Context Navigation

smbtree.vrs@ 908

Visit:

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

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

Download in other formats:

Original Format