source: trunk/guitools/shared/smbtree.vrs@ 1053

Last change on this file since 1053 was 1053, checked in by Herwig Bauernfeind, 8 years ago

SMBMon: ACLS browser, missing, recreated stuff
File size: 32.0 KB
Line 
1/* Samba REXX Routines to handle smbtree output */
2
3/*
4Copyright (C) 2007-2017 Herwig Bauernfeind for bww bitwise works GmbH.
5
6This program is free software: you can redistribute it and/or modify
7it under the terms of the GNU General Public License as published by
8the Free Software Foundation, either version 3 of the License, or
9(at your option) any later version.
10
11This program is distributed in the hope that it will be useful,
12but WITHOUT ANY WARRANTY; without even the implied warranty of
13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14GNU General Public License for more details.
15
16You should have received a copy of the GNU General Public License
17along 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'
65return
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'
189return
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'
248return
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'
480return
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'"'
504return 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'
539return
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.'
552return 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
571return 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'
599return 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'
634return 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'
677return IPStr'|'MAC'|'Roles
678
679
680
681/*:VRX file2stem
682*/
683file2stem:
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'
724return stemcount
725
726_StatusBarWrapper:
727 StatusWText = arg(1)
728 if VRIsValidObject("DT_STATUSBAR") then do
729 if left(StatusWText,1) = "+" then do
730 ok = VRSet("DT_STATUSBAR","Caption", VRGet("DT_STATUSBAR","Caption")||substr(StatusWText,2))
731 end
732 else do
733 ok = VRSet("DT_STATUSBAR","Caption", " "||StatusWText)
734
735 if VRIsValidObject("TM_STATUSBAR") then do
736 ok = VRSet("TM_STATUSBAR","DELAY", 4000)
737 ok = VRSet("TM_STATUSBAR","Enabled", 1)
738 trStWT = translate(StatusWText)
739 select
740 when pos("LOGIN SUCCESSFUL", trStWT) > 0 then ok = VRSet("DT_STATUSBAR","BACKCOLOR","GREEN")
741 when pos("NT_STATUS_OK", trStWT) > 0 then ok = VRSet("DT_STATUSBAR","BACKCOLOR","GREEN")
742 when pos("OK", trStWT) > 0 then ok = VRSet("DT_STATUSBAR","BACKCOLOR","GREEN")
743 when pos("NT_STATUS_ACCESS_DENIED", trStWT) > 0 then ok = VRSet("DT_STATUSBAR","BACKCOLOR","YELLOW")
744 when pos("ERROR", trStWT) > 0 then ok = VRSet("DT_STATUSBAR","BACKCOLOR","RED")
745 when pos("NT_STATUS_", trStWT) > 0 then ok = VRSet("DT_STATUSBAR","BACKCOLOR","RED")
746 otherwise ok = VRSet("TM_STATUSBAR","Enabled", 0)
747 end
748 end
749 end
750 end
751return
752
753_StatusBarReset:
754 ok = VRSet("DT_STATUSBAR","BACKCOLOR","<default>")
755 ok = VRSet("TM_STATUSBAR","Enabled", 0)
756return
Note: See TracBrowser for help on using the repository browser.