program linetime; {$mode objfpc}{$H+} uses {$IFDEF UNIX}{$IFDEF UseCThreads} cthreads, {$ENDIF}{$ENDIF} Classes, SysUtils, CustApp { you can add units after this } ,DateUtils, IOStream; type { TMyApplication } TMyApplication = class(TCustomApplication) protected procedure DoRun; override; private UseEscapeChars: Boolean; TestMode: Boolean; TestLineDelay: TDateTime; TestString: string; FirstLine: Boolean; TextOnLine: Boolean; StartTime: TDateTime; NewLine: Boolean; NewLineEnding: string; ShowTime: Boolean; LastLineTime: TDateTime; LogFile: TFileStream; LogEnabled: Boolean; TermString: string; TermStringIndex: Integer; procedure TermCheckString(Buffer: string); function FindLineEnding(Buffer: string; var FoundLineEnding: string): Integer; procedure WriteRaw(Text: string); procedure WriteLog(Text: string); procedure PrintOutput(Output: string); procedure ShowTimePrefix; procedure ProcessBuffer(Buffer: string); public FormatCSV: Boolean; constructor Create(TheOwner: TComponent); override; destructor Destroy; override; procedure WriteHelp; virtual; end; { TMyApplication } procedure TMyApplication.DoRun; var ErrorMsg: String; Buffer: string; InputStream: TStream; Count: Integer; LogDir: string; FileName: string; begin // Quick check parameters ErrorMsg := CheckOptions('hclt:e', 'help csv log termstr escape'); if ErrorMsg <> '' then begin ShowException(Exception.Create(ErrorMsg)); Terminate; Exit; end; // Parse parameters if HasOption('h', 'help') then begin WriteHelp; Terminate; Exit; end; if HasOption('t', 'termstr') then begin TermString := GetOptionValue('t', 'termstr'); end else TermString := ''; FormatCSV := HasOption('c', 'csv'); UseEscapeChars := HasOption('e', 'escape'); LogEnabled := HasOption('l', 'log'); if LogEnabled then begin LogDir := GetUserDir + DirectorySeparator + '.linetime' + DirectorySeparator + 'logs'; ForceDirectories(LogDir); FileName := LogDir + DirectorySeparator + FormatDateTime('yyyymmddhhnnss', Now) + '.log'; LogFile := TFileStream.Create(FileName, fmCreate); end; NewLine := True; ShowTime := True; FirstLine := True; StartTime := Now; LastLineTime := 0; TermStringIndex := 1; TextOnLine := False; try if TestMode then begin InputStream := TMemoryStream.Create; InputStream.Write(TestString[1], Length(TestString)); InputStream.Position := 0; end else InputStream := TIOStream.Create(iosInput); repeat SetLength(Buffer, 1000); Count := InputStream.Read(Buffer[1], Length(Buffer)); SetLength(Buffer, Count); ProcessBuffer(Buffer); until (Count = 0) or Terminated; NewLineEnding := LineEnding; PrintOutput(''); finally InputStream.Free; end; WriteRaw(LineEnding); WriteLog(LineEnding); Terminate; end; procedure TMyApplication.TermCheckString(Buffer: string); var I: Integer; begin // Search for termination string if TermString <> '' then for I := 1 to Length(Buffer) do begin if TermStringIndex > Length(TermString) then begin Terminate; Break; end; if Buffer[I] = TermString[TermStringIndex] then Inc(TermStringIndex) else TermStringIndex := 1; end; end; function TMyApplication.FindLineEnding(Buffer: string; var FoundLineEnding: string): Integer; const LineEnding1 = #13#10; LineEnding2 = #10; LineEnding3 = #13; var P: Integer; begin Result := 0; FoundLineEnding := ''; P := Pos(LineEnding1, Buffer); if (P > 0) and (((Result > 0) and (P < Result)) or (Result = 0)) then begin Result := P; FoundLineEnding := LineEnding1; end; P := Pos(LineEnding2, Buffer); if (P > 0) and (((Result > 0) and (P < Result)) or (Result = 0)) then begin Result := P; FoundLineEnding := LineEnding2; end; P := Pos(LineEnding3, Buffer); if (P > 0) and (((Result > 0) and (P < Result)) or (Result = 0)) then begin Result := P; FoundLineEnding := LineEnding3; end; end; procedure TMyApplication.WriteRaw(Text: string); begin Write(Text); end; procedure TMyApplication.WriteLog(Text: string); begin if LogEnabled then begin if Length(Text) > 0 then LogFile.Write(Text[1], Length(Text)); end; end; procedure TMyApplication.PrintOutput(Output: string); begin TermCheckString(Output); if NewLine then begin if not FirstLine then begin // If previous line was empty then print time prefix before move to next line if (not TextOnLine) then ShowTimePrefix; if FormatCSV then begin WriteRaw('"' + LineEnding); end else begin WriteRaw(NewLineEnding); end; TextOnLine := False; end; WriteLog(LineEnding); NewLine := False; FirstLine := False; end; if Length(Output) > 0 then TextOnLine := True; if TextOnLine and ShowTime then begin ShowTimePrefix; ShowTime := False; end; WriteRaw(Output); WriteLog(Output); end; procedure TMyApplication.ShowTimePrefix; var LineTime: TDateTime; TimeStr: string; begin LineTime := Now - StartTime; TimeStr := FloatToStrF(LineTime / OneSecond, ffFixed, 10, 2); if FormatCSV then begin WriteRaw(TimeStr + ',' + FloatToStrF((LineTime - LastLineTime) / OneSecond, ffFixed, 10, 2) + ',"'); end else begin if UseEscapeChars then WriteRaw(#$1b'[0;32m' + TimeStr + #$1b'[0m ') else WriteRaw(TimeStr + ' '); end; WriteLog(TimeStr + ' '); LastLineTime := LineTime; Sleep(Trunc(TestLineDelay / OneMillisecond)); end; procedure TMyApplication.ProcessBuffer(Buffer: string); var P: Integer; I: Integer; Part: string; FoundLineEnding: string; begin NewLineEnding := LineEnding; repeat FoundLineEnding := ''; P := FindLineEnding(Buffer, FoundLineEnding); if P > 0 then begin Part := Copy(Buffer, 1, P - 1); if FormatCSV then Part := StringReplace(Part, '"', '""', [rfReplaceAll]); PrintOutput(Part); NewLineEnding := FoundLineEnding; Delete(Buffer, 1, P - 1 + Length(FoundLineEnding)); NewLine := True; ShowTime := True; end; until P = 0; PrintOutput(Buffer); end; constructor TMyApplication.Create(TheOwner: TComponent); begin inherited Create(TheOwner); StopOnException := True; TestLineDelay := 0; TestMode := False; //TestMode := True; if TestMode then begin TestLineDelay := 10 * OneMillisecond; //TestString := 'Line 1'#13#10'Line 2'#13'Line 3'#10'Line 4 abcd abcd xyz'#13#10#13#10'Line 9'#13#13#10'Line 10'; TestString := 'sas'#13#13#10'Line 10'; end; end; destructor TMyApplication.Destroy; begin FreeAndNil(LogFile); inherited Destroy; end; procedure TMyApplication.WriteHelp; begin WriteLn('Usage: ', ExeName, ' '); WriteLn(' -h --help Show this help'); WriteLn(' -c --csv Print lines in CSV format'); WriteLn(' -l --log Log output to log files in ~/.linetime/logs'); WriteLn(' -t --termstr Termination string'); WriteLn(' -e --escape Use escape characters for color change'); end; var Application: TMyApplication; begin Application := TMyApplication.Create(nil); Application.Run; Application.Free; end.