〔200分〕Delphi 中如何用另外一个用户的身份来运行一人程序

Question

如一个程序要有以下的命令来运行
runas /env /savecred /user:hhql "c:\qlnetbar\bc2\bc2"
我现在的问题是如何在Delphi中用代码来代替 runas /env /savecred /user:hhql 的功能，因为我要监视 c:\qlnetbar\bc2\bc2 的运行情况，所以 c:\qlnetbar\bc2\bc2 必须要由我用Delphi写的程序来运行请高手指教。

Answer 1

找到运行"c:\qlnetbar\bc2\bc2"的命令所在路径就可以用winexec执行了啊.楼主还问如何使其他程序或命令不能运行"c:\qlnetbar\bc2\bc2"这个程序是吗?有点没懂.....

Answer 2

果你用XP或2000，可以用下面的API：CreateProcessWithLogonW
type
  _STARTUPINFOW = record
    cb: DWORD;
    lpReserved: LPWSTR;
    lpDesktop: LPWSTR;
    lpTitle: LPWSTR;
    dwX: DWORD;
    dwY: DWORD;
    dwXSize: DWORD;
    dwYSize: DWORD;
    dwXCountChars: DWORD;
    dwYCountChars: DWORD;
    dwFillAttribute: DWORD;
    dwFlags: DWORD;
    wShowWindow: Word;
    cbReserved2: Word;
    lpReserved2: PByte;
    hStdInput: THandle;
    hStdOutput: THandle;
    hStdError: THandle;
  end;
  STARTUPINFOW = _STARTUPINFOW;function CreateProcessWithLogonW(lpUserName, lpDomain, lpPassword: LPCWSTR;
  dwLogonFlags: DWORD; lpApplicationName: LPCWSTR; lpCommandLine: LPWSTR;
  dwCreationFlags: DWORD; lpEnvironment: Pointer; lpCurrentDirectory: LPCWSTR;
  const lpStartupInfo: STARTUPINFOW; var lpProcessInformation: PROCESS_INFORMATION): BOOL; stdcall;
  external advapi32 Name 'CreateProcessWithLogonW'procedure TForm1.Button2Click(Sender: TObject);
var
  STARTUPINFO: StartupInfoW;
  ProcessInfo: TProcessInformation;
  AUser, ADomain, APass, AExe: WideString;
const
  LOGON_WITH_PROFILE = $00000001;
  LOGON_NETCREDENTIALS_ONLY = $00000002;
begin
  FillChar(STARTUPINFO, SizeOf(StartupInfoW), #0);
  STARTUPINFO.cb := SizeOf(StartupInfoW);
  STARTUPINFO.dwFlags := STARTF_USESHOWWINDOW;
  STARTUPINFO.wShowWindow := SW_SHOW;
  AUser := edtUser.Text;
  ADomain := edtDomain.Text;
  APass := edtPass.Text;
  AExe := edtExe.Text;
  if not CreateProcessWithLogonW(PWideChar(AUser), PWideChar(ADomain),
    PWideChar(APass),
    LOGON_WITH_PROFILE, nil, PWideChar(AExe),
    NORMAL_PRIORITY_CLASS, nil, nil, STARTUPINFO, ProcessInfo) then
    RaiseLastOSError;
end;已经测试通过

Answer 3

请问楼上，我要用
runas /env /savecred /user:hhql "c:\qlnetbar\bc2\bc2"
来运行 "c:\qlnetbar\bc2\bc2" 然后监视 "c:\qlnetbar\bc2\bc2" 什么时候运行完毕，怎么办？？？？
请再指教一次哦

Answer 4

我也觉得是用 CreateProcessWithLogonW
里面有个参数
lpProcessInfo 的参数，访问其变量：hProcess用 waitforsingleObject(lpProcessInfo.hProcess) 可以等待 运行完毕

Answer 5

给个例子可以么，就是运行 runas /env /savecred /user:hhql "c:\qlnetbar\bc2\bc2" 然后等待 "c:\qlnetbar\bc2\bc2" 结束

Answer 6

代码修改了一下：unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;type
  _STARTUPINFOW = record
    cb: DWORD;
    lpReserved: LPWSTR;
    lpDesktop: LPWSTR;
    lpTitle: LPWSTR;
    dwX: DWORD;
    dwY: DWORD;
    dwXSize: DWORD;
    dwYSize: DWORD;
    dwXCountChars: DWORD;
    dwYCountChars: DWORD;
    dwFillAttribute: DWORD;
    dwFlags: DWORD;
    wShowWindow: Word;
    cbReserved2: Word;
    lpReserved2: PByte;
    hStdInput: THandle;
    hStdOutput: THandle;
    hStdError: THandle;
  end;
  STARTUPINFOW = _STARTUPINFOW;function CreateProcessWithLogonW(lpUserName, lpDomain, lpPassword: LPCWSTR;
  dwLogonFlags: DWORD; lpApplicationName: LPCWSTR; lpCommandLine: LPWSTR;
  dwCreationFlags: DWORD; lpEnvironment: Pointer; lpCurrentDirectory: LPCWSTR;
  const lpStartupInfo: STARTUPINFOW; var lpProcessInformation: PROCESS_INFORMATION): BOOL; stdcall;
  external advapi32 Name 'CreateProcessWithLogonW'
var
  Form1: TForm1;implementation{$R *.dfm}procedure TForm1.Button1Click(Sender: TObject);
var
  STARTUPINFO: StartupInfoW;
  ProcessInfo: TProcessInformation;
  AUser, ADomain, APass, AExe: WideString;
const
  LOGON_WITH_PROFILE = $00000001;
  LOGON_NETCREDENTIALS_ONLY = $00000002;
begin
  FillChar(STARTUPINFO, SizeOf(StartupInfoW), #0);
  STARTUPINFO.cb := SizeOf(StartupInfoW);
  STARTUPINFO.dwFlags := STARTF_USESHOWWINDOW;
  STARTUPINFO.wShowWindow := SW_SHOW;
  AUser := 'pcmax';
  //ADomain := edtDomain.Text;
  APass := 'pcmax';
  AExe := 'c:\windows\system32\mspaint.exe';
  if not CreateProcessWithLogonW(PWideChar(AUser), PWideChar(ADomain),
    PWideChar(APass),
    LOGON_WITH_PROFILE, nil, PWideChar(AExe),
    NORMAL_PRIORITY_CLASS, nil, nil, STARTUPINFO, ProcessInfo) then
    RaiseLastOSError;
  WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
  ShowMessage('over now');
end;end.

Answer 7

运行上面的代码，点击button1就会以用户pcmax运行 c:\windows\system32\mspaint.exe。然后等待运行结束后弹出提示对话框。