Context Navigation

smbtree.vrs@ 1009

Visit:

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

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

Download in other formats:

Original Format