如何在CreateDesktop api创建的新桌面中看到GUI软件?

时间:2016-11-23 18:33:09

标签: delphi winapi

我有一个客户端 - 服务器软件,我可以执行我的Client.dll(通过dll注入方法),使用CreateDesktop api创建的新桌面,但我只能看到一个白色服务器端的屏幕。

enter image description here

所以,我问你。 - 如何在新桌面上执行任何程序并查看此程序而不是此白屏?

这是我的代码,用于创建新桌面并执行Client.dll并使用新桌面(使用dll注入方法):

Client.dll

procedure ExecNewProcess(ProgramName : String; Desktop : String);
var
  StartInfo  : TStartupInfo;
  ProcInfo   : TProcessInformation;
  CreateOK   : Boolean;
begin

  FillChar(StartInfo,SizeOf(TStartupInfo),#0);
  FillChar(ProcInfo,SizeOf(TProcessInformation),#0);
  StartInfo.cb := SizeOf(TStartupInfo);
  StartInfo.lpDesktop := PChar('WinSta0' + '\' + Desktop);

  CreateOK := CreateProcess(PChar(ProgramName),nil, nil, nil,False,
              CREATE_NEW_PROCESS_GROUP+NORMAL_PRIORITY_CLASS,
              nil, nil, StartInfo, ProcInfo);
end;

procedure TForm1.CS1Read(Sender: TObject; Socket: TCustomWinSocket);
var
  HDesktopglobal: HDESK;
  sDesktopName : String;
  StrCommand: string;

  begin
  StrCommand := Socket.ReceiveText;

  {=========================================== Server.exe requesting "Desktop creation" ==========================================}

   if Pos('<|NEWDESK|>', StrCommand) > 0 then
  begin
    try

    sDesktopName := 'TimeUpDesktop';

    HDesktopglobal := CreateDesktop(PWideChar(sDesktopName), nil, nil, 0, GENERIC_ALL, nil);

    ExecNewProcess(GetEnvironmentVariable('appdata') + '\' + 'Injector.exe', sDesktopName); // Injector.exe will be executed in Winta0\TimeUpDesktop,
                                                                                           //Will execute "MyExec.exe" and then will inject my dll ( Client.dll ).

    KillOwnProcess;  //Kill "MyExec.exe" that already is running, to prevent fails to inject dll.

   except
  end;

  end;

  {================================================================================================================================}

 end;

版:

为了更好地理解我在客户端服务器(客户端作为可执行文件)的示例下面提出的这个问题,其中服务器向客户端发送命令(&#39; NEWDESK&#39;),以便客户端在新桌面中执行

服务器:

uses
 Jpeg, ScktComp;

var
  Form1: TForm1;

stSize: integer;
Stream: TMemoryStream;
Receiving: boolean;
jpg: TJpegImage; 

implementation

{$R *.dfm}

procedure TForm1.ServerSocket1ClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
var
Item: TListItem;
begin
Item := ListView1.Items.Add;
Item.Caption := IntTostr(socket.Handle);
Item.SubItems.Add(Socket.RemoteAddress);
Item.SubItems.Add(socket.RemoteHost);
Item.Data := Socket.Data;
end;

procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
var
Item: TListItem;
begin
Item:= ListView1.FindCaption(0, inttostr(socket.Handle), false, true, false);
if item <> nil then
Item.Delete;

end;

procedure TForm1.ServerSocket1ClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
showmessage('erro');
ErrorCode := 0;
end;

procedure TForm1.Ativar1Click(Sender: TObject);
begin
ServerSocket1.Active := true;
end;

procedure TForm1.Desativar1Click(Sender: TObject);
begin
ServerSocket1.Active := false;
end;

procedure TForm1.Foto1Click(Sender: TObject);
begin
if ListView1.Selected = nil then exit;
ServerSocket1.Socket.Connections[ListView1.ItemIndex].SendText('screen');
end;

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
s: string;
begin  
s:=Socket.ReceiveText;
if not Receiving then
begin
if pos(#0,s) > 0 then
stSize:=strtoint(copy(s,1,pos(#0,s)-1))
else
exit;
Stream:=TMemoryStream.Create;
Receiving:=True;
delete(s,1,pos(#0,s));
end;
try
Stream.Write(s[1],length(s));
if Stream.Size = stSize then
begin
Stream.Position:=0;
Receiving:=False;
jpg:=TJPEGImage.Create;
jpg.LoadFromStream(Stream);
Image1.Picture.Assign(jpg);
Stream.Free;
end;
except
Stream.Free;
exit
end;
end;

procedure TForm1.NewDesktop1Click(Sender: TObject);
begin
if ListView1.Selected = nil then exit;
ServerSocket1.Socket.Connections[ListView1.ItemIndex].SendText('NEWDESK');
end;

客户端:

uses
 TlHelp32, Jpeg, ScktComp;

var
  Form1: TForm1;
  Stream: TMemoryStream;

implementation

{$R *.dfm}

procedure ExecNewProcess(ProgramName : String; Desktop : String);
var
  StartInfo  : TStartupInfo;
  ProcInfo   : TProcessInformation;
  CreateOK   : Boolean;
begin

  FillChar(StartInfo,SizeOf(TStartupInfo),#0);
  FillChar(ProcInfo,SizeOf(TProcessInformation),#0);
  StartInfo.cb := SizeOf(TStartupInfo);
  StartInfo.lpDesktop := PChar('WinSta0' + '\' + Desktop);

  CreateOK := CreateProcess(PChar(ProgramName),nil, nil, nil,False,
              CREATE_NEW_PROCESS_GROUP+NORMAL_PRIORITY_CLASS,
              nil, nil, StartInfo, ProcInfo);

              //ShowMessage(BoolToStr(CreateOK));
end;

procedure KillOwnProcess;
var
  hShot: THandle;
  pe: TProcessEntry32;
  curPid: dword;
  hProc: THandle;
begin
  hShot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  if hShot <> INVALID_HANDLE_VALUE then
  begin

    curPid := GetCurrentProcessId;

    try
      ZeroMemory(@pe, sizeof(pe));
      pe.dwSize := sizeof(pe);
      if Process32First(hShot, pe) then
        repeat
          if LowerCase(pe.szExeFile) = 'Client.exe' then  // Name for this executable
          begin
            if pe.th32ProcessID = curPid then
            begin
              hProc := OpenProcess(PROCESS_TERMINATE, false, pe.th32ProcessID);
              if hProc <> 0 then
              begin
                TerminateProcess(hProc, 0);
                CloseHandle(hProc);
              end
              else
                  ; // failed
            end;
          end;
        until not Process32Next(hShot, pe);
    finally
      CloseHandle(hShot);
    end;
  end;
end;

function GetScreenShot: TJPEGImage;
var
Desktop: HDC;
bmp: TBitmap;
begin
Result:=TJPEGImage.Create;
bmp := TBitmap.Create;
Desktop := GetDC(0);
try try
bmp.PixelFormat := pf32bit;
bmp.Width := Screen.Width;
bmp.Height := Screen.Height;
BitBlt(bmp.Canvas.Handle, 0, 0, bmp.Width, bmp.Height, Desktop, 0, 0, SRCCOPY);
bmp.Modified := True;
Result.Assign(bmp);
finally
ReleaseDC(0, Desktop);
end;
except
bmp.Free;
bmp := nil;
Result.Free;
Result:=nil;
end;
end;

procedure TForm1.ClientSocket1Connect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
Label1.Caption := 'CONNECTED';
end;

procedure TForm1.ClientSocket1Connecting(Sender: TObject;
  Socket: TCustomWinSocket);
begin
Label1.Caption := 'CONNECTING...';
end;

procedure TForm1.ClientSocket1Disconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
Label1.Caption := 'DESCONECTED';
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
if not ClientSocket1.Active then
ClientSocket1.Active := true;
end;

procedure TForm1.ClientSocket1Error(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
ErrorCode := 0;
end;

procedure TForm1.ClientSocket1Read(Sender: TObject;
  Socket: TCustomWinSocket);
var
s: string;
Stream: TMemoryStream;
jpg: TJPEGImage;
HDesktopglobal: HDESK;
sDesktopName : String;

begin
s:=Socket.ReceiveText;

if s = 'screen' then
begin
Stream:=TMemoryStream.Create;
jpg:=TJPEGImage.Create;
jpg:=GetScreenShot;
jpg.SaveToStream(Stream);
Stream.Position:=0;
Socket.SendText(inttostr(Stream.Size) + #0);
Socket.SendStream(Stream);
end;

if s = 'NEWDESK' then
begin

   try

    sDesktopName := 'TimeUpDesktop';

    HDesktopglobal := CreateDesktop(PChar(sDesktopName), nil, nil, 0, GENERIC_ALL, nil);

    ExecNewProcess(ExtractFilePath(Application.ExeName)+ 'Client.exe', sDesktopName); // Execute this exe to new desktop
    KillOwnProcess; // Kill old instance of this executable ( present on original desktop )

   except
   on E : Exception do
   begin
     ShowMessage(E.ClassName);
     ShowMessage(E.Message);
   end;
  end;

end;

end;

0 个答案:

没有答案