source: cprs/branches/GUI-config/BDK32/Source/Rpcconf1.pas

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

New WorldVistA Config Utility

File size: 7.4 KB
Line 
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, Raul Mendoza, Joel Ivey
6 Description: Server selection dialog.
7 Current Release: Version 1.1 Patch 40 (January 7, 2005))
8*************************************************************** }
9
10{**************************************************
11 p13 - added an OnDestroy event to release the
12 help file. - REM (4/25/00)
13**************************************************}
14unit Rpcconf1;
15
16interface
17
18uses
19 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
20 Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, Xwbut1,
21 WinSock, rpcnet, MFunStr;
22
23type
24 TrpcConfig = class(TForm)
25 cboServer: TComboBox;
26 Panel2: TPanel;
27 Panel3: TPanel;
28 pnlPort: TPanel;
29 btnOk: TBitBtn;
30 btnCancel: TBitBtn;
31 Panel1: TPanel;
32 Panel4: TPanel;
33 btnHelp: TBitBtn;
34 New: TButton;
35 procedure cboServerClick(Sender: TObject);
36 procedure FormClose(Sender: TObject; var Action: TCloseAction);
37 procedure FormCreate(Sender: TObject);
38 procedure butOkClick(Sender: TObject);
39 procedure butCancelClick(Sender: TObject);
40 procedure FormDestroy(Sender: TObject);
41 procedure cboServerExit(Sender: TObject);
42 procedure NewClick(Sender: TObject);
43
44 private
45 { Private declarations }
46 OrigHelp : String; //Help filename of calling application.
47
48 public
49 { Public declarations }
50 ServerPairs : TStringList;
51 end;
52
53function GetServerInfo(var Server,Port: string): integer;
54function GetServerIP(ServerName: String): String;
55
56var
57 rpcConfig: TrpcConfig;
58 ButtonStatus, Instance: integer;
59 rServer, rPort: string;
60 TaskInstance: integer;
61
62implementation
63
64uses AddServer;
65
66{$R *.DFM}
67
68
69function IsIPAddress(Val: String): Boolean;
70var
71 I: Integer;
72 C: Char;
73begin
74 Result := True;
75 for I := 1 to Length(Val) do // Iterate
76 begin
77 C := Val[I];
78 if not (C in ['0','1','2','3','4','5','6','7','8','9','.']) then
79 begin
80 Result := False;
81 Break;
82 end;
83 end; // for
84end;
85
86{: Library function to obtain an IP address, given a server name }
87function GetServerIP(ServerName: String): String;
88var
89 host,outcome: PChar;
90begin
91 TaskInstance := LibOpen;
92 if not IsIPAddress(ServerName) then
93 begin
94 outcome := StrAlloc(256);
95 host := StrAlloc(length(ServerName) + 1);
96 StrPCopy(host, ServerName);
97 LibGetHostIP1(TaskInstance, host, outcome);
98 Result := StrPas(outcome);
99 StrDispose(outcome);
100 StrDispose(host);
101 end
102 else
103 Result := ServerName;
104 LibClose(TaskInstance);
105end;
106
107
108procedure TrpcConfig.cboServerClick(Sender: TObject);
109var
110 index: integer;
111begin
112 {Based on selction, set port and server variable}
113 index := cboServer.ItemIndex;
114 rPort := Piece(ServerPairs[index], ',', 2);
115 pnlPort.Caption := rPort;
116 rServer := Piece(ServerPairs[index], ',', 1);
117 btnOk.Enabled := True;
118
119 {Based on Server, get IP addresss.}
120 Panel4.Caption := GetServerIP(rServer);
121end;
122
123procedure TrpcConfig.FormCreate(Sender: TObject);
124begin
125 FormStyle := fsStayOnTop;
126 OrigHelp := Application.HelpFile; // Save original helpfile.
127 Application.HelpFile := ReadRegData(HKLM, REG_BROKER, 'BrokerDr') +
128 '\clagent.hlp'; // Identify ConnectTo helpfile.
129 ServerPairs := TStringList.Create;
130end;
131
132procedure TrpcConfig.FormClose(Sender: TObject; var Action: TCloseAction);
133begin
134 cboServer.Clear;
135 pnlPort.Caption := '';
136 ServerPairs.Free;
137 Application.HelpFile := OrigHelp; // Restore helpfile.
138end;
139
140function GetServerInfo(var Server,Port: string): integer;
141var
142 index: integer;
143 //tmp,fname,: string; {P14}
144 tmpServerPairs : TStringList; //Format: SERVER,port#
145 TextStr: String;
146
147begin
148 rpcconfig := Trpcconfig.Create(Application);
149 TaskInstance := LibOpen;
150
151 with rpcConfig do
152 begin
153 tmpServerPairs := TStringList.Create;
154 ReadRegValueNames(HKLM, REG_SERVERS, tmpServerPairs);
155 ServerPairs.Assign(tmpServerPairs);
156 tmpServerPairs.Clear;
157 ReadRegValueNames(HKCU, REG_SERVERS, tmpServerPairs);
158 for index := 0 to (tmpServerPairs.Count-1) do
159 begin
160 TextStr := tmpServerPairs[index];
161 if ServerPairs.IndexOf(TextStr) < 0 then
162 ServerPairs.Add(TextStr);
163 end;
164
165 ButtonStatus := mrOk;
166
167 if ServerPairs.Count < 1 then
168 begin
169 WriteRegData(HKLM, REG_SERVERS, 'BROKERSERVER,9200', '');
170 ServerPairs.Add('BROKERSERVER,9200');
171 end;
172
173
174 if ServerPairs.Count > 1 then // P31 //need to show form
175 begin
176 //Initialize form.
177 for index := 0 to (ServerPairs.Count -1) do //Load combobox
178 cboServer.Items.Add(ServerPairs[index]);
179// cboServer.Items.Add(Piece(ServerPairs[index], ',', 1));
180 cboServer.ItemIndex := 0;
181 rServer := Piece(ServerPairs[0], ',', 1);
182 pnlPort.Caption := Piece(ServerPairs[0], ',', 2);
183 rPort := Piece(ServerPairs[0], ',', 2);
184
185 //Get and display IP address.
186 panel4.Caption := GetServerIP(rServer);
187 ShowModal; //Display form
188 end
189 else //One choice: form not shown, value returned.
190 begin
191 rServer := Piece(ServerPairs[0], ',', 1);
192 rPort := Piece(ServerPairs[0], ',', 2);
193 end;
194
195 if ButtonStatus = mrOk then
196 begin
197 Server := rServer;
198 Port := rPort;
199 end;
200 Result := ButtonStatus;
201
202 tmpServerPairs.Free;
203 libClose(TaskInstance);
204 Release;
205 end;
206end;
207
208procedure TrpcConfig.butOkClick(Sender: TObject);
209begin
210 ButtonStatus := mrOk;
211 rServer := Piece(cboServer.Text,',',1);
212 rPort := pnlPort.Caption;
213 rpcConfig.close;
214end;
215
216procedure TrpcConfig.butCancelClick(Sender: TObject);
217begin
218 ButtonStatus := mrCancel;
219 rServer := cboServer.Text;
220 rPort := pnlPort.Caption;
221 rpcConfig.close;
222end;
223
224procedure TrpcConfig.FormDestroy(Sender: TObject);
225begin
226 ServerPairs := TStringList.Create; // {p13 - REM}
227 ServerPairs.Free; // Release Help File.
228 Application.HelpFile := OrigHelp; //
229end;
230
231procedure TrpcConfig.cboServerExit(Sender: TObject);
232begin
233 //
234end;
235
236procedure TrpcConfig.NewClick(Sender: TObject);
237var
238 I: Integer;
239 ServerForm: TfrmAddServer;
240 strServer, strName, strPort: String;
241begin
242 ServerForm := TfrmAddServer.Create(Self);
243 if ServerForm.ShowModal <> mrCancel then
244 begin
245 strServer := ServerForm.edtAddress.Text;
246 strPort := ServerForm.edtPortNumber.Text;
247 ServerForm.edtPortNumber.Text := strPort;
248 strName := strServer + ',' + strPort;
249 WriteRegData(HKCU, REG_SERVERS, strName, '');
250 ServerPairs.Add(strName);
251 strName := ServerPairs[ServerPairs.Count-1];
252 cboServer.Items.Add(strName);
253 for I := 0 to cboServer.Items.Count-1 do // Iterate
254 begin
255 if cboServer.Items[I] = strName then
256 cboServer.ItemIndex := I;
257 end; // for
258// cboServer.Text := strServer;
259// pnlPort.Caption := strPort;
260 cboServerClick(Self);
261 end;
262 ServerForm.Free;
263end;
264
265end.
266
Note: See TracBrowser for help on using the repository browser.