Context Navigation

smbtree.vrs@ 911

Visit:

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

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

Download in other formats:

Original Format