Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > [ "Начинающим" ]
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 21.05.2014, 22:14
HTTqp HTTqp вне форума
Новичок
 
Регистрация: 16.04.2014
Сообщения: 77
Версия Delphi: Delphi 7
Репутация: -25
По умолчанию Работа с потоками

Как сделать правильно поток, если действие которое нужно выполнить имеет еще параметры которые заполняются во время работы. Вот пример:
Дан код:
Код:
{Проверка на наличие CD\DVD}
function DiskInDrive(ADriveLetter:Char):Boolean;
var
SectorsPerCluster,BytesPerSector,NumberOfFreeClusters,TotalNumberOfClusters:Cardinal;
begin
Result:=GetDiskFreeSpace(PChar(ADriveLetter+':\'),SectorsPerCluster,BytesPerSector,NumberOfFreeClusters,TotalNumberOfClusters);
end;
данную функцию надо выполнить в потоке, но переменная ADriveLetter:Char меняется во время работы программы, поясню что это буква диска она может быть как с, d, e и т.д.
Ответить с цитированием
  #2  
Старый 21.05.2014, 22:52
Аватар для Bargest
Bargest Bargest вне форума
Профессионал
 
Регистрация: 19.10.2010
Адрес: Москва
Сообщения: 2,390
Версия Delphi: XE3/VS12/FASM
Репутация: 14665
По умолчанию

Вариант в лоб (кривой и неправильный): сделать букву полем класса-наследника TThread, в потоке читать его и передавать в описанную функцию. Учитывая, что поток переменную только читает, а основной код только пишет, работать будет, только иногда с неактуальными данными.
Вариант нормальный, правильный, по фень-шую: то же самое, что и первый, только + критические секции. Подробности - в гугле.
__________________
jmp $ ; Happy End!
The Cake Is A Lie.
Ответить с цитированием
  #3  
Старый 22.05.2014, 00:02
Аватар для Страдалецъ
Страдалецъ Страдалецъ вне форума
Гуру
 
Регистрация: 09.03.2009
Адрес: На курорте, из окна вижу теплое Баренцево море. Бррр.
Сообщения: 4,723
Репутация: 52347
По умолчанию

А что мешает в поток засунуть и обход всех дисков? Как я понял это последовательная операция и вы ее не планируете разбивать на отдельные потоки для каждого из дисков.
__________________
Жизнь такова какова она есть и больше никакова.
Помогаю за спасибо.
Ответить с цитированием
  #4  
Старый 22.05.2014, 01:40
HTTqp HTTqp вне форума
Новичок
 
Регистрация: 16.04.2014
Сообщения: 77
Версия Delphi: Delphi 7
Репутация: -25
По умолчанию

Цитата:
Сообщение от Страдалецъ
А что мешает в поток засунуть и обход всех дисков? Как я понял это последовательная операция и вы ее не планируете разбивать на отдельные потоки для каждого из дисков.
Вот последовательность действий: после запуска программы, она начинает постоянно проверять не появились ли новые диски, если да то передать нужную букву диска и проверить ли там cd балванка
Ответить с цитированием
  #5  
Старый 22.05.2014, 06:48
Аватар для Alegun
Alegun Alegun вне форума
LMD-DML
 
Регистрация: 12.07.2009
Адрес: Богородское
Сообщения: 3,025
Версия Delphi: D7E
Репутация: 1834
По умолчанию

Цитата:
Сообщение от HTTqp
...после запуска программы, она начинает постоянно проверять...
Зачем постоянно-то, при удалении/появлении в усройстве нового сиди системой генерится сообщение WM_DEVICECHANGE, в этот момент и надо ловить, вот пара способов из drkb
Код:
{ 
Some applications need to know when the user inserts or 
removes a compact disc or DVD from a CD-ROM drive without 
polling for media changes. Windows provide a way to notify these 
applications through the WM_DEVICECHANGE message. 
}

type
  TForm1 = class(TForm)
  private
    procedure WMDeviceChange(var Msg: TMessage); message WM_DEVICECHANGE;
  public
  end;

{...}

implementation

{$R *.DFM}

procedure TForm1.WMDeviceChange(var Msg: TMessage);
const
 DBT_DEVICEARRIVAL = $8000; // system detected a new device 
 DBT_DEVICEREMOVECOMPLETE = $8004;  // device is gone 
var
  myMsg: string;
begin
  inherited;
  case Msg.wParam of
    DBT_DEVICEARRIVAL: myMsg  := 'CD inserted!';
    DBT_DEVICEREMOVECOMPLETE: myMsg := 'CD removed!';
  end;
  ShowMessage(myMsg);
end;
и
Код:
// Advanced Code: 
// When the device is of type volume, then we can get some device specific 
// information, namely specific information about a logical volume. 
// by Juergen Kantz 

unit Unit1;

interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    label1: TLabel;
  private
    procedure WMDeviceChange(var Msg: TMessage); message WM_DeviceChange;
    { Private declarations }
  public
    { Public declarations }
  end;
const
  DBT_DeviceArrival = $8000;
  DBT_DeviceRemoveComplete = $8004;
  DBTF_Media = $0001;
  DBT_DevTyp_Volume = $0002;

type
  PDevBroadcastHdr = ^TDevBroadcastHdr;
  TDevBroadcastHdr = packed record
    dbcd_size: DWORD;
    dbcd_devicetype: DWORD;
    dbcd_reserved: DWORD;
  end;

type
  PDevBroadcastVolume = ^TDevBroadcastVolume;
  TDevBroadcastVolume = packed record
    dbcv_size: DWORD;
    dbcv_devicetype: DWORD;
    dbcv_reserved: DWORD;
    dbcv_unitmask: DWORD;
    dbcv_flags: Word;
  end;

var
  Form1: TForm1;
implementation

{$R *.dfm}

function GetDrive(pDBVol: PDevBroadcastVolume): string;
var
  i: Byte;
  Maske: DWORD;
begin
  if (pDBVol^.dbcv_flags and DBTF_Media) = DBTF_Media then
  begin
    Maske := pDBVol^.dbcv_unitmask;
    for i := 0 to 25 do
    begin
      if (Maske and 1) = 1 then
        Result := Char(i + Ord('A')) + ':';
      Maske := Maske shr 1;
    end;
  end;
end;

procedure TForm1.WMDeviceChange(var Msg: TMessage);
var
  Drive: string;
begin
  case Msg.wParam of
    DBT_DeviceArrival:
      if PDevBroadcastHdr(Msg.lParam)^.dbcd_devicetype = DBT_DevTyp_Volume then
      begin
        Drive := GetDrive(PDevBroadcastVolume(Msg.lParam));
        label1.Caption := 'CD inserted in Drive ' + Drive;
      end;
    DBT_DeviceRemoveComplete:
      if PDevBroadcastHdr(Msg.lParam)^.dbcd_devicetype = DBT_DevTyp_Volume then
      begin
        Drive := GetDrive(PDevBroadcastVolume(Msg.lParam));
        label1.Caption := 'CD removed from Drive ' + Drive;
      end;
  end;
end;
end.
это всё под CD-диск заточено, но думаю константы совпадают и для болванок
Ответить с цитированием
  #6  
Старый 22.05.2014, 07:00
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 8,056
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
По умолчанию

Вот мой код из одного из проектов. Довит появление/удаление диска (работает на CD/DVD и флешках, проверял):
Код:
procedure TBrowserMainForm.WMDeviceChange(var Message: TMessage);
const
  DBT_CONFIGCHANGECANCELED    = $19;
  DBT_CONFIGCHANGED           = $18;
  DBT_CUSTOMEVENT             = $8006;
  DBT_DEVICEARRIVAL           = $8000;
  DBT_DEVICEQUERYREMOVE       = $8001;
  DBT_DEVICEQUERYREMOVEFAILED = $8002;
  DBT_DEVICEREMOVECOMPLETE    = $8004;
  DBT_DEVICEREMOVEPENDING     = $8003;
  DBT_DEVICETYPESPECIFIC      = $8005;
  DBT_DEVNODES_CHANGED        = $7;
  DBT_QUERYCHANGECONFIG       = $17;
  DBT_USERDEFINED             = $FFFF;
var
  ASelFolder : String;
begin
  If FDevChanged Then
    Begin
      ASelFolder := tvFolders.Path;
      tvFolders.Items.BeginUpdate;
      tvFolders.Refresh(tvFolders.Items[0]);
      tvFolders.Path := ASelFolder;
      tvFolders.Items.EndUpdate;
      FDevChanged := False;
    End;

  Case Message.WParam Of
    DBT_DEVICEARRIVAL,
    DBT_DEVICEREMOVECOMPLETE :
      Begin
        CreateDiskShortCuts;
        FDevChanged := True;
      End;
  End;
end;
Зачем описывал все константы - уже не помню, видимо, что бы не потерять список...
Ответить с цитированием
  #7  
Старый 22.05.2014, 12:55
HTTqp HTTqp вне форума
Новичок
 
Регистрация: 16.04.2014
Сообщения: 77
Версия Delphi: Delphi 7
Репутация: -25
По умолчанию

Цитата:
Сообщение от Alegun
Зачем постоянно-то, при удалении/появлении в усройстве нового сиди системой генерится сообщение WM_DEVICECHANGE, в этот момент и надо ловить, вот пара способов из drkb
Код:
{ 
Some applications need to know when the user inserts or 
removes a compact disc or DVD from a CD-ROM drive without 
polling for media changes. Windows provide a way to notify these 
applications through the WM_DEVICECHANGE message. 
}

type
  TForm1 = class(TForm)
  private
    procedure WMDeviceChange(var Msg: TMessage); message WM_DEVICECHANGE;
  public
  end;

{...}

implementation

{$R *.DFM}

procedure TForm1.WMDeviceChange(var Msg: TMessage);
const
 DBT_DEVICEARRIVAL = $8000; // system detected a new device 
 DBT_DEVICEREMOVECOMPLETE = $8004;  // device is gone 
var
  myMsg: string;
begin
  inherited;
  case Msg.wParam of
    DBT_DEVICEARRIVAL: myMsg  := 'CD inserted!';
    DBT_DEVICEREMOVECOMPLETE: myMsg := 'CD removed!';
  end;
  ShowMessage(myMsg);
end;
и
Код:
// Advanced Code: 
// When the device is of type volume, then we can get some device specific 
// information, namely specific information about a logical volume. 
// by Juergen Kantz 

unit Unit1;

interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    label1: TLabel;
  private
    procedure WMDeviceChange(var Msg: TMessage); message WM_DeviceChange;
    { Private declarations }
  public
    { Public declarations }
  end;
const
  DBT_DeviceArrival = $8000;
  DBT_DeviceRemoveComplete = $8004;
  DBTF_Media = $0001;
  DBT_DevTyp_Volume = $0002;

type
  PDevBroadcastHdr = ^TDevBroadcastHdr;
  TDevBroadcastHdr = packed record
    dbcd_size: DWORD;
    dbcd_devicetype: DWORD;
    dbcd_reserved: DWORD;
  end;

type
  PDevBroadcastVolume = ^TDevBroadcastVolume;
  TDevBroadcastVolume = packed record
    dbcv_size: DWORD;
    dbcv_devicetype: DWORD;
    dbcv_reserved: DWORD;
    dbcv_unitmask: DWORD;
    dbcv_flags: Word;
  end;

var
  Form1: TForm1;
implementation

{$R *.dfm}

function GetDrive(pDBVol: PDevBroadcastVolume): string;
var
  i: Byte;
  Maske: DWORD;
begin
  if (pDBVol^.dbcv_flags and DBTF_Media) = DBTF_Media then
  begin
    Maske := pDBVol^.dbcv_unitmask;
    for i := 0 to 25 do
    begin
      if (Maske and 1) = 1 then
        Result := Char(i + Ord('A')) + ':';
      Maske := Maske shr 1;
    end;
  end;
end;

procedure TForm1.WMDeviceChange(var Msg: TMessage);
var
  Drive: string;
begin
  case Msg.wParam of
    DBT_DeviceArrival:
      if PDevBroadcastHdr(Msg.lParam)^.dbcd_devicetype = DBT_DevTyp_Volume then
      begin
        Drive := GetDrive(PDevBroadcastVolume(Msg.lParam));
        label1.Caption := 'CD inserted in Drive ' + Drive;
      end;
    DBT_DeviceRemoveComplete:
      if PDevBroadcastHdr(Msg.lParam)^.dbcd_devicetype = DBT_DevTyp_Volume then
      begin
        Drive := GetDrive(PDevBroadcastVolume(Msg.lParam));
        label1.Caption := 'CD removed from Drive ' + Drive;
      end;
  end;
end;
end.
это всё под CD-диск заточено, но думаю константы совпадают и для болванок

Вот опять куда вы полезли, я про потоки вы тут про определение, мне нужно загнать процедуру в поток, не важно как она определяет вставлен ли диск или нет.
Ответить с цитированием
  #8  
Старый 22.05.2014, 15:17
Аватар для NumLock
NumLock NumLock вне форума
Let Me Show You
 
Регистрация: 30.04.2010
Адрес: Северодвинск
Сообщения: 5,426
Версия Delphi: 7, XE5
Репутация: 59586
По умолчанию

обертка переменной критической секцией поможет. либо критическая секция в get'тере / set'тере.
__________________
Пишу программы за еду.
__________________
Ответить с цитированием
  #9  
Старый 22.05.2014, 16:20
Аватар для Alegun
Alegun Alegun вне форума
LMD-DML
 
Регистрация: 12.07.2009
Адрес: Богородское
Сообщения: 3,025
Версия Delphi: D7E
Репутация: 1834
По умолчанию

Цитата:
Сообщение от HTTqp
Вот опять куда вы полезли, я про потоки вы тут про определение, мне нужно загнать процедуру в поток, не важно как она определяет вставлен ли диск или нет.
Да в том то и дело что здесь наблюдается попытке под видом разгрузить процесс явное его усложнение - можно просто завести в var-секции указатели на букву и присутствие болванки в устройстве, изменять их автоматом при обработке WMDeviceChange, а в потоке лишь следить за их содержимым или состоянием, чем выполнять проверку того же самого, причём постоянно и "изнутрей". А глобальные переменные считываются потоком просто и легко, как уже подсказал bro NumLock, обычным get'том
Ответить с цитированием
  #10  
Старый 22.05.2014, 17:30
HTTqp HTTqp вне форума
Новичок
 
Регистрация: 16.04.2014
Сообщения: 77
Версия Delphi: Delphi 7
Репутация: -25
По умолчанию

Цитата:
Сообщение от Alegun
Да в том то и дело что здесь наблюдается попытке под видом разгрузить процесс явное его усложнение - можно просто завести в var-секции указатели на букву и присутствие болванки в устройстве, изменять их автоматом при обработке WMDeviceChange, а в потоке лишь следить за их содержимым или состоянием, чем выполнять проверку того же самого, причём постоянно и "изнутрей". А глобальные переменные считываются потоком просто и легко, как уже подсказал bro NumLock, обычным get'том

Хорошо, тогда скажите как не отображать букву диска если если там нет диска, моя программа в любом случаи определяет даже если там нет диска, букву привода.
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 02:20.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter