Версия для печати
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум на Исходниках.RU > Delphi: Система, Windows API > Помогите с процессами


Автор: piton_zel 13.08.04, 15:04
Помогите народ, уже неделю бъюсь, а результат ноль. Мне надо запустить другой процесс (консольная программа) под другим пользователем и перехватить всю информацию выводимую в консольном окне. Процес запускается, выполняется, а вот что он там пишет я не как не могу перехватить. Где у меня ошибка???
<{CODE_COLLAPSE_OFF}><{CODE_WRAP_OFF}>
     
    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 = $00000001;
      LOGON_NETCREDENTIALS_ONLY = $00000002;
      LOGON_ZERO_PASSWORD_BUFFER = $80000000;
     
    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,
          0,
          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;
     
    end;
     
    var
      Data: String;
    begin
      ExecuteExternal('N:\work\_Net\WEBServer\_ts\Project2.exe 123456','',Data);
      WriteLn(Data);
      Write('FINISH'); ReadLn;
    end.

Автор: P.O.D 13.08.04, 16:59
piton_zel, большой код, неахота смотреть ;)
А почему не юзаеть документированную ф-цию CreateProcessAsUser, вместо недокументировванной CreateProcessWithLogon ?

Автор: piton_zel 14.08.04, 10:49
Цитата P.O.D @ 13.08.04, 19:59
piton_zel, большой код, неахота смотреть ;)
А почему не юзаеть документированную ф-цию CreateProcessAsUser, вместо недокументировванной CreateProcessWithLogon ?

хм... сейчас посмотрю, что это за зверь...

Автор: piton_zel 14.08.04, 12:12
Вот, что-то родил, но тоже пока без результа... LogonUser почему-то сообщает: Logon failed. Клиент не обладает требуемыми правами.
<{CODE_COLLAPSE_OFF}><{CODE_WRAP_OFF}>
     
        if not OpenProcessToken(GetCurrentProcess,TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,hToken)
          then WriteLn('ERROR: '+strtooem(winerrorasstring(getlasterror)));
        if not LookupPrivilegeValue(nil,'SeTcbPrivilege',tkp.Privileges[0].Luid)
          then WriteLn('ERROR: '+strtooem(winerrorasstring(getlasterror)));
        tkp.PrivilegeCount:= 1;
        tkp.Privileges[0].Attributes:= SE_PRIVILEGE_ENABLED;
        dwNull:= 0;
        if not AdjustTokenPrivileges(hToken,FALSE,tkp,SizeOf(TTokenPrivileges),tmp,dwNull)
          then WriteLn('ERROR: '+strtooem(winerrorasstring(getlasterror)));
        CloseHandle(hToken);
     
        if LogonUser( 'test', 'piton', '1234', LOGON32_LOGON_NETWORK, LOGON32_PROVIDER_DEFAULT, hToken )
          then WriteLn('Succeeded, token = 0x'+IntToHex(hToken,8))
          else WriteLn('Logon failed. '+strtooem(winerrorasstring(getlasterror)));
     
        Result:= CreateProcessAsUser( hToken, 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

Автор: P.O.D 14.08.04, 12:28
piton_zel, привилегий не надо, попробуй сразу LogonUser(...)

Автор: piton_zel 14.08.04, 12:59
Цитата P.O.D @ 14.08.04, 15:28
piton_zel, привилегий не надо, попробуй сразу LogonUser(...)

дык... У меня весь смысл в этом и сидит, мне надо запустить процесс под другими пользователем. А привилегии нужны, чтобы я мог выполнить функцию LogonUser. хех, может я не правильно выражаюсь?.. смысл такой, мне надо запустить программу и что бы эта прога не наделал гадостей системе, т.е. под учетной записью у которой будет все закрыто, кроме доступа к одному каталогу. Самое интересное, что это дело работает под SYSTEM, т.е. как сервис, но мне это надо запускать из под админа. вот, пока не знаю как и решить данный вопрос...

Автор: P.O.D 14.08.04, 18:17
Цитата
piton_zel, 14.08.04, 16:59
А привилегии нужны, чтобы я мог выполнить функцию LogonUser

вроде нет...
так работает ?
<{CODE_COLLAPSE_OFF}><{CODE_WRAP_OFF}>
     
    if LogonUser( 'test', 'piton', '1234', LOGON32_LOGON_NETWORK, LOGON32_PROVIDER_DEFAULT, hToken )
          then WriteLn('Succeeded, token = 0x'+IntToHex(hToken,8))
          else WriteLn('Logon failed. '+strtooem(winerrorasstring(getlasterror)));
     
        Result:= CreateProcessAsUser( hToken, 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

Автор: piton_zel 16.08.04, 05:30
Нет не работает. Тут видешь какая фишка, если прогу запустить по system, например как службу, то это будет работать, а если из под пользователя, в данном случае администратора, то нет. А все это происходит из-за того, что у пользователей нет прав, а именно "SeTcbPrivilege". Вот и приходиться сначала установить эту привелегию, а потом выполнять LogonUser. Причем, такой геморой наблюдается только в NT,W2K, поговаривают, что в XP такого нет.
Вопрос, пока, так и остался открытым....

Powered by Invision Power Board (https://www.invisionboard.com)
© Invision Power Services (https://www.invisionpower.com)