AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Code-Bibliothek Neuen Beitrag zur Code-Library hinzufügen Delphi Prozess starten + Rückgabewert für Delphi 2009

Prozess starten + Rückgabewert für Delphi 2009

Ein Thema von Zerolith · begonnen am 26. Jan 2009 · letzter Beitrag vom 31. Jan 2009
Antwort Antwort
Seite 1 von 4  1 23     Letzte » 
Zerolith

Registriert seit: 12. Mär 2003
Ort: Kempten
188 Beiträge
 
Delphi 6 Enterprise
 
#1

Prozess starten + Rückgabewert für Delphi 2009

  Alt 26. Jan 2009, 15:54
Habe heute nach genau so einer Funktion hier gesucht. Musste aber für Delphi 2009 ein paar Anpassungen machen.
(Leider find ich den Link grad nicht mehr)

Konnte den Code hier nur mit 2009 und XP testen. Theoretisch müsste es schon mit Delphi 6 funktionieren.

Hoffe es hilft jemandem.

Delphi-Quellcode:
function RunWaitAndCaptureOutput(CommandLine: ansistring; var Output: ansistring): DWord;
const
  BufSize = 1024;
var
  buf: array[0..BufSize - 1] of ansichar;
  si: STARTUPINFOA;
  sa: SECURITY_ATTRIBUTES;
  sd: SECURITY_DESCRIPTOR;
  pi: PROCESS_INFORMATION;
  newstdout, read_stdout: THandle;
  bytes_read: cardinal;
  bytes_available: cardinal;

  procedure ZeroBuffer;
  begin
    FillChar(Buf, SizeOf(Buf), 0);
  end;

  procedure RaiseError(str: string);
  var
    n: DWord;
  begin
    n := GetLastError;
    raise EReadError.CreateFmt('%s: %d/0x%x -%s', [Str, n, n, SysErrorMessage(n)]);
  end;

  procedure GetData;
  begin
    PeekNamedPipe(read_stdout, @buf, BufSize - 1, @bytes_read, @bytes_available, nil);
    if (bytes_read <> 0) then
    begin
      ZeroBuffer;
      if (bytes_available > BufSize - 1)
        then
        while (bytes_read >= BufSize - 1) do
        begin
          ReadFile(read_stdout, buf, BufSize - 1, bytes_read, nil);
          Output := Output + Buf;
          ZeroBuffer;
        end
      else
      begin
        ReadFile(read_stdout, buf, BufSize - 1, bytes_read, nil);
        Output := Output + Buf;
      end;
    end;
  end;

begin
  Output := '';
  Result := 255;

  if IsWindowsNT then
  begin
    InitializeSecurityDescriptor(@sd, SECURITY_DESCRIPTOR_REVISION);
    SetSecurityDescriptorDacl(@sd, true, nil, False);
    sa.lpSecurityDescriptor := @sd;
  end else
    sa.lpSecurityDescriptor := nil;

  sa.nLength := sizeof(SECURITY_ATTRIBUTES);
  sa.bInheritHandle := true; //allow inheritable handles

  if not (CreatePipe(read_stdout, newstdout, @sa, 0)) then
    RaiseError('CreatePipe');

  GetStartupInfoA(si);

  si.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
  si.wShowWindow := SW_HIDE;
  si.hStdOutput := newstdout;
  si.hStdError := newstdout;

  if not (CreateProcessA(nil, PAnsiChar(CommandLine), nil, nil, TRUE, CREATE_NEW_CONSOLE, nil, nil, si, pi)) then
  begin
    CloseHandle(newstdout);
    CloseHandle(read_stdout);
    RaiseError('CreateProcess');
  end;

  ZeroBuffer;
  while True do
  begin
    GetExitCodeProcess(pi.hProcess, Result);
    if (Result <> STILL_ACTIVE) then break;
    GetData;
  end;

  GetData;

  CloseHandle(pi.hThread);
  CloseHandle(pi.hProcess);
  CloseHandle(newstdout);
  CloseHandle(read_stdout);
end;
Daniel
  Mit Zitat antworten Zitat
Benutzerbild von Luckie
Luckie
(Moderator)

Registriert seit: 29. Mai 2002
37.621 Beiträge
 
Delphi 2006 Professional
 
#2

Re: Prozess starten + Rückgabewert für Delphi 2009

  Alt 26. Jan 2009, 16:07
Und was musstest du wie für D2009 anpassen?
Michael
Ein Teil meines Codes würde euch verunsichern.
  Mit Zitat antworten Zitat
Zerolith

Registriert seit: 12. Mär 2003
Ort: Kempten
188 Beiträge
 
Delphi 6 Enterprise
 
#3

