Context Navigation

smbtree.vrs@ 791

Visit:

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

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

Download in other formats:

Original Format