umainfrm.pas

本示例说明怎样用XML来保存日志文件

unit UMainFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, DBClient, ExtCtrls, DBCtrls, Grids, DBGrids, StdCtrls, StrUtils;

type
  TMainFrm = class(TForm)
    ClientDataSet1: TClientDataSet;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    DBNavigator1: TDBNavigator;
    Button5: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button5Click(Sender: TObject);
  private
    { Private declarations }
  public
    LogStream: TStream;
    function OpenLogs(FileName: String): Boolean;
    function CloseLogs: Boolean;
    function SavLogs: Integer;
  end;

var
  MainFrm: TMainFrm;

implementation

uses UViewLog;

{$R *.dfm}

function TMainFrm.OpenLogs(FileName: String): Boolean;
var
  fs: TFileStream;
begin
  Result := False;
  if Assigned(LogStream) then Exit;
  fs := nil;
  try
    // If the file not exists, create it
    if not FileExists(FileName) then
      FileClose(FileCreate(FileName));

    fs := TFileStream.Create(FileName,
      fmOpenReadWrite or fmShareDenyWrite);
    LogStream := fs;
    ClientDataSet1.Active := False;
    ClientDataSet1.FieldDefs.Clear;
    ClientDataSet1.FieldDefs.Add('logid', ftInteger);
    ClientDataSet1.FieldDefs.Add('logtitle', ftString, 50);
    ClientDataSet1.FieldDefs.Add('logcontent', ftString, 500);

    ClientDataSet1.CreateDataSet;

    Result := True;
  except
    if Assigned(fs) then FreeAndNil(fs);
    Result := False;
  end;
end;

function TMainFrm.CloseLogs: Boolean;
begin
  if Assigned(LogStream) then FreeAndNil(LogStream);
  Result := True;
end;

function TMainFrm.SavLogs: Integer;
var
  ms: TMemoryStream;
  s, s1: String;
  p1, p2: PChar;
  ret: Integer;
begin
  ClientDataSet1.MergeChangeLog;
  Result := ClientDataSet1.RecordCount;
  ms := TMemoryStream.Create;
  ClientDataSet1.SaveToStream(ms, dfXMLUTF8);
  SetLength(s, ms.Size);
  ms.Position := 0;
  ms.Read(PChar(s)^, Length(s));
  ms.Free;

  p1 := SearchBuf(PChar(s), Length(s), 0, 0,
    '<ROWDATA>', );
  p2 := SearchBuf(PChar(s), Length(s), Length(s) - 1, 0,
    '</ROWDATA>', []);

  if Assigned(p1) and Assigned(p1) and (p1 < p2) then
  begin
    p1 := p1 + Length('<ROWDATA>');
    s1 := Copy(s, p1 - PChar(s) + 1, p2 - p1);
  end
  else
    s1 := '';

  if LogStream.Size = 0 then
  begin
    //ClientDataSet1.SaveToStream(LogStream, dfXML);
    p1 := StrScan(PChar(s), '<');
    p2 := StrScan(p1, '>');
    p2 := p2 + 1;
    ret := p2 - PChar(s) + 1;
    if Assigned(p2) and (ret < Length(s)) and (ret > 0) then
    begin
      Insert(#13#10'<?xml-stylesheet type="text/xsl"' +
        ' href="vlogs.xsl"?>'#13#10#13#10, s, ret);
    end;
    LogStream.Write(PChar(s)^, Length(s));
    // Flush to disk
    FlushFileBuffers(TFileStream(LogStream).Handle);
  end
  else
  begin
    SetLength(s, 100);
    LogStream.Seek(-100, soFromEnd);
    ret := LogStream.Read(PChar(s)^, Length(s));
    SetLength(s, ret);

    p1 := SearchBuf(PChar(s), Length(s), 0, 0, '</ROWDATA>');

    if Assigned(p1) and (s1 <> '') then
    begin
      ret := p1 - PChar(s);
      LogStream.Seek(ret - 100, soFromEnd);
      s := s1 + p1;
      LogStream.Write(PChar(s)^, Length(s));
      // Flush to disk
      FlushFileBuffers(TFileStream(LogStream).Handle);
    end
    else
      Result := -1;
  end;
  if Result > 0 then
  begin
    ClientDataSet1.EmptyDataSet;
    ClientDataSet1.MergeChangeLog;
  end;
end;

procedure TMainFrm.Button1Click(Sender: TObject);
begin
  if not OpenLogs('mm.xml') then
    ShowMessage('error');
end;

procedure TMainFrm.Button2Click(Sender: TObject);
begin
  CloseLogs;
end;

procedure TMainFrm.Button3Click(Sender: TObject);
var
  ret: Integer;
  t1, t2: Integer;
begin
  t1 := GetTickCount;
  ret := SavLogs;
  t2 := GetTickCount;
  if ret < 0 then ret := 0;
  Caption := IntToStr(ret) + ' records flush to disk, use time:' +
    IntToStr(t2-t1);;
end;

procedure TMainFrm.Button4Click(Sender: TObject);
var
  i: Integer;
  ct: Integer;
  t1, t2: Integer;
begin
  if ClientDataSet1.Active then
  begin
    t1 := GetTickCount;
    ClientDataSet1.DisableControls;
    ct := Random(2000) + 1000;
    for i := 0 to ct do
    begin
      ClientDataSet1.Append;
      ClientDataSet1.FieldByName('logid').AsInteger := Random(2000);
      ClientDataSet1.FieldByName('logtitle').AsString := 'fdkslajl' + IntToStr(Random(2000));
      ClientDataSet1.FieldByName('logcontent').AsString := '中华人民共和国' + IntToStr(Random(2000));
      ClientDataSet1.Post;
    end;
    ClientDataSet1.EnableControls;
    t2 := GetTickCount;
    Caption := IntToStr(ct) +
      ' records inerted, use time:' + IntToStr(t2-t1);
  end;
end;

procedure TMainFrm.FormCreate(Sender: TObject);
begin
  Randomize;
end;

procedure TMainFrm.FormDestroy(Sender: TObject);
begin
  CloseLogs;
end;

procedure TMainFrm.Button5Click(Sender: TObject);
begin
  FrmViewLog := TFrmViewLog.Create(Self);
  LogStream.Position := 0;
  FrmViewLog.ClientDataSet1.LoadFromStream(LogStream);
  FrmViewLog.ListView1.Items.Count :=
    FrmViewLog.ClientDataSet1.RecordCount;
  FrmViewLog.ShowModal;
  FreeAndNil(FrmViewLog);
end;

end.