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

本人最近在做一个服务，服务中启动另一个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

11 个解决方案

#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');//这里填写操作系统的用户名与密码

这个方法不行，不能启动程序。

#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;

#3

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

#4

引用 3 楼 oushengfen的回复:

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

2016可以，哈哈哈呵呵呵

#5

ShellExcute不行吗

#6

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

#7

引用 2 楼 pzhbdexxend 的回复:

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;

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

#8

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

#9

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

#10

引用 4 楼 weixin_42223394 的回复:

Quote: 引用 3 楼 oushengfen的回复:

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

2016可以，哈哈哈呵呵呵

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

#11

引用 7 楼 oushengfen 的回复:

Quote: 引用 2 楼 pzhbdexxend 的回复:

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;

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

可以使用的！程序要给管理权限！