串口监视程序

Question

各位大虾：我需要写一个串口监视程序，当串口收到指定信息时循环开启两个不同的程序（这两个程序不是本人开发，无源码，只有一个串口可用，这两个程序都使用同一个串口与硬件通讯）。本人对DELPHI不太熟悉，在网上找了一些DLL源码（原文说是在95/98上使用的，我需要在XP下使用），目前该源码可以监视串口，并循环开启程序。但发现监视程序在被监视程序启动时不能直接监视串口（串口在程序启动时已经同时开启），只有在被监视程序关闭串口并再次打开后才能进行监视。看了很久，都不知道是哪里出问题了，请各位指点一下。//ComTSRDLL.DLL源码：library ComTSRDLL;{%File 'ModelSupport\UnitWJSHook\UnitWJSHook.txvpck'}
{%File 'ModelSupport\UnitDllMain\UnitDllMain.txvpck'}
{%File 'ModelSupport\default.txvpck'}uses
  SysUtils,
  windows,
  Classes,
  UnitWJSHook in 'UnitWJSHook.pas',
  UnitDllMain in 'UnitDllMain.pas';{$R *.RES}exports StartHook,StopHook;begin
  DllProc := @DllEntry;
  DllEntry(DLL_PROCESS_ATTACH);
end.

Answer 1

//UnitDllMain.pas源码：
unit UnitDllMain;interfaceuses
    windows,
    Messages,
    Unitwjshook,
    Sysutils,
    dialogs,
    TlHelp32,
    Classes;const
   MappingFileName = 'Mapping File Comm DLL';
   //需要循环开启的文件路径及名称
   strPathNameA='D:\Windows\System32\';
   StrPathNameB='D:\Windows\System32\';
   strFileNameA='CalC.exe';
   strFileNameB='NotePad.exe';type
  TShareMem = packed record
    ComPortFile:array[0..255] of char;
    FileHandle:THandle;
    DatToWriteFile:array[0..255] of char;
    DatToReadFile:array[0..255] of char;
    MessageHook: HHOOK;
  end;
  PShareMem = ^TShareMem;procedure StartHook(FileBeSpy,readfile,writefile:pchar); stdcall;
procedure StopHook; stdcall;
procedure DllEntry(nReason : integer);implementationvar
  pShMem : PShareMem;
  hMappingFile : THandle;
  hook:array[0..3]of HookStruct;
  FirstProcess:boolean;
  bolDorS:boolean;function NewCreateFileA(lpFileName: PChar;dwDesiredAccess: Integer;dwShareMode: Integer;
   lpSecurityAttributes: PSecurityAttributes;dwCreationDisposition: DWORD;dwFlagsAndAttributes: DWORD;
   hTemplateFile: THandle): THandle;stdcall;
type
  TCreateFileA=function(lpFileName: PChar;dwDesiredAccess: Integer;dwShareMode: Integer;
   lpSecurityAttributes: PSecurityAttributes;dwCreationDisposition: DWORD;dwFlagsAndAttributes: DWORD;
   hTemplateFile: THandle): THandle;stdcall;
begin
   result:=TCreateFileA(hook[0].OldFunction)(lpFileName,dwDesiredAccess,dwShareMode,
      lpSecurityAttributes,dwCreationDisposition,dwFlagsAndAttributes,
      hTemplateFile);   if stricomp(lpFileName,pShMem^.ComPortFile)=0 then
   begin
      pShMem^.FileHandle:=result;
      //FlushViewOfFile(pShMem,0);
   end;
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
   result:=TWriteFile(hook[1].OldFunction)(hFile,Buffer,nNumberOfBytesToWrite,lpNumberOfBytesWritten,lpOverlapped);
   //读到写文件句柄时什么都不干
 end; function Kill_Task(ExeFileName: string):integer;
const
  PROCESS_TERMINATE=$0001; //进程的PROCESS_TERMINATE访问权限
var
  ContinueLoop: BOOL;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
begin
  result:= 0;
  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); //获取系统所有进程快照
  FProcessEntry32.dwSize := Sizeof(FProcessEntry32);  //调用Process32First前用Sizeof(FProcessEntry32)填充FProcessEntry32.dwSize
  ContinueLoop := Process32First(FSnapshotHandle,FProcessEntry32); //获取快照中第一个进程信息并保存到FProcessEntry32结构体中
  while integer(ContinueLoop) <> 0 do //循环枚举快照中所有进程信息
  begin
    if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile))=UpperCase(ExeFileName))
      or (UpperCase(FProcessEntry32.szExeFile)=UpperCase(ExeFileName))) then  //找到要中止的进程名
       Result := Integer(TerminateProcess(OpenProcess(PROCESS_TERMINATE, BOOL(0),FProcessEntry32.th32ProcessID), 0));     //中止进程
       ContinueLoop := Process32Next(FSnapshotHandle,FProcessEntry32); //查找下一个符合条件进程
  end;
