/* Samba REXX Routines to handle smbtree output */

/*
Copyright (C) 2007-2017 Herwig Bauernfeind for bww bitwise works GmbH.

This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program.  If not, see <http://www.gnu.org/licenses/>.
*/


/*:VRX */
_RefreshTree: 
    say time()' _RefreshTree() started'
    FirstRun = 0
    call _StatusBarWrapper "Refreshing network"
    ok = SysFileDelete(samba.!msg)
    parse var debuglevel .'='level
    if level = 0 then debuglevel = ' --debuglevel=1'

    if UserCred   = 'USERCRED'   | UserCred = '' | UserCred = '--user=%' | UserCred = '--user=%%' then UserCred = '-N'
    if ShowHidden = 'SHOWHIDDEN' | ShowHidden = '' then ShowHidden = 0
    if BroadCast = 1 then BroadCast = '-b'; else BroadCast = ''

    say "  UserCred="UserCred
    samba.!serverlist = TempDir'smbtree.srvlst'

    /* smbtree -b = Use broadcast instead of using the master browser
       smbtree -D = List only domains (workgroups) of tree
       smbtree -S = List domains(workgroups) and servers of */
    say       '  detach 'samba.!smbtreeexe' 'BroadCast' -S 'UserCred' 'debuglevel' 2>'samba.!error' 1>'samba.!serverlist
    address cmd 'detach 'samba.!smbtreeexe' 'BroadCast' -S 'UserCred' 'debuglevel' 2>'samba.!error' 1>'samba.!serverlist

    if level = 0 then debuglevel = ' --debuglevel=0'

    /* strip username from caption */
    UserContext = VRGet("CN_SMBTREE","Caption")
    UserContext = strip(DelWord(UserContext,words(UserContext)))
    
    if UserCred = '-N' then ok = VRSet("CN_SMBTREE","Caption",UserContext" Guest")
    else do
        parse var UserCred '--user='username'%'.
        ok = VRSet("CN_SMBTREE","Caption",UserContext" "username)
    end

    if BroadCast = '-b' then BroadCast = 1; else BroadCast = 0
    if UserCred  = '-N' then UserCred = ''

    ok = VRMethod("CN_smbtree", "RemoveRecord", "ALL")

    RefreshMode = "TREE"
    ok = VRSet("CN_smbtree","Enabled", 0)
    ok = VRset("TM_RefreshTreeDisplay","Enabled",1)

    say time()' _RefreshTree() done'
return

