OS/2 Professional/OS2PRO194.ISO/os2/fileutil/dhrgcd/dhrgcd.cmd

Text File | 1992-07-01 | 18.2 KB | 480 lines

/* This is a REXX Exec */
/*
** DHR Global Change Directory Version 1.01
** Created 06/09/92 by Dennis H. Rosenthal
** for OS/2 Version 2.0.
** Released to the public domain.
** No warranty expressed or implied.
** Enter DHRGCD /h for View help or ? for
**  help info at end of this file
*/
trace
/* Reference #1 */
parse upper source opsys cmdtype exname1
exname = filespec('NAME',exname1)                        /* name of this file */
parse var exname exname '.' .
'@ECHO OFF'                              /* Turn off display of OS/2 commands */
signal on halt name gcd_halt                       /* Trap control break keys */

/*
** Set Options Next
*/

/* Reference #2 */
use_current_disk_index = 'N'           /* Set to 'Y' to always check current  */
                                       /*  disk first for directory index     */
use_boot_disk_index = 'Y'              /* Set to 'N' to use first local       */
                                       /*  disk for directory index           */
use_ansi_colors = 'Y'                  /* Set to 'N' to skip colors           */

use_all_disks = 'Y'                   /* Set to 'N' to index only local disks */
                                      /* Set to 'Y' to index local & network  */

/*
** End of Options
*/


/*
** Extract command line parms
** Provide both OS/2 method - command / option or / option command
** and VM/CMS method - command ( option
*/
/*
** Allow spaces in directory name ("  ")
** Place directory desired into variable named target
** Place option into variable named opt
*/
/* Reference #3 */
parse upper arg target1 '/' opt1 target2 .
parse upper arg . '"'target3'"' .
parse upper arg target4 '(' opt2 ')' .
target1 = strip(target1)
target2 = strip(target2)
target3 = strip(target3,T)                     /* remove only trailing blanks */
target4 = strip(target4)
if target3 <> '' then target = target3
else if opt2 <> '' then target = target4
else if target1 <> '' then target = target1
else target = target2
if opt2 <> '' then opt = opt2
else opt = opt1
opt = strip(opt)
if target = '?' then opt = target

/*
** Verify allowable options here
*/
/* Reference #4 */
if opt = '?' | opt = 'H' then do
    call disp_help
    exit 4                                                /* exit immediately */
end
else if target = '' then do
    if opt = 'L' | opt = '' then do
        say ''
        say 'Cmd requires destination directory as parameter'
        say 'For more information, use /? as parm'
        exit 12                                           /* exit immediately */
    end
    else if opt <> 'R' & opt <> 'RQ' then do
        say ''
        say 'Error - Invalid option ('opt') entered'
        exit 16                                           /* exit immediately */
    end
end
else if opt <> '' then do
    if opt <> 'L' & opt <> 'R' & opt <> 'RQ' then do
        say ''
        say 'Error - Invalid option ('opt') entered'
        exit 16                                           /* exit immediately */
    end
end

/*
** Define some constants
*/
/* Reference #5 */
index_file = 'DIRINFO.GCD'                      /* Identify Global Index File */
if use_ansi_colors = 'Y' then do                          /* test option flag */
    esc_char        = '1B'x
    ansi_red        = esc_char'[0;31;40m'       /* red foreground, black back */
    ansi_boldred    = esc_char'[1;31;40m'   /* bold red foreground,black back */
    ansi_green      = esc_char'[0;32;40m'     /* green foreground, black back */
    ansi_boldgreen  = esc_char'[1;32;40m'     /* green foreground, black back */
    ansi_yellow     = esc_char'[0;33;40m'    /* yellow foreground, black back */
    ansi_boldyellow = esc_char'[1;33;40m'    /* yellow foreground, black back */
    ansi_blue       = esc_char'[0;34;40m'      /* blue foreground, black back */
    ansi_boldblue   = esc_char'[1;34;40m'      /* blue foreground, black back */
    ansi_white      = esc_char'[0;40m'               /* normal white on black */
    ansi_erase      = esc_char'[2J'              /* erase screen, home cursor */
end
else do
    ansi_red        = ''
    ansi_boldred    = ''
    ansi_green      = ''
    ansi_boldgreen  = ''
    ansi_yellow     = ''
    ansi_boldyellow = ''
    ansi_blue       = ''
    ansi_boldblue   = ''
    ansi_white      = ''
    ansi_erase      = ''