end;procedure ChangeFileForReadFile();
  begin
      if bolDorS then
        begin
           bolDorS:=false;
           Kill_Task(strFileNameA);
           winexec(strPathNameB+strFileNameB, SW_SHOWNORMAL);
        end
      else
        begin
          bolDorS:=true;
          Kill_Task(strFileNameB);
          winexec(strPathNameA+strFileNameA, SW_SHOWNORMAL);
        end;
  end;procedure CheckForReadFile(Const s;bytes:DWord); //读到读文件句柄时调用本函数
  var
      strDataCheck:String;  begin
      if bytes=0 then exit;
      strDataCheck:=IntToHex(Integer(s),2);
      if strDataCheck='00' then
        begin
             ChangeFileForReadFile();
        end;
  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;
begin
   result:=TReadFile(hook[2].OldFunction)(hFile,Buffer,nNumberOfBytesToRead,lpNumberOfBytesRead,lpOverlapped);
   if hFile=pShMem^.FileHandle then   //读到读文件句柄
    begin
        CheckForReadFile(buffer,nNumberofBytesToRead);
    end;
end;function NewCloseHandle(hObject:THandle):BOOL;stdcall;
type
  TCloseHandle=function(hObject:THandle):BOOL;stdcall;
begin
   if (pShMem^.FileHandle=hObject)and(hObject<>INVALID_HANDLE_VALUE) then
   begin
      pShMem^.FileHandle:=INVALID_HANDLE_VALUE;
      //FlushViewOfFile(pShMem,0);
   end;
   result:=TCloseHandle(hook[3].OldFunction)(hObject);
