Context Navigation

smbtree.vrs@ 784

Visit:

Last change on this file since 784 was 784, checked in by Herwig Bauernfeind, 12 years ago
GUI-Tools: Changes in order to work around % issue
File size: 27.4 KB

Line
1	/* Routines to handle smbtree output */
2
3	/:VRX /
4	_RefreshTree:
5	say time()' _RefreshTree() started'
6	FirstRun = 0
7	if VRIsValidObject("DT_STATUSBAR") then ok = VRSet("DT_STATUSBAR","Caption", "Refreshing network")
8	ok = SysFileDelete(samba.!msg)
9
10	if UserCred = 'USERCRED' \| UserCred = '' \| UserCred = '--user=%' \| UserCred = '--user=%%' then UserCred = '-N'
11	if ShowHidden = 'SHOWHIDDEN' \| ShowHidden = '' then ShowHidden = 0
12	if BroadCast = 1 then BroadCast = '-b'; else BroadCast = ''
13
14	say " UserCred="UserCred
15	samba.!serverlist = TempDir'smbtree.srvlst'
16
17	/* smbtree -b = Use broadcast instead of using the master browser
18	smbtree -D = List only domains (workgroups) of tree
19	smbtree -S = List domains(workgroups) and servers of */
20	say ' detach 'samba.!smbtreeexe' 'BroadCast' -S 'UserCred' 'debuglevel' >'samba.!serverlist
21	address cmd 'detach 'samba.!smbtreeexe' 'BroadCast' -S 'UserCred' 'debuglevel' >'samba.!serverlist
22
23	/* strip username from caption */
24	UserContext = VRGet("CN_SMBTREE","Caption")
25	UserContext = DelWord(UserContext,words(UserContext))
26
27	if UserCred = '-N' then ok = VRSet("CN_SMBTREE","Caption",UserContext': Guest')
28	else do
29	parse var UserCred '--user='username'%'.
30	ok = VRSet("CN_SMBTREE","Caption",UserContext": "username)
31	end
32
33	if BroadCast = '-b' then BroadCast = 1; else BroadCast = 0
34	if UserCred = '-N' then UserCred = ''
35
36	ok = VRMethod("CN_smbtree", "RemoveRecord", "ALL")
37
38	RefreshMode = "TREE"
39	ok = VRSet("CN_smbtree","Enabled", 0)
40	ok = VRset("TM_RefreshTreeDisplay","Enabled",1)
41
42	say time()' _RefreshTree() done'
43	return
44
45	/:VRX /
46	_RefreshTreeDisplay:
47	say time()' _RefreshTreeDisplay() started'
48
49	stat = stream(samba.!serverlist,'c','open read')
50	if stat <> "READY:" then do
51	if VRIsValidObject("DT_STATUSBAR") then ok = VRSet("DT_STATUSBAR","Caption", VRGet("DT_STATUSBAR","Caption")\|\|'.')
52	return
53	end
54
55	if UserCred = 'USERCRED' \| UserCred = '' \| UserCred = '--user=%' \| UserCred = '--user=%%' then UserCred = '-N'
56	if ShowHidden = 'SHOWHIDDEN' \| ShowHidden = '' then ShowHidden = 0
57	if BroadCast = 1 then BroadCast = '-b'; else BroadCast = ''
58
59	if UserCred = '-N' then ok = VRSet("CN_SMBTREE","Caption","User context: Guest")
60	else do
61	parse var UserCred '--user='username'%'.
62	ok = VRSet("CN_SMBTREE","Caption","User context: "username)
63	end
64
65	ok = VRset("TM_RefreshTreeDisplay","Enabled",0)
66	ok = VRSet("CN_smbtree", 'Enabled', 0 )
67
68	ok = VRSet( "CN_smbtree", "Painting", 0 )
69	ok = VRMethod("CN_smbtree", "RemoveRecord", "ALL")
70
71	drop smbtree.
72
73	ok = file2stem(samba.!serverlist,"smbtreeline.")
74
75	do sl = 1 to smbtreeline.0
76	Header = c2x(left(smbtreeline.sl,3))
77	select
78	when Header = "09095C" then nop /* share - obsolete, we only list domains and servers here */
79	when Header = "095C5C" then do /* machine */
80	smbtreeline.sl = strip(smbtreeline.sl,,'09'x)
81	parse var smbtreeline.sl '\\'machine '0909'x comment
82	machine = strip(machine)
83	comment = strip(comment)
84	if VRGet("CN_smbtree","View") = "IconTree" then parent = smbtree.!workgroup; else parent = ""
85	/* We make any machine as sleeping initially */
86	smbtree.!machine = _AddSleepingMachine(machine,comment,parent)
87
88	ok = VRSet( "CN_smbtree", "Painting", 1 )
89	ok = VRSet( "CN_smbtree", "Painting", 0 )
90
91	if VRGet("CN_smbtree","View") <> "Detail" then do
92	/* Tree view */
93	call _RefreshShares
94	end
95	else do /* Fill records for details view */
96	ok = VRSet("Main", 'Pointer', 'Wait' )
97	/* Get NMBLookup Status for machine */
98	NMBStatus = _GetMachineNMBSTatus(machine)
99	parse var NMBStatus IPStr'\|'MAC '\|' Roles; drop NMBStatus
100	if pos("PDC",Roles) > 0 then ok = VRMethod( "CN_smbtree", "SetRecordAttr", smbtree.!machine, "Icon","#63:PMWP.DLL")
101	ok = VRMethod( "CN_smbtree", "SetFieldData", smbtree.!machine, IPFH, IPStr,MBFH, Roles, MacFH,MAC)
102
103	/* FIXME: Possibly obsolete */
104	parse var IPStr MachineIP ',' .
105	if strip(MachineIP) = "" then MachineIP = machine
106
107	ok = VRSet("Main", 'Pointer', '<default>' )
108
109	/* Find out OS, version */
110	say ' 'samba.!smbclientexe' -L "'machine'" 'UserCred' 'debuglevel' 2>'samba.!msg' 1>NUL'
111	address cmd samba.!smbclientexe' -L "'machine'" 'UserCred' 'debuglevel' 2>'samba.!msg' 1>NUL'
112	smbline = linein(samba.!msg)
113	ok = stream(samba.!msg,'c','close')
114	parse var smbline "Domain=["WorkGroup"] OS=["OS"] Server=["Version"]"Rest
115	ok = VRMethod( "CN_smbtree", "SetFieldData", smbtree.!machine, OSFH, OS, VersionFH, Version, WorkgroupFH, WorkGroup)
116	end
117	end
118	when smbtreeline.sl = "" then nop /* skip empty lines */
119	otherwise do /* possibly a new workgroup */
120	say ' Possible workgroup: "'smbtreeline.sl'"'
121	/* check for eventual error messages */
122	if pos("RECEIVING",translate(smbtreeline.sl)) > 0 \| pos("NT_STATUS",translate(smbtreeline.sl)) > 0 then do
123	Msg.Type = "W"
124	Msg.Text = smbtreeline.sl
125	call _ShowMsg
126	end
127	else do /* it is really a new workgroup */
128	if VRGet("CN_smbtree","View") = "IconTree" then do
129	smbtree.!workgroup = _AddWorkGroup(smbtreeline.sl)
130	end
131	CurWG = smbtreeline.sl
132	end
133	end
134	end
135	end
136
137	ok = VRSet( "CN_smbtree", "Painting", 1 )
138
139	/* ok = VRSet("Main", 'Pointer', '<default>' ) */
140	ok = VRSet("CN_smbtree","Enabled", 1)
141	ok = VRSet("TM_Throbber","Enabled", 0)
142	ok = VRSet("Pict_Throbber","Visible", 0)
143	say time()' _RefreshTreeDisplay() done'
144	return
145
146	/:VRX _RefreshShares /
147	_RefreshShares:
148	say time()' _RefreshShares() started'
149
150	smbmachine = TempDir\|\|"smbmachine."\|\|machine
151	MaxSmbClient = 32 /* Do not run more than MaxSmbClient instances of smbclient.exe at the same time */
152
153	Defer = 1
154	do while Defer = 1
155	SmbCltCount = 0
156	ok = PRProcessList(proc)
157
158	do I = 1 to proc.0
159	CurProc = VRParseFileName(proc.i.name,'NE')
160	if CurProc = "SMBCLIENT.EXE" then SmbCltCount = SmbCltCount + 1
161	end
162	say ' 'SmbCltCount' instance(s) of 'samba.!smbclientexe' is/are running.'
163	if SmbCltCount >= MaxSmbClient then do
164	say " Waiting until at least "SmbCltCount-MaxSmbClient+1" instance(s) of smbclient.exe terminate(s)."
165	ok = SysSleep(1)
166	end
167	else Defer = 0
168	end
169
170	if UserCred = 'USERCRED' \| UserCred = '' \| UserCred = '--user=%' \| UserCred = '--user=%%' then UserCred = '-N'
171
172	/* We have to remove the double % for smbclient.exe - not entirely clear why */
173	OldUserCred = ""
174	if pos('%%',UserCred) > 0 & pos("4OS2", value("COMSPEC",,"OS2ENVIRONMENT")) = 0 then do
175	OldUserCred = UserCred
176	parse var UserCred '--user='username'%%'password
177	UserCred = '--user='username'%'password
178	say " Strip double %%!!!"
179	end
180
181	say ' detach 'samba.!smbclientexe' -L "'machine'" 'UserCred' 'debuglevel' 2>'smbmachine' 1>&2'
182	address cmd 'detach 'samba.!smbclientexe' -L "'machine'" 'UserCred' 'debuglevel' 2>'smbmachine' 1>&2'
183
184	if UserCred = '-N' then ok = VRSet("CN_SMBTREE","Caption","User context: Guest")
185	else do
186	parse var UserCred '--user='username'%'.
187	ok = VRSet("CN_SMBTREE","Caption","User context: "username)
188	end
189
190	if OldUserCred <> "" then do
191	UserCred = OldUserCred
192	OldUserCred = ""
193	say " Restore double %%!!!"
194	end
195
196	if UserCred = '-N' then UserCred = ''
197
198	RefreshMode = "SHARE"
199
200	ok = VRSet("CN_smbtree","Enabled", 0)
201	ok = VRset("TM_RefreshTreeDisplay","Enabled",1)
202	say time()' _RefreshShares() done'
203	return
204
205	/*:VRX _AddSharesDisplay
206	*/
207	_AddSharesDisplay: /* New get shares code - uses smbclient output and is much faster */
208	say time()' _AddSharesDisplay() started'
209
210	ok = SysFileTree(Tempdir\|\|'smbmachine.*',smbmachine.,'FO')
211	if smbmachine.0 = 0 then do /* we are done, no more files around, cleanup, disable Timer and exit */
212	RefreshMode = ""
213	ok = VRset("TM_RefreshTreeDisplay","Enabled", 0)
214	ok = VRSet("TM_RefreshTreeDisplay","Delay", 1000)
215	ok = VRSet("CN_smbtree","Enabled", 1)
216	if DoLMHosts = 1 then do
217	call _LMHostsRead
218	call _LMHostsUpdate
219	end
220	ok = VRSet("CN_smbtree", "Painting", 0 )
221	ok = VRSet("CN_smbtree", "Painting", 1 )
222	say time()' _AddSharesDisplay() completed'
223	return /* exit here */
224	end
225	else do
226	say ' 'smbmachine.0' file(s) to process.'
227	if smbmachine.0 = 1 then ok = VRSet("TM_RefreshTreeDisplay", "Delay", VRGet("TM_RefreshTreeDisplay", "Delay") * 2)
228	end
229
230	if UserCred = 'USERCRED' \| UserCred = '' \| UserCred = '--user=%' \| UserCred = '--user=%%' then UserCred = '-N'
231	if ShowHidden = 'SHOWHIDDEN' \| ShowHidden = '' then ShowHidden = 0
232
233	do I = 1 to smbmachine.0
234	call charout , ' Going for "'smbmachine.I'", got '
235	if VRIsValidObject("DT_STATUSBAR") then ok = VRSet("DT_STATUSBAR","Caption", VRGet("DT_STATUSBAR","Caption")\|\|'.')
236	stat = stream(smbmachine.I,'c','open read')
237	say ' Try to open "'smbmachine.I'" for reading: "'stat'"'
238	if stat = "READY:" & smbmachine.0 = 1 then do /* We just found out we are processing the last machine */
239	ok = VRSet("TM_RefreshTreeDisplay","Delay", 1000)
240	end
241	infoline = ""
242	if stat = "READY:" then do /* we found a readable output file */
243	OneWorkGroupOnly = 0
244
245	Machine = substr(smbmachine.I,pos('.',smbmachine.I)+1)
246
247	smbtree.!machine = _GetMachinehandle(Machine)
248
249	if smbtree.!machine = "" then do /* invalid (old) file */
250	say time()' _AddSharesDisplay() exit with Invalid file found (no corresponding machine)'
251	ok = stream(smbmachine.I,'c','close')
252	ok = SysFileDelete(smbmachine.I)
253	iterate
254	end
255	line = linein(smbmachine.I) /* PID line */
256	line = linein(smbmachine.I)
257	if pos('creating lame', line) > 0 then do
258	line = linein(smbmachine.I)
259	line = linein(smbmachine.I)
260	end
261	if pos('Server=[', line) > 0 then do
262	infoline = linein(smbmachine.I)
263	parse var infoline "Domain=["WorkGroup"] OS=["OS"] Server=["Server"]"Rest
264	ok = VRMethod( "CN_smbtree", "SetFieldData", smbtree.!machine, OSFH, OS, VersionFH, Server)
265	line = linein(smbmachine.I)
266	end
267	say ' Message "'line'"'
268	ok = VRMethod('CN_smbtree', 'SetRecordAttr', smbtree.!machine, 'UserData', "SERVER\|"\|\|strip(line))
269
270	if pos("FAIL", translate(line)) > 0 then do /* we see an error message - the term "FAIL" seems to be common to all */
271	say time()' _AddSharesDisplay() exit with "'line'"'
272	ok = stream(smbmachine.I,'c','close')
273	ok = SysFileDelete(smbmachine.I)
274	iterate
275	end
276
277	retries = 0
278	do while(left(line,1) <> '09'x)
279	line = linein(smbmachine.I)
280	retries = retries + 1
281	say ' Skip 'retries' "'line'"'
282	if retries >=10 then do /* No valid output - error */
283	say time()' _AddSharesDisplay() exit with invalid output error'
284	ok = stream(smbmachine.I,'c','close')
285	ok = SysFileDelete(smbmachine.I)
286	leave
287	end
288	end
289	if retries >=10 then iterate
290
291	/* Skip header */
292	line = linein(smbmachine.I)
293	line = linein(smbmachine.I)
294
295	if translate(left(strip(line),5)) = "ERROR" then ok = VRMethod('CN_smbtree', 'SetRecordAttr', smbtree.!machine, 'UserData', "SERVER\|"\|\|strip(line))
296
297	do while(left(line,1) = '09'x) /* Share loop */
298	share = strip(substr(line,2,16))
299	type = translate(strip(substr(line,17,10)))
300	comment = strip(substr(line,27,))
301
302	select
303	when type = "DISK" then res = '#64:PMWP.DLL'
304	when type = "PRINTER" then res = '#65:PMWP.DLL'
305	when type = "IPC" then res = '#59:PMWP.DLL'
306	when type = "DEVICE" then res = '#84:PMWP.DLL' /* There might be better ones around */
307	otherwise res = ''
308	end
309
310	/* Now the machine receives the wakeup icon */
311	ok = VRMethod('CN_smbtree', 'SetRecordAttr', smbtree.!machine, 'Icon', "#35:PMWP.DLL")
312
313	parent = smbtree.!machine
314	smbtree.!share = VRMethod( "CN_smbtree", "AddRecord",parent,, share\|\|'0D0A'x\|\|comment, res)
315	ok = VRMethod( "CN_smbtree", "SetRecordAttr", smbtree.!share, "ReadOnly", 1, 'UserData', type"\|")
316	if pos("$", share) > 0 then ok = VRMethod( "CN_smbtree", "SetRecordAttr", smbtree.!share, "Visible", ShowHidden)
317
318	/* get next share */
319	line = linein(smbmachine.I)
320	end /* Share loop */
321
322	do until left(line,10) = '09'x\|\|'Workgroup' \| lines(smbmachine.I) = 0
323	line = linein(smbmachine.I)
324	end
325	line = linein(smbmachine.I) /* this should be the -------- string */
326	/* Reading FIRST workgroup and master - eventually both empty */
327	line = linein(smbmachine.I)
328
329	/* Multiple workgroups? */
330	if lines(smbmachine.I) = 0 then OneWorkGroupOnly = 1
331	else OneWorkGroupOnly = 0
332	say " OneWorkGroupOnly = "OneWorkGroupOnly
333
334	parse var line '09'x workgroup master
335	master = strip(master)
336
337	/* we use this to set the workgroup for manually added servers - if there is ONLY ONE workgroup */
338	if workgroup <> "" & OneWorkGroupOnly = 1 then do
339	wgh = _GetMachinehandle(workgroup)
340	if wgh = "" then do /* The machine appears to be in a new workgroup - add it as well */
341	/* NOTE: This should be obsolete now because the list of available */
342	/* workgroups should always have been updated before we get here */
343	wgh = _AddWorkGroup(workgroup)
344	end
345	/* we only do this for machines with empty parent (=workgroup) handle */
346	/* IF there is only one workgroup */
347	if wgh <> "" & VRMethod('CN_smbtree', 'GetRecordAttr', smbtree.!machine, 'Parent') = "" then do
348	ok = VRMethod('CN_smbtree', 'SetRecordAttr', smbtree.!machine, 'Parent', wgh)
349	end
350	end
351	else do
352	if workgroup <> "" then do
353	/* There are multiple workgroups, we need additional */
354	/* measures to find out which is our workgroup */
355	if infoline <> "" then do
356	say ' 'samba.!smbclientexe' -L "'Machine'" -N 'debuglevel' 2>'samba.!msg' 1>NUL'
357	address cmd samba.!smbclientexe' -L "'Machine'" -N 'debuglevel' 2>'samba.!msg' 1>NUL'
358	infoline = linein(samba.!msg)
359
360	if word(infoline,1) = "creating" then do /* upcase tables are missing */
361	say "Missing upcase tables detected!"
362	infoline = linein(samba.!msg)
363	infoline = linein(samba.!msg)
364	end
365	IF options.!debug == 1 THEN say ' Response = "'Infoline'"'
366	ok = stream(samba.!msg,'c','close')
367	ok = SysFileDelete(samba.!msg)
368	end
369
370	parse var infoline "Domain=["WorkGroup"] OS=["OS"] Server=["Server"]"Rest
371
372	wgh = _GetMachinehandle(workgroup)
373	if wgh <> "" & VRMethod('CN_smbtree', 'GetRecordAttr', smbtree.!machine, 'Parent') = "" then do
374	ok = VRMethod('CN_smbtree', 'SetRecordAttr', smbtree.!machine, 'Parent', wgh)
375	end
376	end
377	else do
378	/* The machine does not allow browsing and does not report a workgroup here */
379	say ' "'Machine'" does not allow browsing.'
380	end
381	end
382
383	ok = VRSet("Main", 'Pointer', 'Wait' )
384
385	/* Get NMBLookup Status for machine */
386	NMBStatus = _GetMachineNMBSTatus(machine)
387	parse var NMBStatus IPStr'\|'MAC '\|' Roles; drop NMBStatus
388	if pos("PDC",Roles) > 0 then ok = VRMethod( "CN_smbtree", "SetRecordAttr", smbtree.!machine, "Icon","#63:PMWP.DLL")
389	ok = VRMethod( "CN_smbtree", "SetFieldData", smbtree.!machine, IPFH, IPStr,MBFH, Roles, MacFH,MAC)
390
391	ok = VRSet("Main", 'Pointer', '<default>' )
392
393	say time()' _AddSharesDisplay() success and cleanup'
394	ok = stream(smbmachine.I,'c','close')
395	ok = SysFileDelete(smbmachine.I)
396	if ok <> 0 then say ' Failure 'ok' deleting "'smbmachine.I'"!'
397	end
398	end
399
400	if UserCred = '-N' then UserCred = ''
401
402	if VRIsValidObject("DT_STATUSBAR") then ok = VRSet("DT_STATUSBAR","Caption", "Ready.")
403	say time()' _AddSharesDisplay() loop end'
404	return
405
406	/*:VRX _GetMachinehandle
407	*/
408
409	_GetMachinehandle: procedure /* get recordhandle by machine name (also works for workgroups) */
410	Machine = translate(arg(1))
411	say ' _GetMachineHandle("'Machine'") started.'
412	ok = VRMethod("CN_smbtree", "GetRecordList", "All", rh.)
413	match = 0
414
415	do I = 1 to rh.0
416	ResName = translate(VRMethod("CN_smbtree","GetRecordAttr",rh.I,"Caption"))
417
418	parse var ResName ResName '0D0A'x .
419	ResName = strip(ResName)
420
421	if Machine = ResName then do /* we got a matching name */
422	match = 1
423	leave
424	end
425	end
426	if match = 0 then rh.I = "" /* return an empty handle, if there was no match */
427	say ' _GetMachineHandle("'Machine'") done, handle = "'rh.I'"'
428	return rh.I
429
430	/*:VRX _RefreshWorkgroups
431	*/
432	_RefreshWorkgroups:
433	say time()' _RefreshWorkgroups() started'
434	if UserCred = 'USERCRED' \| UserCred = '' \| UserCred = '--user=%' \| UserCred = '--user=%%' then UserCred = '-N'
435	if BroadCast = 1 then BroadCast = '-b'; else BroadCast = ''
436
437	call VRSet VRWindow(), 'Pointer', 'Wait'
438
439	/* smbtree -b = Use broadcast instead of using the master browser
440	smbtree -D = List only domains (workgroups) of tree
441	smbtree -S = List domains(workgroups) and servers of */
442	say ' detach 'samba.!smbtreeexe' 'BroadCast' -D 'UserCred' 'debuglevel' >'samba.!msg
443	address cmd 'detach 'samba.!smbtreeexe' 'BroadCast' -D 'UserCred' 'debuglevel' >'samba.!msg
444
445	if VRIsValidObject("DT_STATUSBAR") then ok = VRSet("DT_STATUSBAR","Caption","Enumerating workgroups")
446	do while stream(samba.!msg,'c','open read') <> "READY:"
447	ok = SysSleep(1)
448	if VRIsValidObject("DT_STATUSBAR") then ok = VRSet("DT_STATUSBAR","Caption", VRGet("DT_STATUSBAR","Caption")\|\|'.')
449	end
450	call VRSet VRWindow(), 'Pointer', '<default>'
451
452	if BroadCast = '-b' then BroadCast = 1; else BroadCast = 0
453	if UserCred = '-N' then UserCred = ''
454
455	ok = File2Stem(samba.!msg,"workgroups.")
456	do I = 1 to workgroups.0
457	workgroup = translate(workgroups.I)
458	if pos("RECEIVING",workgroup) > 0 \| pos("TDB(",workgroup) > 0 then iterate /* We ignore errors here */
459	wgh = _GetMachinehandle(workgroup)
460	if wgh = "" then wgh = _AddWorkGroup(workgroup) /* A new workgroup was found -- add it */
461	end
462	say time()' _RefreshWorkgroups() done'
463	return
464
465	/*:VRX _AddWorkgroup
466	*/
467	_AddWorkGroup: procedure expose WorkGroupFH
468	workgroup = arg(1)
469	say ' _AddWorkGroup("'workgroup'") started.'
470	wgh= VRMethod( "CN_smbtree", "AddRecord",,, workgroup,"#62:PMWP.DLL")
471	ok = VRMethod( "CN_smbtree", "SetFieldData", wgh, WorkGroupFH, workgroup)
472	ok = VRMethod( "CN_smbtree", "SetRecordAttr", wgh, "Collapsed", 0)
473	ok = VRMethod( "CN_smbtree", "SetRecordAttr", wgh, "ReadOnly", 1)
474	ok = VRMethod( "CN_smbtree", 'SetRecordAttr', wgh, "UserData", "WORKGROUP\|")
475	say ' _AddWorkGroup("'workgroup'") done.'
476	return wgh
477
478	/*:VRX _AddSleepingMachine
479	*/
480	_AddSleepingMachine: procedure expose WorkGroupFH NBFH CommentFH
481	machine = arg(1)
482	comment = arg(2)
483	parent = arg(3)
484	mh = VRMethod( "CN_smbtree", "AddRecord",parent,, machine\|\|'0D0A'x\|\|comment)
485	ok = VRMethod( "CN_smbtree", "SetFieldData", mh, NBFH, machine, CommentFH, comment)
486	ok = VRMethod( "CN_smbtree", "SetRecordAttr", mh, "Icon","#61:PMWP.DLL")
487	ok = VRMethod( "CN_smbtree", "SetRecordAttr", mh, "ReadOnly", 1)
488	ok = VRMethod( "CN_smbtree", "SetRecordAttr", mh, "Collapsed", 1)
489	ok = VRMethod( "CN_smbtree", 'SetRecordAttr', mh, "UserData", "SERVER\|")
490	if parent <> "" then do
491	WGName = translate(VRMethod("CN_smbtree","GetRecordAttr",parent,"Caption"))
492	parse var WGName WGName '0D0A'x .
493	ok = VRMethod( "CN_smbtree", "SetFieldData", mh, WorkgroupFH, strip(WGName))
494	end
495	return mh
496
497	/*:VRX _GetMachineIP
498	*/
499	_GetMachineIP: procedure expose debuglevel samba.
500	say time()' _GetMachineIP() started'
501	/* Get all IP addresses of the machine */
502	machine = arg(1)
503	call VRSet VRWindow(), 'Pointer', 'Wait'
504	say ' detach 'samba.!nmblookupexe' 'machine' 'debuglevel' >'samba.!msg
505	address cmd 'detach 'samba.!nmblookupexe' 'machine' 'debuglevel' >'samba.!msg
506
507	if VRIsValidObject("DT_STATUSBAR") then ok = VRSet("DT_STATUSBAR","Caption","Obtaining IP from "machine)
508	do while stream(samba.!msg,'c','open read') <> "READY:"
509	ok = SysSleep(0.33)
510	if VRIsValidObject("DT_STATUSBAR") then ok = VRSet("DT_STATUSBAR","Caption", VRGet("DT_STATUSBAR","Caption")\|\|'.')
511	end
512	call VRSet VRWindow(), 'Pointer', '<default>'
513
514	ok = file2stem(samba.!msg,"nmblookup.")
515	ipstr = ""; ip = ""
516	do i = 1 to nmblookup.0
517	if pos(strip(machine)'<',nmblookup.i) = 0 then iterate
518	parse var nmblookup.i ip .
519	if pos(strip(ip), ipstr) = 0 then ipstr = ipstr\|\|ip','
520	end
521	ipstr = strip(ipstr,,',')
522	say time()' _GetMachineIP() done'
523	return IpStr
524
525	/*:VRX _GetMachineRole
526	*/
527	_GetMachineMACRoles: procedure expose debuglevel samba.
528	say time()' _GetMachineMACRoles() started'
529	machine = arg(1) /* May be name or IP */
530	call VRSet VRWindow(), 'Pointer', 'Wait'
531	say ' detach 'samba.!nmblookupexe' -A 'machine' 'debuglevel' >'samba.!msg
532	address cmd 'detach 'samba.!nmblookupexe' -A 'machine' 'debuglevel' >'samba.!msg
533
534	if VRIsValidObject("DT_STATUSBAR") then ok = VRSet("DT_STATUSBAR","Caption","Obtaining capabilities from "machine)
535	do while stream(samba.!msg,'c','open read') <> "READY:"
536	ok = SysSleep(0.33)
537	if VRIsValidObject("DT_STATUSBAR") then ok = VRSet("DT_STATUSBAR","Caption", VRGet("DT_STATUSBAR","Caption")\|\|'.')
538	end
539	call VRSet VRWindow(), 'Pointer', '<default>'
540	ok = file2stem(samba.!msg,"nmblookup.")
541	Roles = ""
542	MAC = 'xx-xx-xx-xx-xx-xx'
543	do I = 1 to nmblookup.0
544	select
545	when pos('<1c>', nmblookup.I) > 0 then Roles = Roles\|\|"PDC," /* # */
546	when pos('<1b>', nmblookup.I) > 0 then Roles = Roles\|\|"LMB," /* + */
547	when pos('<1d>', nmblookup.I) > 0 then Roles = Roles\|\|"DMB," /* * */
548	when pos('MAC', nmblookup.I) > 0 then do
549	parse var nmblookup.I . '=' MAC
550	MAC = strip(MAC)
551	end
552	otherwise nop
553	end
554	end
555	Roles = strip(Roles,,',')
556	if Roles = "" then Roles = "Workstation"
557	say time()' _GetMachineMACRoles() done'
558	return MAC'\|'Roles
559
560	/*:VRX _GetMachineNMBStatus
561	*/
562	_GetMachineNMBStatus: procedure expose debuglevel samba.
563	say time()' _GetMachineNMBStatus() started'
564	machine = arg(1) /* name only allowed */
565	call VRSet VRWindow(), 'Pointer', 'Wait'
566	say ' detach 'samba.!nmblookupexe' -S 'machine' 'debuglevel' >'samba.!msg
567	address cmd 'detach 'samba.!nmblookupexe' -S 'machine' 'debuglevel' >'samba.!msg
568
569	if VRIsValidObject("DT_STATUSBAR") then ok = VRSet("DT_STATUSBAR","Caption","Querying "machine" for roles")
570	do while stream(samba.!msg,'c','open read') <> "READY:"
571	ok = SysSleep(0.33)
572	if VRIsValidObject("DT_STATUSBAR") then ok = VRSet("DT_STATUSBAR","Caption", VRGet("DT_STATUSBAR","Caption")\|\|'.')
573	end
574	call VRSet VRWindow(), 'Pointer', '<default>'
575
576	ok = file2stem(samba.!msg,"nmblookup.")
577	IPStr = ""
578	Roles = ""
579	MAC = 'xx-xx-xx-xx-xx-xx'
580	do I = 1 to nmblookup.0
581	select
582	when pos(machine'<',nmblookup.I) > 0 then do
583	parse var nmblookup.i ip .
584	ip = strip(ip)
585	if pos(ip, ipstr) = 0 then ipstr = ipstr\|\|ip','
586	end
587	when pos('<1c>', nmblookup.I) > 0 then Roles = Roles\|\|"PDC," /* # */
588	when pos('<1b>', nmblookup.I) > 0 then Roles = Roles\|\|"LMB," /* + */
589	when pos('<1d>', nmblookup.I) > 0 then Roles = Roles\|\|"DMB," /* * */
590	when pos('MAC', nmblookup.I) > 0 then do
591	parse var nmblookup.I . '=' MAC
592	MAC = strip(MAC)
593	end
594	otherwise nop
595	end
596	end
597	Roles = strip(Roles,,',')
598	if Roles = "" then Roles = "Workstation"
599	ipstr = strip(ipstr,,',')
600	say time()' _GetMachineNMBStatus() done'
601	return IPStr'\|'MAC'\|'Roles
602
603
604
605	/*:VRX file2stem
606	*/
607	file2stem:
608	say time()' file2stem() started'
609	msgfile = arg(1)
610	msgstem = arg(2)
611	delmsgfile = translate(arg(3))
612	if right(msgstem,1) <> '.' then msgstem = msgstem'.'
613	say ' file2stem("'msgfile'","'msgstem'")'
614	dyn = 'drop 'msgstem
615	interpret dyn
616	stemcount = 0
617	do while lines(msgfile) > 0
618	stemcount = stemcount + 1
619	inline = linein(msgfile)
620	if pos('creating lame',inline) > 0 \| pos('tdb(',inline) > 0 then do
621	stemcount = stemcount - 1
622	iterate
623	end
624	dyn = msgstem\|\|stemcount' = inline'
625	interpret dyn
626	end
627	dyn = msgstem\|\|"0 = "stemcount
628	interpret dyn
629	ok = stream(msgfile,'c','close')
630	/* if delMsgFile <> "NODEL" then ok = SysFileDelete(msgfile) */
631
632	drop msgfile msgstem
633	say time()' file2stem() done'
634	return stemcount

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format