求串口监听异常解决良方(全分赠送)(200分)

我用“delphi下深入windows核心编程”中的串口监听源代码（动态链接库），当下载钩子时为何会使系统不稳定，被监听程序异常关闭等情况。采用的是陷阱式，引入表式监听不到相应串口通讯数据。

主要异常表现在explorer.exe和被监听程序的异常，表现为程序关闭和停止消息响应。

其dll代码如下：
unit UnitDllMain;

interface

uses windows,UnitNt2000Hook,Sysutils,dialogs,messages;

const
MappingFileName = 'Mapping File Comm DLL';
Trap=true; {True陷阱式,False改引入表式}

type
TShareMem = packed record
ComPortFile:array[0..255] of char;
FileHandle:THandle;
DatToWriteFile:array[0..255] of char;
DatToReadFile:array[0..255] of char;
end;
PShareMem = ^TShareMem;

procedure StartHook(FileBeSpy,readfile,writefilechar); stdcall;
procedure StopHook; stdcall;

implementation

var
pShMem : PShareMem;
hMappingFile : THandle;
hook:array[0..4]of THookClass;
FirstProcess:boolean;
MessageHook:Thandle;

function NewCreateFileA(lpFileName: PChar;dwDesiredAccess, dwShareMode: DWORD;
lpSecurityAttributes: PSecurityAttributes;dwCreationDisposition,dwFlagsAndAttributes: DWORD;
hTemplateFile: THandle): THandle;stdcall;
type
TCreateFileA=function(lpFileName: PChar;dwDesiredAccess, dwShareMode: DWORD;
lpSecurityAttributes: PSecurityAttributes;dwCreationDisposition,dwFlagsAndAttributes: DWORD;
hTemplateFile: THandle): THandle;stdcall;
begin
Hook[0].Restore; {改引入表式可以不使用此语句}
result:=TCreateFileA(hook[0].OldFunction)(lpFileName,dwDesiredAccess,dwShareMode,
lpSecurityAttributes,dwCreationDisposition,dwFlagsAndAttributes,
hTemplateFile);
if (stricomp(lpFileName,pShMem^.ComPortFile)=0)or // COM2
((plongword(@lpFileName[0])^=$5c2e5c5c)and(stricomp(@lpFileName[4],pShMem^.ComPortFile)=0)) or // //./COM2
((strlicomp(lpFileName,pShMem^.ComPortFile,4)=0)and(pword(@lpFileName[4])^=$002e))then // COM2.
begin
pShMem^.FileHandle:=result;
end;
Hook[0].Change; {改引入表式可以不使用此语句}
end;

function NewCreateFileW(lpFileName: PWideChar;dwDesiredAccess, dwShareMode: DWORD;
lpSecurityAttributes: PSecurityAttributes;dwCreationDisposition,dwFlagsAndAttributes: DWORD;
hTemplateFile: THandle): THandle;stdcall;
type
TCreateFileW=function (lpFileName: PWideChar; dwDesiredAccess, dwShareMode: DWORD;
lpSecurityAttributes: PSecurityAttributes; dwCreationDisposition, dwFlagsAndAttributes: DWORD;
hTemplateFile: THandle): THandle; stdcall;
var
s:string;
begin
Hook[1].Restore; {改引入表式可以不使用此语句}
result:=TCreateFileW(hook[1].OldFunction)(lpFileName,dwDesiredAccess,dwShareMode,
lpSecurityAttributes,dwCreationDisposition,dwFlagsAndAttributes,
hTemplateFile);
s:=WideCharToString(lpFileName);
if s<>'' then
if (stricomp(@s[1],pShMem^.ComPortFile)=0)or //COM2
((plongword(@s[1])^=$5c2e5c5c)and(stricomp(@lpFileName[5],pShMem^.ComPortFile)=0)) or // //./COM2
((strlicomp(@s[1],pShMem^.ComPortFile,4)=0)and(pword(@lpFileName[5])^=$002e))then // COM2.
begin
pShMem^.FileHandle:=result;
end;
Hook[1].Change; {改引入表式可以不使用此语句}
end;

procedure SaveForWriteFile(const s;bytes:dword);
var
h:integer;
begin
if bytes=0 then exit;
if fileexists(pShMem^.DatToWriteFile) then
begin
h:=fileopen(pShMem^.DatToWriteFile,fmOpenWrite);
fileseek(h,0,2);
end
else h:=filecreate(pShMem^.DatToWriteFile);
if h=-1 then exit;
FileWrite(h,s,bytes);
FileClose(h);
end;