/*:VRX */
_RefreshTreeDisplay:
    say time()' _RefreshTreeDisplay() started'

    errstat = stream(samba.!error,'c','open read')
    if errstat = "READY:" then do
        if file2stem(samba.!error,"treeError.") > 1 then do
            call _StatusBarWrapper treeError.2
        end
    end

    stat = stream(samba.!serverlist,'c','open read')
    if stat <> "READY:" then do
        call _StatusBarWrapper '+.'
        return
    end

    if UserCred = 'USERCRED' | UserCred = '' | UserCred = '--user=%' | UserCred = '--user=%%' then UserCred = '-N'
    if ShowHidden = 'SHOWHIDDEN' | ShowHidden = '' then ShowHidden = 0
    if BroadCast = 1 then BroadCast = '-b'; else BroadCast = ''

    if UserCred = '-N' then ok = VRSet("CN_SMBTREE","Caption",Usercontext" Guest")
    else do
        parse var UserCred '--user='username'%'.
        ok = VRSet("CN_SMBTREE","Caption", Usercontext" "username)
    end

    ok = VRset("TM_RefreshTreeDisplay","Enabled",0)
    ok = VRSet("CN_smbtree", 'Enabled', 0 )

    ok = VRSet( "CN_smbtree", "Painting", 0  )
    ok = VRMethod("CN_smbtree", "RemoveRecord", "ALL")

    drop smbtree.

    ok = file2stem(samba.!serverlist,"smbtreeline.")
    if smbtreeline.0 = 0 then do
        ok = VRSet("TM_Throbber","Enabled", 0)
        ok = VRSet("Pict_Throbber","Visible", 0)
    end


    do sl = 1 to smbtreeline.0
        Header = c2x(left(smbtreeline.sl,3))
        select
            when Header = "09095C" then nop /* share - obsolete, we only list domains and servers here */
            when Header = "095C5C" then do  /* machine */
                smbtreeline.sl = strip(smbtreeline.sl,,'09'x)
                parse var smbtreeline.sl '\\'machine '0909'x comment
                machine = strip(machine)
                comment = strip(comment)
                if VRGet("CN_smbtree","View") = "IconTree" then parent = smbtree.!workgroup; else parent = ""
                /* We create any machine as sleeping initially */
                smbtree.!machine = _AddSleepingMachine(machine,comment,parent)

                ok = VRSet( "CN_smbtree", "Painting", 1  )
                ok = VRSet( "CN_smbtree", "Painting", 0  )

                if VRGet("CN_smbtree","View") <> "Detail" then do
                    /* Tree view */
                    call _RefreshShares
                end
                else do /* Fill records for details view */
                    ok = VRSet("Main", 'Pointer', 'Wait' )
                    /* Get NMBLookup Status for machine */
                    NMBStatus = _GetMachineNMBSTatus(machine)
                    parse var NMBStatus IPStr'|'MAC '|' Roles; drop NMBStatus
                    if pos("PDC",Roles) > 0 then ok = VRMethod( "CN_smbtree", "SetRecordAttr", smbtree.!machine, "Icon","#63:PMWP.DLL")
                    ok = VRMethod( "CN_smbtree", "SetFieldData", smbtree.!machine, IPFH, IPStr,MBFH, Roles, MacFH,MAC)

                    /* FIXME: Possibly obsolete */
                    parse var IPStr MachineIP ',' .
                    if strip(MachineIP) = "" then MachineIP = machine

                    ok = VRSet("Main", 'Pointer', '<default>' )

                    /* Find out OS, version */ 
                    say     '  'samba.!smbclientexe' -L "'machine'" 'UserCred' 'debuglevel' 2>'samba.!msg' 1>NUL'
                    address cmd samba.!smbclientexe' -L "'machine'" 'UserCred' 'debuglevel' 2>'samba.!msg' 1>NUL'
                    smbline = linein(samba.!msg)
                    ok = stream(samba.!msg,'c','close')
                    parse var smbline "Domain=["WorkGroup"] OS=["OS"] Server=["Version"]"Rest
                    ok = VRMethod( "CN_smbtree", "SetFieldData", smbtree.!machine, OSFH, OS, VersionFH, Version, WorkgroupFH, WorkGroup)
                end
            end
            when smbtreeline.sl = "" then nop /* skip empty lines */
            otherwise do /* possible new workgroup */
                say '  Possible workgroup: "'smbtreeline.sl'"'
                ThrowMsg = 0
                /* Do some checks to be sure */
                select 
                    when pos("RECEIVING",translate(smbtreeline.sl)) > 0 then ThrowMsg = 1
                    when pos("NT_STATUS",translate(smbtreeline.sl)) > 0 then ThrowMsg = 1
                    when pos(" ", smbtreeline.sl) > 0 then ThrowMsg = 1
                    when pos("=", smbtreeline.sl) > 0 then ThrowMsg = 1
                    when pos(":", smbtreeline.sl) > 0 then ThrowMsg = 1
                    when pos("%", smbtreeline.sl) > 0 then ThrowMsg = 1
                    otherwise do /* it is really a new workgroup */
                        if VRGet("CN_smbtree","View") = "IconTree" then do
                            say "Checks passed, "smbtreeline.sl" is a workgroup!"
                            smbtree.!workgroup = _AddWorkGroup(smbtreeline.sl)
                            CurWG = smbtreeline.sl
                        end
                    end
                end
                if ThrowMsg = 1 then do
                    ThrowMsg = 0
                    Msg.Type = "W"
                    Msg.Text = smbtreeline.sl
                    call _ShowMsg
                end
            end
        end 
    end

    ok = VRSet( "CN_smbtree", "Painting", 1  )

/*  ok = VRSet("Main", 'Pointer', '<default>' ) */
    ok = VRSet("CN_smbtree","Enabled", 1)
/*  ok = VRSet("TM_Throbber","Enabled", 0)
    ok = VRSet("Pict_Throbber","Visible", 0) */
    say time()' _RefreshTreeDisplay() done'
return

