source: trunk/guitools/shared/browse.vrs@ 1051

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

Move browsing code to browse.vrs, add colors to smbtree.vrs statusbar messages
File size: 13.8 KB
Line 
1/* Samba REXX Routines to enable smb resource browsing */
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 _dropdeprecated
22*/
23_dropdeprecated:
24 /* The stem-less counterparts of these variables are considered deprecated and should be removed wherever possible
25 The _dropdeprecated routine will drop any value in order to make sure the stem actually works
26 If another variable is added to the stem, ensure to also drop it in dropdeprecated otherwise it will not be exported
27 */
28 drop rh
29 drop parentrh
30 drop gparentrh
31 drop icon
32 drop resname
33 drop comment
34 drop udatatype
35 drop udatamsg
36return
37
38/*:VRX */
39_GetSMBObjectProperties: procedure expose samba. options. SMBObj. rh icon resname udatatype udatamsg parentrh icons.
40 if options.!debug == 1 then say time()' _GetSMBObjectProperties started'
41
42 /* Purpose of this subroutine:
43 The current SMB object's frequently used properties should be stored in a stem
44 SMBObj.rh = recordhandle of the object
45 SMBObj.resname = resourcename of the object
46 SMBObj.comment = commentstring of the object
47 SMBObj.icon = icon of the object
48 SMBObj.udatatype = type of object (WORKGROUP, SERVER, DISK, PRINTER, FILE, DIRECTORY)
49 SMBObj.udatamsg = arbitrary object related data (Login message, file properties)
50 SMBObj.parentrh = recordhandle of the object's parent
51 SMBObj.gparentrh = recordhandle of the object's grandparent
52
53 The stem-less counterparts of these variables are considered deprecated and should be removed wherever possible
54 The _dropdeprecated routine will drop any value in order to make sure the stem actually works
55 If another variable is added to the stem, ensure to also drop it in dropdeprecated otherwise it will not be exported
56 */
57 call _dropdeprecated
58
59 SMBObj. = ""
60 SMBObj.rh = arg(1)
61
62 if VRMethod( "CN_SMBTREE", "ValidateRecord", SMBObj.rh) <> 1 | SMBObj.rh = "" then do
63 if options.!debug == 1 then say time()' _GetSMBObjectProperties aborted'
64 return
65 end
66
67 SMBObj.Icon = VRMethod("CN_SMBTREE", "GetRecordAttr", SMBObj.rh, "Icon")
68
69 SMBObj.parentrh = VRMethod("CN_SMBTREE", "GetRecordAttr", SMBObj.rh, "Parent")
70 if SMBObj.parentrh = ""
71 then SMBObj.gparentrh = ""
72 else SMBObj.gparentrh = VRMethod("CN_SMBTREE", "GetRecordAttr", SMBObj.parentrh, "Parent")
73
74 SMBObj.resname = VRMethod("CN_SMBTREE", "GetRecordAttr", SMBObj.rh, "Caption")
75 parse var SMBObj.resname SMBObj.resname '0D0A'x SMBObj.comment
76 SMBObj.resname = strip(SMBObj.resname)
77 SMBObj.comment = strip(SMBObj.comment)
78
79 Userdata = VRMethod("CN_SMBTREE", "GetRecordAttr", SMBObj.rh, "Userdata")
80 parse var userdata SMBObj.udatatype '|' SMBObj.udatamsg
81 SMBObj.udatatype = strip(SMBObj.udatatype)
82 SMBObj.udatamsg = strip(SMBObj.udatamsg)
83
84 if options.!debug == 1 then do
85 say ' Handle: "'SMBObj.rh'"'
86 say ' GParentrh "'SMBObj.gparentrh'"'
87 say ' Resource: "'SMBObj.resname'"'
88 say ' Comment: "'SMBObj.comment'"'
89 say ' Type: "'SMBObj.udatatype'"'
90 say ' Message: "'SMBObj.udatamsg'"'
91 say ' Icon: "'SMBObj.icon'"'
92 end
93
94 if options.!debug == 1 then say time()' _GetSMBObjectProperties done'
95return
96
97/*:VRX */
98_BrowseResetObject: procedure
99 ok = VRSet("CN_SMBTREE","Painting", 0 )
100 rh = arg(1)
101
102 /* Remove all files and directories whose parent is our share */
103 ok = VRMethod( "CN_SMBTREE", "GetRecordList", "All", "AllRH." )
104 do I = 1 to AllRH.0
105 AllParentRH = VRMethod("CN_SMBTREE","GetRecordAttr",AllRH.I,"Parent")
106 if AllParentRH = rh then ok = VRMethod( "CN_SMBTREE", "RemoveRecord", AllRH.I )
107 end
108 ok = VRSet("CN_SMBTREE","Painting", 1 )
109return
110
111/*:VRX */
112_BrowseDirectory: /* This must not be a procedure */
113 if options.!debug == 1 then say time()' _BrowseDirectory started'
114
115 /* Turn off painting */
116 ok = VRSet("CN_SMBTREE","Painting", 0 )
117 call VRSet VRWindow(), 'Pointer', 'Wait'
118
119 /* Make sure credentials are usable */
120 if UserCred = 'USERCRED' | UserCred = '' | UserCred = '--user=%' then UserCred = '-N'
121
122 /* We have to remove the double % for smbclient.exe - not entirely clear why */
123 OldUserCred = ""
124 if pos('%%',UserCred) > 0 & pos("4OS2", value("COMSPEC",,"OS2ENVIRONMENT")) = 0 then do
125 OldUserCred = UserCred
126 parse var UserCred '--user='username'%%'password
127 UserCred = '--user='username'%'password
128 call lineout "debug", " Strip double %%!!!"
129 end
130
131 say ' 'samba.!smbclientexe' \\'machine'\'sharename' 'UserCred' --command="dir 'browsepath'"'
132 address cmd samba.!smbclientexe' \\'machine'\'sharename' 'UserCred' --command="dir 'browsepath'" 'debuglevel' 2>NUL 1>'samba.!msg
133
134 if UserCred = '-N' then UserCred = ''
135
136 if OldUserCred <> "" then do
137 UserCred = OldUserCred
138 OldUserCred = ""
139 say " Restore double %%!!!"
140 end
141
142 I = 0
143 call _StatusBarWrapper ""
144 do until lines(samba.!msg) = 0
145 infoline = linein(samba.!msg)
146 select
147 when pos('blocks',infoline) > 0 then do /* Last line */
148 /* we should handle size information here */
149 iterate
150 end
151 when I = 0 & length(infoline) > 0 & left(infoline,2) <> " " then do /* Login message */
152 say ' Login message "'Infoline'"'
153 ok = VRMethod("CN_SMBTREE", "SetRecordAttr", SMBObj.rh, "Userdata", SMBObj.udatatype'|'infoline )
154 call _StatusBarWrapper infoline
155 end
156 when left(infoline,2) = " " & length(infoline) > 0 then do /* file or DIR */
157 wn = words(infoline)
158 fyear = word(infoline,wn)
159 ftime = word(infoline,wn-1)
160 fday = word(infoline,wn-2)
161 fmonth = word(infoline,wn-3)
162 fwday = word(infoline,wn-4)
163 /* FIXME: This is flaky! */
164 pos_attr = max(pos(fwday,infoline)-16,4)
165 fsize = word(infoline,wn-5)
166 fattr = substr(infoline,pos_attr,6)
167 fname = strip( substr(infoline,3,pos_attr-3))
168 if fname = '.' | fname = '..' then iterate /* we do not display these */
169 if pos('H',fattr) > 0 then iterate /* we do not display hidden files */
170 if pos('S',fattr) > 0 then iterate /* we do not display system files */
171 I = I + 1
172 fh.I = VRMethod( "CN_SMBTREE", "AddRecord", SMBObj.rh, , fname)
173 if pos('D',fattr) = 0 then do
174 Ext = translate(VRParseFIleName(fname,'E'))
175 select
176 when Ext = 'EXE' then ficon = icons.!exe /* executable */
177 when Ext = 'CMD' then ficon = icons.!cmd /* OS/2 or NT batch */
178 when Ext = 'BAT' then ficon = icons.!bat /* DOS batch */
179 when Ext = 'PDF' then ficon = icons.!pdf /* PDF document */
180 when wordpos(Ext, 'XLS SXC ODS CSV') > 0 then ficon = icons.!spreadsheet
181 when wordpos(Ext, 'DOC SXW ODT') > 0 then ficon = icons.!textdocument
182 when wordpos(Ext, 'FW2 FW3 FW4') > 0 then ficon = icons.!framework
183 when wordpos(Ext, 'JPG BMP PNG GIF TIF') > 0 then ficon = icons.!image
184 when wordpos(Ext, 'AVI MPG FLV WMV MP4') > 0 then ficon = icons.!movie
185 when wordpos(Ext, 'WAV MP3 OGG MID') > 0 then ficon = icons.!sound
186 when wordpos(Ext, 'WPI') > 0 then ficon = icons.!warpin
187 when wordpos(Ext, 'ZIP') > 0 then ficon = icons.!zip
188 when wordpos(Ext, 'INF HLP') > 0 then ficon = icons.!view
189 when wordpos(Ext, 'TXT') > 0 then ficon = icons.!plaintext
190 otherwise ficon = icons.!defaultfile /* default file icon */
191 end
192 ftype = 'FILE'
193 end
194 else do
195 ficon = icons.!folder
196 ftype = 'DIRECTORY'
197 end
198
199 ok = VRmethod("CN_SMBTREE", "SetRecordAttr", fh.I, "userdata", ftype'|'fsize' Bytes 'fday'-'fmonth'-'fyear' 'ftime,'icon',Ficon)
200
201 end
202 otherwise nop /* no other line type */
203 end
204 end
205 if I > 0 then ok = VRMethod("CN_SMBTREE","SetRecordAttr",SMBObj.rh, "Icon", icons.!folder_open)
206 ok = stream(samba.!msg,'c','close')
207 ok = SysFileDelete(samba.!msg)
208
209 ok = VRMethod( "CN_SMBTREE", "SetRecordAttr", SMBObj.rh,"Collapsed", 0)
210 /* Turn on painting */
211 call VRSet VRWindow(), 'Pointer', '<default>'
212 ok = VRSet("CN_SMBTREE","Painting", 1 )
213 if options.!debug == 1 then say time()' _BrowseDirectory done'
214return
215
216/*:VRX */
217_BrowseBuildPath: procedure expose options. icons. samba. sharerh
218 if options.!debug == 1 then say time()' _BrowseBuildPath started'
219 rh = arg(1)
220
221 finished = 0
222 BrowsePathStr = ''
223
224 do while \finished
225 parentrh = VRMethod("CN_SMBTREE","GetRecordAttr",rh,"Parent")
226 resname = VRMethod("CN_SMBTREE","GetRecordAttr",rh,"caption")
227 userdata = VRMethod("CN_SMBTREE","GetRecordAttr",rh,"userdata")
228 parse var userdata udatatype '|' udatamsg
229 parse var resname resname '0D0A'x .
230 resname = strip(resname)
231 /* say " Not connected - cannot open!" */
232 select
233 when udatatype = "SERVER" then do
234 BrowsePathStr = '\\'resname'\'BrowsePathStr
235 finished = 1
236 end
237 when udatatype = "DISK" then do
238 BrowsePathStr = resname'\'BrowsePathStr
239 sharerh =rh
240 rh = parentrh
241 end
242 otherwise do
243 BrowsePathStr = resname'\'BrowsePathStr
244 rh = parentrh
245 end
246 end
247 /* say ' BrowsePathStr = "'BrowsePathStr'"' */
248 end
249 BrowsePathStr = strip(BrowsePathStr,'T','\')
250 if options.!debug == 1 then say time()' _BrowseBuildPath done, returning "'BrowsePathStr'"'
251return BrowsePathStr
252
253/*:VRX */
254_BrowseObjectOpen: procedure expose samba. options. cd. icons.
255 machine = arg(1)
256 sharename = arg(2)
257 browsepath = arg(3)
258
259 OpenOk = 0
260
261 if VRIsValidObject("CN_CONDET") then do
262 CALL VRMethod "CN_CONDET", 'GetRecordList', 'All', 'records.'
263
264 DO i = 1 TO records.0
265 if VRMethod( "CN_CONDET", "GetFieldData", records.i, CD.StatusFH) = icons.!active then do
266 if options.!debug == 1 then say ' 'VRMethod( "CN_CONDET", "GetFieldData", records.i, CD.StatusFH)' 'VRMethod( "CN_CONDET", "GetFieldData", records.i, CD.MPointFH)' 'VRMethod( "CN_CONDET", "GetFieldData", records.i, CD.ServerFH)' 'VRMethod( "CN_CONDET", "GetFieldData", records.i, CD.ShareFH)
267 if machine = VRMethod( "CN_CONDET", "GetFieldData", records.i, CD.ServerFH) &,
268 sharename = VRMethod( "CN_CONDET", "GetFieldData", records.i, CD.ShareFH) then do
269 Object = strip(VRMethod( "CN_CONDET", "GetFieldData", records.i, CD.MPointFH),'T','\')'\'browsepath
270 if options.!debug == 1 then say ' Non UNC object: "'Object'"'
271 ID = VRMethod( "Application", "StartThread", "wps_open", Object, "DEFAULT" )
272 OpenOK = 1
273 end
274 end
275 if OpenOK = 1 then leave
276 end
277 end
278return OpenOK /* 1 = Success 0 = Could not open */
279
280/*:VRX */
281_BrowseIconsInit:
282 if options.!debug == 1 then say time()' _BrowseIconsInit() started. '
283 icons. = '#24:PMWP.DLL'
284 icons.!bat = '#1:PMWP.DLL'
285 icons.!cmd = '#2:PMWP.DLL'
286 icons.!exe = '#3:PMWP.DLL'
287 icons.!template = '#10:PMWP.DLL'
288 icons.!drive = '#16:PMWP.DLL'
289 icons.!defaultfile = '#24:PMWP.DLL'
290 icons.!folder = '#26:PMWP.DLL'
291 icons.!folder_open = '#34:PMWP.DLL'
292 icons.!machine_awake = '#35:PMWP.DLL'
293 icons.!machine_sleeping = '#61:PMWP.DLL'
294 icons.!workgroup = '#62:PMWP.DLL'
295 icons.!pdc = '#63:PMWP.DLL'
296 icons.!active = '#64:PMWP.DLL'
297 icons.!passive = '#68:PMWP.DLL'
298 icons.!printer = '#65:PMWP.DLL'
299 icons.!drive_inactive = '#70:PMWP.DLL'
300 icons.!pdf = '#80'
301 icons.!spreadsheet = '#82'
302 icons.!textdocument = '#86'
303 icons.!framework = '#87'
304 icons.!image = '#88'
305 icons.!movie = '#89'
306 icons.!sound = '#90'
307 icons.!warpin = '#91'
308 icons.!zip = '#92'
309 icons.!view = '#93'
310 icons.!plaintext = '#94'
311 if options.!debug == 1 then say time()' _BrowseIconsInit() done.'
312return
Note: See TracBrowser for help on using the repository browser.