function NewWriteFile(hFile: THandle;const Buffer;nNumberOfBytesToWrite: DWORD;
var lpNumberOfBytesWritten: DWORD;lpOverlapped: POverlapped): BOOL;stdcall;
type
TWriteFile=function(hFile: THandle;const Buffer;nNumberOfBytesToWrite: DWORD;
var lpNumberOfBytesWritten: DWORD;lpOverlapped: POverlapped): BOOL;stdcall;
begin
Hook[2].Restore; {改引入表式可以不使用此语句}
result:=TWriteFile(hook[2].OldFunction)(hFile,Buffer,nNumberOfBytesToWrite,lpNumberOfBytesWritten,lpOverlapped);
if hFile=pShMem^.FileHandle then
SaveForWriteFile(buffer,nNumberOfBytesToWrite);
Hook[2].Change; {改引入表式可以不使用此语句}
end;

procedure SaveForReadFile(const s;bytes:dword);
var
h:integer;
begin
if bytes=0 then exit;
if fileexists(pShMem^.DatToReadFile) then
begin
h:=fileopen(pShMem^.DatToReadFile,fmOpenWrite or fmShareDenyNone);
fileseek(h,0,2);
end
else h:=FileCreate(pShMem^.DatToReadFile);
if h=-1 then exit;
FileWrite(h,s,bytes);
FileClose(h);
end;

function NewReadFile(hFile: THandle;var Buffer;nNumberOfBytesToRead: DWORD;
var lpNumberOfBytesRead: DWORD;lpOverlapped: POverlapped): BOOL;stdcall;
type
TReadFile=function(hFile: THandle;var Buffer;nNumberOfBytesToRead: DWORD;
var lpNumberOfBytesRead: DWORD;lpOverlapped: POverlapped): BOOL;stdcall;
var
s:string;
begin
Hook[3].Restore; {改引入表式可以不使用此语句}
result:=TReadFile(hook[3].OldFunction)(hFile,Buffer,nNumberOfBytesToRead,lpNumberOfBytesRead,lpOverlapped);
if hFile=pShMem^.FileHandle then
begin
SaveForReadFile(buffer,lpNumberOfBytesRead);
end;
Hook[3].Change; {改引入表式可以不使用此语句}
end;

function NewCloseHandle(hObject:THandle):BOOL;stdcall;
type
TCloseHandle=function(hObject:THandle):BOOL;stdcall;
begin
Hook[4].Restore; {改引入表式可以不使用此语句}
if (pShMem^.FileHandle=hObject)and(hObject<>INVALID_HANDLE_VALUE) then
begin
pShMem^.FileHandle:=INVALID_HANDLE_VALUE;
end;
result:=TCloseHandle(hook[4].OldFunction)(hObject);
Hook[4].Change; {改引入表式可以不使用此语句}
end;

function GetMsgProc(code: integer; wPar: integer; lPar: integer): Integer; stdcall;
begin
Result := CallNextHookEx(MessageHook, Code, wPar, lPar);
end;

procedure StartHook(FileBeSpy,readfile,writefilechar); stdcall;
begin
if MessageHook=0 then
begin
strlcopy(pShMem^.DatToWriteFile,writefile,255);
strlcopy(pShMem^.DatToReadFile,readfile,255);
strlcopy(pShMem^.ComPortFile,FileBeSpy,255);
MessageHook:=SetWindowsHookEx(WH_GetMessage, GetMsgProc, HInstance, 0);
end;
end;

procedure StopHook; stdcall;
begin
if MessageHook<>0 then
begin
UnhookWindowsHookEx(MessageHook);
MessageHook:=0;
SendMessage(HWND_BROADCAST,WM_SETTINGCHANGE,0,0);
end;
end;

initialization
hMappingFile := OpenFileMapping(FILE_MAP_WRITE,False,MappingFileName);
if hMappingFile=0 then
begin
hMappingFile := CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,0,SizeOf(TShareMem),MappingFileName);
FirstProcess:=true;
end
else FirstProcess:=false;
if hMappingFile=0 then Exception.Create('不能建立共享内存!');
pShMem := MapViewOfFile(hMappingFile,FILE_MAP_WRITE or FILE_MAP_READ,0,0,0);
if pShMem = nil then
begin
CloseHandle(hMappingFile);
Exception.Create('不能映射共享内存!');
end;
if FirstProcess then
begin
pShMem^.FileHandle:=INVALID_HANDLE_VALUE;
end;
MessageHook:=0;
Hook[0]:=THookClass.Create(Trap,@CreateFileA,@NewCreateFileA);{Trap=False改引入表式}
Hook[1]:=THookClass.Create(Trap,@CreateFileW,@NewCreateFileW);
Hook[2]:=THookClass.Create(Trap,@WriteFile,@NewWriteFile);
Hook[3]:=THookClass.Create(Trap,@ReadFile,@NewReadFile);
Hook[4]:=THookClass.Create(Trap,@CloseHandle,@NewCloseHandle);
finalization
Hook[0].Destroy;
Hook[1].Destroy;
Hook[2].Destroy;
Hook[3].Destroy;
Hook[4].Destroy;
UnMapViewOfFile(pShMem);
CloseHandle(hMappingFile);
end.