/*:VRX         _RefreshShares */
_RefreshShares:
    say time()' _RefreshShares() started'

    smbmachine = TempDir||"smbmachine."||machine
    MaxSmbClient = 32 /* Do not run more than MaxSmbClient instances of smbclient.exe at the same time */

    Defer = 1
    do while Defer = 1 
        SmbCltCount = 0
        ok = PRProcessList(proc)

        do I = 1 to proc.0
            CurProc = VRParseFileName(proc.i.name,'NE')
            if CurProc = "SMBCLIENT.EXE" then SmbCltCount = SmbCltCount + 1
        end
        say '  'SmbCltCount' instance(s) of 'samba.!smbclientexe' is/are running.'
        if SmbCltCount >= MaxSmbClient then do
            say "  Waiting until at least "SmbCltCount-MaxSmbClient+1" instance(s) of smbclient.exe terminate(s)."
            ok = SysSleep(1)
        end
        else Defer = 0
    end

    if UserCred   = 'USERCRED'   | UserCred = '' | UserCred = '--user=%' | UserCred = '--user=%%' then UserCred = '-N'

    /* We have to remove the double % for smbclient.exe - not entirely clear why */
    OldUserCred = ""
    if pos('%%',UserCred) > 0 & pos("4OS2", value("COMSPEC",,"OS2ENVIRONMENT")) = 0  then do
        OldUserCred = UserCred
        parse var UserCred '--user='username'%%'password
        UserCred = '--user='username'%'password
        say "  Strip double %%!!!"
    end

    say       '  detach 'samba.!smbclientexe' -L "'machine'" 'UserCred' 'debuglevel' 2>'smbmachine' 1>&2'
    address cmd 'detach 'samba.!smbclientexe' -L "'machine'" 'UserCred' 'debuglevel' 2>'smbmachine' 1>&2'

    if UserCred = '-N' then ok = VRSet("CN_SMBTREE","Caption",Usercontext" Guest")
    else do
        parse var UserCred '--user='username'%'.
        ok = VRSet("CN_SMBTREE","Caption",Usercontext" "username)
    end
    
    if OldUserCred <> "" then do
        UserCred = OldUserCred
        OldUserCred = ""
        say "  Restore double %%!!!"
    end
    
    if UserCred = '-N' then UserCred = ''

    RefreshMode = "SHARE"

    ok = VRSet("CN_smbtree","Enabled", 0)
    ok = VRset("TM_RefreshTreeDisplay","Enabled",1)
    say time()' _RefreshShares() done'
return

