服务启动另一个程序无界面的问题。

Question

本人最近在做一个服务，服务中启动另一个exe程序，但启动后没有界面，查找了很多资料，但是编译都不成功。请高手指教 一下。
{Function GetProcessHandleAsName(Name:String):THandle;
Var
  Hd,Hs:THandle;
  dExit:Cardinal;
  Tmp,Tmp1:String;
  Lp:TProcessEntry32;
begin
  Result:=0;
  Lp.dwSize:=sizeof(TProcessEntry32);
  Hd:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
  if Process32First(Hd,Lp) then
    Repeat
      Tmp:=UpperCase(Trim(Name));
      Tmp1:=Trim(UpperCase(Lp.szExeFile));
  if AnsiPos(Tmp,Tmp1)> 0   then
  begin
    Result:=OpenProcess(PROCESS_ALL_ACCESS,true,Lp.th32ProcessID);
    break;
  end
  Until Process32Next(Hd,Lp)=False;
end;Function CreateProc(ProcessName:String):boolean;
Var
  siStartupInfo:STARTUPINFO;
  saProcess,saThread:SECURITY_ATTRIBUTES;
  piProcInfo:PROCESS_INFORMATION;
  Hd:NativeInt;
  ProcessHd:THandle;
  Hds:THandle;
  Str:String;
begin
  Result := false;
  ProcessHd:=GetProcessHandleAsName('Explorer');
  if ProcessHd=0 then Exit;
  if OpenProcessToken(ProcessHd,TOKEN_ALL_ACCESS,Hds)   then
  if DuplicateTokenEx(Hds,TOKEN_ALL_ACCESS,nil,SecurityIdentification,TokenPrimary,hd) then
  begin
    ZeroMemory(@siStartupInfo,sizeof(siStartupInfo));
    siStartupInfo.cb:=sizeof(siStartupInfo);
    saProcess.nLength:=sizeof(saProcess);
    saProcess.lpSecurityDescriptor:=nil;
    saProcess.bInheritHandle:=false;
    saThread.nLength:=sizeof(saThread);
    saThread.lpSecurityDescriptor:=nil;
    saThread.bInheritHandle:=false;
    if CreateProcessAsUser(Hd,nil,PChar(ProcessName),nil,nil,false,
        CREATE_DEFAULT_ERROR_MODE,nil,nil,siStartupInfo,piProcInfo) then
      Result := true;
  end;
end;}if DuplicateTokenEx(Hds,TOKEN_ALL_ACCESS,nil,SecurityIdentification,TokenPrimary,hd) then[dcc32 Error] Unit1.pas(113): E2033 Types of actual and formal var parameters must be identical

Answer 1

另一个方法，则无效function CreateProcessWithLogonW(
  lpUsername,                 // user's name
  lpDomain,                   // user's domain
  lpPassword:PWideChar;       // user's password
  dwLogonFlags:dword;         // logon option
  lpApplicationName: PWideChar;
  lpCommandLine: PWideChar;
  dwCreationFlags: DWORD;
  lpEnvironment: Pointer;
  lpCurrentDirectory: PWideChar;
  const lpStartupInfo: tSTARTUPINFO;
  var lpProcessInformation: TProcessInformation
  ): BOOL; stdcall;external  'advapi32.dll';Function RunAsUser(const filename,username,password:string):boolean;
var
  StartupInfo: tStartupInfo;
  ProcessInfo: TProcessInformation;
  wfilename,wusername,wpassword:pwidechar;