end
gcd_rc = 0
result = 0
building_index = 0
cur_dir = directory()                               /* save current directory */
/* Load Rexx System Utility Functions if not already loaded */
if RxFuncQuery('SysLoadFuncs') then do
    call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
    call SysLoadFuncs                                    /* RexxUtil function */
end


/*
** Identify boot disk if option selected
*/
/* Reference #6 */
boot_disk = ''                                          /* init value to null */
if use_boot_disk_index = 'Y' then do                           /* test option */
    /*
    ** Find Boot Disk
    ** Use custom DLL to issue DosQuerySysInfo
    */
    if RxFuncQuery('DHRSysInfo') then
        call RxFuncAdd 'DHRSysInfo','DHRRU100','DHRSysInfo'
    if result > 1 then do
        say ''
        say 'Unable to Add Function DHRSysInfo from DLL DHRRU100'
            '(rc ='result')'
        say 'Please insure that the DHRRU100.DLL exists in a'
            'subdirectory contained'
        say 'in the LIBPATH statement in your CONFIG.SYS file.'
        exit 32                                           /* exit immediately */
    end
    call 'DHRSysInfo' OS2info                     /* Extract OS/2 System Info */
    if result <> 0 then do
        say ''
        say 'Error' result 'processing DHRSysInfo request'
        exit 36                                           /* exit immediately */
    end
    call RxFuncDrop 'DHRSysInfo'
    /*
    ** Set boot_disk to disk letter if not floppy
    ** OS2info.5 = boot disk number, 1=A, 3=C, etc.
    */
    if OS2info.5 > 2 then
        boot_disk = substr('ABCDEFGHIJKLMNOPQRSTUVWXYZ',OS2info.5,1)':'
end