/*:VRX         _AddSharesDisplay
*/
_AddSharesDisplay: /* New get shares code - uses smbclient output and is much faster */
    say time()' _AddSharesDisplay() started'

    ok = SysFileTree(Tempdir||'smbmachine.*',smbmachine.,'FO')
    if smbmachine.0 = 0 then do /* we are done, no more files around, cleanup, disable Timer and exit */
        RefreshMode = ""
        ok = VRset("TM_RefreshTreeDisplay","Enabled", 0)
        ok = VRSet("TM_RefreshTreeDisplay","Delay", 1000)
        ok = VRSet("CN_smbtree","Enabled", 1)
        if DoLMHosts = 1 then do
            call _LMHostsRead
            call _LMHostsUpdate
        end
        ok = VRSet("CN_smbtree", "Painting", 0 )
        ok = VRSet("TM_Throbber","Enabled", 0)
        ok = VRSet("Pict_Throbber","Visible", 0)
        ok = VRSet("CN_smbtree", "Painting", 1 )
        say time()' _AddSharesDisplay() completed'
        return /* exit here */
    end
    else do
        say '  'smbmachine.0' file(s) to process.'
        if smbmachine.0 = 1 then ok = VRSet("TM_RefreshTreeDisplay", "Delay", VRGet("TM_RefreshTreeDisplay", "Delay") * 2)
    end

    if UserCred   = 'USERCRED'   | UserCred = '' | UserCred = '--user=%' | UserCred = '--user=%%' then UserCred = '-N'
    if ShowHidden = 'SHOWHIDDEN' | ShowHidden = '' then ShowHidden = 0

    do I = 1 to smbmachine.0
        call charout , '  Going for "'smbmachine.I'", got '
        call _StatusBarWrapper '+.'
        stat = stream(smbmachine.I,'c','open read')
        say '  Try to open "'smbmachine.I'" for reading: "'stat'"'
        if stat = "READY:" & smbmachine.0 = 1 then do /* We just found out we are processing the last machine */
            ok = VRSet("TM_RefreshTreeDisplay","Delay", 1000)
        end
        infoline = ""
        if stat = "READY:" then do /* we found a readable output file */
            OneWorkGroupOnly = 0
            GuestRetry = 0
            
            Machine = substr(smbmachine.I,pos('.',smbmachine.I)+1)
            if right(Machine,4) = '$rt$' then do
                Machine = left(Machine, length(Machine) - 4)
                GuestRetry = 1
            end


            smbtree.!machine = _GetMachinehandle(Machine)
           
            if smbtree.!machine = "" then do /* invalid (old) file */
                say time()' _AddSharesDisplay() exit with Invalid file found (no corresponding machine)'
                ok = stream(smbmachine.I,'c','close')
                ok = SysFileDelete(smbmachine.I)
                iterate
            end
            line = linein(smbmachine.I) /* PID line */
            line = linein(smbmachine.I)
            if pos('creating lame', line) > 0 then do
                line = linein(smbmachine.I)
                line = linein(smbmachine.I)
            end
            if pos('Server=[', line) > 0 then do
                infoline = linein(smbmachine.I)
                parse var infoline "Domain=["WorkGroup"] OS=["OS"] Server=["Server"]"Rest
                ok = VRMethod( "CN_smbtree", "SetFieldData", smbtree.!machine, OSFH, OS, VersionFH, Server)
                line = linein(smbmachine.I)
            end
            /* Filter possible debug messages */
            do while(pos("TDB(",translate(line)) > 0) | (pos("%",line) > 0) | (pos("=",line) > 0)
                say '  Skip "'line'"'
                line = linein(smbmachine.I)
            end
            say '  Message "'line'"'
            
            ok = VRMethod('CN_smbtree', 'SetRecordAttr', smbtree.!machine, 'UserData', "SERVER|"||strip(line))

            if pos("FAIL", translate(line)) > 0 then do /* we see an error message - the term "FAIL" seems to be common to all */
                say time()' _AddSharesDisplay() exit with "'line'"'
                ok = stream(smbmachine.I,'c','close')
                ok = SysFileDelete(smbmachine.I)
                /* Try with guest account once */

                if GuestRetry = 0 & UserCred <> '-N' then do
                    say       '  detach 'samba.!smbclientexe' -L "'machine'" -N 'debuglevel' 2>'smbmachine.I'$rt$ 1>&2'
                    address cmd 'detach 'samba.!smbclientexe' -L "'machine'" -N 'debuglevel' 2>'smbmachine.I'$rt$ 1>&2'
                end

                iterate
            end

            retries = 0
            do while(left(line,1) <> '09'x)
                line = linein(smbmachine.I)
                retries = retries + 1
                say '  Skip 'retries' "'line'"'
                if retries >=10 then do /* No valid output - error */
                    say time()' _AddSharesDisplay() exit with invalid output error'
                    ok = stream(smbmachine.I,'c','close')
                    ok = SysFileDelete(smbmachine.I)
                    leave
                end
            end
            if retries >=10 then iterate

            /* Skip header */
            line = linein(smbmachine.I)
            line = linein(smbmachine.I)

            if translate(left(strip(line),5)) = "ERROR" then ok = VRMethod('CN_smbtree', 'SetRecordAttr', smbtree.!machine, 'UserData', "SERVER|"||strip(line))

            do while(left(line,1) = '09'x) /* Share loop */
                share   = strip(substr(line,2,16))
                type    = translate(strip(substr(line,17,10)))
                comment = strip(substr(line,27,))

                select
                    when type = "DISK"    then res = '#64:PMWP.DLL'
                    when type = "PRINTER" then res = '#65:PMWP.DLL'
                    when type = "IPC"     then res = '#59:PMWP.DLL'
                    when type = "DEVICE"  then res = '#84:PMWP.DLL' /* There might be better ones around */
                    otherwise res = ''
                end

                /* Now the machine receives the wakeup icon */
                ok = VRMethod('CN_smbtree', 'SetRecordAttr', smbtree.!machine, 'Icon', "#35:PMWP.DLL")
                
                parent = smbtree.!machine
                smbtree.!share = VRMethod( "CN_smbtree", "AddRecord",parent,, share||'0D0A'x||comment, res)
                ok = VRMethod( "CN_smbtree", "SetRecordAttr", smbtree.!share, "ReadOnly", 1, 'UserData', type"|")
                if pos("$", share) > 0 then ok = VRMethod( "CN_smbtree", "SetRecordAttr", smbtree.!share, "Visible", ShowHidden)

                /* get next share */
                line = linein(smbmachine.I)
            end /* Share loop */

            do until left(line,10) = '09'x||'Workgroup' | lines(smbmachine.I) = 0
                line = linein(smbmachine.I)
            end
            line = linein(smbmachine.I) /* this should be the -------- string */
            /* Reading FIRST workgroup and master - eventually both empty */
            line = linein(smbmachine.I)

            /* Multiple workgroups? */
            if lines(smbmachine.I) = 0 then OneWorkGroupOnly = 1
                                       else OneWorkGroupOnly = 0
            say "  OneWorkGroupOnly = "OneWorkGroupOnly

            parse var line '09'x workgroup master
            master = strip(master)

            /* we use this to set the workgroup for manually added servers - if there is ONLY ONE workgroup */
            if workgroup <> "" & OneWorkGroupOnly = 1 then do
                wgh = _GetMachinehandle(workgroup)
                if wgh = "" then do /* The machine appears to be in a new workgroup - add it as well */
                    /* NOTE: This should be obsolete now because the list of available     */
                    /*       workgroups should always have been updated before we get here */
                    wgh = _AddWorkGroup(workgroup)
                end
                /* we only do this for machines with empty parent (=workgroup) handle */
                /* IF there is only one workgroup */
                if wgh <> "" & VRMethod('CN_smbtree', 'GetRecordAttr', smbtree.!machine, 'Parent') = "" & VRIsValidObject(smbtree.!machine) then do
                    ok = VRMethod('CN_smbtree', 'SetRecordAttr', smbtree.!machine, 'Parent', wgh)
                end
                else do
                    say "Ticket #244 failure: case 1"
                    say "wgh    = "wgh
                    say "Parent = "VRMethod('CN_smbtree', 'GetRecordAttr', smbtree.!machine, 'Parent')
                end
            end
            else do
                if workgroup <> "" then do
                    /* There are multiple workgroups, we need additional */
                    /* measures to find out which is our workgroup       */
                    if infoline <> "" then do
                        say     '  'samba.!smbclientexe' -L "'Machine'" -N 'debuglevel' 2>'samba.!msg' 1>NUL'
                        address cmd samba.!smbclientexe' -L "'Machine'" -N 'debuglevel' 2>'samba.!msg' 1>NUL'
                        infoline = linein(samba.!msg)

                        if word(infoline,1) = "creating" then do /* upcase tables are missing */
                            say "Missing upcase tables detected!"
                            infoline = linein(samba.!msg)
                            infoline = linein(samba.!msg)
                        end
                        IF options.!debug == 1 THEN say '  Response = "'Infoline'"'
                        ok = stream(samba.!msg,'c','close')
                        ok = SysFileDelete(samba.!msg)
                    end

                    parse var infoline "Domain=["WorkGroup"] OS=["OS"] Server=["Server"]"Rest

                    wgh = _GetMachinehandle(workgroup)
                    if wgh <> "" & VRMethod('CN_smbtree', 'GetRecordAttr', smbtree.!machine, 'Parent') = "" & VRIsValidObject(smbtree.!machine) then do
                        ok = VRMethod('CN_smbtree', 'SetRecordAttr', smbtree.!machine, 'Parent', wgh)
                    end
                    else do
                        say "Ticket #244 failure: case 2"
                        say "wgh    = "wgh
                        say "Parent = "VRMethod('CN_smbtree', 'GetRecordAttr', smbtree.!machine, 'Parent')
                    end
                end
                else do
                    /* The machine does not allow browsing and does not report a workgroup here */
                    say '  "'Machine'" does not allow browsing.'
                end
            end

            ok = VRSet("Main", 'Pointer', 'Wait' )

            /* Get NMBLookup Status for machine */
            NMBStatus = _GetMachineNMBSTatus(machine)
            parse var NMBStatus IPStr'|'MAC '|' Roles; drop NMBStatus
            if pos("PDC",Roles) > 0 then ok = VRMethod( "CN_smbtree", "SetRecordAttr", smbtree.!machine, "Icon","#63:PMWP.DLL")
            ok = VRMethod( "CN_smbtree", "SetFieldData", smbtree.!machine, IPFH, IPStr,MBFH, Roles, MacFH,MAC)

            ok = VRSet("Main", 'Pointer', '<default>' )

            say time()' _AddSharesDisplay() success and cleanup'
            ok = stream(smbmachine.I,'c','close')
            ok = SysFileDelete(smbmachine.I)
            if ok <> 0 then say '  Failure 'ok' deleting "'smbmachine.I'"!'
        end
    end

    if UserCred = '-N' then UserCred = ''

    call _StatusBarWrapper "Ready."
    say time()' _AddSharesDisplay() loop end'
