source: cprs/branches/GUI-config/BDK32/Samples/SharedRPCBroker/BrokerEx/fBrokerExample.pas@ 1123

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

New WorldVistA Config Utility

File size: 9.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, BrokerExampleAboutFrm, Buttons,
59 ActiveX, SharedRPCBroker;
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 RPCBroker1: TSharedRPCBroker;
114 procedure AboutExampleClick(Sender: TObject);
115 procedure btnEchoStringClick(Sender: TObject);
116 procedure btnConnectClick(Sender: TObject);
117 procedure btnPassByRefClick(Sender: TObject);
118 procedure btnGetListClick(Sender: TObject);
119 procedure btnSortNumClick(Sender: TObject);
120 procedure btnWPTextClick(Sender: TObject);
121 procedure Timer1Timer(Sender: TObject);
122 procedure btnGetServerInfoClick(Sender: TObject);
123 procedure edtServerChange(Sender: TObject);
124 procedure FormCreate(Sender: TObject);
125end;
126
127
128
129var
130 frmBrokerExample: TfrmBrokerExample;
131
132
133implementation
134
135{$R *.DFM}
136
137procedure TfrmBrokerExample.btnEchoStringClick(Sender: TObject);
138begin
139 RPCBroker1.RemoteProcedure := 'XWB EXAMPLE ECHO STRING';
140 RPCBroker1.Param[0].Value := edtStrOrig.Text;
141 RPCBroker1.Param[0].PType := literal;
142 RPCBroker1.Call; //execute RPC
143 edtStrRtrn.Text := RPCBroker1.Results[0]; //for single value use Results[0]
144end;
145
146
147
148procedure TfrmBrokerExample.btnPassByRefClick(Sender: TObject);
149begin
150 RPCBroker1.RemoteProcedure := 'XWB GET VARIABLE VALUE';
151 RPCBroker1.Param[0].Value := edtReference.Text;
152 RPCBroker1.Param[0].PType := reference;
153 edtValue.Text := RPCBroker1.strCall; //execute RPC and show result in one call
154end;
155
156
157
158procedure TfrmBrokerExample.btnGetListClick(Sender: TObject);
159begin
160 RPCBroker1.RemoteProcedure := 'XWB EXAMPLE GET LIST';
161 if RadioButton1.Checked then begin
162 RPCBroker1.Param[0].Value := 'LINES';
163 RPCBroker1.Param[0].PType := literal;
164 RPCBroker1.Param[1].Value := IntToStr(spnLines.Value);
165 RPCBroker1.Param[1].PType := literal;
166 end
167 else begin
168 RPCBroker1.Param[0].Value := 'KILOBYTES';
169 RPCBroker1.Param[0].PType := literal;
170 RPCBroker1.Param[1].Value := IntToStr(spnKbytes.Value);
171 RPCBroker1.Param[1].PType := literal
172 end;
173 RPCBroker1.Call; //execute RPC
174 lstData.Items := RPCBroker1.Results; //show results of the call
175end;
176
177
178
179procedure TfrmBrokerExample.btnWPTextClick(Sender: TObject);
180begin
181 RPCBroker1.RemoteProcedure := 'XWB EXAMPLE WPTEXT';
182 RPCBroker1.lstCall(mmoText.Lines); //execute RPC and show results in one call
183end;
184
185
186
187procedure TfrmBrokerExample.btnSortNumClick(Sender: TObject);
188var
189 I, SaveRPCTimeLimit: integer;
190begin
191 lblStatus.Visible := True; //turn on status label
192 lblStatus.Caption := 'building'; //tell user what's happenning
193 Application.ProcessMessages; //give Windows chance to paint
194 with RPCBroker1 do begin
195 RemoteProcedure := 'XWB EXAMPLE SORT NUMBERS';
196 if rgrDirection.ItemIndex = 0 then Param[0].Value := 'LO'
197 else Param[0].Value := 'HI';
198 Param[0].PType := literal;
199 with Param[1] do begin
200 PType := list; //tells Broker to pass Mult
201 for I := 0 to spnNumbers.Value - 1 do //build Mult one by one
202 Mult[IntToStr(Random(10000)+1)] := IntToStr(I); //subscript and value are strings!
203 end;
204 lblStatus.Caption := 'RPC running';
205 Application.ProcessMessages; //give Windows chance to paint
206 SaveRPCTimeLimit := RPCTimeLimit;
207 RPCTimeLimit := spnNumbers.Value div 10; //adjust in case a lot of numbers
208 Call; //execute RPC
209 lstSorted.Items := Results; //show results of the call
210 RPCTimeLimit := SaveRPCTimeLimit; //restore original value
211 end;
212 lblStatus.Visible := False; //turn off status label
213end;
214
215
216
217procedure TfrmBrokerExample.btnConnectClick(Sender: TObject);
218begin
219 if btnConnect.Caption = '&Connect' then
220 begin //connect
221 RPCBroker1.ClearParameters := True; //try False, see what happens
222 try
223 RPCBroker1.Connected := True;
224 //establish connection
225 if not RPCBroker1.CreateContext('XWB BROKER EXAMPLE') then
226 ShowMessage('Context could not be created!');
227 except
228 on e: Exception do
229 ShowMessage('Error: ' + e.Message);
230 end;
231 end
232 else //disconnect
233 RPCBroker1.Connected := False;
234end;
235
236
237
238procedure TfrmBrokerExample.btnGetServerInfoClick(Sender: TObject);
239var
240 strServer, strPort: string;
241begin
242 if GetServerInfo(strServer, strPort)<> mrCancel then
243 begin {getsvrinfo}
244 edtServer.Text := strServer; //use chosen server
245 edtPort.Text := strPort; //use chosen port
246 end;
247end;
248
249
250
251procedure TfrmBrokerExample.edtServerChange(Sender: TObject);
252begin
253 RPCBroker1.Server := edtServer.Text; //use specified server name/addr
254 RPCBroker1.ListenerPort := StrToInt(edtPort.Text); //use specified port
255end;
256
257
258
259procedure TfrmBrokerExample.Timer1Timer(Sender: TObject);
260begin
261 if RPCBroker1.Connected then begin
262 btnConnect.Caption := '&Disconnect';
263 btnConnect.Default := False;
264 Label3.Caption := 'Connected';
265 Label3.Font.Color := clLime; // clGreen; // went to lime for higher contrast at some of the High contrast desktops
266 end
267 else begin
268 btnConnect.Caption := '&Connect';
269 btnConnect.Default := True;
270 Label3.Caption := 'Disconnected';
271 Label3.Font.Color := clRed; // Stayed with Red, generated a high contrast across all of the various combinations
272 // Attempted to use clHighlight, but it did not show up like a highlight.
273 end;
274end;
275
276
277
278procedure TfrmBrokerExample.AboutExampleClick(Sender: TObject);
279begin
280 AboutBox.Show;
281end;
282
283
284procedure TfrmBrokerExample.FormCreate(Sender: TObject);
285begin
286 CoInitialize(nil);
287end;
288
289end.
290
291
Note: See TracBrowser for help on using the repository browser.