Re: Prozess starten + Rückgabewert für Delphi 2009

  Alt 26. Jan 2009, 16:28
zum einen die Parameter von String auf AnsiString

den Buffer auf AnsiChar

si: STARTUPINFO => auf STARTUPINFOA

CreateProcess auf CreateProcessA

und den Parameter PChar(CommandLine) auf PAnsiChar(CommandLine)
Daniel
  Mit Zitat antworten Zitat
Benutzerbild von toms
toms
(CodeLib-Manager)

Registriert seit: 10. Jun 2002
4.648 Beiträge
 
Delphi XE Professional
 
#4

Re: Prozess starten + Rückgabewert für Delphi 2009

  Alt 26. Jan 2009, 16:34
Zitat von Zerolith:
Habe heute nach genau so einer Funktion hier gesucht. Musste aber für Delphi 2009 ein paar Anpassungen machen.
(Leider find ich den Link grad nicht mehr)
[/delphi]
Die ursprüngliche Version wurde hier veröffentlicht.
Thomas
  Mit Zitat antworten Zitat
Zerolith

Registriert seit: 12. Mär 2003
Ort: Kempten
188 Beiträge
 
Delphi 6 Enterprise
 
#5

Re: Prozess starten + Rückgabewert für Delphi 2009

  Alt 26. Jan 2009, 16:41
Zitat von toms:
Zitat von Zerolith:
Habe heute nach genau so einer Funktion hier gesucht. Musste aber für Delphi 2009 ein paar Anpassungen machen.
(Leider find ich den Link grad nicht mehr)
[/delphi]
Die ursprüngliche Version wurde hier veröffentlicht.
Ah, Dankeschön!
Daniel
  Mit Zitat antworten Zitat
Benutzerbild von Luckie
Luckie
(Moderator)

Registriert seit: 29. Mai 2002
37.621 Beiträge
 
Delphi 2006 Professional
 
#6

Re: Prozess starten + Rückgabewert für Delphi 2009

  Alt 26. Jan 2009, 17:04
Zitat von Zerolith:
zum einen die Parameter von String auf AnsiString

den Buffer auf AnsiChar

si: STARTUPINFO => auf STARTUPINFOA

CreateProcess auf CreateProcessA

und den Parameter PChar(CommandLine) auf PAnsiChar(CommandLine)
Warum denn das? D2009 benutzt standardmäßig Unicode und du biegst alles wieder auf Ansi zurück?
Michael
Ein Teil meines Codes würde euch verunsichern.
  Mit Zitat antworten Zitat
Apollonius

Registriert seit: 16. Apr 2007
2.325 Beiträge
 
Turbo Delphi für Win32
 
#7

Re: Prozess starten + Rückgabewert für Delphi 2009

  Alt 26. Jan 2009, 18:47
Overlapped IO ist etwas Feines. Ich hasse es, wenn ich Code mit derartigen Schleifen sehe. Windows stellt nicht umsonst Funktionen zum Warten bereit.
Wer erweist der Welt einen Dienst und findet ein gutes Synonym für "Pointer"?
"An interface pointer is a pointer to a pointer. This pointer points to an array of pointers, each of which points to an interface function."
  Mit Zitat antworten Zitat
Benutzerbild von Luckie
Luckie
(Moderator)

Registriert seit: 29. Mai 2002
37.621 Beiträge
 
Delphi 2006 Professional
 
#8

Re: Prozess starten + Rückgabewert für Delphi 2009

  Alt 27. Jan 2009, 00:09
Ah, das wollte ich auch schon mal machen, habe es aber nicht hinbekommen. Könntest du das mal bitte machen, wenn du weißt, wie es geht?
Michael
Ein Teil meines Codes würde euch verunsichern.
  Mit Zitat antworten Zitat
Apollonius

Registriert seit: 16. Apr 2007
2.325 Beiträge
 
Turbo Delphi für Win32
 
#9

Re: Prozess starten + Rückgabewert für Delphi 2009

  Alt 27. Jan 2009, 17:24
Bitte sehr.
Delphi-Quellcode:
//Either Path or CmdLine may be empty.
function CreateProcessAndReadOutput(Path: String; CmdLine: String; out Output: String): DWord;
const BUFFER_SIZE = 512;
var lpPath, lpCmdLine: PChar;
    StartupInf: STARTUPINFO;
    ProcessInfo: PROCESS_INFORMATION;

    PipeName: String;
    SecAttr: SECURITY_ATTRIBUTES;
    WriteHandle, ReadHandle: THandle;

    OvLapped: OVERLAPPED;
    BytesRead: Cardinal;
    Buffer: array[0..BUFFER_SIZE - 1] of Byte;
    BufStr: AnsiString;

    HandleArray: array[0..1] of THandle;