return

/*:VRX         _GetMachinehandle
*/

_GetMachinehandle: procedure /* get recordhandle by machine name (also works for workgroups) */
    Machine = translate(arg(1))
    say '  _GetMachineHandle("'Machine'") started.'
    ok = VRMethod("CN_smbtree", "GetRecordList", "All", rh.)
    match = 0

    do I = 1 to rh.0
        ResName  = translate(VRMethod("CN_smbtree","GetRecordAttr",rh.I,"Caption"))

        parse var ResName  ResName '0D0A'x .
        ResName = strip(ResName)

        if Machine = ResName then do /* we got a matching name */
            match = 1
            leave
        end
    end
    if match = 0 then rh.I = "" /* return an empty handle, if there was no match */
    say '  _GetMachineHandle("'Machine'") done, handle = "'rh.I'"'
return rh.I

/*:VRX         _RefreshWorkgroups
*/
_RefreshWorkgroups:
    say time()' _RefreshWorkgroups() started'
    if UserCred   = 'USERCRED'   | UserCred = '' | UserCred = '--user=%' | UserCred = '--user=%%' then UserCred = '-N'
    if BroadCast = 1 then BroadCast = '-b'; else BroadCast = ''

    call VRSet VRWindow(), 'Pointer', 'Wait'
    
    /* smbtree -b = Use broadcast instead of using the master browser
       smbtree -D = List only domains (workgroups) of tree
       smbtree -S = List domains(workgroups) and servers of */
    say       '  detach 'samba.!smbtreeexe' 'BroadCast' -D 'UserCred' 'debuglevel' >'samba.!msg
    address cmd 'detach 'samba.!smbtreeexe' 'BroadCast' -D 'UserCred' 'debuglevel' >'samba.!msg

    call _StatusBarWrapper "Enumerating workgroups"
    do while stream(samba.!msg,'c','open read') <> "READY:"
        ok = SysSleep(1)
        call _StatusBarWrapper '+.'
    end
    call VRSet VRWindow(), 'Pointer', '<default>'

    if BroadCast = '-b' then BroadCast = 1; else BroadCast = 0
    if UserCred = '-N' then UserCred = ''

    ok = File2Stem(samba.!msg,"workgroups.")
    do I = 1 to workgroups.0
        workgroup = translate(workgroups.I)
        if pos("RECEIVING",workgroup) > 0 | pos("TDB(",workgroup) > 0 then iterate /* We ignore errors here */
        wgh = _GetMachinehandle(workgroup)
        if wgh = "" then wgh = _AddWorkGroup(workgroup) /* A new workgroup was found -- add it */
    end
    say time()' _RefreshWorkgroups() done'
