{$APPTYPE CONSOLE}

// From scratch by CJ. ;)

// Lancement d'une application console, et lecture de la sortie écran.
// Résolution du problème des applis n'utilisant pas la sortie standard

// Exemple d'utilisation :
// CONSOLEAPP.EXE 0 CAPTURE.TXT LAME.EXE --longhelp

program ConsoleApp;

// Nécessite au moins 3 paramètres
// Paramètre 1 : nombre de lignes à récupérer, zéro = tout l'écran
// Paramètre 2 : nom SEUL du fichier résultat (ex: "CAPTURE.TXT")
// Paramètre 3 : nom SEUL du sous-processus à lancer (ex : "LAME.EXE")
// les paramètres 4 et suivants sont transmis au sous-processus

uses
  Windows,SysUtils;

type PStringArray = ^TStringArray;
     TStringArray = array [0..Maxint div SizeOf(string) - 1] of string;

var
    OutHandle                   : THandle;
    Security                    : TSecurityAttributes;
    start                       : TStartUpInfo;
    ProcessInfo                 : TProcessInformation;
    Apprunning                  : DWord;
    NumLinesStr                 : string;
    NumLines,LineWidth,NumLine2 : Integer;
    ScreenBuffer                : PChar;
    L,I,CharsRead,CharsToRead   : DWORD;
    CharsInConsole              : DWORD;
    ConsoleScreenBufferInfo     : TConsoleScreenBufferInfo;
    Coord                       : TCoord;
    AppDir                      : string;
    S,ScrFile,Params            : string;
    StringArray                 : PStringArray;
    F                           : TextFile;

function CorrigeParam(S:String):string;
 begin
  if Pos(' ',S) <> 0 then Result := '"' + S + '"' else Result := S;
 end;

begin

 if ParamCount < 3 then halt(1);

 AppDir := ExtractFileDir(ParamStr(0))+'\';// dossier appli

 NumLinesStr := ParamStr(1);
 for i := 1 to length(NumLinesStr) do
     if not(NumLinesStr[i] in ['0'..'9'])
        then halt(2);
 NumLines := StrToInt(NumLinesStr); // nombre de lignes

 ScrFile  := AppDir+ParamStr(2);
 if FileExists(ScrFile) then DeleteFile(ScrFile); // fichier capture

 Params   := CorrigeParam(AppDir+ParamStr(3)); // sous-processus

 for I:=4 to ParamCount do Params := Params + ' ' + CorrigeParam(ParamStr(I));

 // On récupère le handle de la console
 OutHandle := GetStdHandle(STD_OUTPUT_HANDLE);
 // si le nombre de lignes de la console (300 par défaut) n'est pas
 // suffisant, on l'agrandit
 FillChar(ConsoleScreenBufferInfo,SizeOf(ConsoleScreenBufferInfo),0);
 GetConsoleScreenBufferInfo(OutHandle,ConsoleScreenBufferInfo);
 With ConsoleScreenBufferInfo do
      begin
       if NumLines <= 0 then NumLines := dwSize.Y;
       if (dwSize.X < 80) or (dwSize.Y < NumLines) then
          begin
           dwSize.X := 80;
           dwSize.Y := NumLines;
           SetConsoleScreenBufferSize(OutHandle,dwSize);
          end;
       LineWidth      := dwSize.X;
       CharsToRead    := LineWidth * NumLines;
       CharsInConsole := LineWidth * dwSize.Y;
       GetMem(ScreenBuffer,CharsToRead);
       FillChar(ScreenBuffer^,CharsToRead,0);
      end;
// With ConsoleScreenBufferInfo do Writeln(Format('dwSize.X=%d'#13#10'dwSize.Y=%d'#13#10'dwCursorPosition.X=%d'#13#10'dwCursorPosition.Y=%d'#13#10'wAttributes=%d'#13#10'srWindow.Left=%d'#13#10'srWindow.Top=%d'#13#10'srWindow.Right=%d'#13#10'srWindow.Bottom=%d'#13#10'dwMaximumWindowSize.X=%d'#13#10'dwMaximumWindowSize.Y=%d'#13#10#13#10'CharsToRead=%d',[dwSize.X,dwSize.Y,dwCursorPosition.X,dwCursorPosition.Y,wAttributes,srWindow.Left,srWindow.Top,srWindow.Right,srWindow.Bottom,dwMaximumWindowSize.X,dwMaximumWindowSize.Y,CharsToRead]));

// espace pour les chaînes de caractère
// Il n'y a pas de vérification de l'exception EOutOfMemory
// peut-être ça, le problème de plantage parfois observé ?
// ce qui est bizarre, c'est qu'à part gowap, personne n'a de problème
 GetMem(StringArray,NumLines * SizeOf(string));

// Lancement du sous-processus
 With Security do
       begin
        nlength              := SizeOf(TSecurityAttributes);
        binherithandle       := true;
        lpsecuritydescriptor := nil;
       end;
 FillChar(Start,Sizeof(Start),#0);
 start.cb:= SizeOf(start);
// start.dwFlags     := STARTF_USESHOWWINDOW;
// start.wShowWindow := SW_HIDE; // inutile, car on hérite de la console
 if CreateProcess( nil,PChar(Params),@Security,
                   @Security,true,NORMAL_PRIORITY_CLASS,
                   nil,nil,start,ProcessInfo )
    then begin
          repeat
           Apprunning := WaitForSingleObject(ProcessInfo.hProcess,200);
          until (Apprunning <> WAIT_TIMEOUT);
          CloseHandle(ProcessInfo.hProcess);
          CloseHandle(ProcessInfo.hThread);
         end;

// Lecture du buffer écran
 Coord.X := 0;Coord.Y := 0;
 if CharsToRead <> 0 then ReadConsoleOutputCharacter(OutHandle,ScreenBuffer,CharsToRead,Coord,CharsRead);
 FillConsoleOutputCharacter(OutHandle,#0,CharsInConsole,Coord,CharsRead);
 SetConsoleCursorPosition(OutHandle,Coord);

 NumLine2 := -1;
 for L:= 0 to NumLines - 1 do
  begin
   S:='';
   // Il y a certainement plus efficace que ce qui suit, mais bon...
   for I := 0 to LineWidth - 1 do
       begin
        s:=s + ScreenBuffer^;
        inc(ScreenBuffer);
       end;
   S:=Trim(S);
   StringArray^[L] := S;
   if S<>'' then NumLine2 := L
  end;

// sauvegarde de la capture écran
 system.assign(F,ScrFile);
 system.rewrite(F);
 for L := 0 to NumLine2 do writeln(F,StringArray^[L]);
 system.close(F);

 FreeMem(StringArray,NumLines * SizeOf(string));
end.