Tilgå Stdin & stdout fra Gui applikation

Jeg er bange for at det ikke kan lade sig gøre. Et kig i hjælpen til D5 siger bl.a.:

In a GUI (non-console) application, any attempt to read or write using Input or Output will produce an I/O error.

Og hhv. Input og Output er defineret som Standard In og -Out. Prøv at se afsnittet i hjælpen vedr. \"Standard routines and I/O\", \"DeviceFunctions\" og \"Text Files\"

sjensen: du har vist læst spørgsmålet forkert: det er stdin/stdout for et ANDET program (konsol--program) der prøves at fås fat på - hvilket \"sagtens\" kan lade sig gøre.
Der er dog ingen direkte Delphi/Pascal omveje til det, men man må gå direkte til Win32 API\'et - og det er her det begynder at blive en smule kompliceret.
Hvis du kender til C/C++ er der et eksempel på MSDN: http://msdn.microsoft.com/library/psdk/winbase/prothred_4uus.htm

Michael

michaelras: Det var det jeg frygtede. Det som står på den side er også at finde i win32 hjælpen som følger med D5. :-( Og det har ikke givet mig den store ide om hvordan det skal gøres.

michaelras: Du har ret. Jeg læste spm. forkert. Sorry kim_friis.

Men når man kigger på C++ eksemplet hos MS ser det ikke så farligt ud. Det er stort set kun Apikald og det er faktisk ikke så vanskeligt i Delphi. Men skal bare lige holde tungen lige i munden når man angiver parametre og typen af parametre. I de fleste tilfælde kan du bruge de samme navne til at teste om kaldet er gået godt, samt naturligvis de samme funktionsnavne, da Delphi har implementeret hele API-delen, både med funktionsnavne og konstanter, og i nogen tilfælde har delphi endda sine egne funktioner til rådighed, der indkapsler MS\'s kald. Sammen med Delphi installeres Win32.hlp (i fælles filer, borland fælles, mshelp) og denne fil (med en størrelse på omrking 24mb) lister alle de APIkald der findes.

Så hvis du starter med at lave en funktion der kan skabe en process (createProcess) og går videre til CreateChildProcess kan du efterfølgende bruge de samme APIkald (GetStdHandle o.s.v) og stort set teste på samme måde om kaldet gik godt eller ej.

Det er svært at komme igang med APIkald men når man først er kommet igang og har forstået forskellen på de forskellige parameter- og datatyper mellem C++ og Delphi, er det ikke så svært længere.

Jeg har \"oversat\" det ex jeg henvendte til tidligere (fra C++ til Delphi), og lavet det til et unit (bevaret alle kommentarerne):
// START HER FRA 
unit ReDir;

interface

uses windows;

const BUFSIZE = 4096;

var hSaveStdin, hSaveStdout, hChildStdinRd, hChildStdinWr, hChildStdoutRd, hChildStdinWrDup,
  hChildStdoutWr, hChildStdoutRdDup, hInputFile : THandle;

function CreateChildProcess : Boolean;
procedure WriteToPipe;
procedure ReadFromPipe;
procedure ErrorExit(lpszMessage : String);
procedure DoSomeRedir(AppFile, Params, InputFile : String);

implementation

var fAppFile, fParams, fInputFile : String;

function CreateChildProcess : Boolean;
var piProcInfo  : TPROCESSINFORMATION;
    siStartInfo : TSTARTUPINFO;
begin

// Set up members of the PROCESS_INFORMATION structure.
  FillChar(piProcInfo, sizeof(TPROCESSINFORMATION), 0);

// Set up members of the STARTUPINFO structure.
  FillChar(siStartInfo, sizeof(TSTARTUPINFO), 0);

  siStartInfo.cb := sizeof(TSTARTUPINFO);

// Create the child process.

  Result := CreateProcess(nil,
      PChar(fAppFile + \' \' + fParams),      // command line
      nil,          // process security attributes
      nil,          // primary thread security attributes
      TRUE,          // handles are inherited
      0,            // creation flags
      nil,          // use parent\'s environment
      nil,          // use parent\'s current directory
      siStartInfo,  // STARTUPINFO pointer
      piProcInfo);  // receives PROCESS_INFORMATION
end;

procedure WriteToPipe;
var
  dwRead, dwWritten : DWORD;
  chBuf : packed Array[1..BUFSIZE] of Char;

begin
// Read from a file and write its contents to a pipe.
  if fInputFile <> \'\' then
  begin
      while true do
      begin
        FillChar(chBuf, BUFSIZE, 0);
        if (not ReadFile(hInputFile, chBuf, BUFSIZE, dwRead, nil)) or (dwRead = 0) then break;
        if not WriteFile(hChildStdinWrDup, chBuf, dwRead, dwWritten, nil) then break;
      end;
  end;

// Close the pipe handle so the child process stops reading.

  if not CloseHandle(hChildStdinWrDup) then  ErrorExit(\'Close pipe failed\');
end;

procedure ReadFromPipe;
var
  dwRead, dwWritten : DWORD;
  chBuf : packed Array[1..BUFSIZE] of Char;
  hStdout : THandle;

begin
  hStdout := GetStdHandle(STD_OUTPUT_HANDLE);
// Close the write end of the pipe before reading from the
// read end of the pipe.

  if not CloseHandle(hChildStdoutWr) then  ErrorExit(\'Closing handle failed\');

// Read output from the child process, and write to parent\'s STDOUT.

  while true do
  begin
      FillChar(chBuf, BUFSIZE, 0);
      if (not ReadFile(hChildStdoutRdDup, chBuf, BUFSIZE, dwRead, nil)) or (dwRead = 0) then break;
      if not WriteFile(hSaveStdout, chBuf, dwRead, dwWritten, nil) then break;
      MessageBox(0, PChar(String(chBuf)), \'Txt\', MB_OK);
  end;
end;

procedure ErrorExit(lpszMessage : String);
begin
  MessageBox(0, PChar(lpszMessage), \'Fejl!\', MB_OK);
//  fprintf(stderr, \"%s\\n\", lpszMessage);
  ExitProcess(0);
end;

procedure DoSomeRedir(AppFile, Params, InputFile : String);
var
  saAttr : TSECURITYATTRIBUTES;
  fSuccess : Boolean;

begin
  fAppFile := AppFile;
  fParams := Params;
  fInputFile := InputFile;
// Set the bInheritHandle flag so pipe handles are inherited.

  saAttr.nLength := sizeof(TSECURITYATTRIBUTES);
  saAttr.bInheritHandle := TRUE;
  saAttr.lpSecurityDescriptor := nil;

  // The steps for redirecting child process\'s STDOUT:
  //    1. Save current STDOUT, to be restored later.
  //    2. Create anonymous pipe to be STDOUT for child process.
  //    3. Set STDOUT of the parent process to be write handle to
  //        the pipe, so it is inherited by the child process.
  //    4. Create a noninheritable duplicate of the read handle and
  //        close the inheritable read handle.

// Save the handle to the current STDOUT.

  hSaveStdout := GetStdHandle(STD_OUTPUT_HANDLE);

// Create a pipe for the child process\'s STDOUT.

  if not CreatePipe(hChildStdoutRd, hChildStdoutWr, @saAttr, 0) then
      ErrorExit(\'Stdout pipe creation failed\');

// Set a write handle to the pipe to be STDOUT.

  if not SetStdHandle(STD_OUTPUT_HANDLE, hChildStdoutWr) then
      ErrorExit(\'Redirecting STDOUT failed\');

// Create noninheritable read handle and close the inheritable read
// handle.

    fSuccess := DuplicateHandle(GetCurrentProcess, hChildStdoutRd,
        GetCurrentProcess, @hChildStdoutRdDup, 0, FALSE, DUPLICATE_SAME_ACCESS);
    if not fSuccess then ErrorExit(\'DuplicateHandle failed\');
    CloseHandle(hChildStdoutRd);

  // The steps for redirecting child process\'s STDIN:
  //    1.  Save current STDIN, to be restored later.
  //    2.  Create anonymous pipe to be STDIN for child process.
  //    3.  Set STDIN of the parent to be the read handle to the
  //        pipe, so it is inherited by the child process.
  //    4.  Create a noninheritable duplicate of the write handle,
  //        and close the inheritable write handle.

// Save the handle to the current STDIN.

  hSaveStdin := GetStdHandle(STD_INPUT_HANDLE);

// Create a pipe for the child process\'s STDIN.

  if not CreatePipe(hChildStdinRd, hChildStdinWr, @saAttr, 0) then ErrorExit(\'Stdin pipe creation failed\');

// Set a read handle to the pipe to be STDIN.

  if not SetStdHandle(STD_INPUT_HANDLE, hChildStdinRd) then ErrorExit(\'Redirecting Stdin failed\');

// Duplicate the write handle to the pipe so it is not inherited.

  fSuccess := DuplicateHandle(GetCurrentProcess, hChildStdinWr,
      GetCurrentProcess, @hChildStdinWrDup, 0,
      FALSE,                  // not inherited
      DUPLICATE_SAME_ACCESS);
  if not fSuccess then ErrorExit(\'DuplicateHandle failed\');

  CloseHandle(hChildStdinWr);

// Now create the child process.

  if not CreateChildProcess then  ErrorExit(\'Create process failed\');

// After process creation, restore the saved STDIN and STDOUT.

  if not SetStdHandle(STD_INPUT_HANDLE, hSaveStdin) then ErrorExit(\'Re-redirecting Stdin failed\');

  if not SetStdHandle(STD_OUTPUT_HANDLE, hSaveStdout) then ErrorExit(\'Re-redirecting Stdout failed\');

// Get a handle to the parent\'s input file.

  if fInputFile <> \'\' then
    hInputFile := CreateFile(PChar(fInputFile), GENERIC_READ, 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_READONLY, 0)
  else
      hInputFile := hSaveStdin;

  if hInputFile = INVALID_HANDLE_VALUE then ErrorExit(\'no input file\');

// Write to pipe that is the standard input for a child process.

  WriteToPipe;

// Read from pipe that is the standard output for child process.

  ReadFromPipe;
end;
end.
// SLUT HER
Eksempel på at kalde redir-unittet:
//DoSomeRedir(programfil, parametre, inputfil);
// - inputfil = fil hvis indhold bliver kopieret til stdin for programfil (tom streng = intet)

AllocConsole; // Opret stdin og stdout for GUI app
DoSomeRedir(\'attrib.exe\', \'/?\', \'\');
FreeConsole;

Viser en dialog-boks med de parametre attrib.exe (et DOS-program) tager

I ReadFromPipe er indsat et kald til MessageBox, så man kan se hvad stdout byder på - kan sagtens kopieres over i en string som så fx returneres af DoSomeRedir - det var i hvert fald en ide...

Michael

michaelras: Tak for det lange eksempel. Det vil jeg straks afprøve når jeg kommer hjem. Og så vender jeg tilbage med et svar.

Det var for genialt svar Michael. Jeg måtte lige afprøve det og det virker jo fint. Det har helt sikkert sat mig i stand til at komme videre med mit program. takker mange gang. (Og jeg smed lige lidt flere point med, som tak)

Glad jeg kunne hjælpe.... det eneste der irreterer mig ved koden er det synlige konsol-vindue - men det var mig ikke muligt at slippe af med det på en elegant måde. Problemet er (det kan være du er ligeglad med at man kan se konsollen) at konsollen kommer til syne, og først derefter skjules (ved at sende SW_HIDE via ShowWindow til konsol-vinduet) - hvis du er interesseret kan jeg godt skrive koden

Michael

Nå - jeg sender dig skjul-konsol-koden alligevel...

const KonsolTitel = \'EnUnikTempStreng_a9c2h3\';

function EnumWindowsProc(hwnd, lParam : Integer) : Boolean; stdcall;
var WT : PChar;
begin
    Result := True;
    GetMem(WT, 256);
    GetWindowText(hwnd, WT, 256);
    if StrComp(WT, PChar(KonsolTitel)) = 0 then
    begin
          ShowWindow(hwnd, SW_HIDE);
          Result := False;
    end;
    FreeMem(WT);
end;

// I den procedure/function du kalder DoSomeRedir - eller hvad du nu har ændret navnet til:
  var H: THandle;
begin
    AllocConsole;
    SetConsoleTitle(PChar(KonsolTitel));
    sleep(20);
    EnumWindows(@EnumWindowsProc, 0);
    DoSomeRedir(bla bla bla);
osv osv osv


OBS: Det er IKKE sikkert sleep(20) er nødvendig, men på mit system var det, da det gav Windows tid til at ændre titlen på konsollen så den let kunne findes med EnumWindows

Michael

Hmm... den var H: THandle;

Ved ikke hvor den kommer fra... ???

Bare drop den

Michael