source: cprs/branches/GUI-config/BDK32/Source/RpcbErr.pas@ 881

Last change on this file since 881 was 476, checked in by Kevin Toppenberg, 16 years ago

New WorldVistA Config Utility

File size: 7.1 KB
RevLine 
[476]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
10unit Rpcberr;
11
12interface
13
14uses
15 TRPCB, Winsock, Classes, Forms, SysUtils, Controls,
16 StdCtrls, Buttons, ExtCtrls, Graphics, WinProcs;
17
18type
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
33var
34 frmRpcbError: TfrmRpcbError;
35
36procedure ShowBrokerError(BrokerError: EBrokerError);
37procedure NetError(Action: string; ErrType: integer);
38
39const
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;
58implementation
59uses wsockc;
60{$R *.DFM}
61
62
63procedure ShowBrokerError(BrokerError: EBrokerError);
64begin
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;
76end;
77
78
79procedure TfrmRpcbError.FormCreate(Sender: TObject);
80var
81 FIcon: TIcon;
82begin
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;
91end;
92
93procedure NetError(Action : String; ErrType: integer);
94var
95 x,s: string;
96 r: integer;
97 BrokerError: EBrokerError;
98begin
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;
184end;
185
186end.
Note: See TracBrowser for help on using the repository browser.