| 1 | { ************************************************************** | 
|---|
| 2 | Package: XWB - Kernel RPCBroker | 
|---|
| 3 | Date Created: Sept 18, 1997 (Version 1.1) | 
|---|
| 4 | Site Name: Oakland, OI Field Office, Dept of Veteran Affairs | 
|---|
| 5 | Developers: Danila Manapsal, Don Craven, Joel Ivey | 
|---|
| 6 | Description: Error handling for TRPCBroker. | 
|---|
| 7 | Current Release: Version 1.1 Patch 40 (January 7, 2005)) | 
|---|
| 8 | *************************************************************** } | 
|---|
| 9 |  | 
|---|
| 10 | unit Rpcberr; | 
|---|
| 11 |  | 
|---|
| 12 | interface | 
|---|
| 13 |  | 
|---|
| 14 | uses | 
|---|
| 15 | TRPCB, Winsock, Classes, Forms, SysUtils, Controls, | 
|---|
| 16 | StdCtrls, Buttons, ExtCtrls, Graphics, WinProcs; | 
|---|
| 17 |  | 
|---|
| 18 | type | 
|---|
| 19 | TfrmRpcbError = class(TForm) | 
|---|
| 20 | BitBtn1: TBitBtn; | 
|---|
| 21 | BitBtn3: TBitBtn; | 
|---|
| 22 | Label1: TLabel; | 
|---|
| 23 | Bevel1: TBevel; | 
|---|
| 24 | Symbol: TImage; | 
|---|
| 25 | Label2: TLabel; | 
|---|
| 26 | Label3: TLabel; | 
|---|
| 27 | lblAction: TLabel; | 
|---|
| 28 | lblCode: TLabel; | 
|---|
| 29 | lblMessage: TLabel; | 
|---|
| 30 | procedure FormCreate(Sender: TObject); | 
|---|
| 31 | end; | 
|---|
| 32 |  | 
|---|
| 33 | var | 
|---|
| 34 | frmRpcbError: TfrmRpcbError; | 
|---|
| 35 |  | 
|---|
| 36 | procedure ShowBrokerError(BrokerError: EBrokerError); | 
|---|
| 37 | procedure NetError(Action: string; ErrType: integer); | 
|---|
| 38 |  | 
|---|
| 39 | const | 
|---|
| 40 | XWBBASEERR = {WSABASEERR + 1} 20000; | 
|---|
| 41 |  | 
|---|
| 42 | {Broker Application Error Constants} | 
|---|
| 43 | XWB_NO_HEAP = XWBBASEERR + 1; | 
|---|
| 44 | XWB_M_REJECT = XWBBASEERR + 2; | 
|---|
| 45 | XWB_BadSignOn = XWBBASEERR + 4; | 
|---|
| 46 | XWB_BldConnectList = XWBBASEERR + 5; | 
|---|
| 47 | XWB_NullRpcVer = XWBBASEERR + 6; | 
|---|
| 48 | XWB_ExeNoMem = XWBBASEERR + 100; | 
|---|
| 49 | XWB_ExeNoFile = XWB_ExeNoMem +  2; | 
|---|
| 50 | XWB_ExeNoPath = XWB_ExeNoMem +  3; | 
|---|
| 51 | XWB_ExeShare = XWB_ExeNoMem +  5; | 
|---|
| 52 | XWB_ExeSepSeg = XWB_ExeNoMem +  6; | 
|---|
| 53 | XWB_ExeLoMem = XWB_ExeNoMem +  8; | 
|---|
| 54 | XWB_ExeWinVer = XWB_ExeNoMem + 10; | 
|---|
| 55 | XWB_ExeBadExe = XWB_ExeNoMem + 11; | 
|---|
| 56 | XWB_ExeDifOS = XWB_ExeNoMem + 12; | 
|---|
| 57 | XWB_RpcNotReg = XWBBASEERR + 201; | 
|---|
| 58 | implementation | 
|---|
| 59 | uses wsockc; | 
|---|
| 60 | {$R *.DFM} | 
|---|
| 61 |  | 
|---|
| 62 |  | 
|---|
| 63 | procedure ShowBrokerError(BrokerError: EBrokerError); | 
|---|
| 64 | begin | 
|---|
| 65 | try | 
|---|
| 66 | Application.CreateForm(TfrmRpcbError, frmRpcbError); | 
|---|
| 67 | with frmRpcbError do begin | 
|---|
| 68 | lblAction.Caption := BrokerError.Action; | 
|---|
| 69 | lblCode.Caption := IntToStr(BrokerError.Code); | 
|---|
| 70 | lblMessage.Caption := BrokerError.Mnemonic; | 
|---|
| 71 | ShowModal; | 
|---|
| 72 | end | 
|---|
| 73 | finally | 
|---|
| 74 | frmRpcbError.Release; | 
|---|
| 75 | end; | 
|---|
| 76 | end; | 
|---|
| 77 |  | 
|---|
| 78 |  | 
|---|
| 79 | procedure TfrmRpcbError.FormCreate(Sender: TObject); | 
|---|
| 80 | var | 
|---|
| 81 | FIcon: TIcon; | 
|---|
| 82 | begin | 
|---|
| 83 | FIcon := TIcon.Create; | 
|---|
| 84 | try | 
|---|
| 85 | FIcon.Handle := LoadIcon(0, IDI_HAND); | 
|---|
| 86 | Symbol.Picture.Graphic := FIcon; | 
|---|
| 87 | Symbol.BoundsRect := Bounds(Symbol.Left, Symbol.Top, FIcon.Width, FIcon.Height); | 
|---|
| 88 | finally | 
|---|
| 89 | FIcon.Free; | 
|---|
| 90 | end; | 
|---|
| 91 | end; | 
|---|
| 92 |  | 
|---|
| 93 | procedure NetError(Action : String; ErrType: integer); | 
|---|
| 94 | var | 
|---|
| 95 | x,s: string; | 
|---|
| 96 | r: integer; | 
|---|
| 97 | BrokerError: EBrokerError; | 
|---|
| 98 | begin | 
|---|
| 99 | Screen.Cursor := crDefault; | 
|---|
| 100 | r := 0; | 
|---|
| 101 | if ErrType > 0 then r := ErrType; | 
|---|
| 102 | if ErrType = 0 then | 
|---|
| 103 | begin | 
|---|
| 104 | r := WSAGetLastError; | 
|---|
| 105 | //        if r = WSAEINTR then xFlush := True; | 
|---|
| 106 | //        if WSAIsBlocking = True then WSACancelBlockingCall; | 
|---|
| 107 | end; | 
|---|
| 108 | Case r of | 
|---|
| 109 | WSAEINTR           : x := 'WSAEINTR'; | 
|---|
| 110 | WSAEBADF           : x := 'WSAEINTR'; | 
|---|
| 111 | WSAEFAULT          : x := 'WSAEFAULT'; | 
|---|
| 112 | WSAEINVAL          : x := 'WSAEINVAL'; | 
|---|
| 113 | WSAEMFILE          : x := 'WSAEMFILE'; | 
|---|
| 114 | WSAEWOULDBLOCK     : x := 'WSAEWOULDBLOCK'; | 
|---|
| 115 | WSAEINPROGRESS     : x := 'WSAEINPROGRESS'; | 
|---|
| 116 | WSAEALREADY        : x := 'WSAEALREADY'; | 
|---|
| 117 | WSAENOTSOCK        : x := 'WSAENOTSOCK'; | 
|---|
| 118 | WSAEDESTADDRREQ    : x := 'WSAEDESTADDRREQ'; | 
|---|
| 119 | WSAEMSGSIZE        : x := 'WSAEMSGSIZE'; | 
|---|
| 120 | WSAEPROTOTYPE      : x := 'WSAEPROTOTYPE'; | 
|---|
| 121 | WSAENOPROTOOPT     : x := 'WSAENOPROTOOPT'; | 
|---|
| 122 | WSAEPROTONOSUPPORT : x := 'WSAEPROTONOSUPPORT'; | 
|---|
| 123 | WSAESOCKTNOSUPPORT : x := 'WSAESOCKTNOSUPPORT'; | 
|---|
| 124 | WSAEOPNOTSUPP      : x := 'WSAEOPNOTSUPP'; | 
|---|
| 125 | WSAEPFNOSUPPORT    : x := 'WSAEPFNOSUPPORT'; | 
|---|
| 126 | WSAEAFNOSUPPORT    : x := 'WSAEAFNOSUPPORT'; | 
|---|
| 127 | WSAEADDRINUSE      : x := 'WSAEADDRINUSE'; | 
|---|
| 128 | WSAEADDRNOTAVAIL   : x := 'WSAEADDRNOTAVAIL'; | 
|---|
| 129 | WSAENETDOWN        : x := 'WSAENETDOWN'; | 
|---|
| 130 | WSAENETUNREACH     : x := 'WSAENETUNREACH'; | 
|---|
| 131 | WSAENETRESET       : x := 'WSAENETRESET'; | 
|---|
| 132 | WSAECONNABORTED    : x := 'WSAECONNABORTED'; | 
|---|
| 133 | WSAECONNRESET      : x := 'WSAECONNRESET'; | 
|---|
| 134 | WSAENOBUFS         : x := 'WSAENOBUFS'; | 
|---|
| 135 | WSAEISCONN         : x := 'WSAEISCONN'; | 
|---|
| 136 | WSAENOTCONN        : x := 'WSAENOTCONN'; | 
|---|
| 137 | WSAESHUTDOWN       : x := 'WSAESHUTDOWN'; | 
|---|
| 138 | WSAETOOMANYREFS    : x := 'WSAETOOMANYREFS'; | 
|---|
| 139 | WSAETIMEDOUT       : x := 'WSAETIMEDOUT'; | 
|---|
| 140 | WSAECONNREFUSED    : x := 'WSAECONNREFUSED'; | 
|---|
| 141 | WSAELOOP           : x := 'WSAELOOP'; | 
|---|
| 142 | WSAENAMETOOLONG    : x := 'WSAENAMETOOLONG'; | 
|---|
| 143 | WSAEHOSTDOWN       : x := 'WSAEHOSTDOWN'; | 
|---|
| 144 | WSAEHOSTUNREACH    : x := 'WSAEHOSTUNREACH'; | 
|---|
| 145 | WSAENOTEMPTY       : x := 'WSAENOTEMPTY'; | 
|---|
| 146 | WSAEPROCLIM        : x := 'WSAEPROCLIM'; | 
|---|
| 147 | WSAEUSERS          : x := 'WSAEUSERS'; | 
|---|
| 148 | WSAEDQUOT          : x := 'WSAEDQUOT'; | 
|---|
| 149 | WSAESTALE          : x := 'WSAESTALE'; | 
|---|
| 150 | WSAEREMOTE         : x := 'WSAEREMOTE'; | 
|---|
| 151 | WSASYSNOTREADY     : x := 'WSASYSNOTREADY'; | 
|---|
| 152 | WSAVERNOTSUPPORTED : x := 'WSAVERNOTSUPPORTED'; | 
|---|
| 153 | WSANOTINITIALISED  : x := 'WSANOTINITIALISED'; | 
|---|
| 154 | WSAHOST_NOT_FOUND  : x := 'WSAHOST_NOT_FOUND'; | 
|---|
| 155 | WSATRY_AGAIN       : x := 'WSATRY_AGAIN'; | 
|---|
| 156 | WSANO_RECOVERY     : x := 'WSANO_RECOVERY'; | 
|---|
| 157 | WSANO_DATA         : x := 'WSANO_DATA'; | 
|---|
| 158 |  | 
|---|
| 159 | XWB_NO_HEAP        : x := 'Insufficient Heap'; | 
|---|
| 160 | XWB_M_REJECT       : x := 'M Error - Use ^XTER'; | 
|---|
| 161 | XWB_BadSignOn      : x := 'Sign-on was not completed.'; | 
|---|
| 162 | XWB_ExeNoMem       : x := 'System was out of memory, executable file was corrupt, or relocations were invalid.'; | 
|---|
| 163 | XWB_ExeNoFile      : x := 'File was not found.'; | 
|---|
| 164 | XWB_ExeNoPath      : x := 'Path was not found.'; | 
|---|
| 165 | XWB_ExeShare       : x := 'Attempt was made to dynamically link to a task,' + | 
|---|
| 166 | ' or there was a sharing or network-protection error.'; | 
|---|
| 167 | XWB_ExeSepSeg      : x := 'Library required separate data segments for each task.'; | 
|---|
| 168 | XWB_ExeLoMem       : x := 'There was insufficient memory to start the application.'; | 
|---|
| 169 | XWB_ExeWinVer      : x := 'Windows version was incorrect.'; | 
|---|
| 170 | XWB_ExeBadExe      : x := 'Executable file was invalid.' + | 
|---|
| 171 | ' Either it was not a Windows application or there was an error in the .EXE image.'; | 
|---|
| 172 | XWB_ExeDifOS       : x := 'Application was designed for a different operating system.'; | 
|---|
| 173 | XWB_RpcNotReg      : X := 'Remote procedure not registered to application.'; | 
|---|
| 174 | XWB_BldConnectList : x := 'BrokerConnections list could not be created'; | 
|---|
| 175 | XWB_NullRpcVer     : x := 'RpcVersion cannot be empty.' + #13 + 'Default is 0 (zero).'; | 
|---|
| 176 | else x := IntToStr(r); | 
|---|
| 177 | end; | 
|---|
| 178 | s := 'Error encountered.' + chr(13)+chr(10) + 'Function was: ' + Action + chr(13)+chr(10) + 'Error was: ' + x; | 
|---|
| 179 | BrokerError := EBrokerError.Create(s); | 
|---|
| 180 | BrokerError.Action := Action; | 
|---|
| 181 | BrokerError.Code := r; | 
|---|
| 182 | BrokerError.Mnemonic := x; | 
|---|
| 183 | raise BrokerError; | 
|---|
| 184 | end; | 
|---|
| 185 |  | 
|---|
| 186 | end. | 
|---|