source: branches/guitools-2.0/shared/smbtree.vrs @ 477

Last change on this file since 477 was 477, checked in by Herwig Bauernfeind, 10 years ago

GUI-Tools: EVFSGUI: Do not run more than 32 smbclient.exe at the same time

File size: 15.8 KB
Line 
1/* Routines to handle smbtree output */
2
3/*:VRX */
4_RefreshTree:
5    say time()' _RefreshTree() started'
6    FirstRun = 0
7
8    ok = SysFileDelete(samba.!msg)
9
10    if UserCred   = 'USERCRED'   | UserCred = '' | UserCred = '--user=%' then UserCred = '-N'
11    if ShowHidden = 'SHOWHIDDEN' | ShowHidden = '' then ShowHidden = 0
12
13    if BroadCast = 1 then BroadCast = '-b'; else BroadCast = ''
14
15    say       '  detach 'samba.!smbtreeexe' 'BroadCast' -S 'debuglevel' 'UserCred' >'samba.!msg
16    address cmd 'detach 'samba.!smbtreeexe' 'BroadCast' -S 'debuglevel' 'UserCred' >'samba.!msg
17
18    if BroadCast = '-b' then BroadCast = 1; else BroadCast = 0
19    if UserCred = '-N' then UserCred = ''
20
21    ok = VRMethod("CN_smbtree", "RemoveRecord", "ALL")
22
23    RefreshMode = "TREE"
24    ok = VRSet("CN_smbtree","Enabled", 0)
25    ok = VRset("TM_RefreshTreeDisplay","Enabled",1)
26
27    say time()' _RefreshTree() done'
28return
29
30/*:VRX */
31_RefreshTreeDisplay:
32    say time()' _RefreshTreeDisplay() started'
33    say '  samba.!msg = "'samba.!msg'"'
34    stat = stream(samba.!msg,'c','open read')
35    if stat <> "READY:" then return
36
37    if UserCred = 'USERCRED' | UserCred = '' | UserCred = '--user=%' then do
38        UserCred = '-N'
39    end
40
41    if ShowHidden = 'SHOWHIDDEN' | ShowHidden = '' then ShowHidden = 0
42
43    ok = VRset("TM_RefreshTreeDisplay","Enabled",0)
44/*  ok = VRSet("Main", "StatusText", NLVGetMessage(50)) */
45    ok = VRSet("CN_smbtree", 'Enabled', 0 )
46/*  ok = VRSet("Main", 'Pointer', 'Wait' ) */
47
48    ok = VRSet( "CN_smbtree", "Painting", 0  )
49    ok = VRMethod("CN_smbtree", "RemoveRecord", "ALL")
50
51    drop smbtree.
52    drop smbtreeline.
53
54    sl = 0
55
56    do until lines(samba.!msg) = 0
57        sl = sl + 1
58        smbtreeline.sl = linein(samba.!msg)
59    end
60    smbtreeline.0 = sl
61    ok = stream(samba.!msg,'c','close')
62    ok = SysFileDelete(samba.!msg)
63
64    do sl = 1 to smbtreeline.0
65        Header = c2x(left(smbtreeline.sl,3))
66        select
67            when Header = "09095C" then do /* share - obsolete, we do that differently now see below! */
68                smbtreeline.sl = strip(smbtreeline.sl,,'09'x)
69                parse var smbtreeline.sl '\\'machine'\'share '09'x comment
70                machine = strip(machine)
71                share   = strip(share)
72                comment = strip(comment)
73                text = translate(share' 'comment)
74                res = _GuessIcon(text)
75                if VRGet("CN_smbtree","View") = "IconTree" then do
76                    parent = smbtree.!machine
77                    smbtree.!share = VRMethod( "CN_smbtree", "AddRecord",parent,, share||'0D0A'x||comment, res)
78                    ok = VRMethod( "CN_smbtree", "SetRecordAttr", smbtree.!share, "ReadOnly", 1)
79                    if pos("$", share) > 0 then ok = VRMethod( "CN_smbtree", "SetRecordAttr", smbtree.!share, "Visible", ShowHidden)
80                end
81            end /* end of obsolete share code */
82            when Header = "095C5C" then do /* Machine */
83                smbtreeline.sl = strip(smbtreeline.sl,,'09'x)
84                parse var smbtreeline.sl '\\'machine '0909'x comment
85                machine = strip(machine)
86                comment = strip(comment)
87                if VRGet("CN_smbtree","View") = "IconTree" then parent = smbtree.!workgroup; else parent = ""
88                smbtree.!machine = VRMethod( "CN_smbtree", "AddRecord",parent,, machine||'0D0A'x||comment)
89                /* We make any machine as sleeping initially */
90                ok = VRMethod( "CN_smbtree", "SetRecordAttr", smbtree.!machine, "Icon","#61:PMWP.DLL")
91                ok = VRMethod( "CN_smbtree", "SetRecordAttr", smbtree.!machine, "ReadOnly", 1)
92                ok = VRMethod( "CN_smbtree", "SetFieldData",  smbtree.!machine, NBFH, machine, CommentFH, Comment, WorkGroupFH, CurWG)
93                ok = VRSet( "CN_smbtree", "Painting", 1  )
94                ok = VRSet( "CN_smbtree", "Painting", 0  )
95                if VRGet("CN_smbtree","View") = "Detail" then do
96                    address cmd samba.!nmblookupexe' 'machine' 'debuglevel' -N >'samba.!msg
97                    ipstr = ""
98                    ip = ""
99                    do until lines(samba.!msg) = 0
100                        nmblookupline = linein(samba.!msg)
101                        if pos(strip(machine)'<',nmblookupline) > 0 then do
102                            parse var nmblookupline ip .
103                            if pos(strip(ip), ipstr) = 0 then do
104                                ipstr = ipstr||ip','
105                            end
106                        end
107                    end
108                    ok = SysFileDelete(samba.!msg)
109                    ipstr = strip(ipstr,,',')
110                    ok = VRMethod( "CN_smbtree", "SetFieldData", smbtree.!machine, IPFH, IPStr)
111                    ok = stream(samba.!msg,'c','close')
112                    if ip <> "" then do
113                        address cmd samba.!smbclientexe' -L "'strip(machine)'" -I "'ip'" -N 'debuglevel' 2>'samba.!msg' 1>NUL'
114                        smbline = linein(samba.!msg)
115                        ok = stream(samba.!msg,'c','close')
116                        parse var smbline "Domain=["WorkGroup"] OS=["OS"] Server=["Server"]"Rest
117                        ok = VRMethod( "CN_smbtree", "SetFieldData", smbtree.!machine, OSFH, OS)
118                        /* WorkGroupFH, Workgroup */
119                        address cmd samba.!nmblookupexe' -A 'machine' 'debuglevel' -N >'samba.!msg
120                        Master = ""
121                        do until lines(samba.!msg) = 0
122                            nmblookupline = linein(samba.!msg)
123                            if pos('<1b>', nmblookupline) > 0 then Master = Master||"LMB," /* + */
124                            if pos('<1d>', nmblookupline) > 0 then Master = Master||"DMB," /* * */
125                            if pos('MAC',nmblookupline) > 0 then do
126                                parse var nmblookupline . '=' MAC
127                                MAC = strip(MAC)
128                            end
129                        end
130                        Master= strip(Master,,',')
131                        ok = stream(samba.!msg,'c','close')
132                        ok = SysFileDelete(samba.!msg)
133                        ok = VRMethod( "CN_smbtree", "SetFieldData", smbtree.!machine, MBFH, Master,MacFH,MAC)
134                    end
135                end
136                else do
137                    call _RefreshShares
138                end
139            end
140            when smbtreeline.sl = "" then nop
141            otherwise do
142                say '  Workgroup: "'smbtreeline.sl'"'
143                if pos("RECEIVING",translate(smbtreeline.sl)) > 0 then do
144                    Msg.Type = "W"
145                    Msg.Text = smbtreeline.sl
146                    call _ShowMsg
147                end
148                else do
149                    if VRGet("CN_smbtree","View") = "IconTree" then do
150                        smbtree.!workgroup = VRMethod( "CN_smbtree", "AddRecord",,, smbtreeline.sl,"#62:PMWP.DLL")
151                        ok = VRMethod( "CN_smbtree", "SetFieldData", smbtree.!workgroup, WorkGroupFH, smbtreeline.sl)
152                        ok = VRMethod( "CN_smbtree", "SetRecordAttr", smbtree.!workgroup, "Collapsed", 0)
153                        ok = VRMethod( "CN_smbtree", "SetRecordAttr", smbtree.!workgroup, "ReadOnly", 1)
154                        ok = VRMethod( "CN_smbtree", 'SetRecordAttr', smbtree.!workgroup, "UserData", "WORKGROUP|")
155                    end
156                    CurWG = smbtreeline.sl
157                end
158            end
159        end
160    end
161
162    ok = VRSet( "CN_smbtree", "Painting", 1  )
163
164/*  ok = VRSet("Main", 'Pointer', '<default>' ) */
165    ok = VRSet("CN_smbtree","Enabled", 1)
166    ok = VRSet("TM_Throbber","Enabled", 0)
167    ok = VRSet("Pict_Throbber","Visible", 0)
168    say time()' _RefreshTreeDisplay() done'
169return
170
171/*:VRX         _RefreshShares */
172_RefreshShares:
173    say time()' _RefreshShares() started'
174    /* RefreshID = RANDOM() */
175    smbmachine = TempDir||"smbmachine."||machine
176    MaxSmbClient = 32 /* Do not run more than MaxSmbClient instances of smbclient.exe at the same time */
177
178    Defer = 1
179    do while Defer = 1
180        SmbCltCount = 0
181        ok = PRProcessList(proc)
182
183        do I = 1 to proc.0
184            CurProc = VRParseFileName(proc.i.name,'NE')
185            if CurProc = "SMBCLIENT.EXE" then SmbCltCount = SmbCltCount + 1
186        end
187        say '  'SmbCltCount' instance(s) of 'samba.!smbclientexe' is/are running.'
188        if SmbCltCount >= MaxSmbClient then do
189            say "  Waiting until at least "SmbCltCount-MaxSmbClient+1" instance(s) of smbclient.exe terminate(s)."
190            ok = SysSleep(1)
191        end
192        else Defer = 0
193    end
194
195    if UserCred   = 'USERCRED'   | UserCred = '' | UserCred = '--user=%' then UserCred = '-N'
196
197    say       '  detach 'samba.!smbclientexe' -L "'strip(machine)'" 'UserCred' 'debuglevel' 1>'smbmachine' 2>NUL'
198    address cmd 'detach 'samba.!smbclientexe' -L "'strip(machine)'" 'UserCred' 'debuglevel' 1>'smbmachine' 2>NUL'
199
200    if UserCred = '-N' then UserCred = ''
201
202    RefreshMode = "SHARE"
203
204    ok = VRSet("CN_smbtree","Enabled", 0)
205    ok = VRset("TM_RefreshTreeDisplay","Enabled",1)
206    say time()' _RefreshShares() done'
207return
208
209/*:VRX         _AddSharesDisplay
210*/
211_AddSharesDisplay: /* New get shares code - uses smbclient output and is much faster */
212    say time()' _AddSharesDisplay() started'
213
214    ok = SysFileTree(Tempdir||'smbmachine.*',smbmachine.,'FO')
215    say '  'smbmachine.0' file(s) to process.'
216
217    if smbmachine.0 = 0 then do /* we are done, no more files around, cleanup, disable Timer and exit */
218        RefreshMode = ""
219        ok = VRSet("CN_smbtree","Enabled", 1)
220        ok = VRset("TM_RefreshTreeDisplay","Enabled",0)
221        ok = VRSet( "CN_smbtree", "Painting", 0  )
222        ok = VRSet( "CN_smbtree", "Painting", 1  )
223        say time()' _AddSharesDisplay() completed'
224        return /* exit here */
225    end
226
227    if UserCred   = 'USERCRED'   | UserCred = '' | UserCred = '--user=%' then UserCred = '-N'
228    if ShowHidden = 'SHOWHIDDEN' | ShowHidden = '' then ShowHidden = 0
229
230    do I = 1 to smbmachine.0
231        say ' Going for "'smbmachine.I'"'
232        stat = stream(smbmachine.I,'c','open read')
233        if stat = "READY:" then do /* we found a readable output file */
234            /* Machine = VRParseFilename(smbmachine.I,'E') */
235            Machine = substr(smbmachine.I,pos('.',smbmachine.I)+1)
236
237            smbtree.!machine = _GetMachinehandle(Machine)
238            say '  Machine (handle) = "'machine'" ('smbtree.!machine')'
239
240            if smbtree.!machine = "" then do /* invalid (old) file */
241                say time()' _AddSharesDisplay() exit with Invalid file found (no corresponding machine)'
242                ok = stream(smbmachine.I,'c','close')
243                ok = SysFileDelete(smbmachine.I)
244                iterate
245            end
246            line = linein(smbmachine.I)
247            say '  Answer "'line'"'
248            ok = VRMethod('CN_smbtree', 'SetRecordAttr', smbtree.!machine, 'UserData', "SERVER|"||strip(line))
249
250            if pos("FAIL", translate(line)) > 0 then do /* we see an error message - the term "FAIL" seems to be common to all */
251                say time()' _AddSharesDisplay() exit with "'line'"'
252                ok = stream(smbmachine.I,'c','close')
253                ok = SysFileDelete(smbmachine.I)
254                iterate
255            end
256
257            retries = 0
258            do while(left(line,1) <> '09'x)
259                line = linein(smbmachine.I)
260                retries = retries + 1
261                say '  Skip 'retries' "'line'"'
262                if retries >=10 then do /* No valid output - error */
263                    say time()' _AddSharesDisplay() exit with invalid output error'
264                    ok = stream(smbmachine.I,'c','close')
265                    ok = SysFileDelete(smbmachine.I)
266                    leave
267                end
268            end
269            if retries >=10 then iterate
270
271            /* Skip header */
272            line = linein(smbmachine.I)
273            line = linein(smbmachine.I)
274
275            if left(line,5) = "Error" then ok = VRMethod('CN_smbtree', 'SetRecordAttr', smbtree.!machine, 'UserData', "SERVER|"||strip(line))
276
277            do while(left(line,1) = '09'x) /* Share loop */
278                parse var line '09'x share type comment
279                type = translate(strip(type))
280                comment = strip(comment)
281
282                select
283                    when type = "DISK"    then res = '#64:PMWP.DLL'
284                    when type = "PRINTER" then res = '#65:PMWP.DLL'
285                    when type = "IPC"     then res = '#59:PMWP.DLL'
286                    when type = "DEVICE"  then res = '#84:PMWP.DLL' /* There might be better ones around */
287                    otherwise res = ''
288                end
289
290                /* Now the machine receives the wakeup icon */
291                ok = VRMethod('CN_smbtree', 'SetRecordAttr', smbtree.!machine, 'Icon', "#35:PMWP.DLL")
292                parent = smbtree.!machine
293                smbtree.!share = VRMethod( "CN_smbtree", "AddRecord",parent,, share||'0D0A'x||comment, res)
294                ok = VRMethod( "CN_smbtree", "SetRecordAttr", smbtree.!share, "ReadOnly", 1, 'UserData', type"|")
295                if pos("$", share) > 0 then ok = VRMethod( "CN_smbtree", "SetRecordAttr", smbtree.!share, "Visible", ShowHidden)
296
297                /* get next share */
298                line = linein(smbmachine.I)
299            end /* Share loop */
300
301            do until left(line,10) = '09'x||'Workgroup'
302                line = linein(smbmachine.I)
303            end
304            line = linein(smbmachine.I)
305            /* Reading workgroup and master - eventually both empty */
306            line = linein(smbmachine.I)
307            parse var line '09'x workgroup master
308            master = strip(master)
309
310            /* we use this to set the workgroup for manually added servers */
311            if workgroup <> "" then do
312                wgh = _GetMachinehandle(workgroup)
313                if wgh = "" then do /* This machine is in a new workgroup - add it as well */
314                    wgh = VRMethod( "CN_smbtree", "AddRecord",,, workgroup,"#62:PMWP.DLL")
315                    ok = VRMethod( "CN_smbtree", "SetFieldData", wgh, WorkGroupFH, workgroup)
316                    ok = VRMethod( "CN_smbtree", "SetRecordAttr", wgh, "Collapsed", 0)
317                    ok = VRMethod( "CN_smbtree", "SetRecordAttr", wgh, "ReadOnly", 1)
318                    ok = VRMethod( "CN_smbtree", 'SetRecordAttr', wgh, "UserData", "WORKGROUP|")
319                end
320                if wgh <> "" then ok = VRMethod('CN_smbtree', 'SetRecordAttr', smbtree.!machine, 'Parent', wgh)
321            end
322
323            say time()' _AddSharesDisplay() success and cleanup'
324            ok = stream(smbmachine.I,'c','close')
325            ok = SysFileDelete(smbmachine.I)
326            if ok <> 0 then say '  Failure 'ok' deleting "'smbmachine.I'"!'
327        end
328        else say '  Got "'stat'" for "'smbmachine.I'"'
329    end
330
331    if UserCred = '-N' then UserCred = ''
332
333    say time()' _AddSharesDisplay() loop end'
334return
335
336/*:VRX         _GetMachinehandle
337*/
338
339_GetMachinehandle: procedure /* get recordhandle by machine name (also works for workgroups) */
340    Machine = translate(arg(1))
341
342    ok = VRMethod("CN_smbtree", "GetRecordList", "All", rh.)
343    match = 0
344
345    do I = 1 to rh.0
346        ResName  = translate(VRMethod("CN_smbtree","GetRecordAttr",rh.I,"Caption"))
347
348        parse var ResName  ResName '0D0A'x .
349        ResName = strip(ResName)
350
351        if Machine = ResName then do /* we got a matching name */
352            match = 1
353            leave
354        end
355    end
356    if match = 0 then rh.I = "" /* return an empty handle, if there was no match */
357return rh.I
Note: See TracBrowser for help on using the repository browser.