source: cprs/branches/tmg-cprs/BDK32/Source/Xwbut1.pas@ 612

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

Initial upload of TMG-CPRS 1.0.26.69

File size: 9.7 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, Don Craven, Joel Ivey
6 Description: Contains utilities used by the BDK.
7 Current Release: Version 1.1 Patch 40 (January 7, 2005))
8*************************************************************** }
9
10unit Xwbut1;
11
12interface
13
14Uses
15Sysutils, Classes, Messages, WinProcs, IniFiles,
16Dialogs, Registry;
17
18const
19 xwb_ConnectAction = wm_User + 200;
20 IniFile = 'VISTA.INI';
21 BrokerSection = 'RPCBroker';
22 BrokerServerSection = 'RPCBroker_Servers';
23 TAB = #9;
24 {For Registry interaction}
25 {Roots}
26 HKCR = HKEY_CLASSES_ROOT;
27 HKCU = HKEY_CURRENT_USER;
28 HKLM = HKEY_LOCAL_MACHINE;
29 HKU = HKEY_USERS;
30 HKCC = HKEY_CURRENT_CONFIG;
31 HKDD = HKEY_DYN_DATA;
32 {Keys}
33 REG_BROKER = 'Software\Vista\Broker';
34 REG_VISTA = 'Software\Vista';
35 REG_SIGNON = 'Software\Vista\Signon';
36 REG_SERVERS = 'Software\Vista\Broker\Servers';
37
38var
39 RetryLimit: integer;
40
41
42function BuildSect(s1: string; s2: string): string;
43procedure GetHostList(HostList: TStrings);
44function GetHostsPath : String;
45function GetIniValue(Value, Default: string): string;
46function Iff(Condition: boolean; strTrue, strFalse: string): string;
47function Sizer (s1: string; s2: string): string;
48function ReadRegData(Root : HKEY; Key, Name : string) : string;
49procedure WriteRegData(Root: HKEY; Key, Name, Value : string);
50procedure DeleteRegData(Root: HKEY; Key, Name : string);
51function ReadRegDataDefault(Root: HKEY; Key, Name, Default : string) : string;
52procedure ReadRegValues(Root: HKEY; Key : string; var RegValues : TStringList);
53procedure ReadRegValueNames(Root:HKEY; Key : string; var RegNames : TStringlist);
54
55implementation
56
57
58
59{---------------------------- BuildSect ---------------------------
60------------------------------------------------------------------}
61Function BuildSect(s1: string; s2: string): string;
62var
63 s, x: string[100];
64begin
65 if s2 <> '' then
66 s := s1 + s2
67 else
68 s := s1;
69
70 x := IntToStr(length(s));
71 if length(x) = 1 then x := '00' + x;
72 if length(x) = 2 then x := '0' + x;
73 Result := x + s;
74end;
75
76
77
78{--------------------------- GetHostList --------------------------
79Reads HOSTS file and fills the passed HostList with all
80entries from that file.
81------------------------------------------------------------------}
82procedure GetHostList(HostList: TStrings);
83var
84 I, SpacePos: integer;
85 IP, HostName: string;
86 S : string; //Individual line from Hosts file.
87 WholeList: TStringList;
88begin
89
90 HostList.Clear;
91 WholeList := nil;
92 try
93 WholeList := TStringList.Create; {create temp buffer}
94 WholeList.LoadFromFile(GetHostsPath + '\HOSTS'); {read in the file}
95 for I := 0 to WholeList.Count - 1 do
96 begin
97 S := WholeList[I];
98 {ignore lines that start with '#' and empty lines}
99 if (Copy(S,1,1) <> '#') and (Length(S) > 0) then
100 begin
101 while Pos(TAB, S) > 0 do //Convert tabs to spaces
102 S[Pos(TAB, S)] := ' ';
103 IP := Copy(S,1,pos(' ', S)-1); {get IP addr}
104 {parse out Host name}
105 SpacePos := Length(IP) + 1;
106 while Copy(S,SpacePos,1) = ' ' do inc(SpacePos);
107 HostName := Copy(S,SpacePos,255);
108 if pos(' ',HostName) > 0 then
109 HostName := Copy(HostName,1,pos(' ',HostName)-1);
110 if pos('#',HostName) > 0 then
111 HostName := Copy(HostName,1,pos('#',HostName)-1);
112 HostList.Add(HostName+' [' + IP + ']');
113 end{if};
114 end{for};
115 finally
116 WholeList.Free;
117 end{try};
118end;
119
120{GetHostsPath returns path to host file without terminating '\'.
121If path in VISTA.INI that is used. Otherwise, path is determined based
122on default windows directory and Windows OS.}
123function GetHostsPath : String;
124var
125 OsInfo : TOSVersionInfo; //Type for OS info
126 HostsPath : String;
127 WinDir : PChar;
128begin
129 Result := '';
130 OSInfo.dwOSVersionInfoSize := SizeOf(OsInfo);
131 GetVersionEx(OSInfo); // Retrieve OS info
132 WinDir := StrAlloc(MAX_PATH + 1);
133 GetWindowsDirectory(WinDir, MAX_PATH); //Retieve windows directory
134 HostsPath := StrPas(WinDir);
135 StrDispose(WinDir);
136 {Now check OS. VER_PLATFORM_WIN32_WINDOWS indicates Windows 95.
137 If Windows 95, hosts default directory is windows directory.
138 Else assume NT and append NT's directory for hosts to windows directory.}
139 if OSInfo.dwPlatformID <> VER_PLATFORM_WIN32_WINDOWS then
140 HostsPath := HostsPath + '\system32\drivers\etc';
141 HostsPath := GetIniValue('HostsPath',HostsPath);
142 if Copy(HostsPath, Length(HostsPath), 1) = '\' then //Strip terminating '\'
143 HostsPath := Copy(HostsPath, 1, Length(HostsPath)-1);
144 Result := HostsPath;
145end;
146
147
148{-------------------------- GetIniValue --------------------------
149------------------------------------------------------------------}
150function GetIniValue(Value, Default: string): string;
151var
152 DhcpIni: TIniFile;
153 pchWinDir: array[0..100] of char;
154begin
155 GetWindowsDirectory(pchWinDir, SizeOf(pchWinDir));
156 DhcpIni := TIniFile.Create(IniFile);
157 Result := DhcpIni.ReadString(BrokerSection, Value, 'Could not find!');
158 if Result = 'Could not find!' then begin
159 if ((Value <> 'Installing') and (GetIniValue('Installing','0') <> '1')) then
160 {during Broker install Installing=1 so warnings should not display}
161 begin
162 DhcpIni.WriteString(BrokerSection, Value, Default); {Creates vista.ini
163 if necessary}
164 end;
165 Result := Default;
166 end;
167 DhcpIni.Free;
168end;
169
170
171
172{------------------------------ Iff ------------------------------
173------------------------------------------------------------------}
174function Iff(Condition: boolean; strTrue, strFalse: string): string;
175begin
176 if Condition then Result := strTrue else Result := strFalse;
177end;
178
179
180{------------------------------ Sizer -----------------------------
181This function is used in conjunction with the ListSetUp function. It returns
182the number of characters found in the string passed in. The string is
183returned with a leading 0 for the 3 character number format required by the
184broker call.
185------------------------------------------------------------------}
186function Sizer (s1: string; s2: string): string;
187var
188 x: integer;
189 st: string;
190begin
191 st := s1 + s2;
192 x := Length(st);
193 st := IntToStr(x);
194 if length(st) < 3 then
195 Result := '0' + st
196 else
197 Result := st;
198end;
199
200{Function to retrieve a data value from the Windows Registry.
201If Key or Name does not exist, null returned.}
202function ReadRegData(Root: HKEY; Key, Name : string) : string;
203var
204 Registry: TRegistry;
205begin
206 Result := '';
207 Registry := TRegistry.Create;
208 try
209 Registry.RootKey := Root;
210 if Registry.OpenKeyReadOnly(Key) then
211 begin
212 Result := Registry.ReadString(Name);
213 Registry.CloseKey;
214 end;
215 finally
216 Registry.Free;
217 end;
218end;
219
220{Function to set a data value into the Windows Registry.
221If Key or Name does not exist, it is created.}
222procedure WriteRegData(Root: HKEY; Key, Name, Value : string);
223var
224 Registry: TRegistry;
225begin
226 Registry := TRegistry.Create;
227 try
228 Registry.RootKey := Root;
229 if Registry.OpenKey(Key, True) then
230 begin
231 Registry.WriteString(Name, Value);
232 Registry.CloseKey;
233 end;
234 finally
235 Registry.Free;
236 end;
237end;
238
239{Procedure to delete a data value into the Windows Registry.}
240procedure DeleteRegData(Root: HKEY; Key, Name : string);
241var
242 Registry: TRegistry;
243begin
244 Registry := TRegistry.Create;
245 try
246 Registry.RootKey := Root;
247 if Registry.OpenKey(Key, True) then
248 begin
249 Registry.DeleteValue(Name);
250 Registry.CloseKey;
251 end;
252 finally
253 Registry.Free;
254 end;
255end;
256
257
258{Returns string value from registry. If value is '', then Default
259value is filed in Registry and Default is returned.}
260function ReadRegDataDefault(Root: HKEY; Key, Name, Default : string) : string;
261begin
262 Result := ReadRegData(Root, Key, Name);
263 if Result = '' then
264 begin
265 WriteRegData(Root, Key, Name, Default);
266 Result := Default;
267 end;
268end;
269
270{Returns name=value pairs for a key. Format returned same as found in .ini
271files. Useful with the Values method of TStringList.}
272procedure ReadRegValues(Root: HKEY; Key : string; var RegValues : TStringList);
273var
274 RegNames : TStringList;
275 Registry : TRegistry;
276 i : integer;
277begin
278 RegNames := TStringlist.Create;
279 Registry := TRegistry.Create;
280 try
281 Registry.RootKey := Root;
282 if Registry.OpenKeyReadOnly(Key) then
283 begin
284 Registry.GetValueNames(RegNames);
285 for i := 0 to (RegNames.Count - 1) do
286 RegValues.Add(RegNames.Strings[i] + '='
287 + Registry.ReadString(RegNames.Strings[i]));
288 end
289 else
290 RegValues.Add('');
291 finally
292 Registry.Free;
293 RegNames.Free;
294 end;
295end;
296
297procedure ReadRegValueNames(Root:HKEY; Key : string; var RegNames : TStringlist);
298var
299 Registry : TRegistry;
300 ReturnedNames : TStringList;
301begin
302 RegNames.Clear;
303 Registry := TRegistry.Create;
304 ReturnedNames := TStringList.Create;
305 try
306 Registry.RootKey := Root;
307 if Registry.OpenKeyReadOnly(Key) then
308 begin
309 Registry.GetValueNames(ReturnedNames);
310 RegNames.Assign(ReturnedNames);
311 end;
312 finally
313 Registry.Free;
314 ReturnedNames.Free;
315 end;
316end;
317
318end.
319
Note: See TracBrowser for help on using the repository browser.