| 资源简介： |
其中有个多线程日志类值得一看
{ 日志记录类
建立时间：2000.03.27
建 立 者：那璜懿
类 说 明：名称：TLog
属性：
property LogFileName : string; //日志文件名
方法：
procedure WriteMessage(sMessage : string); //所写内容
说明：
该类是线程安全的，不用考虑同时读写的问题
}
unit Log;
interface
uses sysutils,syncobjs,windows;
type
TLog = class
private
FLogFileName : string;
FWriteFlag : TCriticalSection;
function FWriteToLog(var sError:String):Boolean;
function FWriteToStr(var sError:String):Boolean;
public
procedure WriteMessage(sMessage : string);
procedure WriteString(sString:String);
constructor Create;
destructor Destroy;override;
published
property LogFileName : string read FLogFileName write FLogFileName;
end;
implementation
{ 内部记入Log文件}
constructor TLog.Create;
begin
inherited;
FWriteFlag := TCriticalSection.Create;
end;
destructor TLog.Destroy;
begin
FWriteFlag.Free;
FWriteFlag := nil;
inherited;
end;
function TLog.FWriteToLog(var sError:String):Boolean;
var __F : TextFile;
begin
Result := False;
FWriteFlag.Enter;
try
AssignFile(__F,FLogFileName);
if FileExists(FLogFileName) then Append(__F)
else ReWrite(__F);
try
sError := FormatDateTime('yyyy-mm-dd hh:nn:ss ',now)+sError+#13#10;
Write(__F,sError);
except
on E:Exception do begin
sError := sError + '在写日志文件'+FLogFileName+'时出错！'+E.Message+#13#10;
end;
end;
CloseFile(__F);
Result := True;
except
on E:Exception do begin
sError := sError + '在打开日志文件'+FLogFileName+'时出错！'+E.Message+#13#10;
end;
end;
FWriteFlag.Leave;
end;
function TLog.FWriteToStr(var sError:String):Boolean;
var __F : TextFile;
begin
Result := False;
FWriteFlag.Enter;
try
AssignFile(__F,FLogFileName);
//if FileExists(FLogFileName) then Append(__F)
//else ReWrite(__F);
ReWrite(__F);
try
sError := sError+#13#10;
Write(__F,sError);
except
on E:Exception do begin
sError := sError + '在写字符串文件'+FLogFileName+'时出错！'+E.Message+#13#10;
end;
end;
CloseFile(__F);
Result := True;
except
on E:Exception do begin
sError := sError + '在打开日志文件'+FLogFileName+'时出错！'+E.Message+#13#10;
end;
end;
FWriteFlag.Leave;
end;
{写入Log文件}
procedure TLog.WriteMessage(sMessage:string);
var __s : string;
__i : Integer;
begin
if length(FLogFileName) <= 0 then Exit;
__s := sMessage;
__i := 0;
while __i < 10 do begin
if FWriteToLog(__s) then break;
Sleep(10000);
__i := __i+1;
end;
end;
procedure TLog.WriteString(sString:string);
var __s : string;
__i : Integer;
begin
if length(FLogFileName) <= 0 then Exit;
__s := sString;
__i := 0;
while __i < 10 do begin
if FWriteToStr(__s) then break;
Sleep(10000);
__i := __i+1;
end;
end;
end.
|
网上文摘 
当前位置：Delphi园地 → 精彩源码 → 示例源码 → 导出生成Inert脚本 
本周下载排行
