var 
  Form1: TForm1; 
 
  function CreateProcessWithLogonW(lpUsername, lpDomain, lpPassword: LPWSTR; 
  dwLogonFlags: dword; lpApplicationName, lpCommandLine: LPWSTR; 
  dwCreationFlags: dword; lpEnvironment: pointer; 
  lpCurrentDirectory: LPWSTR; lpStartupInfo: PStartUpInfo; 
  lpProcessInfo: PProcessInformation): boolean; stdcall; 
  external 'advapi32.dll'; 
 
implementation 
 
{$R *.DFM} 
 
uses shellapi; 
 
function ProcessWithLogon(User, Domain, PW, App, Param: string): DWord; 
var 
  si: TStartupInfo; 
  pif: TProcessInformation; 
  s: WideString; 
begin 
  ZeroMemory(@si, sizeof(si)); 
  si.cb := sizeof(si); 
  si.dwFlags := STARTF_USESHOWWINDOW; 
  si.wShowWindow := SW_SHOWNORMAL; 
  if (Param <> '') and (Param[1] <> '"') then 
    Param := ' "' + Param + '"'; 
  s := App + Param; 
  SetLastError(0); 
  CreateProcessWithLogonW(PWideChar(WideString(User)), 
    PWideChar(WideString(Domain)), PWideChar(WideString(PW)), 1, nil, 
    PWideChar(s), CREATE_DEFAULT_ERROR_MODE, nil, nil, @si, @pif); 
  Result := GetLastError; 
end; 
 
procedure TForm1.FormCreate(Sender: TObject); 
var 
  p: PChar; 
  dw: DWord; 
begin 
  Opendialog1.options := Opendialog1.options + [ofFileMustExist]; 
  Button1.caption := '&Start'; 
  Passwort.Font.Name := 'Wingdings'; 
  Passwort.PasswordChar := #108; 
  dw := 100; 
  GetMem(p, dw); 
  GetUserName(p, dw); 
  Benutzer.Text := p; 
  GetComputername(p, dw); 
  Domain.Text := p; 
  FreeMem(p); 
end; 
 
procedure TForm1.SpeedButton1Click(Sender: TObject); 
begin 
  if Opendialog1.execute then Programm.Text := Opendialog1.Filename; 
end; 
 
procedure TForm1.SpeedButton2Click(Sender: TObject); 
begin 
  if Opendialog1.execute then Parameter.Text := Opendialog1.Filename; 
end; 
 
function DosName(lang: string): string; 
var 
  p: Pchar; 
  f: DWord; 
begin 
  getmem(p, max_path); 
  f := getshortpathname(pchar(lang), p, max_path); 
  if (f = ERROR_INVALID_PARAMETER) or (f = 0) then result := '' else 
    result := ansiuppercase(p); 
  freemem(p); 
end; 
 
procedure TForm1.Button1Click(Sender: TObject); 
var 
  dw: DWord; 
  s, ss: string; 
  p: PChar; 
begin 
  s := dosname(Programm.Text); 
  GetMem(p, max_path); 
  FindExecutable(Pchar(s), nil, p); 
  ss := dosname(p); 
  if ss <> s then begin 
    Parameter.Text := Programm.Text + #32 + Parameter.Text; 
    Programm.Text := p; 
    s := ss; 
  end; 
  FreeMem(p); 
  dw := ProcessWithLogon(Benutzer.Text, Domain.Text, Passwort.Text, 
    s, Parameter.Text); 
  if dw <> 0 then begin 
    s := SysErrorMessage(dw); 
    if s = '' then s := 'Unbekannter Fehler' else 
      if s = 'Falscher Parameter' then s := 'Unbekanntes Programm/' + s; 
    Messagebox(handle, PChar(s), 'FEHLER', mb_ICONERROR); 
  end; 
  Passwort.Text := ''; 
end;