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