uaerrorhandler.pas

基于Midas 技术的多层应用开发包第二版（带开发文档）

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 -1 do
  begin
    if trim(sTmp) <> '' then sTmp := sTmp + #13#10 + 'UA Error Descs'+ IntToStr(i);
    with TErrorParam(FErrorMsgs.Items[i]) 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 -1 do
            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 -1 do
            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 -1 do
            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.ActiveForm do
      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.