Context Navigation

← Previous Revision
Next Revision →
Normal
Revision Log

smbtree.vrs

Visit:

Last change on this file was 1055, checked in by Herwig Bauernfeind, 7 years ago
Unify debug formatting
File size: 32.1 KB

Rev	Line
[1023]	1	/* Samba REXX Routines to handle smbtree output */
[638]	2
[1023]	3	/*
	4	Copyright (C) 2007-2017 Herwig Bauernfeind for bww bitwise works GmbH.
	5
	6	This program is free software: you can redistribute it and/or modify
	7	it under the terms of the GNU General Public License as published by
	8	the Free Software Foundation, either version 3 of the License, or
	9	(at your option) any later version.
	10
	11	This program is distributed in the hope that it will be useful,
	12	but WITHOUT ANY WARRANTY; without even the implied warranty of
	13	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	14	GNU General Public License for more details.
	15
	16	You should have received a copy of the GNU General Public License
	17	along with this program. If not, see <http://www.gnu.org/licenses/>.
	18	*/
	19
	20
[638]	21	/:VRX /
	22	_RefreshTree:
	23	say time()' _RefreshTree() started'
	24	FirstRun = 0
[1030]	25	call _StatusBarWrapper "Refreshing network"
[638]	26	ok = SysFileDelete(samba.!msg)
[797]	27	parse var debuglevel .'='level
	28	if level = 0 then debuglevel = ' --debuglevel=1'
[638]	29
[769]	30	if UserCred = 'USERCRED' \| UserCred = '' \| UserCred = '--user=%' \| UserCred = '--user=%%' then UserCred = '-N'
[638]	31	if ShowHidden = 'SHOWHIDDEN' \| ShowHidden = '' then ShowHidden = 0
	32	if BroadCast = 1 then BroadCast = '-b'; else BroadCast = ''
	33
[640]	34	say " UserCred="UserCred
[643]	35	samba.!serverlist = TempDir'smbtree.srvlst'
[638]	36
[784]	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 */
[911]	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
[640]	42
[797]	43	if level = 0 then debuglevel = ' --debuglevel=0'
	44
[759]	45	/* strip username from caption */
	46	UserContext = VRGet("CN_SMBTREE","Caption")
[909]	47	UserContext = strip(DelWord(UserContext,words(UserContext)))
[759]	48
[909]	49	if UserCred = '-N' then ok = VRSet("CN_SMBTREE","Caption",UserContext" Guest")
[703]	50	else do
	51	parse var UserCred '--user='username'%'.
[909]	52	ok = VRSet("CN_SMBTREE","Caption",UserContext" "username)
[703]	53	end
	54
[638]	55	if BroadCast = '-b' then BroadCast = 1; else BroadCast = 0
[641]	56	if UserCred = '-N' then UserCred = ''
[638]	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'
	65	return
	66
	67	/:VRX /
	68	_RefreshTreeDisplay:
	69	say time()' _RefreshTreeDisplay() started'
[640]	70
[911]	71	errstat = stream(samba.!error,'c','open read')
	72	if errstat = "READY:" then do
	73	if file2stem(samba.!error,"treeError.") > 1 then do
[1030]	74	call _StatusBarWrapper treeError.2
[911]	75	end
	76	end
	77
[643]	78	stat = stream(samba.!serverlist,'c','open read')
[688]	79	if stat <> "READY:" then do
[1030]	80	call _StatusBarWrapper '+.'
[688]	81	return
	82	end
[638]	83
[769]	84	if UserCred = 'USERCRED' \| UserCred = '' \| UserCred = '--user=%' \| UserCred = '--user=%%' then UserCred = '-N'
[638]	85	if ShowHidden = 'SHOWHIDDEN' \| ShowHidden = '' then ShowHidden = 0
[640]	86	if BroadCast = 1 then BroadCast = '-b'; else BroadCast = ''
[638]	87
[909]	88	if UserCred = '-N' then ok = VRSet("CN_SMBTREE","Caption",Usercontext" Guest")
[703]	89	else do
	90	parse var UserCred '--user='username'%'.
