Context Navigation

smbtree.vrs

Visit:

Last change on this file was 571, checked in by Herwig Bauernfeind, 14 years ago
GUI-Tools: EVFSGUI 2.1: Display hints in statusbar during browsing
File size: 20.0 KB

Rev	Line
[315]	1	/* Routines to handle smbtree output */
	2
	3	/:VRX /
	4	_RefreshTree:
[348]	5	say time()' _RefreshTree() started'
[315]	6	FirstRun = 0
	7
	8	ok = SysFileDelete(samba.!msg)
	9
[348]	10	if UserCred = 'USERCRED' \| UserCred = '' \| UserCred = '--user=%' then UserCred = '-N'
[327]	11	if ShowHidden = 'SHOWHIDDEN' \| ShowHidden = '' then ShowHidden = 0
[319]	12
[348]	13	if BroadCast = 1 then BroadCast = '-b'; else BroadCast = ''
[315]	14
[477]	15	say ' detach 'samba.!smbtreeexe' 'BroadCast' -S 'debuglevel' 'UserCred' >'samba.!msg
[348]	16	address cmd 'detach 'samba.!smbtreeexe' 'BroadCast' -S 'debuglevel' 'UserCred' >'samba.!msg
	17
	18	if BroadCast = '-b' then BroadCast = 1; else BroadCast = 0
[315]	19	if UserCred = '-N' then UserCred = ''
	20
	21	ok = VRMethod("CN_smbtree", "RemoveRecord", "ALL")
	22
[345]	23	RefreshMode = "TREE"
[315]	24	ok = VRSet("CN_smbtree","Enabled", 0)
	25	ok = VRset("TM_RefreshTreeDisplay","Enabled",1)
	26
[348]	27	say time()' _RefreshTree() done'
[315]	28	return
	29
	30	/:VRX /
[348]	31	_RefreshTreeDisplay:
	32	say time()' _RefreshTreeDisplay() started'
[349]	33	say ' samba.!msg = "'samba.!msg'"'
[315]	34	stat = stream(samba.!msg,'c','open read')
	35	if stat <> "READY:" then return
	36
[345]	37	if UserCred = 'USERCRED' \| UserCred = '' \| UserCred = '--user=%' then do
	38	UserCred = '-N'
	39	end
	40
[327]	41	if ShowHidden = 'SHOWHIDDEN' \| ShowHidden = '' then ShowHidden = 0
	42
[315]	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')
[334]	62	ok = SysFileDelete(samba.!msg)
[315]	63
	64	do sl = 1 to smbtreeline.0
	65	Header = c2x(left(smbtreeline.sl,3))
	66	select
[345]	67	when Header = "09095C" then do /* share - obsolete, we do that differently now see below! */
[315]	68	smbtreeline.sl = strip(smbtreeline.sl,,'09'x)
	69	parse var smbtreeline.sl '\\'machine'\'share '09'x comment
	70	machine = strip(machine)
[393]	71	share = strip(share)
[315]	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)
[325]	78	ok = VRMethod( "CN_smbtree", "SetRecordAttr", smbtree.!share, "ReadOnly", 1)
[319]	79	if pos("$", share) > 0 then ok = VRMethod( "CN_smbtree", "SetRecordAttr", smbtree.!share, "Visible", ShowHidden)
[315]	80	end
[345]	81	end /* end of obsolete share code */
[315]	82	when Header = "095C5C" then do /* Machine */
	83	smbtreeline.sl = strip(smbtreeline.sl,,'09'x)
	84	parse var smbtreeline.sl '\\'machine '0909'x comment
[393]	85	machine = strip(machine)
[315]	86	comment = strip(comment)
	87	if VRGet("CN_smbtree","View") = "IconTree" then parent = smbtree.!workgroup; else parent = ""
[345]	88	smbtree.!machine = VRMethod( "CN_smbtree", "AddRecord",parent,, machine\|\|'0D0A'x\|\|comment)
	89	/* We make any machine as sleeping initially */