begin
  FillChar (StartupInfo, SizeOf(StartupInfo), #0);
  StartupInfo.cb := SizeOf(StartupInfo);
  StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
  StartupInfo.wShowWindow := SW_SHOWNORMAL;
  GetMem( wfilename, Length( filename ) * SizeOf( WideChar ) + SizeOf(
WideChar ) ) ;
  GetMem( wusername, length(username) * SizeOf( WideChar ) + SizeOf(
WideChar ) ) ;
  GetMem( wpassword, length(password) * SizeOf( WideChar ) + SizeOf(
WideChar ) ) ;
  StringToWideChar( filename, wfilename, Length( filename ) * SizeOf(
WideChar ) + SizeOf( WideChar ) ) ;
  StringToWideChar( username, wusername, Length( username ) * SizeOf(
WideChar ) + SizeOf( WideChar ) ) ;
  StringToWideChar( password, wpassword, Length( password ) * SizeOf(
WideChar ) + SizeOf( WideChar ) ) ;
  result:=CreateProcessWithLogonW(wusername,nil,wpassword,0, wfilename, nil,
0, nil, nil,StartupInfo , ProcessInfo);
  freemem(wfilename);
  freemem(wusername);
  freemem(wpassword);
end;RunAsUser(strPath,'user','pass');//这里填写操作系统的用户名与密码这个方法不行，不能启动程序。

Answer 2

function RunProcess(const ProcessName: String): Boolean;
  function CheckProcessHd(const aFileName: string): THandle;
  var
    hSnapshot: THandle;
    lppe: TProcessEntry32;
    Found: Boolean;
  begin
    Result := 0;
    hSnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
    lppe.dwSize := sizeof(TProcessEntry32);
    Found := Process32First(hSnapshot, lppe);
    while Found do
    begin
      if ((UpperCase(ExtractFileName(lppe.szExeFile)) = UpperCase(aFileName)) or
        (UpperCase(lppe.szExeFile) = UpperCase(aFileName))) then
      begin
        Result := OpenProcess(PROCESS_ALL_ACCESS, true, lppe.th32ProcessID);
        CloseHandle(hSnapshot);
        Exit;
      end;
      Found := Process32Next(hSnapshot, lppe);
    end;
    CloseHandle(hSnapshot);
  end;Var
  siStartupInfo: STARTUPINFO;
  saProcess, saThread: SECURITY_ATTRIBUTES;
  piProcInfo: PROCESS_INFORMATION;
  // Hd: Cardinal;
  HD: THandle;
  ProcessHd: THandle;
  Hds: THandle;
  // Str: String;
begin
  Result := False;
  if not FileExists(ProcessName) then
  begin
    Exit;
  end;
  ProcessHd := CheckProcessHd('explorer.exe');
  if ProcessHd = 0 then
    Exit;
  if OpenProcessToken(ProcessHd, TOKEN_ALL_ACCESS, Hds) then
  begin
    { if DuplicateTokenEx(Hds, TOKEN_ALL_ACCESS, nil, SecurityIdentification,
      TokenPrimary, Hd) then }
    if DuplicateTokenEx(Hds, TOKEN_ALL_ACCESS, nil, SecurityIdentification,
      TokenPrimary, HD) then
    begin
      ZeroMemory(@siStartupInfo, sizeof(siStartupInfo));
      siStartupInfo.cb := sizeof(siStartupInfo);
      saProcess.nLength := sizeof(saProcess);
      saProcess.lpSecurityDescriptor := nil;
      saProcess.bInheritHandle := False;
      saThread.nLength := sizeof(saThread);
      saThread.lpSecurityDescriptor := nil;
      saThread.bInheritHandle := False;
      Result := CreateProcessAsUser(HD, nil, PChar(ProcessName), nil, nil,
        False, CREATE_DEFAULT_ERROR_MODE, nil, nil, siStartupInfo, piProcInfo);
    end;
  end;
end;

Answer 3

你好，你这个在win10,2008，2012，企业版，数据中心版，试验过？

Answer 4

ShellExcute不行吗

Answer 5

服务是工作在 winlogon 桌面的，你的用户桌面当然看不到咯，正是这个原因，一些网络服务的软件（主要也是个服务）都会通过一个端口（发给自己127.0.0.1）实现用户的配置的。

Answer 6

这段代码在win7下是可以的，但2008，2012，WIN10是不行的。

Answer 7

调用CreateProcessAsUser的进程必须有SE_INCREASE_QUOTA_NAME权限，可以使用OpenProcessToken、AdjustTokenPrivileges修改

Answer 8

服务启动，写注册，设置exe为开机启动。

Answer 9

2016可以，哈哈哈呵呵呵WIN2008、WIN2012 下可以使用的，程序要有管理权限。

Answer 10

这段代码在win7下是可以的，但2008，2012，WIN10是不行的。可以使用的！程序要给管理权限！

Answer 11

楼主现在还在搞delphi吗？坚持这么多年真是不容易。