[909]	91	ok = VRSet("CN_SMBTREE","Caption", Usercontext" "username)
[703]	92	end
	93
[638]	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
[643]	102	ok = file2stem(samba.!serverlist,"smbtreeline.")
[925]	103	if smbtreeline.0 = 0 then do
	104	ok = VRSet("TM_Throbber","Enabled", 0)
	105	ok = VRSet("Pict_Throbber","Visible", 0)
	106	end
[638]	107
[925]	108
[638]	109	do sl = 1 to smbtreeline.0
	110	Header = c2x(left(smbtreeline.sl,3))
	111	select
[640]	112	when Header = "09095C" then nop /* share - obsolete, we only list domains and servers here */
	113	when Header = "095C5C" then do /* machine */
[638]	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 = ""
[786]	119	/* We create any machine as sleeping initially */
[640]	120	smbtree.!machine = _AddSleepingMachine(machine,comment,parent)
	121
[638]	122	ok = VRSet( "CN_smbtree", "Painting", 1 )
	123	ok = VRSet( "CN_smbtree", "Painting", 0 )
[640]	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' )
[641]	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 */
[640]	138	parse var IPStr MachineIP ',' .
	139	if strip(MachineIP) = "" then MachineIP = machine
[641]	140
[640]	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)
[638]	147	ok = stream(samba.!msg,'c','close')
[640]	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)
[638]	150	end
	151	end
[640]	152	when smbtreeline.sl = "" then nop /* skip empty lines */
[786]	153	otherwise do /* possible new workgroup */
[640]	154	say ' Possible workgroup: "'smbtreeline.sl'"'
[786]	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
[638]	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)
[925]	186	/* ok = VRSet("TM_Throbber","Enabled", 0)
	187	ok = VRSet("Pict_Throbber","Visible", 0) */
[638]	188	say time()' _RefreshTreeDisplay() done'
	189	return
	190
	191	/:VRX _RefreshShares /
	192	_RefreshShares:
	193	say time()' _RefreshShares() started'
[640]	194
[638]	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
[769]	215	if UserCred = 'USERCRED' \| UserCred = '' \| UserCred = '--user=%' \| UserCred = '--user=%%' then UserCred = '-N'
[638]	216
[784]	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
[640]	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'
[638]	228
[909]	229	if UserCred = '-N' then ok = VRSet("CN_SMBTREE","Caption",Usercontext" Guest")
[703]	230	else do
	231	parse var UserCred '--user='username'%'.
[909]	232	ok = VRSet("CN_SMBTREE","Caption",Usercontext" "username)
[703]	233	end
	234
[784]	235	if OldUserCred <> "" then do
	236	UserCred = OldUserCred
	237	OldUserCred = ""
	238	say " Restore double %%!!!"
	239	end
	240
[638]	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'
	248	return
	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 = ""
[641]	258	ok = VRset("TM_RefreshTreeDisplay","Enabled", 0)
	259	ok = VRSet("TM_RefreshTreeDisplay","Delay", 1000)
[638]	260	ok = VRSet("CN_smbtree","Enabled", 1)
[660]	261	if DoLMHosts = 1 then do
	262	call _LMHostsRead
	263	call _LMHostsUpdate
	264	end
[641]	265	ok = VRSet("CN_smbtree", "Painting", 0 )
[925]	266	ok = VRSet("TM_Throbber","Enabled", 0)
	267	ok = VRSet("Pict_Throbber","Visible", 0)
[641]	268	ok = VRSet("CN_smbtree", "Painting", 1 )
[638]	269	say time()' _AddSharesDisplay() completed'
	270	return /* exit here */
	271	end
[641]	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
[638]	276
[769]	277	if UserCred = 'USERCRED' \| UserCred = '' \| UserCred = '--user=%' \| UserCred = '--user=%%' then UserCred = '-N'
[638]	278	if ShowHidden = 'SHOWHIDDEN' \| ShowHidden = '' then ShowHidden = 0
	279
	280	do I = 1 to smbmachine.0