[346]	90	ok = VRMethod( "CN_smbtree", "SetRecordAttr", smbtree.!machine, "Icon","#61:PMWP.DLL")
[325]	91	ok = VRMethod( "CN_smbtree", "SetRecordAttr", smbtree.!machine, "ReadOnly", 1)
[346]	92	ok = VRMethod( "CN_smbtree", "SetFieldData", smbtree.!machine, NBFH, machine, CommentFH, Comment, WorkGroupFH, CurWG)
[348]	93	ok = VRSet( "CN_smbtree", "Painting", 1 )
[345]	94	ok = VRSet( "CN_smbtree", "Painting", 0 )
[315]	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
[334]	108	ok = SysFileDelete(samba.!msg)
[315]	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')
[334]	132	ok = SysFileDelete(samba.!msg)
[315]	133	ok = VRMethod( "CN_smbtree", "SetFieldData", smbtree.!machine, MBFH, Master,MacFH,MAC)
	134	end
	135	end
[345]	136	else do
	137	call _RefreshShares
	138	end
[315]	139	end
[347]	140	when smbtreeline.sl = "" then nop
[315]	141	otherwise do
[348]	142	say ' Workgroup: "'smbtreeline.sl'"'
[558]	143	if pos("RECEIVING",translate(smbtreeline.sl)) > 0 \| pos("TDB(",translate(smbtreeline.sl)) > 0 then do
[315]	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)
[325]	153	ok = VRMethod( "CN_smbtree", "SetRecordAttr", smbtree.!workgroup, "ReadOnly", 1)
[345]	154	ok = VRMethod( "CN_smbtree", 'SetRecordAttr', smbtree.!workgroup, "UserData", "WORKGROUP\|")
[315]	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)
[348]	168	say time()' _RefreshTreeDisplay() done'
[315]	169	return
	170
[348]	171	/:VRX _RefreshShares /
[345]	172	_RefreshShares:
[348]	173	say time()' _RefreshShares() started'
[477]	174	/* RefreshID = RANDOM() */
[346]	175	smbmachine = TempDir\|\|"smbmachine."\|\|machine
[477]	176	MaxSmbClient = 32 /* Do not run more than MaxSmbClient instances of smbclient.exe at the same time */
[345]	177
[477]	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
[450]	195	if UserCred = 'USERCRED' \| UserCred = '' \| UserCred = '--user=%' then UserCred = '-N'
	196
[348]	197	say ' detach 'samba.!smbclientexe' -L "'strip(machine)'" 'UserCred' 'debuglevel' 1>'smbmachine' 2>NUL'
[346]	198	address cmd 'detach 'samba.!smbclientexe' -L "'strip(machine)'" 'UserCred' 'debuglevel' 1>'smbmachine' 2>NUL'
[345]	199
[450]	200	if UserCred = '-N' then UserCred = ''
	201
[345]	202	RefreshMode = "SHARE"
	203
	204	ok = VRSet("CN_smbtree","Enabled", 0)
	205	ok = VRset("TM_RefreshTreeDisplay","Enabled",1)
[348]	206	say time()' _RefreshShares() done'
[345]	207	return
	208
	209	/*:VRX _AddSharesDisplay
	210	*/
	211	_AddSharesDisplay: /* New get shares code - uses smbclient output and is much faster */
[348]	212	say time()' _AddSharesDisplay() started'
[345]	213
[346]	214	ok = SysFileTree(Tempdir\|\|'smbmachine.*',smbmachine.,'FO')
[348]	215	say ' 'smbmachine.0' file(s) to process.'
[345]	216
[346]	217	if smbmachine.0 = 0 then do /* we are done, no more files around, cleanup, disable Timer and exit */
[345]	218	RefreshMode = ""
	219	ok = VRSet("CN_smbtree","Enabled", 1)
	220	ok = VRset("TM_RefreshTreeDisplay","Enabled",0)
[348]	221	ok = VRSet( "CN_smbtree", "Painting", 0 )
	222	ok = VRSet( "CN_smbtree", "Painting", 1 )
	223	say time()' _AddSharesDisplay() completed'
