logshow.pas

自己写的用delphi封装东劲板卡api.

unit LogShow;

interface

uses
  SysUtils, Classes,UnitWriteLogThread,ULogFrm;

type
  TLogShow = class(TComponent)
  private
    { Private declarations }
    LogList : TThreadList ;
    LogThread :TWriteLogThread ;

    function GetLogFileName:Shortstring;
    procedure AddLogToList(Log,LogSource:ShortString;LobLevel:TLogLevel);
    function  GetNextLog:PLogRecord;
    Procedure RemoveLogInList(Log:PLogRecord);
    procedure WriteLogFileAll ;overload;
    function WriteLogFileALL(FileName:ShortString):boolean;overload;

  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create;
    destructor destroy;override;
    function StartWriteLogThread : TWriteLogThread;
    function StopWriteLogThread:boolean;
    procedure MemoryToTxtFile(Mess:pchar; start, pCharLength:integer);
  published
    { Published declarations }
  end;

procedure Register;

implementation

{-------------------------------------------------------------------------------
  过程名:    MemoryToTxtFile
  作者:      fengfan
  日期:      2004.11.10
  说明:      将一段内存以字节的方式保存到文件中，而不管这个字节是否可见。
  参数:      Mess:pchar; start, Length:integer
  返回值:    无
-------------------------------------------------------------------------------}
procedure TLogShow.MemoryToTxtFile(Mess:pchar; start, pCharLength:integer);
var
  ExeName,FileName,ExtName,FilePath:ShortString;
  i:integer;
  MemoryStream :TMemoryStream ;
  FileNameLength :Integer;
begin
  ExtName := ExtractFileExt(Application.ExeName);
  FileName := ExtractFileName(Application.ExeName);
  FileNameLength := Length(FileName)-Length(ExtName) ;
  ExeName := Copy(FileName,1,FileNameLength);
  FilePath := ExtractFilePath(Application.ExeName);
  filename:=FilePath+'log\'+ExeName+formatdatetime('YYYYMMDDHHSSNN',Now);
  i := 0 ;
  while FileExists(FileName) do
  begin
    FileName := FileName + IntToStr(i);
    inc(i);
  end;
  MemoryStream := TMemoryStream.Create ;
  try
    MemoryStream.Write(Mess[Start],pCharLength);
    MemoryStream.SaveToFile(FileName);
  finally
    MemoryStream.free;
  end;
end;

{-------------------------------------------------------------------------------
  过程名:    AddLogToList
  作者:      fengfan
  日期:      2004.07.13
  说明:      将一条日志记录放入队列中。
  参数:      Log:shortstring
  20060827 修改
  返回值:    无
-------------------------------------------------------------------------------}
procedure TLogShow.AddLogToList(Log,LogSource:ShortString;LobLevel:TLogLevel);
var
  LogRecord:PLogRecord ;