unit UnitNt2000Hook;

interface

uses classes, Windows,SysUtils, messages,dialogs;

type
TImportCode = packed record
JumpInstruction: Word;
AddressOfPointerToFunction: PPointer;
end;
PImage_Import_Entry = ^Image_Import_Entry;
Image_Import_Entry = record
Characteristics: DWORD;
TimeDateStamp: DWORD;
MajorVersion: Word;
MinorVersion: Word;
Name: DWORD;
LookupTable: DWORD;
end;
PImportCode = ^TImportCode;
TLongJmp = packed record
JmpCode: ShortInt; {指令，用$E9来代替系统的指令}
FuncAddr: DWORD; {函数地址}
end;

THookClass = class
private
Trap:boolean; {调用方式：True陷阱式，False改引入表式}
hProcess: Cardinal; {进程句柄，只用于陷阱式}
AlreadyHook:boolean; {是否已安装Hook，只用于陷阱式}
AllowChange:boolean; {是否允许安装、卸载Hook，只用于改引入表式}
Oldcode: array[0..4]of byte; {系统函数原来的前5个字节}
Newcode: TLongJmp; {将要写在系统函数的前5个字节}
private
public
OldFunction,NewFunctionointer;{被截函数、自定义函数}
constructor Create(IsTrap:boolean;OldFun,NewFunointer);
constructor Destroy;
procedure Restore;
procedure Change;
published
end;

implementation

{取函数的实际地址。如果函数的第一个指令是Jmp，则取出它的跳转地址（实际地址），这往往是由于程序中含有Debug调试信息引起的}
function FinalFunctionAddress(Code: Pointer): Pointer;
Var
func: PImportCode;
begin
Result:=Code;
if Code=nil then exit;
try
func:=code;
if (func.JumpInstruction=$25FF) then
{指令二进制码FF 25 汇编指令jmp [...]}
Func:=func.AddressOfPointerToFunction^;
result:=Func;
except
Result:=nil;
end;
end;

{更改引入表中指定函数的地址，只用于改引入表式}
function PatchAddressInModule(BeenDone:Tlist;hModule: THandle; OldFunc,NewFunc: Pointer):integer;
const
SIZE=4;
Var
Dos: PImageDosHeader;
NT: PImageNTHeaders;
ImportDesc: PImage_Import_Entry;
rva: DWORD;
Func: PPointer;
DLL: String;
f: Pointer;
written: DWORD;
mbi_thunk:TMemoryBasicInformation;
dwOldProtectWORD;
begin
Result:=0;
if hModule=0 then exit;
Dos:=Pointer(hModule);
{如果这个DLL模块已经处理过，则退出。BeenDone包含已处理的DLL模块}
if BeenDone.IndexOf(Dos)>=0 then exit;
BeenDone.Add(Dos);{把DLL模块名加入BeenDone}
OldFunc:=FinalFunctionAddress(OldFunc);{取函数的实际地址}

{如果这个DLL模块的地址不能访问，则退出}
if IsBadReadPtr(Dos,SizeOf(TImageDosHeader)) then exit;
{如果这个模块不是以'MZ'开头，表明不是DLL，则退出}
if Dos.e_magic<>IMAGE_DOS_SIGNATURE then exit;{IMAGE_DOS_SIGNATURE='MZ'}

{定位至NT Header}
NT :=Pointer(Integer(Dos) + dos._lfanew);
{定位至引入函数表}
RVA:=NT^.OptionalHeader.
DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].VirtualAddress;
if RVA=0 then exit;{如果引入函数表为空，则退出}
{把函数引入表的相对地址RVA转换为绝对地址}
ImportDesc := pointer(DWORD(Dos)+RVA);{Dos是此DLL模块的首地址}