return

/*:VRX         _AddWorkgroup
*/
_AddWorkGroup: procedure expose WorkGroupFH
    workgroup = arg(1)
    say '  _AddWorkGroup("'workgroup'") started.'
    wgh= VRMethod( "CN_smbtree", "AddRecord",,, workgroup,"#62:PMWP.DLL")
    ok = VRMethod( "CN_smbtree", "SetFieldData",  wgh, WorkGroupFH, workgroup)
    ok = VRMethod( "CN_smbtree", "SetRecordAttr", wgh, "Collapsed", 0)
    ok = VRMethod( "CN_smbtree", "SetRecordAttr", wgh, "ReadOnly", 1)
    ok = VRMethod( "CN_smbtree", 'SetRecordAttr', wgh, "UserData", "WORKGROUP|")
    say '  _AddWorkGroup("'workgroup'") done.'
return wgh

/*:VRX         _AddSleepingMachine
*/
_AddSleepingMachine: procedure expose WorkGroupFH NBFH CommentFH
    machine = arg(1)
    comment = arg(2)
    parent  = arg(3)
    mh = VRMethod( "CN_smbtree", "AddRecord",parent,, machine||'0D0A'x||comment)
    ok = VRMethod( "CN_smbtree", "SetFieldData",  mh, NBFH, machine, CommentFH, comment)
    ok = VRMethod( "CN_smbtree", "SetRecordAttr", mh, "Icon","#61:PMWP.DLL")
    ok = VRMethod( "CN_smbtree", "SetRecordAttr", mh, "ReadOnly", 1)
    ok = VRMethod( "CN_smbtree", "SetRecordAttr", mh, "Collapsed", 1)
    ok = VRMethod( "CN_smbtree", 'SetRecordAttr', mh, "UserData", "SERVER|")
    if parent <> "" then do
        WGName  = translate(VRMethod("CN_smbtree","GetRecordAttr",parent,"Caption"))
        parse var WGName  WGName '0D0A'x .
        ok = VRMethod( "CN_smbtree", "SetFieldData",  mh, WorkgroupFH, strip(WGName))
    end
