分享贴: delphi WIN32 Service 中启动另一个进程 (win7 win2003下测试通过）

｛

参考了以文章，感谢文章作者。

http://www.cnblogs.com/gnielee/archive/2010/04/08/1707169.html

http://www.java123.net/v/324099.html

开始按VC写的，发现有问题，后精简为C#版。

｝



｛导入的API｝

function WTSQueryUserToken(SessionId: DWORD; phToken: PHandle): Boolean; stdcall; external 'wtsapi32.dll';

function CreateEnvironmentBlock(lpEnvironment: PPVOID; hToken: THandle; bInherit: Boolean): Boolean; stdcall; external 'userenv.dll';



｛ 判断操作系统 ｝

function GetWindowsVersion: Double;

var

  Info: TOSVersionInfo;

begin

  FillChar(Info, sizeof(Info), 0);

  Info.dwOSVersionInfoSize := sizeof(OSVERSIONINFO);

  GetVersionExW(Info);

  Result := StrToFloat(Info.dwMajorVersion.ToString()+'.'+Info.dwMinorVersion.ToString());

end;



｛ 主体代码｝

function RunAppTest: Boolean;

var

  si: TStartupInfo;

  pi: TProcessInformation;

  hThisToken, hDuplicatedToken: THandle;

  SessionID: DWORD;



  TokenInfoClass: TTokenInformationClass;

  lpEnvironment: LPVOID;



  sa: TSecurityAttributes;

begin

  ZeroMemory(@si, SizeOf(si));

  ZeroMemory(@pi, Sizeof(pi));

  si.cb := SizeOf(si);

  si.lpDesktop := 'Winsta0\Default';



  SessionID := WTSGetActiveConsoleSessionId();

  b := WTSQueryUserToken(SessionID, @hThisToken);

  Log.Add('WTSQueryUserToken ' + B2S(b));



  b := DuplicateTokenEx(hThisToken, MAXIMUM_ALLOWED, @sa, SecurityIdentification, TokenPrimary, hDuplicatedToken);

  Log.Add('DuplicateTokenEx ' + B2S(b));



  b := CreateEnvironmentBlock(@lpEnvironment, hDuplicatedToken, False);

  Log.Add('CreateEnvironmentBlock ' + B2S(b));





  b := CreateProcessAsUserW( hDuplicatedToken,

                             'calc.exe',

                             nil,

                             @sa,

                             nil,

                             False,

                             NORMAL_PRIORITY_CLASS or CREATE_NEW_CONSOLE or CREATE_UNICODE_ENVIRONMENT,

                             lpEnvironment,

                             'c:\windows\system32',

                             si,

                             pi );



  Log.Add('CreateProcessAsUserW ' + B2S(b));

  { CloseHandle 代码 略 }

end;

补充信息：
1 网上搜的系统版本号
{
4.0 win95 4.10 win98 4.90 win_me 3.51 win_Nt_3_5 5.0 win2000 5.1 win_xp 5.2 win2003 6.0 vista 6.1 win7 6.2 win8
}
2 服务线程中切换
if GetWindowsVersion<6.0 then
WinExec('c:\windows\system32\notepad.exe', SW_SHOWNORMAL)
else
RunAppTest;
3 Service 的 Interactive属性 置为 true （win2003下需要）

昨晚在网上没搜到现成的代码，只好花了点时间自己来转为D的代码，希望对需要的人有所帮助以节省时间。