CreateProcessWithLogonW

← →
Чапаев © (2006-08-04 13:32) [0]

procedure ReRun(const UserName,Password:PWideChar); var SI:TStartupInfoW; PI:TProcessInformation; CompName:array [0..MAX_COMPUTERNAME_LENGTH] of WideChar; Size:Cardinal; CurDir,Exe:WideString; begin Size:=SizeOf(CompName); GetComputerNameW(CompName,Size); FillChar(SI,SizeOf(SI),0); SI.cb:=SizeOf(SI); Exe:=ParamStr(0); CurDir:=GetCurrentDir; CreateProcessWithLogonW(UserName, CompName, Password, 0, PWideChar(Exe), nil, 0, nil, PWideChar(CurDir), SI, PI); // RaiseLastOsError; end;
Дома это работает, на работе -- через раз. В несчастливые разы выбрасывает ошибку 5: access denied. Что делать? Сменить работу и убитьсибяапстену не предлагать.

← →
Игорь Шевченко © (2006-08-04 16:58) [1]

> Дома это работает, на работе -- через раз.

Может быть ты сам найдешь 10 отличий между домом и работой и напишешь их здесь, чтобы мы не гадали ?

← →
Чапаев © (2006-08-07 13:45) [2]

> найдешь 10 отличий между домом и работой

Все выходные искал -- ничего не нашёл. Домашняя и рабочая операционки ставились с одной болванки. Сначала думал, что fast user switching или антивирус фокусничают, но их включение/выключение ситуацию не изменило. :-(

← →
BiN © (2006-08-07 14:14) [3]

> Чапаев © (04.08.06 13:32)

Для начала попробуй передавать в CreateProcessWithLogonW только константы.
А также проверь не отключена ли (не путать с "остановлена") служба runas.

← →
Чапаев © (2006-08-07 14:23) [4]

> А также проверь не отключена ли (не путать с "остановлена")
> служба runas.

Secondary logon, наверное?

Основная проблема в том, что перестаёт и вновь начинает работать без какой бы то ни было понятной мне системы. :-(

← →
Reindeer Moss Eater © (2006-08-07 15:26) [5]

А GetLastError в отпуске?

← →
Чапаев © (2006-08-07 15:29) [6]

> А GetLastError в отпуске?

А исходное сообщение читал? Ошибка нумер пять: отказано в доступе.

← →
Reindeer Moss Eater © (2006-08-07 17:45) [7]

Ну так какие тогда вопросы?
Нет правов на выполнение функции.

← →
Reindeer Moss Eater © (2006-08-07 18:01) [8]

Либо косяки с самими параметрами.
Например юзер от которого запускается процесс может не иметь прав на то, что возвращает GetCurrentDir или еще чего.

Кроме того любая API функция могла завершиться обломом, а результат ты проверяешь только у последней.
В общем я бы для начала скомпилировал пример из PlatformSDK один-в-один.

← →
СисАдмин (2006-08-08 09:51) [9]

Ваш код не анализировал, привожу свой. У меня работает 100% на w2k и xp
Помню тоже прилично помучался с этой функцией, и на форумах много посылали и вот результат (испытано на дельфи 6)

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Buttons;

type
TForm1 = class(TForm)
Button1: TButton;
E1: TLabeledEdit;
E2: TLabeledEdit;
E3: TLabeledEdit;
E4: TLabeledEdit;
SpeedButton1: TSpeedButton;
OpenDialog1: TOpenDialog;
procedure Button1Click(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

const
LOGON_WITH_PROFILE = $00000001;
LOGON_NETCREDENTIALS_ONLY = $00000002;

var
Form1: TForm1;

implementation

{$R *.dfm}

function CreateProcessWithLogonW
(
lpUsername, // user"s name
lpDomain, // user"s domain
lpPassword: PWideChar; // user"s password
dwLogonFlags: DWORD; // logon option
lpApplicationName: PWideChar; // executable module name
lpCommandLine: PWideChar; // command-line string
dwCreationFlags: DWORD; // creation flags
lpEnvironment: Pointer; // new environment block
lpCurrentDirectory: PWideChar; // current directory name
const lpStartupInfo: TStartupInfo; // startup information
var lpProcessInformation: TProcessInformation //process inf
): Bool; stdcall;external "advapi32.dll";

procedure TForm1.Button1Click(Sender: TObject);

var
UserName,
UserDomain,
Password,
CmdLine:Pwidechar;
si: TStartupInfo;
ProcInfo: TProcessInformation;

begin
FillChar(si,sizeof(si), 0);
si.cb:=sizeof(si);
GetMem(UserName, 512);
GetMem(UserDomain, 512);
GetMem(Password, 512);
GetMem(CmdLine, 512);
try
UserName:=StringToWideChar(E2.Text,UserName,512);
UserDomain:=StringToWideChar(E4.Text,UserDomain,512);
Password:=StringToWideChar(E3.Text,Password,512);
cmdline:=StringToWideChar(E1.Text,cmdline,512);
if not CreateProcessWithLogonW(
UserName,
UserDomain,
Password,
LOGON_WITH_PROFILE,
nil,
CmdLine,
CREATE_DEFAULT_ERROR_MODE,
//CREATE_NEW_CONSOLE or CREATE_NEW_PROCESS_GROUP,
nil, nil, si, ProcInfo) then
begin
MessageDlg(SysErrorMessage(GetLastError)+#10#13+inttostr(GetLastError), mtError, [mbOK], 0);
end else
begin
WaitForSingleObject(procinfo.hProcess, INFINITE);
CloseHandle(procinfo.hProcess);
CloseHandle(procinfo.hThread);
ShowMessage("Success !!!");
end;
finally
FreeMem(UserName, 512);
FreeMem(UserDomain, 512);
FreeMem(Password, 512);
FreeMem(CmdLine, 512);
end;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
E1.Text:=OpenDialog1.FileName;
end;
end;

end.

> Нет правов на выполнение функции.

Но почему они то появляются, то исчезают? Я-то политики безопасности не меняю.

> Например юзер от которого запускается процесс может не иметь
> прав на то, что возвращает GetCurrentDir или еще чего.

Исключено.

> Кроме того любая API функция могла завершиться обломом,
> а результат ты проверяешь только у последней.

Это в примере, кинутом в форум. Реально при трассировке все функции, кроме последней выполняются успешно.

> СисАдмин (08.08.06 09:51) [9]

Благодарю, попробую.

> UserName:=StringToWideChar(E2.Text,UserName,512);

Тут, насколько я понимаю, ошибка: третий параметр -- количество СИМВОЛОВ, то есть для WideChar -- 512/2.

CreateProcessWithLogonW Найти похожие ветки