原理
Delphi能不能开发Windows的驱动程序（这里的驱动程序当然不是指VxD了^_^）一直是广大Delphi fans关注的问题。姑且先不说能或者不能，我们先来看看用Delphi开发驱动程序需要解决哪些技术上问题。
Delphi的链接器是无法生成Windows内核模式程序的，因此用delphi无法直接生成驱动程序。M$的链接器是可以生成Windows内核模式程序的，那么是否可以用Delphi生成目标文件，然后用M$链接呢？要这么做必须要解决以下的问题：
Delphi生成的目标文件是OMF格式的，而M$ link虽然声称支持OMF格式的目标文件，但基本无用。最好能将OMF格式转换成COFF格式，EliCZ大侠的OMF2D正好可以解决这个问题。解决了目标格式的问题，一切都OK了吗？远没这么简单。
DDDK（Delphi Driver Development Kit）是The Hacker Defender Project team发布的一个用Delphi开发Windows驱动程序的工具包。DDDK是将常用的驱动API用Delphi做了层包装放在DDDK单元中，就像下面这样：
代码:unit DDDK;
interface
const
NtKernel='ntoskrnl.exe';
……
procedure IoCompleteRequest(Irp:PIrp;PriorityBoost:Integer); stdcall;
……
implementation
procedure krnlIoCompleteRequest(Irp:PIrp;PriorityBoost:Integer); stdcall; external NtKernel name 'IoCompleteRequest';
procedure IoCompleteRequest(Irp:PIrp;PriorityBoost:Integer); stdcall;
begin
krnlIoCompleteRequest(Irp,PriorityBoost);
end;
……
然后在每次链接驱动文件之前，用omf2d对dddk.obj中需要引入的驱动API做以下的处理：
omf2d inc\DDDK.obj /U- /CEIoCompleteRequest=_IoCompleteRequest@8 2>nul将DDDK.obj中的IoCompleteRequest改成_IoCompleteRequest@8，为什么要这样做呢？那是因为诸如ntoskrnl.lib之类的导入库都是coff格式的，coff格式就是这样命名的。完成这步以后就可以调用m$ link将目标文件链接成驱动文件了。
这样做虽然可以生成正确的驱动文件，但缺点也是明显的。将驱动API用delphi包装，这些用delphi包装的函数不管是否使用都会被链接到最终生成的驱动文件中，这样会增加驱动文件的尺寸，而且通过delphi的封装函数再去调用驱动API效率也会受影响，还有就是每次链接前都要用omf2d inc\DDDK.obj /U- /CEIoCompleteRequest=_IoCompleteRequest@8去转换delphi的目标文件，既麻烦又容易出错。有没有更好的办法呢？
omf2d的工作就是将delphi的命名方法转换成coff的_xxxxxxx@xx格式，默认omf2d会去掉前导下划线和@xx后缀，可以用/U_*开关让omf2d不删除前导下划线，如果我们再有没有@xx后缀的导入库，那问题就简单多了。但m$并没有提供没有@xx后缀的导入库，那就让我们自己做一个吧^_^，其实很简单，比如我们要生成hal.dll的导入库，只需要编辑一个如下内容的hal.def文件：
代码:LIBRARY HAL.DLL
EXPORTS
ExAcquireFastMutex
ExReleaseFastMutex
ExTryToAcquireFastMutex
HalAcquireDisplayOwnership
HalAdjustResourceList
HalAllProcessorsStarted
……
然后用LINK /LIB /MACHINE:IX86 /DEF:hal.def /OUT:hal.lib命令就可以生成我们需要的没有@xx后缀的导入库文件了。有了这个文件，事情就好办多了。下面就让我们开始用delphi来开发一个简单的驱动程序beeper吧。
这个驱动程序是从Four-F的KmdKit里的beeper转换过来的，程序的目标就是通过访问端口让PC的扬声器发声，程序通过三种方法让扬声器发声，一种是直接访问端口，一种是调用hal.dll的READ_PORT_UCHAR和WRITE_PORT_UCHAR访问端口，第三种方法则是调用hal.dll的HalMakeBeep函数。
代码:unit beeper;
interface
uses windows, DDDK, hal;
function _DriverEntry(DriverObject:PDriverObject;RegistryPath:PUnicodeString):NTSTATUS; stdcall;
implementation
const
TIMER_FREQUENCY:DWORD = 1193167; {1,193,167 Hz}
OCTAVE:DWORD = 2; {octave multiplier}
PITCH_C:DWORD = 523; {C - 523,25 Hz}
PITCH_Cs:DWORD = 554; {C# - 554,37 Hz}
PITCH_D:DWORD = 587; {D - 587,33 Hz}
PITCH_Ds:DWORD = 622; {D# - 622,25 Hz}
PITCH_E:DWORD = 659; {E - 659,25 Hz}
PITCH_F:DWORD = 698; {F - 698,46 Hz}
PITCH_Fs:DWORD = 740; {F# - 739,99 Hz}
PITCH_G:DWORD = 784; {G - 783,99 Hz}
PITCH_Gs:DWORD = 831; {G# - 830,61 Hz}
PITCH_A:DWORD = 880; {A - 880,00 Hz}
PITCH_As:DWORD = 988; {B - 987,77 Hz}
PITCH_H:DWORD = 1047; {H - 1046,50 Hz}
{ We are going to play c-major chord }
DELAY:DWORD = $18000000; {for my ~800mHz box}
TONE_1:DWORD = 1141;
TONE_2:DWORD = 905;
TONE_3:DWORD = 1568; {for HalMakeBeep}
STATUS_DEVICE_CONFIGURATION_ERROR:DWORD = $00C0000182;
procedure MakeBeep1(dwPitch: DWORD); stdcall; assembler;
asm
cli
mov al, 10110110b
out 43h, al
mov eax, dwPitch
out 42h, al
mov al, ah
out 42h, al
{Turn speaker ON}
in al, 61h
or al, 11b
out 61h, al
sti
push eax
mov eax, DELAY
@@1:
dec eax
jnz @@1
pop eax
cli
{Turn speaker OFF}
in al, 61h
and al, 11111100b
out 61h, al
sti
end;
procedure MakeBeep2(dwPitch: DWORD); stdcall;
var
dwPort, i: DWORD;
begin
asm
cli;
end;
WRITE_PORT_UCHAR(PUCHAR($43), $b6);
WRITE_PORT_UCHAR(PUCHAR($42), dwPitch and $FF);
WRITE_PORT_UCHAR(PUCHAR($42), ((dwPitch shr 8) and $FF));
dwPort := READ_PORT_UCHAR(PUCHAR($61));
dwPort := dwPort or 3;
WRITE_PORT_UCHAR(PUCHAR($61), dwPort);
asm
sti
end;
for i := 1 to DELAY do
begin
end;
asm
cli
end;
{ Turn speaker OFF }
dwPort := READ_PORT_UCHAR(PUCHAR($61));
dwPort := dwPort and $FC;
WRITE_PORT_UCHAR(PUCHAR($61), dwPort);
asm
sti
end;
end;
function _DriverEntry(DriverObject:PDriverObject;RegistryPath:PUnicodeString):NTSTATUS; stdcall;
var
i: integer;
begin
MakeBeep1(TONE_1);
MakeBeep2(TONE_2);
HalMakeBeep(TONE_3);
for i := 1 to DELAY do
begin
end;
HalMakeBeep(0);
Result := STATUS_DEVICE_CONFIGURATION_ERROR;
end;
end.
代码:unit hal;
interface
uses
Windows;
const
NtHal = 'hal.dll';
function HalMakeBeep(Frequency: ULONG):BOOLEAN; stdcall;
function READ_PORT_UCHAR(Port:PUCHAR):UCHAR; stdcall;
procedure WRITE_PORT_UCHAR(Port: PUCHAR; Value: UCHAR); stdcall;
implementation
function HalMakeBeep(Frequency: ULONG):BOOLEAN; stdcall; external NtHal name '_HalMakeBeep';
function READ_PORT_UCHAR(Port:PUCHAR):UCHAR; stdcall; external NtHal name '_READ_PORT_UCHAR';
procedure WRITE_PORT_UCHAR(Port: PUCHAR; Value: UCHAR); stdcall; external NtHal name '_WRITE_PORT_UCHAR';
end.
1. 用dcc32 –U ..\include -B -CG -JP -$A-,C-,D-,G-,H-,I-,L-,P-,V-,W+,Y- beeper.pas生成目标文件（此处的..\inc是我保存相关delphi单元文件的目录，你的可能不是这个目录哟）
2. 用omf2d beeper.obj /U_*转换目标文件，使其能被m$ link链接
3. 用link /NOLOGO /ALIGN:32 /BASE:0x10000 /SUBSYSTEM:NATIVE /DRIVER /FORCE:UNRESOLVED /FORCE:MULTIPLE /ENTRY:DriverEntry ..\lib\hal.lib beeper.obj /OUT:beeper.sys生成最终的驱动文件。（注意这里用/FORCE:UNRESOLVED是因为dcc32会在delphi的目标文件中加入一些单元的初始化及销毁代码，这些东东在驱动程序中是不需要的，所以强行忽略之，还会出现一堆链接警告，也不用理会）。
执行完以上的步骤，在你的目录下就会生成一个beeper.sys文件了。把它拷贝到KmdKit的beeper目录中，用它的SCP文件加载，PC的喇叭果然发出的清脆的声音，证明我们的delphi驱动是正确的。用此种方法生成的beeper.sys只有1376字节，只比用KmdKit的汇编代码的beeper.sys大几百个字节，而用DDDK生成的beeper.sys则要超过3K。
工具与环境搭建
用Delphi开发驱动程序所必须的工具：
Dcc32.exe – Delphi编译器，我用的是Delphi 2007的dcc32
rmcoff -- 我用BCB开发的Delphi目标文件符号名修改、OMF到coff格式转换以及删除obj文件中无用代码及重复符号的工具
Link.exe -- microsoft链接器，不要使用7.1xx版的，似乎有bug
DDK相关结构、APIs的Delphi声明文件（我已经完成部分结构、APIs的声明转换，放在我的KmdKit4D工具包里）
有上面的东东就可以开发Windows驱动程序了，
下面就让我们来写一个最简单的驱动程序：
代码:
unit driver;interfaceuses nt_status, ntoskrnl;function _DriverEntry(DriverObject:PDriverObject;RegistryPath:PUnicodeString):NTSTATUS; stdcall;implementationprocedure DriverUnload(DriverObject:PDriverObject); stdcall;
begin
DbgPrint('DriverUnload(DriverObject:0x%.8X)',[DriverObject]);
DbgPrint('DriverUnload(-)',[]);
end;function _DriverEntry(DriverObject:PDriverObject;RegistryPath:PUnicodeString):NTSTATUS; stdcall;
begin
DbgPrint('DriverEntry(DriverObject:0x%.8X;RegistryPath:0x%.8X)',[DriverObject,RegistryPath]);DriverObject^.DriverUnload:=@DriverUnload;Result:=STATUS_SUCCESS;
DbgPrint('DriverEntry(-):0x%.8X',[Result]);
end;end.
以上就是一个最简单的驱动程序，就像其他的可执行程序一样，每个驱动程序也有一个入口点，这是当驱动被装载到内存中时首先被调用的，驱动的入口点是DriverEntry过程（注：过程也就是子程序），DriverEntry这个名称只是一个标记而已，你可以把它命名为其他任何名字--只要它是入口点就行了。DriverEntry过程用来对驱动程序的一些数据结构进行初始化，它的函数原型定义如下：
代码:function _DriverEntry(DriverObject:PDriverObject;RegistryPath:PUnicodeString):NTSTATUS; stdcall;
当然你也可以不用DriverEntry这个名字，任意的名字都可以，不过前面的下划线是必需的。nt_status和 ntoskrnl两个单元包含了常用的数据结构和APIs的声明。由于我常开发Unix下的程序，所以我习惯使用make编译程序，个人感觉make比较智能和方便，因此在推荐大家使用make编译程序。我用的是borland make 5.2版。Makefile的写法可以参考http://bbs.pediy.com/showthread.php?t=56912，以下是编译这个程序的makefile:代码:
NAME=driver
DCC=dcc32
INCLUDE=d:\mickeylan\KmdKit4D\include
LIB_PATH=d:\mickeylan\KmdKit4D\lib
DCCFLAGS=-U$(INCLUDE) -B -CG -JP -$A-,C-,D-,G-,H-,I-,L-,P-,V-,W+,Y-
LIBS=ntoskrnl.lib hal.lib win32k.lib ntdll.lib
LINKFLAGS=/NOLOGO /ALIGN:32 /BASE:0x10000 /SUBSYSTEM:NATIVE /DRIVER /LIBPATH:$(LIB_PATH) /FORCE:UNRESOLVED /FORCE:MULTIPLE /ENTRY:DriverEntryall : $(NAME).sys$(NAME).sys : $(NAME).obj
omf2d $(NAME).obj /U_*
link $(LINKFLAGS) $(LIBS) /out:$(NAME).sys $(NAME).obj$(NAME).obj : $(NAME).pas
$(DCC) $(DCCFLAGS) $(NAME).pasclean :
del *.obj
del *.dcu
del *.sys
在命令行下执行make即可编译生成驱动文件，是不是很简单^_^。此程序的源码放在KmdKit4D的sample\basic目录下，该目录下还有一个loaddriver.bat，执行此批处理文件即可加载驱动，并且可以在DbgView的窗口里看见驱动程序输出的调试信息。
到这里，你应该对用Delphi开发驱动程序有了个大体的了解了，下面让我们再来写一个很有趣的驱动程序以加深了解。这个程序是从Four-F的KmdKit的giveio转换来的（我比较懒，不想写新的^_^），写个驱动程序让用户模式下的进程能通过读取端口来访问电脑的CMOS。
大家都知道，端口是被Windows保护起来的，正常情况下，用户模式下的程序是无法直接操作端口的，通过我们的驱动程序修改I/O许可位图（I/O permission bit map，IOPM），这样用户模式下的相应进程就被允许自由地存取I/O端口，这方面详细资料见http://www.intel.com/design/intarch/techinfo/pentium/PDF/inout.pdf。每个进程都有自己的I/O许可位图，每个单独的I/O端口的访问权限都可以对每个进程进行单独授权，如果相关的位被设置的话，对对应端口的访问就是被禁止的，如果相关的位被清除，那么进程就可以访问对应的端口。既然I/O地址空间由64K个可单独寻址的8位I/O端口组成，IOPM表的最大尺寸就是2000h字节（注：每个端口的权限用1个bit表示，64K个端口除以8得到的就是IOPM的字节数，也就是65536/8＝8192字节＝2000h字节）。
TSS的设计意图是为了在任务切换的时候保存处理器状态，从执行效率的考虑出发，Windows NT并没有使用这个特征，它只维护一个TSS供多个进程共享，这就意味着IOPM也是共享的，因此某个进程改变了IOPM的话，造成的影响是系统范围的。
ntoskrnl.exe中有些未公开的函数是用来维护IOPM的，它们是Ke386QueryIoAccessMap和Ke386SetIoAccessMap函数。
代码:function Ke386QueryIoAccessMap(
dwFlag:DWORD;
pIopm:PVOID): NTSTATUS; stdcall;
Ke386QueryIoAccessMap函数从TSS中拷贝2000h字节的当前IOPM到指定的内存缓冲区中，缓冲区指针由pIopm参数指定。
各参数描述如下：
◎ dwFlag--0表示将全部缓冲区用0FFh填写，也就是所有的位都被设置，所有的端口都被禁止访问；1表示从TSS中将当前IOPM拷贝到缓冲区中
◎ pIopm--用来接收当前IOPM的缓冲区指针，注意缓冲区的大小不能小于2000h字节
如果函数执行成功的话会在返回值的低8位返回非0值；如果执行失败则返回零。
代码:function Ke386SetIoAccessMap(
dwFlag:DWORD;
pIopm:PVOID): NTSTATUS; stdcall;
Ke386SetIoAccessMap函数刚好相反，它从pIopm参数指定的缓冲区中拷贝2000h字节的IOPM到TSS中去。
各参数描述如下：
◎ dwFlag--这个参数只能是1，其他任何值函数都会返回失败
◎ pIopm--指向包含IOPM数据的缓冲区，缓冲区的尺寸不能小于2000h字节
如果函数执行成功的话会在返回值的低8位返回非0值；如果执行失败则返回零
当IOPM拷贝到TSS后，IOPM的偏移指针必须被定位到新的数据中去，这可以通过Ke386IoSetAccessProcess函数来完成，这也是ntoskrnl.exe中的一个很有用的未公开函数。
代码:function Ke386IoSetAccessProcess(
pProcess: PKPROCESS;
dwFlag:DWORD): NTSTATUS; stdcall;
Ke386IoSetAccessProcess允许或者禁止对进程使用IOPM。其参数说明如下：
◎ pProcess--指向KPROCESS结构
◎ dwFlag--0表示禁止对I/O端口进行存取，将IOPM的偏移指针指到TSS段外面；1表示允许存取I/O端口，将IOPM的偏移指针指到TSS段的88h中
如果函数执行成功的话会在返回值的低8位返回非0值；如果执行失败则返回零
顺便提一下，ntoskrnl中的所有函数都有前缀，通过这个前缀你就可以辨别该函数属于系统功能中的哪一类。不同的前缀表示不同的功能--如i前缀表示内部使用（internal）、p表示私有函数（private）、f表示fastcall。再如，Ke表示内核函数（kernel），Psp表示内部进程支持函数（internal process support），Mm表示内存管理函数（Memory Manager）等等。
Ke386IoSetAccessProcess函数的第一个参数指向进程对象，也就是KPROCESS结构（在\include\nt_status.dcu中定义），Ke386IoSetAccessProcess会将KPROCESS结构中IopmOffset字段的值设置为合适的值。
代码:
unit giveio;interfaceuses
nt_status, ntoskrnl, ntutils;const
IOPM_SIZE = $2000; function _DriverEntry(DriverObject:PDriverObject;pusRegistryPath:PUnicodeString):NTSTATUS; stdcall;implementationfunction _DriverEntry(DriverObject:PDriverObject;pusRegistryPath:PUnicodeString):NTSTATUS; stdcall;
var
status:NTSTATUS;
oa:OBJECT_ATTRIBUTES;
hKey:HANDLE;
kvpi:KEY_VALUE_PARTIAL_INFORMATION;
pIopm:PVOID;
pProcess: PVOID;
iRet: NTSTATUS;
resultLen: ULONG;
KeyValue: TUnicodeString;
begin
DbgPrint('giveio: Entering DriverEntry',[]);
status := STATUS_DEVICE_CONFIGURATION_ERROR;
InitializeObjectAttributes(oa, pusRegistryPath, 0, 0, nil);
iRet := ZwOpenKey(hKey, KEY_READ, @oa);
if iRet = STATUS_SUCCESS then
begin
RtlInitUnicodeString(KeyValue, 'ProcessId');
if (ZwQueryValueKey(hKey, @KeyValue,
KeyValuePartialInformation, PVOID(@kvpi),
sizeof(kvpi), resultLen) <> STATUS_OBJECT_NAME_NOT_FOUND) and
(resultLen <> 0) then
begin
DbgPrint('giveio: Process ID: %X', [kvpi.dData]);
{Allocate a buffer for the I/O permission map}
pIopm := MmAllocateNonCachedMemory(IOPM_SIZE);
if pIopm <> nil then
begin
if PsLookupProcessByProcessId(kvpi.dData, pProcess) = STATUS_SUCCESS then
begin
DbgPrint('giveio: PTR KPROCESS: %08X', [@pProcess]);
iRet := Ke386QueryIoAccessMap(0, pIopm);
if iRet and $ff <> 0 then
begin
{I/O access for 70h port}
asm
pushad
mov ecx, pIopm
add ecx, 70h / 8
mov eax, [ecx]
btr eax, 70h MOD 8
mov [ecx], eax{I/O access for 71h port}
mov ecx, pIopm
add ecx, 71h / 8
mov eax, [ecx]
btr eax, 71h MOD 8
mov [ecx], eax
popad
end;iRet := Ke386SetIoAccessMap(1, pIopm);
if iRet and $FF <> 0 then
begin
iRet := Ke386IoSetAccessProcess(pProcess, 1);
if iRet and $FF <> 0 then
begin
DbgPrint('giveio: I/O permission is successfully given',[]);
end else
begin
DbgPrint('giveio: I/O permission is failed',[]);
status := STATUS_IO_PRIVILEGE_FAILED;
end;
end else
begin
status := STATUS_IO_PRIVILEGE_FAILED;
end;
end else
begin
status := STATUS_IO_PRIVILEGE_FAILED;
end;
ObfDereferenceObject(pProcess);
end else
begin
status := STATUS_OBJECT_TYPE_MISMATCH;
end;
MmFreeNonCachedMemory(pIopm, IOPM_SIZE);
end else
begin
DbgPrint('giveio: Call to MmAllocateNonCachedMemory failed',[]);
status := STATUS_INSUFFICIENT_RESOURCES;
end;
end;
ZwClose(hKey);
end;
DbgPrint('giveio: Leaving DriverEntry',[]);
result := status;
end;end.
以下是makefile:代码:
NAME=giveio
DCC=dcc32
INCLUDE=e:\mickeylan\KmdKit4D\include
LIB_PATH=e:\mickeylan\KmdKit4D\lib
DCCFLAGS=-U$(INCLUDE) -B -CG -JP -$A-,C-,D-,G-,H-,I-,L-,P-,V-,W+,Y-
LIBS=ntoskrnl.lib hal.lib win32k.lib ntdll.lib
LINKFLAGS=/NOLOGO /ALIGN:32 /BASE:0x10000 /SUBSYSTEM:NATIVE /DRIVER /LIBPATH:$(LIB_PATH) /FORCE:UNRESOLVED /FORCE:MULTIPLE /ENTRY:DriverEntryall : $(NAME).sys$(NAME).sys : $(NAME).obj
omf2d $(NAME).obj /U_*
link $(LINKFLAGS) $(LIBS) /out:$(NAME).sys $(NAME).obj ntutils.obj$(NAME).obj : $(NAME).pas
$(DCC) $(DCCFLAGS) $(NAME).pasclean :
del *.obj
del *.dcu
del *.sys