Форум на Исходниках.RU

program Project3;

{$APPTYPE CONSOLE}

uses

Windows, SysUtils;

type

TCreateProcessWithLogonW =

function(const lpUsername: PWideChar;

const lpDomain: PWideChar; const lpPassword: PWideChar;

dwLogonFlags: DWORD; const lpApplicationName: PWideChar;

lpCommandLine: PWideChar; dwCreationFlags: DWORD;

lpEnvironment: Pointer; const lpCurrentDirectory: PWideChar;

lpStartupInfo: PStartupInfo;

lpProcessInfo: PProcessInformation): Boolean; stdcall;

const

DllName = 'advapi32.dll';

LOGON_WITH_PROFILE = {text}000001;

LOGON_NETCREDENTIALS_ONLY = {text}000002;

LOGON_ZERO_PASSWORD_BUFFER = 000000;

var

DllHandle: THandle;

_CreateProcessWithLogonW: TCreateProcessWithLogonW;

////////////////////////////////////////////////////////////////////////////////

function InitLib: Boolean;

begin

if DllHandle = 0 then

if Win32Platform = VER_PLATFORM_WIN32_NT then begin

DllHandle:= LoadLibrary(DllName);

if DllHandle <> 0

then @_CreateProcessWithLogonW:= GetProcAddress(DllHandle,'CreateProcessWithLogonW');

end;

Result:= ( DllHandle <> 0 );

end;

////////////////////////////////////////////////////////////////////////////////

function NotImplementedBool: Boolean;

begin

SetLastError(ERROR_CALL_NOT_IMPLEMENTED);

Result:= false;

end;

////////////////////////////////////////////////////////////////////////////////

function CreateProcessWithLogonW(const lpUsername: PWideChar;

const lpDomain: PWideChar; const lpPassword: PWideChar;

dwLogonFlags: DWORD; const lpApplicationName: PWideChar;

lpCommandLine: PWideChar; dwCreationFlags: DWORD;

lpEnvironment: Pointer; const lpCurrentDirectory: PWideChar;

lpStartupInfo: PStartupInfo;

lpProcessInfo: PProcessInformation): Boolean; stdcall;

begin

if InitLib and Assigned(_CreateProcessWithLogonW) then

Result:= _CreateProcessWithLogonW( lpUsername, lpDomain, lpPassword,

dwLogonFlags, lpApplicationName, lpCommandLine, dwCreationFlags,

lpEnvironment, lpCurrentDirectory, lpStartupInfo, lpProcessInfo )

else Result:= NotImplementedBool;

end;

////////////////////////////////////////////////////////////////////////////////

function WinErrorAsString( id : integer ): string;

var a: array[ 0..MAX_PATH ] of char;

begin

//SysErrorMessage... тоже самое???