[640]	281	call charout , ' Going for "'smbmachine.I'", got '
[1030]	282	call _StatusBarWrapper '+.'
[638]	283	stat = stream(smbmachine.I,'c','open read')
[769]	284	say ' Try to open "'smbmachine.I'" for reading: "'stat'"'
[641]	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
[640]	288	infoline = ""
[638]	289	if stat = "READY:" then do /* we found a readable output file */
	290	OneWorkGroupOnly = 0
[797]	291	GuestRetry = 0
[640]	292
[638]	293	Machine = substr(smbmachine.I,pos('.',smbmachine.I)+1)
[797]	294	if right(Machine,4) = '$rt$' then do
	295	Machine = left(Machine, length(Machine) - 4)
	296	GuestRetry = 1
	297	end
[638]	298
[797]	299
[638]	300	smbtree.!machine = _GetMachinehandle(Machine)
[640]	301
[638]	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
[640]	308	line = linein(smbmachine.I) /* PID line */
[638]	309	line = linein(smbmachine.I)
[640]	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
[786]	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
[769]	325	say ' Message "'line'"'
[786]	326
[638]	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)
[797]	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
[638]	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 */
[766]	364	share = strip(substr(line,2,16))
	365	type = translate(strip(substr(line,17,10)))
	366	comment = strip(substr(line,27,))
[638]	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")
[766]	378
[638]	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
[707]	388	do until left(line,10) = '09'x\|\|'Workgroup' \| lines(smbmachine.I) = 0
[638]	389	line = linein(smbmachine.I)
	390	end
[707]	391	line = linein(smbmachine.I) /* this should be the -------- string */
[638]	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 */
[640]	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)
[638]	410	end
	411	/* we only do this for machines with empty parent (=workgroup) handle */
	412	/* IF there is only one workgroup */
[875]	413	if wgh <> "" & VRMethod('CN_smbtree', 'GetRecordAttr', smbtree.!machine, 'Parent') = "" & VRIsValidObject(smbtree.!machine) then do
[638]	414	ok = VRMethod('CN_smbtree', 'SetRecordAttr', smbtree.!machine, 'Parent', wgh)
	415	end
[875]	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
[638]	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 */
[640]	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'
[638]	429	infoline = linein(samba.!msg)
[640]	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)
[638]	439	end
	440
[640]	441	parse var infoline "Domain=["WorkGroup"] OS=["OS"] Server=["Server"]"Rest
	442
[638]	443	wgh = _GetMachinehandle(workgroup)
[875]	444	if wgh <> "" & VRMethod('CN_smbtree', 'GetRecordAttr', smbtree.!machine, 'Parent') = "" & VRIsValidObject(smbtree.!machine) then do
[638]	445	ok = VRMethod('CN_smbtree', 'SetRecordAttr', smbtree.!machine, 'Parent', wgh)
	446	end
[875]	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
[638]	452	end
	453	else do
[640]	454	/* The machine does not allow browsing and does not report a workgroup here */
	455	say ' "'Machine'" does not allow browsing.'
[638]	456	end
	457	end
	458
[640]	459	ok = VRSet("Main", 'Pointer', 'Wait' )
	460
[641]	461	/* Get NMBLookup Status for machine */
	462	NMBStatus = _GetMachineNMBSTatus(machine)
	463	parse var NMBStatus IPStr'\|'MAC '\|' Roles; drop NMBStatus
[640]	464	if pos("PDC",Roles) > 0 then ok = VRMethod( "CN_smbtree", "SetRecordAttr", smbtree.!machine, "Icon","#63:PMWP.DLL")
[641]	465	ok = VRMethod( "CN_smbtree", "SetFieldData", smbtree.!machine, IPFH, IPStr,MBFH, Roles, MacFH,MAC)
[640]	466
[641]	467	ok = VRSet("Main", 'Pointer', '<default>' )
	468
[638]	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
[1030]	478	call _StatusBarWrapper "Ready."
[638]	479	say time()' _AddSharesDisplay() loop end'
	480	return
	481
	482	/*:VRX _GetMachinehandle
	483	*/
	484
	485	_GetMachinehandle: procedure /* get recordhandle by machine name (also works for workgroups) */
	486	Machine = translate(arg(1))
