Пример создания VxD-драйвера на Delphi

Компиляция данного примера возможна только с Delphi 3. Delphi 2 не был опробован в связи с его отсутствием, объектные фалы созданные Delphi 4 отвергаются Microsoft � Linker 5.12.8181 как файлы неизвестного формата.
При написании данного материала были использованы Microsoft � Macro Assembler ver. 6.11d и Microsoft � Incremental Linker ver. 5.12.8181 из поставки Windows 98DDK

Практически возможно создание драйвера поддерживающего оба типа загрузки.

Нам необходим динамически загружаемый VxD драйвер (далее "VxD") т.к. такой драйвер можно будет без перезагрузки Windows загружать из Win32� приложений используя процедуру CreateFile().

Когда Win32 приложение открывает дескриптор для VxD, виртуальное устройство VWIN32 используя сервис LoadDevice загружает VxD-драйвер в память и посылает информационное сообщение W32_DEVICEIOCONTROL загруженному VxD.

Таким образом для построения VxD необходимо обрабатывать как минимум три системных сообщения:

Собщение SYS_DYNAMIC_DEVICE_INIT посылается при попытке динамической загрузки VxD, SYS_DYNAMIC_DEVICE_EXIT посылается при попытке динамической выгрузке. Из обработчиков сообщений для подтверждения успеха необходимо вернуть VXD_SUCCESS в регистре AX
Сообщение W32_DEVICEIOCONTROL имеет следующие значения для параметра dwService

При обращении к процедурам находящимся в модулях Delphi надо учесть для fastcall-процедур к имени добавляется в начале символ "@"

...
extrn SysDynamicDeviceInit :PROC
extrn SysDynamicDeviceExit :PROC
extrn W32DeviceIoControl   :PROC
...
Control_0	proc
	cmp	eax, SYS_DYNAMIC_DEVICE_INIT
	jnz	short chkSysDynExit
	call	SysDynamicDeviceInit
	cmp	eax, 1
	retn	
;-------------

chkSysDynExit:
	cmp	eax, SYS_DYNAMIC_DEVICE_EXIT
	jnz	short chkDevIOCtl
	call	SysDynamicDeviceExit
	cmp	eax, 1
	retn	
;-------------
chkDevIOCtl:
	cmp	eax, W32_DEVICEIOCONTROL
	jnz	short loc_ret
	push	esi
	push	edx
	push	ebx
	push	ecx
	call	W32DeviceIoControl
	cmp	eax, 1
	retn	
;-------------
loc_ret:
	clc	
	retn	

Control_0	endp
...

Delphi создает код для инициализации/деинициализации модулей, обращаясь к внешним процедурам HandleFinaly и initialization даже если блоки initilization и finalization в модуле отсутствуют. Создадим пустую "заглушку" для этих процедур и объявим их доступными для внешних модулей.

procedure ShellMessage(Handle, Flags : integer; 
   const Message, Caption : PChar; 
   Callback, ReferenceData : pointer); stdcall; assembler;
asm
  mov	ebx, Handle		// virtual machine handle
  mov	eax, Flags		// message box flags
  mov	ecx, Message		// address of message text
  mov	edi, Caption		// address of caption text
  mov	esi, Callback		// address of callback
  mov	edx, ReferenceData	// reference data for callback

  int	20H			// VxDCall
  dd 	170004h			// Shell_Message
end;

const
  Copyright : PChar = '(c) 1999 Emil Biserov, '+
              'fatty@mail.primorye.ru, http://dinfo.da.ru';

function SysDynamicDeviceInit : INTEGER;
begin
  ShellMessage(0, $10, Copyright, 
    'SysDynInit: Hello from Delphi VxD !!!', nil, nil);
  Result := VXD_SUCCESS;
end;

function SysDynamicDeviceExit : INTEGER;
begin
  ShellMessage(0, $10, Copyright, 
    'SysDynDevExit: Bye from Delphi VxD !!!', nil, nil);
  Result := VXD_SUCCESS;
end;

var
  Str : array [0..16] of char;

function W32DeviceIoControl(dwService : INTEGER;
                            dwDDB : INTEGER;
                            hDevice : INTEGER;
                            lpDIOCParms : pointer) : INTEGER;
begin
  ShellMessage(0, $10, Copyright, 'W32DevIOCtl', nil, nil);

  if (dwService = DIOC_OPEN) then
  begin
      Result := NO_ERROR;
  end
  // 
  // 
  else if (dwService = DIOC_CLOSEHANDLE) then
  begin
      Result := VXD_SUCCESS;
  end
  else if (dwService > MAX_PASVXD_W32_API) then
  begin
      Result := ERROR_NOT_SUPPORTED;
  end
    else
  begin
      Result := VXD_SUCCESS; 
  end;
end;

Представляет из себя простую форму с двумя кнопками. Приведу лишь методы для открытия и закрытия VxD драйвера.

const
 VxDName = '\\.\DELPHIIO.VXD';

...

function TVxDTestForm.OpenVxDDriver: boolean;
begin
  HVxDHandle := CreateFile(VxDName,0,0,nil,0,FILE_FLAG_DELETE_ON_CLOSE,0);
  Result := HVxDHandle <> INVALID_HANDLE_VALUE;
end;

procedure TVxDTestForm.CloseVxDDriver;
begin
 if HVxDHandle <> INVALID_HANDLE_VALUE then begin
   CloseHandle(HVxDHandle);
   HVxDHandle := INVALID_HANDLE_VALUE;
 end;
end;

Выгрузку неиспользуемого модуля можно производить автоматически, указав в параметрах CreateFile(,,,,,FILE_FLAG_DELETE_ON_CLOSE,). В данном случае система при каждом открытии дескриптора к VxD будет увеличивать внутренний счетчик использования на 1 и вычитать 1 при закрытии дескриптора. При значении счетчика равном нулю VxD будет автоматически выгружен.

Драйвера на Delphi писать можно. Но вот только стоит ли?
Использование VxD имеет смысл только для использования Windows 3.1 и Windows 95. Да и доступ к аппаратным ресурсам в них гораздо прозрачнее чем Windows NT/2000. Windows 98, Windows NT и Windows2000 поддерживают новую модель драйверов WDM 1.0/2.0, использующую формат PE (Portable Executable) и (предположительно) проблем будет меньше, чем с VxD и его LE (Linear Executable) форматом драйверов.