Всем привет!
Пишу проект. Смысл его части в том, что надо отловить появление флешки и запустить другую процедуру.
В части отлова флешки я не изобретал велосипед и сделал так:
| Код |
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ScktComp, ExtCtrls, sSkinManager, sButton, acPNG,
sLabel, sGroupBox, sMemo,activeX, OleServer, WbemScripting_TLB,registry;
Const
DBT_DEVICEARRIVAL = $8000;
DBT_DEVTYP_VOLUME = 2;
DBT_DEVICEREMOVECOMPLEATE = $8004;
DICS_ENABLE = $00000001;
DICS_DISABLE = $00000002;
DIF_PROPERTYCHANGE = $00000012;
DICS_FLAG_GLOBAL = $00000001;
DIGCF_PRESENT = $00000002;
SPDRP_COMPATIBLEIDS = $00000002;
DISK_GUID: TGUID = '{4D36E967-E325-11CE-BFC1-08002BE10318}';
type
PDEV_BROADCAST_HDR = ^DEV_BROADCAST_HDR;
DEV_BROADCAST_HDR = record
dbch_size,
dbch_devicetype,
dbch_reserved: DWORD;
end;
PDEV_BROADCAST_VOLUME = ^DEV_BROADCAST_VOLUME;
DEV_BROADCAST_VOLUME = record
dbcv_size,
dbcv_devicetype,
dbcv_reserved,
dbcv_unitmask: DWORD;
end;
TClient = class(TForm)
cs: TClientSocket;
te: TTimer;
sGroupBox1: TsGroupBox;
sLabel1: TsLabel;
Image1: TImage;
infolabel: TsLabel;
ClearButton: TsButton;
sSkinManager1: TsSkinManager;
ownsend: TButton;
log1: TsMemo;
SWbemLocator1: TSWbemLocator;
sButton1: TsButton;
log: TMemo;
procedure AddToLog(s:string);
Procedure Proc(var Msg:TMessage); message WM_DEVICECHANGE; stdcall;
............................................
....................
...
.............
implementation
{$R *.dfm}
type
PSP_CLASSINSTALL_HEADER = ^SP_CLASSINSTALL_HEADER;
SP_CLASSINSTALL_HEADER = record
cbSize: DWORD;
InstallFunction: Cardinal;
end;
PSP_PROPCHANGE_PARAMS = ^SP_PROPCHANGE_PARAMS;
SP_PROPCHANGE_PARAMS = record
ClassInstallHeader: SP_CLASSINSTALL_HEADER;
StateChange: DWORD;
Scope: DWORD;
HwProfile: DWORD;
end;
PSP_DEVINFO_DATA = ^SP_DEVINFO_DATA;
SP_DEVINFO_DATA = record
cbSize: DWORD;
ClassGuid: TGUID;
DevInst: DWORD;
Reserved: Longint;
end;
function SetupDiGetClassDevs(const ClassGuid: PGUID; Enumerator: PChar;
hwndParent: HWND; Flags: DWORD): DWORD; stdcall;
external 'Setupapi.dll' name 'SetupDiGetClassDevsA';
function SetupDiDestroyDeviceInfoList(DeviceInfoSet: DWORD): BOOL; stdcall;
external 'Setupapi.dll';
function SetupDiEnumDeviceInfo(DeviceInfoSet: DWORD; MemberIndex: DWORD;
DeviceInfoData: PSP_DEVINFO_DATA): BOOL; stdcall;
external 'Setupapi.dll';
function SetupDiCallClassInstaller(InstallFunction: DWORD;
DeviceInfoSet: DWORD; DeviceInfoData: PSP_DEVINFO_DATA): BOOL; stdcall;
external 'setupapi.dll';
function SetupDiGetDeviceRegistryProperty(DeviceInfoSet: DWORD;
DeviceInfoData: PSP_DEVINFO_DATA; Propertys: DWORD; PropertyRegDataType: PWORD;
PropertyBuffer: PByte; PropertyBufferSize: DWORD; RequiredSize: PWORD): BOOL; stdcall;
external 'Setupapi.dll' name 'SetupDiGetDeviceRegistryPropertyA';
function SetupDiSetClassInstallParams(DeviceInfoSet: DWORD;
DeviceInfoData: PSP_DEVINFO_DATA; ClassInstallParams: PSP_CLASSINSTALL_HEADER;
ClassInstallParamsSize: DWORD): BOOL; stdcall;
external 'setupapi.dll' name 'SetupDiSetClassInstallParamsA';
//==============================================================================
procedure tclient.Proc(var Msg: TMessage);
var
DriveLetter: string;
mess:string;
begin
try
if (Msg.WParam = DBT_DEVICEREMOVECOMPLEATE) then
if (PDEV_BROADCAST_HDR(Msg.LParam)^.dbch_devicetype = DBT_DEVTYP_VOLUME) then
mess:='Флешка ушла';
if (MSG.WParam = DBT_DEVICEARRIVAL) then
if (PDEV_BROADCAST_HDR(Msg.LParam)^.dbch_devicetype = DBT_DEVTYP_VOLUME) then
begin
mess:='Флешка пришла';
end;
finally
addtolog(mess);
end;
end;
Procedure TClient.AddToLog (s:string);
var
myDate : TDateTime;
formattedDateTime : string;
begin
mydate:=Now;
DateTimeToString(formattedDateTime, 'c', myDate);
[color=red] log.lines.Add(formattedDateTime+' : '+s);[/color]
end;
.................................
и так далее
.................
прочие процедуры и функции
........................................
|
Т.е. что тут получается:
как только приходит в систему флешка, то процедура PROC ловит это событие и процедура AddToLog должна вывести в мемо (имеет имя log) строку, которую ей передает процедура Proc.
По факту имею:
Флешку ловит, доходит до момента, когда AddToLog указывается добавить строку в мемо (строка выделена красным в коде) и выкидывает ошибку EAccess Violation скрине во вложении.
Я пробовал с любым объектом-не возможно его модифицировать, та же ошибка.
Однако Showmessage работает.
Что я не так написал? Ткните пальцем плиз)
|
)