begin
  new(LogRecord) ;
  FillChar(LogRecord.LogStr[0],sizeof(LogRecord.LogStr),#0);
  StrPCopy(LogRecord.LogStr,Log);
  FillChar(LogRecord.LogSource[0],sizeof(LogRecord.LogSource),#0);
  StrPCopy(LogRecord.LogSource,LogSource);
  LogRecord.LogTime := Now ;
  LogRecord.LogLevel := LogLevel ;
  LogList.Add(LogRecord);
end;

{-------------------------------------------------------------------------------
  过程名:    GetNextLog
  作者:      fengfan
  日期:      2004.07.13
  说明:      取日志队列中第一条日志记录
  参数:      无
  返回值:    PLogRecord
-------------------------------------------------------------------------------}
function  TLogShow.GetNextLog :PLogRecord;
var
  vList :TList;
begin
  Result := nil ;
  if not Assigned(LogList) then exit ;
  vList := LogList.LockList ;
  try
    if vList.Count > 0 then
    begin
      Result := PLogRecord(vList.items[0]);
    end
    else
    begin
      Result := nil;
    end;
  finally
    LogList.UnlockList ;
  end;
end;

{-------------------------------------------------------------------------------
  过程名:    RemoveLogInList
  作者:      fengfan
  日期:      2004.07.13
  说明:      从日志队列中移除一条日志记录      
  参数:      Log:PLogRecord
  返回值:    无
-------------------------------------------------------------------------------}
Procedure TLogShow.RemoveLogInList(Log:PLogRecord);
begin
  if not Assigned(LogList) then exit ;
  LogList.Remove(Log);
  Dispose(Log);
end;

{-------------------------------------------------------------------------------
  过程名:    GetLogFileName
  作者:      fengfan
  日期:      2004.07.13
  说明:      取得日志文件名 格式为：'路径'+'文件名'+'日期'+'_log'+'.txt'
  参数:      无
  返回值:    shortstring
-------------------------------------------------------------------------------}
function TLogShow.GetLogFileName: shortstring;
var
  ExeName,FileName,ExtName,FilePath:ShortString;
begin
  ExtName := ExtractFileExt(Application.ExeName);
  FileName := ExtractFileName(Application.ExeName);
  ExeName := Copy(FileName,1,Length(FileName)-Length(ExtName));
  FilePath := ExtractFilePath(Application.ExeName);
  result:=FilePath+'log\'+ExeName+datetostr(date)+'_log.html';
end;

{-------------------------------------------------------------------------------
  过程名:    WriteLogFileAll
  作者:      fengfan
  日期:      2004.07.13
  说明:      一次性将LogList中的文件写入日志文件,如果日志文件不存在,
             则释放日志占用内存
  参数:      无
  返回值:    无
-------------------------------------------------------------------------------}
procedure TLogShow.WriteLogFileAll;
var
  FileName:ShortString;
begin
  FileName :=  GetLogFileName ;
  if not WriteLogFileAll(FileName) then
  begin
    FileName := copy(FileName,1,Length(FileName) - 3 ) + 'bak';
    if not WriteLogFileAll(FileName) then
    begin
      ShowMessage('保存日志数据失败！'+#13+#13+#13+#13+#13+#13+#13+#13);
    end;
  end;
end;

function TLogShow.WriteLogFileALL(FileName:ShortString):boolean;
var
  LogStr:ShortString;
  LogFile :TextFile ;
  LogRecord :PLogRecord ;
  vList : TList ;
  TryNum,FileHanel : integer;
begin

  FileHanel := 0 ;
  if not FileExists(FileName) then
  begin
    FileHanel := FileCreate(FileName);
  end;
  if FileHanel = -1 then
  begin
    vList := LogList.LockList ;
    try
      while vList.Count >0 do
      begin
        LogRecord:= PLogRecord(vList.Items[0]);
        vList.Remove(LogRecord);
        Dispose(LogRecord);
      end;
    finally
      LogList.UnlockList ;
    end;
    Result := true ;
    Exit;
  end
  else
    FileClose(FileHanel);

  AssignFile(LogFile,FileName);
  vList := LogList.LockList ;
  Append(LogFile);
  try
    TryNum := 0 ;
    while vList.Count >0 do
    begin
      LogRecord:= PLogRecord(vList.Items[0]);
      LogStr := (datetimetostr(LogRecord.LogTime)+':'+LogRecord.LogStr) ;
      try
        writeln(LogFile,LogStr);
        vList.Remove(LogRecord);
        Dispose(LogRecord);
        TryNum := 0 ;
      except
        on e:Exception  do
        begin
          AddLogToListA('写入日志文件失败!'+e.Message,LogError);
          inc(TryNum);
        end;
      end;
      if TryNum > 10 then
      begin
        Sleep(1000);
        Result := False ;
        exit;
      end;
    end;
  finally
    LogList.UnlockList ;
    CloseFile(LogFile);
  end;
  Result := true ;
end;

{-------------------------------------------------------------------------------
  过程名:    StartWriteLogThread
  作者:      fengfan
  日期:      2004.07.13
  说明:      启动日志线程
  参数:      memo:TMemo
  返回值:    TWriteLogThread
-------------------------------------------------------------------------------}
function TLogShow.StartWriteLogThread :TWriteLogThread;
begin
  if LogList <> nil then
    //memo.Lines.Add('日志队列已经建立！')
  else
    LogList := TThreadList.Create ;
  if LogThread <> nil then
  begin
    //memo.Lines.Add('写日志线程已经存在');
    Result := LogThread;
    exit;
  end;
  LogThread := TWriteLogThread.create(True);
  try
    LogThread.Priority := tpLowest ;
    LogThread.Resume ;
    //AddLogToList('写日志线程成功启动!');
    result := LogThread ;
  except
    on e:exception do
    begin
      AddLogToList('写日志线程启动失败,错误信息为:'+E.Message);
      Result := Nil;
      exit ;
    end;
  end;
end;

{-------------------------------------------------------------------------------
  过程名:    StopWriteLogThread
  作者:      fengfan
  日期:      2004.07.13
  说明:      停止写日志线程，并将日志List中没有写入日志文件的日志写入日志文件
  参数:      WriteLogThread :TWriteLogThread
  返回值:    boolean
-------------------------------------------------------------------------------}
function TLogShow.StopWriteLogThread:boolean;
var
  i :integer;
begin
  if Assigned(LogThread) then
  begin
    LogThread.Terminate ;
    i := 0 ;
    while true do
    begin
      sleep(1000);
      if LogThread.Terminated then
      begin
        Sleep(1000);
        FreeAndNil(LogThread);
        break;
      end;
      inc(i);
      if i > 6 then break ;
    end;
  end;

  if Assigned(LogList) then
  begin
    i :=  LogList.LockList.Count;
    LogList.UnlockList;
    if i >0 then WriteLogFileAll ;
    FreeAndNil(LogList);
  end;
  Result := True ;
end;



procedure Register;
begin
  RegisterComponents('Samples', [TLogShow]);
end;

end.