Details

Written by: Stanko Milosev

Category: Delphi

Published: 21 November 2008

Last Updated: 18 July 2011

Hits: 6091

Here is an example of function for geting logs from command line. This mean, if you call, for example, chkdsk, you will get what would be writen on a console output. Also, if command failed, you will get that information :)

 

function CaptureConsoleOutput(DosApp : string; var strLog : String): Boolean;
const
  ReadBuffer = 1048576;  // 1 MB Buffer
var
  Security  : TSecurityAttributes;
  ReadPipe,WritePipe  : THandle;
  start  : TStartUpInfo;
  ProcessInfo  : TProcessInformation;
  Buffer  : Pchar;
  TotalBytesRead,
  BytesRead  : DWORD;
  Apprunning,n,
  BytesLeftThisMessage,
  TotalBytesAvail : integer;
  xCode: Cardinal;
  bolOk: Boolean;
begin
  with Security do
  begin
  nlength := SizeOf(TSecurityAttributes);
  binherithandle := true;
  lpsecuritydescriptor := nil;
end;

  if CreatePipe (ReadPipe, WritePipe, @Security, 0) then
  begin
  // Redirect In- and Output through STARTUPINFO structure

  Buffer := AllocMem(ReadBuffer + 1);
  FillChar(Start,Sizeof(Start),#0);
  start.cb := SizeOf(start);
  start.hStdOutput  := WritePipe;
  start.hStdInput := ReadPipe;
  start.dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
  start.wShowWindow := SW_HIDE;
  start.hStdError := WritePipe;

  // Create a Console Child Process with redirected input and output

  if CreateProcess(nil  ,PChar(DosApp),
  @Security,@Security,
  true, CREATE_NO_WINDOW or NORMAL_PRIORITY_CLASS,
 nil,nil,
 start  ,ProcessInfo) then
  begin
  n:=0;
  TotalBytesRead:=0;
  repeat
  // Increase counter to prevent an endless loop if the process is dead
  Inc(n,1);

  // wait for end of child process
  Apprunning := WaitForSingleObject(ProcessInfo.hProcess,100);
  Application.ProcessMessages;

  // it is important to read from time to time the output information
  // so that the pipe is not blocked by an overflow. New information
  // can be written from the console app to the pipe only if there is
  // enough buffer space.

  if not PeekNamedPipe(ReadPipe, @Buffer[TotalBytesRead],
  ReadBuffer,@BytesRead,
 @TotalBytesAvail,@BytesLeftThisMessage) then break
  else if BytesRead > 0 then
  ReadFile(ReadPipe,Buffer[TotalBytesRead],BytesRead,BytesRead,nil);
  TotalBytesRead:=TotalBytesRead+BytesRead;
  until (Apprunning WAIT_TIMEOUT) or (n > 150);
  GetExitCodeProcess(ProcessInfo.hProcess,xCode); //with this you are geting if command was successfull
  if xCode=0 then
  bolOk := True
  else
  bolOk := False;

  Buffer[TotalBytesRead]:= #0;
  OemToChar(Buffer,Buffer);
  strLog := strLog + StrPas(Buffer);
  end;
  FreeMem(Buffer);

  CloseHandle(ProcessInfo.hProcess);
  CloseHandle(ProcessInfo.hThread);
  CloseHandle(ReadPipe);
  CloseHandle(WritePipe);
  Result := bolOk;
  end;
end;

Details

Written by: Stanko Milosev

Category: Delphi

Published: 22 October 2008

Last Updated: 04 May 2022

Hits: 4983

If you receive that exception, and you are using something like:

...
var
Buffer: array [0..MAX_SIZE] of Char;

Than MAX_SIZE is too big, because Char can take small mount of data.

Use better something like this:

{
The following example opens a file of your choice and reads
the entire file into a dynamically allocated buffer. The
buffer and the size of the file are then passed to a routine
that processes the text, and finally the dynamically
allocated buffer is freed and the file is closed.
} 
procedure TForm1.Button1Click(Sender: TObject);
var
  F: file;
  Size: Integer;
  Buffer: PChar;
begin
  if OpenDialog1.Execute then
  begin
    AssignFile(F, OpenDialog1.FileName);
    Reset(F, 1);
    try
      Size := FileSize(F);
      GetMem(Buffer, Size);
      try
        BlockRead(F, Buffer^, Size);
        Memo1.Lines.Add(Buffer);
      finally
        FreeMem(Buffer);
      end;
    finally
      CloseFile(F);
    end;
  end;
end;

That code is taken from Delphi help, system.FreeMem function.

Details

Written by: Stanko Milosev

Category: Delphi

Published: 22 September 2008

Last Updated: 22 September 2008

Hits: 5293