FillChar( a, SizeOf( a ), #0 );

FormatMessage( FORMAT_MESSAGE_FROM_SYSTEM, nil, id, LANG_SYSTEM_DEFAULT, @a, MAX_PATH, nil );

result:= StrPas( a );

while pos( #13, result ) > 0 do result[ pos( #13, result ) ]:= ' ';

while pos( #10, Result ) > 0 do Delete( result, pos( #10, result ), 1 );

end; // WinErrorAsString

////////////////////////////////////////////////////////////////////////////////

function ExecuteExternal( CompilerName, ScriptName: String; out Data: string ): Boolean;

var

StartInfo: TStartupInfo;

ProcInfo: TProcessInformation;

Len, ExitCode: DWORD;

Tmp1, Tmp2: THandle;

SA_Attr: PSecurityAttributes;

ChildStdoutRd: THandle;

ChildStdoutWr: THandle;

ChildStdinRd: THandle;

ChildStdinWr: THandle;

s, st: String;

f: Integer;

WorkDir, ExeScript: String;

dwWritten: cardinal;

UserName: array[0..512] of WideChar;

Password: array[0..512] of WideChar;

CommandLine: array[0..512] of WideChar;

Domain: array[0..512] of WideChar;

WorkDirectory: array[0..512] of WideChar;

// --- Read from pipe...

function ReadStrFromChild( var Data: String ): Boolean;

var

dwRead, BufSize: DWORD;

st: String;

begin

BufSize:= 0;

Data:= '';

repeat

Result:= PeekNamedPipe( ChildStdoutRd, nil, 0, nil, @BufSize, nil );

if Result and ( BufSize > 0 ) then begin

SetLength( st, BufSize );

Result:= ReadFile( ChildStdoutRd, st[1], BufSize, dwRead, nil )and( dwRead = BufSize );

if not Result then exit;

Data:= Data + Copy( st, 1, dwRead );

end;

until not Result or( BufSize = 0 );

end;

begin

Data:= '';

Result:= False;

ProcInfo.hProcess:= 0;

for f:= 1 to Length(CompilerName) do

if CompilerName[f] = '/' then CompilerName[f]:= '\';

WorkDir:= ExtractFilePath(CompilerName);

if ScriptName = '' then ExeScript:= CompilerName

else ExeScript:= CompilerName+' '+ScriptName;

// --- Execute script...

New(SA_Attr);

try

SA_Attr.nLength:= SizeOf(SECURITY_ATTRIBUTES);

SA_Attr.bInheritHandle:= true;

SA_Attr.lpSecurityDescriptor:= nil;

// --- Создаем "читальный" Pipe...

if not CreatePipe( ChildStdoutRd, ChildStdoutWr, SA_Attr, 0 ) then begin

WriteLn('ERROR: Create Pipe. '+WinErrorAsString(GetLastError));

exit;

end;

// --- Создаем "писальный" Pipe...

if not CreatePipe( ChildStdinRd, ChildStdinWr, SA_Attr, 0 ) then begin

WriteLn('ERROR: Create Pipe. '+WinErrorAsString(GetLastError));

exit;

end;

// --- Делаем НЕ наследуемый дубликат "Читального" (Read) конца Pipe'a....

// --- Это нужно, я так полагаю, чтобы не тащить лишние хэндлы в дочерний процесс...

if not DuplicateHandle( GetCurrentProcess(), ChildStdoutRd, GetCurrentProcess(), @Tmp1, 0, False, DUPLICATE_SAME_ACCESS ) then begin

WriteLn('ERROR: DuplicateHandle. '+WinErrorAsString(GetLastError));

exit;

end;

if not DuplicateHandle( GetCurrentProcess(), ChildStdinWr, GetCurrentProcess(), @Tmp2, 0, False, DUPLICATE_SAME_ACCESS ) then begin

WriteLn('ERROR: DuplicateHandle. '+WinErrorAsString(GetLastError));

exit;

end;

CloseHandle(ChildStdoutRd);//Закроем наследуемый вариант "Читального" хэндла

CloseHandle(ChildStdinWr); //Закроем наследуемый вариант "Писального" хэндла

ChildStdoutRd:= Tmp1; //И воткнем их места НЕ наследуемые дубликаты

ChildStdinWr:= Tmp2; //И воткнем их места НЕ наследуемые дубликаты

// --- Запускаем-с...

// --- Set up members of STARTUPINFO structure...

ZeroMemory( @StartInfo, SizeOf(TStartupInfo) );

StartInfo.cb:= SizeOf(TStartupInfo);

StartInfo.hStdInput:= ChildStdinRd;

StartInfo.hStdOutput:= ChildStdoutWr;

StartInfo.dwFlags:= STARTF_USESTDHANDLES;

// --- Create the child process...

FillChar( CommandLine, Length(CommandLine)*SizeOf(WideChar), 0 );

StringToWideChar( ExeScript, CommandLine, Sizeof(CommandLine) div SizeOf(WideChar) );

s:= 'test';

FillChar( UserName, Length(UserName)*SizeOf(WideChar), 0 );

StringToWideChar( s, UserName, Sizeof(UserName) div SizeOf(WideChar) );

s:= '1234';

FillChar( Password, Length(Password)*SizeOf(WideChar), 0 );

StringToWideChar( s, Password, Sizeof(Password) div SizeOf(WideChar) );

FillChar( WorkDirectory, Length(WorkDirectory)*SizeOf(WideChar), 0 );

StringToWideChar( WorkDir, WorkDirectory, Sizeof(WorkDirectory) div SizeOf(WideChar) );

Len:= 1024;

SetString( st, nil, Len );

FillChar( st[1], Len, 0 );

GetComputerName( pChar(st), Len );

st:= Copy( st, 1, Len );

FillChar( Domain, Length(Domain)*SizeOf(WideChar), 0 );

StringToWideChar( st, Domain, Sizeof(Domain) div SizeOf(WideChar) );

Result:= CreateProcessWithLogonW(

UserName,

Domain,

Password,

//LOGON_WITH_PROFILE,

LOGON_NETCREDENTIALS_ONLY,

nil,

CommandLine,

nil,

WorkDirectory,

@StartInfo,

@ProcInfo);

Result:= CreateProcess( nil,

pChar(ExeScript), // command line

nil, // process security attributes

nil, // primary thread security attributes

true, // handles are inherited

0, // creation flags

nil, // use parent's environment

pChar(WorkDir), // use parent's current directory

StartInfo, // STARTUPINFO pointer

ProcInfo); // receives PROCESS_INFORMATION

if not Result then begin

WriteLn('ERROR: CreateProcess '+WinErrorAsString(GetLastError));

exit;

end;

WaitForInputIdle(ProcInfo.hProcess, INFINITE);

// --- Вводим информацию...

Data:= 'ля-ля-ля...';

WriteFile( ChildStdinWr, Data[1], Length(Data), dwWritten, nil );

// --- Читаем информацию...

Data:= '';

repeat

GetExitCodeThread( ProcInfo.hThread, ExitCode );

if not ReadStrFromChild(st) then begin

WriteLn('ERROR: ReadStrFromChild. '+WinErrorAsString(GetLastError),True);

exit;

end;

Data:= Data + st;

until ExitCode <> STILL_ACTIVE;

// --- Удачно-ли завершен скрипт?..

if ExitCode <> NOERROR then begin

WriteLn('ERROR: ExitCode = '+inttostr(ExitCode)+'. script "'+ExeScript+'".',True);

exit;

end;

// ---- ну тут далее, но это уже не относится к делу...

finally

if ProcInfo.hProcess <> 0 then begin

CloseHandle(ProcInfo.hProcess);

CloseHandle(ProcInfo.hThread);

end;

//Закрываем хэндлы пайпов

CloseHandle(ChildStdoutRd);

CloseHandle(ChildStdoutWr);

CloseHandle(ChildStdinRd);

CloseHandle(ChildStdinWr);

Dispose(SA_Attr);

end;

var

Data: String;

begin

ExecuteExternal('N:\work\_Net\WEBServer\_ts\Project2.exe 123456','',Data);

WriteLn(Data);

Write('FINISH'); ReadLn;

end.