UAErrorHandler(0分)

unit UAErrorHandler;
interface
uses
Windows,
Messages,
SysUtils,
Variants,
Classes,
Forms,
Controls,
UAUnits,
UADataPacket;
type
TUAFileLocation = (flDefault, flProgram);
TUAErrorHandlerEx = class(TComponent)
private
FLogFile:string;
FUserName:string;
FMessage:string;
FLogLocation:TUAFileLocation;
function GetLogLocation: TUAFileLocation;
procedure SetLogLocation(const Value: TUAFileLocation);
procedure SetLogFile(const Value: string);
procedure SetUserName(const Value: string);
protected
FErrorMsgs:TList;
procedure SavingErrorLog;
function BuildDescription:string;
public
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
procedure Execute(sTitle:string;vValue:OleVariant;LUADataPacketType:TUADataPacketType;const iLevel:integer = 0);
property ErrorMsgs:TList read FErrorMsgs;
published
property LogLocation:TUAFileLocation read GetLogLocation write SetLogLocation default flProgram;
property LogFile:string read FLogFile write SetLogFile;
property UserName:string read FUserName write SetUserName;
end;

implementation
uses
uaFrmErrorHandler;
resourcestring
srUser = '系统用户:';
srProgram = '应用程序：';
srForm = '业务数据窗口：';
srControl = '错误对象：';
{-----------------------------------------------------------------------------
Procedure: TUAErrorHandlerEx.BuildDescription
Author: vinson zeng
Date: 13-三月-2004
Arguments: None
Result: string
-----------------------------------------------------------------------------}
function TUAErrorHandlerEx.BuildDescription: string;
var
i:integer;
sTmp:string;
begin

for i:= 0 to FErrorMsgs.Count -1do
begin
if trim(sTmp) <> '' then
sTmp := sTmp + #13#10 + 'UA Error Descs'+ IntToStr(i);
with TErrorParam(FErrorMsgs.Items)do
begin
sTmp := sTmp +
'Error Code:'+IntToStr(ErrorCode)+#13#10+
'Error Context:'+ ErrorContext +#13#10+
'Error Message:'+ ErrorMsg+#13#10;
end;
end;
Result := sTmp;
end;

constructor TUAErrorHandlerEx.Create(AOwner: TComponent);
begin
inherited;
FErrorMsgs := TList.Create;
FLogLocation := flProgram;
end;

destructor TUAErrorHandlerEx.Destroy;
begin
FErrorMsgs.Free;
inherited;
end;

procedure TUAErrorHandlerEx.Execute(sTitle:string;vValue:OleVariant;LUADataPacketType:TUADataPacketType;const iLevel:integer = 0);
var
LFrmErrorHandler:TFrmErrorHandler;
aRequestValue:TUARequestDataOutPacket;
aUpdateValue:TUAUpdateDataOutPacket;
aExecuteValue:TUAExecuteDataOutPacket;
aErrorParam:TErrorParam;
i:integer;
begin

LFrmErrorHandler := TFrmErrorHandler.Create(Self);
LFrmErrorHandler.lb_Msg.Caption := sTitle;
aRequestValue := TUARequestDataOutPacket.Create;
aUpdateValue := TUAUpdateDataOutPacket.Create;
aExecuteValue := TUAExecuteDataOutPacket.Create;
FErrorMsgs.Clear;
try
if iLevel = 0 then
LFrmErrorHandler.Image1.Picture.Icon.Handle := LoadIcon(0,IDI_WARNING);
case LUADataPacketType of
dtpRequest:
begin
aRequestValue.UAData := vValue;
if aRequestValue.CountErrorParam <> 0 then
begin
for i := 0 to aRequestValue.CountErrorParam -1do
begin
aErrorParam := aRequestValue.GetItemErrorParam(i);
FErrorMsgs.Add(aErrorParam);
end;
end;
end;
dtpUpdate:
begin
aUpdateValue.UAData := vValue;
if aUpdateValue.CountErrorParam <> 0 then
begin
for i := 0 to aUpdateValue.CountErrorParam -1do
begin
aErrorParam := aUpdateValue.GetItemErrorParam(i);
FErrorMsgs.Add(aErrorParam);
end;
end;
end;
dtpExecute:
begin
aExecuteValue.UAData := vValue;
if aExecuteValue.CountErrorParam <> 0 then
begin
for i := 0 to aExecuteValue.CountErrorParam -1do
begin
aErrorParam := aExecuteValue.GetItemErrorParam(i);
FErrorMsgs.Add(aErrorParam);
end;
end;

end;
end;

LFrmErrorHandler.InitErrors(FErrorMsgs);
LFrmErrorHandler.ShowModal;
if LFrmErrorHandler.ModalResult = mrOk then
begin
case LFrmErrorHandler.UAErrorProcType of
eptSend:
begin
end;
eptIgnore:
begin
end;
eptAbort:
begin
end;
end;
end;
finally
SavingErrorLog;
if Assigned(aRequestValue) then
FreeAndNil(aRequestValue);
if Assigned(aUpdateValue) then
FreeAndNil(aUpdateValue);
if Assigned(aExecuteValue) then
FreeAndNil(aExecuteValue);
if Assigned(LFrmErrorHandler) then
FreeAndNil(LFrmErrorHandler);

end;

end;

function TUAErrorHandlerEx.GetLogLocation: TUAFileLocation;
begin
Result := FLogLocation;
end;

procedure TUAErrorHandlerEx.SavingErrorLog;
var
F: Text;
LogName: TFileName;
begin
if Trim(FLogFile) = '' then
exit;
if (ExtractFilePath(FLogFile) = '') and (FLogLocation = flProgram) then
LogName := ExtractFilePath(Application.ExeName)+FLogFile
else
LogName := FLogFile;
AssignFile(F,LogName);
if FileExists(LogName) then
Append(F)
else
Rewrite(F);
try
WriteLn(F,DateTimeToStr(Now), srUser, FUserName, srProgram, Application.ExeName);
if Assigned(Screen.ActiveForm) then
with Screen.ActiveFormdo
begin
WriteLn(F,srForm,Name,', ',Caption);
if Assigned(ActiveControl) then
WriteLn(F,srControl,ActiveControl.Name);
end;
if BuildDescription <> '' then
WriteLn(F,BuildDescription)
else
WriteLn(F,FMessage);
Flush(F);
finally
CloseFile(F);
end;
end;

procedure TUAErrorHandlerEx.SetLogFile(const Value: string);
begin
FLogFile := Value;
end;

procedure TUAErrorHandlerEx.SetLogLocation(const Value: TUAFileLocation);
begin
FLogLocation := Value;
end;

procedure TUAErrorHandlerEx.SetUserName(const Value: string);
begin
FUserName := Value;
end;

end.