return mh

/*:VRX         _GetMachineIP
*/
_GetMachineIP: procedure expose debuglevel samba.
    say time()' _GetMachineIP() started'
    /* Get all IP addresses of the machine */
    machine = arg(1)
    call VRSet VRWindow(), 'Pointer', 'Wait'
    say       '  detach 'samba.!nmblookupexe' 'machine' 'debuglevel' >'samba.!msg
    address cmd 'detach 'samba.!nmblookupexe' 'machine' 'debuglevel' >'samba.!msg

    call _StatusBarWrapper "Obtaining IP from "machine
    do while stream(samba.!msg,'c','open read') <> "READY:"
        ok = SysSleep(0.33)
        call _StatusBarWrapper '+.'
    end
    call VRSet VRWindow(), 'Pointer', '<default>'

    ok = file2stem(samba.!msg,"nmblookup.")
    ipstr = ""; ip = ""
    do i = 1 to nmblookup.0
        if pos(strip(machine)'<',nmblookup.i) = 0 then iterate
        parse var nmblookup.i ip .
        if pos(strip(ip), ipstr) = 0 then ipstr = ipstr||ip','
    end
    ipstr = strip(ipstr,,',')
    say time()' _GetMachineIP() done'
return IpStr

/*:VRX         _GetMachineRole
*/
_GetMachineMACRoles: procedure expose debuglevel samba.
    say time()' _GetMachineMACRoles() started'
    machine = arg(1) /* May be name or IP */
    call VRSet VRWindow(), 'Pointer', 'Wait'
    say       '  detach 'samba.!nmblookupexe' -A 'machine' 'debuglevel' >'samba.!msg
    address cmd 'detach 'samba.!nmblookupexe' -A 'machine' 'debuglevel' >'samba.!msg

    call _StatusBarWrapper "Obtaining capabilities from "machine
    do while stream(samba.!msg,'c','open read') <> "READY:"
        ok = SysSleep(0.33)
        call _StatusBarWrapper '+.'
    end
    call VRSet VRWindow(), 'Pointer', '<default>'
    ok = file2stem(samba.!msg,"nmblookup.")
    Roles = ""
    MAC = 'xx-xx-xx-xx-xx-xx'
    do I = 1 to nmblookup.0
        select
            when pos('<1c>', nmblookup.I) > 0 then Roles = Roles||"PDC," /* # */
            when pos('<1b>', nmblookup.I) > 0 then Roles = Roles||"LMB," /* + */
            when pos('<1d>', nmblookup.I) > 0 then Roles = Roles||"DMB," /* * */
            when pos('MAC',  nmblookup.I) > 0 then do
                parse var nmblookup.I . '=' MAC
                MAC = strip(MAC)
            end
            otherwise nop
        end
    end
    Roles = strip(Roles,,',')
    if Roles = "" then Roles = "Workstation"
    say time()' _GetMachineMACRoles() done'    
return MAC'|'Roles

/*:VRX         _GetMachineNMBStatus
*/
_GetMachineNMBStatus: procedure expose debuglevel samba.
    say time()' _GetMachineNMBStatus() started'
    machine = arg(1) /* name only allowed */
    call VRSet VRWindow(), 'Pointer', 'Wait'
    say       '  detach 'samba.!nmblookupexe' -S 'machine' 'debuglevel' >'samba.!msg
    address cmd 'detach 'samba.!nmblookupexe' -S 'machine' 'debuglevel' >'samba.!msg

    call _StatusBarWrapper "Querying "machine" for roles"
    do while stream(samba.!msg,'c','open read') <> "READY:"
        ok = SysSleep(0.33)
        call _StatusBarWrapper '+.'
    end
    call VRSet VRWindow(), 'Pointer', '<default>'

    ok = file2stem(samba.!msg,"nmblookup.")
    IPStr = ""
    Roles = ""
    MAC = 'xx-xx-xx-xx-xx-xx'
    do I = 1 to nmblookup.0
        select
            when pos(machine'<',nmblookup.I) > 0 then do
                parse var nmblookup.i ip .
                ip = strip(ip)
                if pos(ip, ipstr) = 0 then ipstr = ipstr||ip','
            end
            when pos('<1c>', nmblookup.I) > 0 then Roles = Roles||"PDC," /* # */
            when pos('<1b>', nmblookup.I) > 0 then Roles = Roles||"LMB," /* + */
            when pos('<1d>', nmblookup.I) > 0 then Roles = Roles||"DMB," /* * */
            when pos('MAC',  nmblookup.I) > 0 then do
                parse var nmblookup.I . '=' MAC
                MAC = strip(MAC)
            end
            otherwise nop
        end
    end
    Roles = strip(Roles,,',')
    if Roles = "" then Roles = "Workstation"
    ipstr = strip(ipstr,,',')
    say time()' _GetMachineNMBStatus() done'    
