unit1.pas

DELPHI中开发系统钩子大全包括使用DLL和不使用DLL的多种方式.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls,registry;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    ComboBox1: TComboBox;
    Edit1: TEdit;
    Label2: TLabel;
    Edit2: TEdit;
    Label3: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
  procedure StartHook(FileBeSpy,readfile,writefile:pchar); stdcall;external 'ComTSRDLL';
  procedure StopHook; stdcall;external 'ComTSRDLL';
var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
   FileRead,FileWrite:string;
begin
   if button1.caption='开始' then
   begin
      button1.caption:='停止';
      FileRead:=edit1.text;
      FileWrite:=edit2.text;
      deletefile(FileRead);
      deletefile(FileWrite);
      StartHook(Pchar(combobox1.text),pchar(FileRead),pchar(FileWrite));
   end
   else begin
      StopHook;
      button1.caption:='开始';
   end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   if button1.caption<>'开始' then Button1Click(Sender);
end;

procedure GetCommList(CommList:TStrings);
var
   reg:tregistry;
   i:integer;
   s:string;
   list:TStringList;
begin
   List:=Tstringlist.create;
   reg:=tregistry.create;
   reg.RootKey:=HKEY_LOCAL_MACHINE;
   reg.OpenKey('Hardware\DeviceMap\SerialComm',true);
   reg.GetValueNames(List);
   for i:=0 to List.Count-1 do
   begin
      s:=List[i];
      if (s='')or(strlicomp(@s[1],'com',3)<>0) then
      begin
         s:=reg.ReadString(s);
         if (s='')or(strlicomp(@s[1],'com',3)<>0) then continue;
      end;
      commList.Add(s);
   end;
   reg.closekey;
   reg.free;
   List.free;
end;

procedure GetModemList(ModemList:TStrings);
const
   Path1='System\CurrentControlSet\Services\Class\Modem\';
   Path2='System\CurrentControlSet\Control\Class\{4D36E96D-E325-11CE-BFC1-08002BE10318}\';
var
   reg:tregistry;
   i:integer;
   list:TStringList;
   s:string;
begin
   List:=Tstringlist.create;
   reg:=tregistry.create;
   reg.RootKey:=HKEY_LOCAL_MACHINE;

   //Windows 9x
   if reg.openkey(Path1,false) then
   begin
      reg.GetKeyNames(List);
      reg.CloseKey;
      for i:=0 to List.count-1 do
      begin
         reg.openkey(Path1+List[i],true);
         if reg.ValueExists('model') then
            ModemList.add(reg.ReadString('model'));
         if reg.ValueExists('AttachedTo') then
         begin
            s:=reg.ReadString('AttachedTo');
            if (s='')or(strlicomp(@s[1],'com',3)<>0) then //
            else if ModemList.IndexOf(s)=-1 then ModemList.Add(s); 
         end;
         reg.closekey;
      end;
   end;

   //Windows XP
   if reg.openkey(Path2,false) then
   begin
      reg.GetKeyNames(List);
      reg.CloseKey;
      for i:=0 to List.count-1 do
      begin
         reg.openkey(Path2+List[i],true);
         if reg.ValueExists('FriendlyName') then
            ModemList.add(reg.ReadString('FriendlyName'));
         if reg.ValueExists('AttachedTo') then
         begin
            s:=reg.ReadString('AttachedTo');
            if (s='')or(strlicomp(@s[1],'com',3)<>0) then //
            else if ModemList.IndexOf(s)=-1 then ModemList.Add(s); 
         end;
         reg.closekey;
      end;
   end;
   reg.free;
   List.free;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
   GetCommList(combobox1.items);
   GetModemList(combobox1.items);
   if combobox1.Items.count>0 then
      combobox1.itemindex:=0;
end;

end.