{$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.