source: cprs/branches/GUI-config/BDK32/Samples/RPCBroker/BrokerEx/fBrokerExample.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: 13.2 KB
RevLine 
[476]1{**************************************************
2RPC Broker Example form ver. 1.1 9/3/97
3 Broker Development Team
4 San Francisco IRM Field Office, Dept. of Veterans Affairs
5
6Disclaimer:
7 This example does not attempt to teach general Delphi and M programming.
8 We intentionally removed any safeguards from the code that prevents
9 passing values that are too small or too large. Therefore, the important
10 code remains uncluttered and the programmer is free to experiment and
11 push the program beyond its limits.
12
13Purpose:
14 This sample application is an example of how to program client/server
15 applications in Delphi and M using the RPC Broker. The demonstrated features
16 include:
17 - Connecting to an M server
18 - Creating an application context
19 - Using the GetServerInfo function
20 - Displaying the VistA splash screen
21 - Setting the TRPCBroker Param property for each Param PType (literal,
22 reference, list)
23 - Calling RPCs with the Call method
24 - Calling RPCs with the lstCall and strCall methods
25
26 We encourage you to study the Delphi and M source code to see how the
27 Broker is used to accomplish these tasks. Try changing some of the
28 RPCBroker1 component properties to see what happens. Also, try other
29 values in the fields of the remote procedure records in the
30 REMOTE PROCEDURE file.
31
32Warning: "Get list" and "Sort numbers" tabs can potentially take excessively
33large data samples which can either crash server process or cause the
34connection timeout. Final note, memory allocation errors are not recorded
35in the Kernel error trap. They are recorded in the operating system error
36trap.
37
38Context option for this application:
39 XWB BROKER EXAMPLE
40
41Remote procedures used:
42 XWB EXAMPLE ECHO STRING
43 XWB EXAMPLE GET LIST
44 XWB EXAMPLE SORT NUMBERS
45 XWB EXAMPLE WPTEXT
46 XWB GET VARIABLE VALUE
47
48Server M routine:
49 XWBEXMPL
50**************************************************}
51unit fBrokerExample;
52
53interface
54
55uses
56 SysUtils,Forms, StdCtrls,Graphics, Dialogs, WinTypes,
57 Controls, Classes, ExtCtrls, TRPCB, XWBut1, MFunStr, Menus, WinProcs,
58 RpcConf1, Spin, ComCtrls, fVistAAbout, Buttons,
59 ActiveX, ActnList, CCOWRPCBroker, OleCtrls, VERGENCECONTEXTORLib_TLB;
60
61type
62 TfrmBrokerExample = class(TForm)
63 GroupBox2: TGroupBox;
64 Label2: TLabel;
65 Label3: TLabel;
66 MainMenu1: TMainMenu;
67 Help1: TMenuItem;
68 AboutExample: TMenuItem;
69 btnConnect: TButton;
70 edtPort: TEdit;
71 edtServer: TEdit;
72 PageControl1: TPageControl;
73 TabSheet1: TTabSheet;
74 TabSheet2: TTabSheet;
75 TabSheet3: TTabSheet;
76 TabSheet4: TTabSheet;
77 TabSheet5: TTabSheet;
78 lblSend: TLabel;
79 edtStrOrig: TEdit;
80 lblReturn: TLabel;
81 edtStrRtrn: TEdit;
82 btnEchoString: TButton;
83 lblList: TLabel;
84 Label1: TLabel;
85 edtReference: TEdit;
86 Label4: TLabel;
87 edtValue: TEdit;
88 btnPassByRef: TButton;
89 lstData: TListBox;
90 Label5: TLabel;
91 btnGetList: TButton;
92 btnWPText: TButton;
93 Label6: TLabel;
94 lstSorted: TListBox;
95 btnSortNum: TButton;
96 spnNumbers: TSpinEdit;
97 Label7: TLabel;
98 rgrDirection: TRadioGroup;
99 RadioButton1: TRadioButton;
100 RadioButton2: TRadioButton;
101 spnLines: TSpinEdit;
102 spnKbytes: TSpinEdit;
103 Timer1: TTimer;
104 mmoText: TMemo;
105 lblStatus: TLabel;
106 BitBtn1: TBitBtn;
107 btnGetServerInfo: TBitBtn;
108 Memo1: TMemo;
109 Memo2: TMemo;
110 Memo3: TMemo;
111 Memo4: TMemo;
112 Memo5: TMemo;
113 rgArrayType: TRadioGroup;
114 cbxBackwardCompatible: TCheckBox;
115 mnuOptions: TMenuItem;
116 mnuOptBackwardCompatible: TMenuItem;
117 mnuOptDebugMode: TMenuItem;
118 mnuOptUserContext: TMenuItem;
119 mnuOptOldConnectionOnly: TMenuItem;
120 ActionList1: TActionList;
121 actBackwardCompatible: TAction;
122 actOldConnectionOnly: TAction;
123 actDebugMode: TAction;
124 actUserContext: TAction;
125 RPCBroker1: TRPCBroker;
126 procedure AboutExampleClick(Sender: TObject);
127 procedure btnEchoStringClick(Sender: TObject);
128 procedure btnConnectClick(Sender: TObject);
129 procedure btnPassByRefClick(Sender: TObject);
130 procedure btnGetListClick(Sender: TObject);
131 procedure btnSortNumClick(Sender: TObject);
132 procedure btnWPTextClick(Sender: TObject);
133 procedure Timer1Timer(Sender: TObject);
134 procedure btnGetServerInfoClick(Sender: TObject);
135 procedure edtServerChange(Sender: TObject);
136 procedure FormCreate(Sender: TObject);
137 procedure rgArrayTypeClick(Sender: TObject);
138 procedure actBackwardCompatibleExecute(Sender: TObject);
139 procedure actDebugModeExecute(Sender: TObject);
140 procedure actUserContextExecute(Sender: TObject);
141 procedure actOldConnectionOnlyExecute(Sender: TObject);
142 public
143 procedure OnCCOWCommit(Sender: TObject); // CCOW related
144end;
145
146
147
148var
149 frmBrokerExample: TfrmBrokerExample;
150 ContextorControl1: TContextorControl; // CCOW related
151
152
153implementation
154
155{$R *.DFM}
156
157procedure TfrmBrokerExample.btnEchoStringClick(Sender: TObject);
158begin
159 RPCBroker1.RemoteProcedure := 'XWB EXAMPLE ECHO STRING';
160 RPCBroker1.Param[0].Value := edtStrOrig.Text;
161 RPCBroker1.Param[0].PType := literal;
162 RPCBroker1.Call; //execute RPC
163 edtStrRtrn.Text := RPCBroker1.Results[0]; //for single value use Results[0]
164end;
165
166
167
168procedure TfrmBrokerExample.btnPassByRefClick(Sender: TObject);
169begin
170 RPCBroker1.RemoteProcedure := 'XWB GET VARIABLE VALUE';
171 RPCBroker1.Param[0].Value := edtReference.Text;
172 RPCBroker1.Param[0].PType := reference;
173 edtValue.Text := RPCBroker1.strCall; //execute RPC and show result in one call
174end;
175
176
177
178procedure TfrmBrokerExample.btnGetListClick(Sender: TObject);
179begin
180 RPCBroker1.RemoteProcedure := 'XWB EXAMPLE GET LIST';
181 if RadioButton1.Checked then begin
182 RPCBroker1.Param[0].Value := 'LINES';
183 RPCBroker1.Param[0].PType := literal;
184 RPCBroker1.Param[1].Value := IntToStr(spnLines.Value);
185 RPCBroker1.Param[1].PType := literal;
186 end
187 else begin
188 RPCBroker1.Param[0].Value := 'KILOBYTES';
189 RPCBroker1.Param[0].PType := literal;
190 RPCBroker1.Param[1].Value := IntToStr(spnKbytes.Value);
191 RPCBroker1.Param[1].PType := literal
192 end;
193 RPCBroker1.Call; //execute RPC
194 lstData.Items := RPCBroker1.Results; //show results of the call
195end;
196
197
198
199procedure TfrmBrokerExample.btnWPTextClick(Sender: TObject);
200begin
201 RPCBroker1.RemoteProcedure := 'XWB EXAMPLE WPTEXT';
202 RPCBroker1.lstCall(mmoText.Lines); //execute RPC and show results in one call
203end;
204
205
206
207procedure TfrmBrokerExample.btnSortNumClick(Sender: TObject);
208var
209 I, SaveRPCTimeLimit, DefaultRange: integer;
210begin
211 lblStatus.Visible := True; //turn on status label
212 lblStatus.Caption := 'building'; //tell user what's happenning
213 Application.ProcessMessages; //give Windows chance to paint
214 with RPCBroker1 do
215 begin
216 if rgArrayType.ItemIndex = 0 then
217 begin
218 RemoteProcedure := 'XWB EXAMPLE SORT NUMBERS';
219 DefaultRange := 10000;
220 end
221 else
222 begin
223 RemoteProcedure := 'XWB EXAMPLE GLOBAL SORT';
224 DefaultRange := 100000;
225 end;
226
227 if rgrDirection.ItemIndex = 0 then Param[0].Value := 'LO'
228 else Param[0].Value := 'HI';
229 Param[0].PType := literal;
230 with Param[1] do begin
231 if rgArrayType.ItemIndex = 0 then
232 PType := list //tells Broker to pass Mult
233 else
234 PType := global;
235 for I := 0 to spnNumbers.Value - 1 do //build Mult one by one
236 Mult['"A'+IntToStr(I)+'"'] := IntToStr(Random(DefaultRange)+1); //subscript and value are strings!
237 end;
238 lblStatus.Caption := 'RPC running';
239 Application.ProcessMessages; //give Windows chance to paint
240 SaveRPCTimeLimit := RPCTimeLimit;
241 RPCTimeLimit := spnNumbers.Value div 10; //adjust in case a lot of numbers
242 Call; //execute RPC
243 lstSorted.Items := Results; //show results of the call
244 RPCTimeLimit := SaveRPCTimeLimit; //restore original value
245 end;
246 lblStatus.Visible := False; //turn off status label
247end;
248
249
250
251procedure TfrmBrokerExample.btnConnectClick(Sender: TObject);
252begin
253 if btnConnect.Caption = '&Connect' then
254 begin //connect
255 RpcBroker1.IsBackwardCompatibleConnection := actBackwardCompatible.Checked;
256 RpcBroker1.OldConnectionOnly := actOldConnectionOnly.Checked;
257 RpcBroker1.DebugMode := actDebugMode.Checked;
258 if RpcBroker1.IsBackwardCompatibleConnection or RpcBroker1.OldConnectionOnly then
259 begin
260 rgArrayType.ItemIndex := 0;
261 rgArrayType.Enabled := False;
262 end
263 else
264 begin
265 rgArrayType.Enabled := True;
266 end;
267{
268 // *********************** CCOW User Context ****************************
269 if actUserContext.Checked then
270 begin
271 if (RPCBroker1.Contextor = nil) then
272 begin
273 if ContextorControl1 = nil then
274 begin
275 ContextorControl1 := TContextorControl.Create(Self);
276 ContextorControl1.OnCommitted := OnCCOWCommit;
277 try
278 ContextorControl1.Run('CCOWTerm#', '', TRUE, '*');
279 except
280 ShowMessage('Problem with Contextor.Run');
281 ContextorControl1.Free;
282 ContextorControl1 := nil;
283 end;
284 end;
285 end;
286 RPCBroker1.Contextor := ContextorControl1;
287 end
288 else
289 RPCBroker1.Contextor := nil;
290
291 // *********************** End CCOW User Context *************************
292}
293
294 RPCBroker1.ClearParameters := True; //try False, see what happens
295 try
296 RPCBroker1.Connected := True;
297 //establish connection
298 if not RPCBroker1.CreateContext('XWB BROKER EXAMPLE') then
299 ShowMessage('Context could not be created!');
300 except
301 on e: Exception do
302 ShowMessage('Error: ' + e.Message);
303 end;
304 end
305 else //disconnect
306 RPCBroker1.Connected := False;
307end;
308
309
310
311procedure TfrmBrokerExample.btnGetServerInfoClick(Sender: TObject);
312var
313 strServer, strPort: string;
314begin
315 if GetServerInfo(strServer, strPort)<> mrCancel then
316 begin {getsvrinfo}
317 edtServer.Text := strServer; //use chosen server
318 edtPort.Text := strPort; //use chosen port
319 end;
320end;
321
322
323
324procedure TfrmBrokerExample.edtServerChange(Sender: TObject);
325begin
326 RPCBroker1.Server := edtServer.Text; //use specified server name/addr
327 RPCBroker1.ListenerPort := StrToInt(edtPort.Text); //use specified port
328end;
329
330
331
332procedure TfrmBrokerExample.Timer1Timer(Sender: TObject);
333begin
334 if RPCBroker1.Connected then begin
335 btnConnect.Caption := '&Disconnect';
336 btnConnect.Default := False;
337 mnuOptions.Enabled := False;
338 cbxBackwardCompatible.Enabled := False;
339 Label3.Caption := 'Connected';
340 Label3.Font.Color := clLime; // clGreen; // went to lime for higher contrast at some of the High contrast desktops
341 end
342 else begin
343 btnConnect.Caption := '&Connect';
344 btnConnect.Default := True;
345 mnuOptions.Enabled := True;
346 if not actOldConnectionOnly.Checked then
347 cbxBackwardCompatible.Enabled := True;
348 Label3.Caption := 'Disconnected';
349 Label3.Font.Color := clRed; // Stayed with Red, generated a high contrast across all of the various combinations
350 // Attempted to use clHighlight, but it did not show up like a highlight.
351 end;
352end;
353
354
355
356procedure TfrmBrokerExample.AboutExampleClick(Sender: TObject);
357begin
358 ShowAboutBox;
359end;
360
361
362procedure TfrmBrokerExample.FormCreate(Sender: TObject);
363begin
364{
365 CoInitialize(nil); // needed for CCOW
366}
367end;
368
369procedure TfrmBrokerExample.rgArrayTypeClick(Sender: TObject);
370begin
371 if rgArrayType.ItemIndex = 0 then
372 spnNumbers.Value := 500
373 else
374 spnNumbers.Value := 5000;
375end;
376
377procedure TfrmBrokerExample.actBackwardCompatibleExecute(Sender: TObject);
378begin
379 if actBackwardCompatible.Checked then
380 actBackwardCompatible.Checked := False
381 else
382 actBackwardCompatible.Checked := True;
383end;
384
385procedure TfrmBrokerExample.actDebugModeExecute(Sender: TObject);
386begin
387 if actDebugMode.Checked then
388 actDebugMode.Checked := False
389 else
390 actDebugMode.Checked := True;
391end;
392
393procedure TfrmBrokerExample.actUserContextExecute(Sender: TObject);
394begin
395 if actuserContext.Checked then
396 actUserContext.Checked := False
397 else
398 actUserContext.Checked := True;
399end;
400
401procedure TfrmBrokerExample.actOldConnectionOnlyExecute(Sender: TObject);
402begin
403 if actOldConnectionOnly.Checked then
404 begin
405 actOldConnectionOnly.Checked := False;
406 actBackwardCompatible.Enabled := True;
407 end
408 else
409 begin
410 actOldConnectionOnly.Checked := True;
411 actBackwardCompatible.Enabled := False;
412 end;
413end;
414
415procedure TfrmBrokerExample.OnCCOWCommit(Sender: TObject);
416begin
417{ // uses CCOWRPCBroker
418 if RpcBroker1.WasUserDefined and RpcBroker1.IsUserCleared then
419 Halt;
420}
421end;
422
423end.
424
425
Note: See TracBrowser for help on using the repository browser.