end;function GetMsgProc(iCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;export;
begin
  Result := CallNextHookEx(pShmem^.MessageHook, iCode, wParam, lParam);
end;procedure StartHook(FileBeSpy,readfile,writefile:pchar); stdcall;
begin
   strlcopy(pShMem^.DatToWriteFile,writefile,255);
   strlcopy(pShMem^.DatToReadFile,readfile,255);
   strlcopy(pShMem^.ComPortFile,FileBeSpy,255);
   pShmem^.MessageHook:=SetWindowsHookEx(WH_GETMESSAGE, @GetMsgProc, HInstance, 0);
   //FlushViewOfFile(pShmem,0);
end;procedure StopHook; stdcall;
begin
   if pShmem^.MessageHook=0 then exit;
   UnhookWindowsHookEx(pShmem^.MessageHook);
   pShmem^.MessageHook:=0;
end;procedure DllEntry(nReason : integer);
begin
  case nReason Of
    DLL_PROCESS_ATTACH:
    begin
        bolDorS:=true;
        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^.MessageHook:=0;
           pShMem^.FileHandle:=INVALID_HANDLE_VALUE;
        end;
        //注意：getprocaddress(getmodulehandle('kernel32'),'CreateFileA')<>@CreateFileA
        //虽然它们都指向Kernel32的CreateFileA的代码，在本例中也可以用getprocaddress...，但必须注意大小写
        hook[0].OldFunction:=FinalFunctionAddress(@CreateFileA);
        hook[0].NewFunction:=FinalFunctionAddress(@NewCreateFileA);
        HookAPIFunction(hook[0]);        hook[1].OldFunction:=FinalFunctionAddress(@WriteFile);
        hook[1].NewFunction:=FinalFunctionAddress(@NewWriteFile);
        HookAPIFunction(hook[1]);        hook[2].OldFunction:=FinalFunctionAddress(@ReadFile);
        hook[2].NewFunction:=FinalFunctionAddress(@NewReadFile);
        HookAPIFunction(hook[2]);        hook[3].OldFunction:=FinalFunctionAddress(@CloseHandle);
        hook[3].NewFunction:=FinalFunctionAddress(@NewCloseHandle);
        HookAPIFunction(hook[3]);
    end;
    DLL_PROCESS_DETACH:
    begin
        UnHookAPIFunction(hook[0]);
        UnHookAPIFunction(hook[1]);
        UnHookAPIFunction(hook[2]);
        UnHookAPIFunction(hook[3]);
        UnMapViewOfFile(pShMem);
        CloseHandle(hMappingFile);
    end;
  end;
end;end.

Answer 2

//UnitWJSHook.pas源码:unit UnitWJSHook;interfaceuses classes,Windows,messages;
type
  PPointer = ^Pointer;
  TImportCode = packed record
    JumpInstruction: Word; // should be $25FF  即 FF 25
    AddressOfPointerToFunction: PPointer;
  end;
  PImportCode = ^TImportCode;  PImage_Import_Entry = ^Image_Import_Entry;
  Image_Import_Entry = record
    Characteristics: DWORD;
    TimeDateStamp: DWORD;
    MajorVersion: Word;
    MinorVersion: Word;
    Name: DWORD;
    LookupTable: DWORD;
  end;  HookStruct = record
     OldFunction,NewFunction:Pointer;
  end;
  function FinalFunctionAddress(Code: Pointer): Pointer;
  procedure HookAPIFunction(hook:HookStruct);
  procedure UnHookAPIFunction(hook:HookStruct);implementationfunction FinalFunctionAddress(Code: Pointer): Pointer;
//取函数的实际地址
//如果函数的第一个指令是Jmp指令，则取出它的跳转地址（实际地址）
Var
  func: PImportCode;
begin
  Result:=Code;
  if Code=nil then exit;
  try
    func:=code;
    if (func.JumpInstruction=$25FF) then begin
      //指令二进制码FF 25  汇编指令jmp [...]
      Result:=func.AddressOfPointerToFunction^;
    end;
  except
    Result:=nil;
  end;
end;function PatchAddressInModule(BeenDone:Tlist;hModule: THandle; OldFunc,NewFunc: Pointer):integer;
Var
   Dos: PImageDosHeader;
   NT: PImageNTHeaders;
   ImportDesc: PImage_Import_Entry;
   rva: DWORD;
   Func: PPointer;
   DLL: String;
   f: Pointer;
   written: DWORD;
begin
  Result:=0;
  if hModule=0 then exit;
  Dos:=Pointer(hModule);
  // 如果这个模块已经处理过，就退出。BeenDone包含已处理的模块。
  if BeenDone.IndexOf(Dos)>=0 then exit;
  BeenDone.Add(Dos); //把模块名加入BeenDone  OldFunc:=FinalFunctionAddress(OldFunc);  //取函数的实际地址
  //如果对这个模块没有读的权限，则退出。
  if IsBadReadPtr(Dos,SizeOf(TImageDosHeader)) then exit;
  //如果这个模块不是以'MZ'开头，表明不是EXE、DLL，则退出。
  if Dos.e_magic<>IMAGE_DOS_SIGNATURE then exit; //IMAGE_DOS_SIGNATURE='MZ'  //windows的PE文件(EXE、DLL)分为DOS、Windows两个部分。
  //._lfanew是PE文件中Windows部分的起始地址。
  NT :=Pointer(Integer(Dos) + dos._lfanew);
  //if IsBadReadPtr(NT,SizeOf(TImageNtHeaders)) then exit;
  //找出这个模块调用了其它DLL的哪些函数
  RVA:=NT^.OptionalHeader.   //模块windows部分的第三小部分OptionalHeader
     DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].  //中的函数引用表
         VirtualAddress; //的入口地址
  if RVA=0 then exit; //如果没有调用，则退出。  ImportDesc := pointer(DWORD(Dos)+RVA); //求函数引用表的绝对地址，RVA只是相对地址
  While (ImportDesc^.Name<>0) do //历遍所有被引用的DLL模块
  begin
    DLL:=PChar(DWORD(Dos)+ImportDesc^.Name); //被当前模块引用的DLL模块名字
    //嵌套调用本函数，历遍DLL相互交差引用函数的网状结构
    //把这个被引用的DLL当作当前模块，重复以上过程
    PatchAddressInModule(BeenDone,GetModuleHandle(PChar(DLL)),OldFunc,NewFunc);    //找出被引用的DLL模块的每一个功能函数
    Func:=Pointer(DWORD(DOS)+ImportDesc.LookupTable);
    While Func^<>nil do //历遍被引用的DLL模块的所有功能函数
    begin
      f:=FinalFunctionAddress(Func^); //取实际地址
      if f=OldFunc then //如果函数实际地址就是所要找的地址
         WriteProcessMemory(GetCurrentProcess,Func,@NewFunc,4,written); //把新函数地址覆盖它
      If Written>0 then Inc(Result);
      Inc(Func); //下一个功能函数
    end;
    Inc(ImportDesc); //下一个DLL模块
  end;
end;procedure HookAPIFunction(hook:HookStruct);
Var
 BeenDone: TList;
begin
  if (hook.NewFunction=nil)or(hook.OldFunction=nil)then exit;
  BeenDone:=TList.Create; //用于存放所有模块的名字
  try
    PatchAddressInModule(BeenDone,GetModuleHandle(nil),hook.OldFunction,hook.NewFunction);
  finally
    BeenDone.Free;
  end;
end;procedure UnHookAPIFunction(hook:HookStruct);
Var
 BeenDone: TList;
begin
  if (hook.NewFunction=nil)or(hook.OldFunction=nil)then exit;
  BeenDone:=TList.Create; //用于存放所有模块的名字
  try
    PatchAddressInModule(BeenDone,GetModuleHandle(nil),hook.NewFunction,hook.OldFunction);
  finally
    BeenDone.Free;
  end;
end;end.

Answer 3

或者如果你有功能差不多的源码，可以发往这个邮箱：[email protected]