/*
** Check if index file already exists.
** If use_current_disk_index option is set to 'Y' then check only current
** disk.
** If use_boot_disk_index is set to 'Y' then check boot disk.
** If not found, check first local disk.
*/
/* Reference #7 */
index_disk = ''                                         /* init value to null */
if use_current_disk_index = 'Y' then do                        /* test option */
    index_disk = left(cur_dir,2)
    rc = SysFileTree(index_disk'\'index_file,dirstem,'FO')   /* RexxUtil call */
    if dirstem.0 < 1 then index_disk = ''                        /* not found */
end
else do
    if use_boot_disk_index = 'Y' & boot_disk <> '' then do     /* test option */
        index_disk = boot_disk                       /* always use boot disk! */
        /* Uncomment the following to search for the index on */
        /* all other disks if it is not currently on the boot disk */
        /* rc = SysFileTree(boot_disk'\'index_file,dirstem,'FO') */
        /* if dirstem.0 < 1 then index_disk = '' */              /* not found */
        /* else index_disk = boot_disk */                    /* use boot disk */
    end
    if index_disk = '' then do         /* search local disks if not yet found */
        local_list = SysDriveMap('C:','LOCAL')           /* RexxUtil function */
        do while local_list <> ''
            parse var local_list test_drive local_list
            rc = SysFileTree(test_drive'\'index_file,dirstem,'FO')  /*RexxUtil*/
            if dirstem.0 > 0 then do
                index_disk = test_drive              /* found on a local disk */
                leave
            end
        end
    end
end
/*
** if index file has not been found, set index_disk based on options set
*/
/* Reference #8 */
if index_disk = '' then do
    if use_current_disk_index = 'Y' then index_disk = left(cur_dir,2)
    else if use_boot_disk_index = 'Y' & boot_disk <> '' then
        index_disk = boot_disk
    else do
        local_list = SysDriveMap('C:','LOCAL')           /* RexxUtil function */
        if local_list <> '' then index_disk = left(local_list,2)
        else do
            say ''
            say 'Error - Directory Index not found and no local disks'
            say 'found to store index!'
            exit 44                                       /* exit immediately */
        end
    end
end


/*
** Process request
*/
/* Reference #9 */
if opt = 'R' | opt = 'RQ' then do                  /* Rebuild Directory Index */
    'DEL' index_disk'\'index_file' 2> NUL'            /* Delete Previous File */
    if opt = 'R' then say 'Index File will be placed on disk' index_disk
    dir_count = 0
    drive_list = ''
    building_index = 1                               /* set flag for gcd_halt */
    if target = '' then do
        if use_all_disks = 'Y' then                              /* test flag */
            drive_list = SysDriveMap('C:','USED')        /* RexxUtil function */
        else
            drive_list = SysDriveMap('C:','LOCAL')       /* RexxUtil function */
    end
    else do while target <> ''
        drive_list = drive_list||left(target,1)': '      /* Use supplied list */
        target = substr(target,2)
    end
    if opt = 'R' then say 'Now Process Drives ' drive_list
    do while drive_list <> ''
        parse var drive_list test_drive drive_list
        if opt = 'R' then say 'Examine Disk' test_drive
        /* rc = SysFileTree(test_drive'\*.*',dirstem,'SDO') */
        call sysfiletree_work_around
        if dirstem.0 = 0 then do
            say 'Warning - No Directories On Drive' test_drive
        end
        else do dir_ctr = 1 to dirstem.0
            call write_dir dirstem.dir_ctr
        end
        dir_count = dir_count + dirstem.0
    end
    if dir_count = 0 then do
        say ''
        say 'Error - No Directories Found, Index File Not Created'
        exit 24                                           /* exit immediately */
    end
    else do
        say dir_count 'Directories Indexed'
        rc = lineout(index_disk'\'index_file)                   /* Close File */
    end
    building_index = 0                             /* reset flag for gcd_halt */
end
else do
    /*
    ** Extract info from directory file
    */
    /* Reference #10 */
    call SysFileSearch target,index_disk'\'index_file,'searchstem'  /*RexxUtil*/
    if result <> 0 then do
        say ansi_red
        say 'Error - Index File -' index_disk'\'index_file' - Not Found'
        say 'Execute' exname '/r to Build Index'
        gcd_rc = 28
        signal exit_gcd                                         /* go to exit */
    end
    match_ctr = 0
    match_val. = ''
    best_match = ''
    do s_ctr = 1 to searchstem.0
        if opt = 'L' then
            if left(cur_dir,2) <> left(searchstem.s_ctr,2) then iterate
        last_sub = filespec('NAME',searchstem.s_ctr)
        if pos(target,last_sub) > 0 then do
            match_ctr = match_ctr + 1
            match_val.match_ctr = searchstem.s_ctr
            if left(cur_dir,2) = left(match_val.match_ctr,2) & ,
                cur_dir <> match_val.match_ctr & ,
                target = last_sub then best_match = match_ctr   /* best match */
        end
    end
    ans1 = ''
    if match_ctr = 1 then do
        say ansi_green'Now Switching to' match_val.1
        call directory match_val.1
        if result = '' then do
            say ansi_red'Error changing to directory' match_val.1
            gcd_rc = 20
        end
    end
    /* Reference #11 */
    else if match_ctr > 1 then do while ans1 = ''
        say ansi_green'There are multiple possibilities -'
        /*y ansi_green'1...+....1....+....2....+....3....+....4....+....5' */
        parse value SysTextScreenSize() with screen_rows screen_cols  /*RexxUt*/
        if match_ctr > screen_rows - 5 then do
            do temp_ctr = 1 to match_ctr by 2
                temp_ctr2 = temp_ctr + 1
                if match_val.temp_ctr2 <> '' then
                    disp2 = right(temp_ctr2,3) match_val.temp_ctr2
                else disp2 = ''
                if length(match_val.temp_ctr) < 36 & ,
                   length(match_val.temp_ctr2) < 36 then do
                    say ansi_boldgreen||right(temp_ctr,3),
                        left(match_val.temp_ctr,35),
                        disp2
                end
                else do
                    say ansi_boldgreen||right(temp_ctr,3) match_val.temp_ctr
                    say ansi_boldgreen||disp2
                end
            end
        end
        else do
            do temp_ctr = 1 to match_ctr
                say ansi_boldgreen||right(temp_ctr,3) match_val.temp_ctr
            end
        end
        if best_match = '' then
            say ansi_boldyellow'Enter Selection Number or 0 for No Change'
        else
            say ansi_boldyellow'Enter Selection Number, 0 for No Change,',
                'or Just Press Enter for Item' best_match
        ans1 = get_ans(match_ctr)                   /* function defined below */
        if ans1 = 0 then do
            say ansi_yellow||exname 'will terminate with no change'
            signal exit_gcd                                     /* go to exit */
        end
        if best_match <> '' then if ans1 = '' then ans1 = best_match
        destdir = match_val.ans1
        if destdir <> '' then do
            say ansi_green'Now Switching to' destdir
            call directory destdir
            if result = '' then do
                say ansi_red'Error changing to directory' match_val.1
                gcd_rc = 20
            end
        end
        else do
            say ansi_erase||ansi_boldred'Invalid Response ('ans1'),',
                'Enter again'
            ans1 = ''
        end
    end
    else do
        say ansi_red'Error - Directory' target 'not found'
        gcd_rc = 8
    end
end
/* Reference #12 */
exit_gcd:                                                 /* go to exit label */
call CHAROUT 'CON:', ansi_white                       /* restore screen color */
exit gcd_rc                       /* exit main procedure with variable gcd_rc */



/*
** Arrive here if control break or control C due to
** 'signal on halt name gcd_halt' statement at the beginning
*/
/* Reference #13 */
gcd_halt:
if building_index = 1 then do
    rc = lineout(index_disk'\'index_file)                       /* Close File */
    'DEL' index_disk'\'index_file' 2> NUL'     /* Delete Current Partial File */
end
say ''
say exname 'will terminate' ansi_white                /* restore screen color */
exit -1                                                   /* exit immediately */


/*
** Following subroutine required because SysFileTree
** does not return directories with leading spaces!
*/
/* Reference #14 */
sysfiletree_work_around:
'DIR' test_drive'\ /A:D /B /F /S | RXQUEUE'
dirstem.0 = queued()
do dir_ctr = 1 to dirstem.0
    pull dirstem.dir_ctr
end
return                                                    /* return to caller */


/*
** Function to Process Keyboard Input function
*/
/* Reference #15 */
get_ans:
parse arg max_numb
max_digits = length(max_numb)
key_string = ''
key_count = 0
do forever
    key = SysGetKey('NOECHO')                            /* RexxUtil function */
    if key = '00'x | key = 'E0' then key = SysGetKey('NOECHO')
    if key = '1B'x then do                             /* Esc key = no change */
        key_string = 0
        leave
    end
    if key = '0D'x then leave                             /* Enter key = exit */
    if key < '0' | key > '9' then iterate             /* Process only numbers */
    key_string = key_string||key                                /* Save input */
    call CHAROUT 'CON:', key                               /* Echo to display */
    if key = '0' & key_string = '0' then leave           /* Exit if leading 0 */
    key_count = key_count + 1
    if key_count >= max_digits then leave       /* Exit if max digits entered */
end
call CHAROUT 'CON:', '  '                                  /* Add some spaces */
return key_string                           /* Return to caller with numerics */


/*
** Subroutine to Write Directory Info to File
*/
/* Reference #16 */
write_dir:
parse upper arg save_dir
if opt = 'R' then say save_dir
rc = lineout(index_disk'\'index_file, save_dir)
if rc <> 0 then do
    say 'Error' rc 'writing' index_file 'to disk' index_disk
    say exname 'will terminate immediately'
    gcd_rc = 40
    signal exit_gcd
end
return                                                    /* return to caller */


/*
** Subroutine to Display Help Information
*/
/* Reference #17 */
disp_help:
if opt = 'H' then do
    'VIEW ' exname
    if rc = 0 then return                       /* unfortunately, rc always 0 */
end
say '                     ' exname 'Version 1.01 Help'
say 'This cmd will jump to another directory on the current disk or any other'
say 'hard disk known to your PC. Format is -'
say exname 'new-directory-name'
say 'If multiple destinations are possible, a selection list will be presented.'
say 'Use the /r or /rq option to initialize a list of directories available on your'
say 'PC. This should be rerun when directories change. Format is -'
say exname '/r optional-drive-list'
say 'where an optional string of drive letters may be supplied (ex. DFH). If not'
say 'supplied, all local drives starting with drive C will be examined for'
say 'directories. The option /rq will do the same but without the display of each'
say 'directory found.'
say 'The option /l may be used to restrict selection to directories only on the'
say 'current disk. The option /h may be used to display more help information.'
say 'The search for new-directory-name will only be successful if it appears as'
say 'part of the last qualifier of a directory in whole or part.'
say 'The destination of where the index file will be placed may be customized.'
say ' '
say 'Please refer to the' exname'.DOC file or' exname'.INF (with VIEW) file for'
say 'more information'.
return                                                    /* return to caller */