[641]	487	say ' _GetMachineHandle("'Machine'") started.'
[638]	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 */
[641]	503	say ' _GetMachineHandle("'Machine'") done, handle = "'rh.I'"'
[638]	504	return rh.I
	505
	506	/*:VRX _RefreshWorkgroups
	507	*/
	508	_RefreshWorkgroups:
	509	say time()' _RefreshWorkgroups() started'
[769]	510	if UserCred = 'USERCRED' \| UserCred = '' \| UserCred = '--user=%' \| UserCred = '--user=%%' then UserCred = '-N'
[638]	511	if BroadCast = 1 then BroadCast = '-b'; else BroadCast = ''
	512
[688]	513	call VRSet VRWindow(), 'Pointer', 'Wait'
[784]	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
[638]	520
[1030]	521	call _StatusBarWrapper "Enumerating workgroups"
[688]	522	do while stream(samba.!msg,'c','open read') <> "READY:"
	523	ok = SysSleep(1)
[1030]	524	call _StatusBarWrapper '+.'
[688]	525	end
	526	call VRSet VRWindow(), 'Pointer', '<default>'
	527
[638]	528	if BroadCast = '-b' then BroadCast = 1; else BroadCast = 0
	529	if UserCred = '-N' then UserCred = ''
	530
[640]	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'
	539	return
[638]	540
[640]	541	/*:VRX _AddWorkgroup
	542	*/
	543	_AddWorkGroup: procedure expose WorkGroupFH
	544	workgroup = arg(1)
[641]	545	say ' _AddWorkGroup("'workgroup'") started.'
[640]	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\|")
[641]	551	say ' _AddWorkGroup("'workgroup'") done.'
[640]	552	return wgh
[638]	553
[640]	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))
[638]	570	end
[640]	571	return mh
[638]	572
[640]	573	/*:VRX _GetMachineIP
	574	*/
	575	_GetMachineIP: procedure expose debuglevel samba.
[707]	576	say time()' _GetMachineIP() started'
[640]	577	/* Get all IP addresses of the machine */
	578	machine = arg(1)
[688]	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
[1030]	583	call _StatusBarWrapper "Obtaining IP from "machine
[688]	584	do while stream(samba.!msg,'c','open read') <> "READY:"
	585	ok = SysSleep(0.33)
[1030]	586	call _StatusBarWrapper '+.'
[688]	587	end
	588	call VRSet VRWindow(), 'Pointer', '<default>'
	589
[640]	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,,',')
[707]	598	say time()' _GetMachineIP() done'
[640]	599	return IpStr
	600
	601	/*:VRX _GetMachineRole
	602	*/
	603	_GetMachineMACRoles: procedure expose debuglevel samba.
[707]	604	say time()' _GetMachineMACRoles() started'
[640]	605	machine = arg(1) /* May be name or IP */
[688]	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
[1030]	610	call _StatusBarWrapper "Obtaining capabilities from "machine
[688]	611	do while stream(samba.!msg,'c','open read') <> "READY:"
	612	ok = SysSleep(0.33)
[1030]	613	call _StatusBarWrapper '+.'
[688]	614	end
	615	call VRSet VRWindow(), 'Pointer', '<default>'
[640]	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
[638]	629	end
[640]	630	end
	631	Roles = strip(Roles,,',')
	632	if Roles = "" then Roles = "Workstation"
[707]	633	say time()' _GetMachineMACRoles() done'
[640]	634	return MAC'\|'Roles
	635
[641]	636	/*:VRX _GetMachineNMBStatus
	637	*/
	638	_GetMachineNMBStatus: procedure expose debuglevel samba.
[707]	639	say time()' _GetMachineNMBStatus() started'
[641]	640	machine = arg(1) /* name only allowed */
[688]	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
[1030]	645	call _StatusBarWrapper "Querying "machine" for roles"
[688]	646	do while stream(samba.!msg,'c','open read') <> "READY:"
	647	ok = SysSleep(0.33)
