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,writefile:pchar); 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,writefile:pchar); 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.