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

Last change on this file since 990 was 990, checked in by Herwig Bauernfeind, 4 years ago

GUITools: All changes that have built over time.

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