unit ULoggerForMyBean; interface uses mybean.core.objects, Classes, SysUtils, StrUtils, WindowsSysVersion, superobject, Dialogs, IdHTTP, ULogger, InterfaceLogger, DateUtils, WinSock; type TLoggerBean = class(TMyBeanInterfacedObject, ILogger) private FLoginName: string; FIP: string; FPlatform: string; FEnable: Boolean; FUrl, FAppCode, FClientVersion: string; public procedure Log(AMessage, ACode, ALoginName: string); overload; stdcall; procedure Log(AMessage, ACode, ALoginName, AStrLevel: string); overload; stdcall; procedure AsynLog(AMessage, ACode, ALoginName: string); stdcall; procedure Success(AMessage, ACode, ALoginName: string); stdcall; procedure Info(AMessage, ACode, ALoginName: string); stdcall; procedure Debug(AMessage, ACode, ALoginName: string); stdcall; procedure Warning(AMessage, ACode, ALoginName: string); stdcall; procedure Error(AMessage, ACode, ALoginName: string); stdcall; procedure Init; procedure LoadConfig; constructor Create; override; end; implementation { TLoggerBean } procedure TLoggerBean.AsynLog(AMessage, ACode, ALoginName: string); var AJson: TStringStream; AHttp: TIdHTTP; Respone, AJsonStr: string; ATimestamp: Int64; begin if not FEnable then Exit; ATimestamp := (DateTimeToUnix(Now) - 8*60*60) * 1000; AJsonStr := Format(JSON_LOG, [FAppCode, ALoginName, ATimestamp, FPlatform, FClientVersion, FIP, ACode, AMessage, 'error']); AJsonStr := StringReplace(AJsonStr, '\r\n', '[\r][\n]', [rfReplaceAll]); AJsonStr := StringReplace(AJsonStr, #13#10, '\r\n', [rfReplaceAll]); AJson := TStringStream.Create(AnsiToUtf8(AJsonStr)); AHttp := TIdHttp.Create(nil); AHttp.HandleRedirects := True;//允许头转向 AHttp.ReadTimeout := 5000;//请求超时设置 try AJson.Position := 0; Respone := AHttp.Post(FUrl, AJson); Respone := Utf8ToAnsi(Respone) finally AJson.Free; AHttp.Free; end; end; procedure TLoggerBean.Log(AMessage, ACode, ALoginName: string); begin Log(AMessage, ACode, ALoginName, 'error'); end; procedure TLoggerBean.Success(AMessage, ACode, ALoginName: string); begin Log(AMessage, ACode, ALoginName, 'success'); end; procedure TLoggerBean.Warning(AMessage, ACode, ALoginName: string); begin Log(AMessage, ACode, ALoginName, 'warning'); end; procedure TLoggerBean.LoadConfig; var AFullPath: string; jo: ISuperObject; begin AFullPath := ExtractFilePath(ParamStr(0)) + CONFIG_DIR; if not FileExists(AFullPath) then begin FEnable := False; Exit; end; try jo := TSuperObject.ParseFile(AFullPath, False); FEnable := jo['enable'].AsBoolean(); FUrl := jo['url'].AsString(); FAppCode := jo['appCode'].AsString(); FClientVersion := jo['clientVersion'].AsString(); except on E: Exception do begin FEnable := False; Dialogs.ShowMessage(E.Message); end; end; end; procedure TLoggerBean.Log(AMessage, ACode, ALoginName, AStrLevel: string); var AJson: string; ASendThread: TSendLogThread; ATimestamp: Int64; begin if not FEnable then Exit; try ATimestamp := (DateTimeToUnix(Now) - 8*60*60) * 1000; AJson := Format(JSON_LOG, [FAppCode, ALoginName, ATimestamp, FPlatform, FClientVersion, FIP, ACode, AMessage, AStrLevel]); AJson := StringReplace(AJson, '\r\n', '[\r][\n]', [rfReplaceAll]); AJson := StringReplace(AJson, #13#10, '\r\n', [rfReplaceAll]); except LoadConfig; Exit; end; ASendThread := TSendLogThread.Create(FUrl, Ajson); end; constructor TLoggerBean.Create; begin inherited; LoadConfig; Init; end; procedure TLoggerBean.Debug(AMessage, ACode, ALoginName: string); begin Log(AMessage, ACode, ALoginName, 'debug'); end; procedure TLoggerBean.Error(AMessage, ACode, ALoginName: string); begin Log(AMessage, ACode, ALoginName, 'error'); end; procedure TLoggerBean.Info(AMessage, ACode, ALoginName: string); begin Log(AMessage, ACode, ALoginName, 'info'); end; procedure TLoggerBean.Init; begin try FPlatform := '未知'; FIP := '0.0.0.0'; case GetWindowsSystemVersion of WinNone: FPlatform := '未知'; Win95: FPlatform := 'Windows 95'; Win98: FPlatform := 'Windows 98'; WinMe: FPlatform := 'Windows Me'; Win2000: FPlatform := 'Windows 2000'; WinServer2000: FPlatform := 'Windows Server 2000'; WinXp: FPlatform := 'Windows XP'; WinXp64: FPlatform := 'Windows XP x64'; WinServer2003: FPlatform := 'Windows Server 2003'; WinHomeServer: FPlatform := 'Windows Home Server'; WinServer2003R2: FPlatform := 'Windows Server 2003 R2'; WinVista: FPlatform := 'Windows Vista'; WinServer2008: FPlatform := 'Windows Server 2008'; WinServer2008R2: FPlatform := 'Windows Server 2008 R2'; Win7: FPlatform := 'Windows 7'; end; FIP := LocalIP; except on E: Exception do begin Dialogs.ShowMessage(E.Message); end; end; end; end.