return IPStr'|'MAC'|'Roles



/*:VRX         file2stem
*/
file2stem:
    say time()' file2stem() started'
    msgfile = arg(1) /* file to create stem of */
    msgstem = arg(2) /* name of the stem */
    if right(msgstem,1) <> '.' then msgstem = msgstem'.'
    delmsgfile = translate(arg(3)) /* erase file after transfer */
    skipwords = strip(arg(4)||' creating lame tdb( ***') /* skip lines with these words */
    do J = 1 to words(skipwords)
        skip.J = translate(word(skipWords,J))
    end
    skip.0 = J
   
    say '  file2stem("'msgfile'","'msgstem'")'
    dyn = 'drop 'msgstem
    interpret dyn
    stemcount = 0
    skipped = 0
    do while lines(msgfile) > 0
        stemcount = stemcount + 1
        inline = linein(msgfile)
        SkipIt = 0
        do J = 1 to skip.0
        if pos(skip.J,translate(inline)) > 0 then do
                skipit = 1
                stemcount = stemcount - 1
                skipped = skipped + 1
                leave
            end
        end
        if \SkipIt then do
            dyn = msgstem||stemcount' = inline'
            interpret dyn
        end
    end
    dyn = msgstem||"0 = "stemcount
    interpret dyn
    ok = stream(msgfile,'c','close')
    if delMsgFile <> "NODEL" then ok = SysFileDelete(msgfile)
    
    drop msgfile msgstem
    say time()' file2stem() ['stemcount' added, 'skipped' skipped] done'    
return stemcount

_StatusBarWrapper:
    StatusWText = arg(1)
    if VRIsValidObject("DT_STATUSBAR") then do
        if VRGet("DT_STATUSBAR","BACKCOLOR") <> "<defaul>" then ok = VRSet("DT_STATUSBAR","BACKCOLOR","<default>")
        if left(StatusWText,1) = "+" then do
            ok = VRSet("DT_STATUSBAR","Caption", VRGet("DT_STATUSBAR","Caption")||substr(StatusWText,2))
        end
        else do
            ok = VRSet("DT_STATUSBAR","Caption", " "||StatusWText)

            if VRIsValidObject("TM_STATUSBAR") then do
                ok = VRSet("TM_STATUSBAR","DELAY", 4000)
                ok = VRSet("TM_STATUSBAR","Enabled", 1)
                trStWT = translate(StatusWText)
                select
                   when pos("LOGIN SUCCESSFUL",        trStWT) > 0 then ok = VRSet("DT_STATUSBAR","BACKCOLOR","GREEN")
                   when pos("NT_STATUS_OK",            trStWT) > 0 then ok = VRSet("DT_STATUSBAR","BACKCOLOR","GREEN")
                   when pos("OK",                      trStWT) > 0 then ok = VRSet("DT_STATUSBAR","BACKCOLOR","GREEN")
                   when pos("NT_STATUS_ACCESS_DENIED", trStWT) > 0 then ok = VRSet("DT_STATUSBAR","BACKCOLOR","YELLOW")
                   when pos("ERROR",                   trStWT) > 0 then ok = VRSet("DT_STATUSBAR","BACKCOLOR","RED")
                   when pos("NT_STATUS_",              trStWT) > 0 then ok = VRSet("DT_STATUSBAR","BACKCOLOR","RED")
                   otherwise ok = VRSet("TM_STATUSBAR","Enabled", 0)
                end
            end
        end
    end
return

_StatusBarReset:
    ok = VRSet("DT_STATUSBAR","BACKCOLOR","<default>")
    ok = VRSet("TM_STATUSBAR","Enabled", 0)
return