Context Navigation

← Previous Revision
Next Revision →
Blame
Revision Log

smbtree.vrs

Visit:

Last change on this file was 1055, checked in by Herwig Bauernfeind, 7 years ago
Unify debug formatting
File size: 32.1 KB

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

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

Download in other formats:

Original Format