begin
  Output := '';

  if Path = 'then
    lpPath := nil
  else
    lpPath := PChar(Path);
  if CmdLine = 'then
    lpCmdLine := nil
  else
    lpCmdLine := PChar(CmdLine);

  ZeroMemory(@SecAttr, SizeOf(SecAttr));
  SecAttr.nLength := SizeOf(SecAttr);
  SecAttr.bInheritHandle := True;

  PipeName := '\\.\pipe\8F66970600BF4D84BAA77F3936C04BE0' + IntToHex(GetCurrentProcessId, 8) + IntToHex(Random(MaxInt), 8);

  ReadHandle := CreateNamedPipe(PChar(PipeName), PIPE_ACCESS_INBOUND or FILE_FLAG_OVERLAPPED, 0, 1, 1024, 1024, 0, nil);
  if ReadHandle = INVALID_HANDLE_VALUE then
    RaiseLastOSError;
  try
    WriteHandle := CreateFile(PChar(PipeName), GENERIC_WRITE, FILE_SHARE_READ, @SecAttr, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
    if WriteHandle = INVALID_HANDLE_VALUE then
      RaiseLastOSError;
    try
      ZeroMemory(@StartupInf, SizeOf(StartupInf));
      StartupInf.cb := SizeOf(StartupInf);
      StartupInf.dwFlags := STARTF_USESTDHANDLES;
      StartupInf.hStdOutput := WriteHandle;
      StartupInf.hStdError := WriteHandle;
      //Input uses our console.
      StartupInf.hStdInput := GetStdHandle(STD_INPUT_HANDLE);

      if not CreateProcess(lpPath, lpCmdLine, nil, nil, True, 0, nil, nil, StartupInf, ProcessInfo) then
        RaiseLastOSError;

      CloseHandle(ProcessInfo.hThread);
      try
        ZeroMemory(@OvLapped, SizeOf(OvLapped));
        OvLapped.hEvent := CreateEvent(nil, True, False, nil);
        try
          HandleArray[0] := ProcessInfo.hProcess;
          HandleArray[1] := OvLapped.hEvent;
          if not ReadFile(ReadHandle, @Buffer, BUFFER_SIZE, nil, @OvLapped)
             and (GetLastError <> ERROR_IO_PENDING) then
            RaiseLastOSError;

          while WaitForMultipleObjects(2, @HandleArray, False, INFINITE) = WAIT_OBJECT_0 + 1 do
          begin
            if not GetOverlappedResult(ReadHandle, OvLapped, BytesRead, False) then
              RaiseLastOSError;
            SetString(BufStr, PAnsiChar(@Buffer), BytesRead);
            Output := Output + BufStr;

            ResetEvent(OvLapped.hEvent);
            if not ReadFile(ReadHandle, @Buffer, BUFFER_SIZE, nil, @OvLapped)
               and (GetLastError <> ERROR_IO_PENDING) then
              RaiseLastOSError;
          end;

          GetExitCodeProcess(ProcessInfo.hProcess, Result);
        finally
          CloseHandle(OvLapped.hEvent);
        end;
      finally
        CloseHandle(ProcessInfo.hProcess);
      end;
    finally
      CloseHandle(WriteHandle);
    end;
  finally
    CloseHandle(ReadHandle);
  end;
end;
Wer erweist der Welt einen Dienst und findet ein gutes Synonym für "Pointer"?
"An interface pointer is a pointer to a pointer. This pointer points to an array of pointers, each of which points to an interface function."
  Mit Zitat antworten Zitat
Dezipaitor

Registriert seit: 14. Apr 2003
Ort: Stuttgart
1.701 Beiträge
 
Delphi 7 Professional
 
#10

Re: Prozess starten + Rückgabewert für Delphi 2009

  Alt 27. Jan 2009, 22:13
Die Serverseite der Pipe sollte durch
Delphi-Quellcode:
1. FlushFileBuffers(hPipe);
2. DisconnectNamedPipe(hPipe);
CloseHandle(hPipe);
beendet werden.
Durch 1. wird der letzte WriteCall (vom Server) auch vollständig durchgeführt.
Durch 2. wird die Pipe auch wirklich geschlossen und nicht einfach der Pipe Handle Referenzzähler um eins nach unten gesetzt.
Christian
Windows, Tokens, Access Control List, Dateisicherheit, Desktop, Vista Elevation?
Goto: JEDI API LIB & Windows Security Code Library (JWSCL)
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +2. Es ist jetzt 13:47 Uhr.
Powered by vBulletin® Copyright ©2000 - 2021, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2021 by Daniel R. Wolf