日志线程单元
//用到THttpCli控件
{*******************************************************************************
Copyright (C), 2011-2015,
File name: UAddLogThread.pas
Author:
Version:
Date:
Description:
Others:
Function List:
History:
1. Date:
Author:
Modification: 上传票面内容，预警状态 midPostContent=5
2. ...
*******************************************************************************}
unit UAddLogThread;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,OverbyteIcsWndControl,
OverbyteIcsHttpProt,ExtCtrls;
type
TLogMsg = procedure(AMsg: string; const blnIsErrorMsg: boolean = False; const BoolSaveToFile: Boolean = True);
TRequestType =(rtPost,rtGet);
TModuleType = (mtAgent=1,mtDept=2);
TModuleID = (midAgentBet=1,midtAgentFeedback=2,midDeptGetTicket=3,midDeptFeedback=4,midPostContent=5);
TActionType= (atBegin=1,atEnd=2);
TAddLogThread = class(TThread)
private
FLogMsg:TLogMsg;
HTTPClient: THttpCli;
FInterval: Integer; //检查间隔 单位秒
ActionList:TStringList;
ErrorList:TStringList;
ErrorSmsList : TStringList ;
Account:string;
PassWord:string;
Host:string;
Port:integer;
{ Private declarations }
procedure DelActionList;
procedure DelErrorList;
procedure DelErrorSmsList ;
procedure pAddErrorLog(log:string);
procedure pAddActionLog(log:string);
procedure paddErrorSmsLog(log:string) ;
function HttpRequest(const RequestType: TRequestType; const Url, Data: string; var Html: string): Boolean;
public
constructor Create;
destructor Destroy;override;
{ Public declarations }
protected
procedure Execute; override;
end;
function InitLog(AAccount,APassWord,AHost:string;APort:integer;ALogMsg:TLogMsg;AInterval: Integer =3):boolean;
function AddErrorLog(BIZ_ID:integer;ModuleType:TModuleType;ModuleID:TModuleID;ErrorMsg:string):boolean;
function AddActionLog(BIZ_ID:integer;ModuleType:TModuleType;ModuleID:TModuleID;ActionType:TActionType):boolean;
function AddErrorSmsLog( ErrorSmsType : Integer ;ErrorMsg : string ): Boolean;
var
AddLogThread:TAddLogThread;
implementation
constructor TAddLogThread.Create;
begin
try
inherited Create(True);
FreeOnTerminate := True;
HTTPClient:=THttpCli.create(nil); //通过THttpCli控件上传信息
ActionList:=TStringList.Create ;
ErrorList:=TStringList.Create ;
ErrorSmsList := TStringList.Create;
//Self.Resume ;
except
on e:exception do
begin
FLogMsg('创建线程出错!'#13+e.Message,true,true);
end;
end;
end;
destructor TAddLogThread.Destroy;
begin
ActionList.Free;
ErrorList.Free;
ErrorSmsList.Free ;
HTTPClient.Free;
inherited;
end;
procedure TAddLogThread.Execute; //主线程
var
i:integer;
SubErrorList:TStringList;
SubActionList:TStringList;
subErrorSmsList : TStringList ;
ErrorURL,ActionURL,ErrorSmsURL,temp:string;
begin
while not Terminated do
begin
try
//服务器 等下要post的地址，
ErrorURL :='http://'+host+':'+inttostr(port)+'/Error.asp';
ActionURL :='http://'+host+':'+inttostr(port)+'/action.asp';
ErrorSmsURL := 'http://'+host+':'+inttostr(port)+'/needsms.asp';
//
if (ErrorList.Count >0) then
begin
SubErrorList:=TStringList.Create ;
try
SubErrorList.Add(Account+'||'+PassWord); //加上用户名和密码；
for i:=0 to ErrorList.Count-1 do
begin
SubErrorList.Add(ErrorList[0]); //取第一条post
synchronize(DelErrorList);
end;
try
HttpRequest(rtPost,ErrorURL,SubErrorList.Text,temp);
except
on e:exception do
begin
FLogMsg('向服务器发送错误日志出错!'#13+e.Message,true,true);
end;
end;
finally
SubErrorList.Free;
end;
end;
if (ErrorSmsList.Count >0) then
begin
subErrorSmsList:=TStringList.Create ;
try
subErrorSmsList.Add(Account+'||'+PassWord);
for i:=0 to ErrorSmsList.Count-1 do
begin
subErrorSmsList.Add(ErrorSmsList[0]);
synchronize(DelErrorSmsList);
end;
try
HttpRequest(rtPost,ErrorSmsURL,subErrorSmsList.Text,temp);
except
on e:exception do
begin
FLogMsg('向服务器发送错误日志出错!'#13+e.Message,true,true);
end;
end;
finally
subErrorSmsList.Free;
end;
end;
if (ActionList.Count >0) then
begin
SubActionList:=TStringList.Create ; //创建
try
SubActionList.Add(Account+'||'+PassWord); //添加验证信息
for i:=0 to ActionList.Count-1 do
begin
SubActionList.Add(ActionList[0]);
synchronize(DelActionList);
end;
try
HttpRequest(rtPost,ActionURL,SubActionList.Text,temp);
except
on e:exception do
begin
FLogMsg('向服务器发送运行日志出错!'#13+e.Message,true,true);
end;
end;
finally
SubActionList.Free;
end;
end;
for i := 1 to FInterval do
begin
if not Terminated then
Sleep(1000);
end;
except on e:exception do
begin
FLogMsg('线程Execute过程出错!'#13+e.Message,true,true);
end;
end;
end;
END;
function TAddLogThread.HttpRequest(const RequestType: TRequestType; const Url, Data: string;
var Html: string): Boolean;
var
DataLen: Int64;
//FailMsg: string;
begin
Result := False;
HTTPClient.URL := Url;
if RequestType = rtPost then
begin
HTTPClient.SendStream := TMemoryStream.Create;
HTTPClient.SendStream.Write(Data[1], Length(Data)); //通过流来发送数据
HTTPClient.SendStream.Seek(0, 0);
end;
HTTPClient.NoCache := True;
HTTPClient.RcvdStream := TMemoryStream.Create;
try
if RequestType = rtPost then
HTTPClient.Post
else
HTTPClient.Get;
try
DataLen := HTTPClient.RcvdStream.Size; //算接收回来的流长度
SetLength(Html, DataLen);
HTTPClient.RcvdStream.Position := 0;
HTTPClient.RcvdStream.Read(PChar(Html)^, DataLen); //取出流数据到Html
Result := True;
except
end;
finally
HTTPClient.SendStream.Free;
HTTPClient.SendStream := nil;
HTTPClient.RcvdStream.Free;
HTTPClient.RcvdStream := nil;
end;
end;
procedure TAddLogThread.DelActionList; //线程安全方法 删list(0)
begin
try
ActionList.Delete(0);
except
on e:exception do
begin
FLogMsg('ActionList.Delete(0)出错!'#13+e.Message,true,true);
end;
end;
end;
procedure TAddLogThread.DelErrorList; //线程安全方法 删list(0)
begin
try
ErrorList.Delete(0);
except
on e:exception do
begin
FLogMsg('ErrorList.Delete(0)出错!'#13+e.Message,true,true);
end;
end;
end;
procedure TAddLogThread.pAddErrorLog(log:string);
begin
try
if ErrorList.Count>1000*1000 then ErrorList.Clear;
ErrorList.Add(log);
except
on e:exception do
begin
FLogMsg('ErrorList.Add(log)出错!'#13+e.Message,true,true);
end;
end;
end;
procedure TAddLogThread.pAddActionLog(log:string);
begin
try
if ActionList.Count>1000*1000 then ActionList.Clear;
ActionList.Add(log);
except
on e:exception do
begin
FLogMsg('ActionList.Add(log)出错!'#13+e.Message,true,true);
end;
end;
end;
function AddErrorLog(BIZ_ID:integer;ModuleType:TModuleType;ModuleID:TModuleID;ErrorMsg:string):boolean; //添加错误日志
begin
try
ErrorMsg:=stringreplace(ErrorMsg,#13,' ',[rfreplaceall]);
ErrorMsg:=stringreplace(ErrorMsg,#10,' ',[rfreplaceall]);
ErrorMsg:=stringreplace(ErrorMsg,'||',' ',[rfreplaceall]);
AddLogThread.pAddErrorLog(inttostr(BIZ_ID)+'||'+inttostr(ord(ModuleType))+'||'+inttostr(ord(ModuleID))+'||'+ErrorMsg);
result:=true;
except
on e:exception do
begin
result:=false;
AddLogThread.FLogMsg('添加错误日志出错!'#13+e.Message,true,true);
end;
end;
end;
function AddActionLog(BIZ_ID:integer;ModuleType:TModuleType;ModuleID:TModuleID;ActionType:TActionType):boolean; //添加运行日志
begin
try
AddLogThread.pAddActionLog(inttostr(BIZ_ID)+'||'+inttostr(ord(ModuleType))+'||'+inttostr(ord(ModuleID))+'||'+inttostr(ord(ActionType)));
result:=true;
except
on e:exception do
begin
result:=false;
AddLogThread.FLogMsg('添加运行日志出错!'#13+e.Message,true,true);
end;
end;
end;
function AddErrorSmsLog( ErrorSmsType : Integer ;ErrorMsg : string): Boolean;
begin
try
ErrorMsg:=stringreplace(ErrorMsg,#13,' ',[rfreplaceall]);
ErrorMsg:=stringreplace(ErrorMsg,#10,' ',[rfreplaceall]);
ErrorMsg:=stringreplace(ErrorMsg,'||',' ',[rfreplaceall]);
AddLogThread.paddErrorSmsLog(inttostr(ErrorSmsType)+'||'+ErrorMsg);
result:=true;
except
on e:exception do
begin
result:=false;
AddLogThread.FLogMsg('添加需要发送短息错误日志出错!'#13+e.Message,true,true);
end;
end;
end;
//为什么没有被调用
function InitLog(AAccount,APassWord,AHost:string;APort:integer;ALogMsg:TLogMsg;AInterval: Integer =3):boolean; //初始化参数 与 时钟
begin
try
AddLogThread.FLogMsg:=ALogMsg;
AddLogThread.Account:=AAccount;
AddLogThread.PassWord:=APassWord;
AddLogThread.Host:=AHost;
AddLogThread.Port:=APort;
AddLogThread.FInterval:=AInterval;
AddLogThread.Resume ;
result:=true;
except
on e:exception do
begin
result:=false;
AddLogThread.FLogMsg('初始化参数出错!'#13+e.Message,true,true);
end;
end;
end;
procedure TAddLogThread.DelErrorSmsList;
begin
try
ErrorSmsList.Delete(0);
except
on e:exception do
begin
FLogMsg('ErrorSmsList.Delete(0)出错!'#13+e.Message,true,true);
end;
end;
end;
procedure TAddLogThread.paddErrorSmsLog(log: string);
begin
try
if ErrorSmsList.Count>1000*1000 then ErrorSmsList.Clear;
ErrorSmsList.Add(log);
except
on e:exception do
begin
FLogMsg('ErrorSmsList.Add(log)出错!'#13+e.Message,true,true);
end;
end;
end;
initialization
AddLogThread:=TAddLogThread.Create ; //初始默认创建，若不用建议屏蔽此句
finalization
AddLogThread.Terminate;
AddLogThread.Resume; //liping.chen 不加上这句无法正确释放。
WaitForSingleObject(AddLogThread.Handle, 500);
AddLogThread:=nil;
end.
浙公网安备 33010602011771号