logfile.pas

是和Delphi 编程精选集锦书本配套的源码

{*******************************************************}
{                                                       }
{          Logbook file manager library                 }
{                                                       }
{          Copyright(c) 2000,   Su Chengxiang           }
{                                                       }
{*******************************************************}

Unit LogFile;

{$R-}

Interface

uses Windows, Classes, SysUtils, SuObject;

type
  THourMinSec = record
    Hour,
    Min,
    Sec: Word;
   end;

{ TLogFile }
{ |-----------+----------+---------------------------|        }
{ FBuffer     FBufPos1   FBufPos2            FBuffer+FBufSize }

  PLogFile = ^TLogFile;
  TLogFile = Object(TSObject)
  private
    FFileName: string;
    FBuffer: PChar;
    FBufSize: DWord;
    FLoadFromDisk: Boolean;
  public
    FBufPos1: PChar;
    FBufPos2: PChar;
    FLineBuffer: PChar;
    constructor Create(FName: shortstring);
    destructor Destroy; virtual;
    procedure LoadFile;
    procedure StoreFile;
    procedure CopyBuffer(var ABuf: PChar);
    function IsFileLoaded: Boolean;
    function CountBufLines: Word;
    function GetLineStart(LineNum: Word): PChar;
    procedure GetALine(LineNum: Word);
    procedure SetLineBuf(Line: PChar);
    procedure SetBufPos(Pos: PChar);
    function SubStrCount(LineNum: Word): Word;
    function GetSubStr(LineNum, Index: Word): ShortString;
    property FileName: string read FFileName;
  end;

{ TTimeLogoFile }

  PTimeLogFile = ^TTimeLogFile;
  TTimeLogFile = object(TLogFile)
    FStartUpTime,
    FShutDownTime: TDateTime;
    constructor Create(FName: shortstring);
    procedure WriteStartUpTime;
    procedure WriteShutDownTime;
   Private
    FRunTime: THourMinSec;
    function StrToHourMinSec(AStr: ShortString; var HMS: THourMinSec): Boolean;
    function HourMinSecToStr(HMS: THourMinSec; HasSec: Boolean): ShortString;
    function GetLastTotalTime: THourMinSec;
    function CalcuRunTime: THourMinSec;
    function CalcuTotalTime: THourMinSec;
  end;

var
  StartUpTime: TDateTime;
//ShutDownTime: TDateTime;

Implementation