{遍历所有被引入的下级DLL模块}
While (ImportDesc^.Name<>0) do
begin
{被引入的下级DLL模块名字}
DLL:=PChar(DWORD(Dos)+ImportDesc^.Name);
{把被导入的下级DLL模块当做当前模块，进行递归调用}
PatchAddressInModule(BeenDone,GetModuleHandle(PChar(DLL)),OldFunc,NewFunc);

{定位至被引入的下级DLL模块的函数表}
Func:=Pointer(DWORD(DOS)+ImportDesc.LookupTable);
{遍历被引入的下级DLL模块的所有函数}
While Func^<>nil do
begin
f:=FinalFunctionAddress(Func^);{取实际地址}
if f=OldFunc then {如果函数实际地址就是所要找的地址}
begin
VirtualQuery(Func,mbi_thunk, sizeof(TMemoryBasicInformation));
VirtualProtect(Func,SIZE,PAGE_EXECUTE_WRITECOPY,mbi_thunk.Protect);{更改内存属性}
WriteProcessMemory(GetCurrentProcess,Func,@NewFunc,SIZE,written);{把新函数地址覆盖它}
VirtualProtect(Func, SIZE, mbi_thunk.Protect,dwOldProtect);{恢复内存属性}
end;
If Written=4 then Inc(Result);
// else showmessagefmt('error:%d',[Written]);
Inc(Func);{下一个功能函数}
end;
Inc(ImportDesc);{下一个被引入的下级DLL模块}
end;
end;

{HOOK的入口，其中IsTrap表示是否采用陷阱式}
constructor THookClass.Create(IsTrap:boolean;OldFun,NewFunointer);
begin
{求被截函数、自定义函数的实际地址}
OldFunction:=FinalFunctionAddress(OldFun);
NewFunction:=FinalFunctionAddress(NewFun);

Trap:=IsTrap;
if Trap then{如果是陷阱式}
begin
{以特权的方式来打开当前进程}
hProcess := OpenProcess(PROCESS_ALL_ACCESS,FALSE, GetCurrentProcessID);
{生成jmp xxxx的代码，共5字节}
Newcode.JmpCode := ShortInt($E9); {jmp指令的十六进制代码是E9}
NewCode.FuncAddr := DWORD(NewFunction) - DWORD(OldFunction) - 5;
{保存被截函数的前5个字节}
move(OldFunction^,OldCode,5);
{设置为还没有开始HOOK}
AlreadyHook:=false;
end;
{如果是改引入表式，将允许HOOK}
if not Trap then AllowChange:=true;
Change; {开始HOOK}
{如果是改引入表式，将暂时不允许HOOK}
if not Trap then AllowChange:=false;
end;

{HOOK的出口}
constructor THookClass.Destroy;
begin
{如果是改引入表式，将允许HOOK}
if not Trap then AllowChange:=true;
Restore; {停止HOOK}
if Trap then{如果是陷阱式}
CloseHandle(hProcess);
end;

{开始HOOK}
procedure THookClass.Change;
var
nCount: DWORD;
BeenDone: TList;
begin
if Trap then{如果是陷阱式}
begin
if (AlreadyHook)or (hProcess = 0) or (OldFunction = nil) or (NewFunction = nil) then
exit;
AlreadyHook:=true;{表示已经HOOK}
WriteProcessMemory(hProcess, OldFunction, @(Newcode), 5, nCount);
end
else begin{如果是改引入表式}
if (not AllowChange)or(OldFunction=nil)or(NewFunction=nil)then exit;
BeenDone:=TList.Create; {用于存放当前进程所有DLL模块的名字}
try
PatchAddressInModule(BeenDone,GetModuleHandle(nil),OldFunction,NewFunction);
finally
BeenDone.Free;
end;
end;
end;

{恢复系统函数的调用}
procedure THookClass.Restore;
var
nCount: DWORD;
BeenDone: TList;
begin
if Trap then{如果是陷阱式}
begin
if (not AlreadyHook) or (hProcess = 0) or (OldFunction = nil) or (NewFunction = nil) then
exit;
WriteProcessMemory(hProcess, OldFunction, @(Oldcode), 5, nCount);
AlreadyHook:=false;{表示退出HOOK}
end
else begin{如果是改引入表式}
if (not AllowChange)or(OldFunction=nil)or(NewFunction=nil)then exit;
BeenDone:=TList.Create;{用于存放当前进程所有DLL模块的名字}
try
PatchAddressInModule(BeenDone,GetModuleHandle(nil),NewFunction,OldFunction);
finally
BeenDone.Free;
end;
end;
end;

end.

就没有人能够提个建议了？？？没有人遇到过这种情况吗？