[345]	224	return /* exit here */
[315]	225	end
[345]	226
[348]	227	if UserCred = 'USERCRED' \| UserCred = '' \| UserCred = '--user=%' then UserCred = '-N'
[345]	228	if ShowHidden = 'SHOWHIDDEN' \| ShowHidden = '' then ShowHidden = 0
	229
[346]	230	do I = 1 to smbmachine.0
	231	say ' Going for "'smbmachine.I'"'
[571]	232	if VRIsValidObject("DT_STATUSBAR") then ok = VRSet("DT_STATUSBAR","Caption", VRGet("DT_STATUSBAR","Caption")\|\|'.')
[346]	233	stat = stream(smbmachine.I,'c','open read')
[571]	234
[345]	235	if stat = "READY:" then do /* we found a readable output file */
[566]	236	OneWorkGroupOnly = 0
[347]	237	/* Machine = VRParseFilename(smbmachine.I,'E') */
	238	Machine = substr(smbmachine.I,pos('.',smbmachine.I)+1)
	239
[345]	240	smbtree.!machine = _GetMachinehandle(Machine)
[346]	241	say ' Machine (handle) = "'machine'" ('smbtree.!machine')'
[345]	242
[346]	243	if smbtree.!machine = "" then do /* invalid (old) file */
[348]	244	say time()' _AddSharesDisplay() exit with Invalid file found (no corresponding machine)'
[346]	245	ok = stream(smbmachine.I,'c','close')
	246	ok = SysFileDelete(smbmachine.I)
	247	iterate
	248	end
	249	line = linein(smbmachine.I)
	250	say ' Answer "'line'"'
[345]	251	ok = VRMethod('CN_smbtree', 'SetRecordAttr', smbtree.!machine, 'UserData', "SERVER\|"\|\|strip(line))
	252
[346]	253	if pos("FAIL", translate(line)) > 0 then do /* we see an error message - the term "FAIL" seems to be common to all */
[348]	254	say time()' _AddSharesDisplay() exit with "'line'"'
[346]	255	ok = stream(smbmachine.I,'c','close')
	256	ok = SysFileDelete(smbmachine.I)
	257	iterate
[345]	258	end
	259
	260	retries = 0
	261	do while(left(line,1) <> '09'x)
[346]	262	line = linein(smbmachine.I)
[345]	263	retries = retries + 1
[346]	264	say ' Skip 'retries' "'line'"'
[345]	265	if retries >=10 then do /* No valid output - error */
[348]	266	say time()' _AddSharesDisplay() exit with invalid output error'
[346]	267	ok = stream(smbmachine.I,'c','close')
	268	ok = SysFileDelete(smbmachine.I)
	269	leave
[345]	270	end
	271	end
[346]	272	if retries >=10 then iterate
[345]	273
	274	/* Skip header */
[346]	275	line = linein(smbmachine.I)
	276	line = linein(smbmachine.I)
[345]	277
[570]	278	if translate(left(strip(line),5)) = "ERROR" then ok = VRMethod('CN_smbtree', 'SetRecordAttr', smbtree.!machine, 'UserData', "SERVER\|"\|\|strip(line))
[345]	279
[361]	280	do while(left(line,1) = '09'x) /* Share loop */
[345]	281	parse var line '09'x share type comment
	282	type = translate(strip(type))
	283	comment = strip(comment)
	284
	285	select
[450]	286	when type = "DISK" then res = '#64:PMWP.DLL'
[345]	287	when type = "PRINTER" then res = '#65:PMWP.DLL'
	288	when type = "IPC" then res = '#59:PMWP.DLL'
	289	when type = "DEVICE" then res = '#84:PMWP.DLL' /* There might be better ones around */
	290	otherwise res = ''
	291	end
	292
	293	/* Now the machine receives the wakeup icon */
	294	ok = VRMethod('CN_smbtree', 'SetRecordAttr', smbtree.!machine, 'Icon', "#35:PMWP.DLL")
	295	parent = smbtree.!machine
	296	smbtree.!share = VRMethod( "CN_smbtree", "AddRecord",parent,, share\|\|'0D0A'x\|\|comment, res)
	297	ok = VRMethod( "CN_smbtree", "SetRecordAttr", smbtree.!share, "ReadOnly", 1, 'UserData', type"\|")
	298	if pos("$", share) > 0 then ok = VRMethod( "CN_smbtree", "SetRecordAttr", smbtree.!share, "Visible", ShowHidden)
	299
	300	/* get next share */
