hberrors.pas

Midas.dll全部源码

{*******************************************************}
{                                                       }
{         Vladimir Gaitanoff HyperBase                  }
{                                                       }
{         Error handling                                }
{                                                       }
{         Copyright (c) 1997,99 Vladimir Gaitanoff      }
{                                                       }
{*******************************************************}

{$I HB.INC}
{$D-,L-}

unit hbErrors;

interface
uses hbIntf, SysUtils;

type

{ EHDBError }
  EHDBError = class(Exception)
  private
    FError: DBResult;
  public
    constructor Create(AError: DBResult);
    property Error: DBResult read FError;
  end;

{ EHDBNavigation }
  EHDBNavigation = class(EHDBError)
  end;

procedure HBError(Status: DBResult);

procedure Check(Status: DBResult);

function HandleExceptions: DBResult;

procedure GetErrorMessage(Status: DBResult; Msg: PChar);


implementation
uses hbConsts;

procedure HBError(Status: DBResult);
begin
  case Status of
    DBERR_BOF, DBERR_EOF:
      raise EHDBNavigation.Create(Status);
    else
      raise EHDBError.Create(Status);
  end;
end;

procedure Check(Status: DBResult);
begin
  if Status <> DBERR_NONE then HBError(Status);
end;

function HandleExceptions: DBResult;

  procedure Error;
  begin
    raise EInvalidOp.Create(Exception(ExceptObject).Message);
  end;

begin
  Result := DBERR_NONE;
  if ExceptObject is EHDBError then
    Result := EHDBError(ExceptObject).Error
  else if ExceptObject is EExternal then
    Result := DBERR_OSEINVMEM
  else if ExceptObject is EHeapException then
  begin
    if ExceptObject is EOutOfMemory then
      Result := DBERR_OSENOMEM
    else if ExceptObject is EInvalidPointer then
      Result := DBERR_OSEINVMEM
    else
      Error;
  end else
    Error;
end;

{ EHDBError }
constructor EHDBError.Create(AError: DBResult);
begin
  inherited Create('');
  FError := AError;
end;

procedure GetErrorMessage(Status: DBResult; Msg: PChar);

  procedure StrPut(const ErrMsg: string);
  begin
    StrCopy(Msg, PChar(ErrMsg));
  end;

begin
  case Status of
    DBERR_BOF:
      StrPut(SBOF);
    DBERR_EOF:
      StrPut(SEOF);
    DBERR_NOTSUPPORTED:
      StrPut(SNotSupported);
    DBERR_NA:
      StrPut(SNA);
    DBERR_NIY:
      StrPut(SNIY);
    DBERR_INVALIDFLDTYPE:
      StrPut(SInvalidFieldType);
    DBERR_INDEXNAMEREQUIRED:
      StrPut(SIndexNameReq);
    DBERR_NOSUCHINDEX:
      StrPut(SNoSuchIndex);
    DBERR_ACTIVEINDEX:
      StrPut(SActiveIndex);
    DBERR_INDEXREADONLY:
      StrPut(SIndexReadOnly);
    DBERR_NOTINDEXED:
      StrPut(SNotIndexed);
    DBERR_NAMENOTUNIQUE:
      StrPut(SNameNotUnique);
    DBERR_KEYVIOL:
      StrPut(SKeyViol);
    DBERR_REQDERR:
      StrPut(SReqdErr);
    DBERR_NOSUCHFILTER:
      StrPut(SNoSuchFilter);
    DBERR_READONLYFLD:
      StrPut(SReadOnlyFld);
    DBERR_TABLEREADONLY:
      StrPut(STableReadOnly);
    DBERR_RECNOTFOUND:
      StrPut(SRecNotFound);
    DBERR_NOCURRREC:
      StrPut(SNoCurrRec);
    DBERR_INVALIDMODIFYREQUEST:
      StrPut(SInvalidModifyReq);
    DBERR_DELTAISEMPTY:
      StrPut(SDeltaIsEmpty);
    DBERR_NOTHINGTOUNDO:
      StrPut(SNothingToUndo);
    DBERR_NOMETADATA:
      StrPut(SNoMetaData);
    DBERR_CANNOTAPPEND:
      StrPut(SCannotAppend);
    DBERR_DATAPACKETMISMATCH:
      StrPut(SDatapacketMismatch);
    DBERR_ABORTED:
      StrPut(SAborted);
    DBERR_CANCELLED:
      StrPut(SCancelled);
    DBERR_NEWERVERSIONREQ:
      StrPut(SNewVersionReq);
    DBERR_BLOBNOTFETCHED:
      StrPut(SBlobNotFetched);
    DBERR_DETAILSNOTFETCHED:
      StrPut(SDetailsNotFetched);
    DBERR_NOMASTERRECORD:
      StrPut(SNoMasterRecord);
    DBERR_LINKFIELDSNOTUNIQUE:
      StrPut(SLinkFieldsNotUnique);
    DBERR_FLYAWAY_WRONGORDER:
      StrPut(SFlyAwayWrongOrder);
    DBERR_NOCASCADEDUPDATES:
      StrPut(SNoCascadeUpdates);

    DBERR_REQOPTPARAM:
      StrPut(SReqOptParam);
    DBERR_INVALIDOPTPARAM:
      StrPut(SInvalidOptParam);

    DBERR_INVALIDLINKEXPR:
      StrPut(SInvalidLinkExpr);

    DBERR_NOXMLDATATYPE:
      StrPut(SNoXMLDataType);

    DBERR_OSENOMEM:
      StrPut(SOSENoMem);
    DBERR_OSEINVMEM:
      StrPut(SOSEInvMem);

    DBERR_CONSTRAINTFAILED:
      StrPut(SConstraintFailed);
  else
    StrPut(SNIA);
  end;
end;

end.