нет точки входа

← →
user51 (2005-08-19 16:52) [0]

Имею компонент отлавливает манипуляции с ФЛЕШКОЙ (вставили вынули)который нормально работает по XP но под NT
вываливается ошибка что нет точки входа в процедуру
RegisterDeviceNotification

(оно и понятно NT USB не потдерживает и такой функции в ней нет)
r := RegisterDeviceNotification(FWindowHandle, @dbi,
DEVICE_NOTIFY_WINDOW_HANDLE
);

Как сделать чтоб под NT проверялось что такой процедуры
и не возникало ошибки (нет и ладно работаем без этого) а под XP
все работало как положено.

unit U_Usb;
interface
uses
Windows, Messages, SysUtils, Classes, Forms;
type
PDevBroadcastHdr = ^DEV_BROADCAST_HDR;
DEV_BROADCAST_HDR = packed record
dbch_size: DWORD;
dbch_devicetype: DWORD;
dbch_reserved: DWORD;
end;
PDevBroadcastDeviceInterface = ^DEV_BROADCAST_DEVICEINTERFACE;
DEV_BROADCAST_DEVICEINTERFACE = record
dbcc_size: DWORD;
dbcc_devicetype: DWORD;
dbcc_reserved: DWORD;
dbcc_classguid: TGUID;
dbcc_name: short;
end;
const
GUID_DEVINTERFACE_USB_DEVICE: TGUID = "{A5DCBF10-6530-11D2-901F-00C04FB951ED}";
DBT_DEVICEARRIVAL = $8000; // system detected a new device
DBT_DEVICEREMOVECOMPLETE = $8004; // device is gone
DBT_DEVTYP_DEVICEINTERFACE = $00000005; // device interface class
type
TComponentUSB = class(TComponent)
private
FWindowHandle: HWND;
FOnUSBArrival: TNotifyEvent;
FOnUSBRemove: TNotifyEvent;
procedure WndProc(var Msg: TMessage);
function USBRegister: Boolean;
protected
procedure WMDeviceChange(var Msg: TMessage); dynamic;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property OnUSBArrival: TNotifyEvent read FOnUSBArrival write FOnUSBArrival;
property OnUSBRemove: TNotifyEvent read FOnUSBRemove write FOnUSBRemove;
end;

procedure Register;

implementation
constructor TComponentUSB.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FWindowHandle := AllocateHWnd(WndProc);
USBRegister;
end;
destructor TComponentUSB.Destroy;
begin
DeallocateHWnd(FWindowHandle);
inherited Destroy;
end;
procedure TComponentUSB.WndProc(var Msg: TMessage);
begin
if (Msg.Msg = WM_DEVICECHANGE) then
begin
try
WMDeviceChange(Msg);
except
Application.HandleException(Self);
end;
end
else
Msg.Result := DefWindowProc(FWindowHandle, Msg.Msg, Msg.wParam, Msg.lParam);
end;
procedure TComponentUSB.WMDeviceChange(var Msg: TMessage);
var
devType: Integer;
Datos: PDevBroadcastHdr;
begin
if (Msg.wParam = DBT_DEVICEARRIVAL) or (Msg.wParam = DBT_DEVICEREMOVECOMPLETE) then
begin
Datos := PDevBroadcastHdr(Msg.lParam);
devType := Datos^.dbch_devicetype;
if devType = DBT_DEVTYP_DEVICEINTERFACE then
begin // USB Device
if Msg.wParam = DBT_DEVICEARRIVAL then
begin
if Assigned(FOnUSBArrival) then
FOnUSBArrival(Self);
end
else
begin
if Assigned(FOnUSBRemove) then
FOnUSBRemove(Self);
end;
end;
end;
end;

procedure Register;
begin
RegisterComponents("USB", [TComponentUSB]); //я добавил
end;

function TComponentUSB.USBRegister: Boolean;
var
dbi: DEV_BROADCAST_DEVICEINTERFACE;
Size: Integer;
r: Pointer;
begin
Result := False;
Size := SizeOf(DEV_BROADCAST_DEVICEINTERFACE);
ZeroMemory(@dbi, Size);
dbi.dbcc_size := Size;
dbi.dbcc_devicetype := DBT_DEVTYP_DEVICEINTERFACE;
dbi.dbcc_reserved := 0;
dbi.dbcc_classguid := GUID_DEVINTERFACE_USB_DEVICE;
dbi.dbcc_name := 0;

ЗДЕСЬ ПОД NT ОЗНИКАЕТ ОШИБКА (оно и понятно NT USB не потдерживает и такой функции в ней нет)
r := RegisterDeviceNotification(FWindowHandle, @dbi,
DEVICE_NOTIFY_WINDOW_HANDLE
);

if Assigned(r) then Result := True;
end;
end.

← →
Юрий Зотов © (2005-08-19 17:07) [1]

Проверить версию Windows, только и всего. Если NT - ничего не делать. В SysUtils есть уже готовые переменные на этот счет, а вот расшифровка их значений для разных версий системы.

Win32MajorVersion:

Windows Server 2003 5
Windows XP 5
Windows 2000 5
Windows NT 4.0 4
Windows Me 4
Windows 98 4
Windows 95 4
Windows NT 3.51 3

Win32MinorVersion:

Windows Server 2003 2
Windows XP 1
Windows 2000 0
Windows NT 4.0 0
Windows Me 90
Windows 98 10
Windows 95 0
Windows NT 3.51 51

Win32PlatformId:

VER_PLATFORM_WIN32_NT (Server 2003, XP, 2000, NT)
VER_PLATFORM_WIN32_WINDOWS (Me, 98, 95)
VER_PLATFORM_WIN32s (Win32s on Windows 3.1)

← →
s999 (2005-08-19 17:31) [2]

либо просто проверить, типа:

var IsRegisterDeviceNotificationExists: Boolean; MyRegisterDeviceNotification: function(hRecipient: THandle; NotificationFilter: Pointer; Flags: DWORD): HDEVNOTIFY; stdcall; procedure InitUnit; var user32: THandle; begin user32 := GetModuleHandle(Windows.user32); if user32 <> 0 then @MyRegisterDeviceNotification := GetProcAddress(user32, "RegisterDeviceNotificationA"); IsRegisterDeviceNotificationExists := Assigned(MyRegisterDeviceNotification); end; initialization InitUnit;

← →
s999 (2005-08-19 17:45) [3]

Кстати, вариант Юрия Зотова не пройдет. Если в программе будет вызов RegisterDeviceNotification (хоть и под if-ом), то программа "обломится" при старте, при попытке статической загрузке user32. То есть, облочка MyRegisterDeviceNotification нужна, но тогда проверка версии Windows не нужна.

← →
s999 (2005-08-19 17:53) [4]

Гм... Какой же это вопрос для начинающих, если авторитет ответил на него неправильно :))))))))))

нет точки входа Найти похожие ветки