[1030]	648	call _StatusBarWrapper '+.'
[688]	649	end
	650	call VRSet VRWindow(), 'Pointer', '<default>'
	651
[641]	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,,',')
[707]	676	say time()' _GetMachineNMBStatus() done'
[641]	677	return IPStr'\|'MAC'\|'Roles
	678
[660]	679
	680
[640]	681	/*:VRX file2stem
	682	*/
	683	file2stem:
[707]	684	say time()' file2stem() started'
[990]	685	msgfile = arg(1) /* file to create stem of */
	686	msgstem = arg(2) /* name of the stem */
[640]	687	if right(msgstem,1) <> '.' then msgstem = msgstem'.'
[990]	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
[640]	695	say ' file2stem("'msgfile'","'msgstem'")'
	696	dyn = 'drop 'msgstem
	697	interpret dyn
	698	stemcount = 0
[990]	699	skipped = 0
[640]	700	do while lines(msgfile) > 0
	701	stemcount = stemcount + 1
	702	inline = linein(msgfile)
[990]	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
[638]	711	end
[990]	712	if \SkipIt then do
	713	dyn = msgstem\|\|stemcount' = inline'
	714	interpret dyn
	715	end
[638]	716	end
[640]	717	dyn = msgstem\|\|"0 = "stemcount
	718	interpret dyn
	719	ok = stream(msgfile,'c','close')
[785]	720	if delMsgFile <> "NODEL" then ok = SysFileDelete(msgfile)
[784]	721
[640]	722	drop msgfile msgstem
[990]	723	say time()' file2stem() ['stemcount' added, 'skipped' skipped] done'
[640]	724	return stemcount
[1030]	725
	726	_StatusBarWrapper:
	727	StatusWText = arg(1)
	728	if VRIsValidObject("DT_STATUSBAR") then do
[1055]	729	if VRGet("DT_STATUSBAR","BACKCOLOR") <> "<defaul>" then ok = VRSet("DT_STATUSBAR","BACKCOLOR","<default>")
[1030]	730	if left(StatusWText,1) = "+" then do
	731	ok = VRSet("DT_STATUSBAR","Caption", VRGet("DT_STATUSBAR","Caption")\|\|substr(StatusWText,2))
	732	end
	733	else do
	734	ok = VRSet("DT_STATUSBAR","Caption", " "\|\|StatusWText)
	735
	736	if VRIsValidObject("TM_STATUSBAR") then do
	737	ok = VRSet("TM_STATUSBAR","DELAY", 4000)
	738	ok = VRSet("TM_STATUSBAR","Enabled", 1)
	739	trStWT = translate(StatusWText)
	740	select
	741	when pos("LOGIN SUCCESSFUL", trStWT) > 0 then ok = VRSet("DT_STATUSBAR","BACKCOLOR","GREEN")
	742	when pos("NT_STATUS_OK", trStWT) > 0 then ok = VRSet("DT_STATUSBAR","BACKCOLOR","GREEN")
[1053]	743	when pos("OK", trStWT) > 0 then ok = VRSet("DT_STATUSBAR","BACKCOLOR","GREEN")
[1030]	744	when pos("NT_STATUS_ACCESS_DENIED", trStWT) > 0 then ok = VRSet("DT_STATUSBAR","BACKCOLOR","YELLOW")
	745	when pos("ERROR", trStWT) > 0 then ok = VRSet("DT_STATUSBAR","BACKCOLOR","RED")
	746	when pos("NT_STATUS_", trStWT) > 0 then ok = VRSet("DT_STATUSBAR","BACKCOLOR","RED")
	747	otherwise ok = VRSet("TM_STATUSBAR","Enabled", 0)
	748	end
	749	end
	750	end
	751	end
	752	return
	753
	754	_StatusBarReset:
	755	ok = VRSet("DT_STATUSBAR","BACKCOLOR","<default>")
	756	ok = VRSet("TM_STATUSBAR","Enabled", 0)
	757	return

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

Download in other formats:

Original Format