[346]	301	line = linein(smbmachine.I)
[361]	302	end /* Share loop */
[346]	303
[347]	304	do until left(line,10) = '09'x\|\|'Workgroup'
	305	line = linein(smbmachine.I)
	306	end
	307	line = linein(smbmachine.I)
[566]	308	/* Reading FIRST workgroup and master - eventually both empty */
[347]	309	line = linein(smbmachine.I)
[566]	310
	311	/* Multiple workgroups? */
	312	if lines(smbmachine.I) = 0 then OneWorkGroupOnly = 1
	313	else OneWorkGroupOnly = 0
	314	say " OneWorkGroupOnly = "OneWorkGroupOnly
	315
[347]	316	parse var line '09'x workgroup master
	317	master = strip(master)
	318
[566]	319	/* we use this to set the workgroup for manually added servers - if there is ONLY ONE workgroup */
	320	if workgroup <> "" & OneWorkGroupOnly = 1 then do
[347]	321	wgh = _GetMachinehandle(workgroup)
[566]	322	if wgh = "" then do /* The machine appears to be in a new workgroup - add it as well */
	323	/* NOTE: This should be obsolete now because the list of available
	324	workgroups should always have been updated before we get here */
[347]	325	wgh = VRMethod( "CN_smbtree", "AddRecord",,, workgroup,"#62:PMWP.DLL")
	326	ok = VRMethod( "CN_smbtree", "SetFieldData", wgh, WorkGroupFH, workgroup)
	327	ok = VRMethod( "CN_smbtree", "SetRecordAttr", wgh, "Collapsed", 0)
	328	ok = VRMethod( "CN_smbtree", "SetRecordAttr", wgh, "ReadOnly", 1)
	329	ok = VRMethod( "CN_smbtree", 'SetRecordAttr', wgh, "UserData", "WORKGROUP\|")
	330	end
[546]	331	/* we only do this for machines with empty parent (=workgroup) handle */
[566]	332	/* IF there is only one workgroup */
[546]	333	if wgh <> "" & VRMethod('CN_smbtree', 'GetRecordAttr', smbtree.!machine, 'Parent') = "" then do
	334	ok = VRMethod('CN_smbtree', 'SetRecordAttr', smbtree.!machine, 'Parent', wgh)
	335	end
[347]	336	end
[570]	337	else do
	338	if workgroup <> "" then do
	339	/* There are multiple workgroups, we need additional */
	340	/* measures to find out which is our workgroup */
	341	say ' 'samba.!smbclientexe' -L "'Machine'" -N 'debuglevel' 2>'samba.!msg' 1>NUL'
	342	address cmd samba.!smbclientexe' -L "'Machine'" -N 'debuglevel' 2>'samba.!msg' 1>NUL'
[566]	343	infoline = linein(samba.!msg)
[570]	344	if word(infoline,1) = "creating" then do /* upcase tables are missing */
	345	say "Missing upcase tables detected!"
	346	infoline = linein(samba.!msg)
	347	infoline = linein(samba.!msg)
	348	end
	349	IF options.!debug == 1 THEN say ' Response = "'Infoline'"'
	350	ok = stream(samba.!msg,'c','close')
	351	ok = SysFileDelete(samba.!msg)
[347]	352
[570]	353	parse var infoline "Domain=["WorkGroup"] "Rest
	354	wgh = _GetMachinehandle(workgroup)
	355	if wgh <> "" & VRMethod('CN_smbtree', 'GetRecordAttr', smbtree.!machine, 'Parent') = "" then do
	356	ok = VRMethod('CN_smbtree', 'SetRecordAttr', smbtree.!machine, 'Parent', wgh)
	357	end
[566]	358	end
[570]	359	else do
	360	/* The machine does not allow browsing and does not report a workgroup */
	361	say ' "'Machine'" does not allow browsing. Unable to determine workgroup.'
	362	end