const
  MaxLineLen = 255;

  LogText1: PChar = '// Logbook (V1.0) 开机日志记录文件'#13#10'// Computer name: ';
  LogText2: PChar = #13#10 +
 '// 欢迎使用,保留版权.(2000年)(苏成翔.王峰) '#13#10 +
 '// '#13#10 +
{'[User] '#13#10 +}
{' 0000-00-00  00:00,  0000-00-00  00:00,   0h00m,  000h00m'#13#10 +}
 '[User] / 开机时刻,        关机时刻,       运行,   累计'#13#10 +
 '// End.'#13#10#26;

var
  LogText: PChar;

function FileValid(FName: shortstring): Boolean;
var
  OrigFileMode: Byte;
  FSize: DWord;
  F: file;
begin
  OrigFileMode:= FileMode;
  {$I-}
  AssignFile(F, FName);
  FileMode:= fmOpenRead;  { 0 - read only, 1 - write only, 2 - read/write }
  Reset(F, 1);
  FSize:= FileSize(F);
  CloseFile(F);
  {$I+}
  FileMode:= OrigFileMode;
  Result:= (IOResult = 0) and (FName <> '') and (FSize <> 0);
end;

{ TLogFile }

function StrCountChar(Str: PChar; Chr: Char): Cardinal; assembler;
asm
        PUSH    EDI
        PUSH    EBX
        PUSH    EAX
        MOV     EDI, Str
        MOV     ECX, 0FFFFFFFFH
        XOR     AL, AL
        REPNE   SCASB
        NOT     ECX
        XOR     EBX, EBX
        POP     EDI
        MOV     AL, Chr
@@1:    REPNE   SCASB
        JNE     @@2
        INC     EBX
        JMP     @@1
@@2:    MOV     EAX, EBX
        POP     EBX
        POP     EDI
end;

function LineCountChar(Str: PChar; Chr: Char): Cardinal; assembler;
asm
        PUSH    EDI
        PUSH    EBX
        PUSH    EAX
        MOV     EDI, Str
        MOV     ECX, 0FFFFFFFFH
        MOV     AL, 13
        REPNE   SCASB
        NOT     ECX
        XOR     EBX, EBX
        POP     EDI
        MOV     AL, Chr
@@1:    REPNE   SCASB
        JNE     @@2
        INC     EBX
        JMP     @@1
@@2:    MOV     EAX, EBX
        POP     EBX
        POP     EDI
end;

procedure InitLogText;
var
  LogTextSize: DWord;
begin
  LogTextSize:= StrLen(LogText1) + StrLen(LogText2) + StrLen(ComputerName) + 8;
  LogText:= StrAlloc(LogTextSize);
  LogText:= StrCopy(LogText, LogText1);
  LogText:= StrCat(LogText, ComputerName);
  LogText:= StrCat(LogText, LogText2);
end;

procedure DisposeLogText;
begin
  StrDispose(LogText);
end;

{ TLogFile }

constructor TLogFile.Create(FName: shortstring);
begin
  Inherited Create;
  FFileName:= FName;
  FBuffer:= nil;
  FBufSize:= 0;
  FBufPos1:= nil;
  FBufPos2:= nil;
  FLoadFromDisk:= True;
  FLineBuffer:= StrAlloc(255);
end;

destructor TLogFile.Destroy;
begin
  StrDispose(FLineBuffer);
  if IsFileLoaded then
    FreeMem(FBuffer, FBufSize);
  Inherited Destroy;
end;

procedure TLogFile.LoadFile;
var
  F: File;
begin
  if FileValid(FFileName) then
    begin
      AssignFile(F, FFileName);
      Reset(F, 1);
      FBufSize:= FileSize(F);
      GetMem(FBuffer, FBufSize + 2);
      BlockRead(F, FBuffer^, FBufSize);
      CloseFile(F);
      FLoadFromDisk:= True;
    end else
    begin
      InitLogText;
      FBufSize:= Length(LogText);
      GetMem(FBuffer, FBufSize+MaxLineLen*2);
      StrMove(FBuffer, LogText, FBufSize);
      DisposeLogText;
      FLoadFromDisk:= False;
    end;
  FBufPos1:= FBuffer;
end;

procedure TLogFile.StoreFile;
var
  F: File;
  Count: DWord;
begin
  if IsFileLoaded then
   begin
    AssignFile(F, FFileName);
    Rewrite(F, 1);
    Seek(F, 0);
    if FBufPos1 < FBuffer then FBufPos1:= FBuffer;
    if FBufPos2 < FBufPos1 then FBufPos2:= FBufPos1;
    //1st part
    Count:= FBufPos1 - FBuffer;
    if Count > 0 then BlockWrite(F, FBuffer^, Count);
    //2nd part
    Count:= StrLen(FLineBuffer);
    if Count > 0 then
      BlockWrite(F, FLineBuffer^, Count);
    //3rd part
    BlockWrite(F, FBufPos2^, FBuffer + FBufSize - FBufPos2);
    CloseFile(F);
    FreeMem(FBuffer, FBufSize);
    FBuffer:= nil;
    FBufPos1:= nil;
    FBufPos2:= nil;
    FBufSize:= 0;
    StrPCopy(FLineBuffer, #0);
   end;
end;

procedure TLogFile.CopyBuffer(var ABuf: PChar);
begin
  if (ABuf = nil) or (StrLen(ABuf) < FBufSize) then
    ABuf:= StrAlloc(FBufSize);
  ABuf:= StrCopy(ABuf, FBuffer);
end;

function TLogFile.IsFileLoaded: Boolean;
begin
  Result:= (FBuffer <> nil) and (FBufSize <> 0);
end;

function TLogFile.CountBufLines: Word;
var
  BufEnd, LastLine: PChar;
  N: Word;
begin
  N:= StrCountChar(FBuffer, #13);
  BufEnd:= StrEnd(FBuffer);
  LastLine:= StrRScan(FBuffer, #13) + 2;
  if BufEnd > LastLine then Inc(N);
  Result:= N;
end;

function TLogFile.GetLineStart(LineNum: Word): PChar;
var
  LastLine, P: PChar;
  I, N: Word;
begin
  I:= LineNum;
  N:= CountBufLines;
  if IsFileLoaded and (I > 0) and (I <= N) then
    begin
      P:= FBuffer;
      LastLine:= StrRScan(FBuffer, #13) + 2;
      while (I > 1) and (P < LastLine) do
        begin
          P:= StrScan(P, #13) + 2;
          Dec(I);
        end;
    end else
    P:= nil;
  Result:= P;
end;

procedure TLogFile.GetALine(LineNum: Word);
var
  NextLine, P: PChar;
  LineLen: Word;
begin
  P:= GetLineStart(LineNum);
  if P <> nil then
    begin
      NextLine:= StrScan(P, #13) + 2;
      if NextLine = nil then NextLine:= FBuffer + FBufSize;
      LineLen:=  NextLine - P;
      if LineLen > MaxLineLen then LineLen:= MaxLineLen;
      FLineBuffer:= StrMove(FLineBuffer, P, LineLen);
    end;
end;

procedure TLogFile.SetLineBuf(Line: PChar);
begin
  FLineBuffer:= StrCopy(FLineBuffer, Line);
end;

procedure TLogFile.SetBufPos(Pos: PChar);
begin
  if IsFileLoaded and (Pos >= FBuffer) and (Pos < FBuffer + FBufSize) then
    FBufPos1:= Pos;
end;

function TLogFile.SubStrCount(LineNum: Word): Word;
var  I1, N: Cardinal;
     P, P1, P2: PChar;
begin
  P:= GetLineStart(LineNum);
  P1:= StrScan(P, #13);
  N:= LineCountChar(P, ',');
  P2:= P;
  if N > 0 then
    for I1:= 1 to N do P2:= StrScan(P2, ',') + 1;
  if P1 = P2 then
    Result:= N else
    Result:= N + 1;
end;

function TLogFile.GetSubStr(LineNum, Index: Word): ShortString;
var
  I1, I2, N: Cardinal;
  P, P1, P2: PChar;
begin
  I1:= Index;
  N:= SubStrCount(LineNum);
  P:= GetLineStart(LineNum);
  if (I1 > 0) and (I1 <= N) then
    begin
      P1:= P;
      if I1 > 1 then
        for I2:= 2 to I1 do P1:= StrScan(P1, ',') + 1;
      P2:= P1;
      while (P2[0] <> ',') and (P2[0] <> #13) do P2:= P2 + 1;
      I2:= P2 - P1;
      StrMove(@Result[1], P1, I2);
      Result[0]:= Char(I2);
    end else
      Result:= '';
end;

{ TTimeLogFile }

constructor TTimeLogFile.Create(FName: shortstring);
begin
  Inherited Create(FName);
  FStartUpTime:= StartUpTime;
end;

function TTimeLogFile.GetLastTotalTime: THourMinSec;
var
  N, I: Word;
  P: PChar;
  LineFound: Boolean;
begin
  N:= CountBufLines;
  LineFound:= False;
  I:= 0;
  repeat
    Inc(I);
    P:= GetLineStart(I);
    LineFound:= (P[0] = '[') and (SubStrCount(I+1) = 4);
    if LineFound then LineFound:= StrToHourMinSec(GetSubStr(I+1, 4), Result);
   until LineFound or (I >= N -1);
  if not LineFound then
    with Result do
      begin
        Hour:= 0;
        Min:= 0;
        Sec:= 0;
      end;
end;

function TTimeLogFile.CalcuRunTime: THourMinSec;
var
  RunTime: TDateTime;
  D, H, M, S, MS: Word;
begin
  RunTime:= FShutDownTime - FStartUpTime;
  D:= Trunc(RunTime);  { Number of days }
  DecodeTime(RunTime, H, M, S, MS);
  if MS > 500 then
    begin    // MS:= 0;
      Inc(S);
      if S > 59 then
        begin
          Inc(M);
          S:= S - 60;
        end;
    end;
  if S <> 0 then  { Consider the time less than 1 min as 1 min }
    begin
      S:= 0;
      Inc(M);
      if M > 59 then
        begin
          Inc(H);
          M:= M - 60;
        end;
    end;
  with FRunTime do
    begin
      Hour:= D*24 + H;
      Min:= M;
      Sec:= S;
    end;
  Result:= FRunTime;
end;

function TTimeLogFile.CalcuTotalTime: THourMinSec;
begin
  Result:= GetLastTotalTime;
  with Result do
    begin
      Hour:= Hour + FRunTime.Hour;
      Min:= Min + FRunTime.Min;
      Sec:= Sec + FRunTime.Sec;
      if Sec > 60 then
        begin
          Dec(Sec, 60);
          Inc(Min);
        end;
      if Min >60 then
        begin
          Dec(Min, 60);
          Inc(Hour);
        end;
    end;
end;

procedure TTimeLogFile.WriteStartUpTime;
var
  N, I: Word;
  LineFound: Boolean;
  Str1: String;
begin
  LoadFile;
  N:= CountBufLines;
  if N > 0 then Dec(N);
  LineFound:= False;
  I:= 0;
  repeat
    Inc(I);
    FBufPos1:= GetLineStart(I);
    LineFound:= (FBufPos1[0] = '[');
   until LineFound or (I >= N);
  if not LineFound then
    FBufPos1:= GetLineStart(6);
  FBufPos2:= FBufPos1;
  DateTimeToString(Str1, ' yyyy/mm/dd  hh:nn, ...'#13#10, FStartUpTime);
  FLineBuffer:= StrCopy(FLineBuffer, '[');
  FLineBuffer:= StrCat(FLineBuffer, UserName);
  FLineBuffer:= StrCat(FLineBuffer, ']'#13#10);
  FLineBuffer:= StrCat(FLineBuffer, PChar(Str1));
  StoreFile;
end;

procedure TTimeLogFile.WriteShutDownTime;
var
  N, I: Word;
  LineFound: Boolean;
  Str1: String;
  P: PChar;
begin
  LoadFile;
  N:= CountBufLines;
  if N > 0 then Dec(N);
  LineFound:= False;
  I:= 0;
  repeat
    Inc(I);
    FBufPos1:= GetLineStart(I);
    LineFound:= (FBufPos1[0] = '[');
   until LineFound or (I >= N);
  P:= StrScan(GetLineStart(I + 1), #13);
  FBufPos1:= StrScan(GetLineStart(I + 1), '.');
  if (FBufPos1 <> nil) then FBufPos2:= FBufPos1 + 3
    else LineFound:= False;
  FShutDownTime:= now;
  if LineFound then
   begin
    DateTimeToString(Str1, '  yyyy/mm/dd  hh:nn,  ', FShutDownTime);
    Str1:= Str1 + HourMinSecToStr(CalcuRunTime, False) +  ',  ' +
           HourMinSecToStr(CalcuTotalTime, False);
   end else
    begin
     FBufPos1:= P;  FBufPos2:= P;
     DateTimeToString(Str1, '"Can not find the StartUp time and Shutdown at" yyyy/mm/dd  hh:nn.', FShutDownTime);
    end;
  FLineBuffer:= StrPCopy(FLineBuffer, Str1);
  StoreFile;
end;

function TTimeLogFile.StrToHourMinSec(AStr: ShortString; var HMS: THourMinSec): Boolean;
var
  L, I, Code: Integer;
  S1: ShortString;
  C: Char;
begin
  L:= Length(AStr);
  Result:= True;
  S1:= '';
  for I:= 1 to L do
    begin
      C:= AStr[I];
      case C of
        ' ': begin end;
        '0'..'9': S1:= S1 + C;
        'h':
          begin
            Val(S1, HMS.Hour, Code);
            S1:= '';
          end;
        'm':
          begin
            Val(S1, HMS.Min, Code);
            if HMS.Min > 59 then HMS.Min:= 59;
            S1:= '';
          end;
        's':
          begin
            Val(S1, HMS.Sec, Code);
            if HMS.Sec > 59 then HMS.Sec:= 59;
            S1:= '';
          end;
      else
        begin
          Result:= False;
          Exit;
        end;
      end;
    end;
end;

function TTimeLogFile.HourMinSecToStr(HMS: THourMinSec; HasSec: Boolean): ShortString;
var
  Str1, Str2, Str3: ShortString;
begin
  with HMS do
    begin
      Str(Hour, Str1);
      Str(Min, Str2);
      Str(Sec, Str3);
    end;
  Result:= Str1 + 'h' + Str2 + 'm';
  if HasSec then
    Result:= Result + Str3 + 's';
end;


Initialization
  StartUpTime:= Now;

end.