Einzelnen Beitrag anzeigen

Benutzerbild von FAlter
FAlter

Registriert seit: 21. Jul 2004
Ort: Ostfildern
1.096 Beiträge
 
FreePascal / Lazarus
 
#2

Re: Mehrere CGI-Scripts gleichzeitig

  Alt 25. Aug 2004, 18:38
Habe eben bemerkt, dass jeder Prozess bei WIN seine eige´nen Umgebungsvariablen hat.

Jetzt hier mein Code:

Delphi-Quellcode:
function GetConsoleOutput(const Command, Input: String; out Output, Errors: String; const Environment: String): Boolean;
//Von Delphi-Source.de
//angepasst von FAlter ([url]http://www.falter.de.tf/[/url])
var
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
  SecurityAttr: TSecurityAttributes;
  PipeOutputRead: THandle;
  PipeOutputWrite: THandle;
  PipeInputWrite: THandle;
  PipeInputRead: THandle;
  PipeErrorsRead: THandle;
  PipeErrorsWrite: THandle;
  Succeed: Boolean;
  Buffer: array [0..255] of Char;
  NumberOfBytesRead: DWORD;
  Stream: TMemoryStream;
begin
  Output := '';
  Errors := '';
  //Initialisierung ProcessInfo
  FillChar(ProcessInfo, SizeOf(TProcessInformation), 0);

  //Initialisierung SecurityAttr
  FillChar(SecurityAttr, SizeOf(TSecurityAttributes), 0);
  SecurityAttr.nLength := SizeOf(SecurityAttr);
  SecurityAttr.bInheritHandle := true;
  SecurityAttr.lpSecurityDescriptor := nil;

  //Pipes erzeugen
  CreatePipe(PipeOutputRead, PipeOutputWrite, @SecurityAttr, 0);
  CreatePipe(PipeErrorsRead, PipeErrorsWrite, @SecurityAttr, 0);
  CreatePipe(PipeInputRead, PipeInputWrite, @SecurityAttr, 0);

  WriteFile(PipeInputWrite, Input[1], Length(Input), NumberOfBytesRead, nil);

  //Initialisierung StartupInfo
  FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
  StartupInfo.cb:=SizeOf(StartupInfo);
  StartupInfo.hStdInput := PipeInputRead;
  StartupInfo.hStdOutput := PipeOutputWrite;
  StartupInfo.hStdError := PipeErrorsWrite;
  StartupInfo.wShowWindow := sw_Hide;
  StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;

  if CreateProcess(nil, PChar(command), nil, nil, true,
  CREATE_DEFAULT_ERROR_MODE or CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, PChar(Environment), nil,
  StartupInfo, ProcessInfo) then begin
    result:=true;
    //Write-Pipes schließen
    CloseHandle(PipeOutputWrite);
    CloseHandle(PipeErrorsWrite);
    CloseHandle(PipeInputWrite);
    CloseHandle(PipeInputRead);

    //Ausgabe Read-Pipe auslesen
    Stream := TMemoryStream.Create;
    try
      while true do begin
        succeed := ReadFile(PipeOutputRead, Buffer, 255, NumberOfBytesRead, nil);
        if not succeed then break;
        Stream.Write(Buffer, NumberOfBytesRead);
      end;
      Stream.Position := 0;
      SetLength(Output, Stream.Size);
      if Stream.Size > 0 then
        Stream.Read(Output[1], Stream.Size)
    finally
      Stream.Free;
    end;
    CloseHandle(PipeOutputRead);

    //Fehler Read-Pipe auslesen
    Stream := TMemoryStream.Create;
    try
      while true do begin
        succeed := ReadFile(PipeErrorsRead, Buffer, 255, NumberOfBytesRead, nil);
        if not succeed then break;
        Stream.Write(Buffer, NumberOfBytesRead);
      end;
      Stream.Position := 0;
      SetLength(Errors, Stream.Size);
      if Stream.Size > 0 then
        Stream.Read(Errors[1], Stream.Size)
    finally
      Stream.Free;
    end;
    CloseHandle(PipeErrorsRead);

    WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
    CloseHandle(ProcessInfo.hProcess);
  end
  else begin
    result:=false;
    CloseHandle(PipeOutputRead);
    CloseHandle(PipeOutputWrite);
    CloseHandle(PipeErrorsRead);
    CloseHandle(PipeErrorsWrite);
  end;
end;
...

Delphi-Quellcode:
      Environment :=
        'CONTENT_LENGTH='    + IntToStr(Length(ARequestInfo.FormParams)) + #0 +
        'SERVER_SOFTWARE='   + IdHTTPServer.ServerSoftware + #0 +
        'REDIRECT_STATUS='   + 'ALLOWED' + #0 +
        'PATH_TRANSLATED='   + PHP + #0 +
        'QUERY_STRING='      + ARequestInfo.QueryParams + #0 +
        'SERVER_NAME='       + ARequestInfo.Host + #0 +
        'GATEWAY_INTERFACE=' + 'CGI/1.0' + #0 + //Oder was kommt hier hin?
        'SERVER_PROTOCOL='   + ARequestInfo.Version + #0 +
        'SERVER_PORT='       + '80' + #0 +
        'REQUEST_METHOD='    + ARequestInfo.Command + #0 +
        //'PATH_INFO=' + '???' + #0 +
        'SCRIPT_NAME='       + ARequestInfo.Document + #0 +
        //'REMOTE_HOST=' + '???'+ #0 +
        'REMOTE_ADDR='       + ARequestInfo.RemoteIP + #0 +
        //'AUTH_TYPE=' + '???' + #0 +
        'REMOTE_USER='       + ARequestInfo.AuthUsername + #0 +
        'HTTP_ACCEPT='       + ARequestInfo.Accept + #0 +
        'HTTP_USER_AGENT='   + ARequestInfo.UserAgent + #0 +
        #0;

      GetConsoleOutput('"' + filtxtPHP.Text + '"' , ARequestInfo.FormParams, Output,
        Error, Environment);
Trotzdem funktionieren die POST-Daten noch nicht. Kann jemand einen Fehler entdecken?
Felix Alter
  Mit Zitat antworten Zitat