[566]	363	end
	364
[348]	365	say time()' _AddSharesDisplay() success and cleanup'
[346]	366	ok = stream(smbmachine.I,'c','close')
	367	ok = SysFileDelete(smbmachine.I)
[348]	368	if ok <> 0 then say ' Failure 'ok' deleting "'smbmachine.I'"!'
[345]	369	end
[346]	370	else say ' Got "'stat'" for "'smbmachine.I'"'
[345]	371	end
[450]	372
	373	if UserCred = '-N' then UserCred = ''
	374
[571]	375	if VRIsValidObject("DT_STATUSBAR") then ok = VRSet("DT_STATUSBAR","Caption", "Ready.")
[348]	376	say time()' _AddSharesDisplay() loop end'
[345]	377	return
	378
	379	/*:VRX _GetMachinehandle
	380	*/
	381
[347]	382	_GetMachinehandle: procedure /* get recordhandle by machine name (also works for workgroups) */
[346]	383	Machine = translate(arg(1))
	384
[345]	385	ok = VRMethod("CN_smbtree", "GetRecordList", "All", rh.)
[346]	386	match = 0
[345]	387
	388	do I = 1 to rh.0
[346]	389	ResName = translate(VRMethod("CN_smbtree","GetRecordAttr",rh.I,"Caption"))
[345]	390
	391	parse var ResName ResName '0D0A'x .
	392	ResName = strip(ResName)
	393
[346]	394	if Machine = ResName then do /* we got a matching name */
	395	match = 1
	396	leave
	397	end
	398	end
	399	if match = 0 then rh.I = "" /* return an empty handle, if there was no match */
[345]	400	return rh.I
[566]	401
	402	/*:VRX _RefreshWorkgroups
	403	*/
	404	_RefreshWorkgroups:
	405	say time()' _RefreshWorkgroups() started'
	406	if UserCred = 'USERCRED' \| UserCred = '' \| UserCred = '--user=%' then UserCred = '-N'
	407	if BroadCast = 1 then BroadCast = '-b'; else BroadCast = ''
	408
	409	say samba.!smbtreeexe' 'BroadCast' -D 'debuglevel' 'UserCred' >'samba.!msg
	410	address cmd samba.!smbtreeexe' 'BroadCast' -D 'debuglevel' 'UserCred' >'samba.!msg
	411
	412	if BroadCast = '-b' then BroadCast = 1; else BroadCast = 0
	413	if UserCred = '-N' then UserCred = ''
	414
	415	drop wgline.
	416
	417	sl = 0
	418
	419	do until lines(samba.!msg) = 0
	420	sl = sl + 1
	421	wgline.sl = linein(samba.!msg)
	422	end
	423	wgline.0 = sl
	424	ok = stream(samba.!msg,'c','close')
	425	ok = SysFileDelete(samba.!msg)
	426
	427	do sl = 1 to wgline.0
	428	if pos("RECEIVING",translate(wgline.sl)) > 0 \| pos("TDB(",translate(wgline.sl)) > 0 then do
	429	iterate /* We ignore errors here */
	430	end
	431	workgroup = wgline.sl
	432	wgh = _GetMachinehandle(workgroup)
	433	if wgh = "" then do /* A new workgroup was found -- add it */
	434	wgh = VRMethod( "CN_smbtree", "AddRecord",,, workgroup,"#62:PMWP.DLL")
	435	ok = VRMethod( "CN_smbtree", "SetFieldData", wgh, WorkGroupFH, workgroup)
	436	ok = VRMethod( "CN_smbtree", "SetRecordAttr", wgh, "Collapsed", 0)
	437	ok = VRMethod( "CN_smbtree", "SetRecordAttr", wgh, "ReadOnly", 1)
	438	ok = VRMethod( "CN_smbtree", 'SetRecordAttr', wgh, "UserData", "WORKGROUP\|")
	439	end
	440	end
	441	say time()' _RefreshWorkgroups() done'
	442	return
	443

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

Download in other formats:

Original Format