Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : RLIB.ZIP
Filename : RL_PAREN.PRG

 
Output of file : RL_PAREN.PRG contained in archive : RLIB.ZIP
* Function..: PARENT
* Author....: Richard Low
* Syntax....: PARENT( [] )
* Returns...: Character name of the current directory's parent directory.
* If the current directory is the root directory, then the
* root directory ('\') is returned.
* Parameters: Optional name of directory to give parent for.

FUNCTION PARENT
PARAMETER p_dir
PRIVATE f_drive

*-- if a directory name is not provided, get the current directory
IF TYPE('p_dir') != 'C'
p_dir = CURDIR()
ENDIF

*-- assume no drive letter was given
f_drive = ''

*-- if they provided a drive letter, save it then strip it off
IF SUBSTR(p_dir,2,1) = ':'
f_drive = SUBSTR(p_dir,1,2)
*-- if only a drive letter given, get current directory for that drive
IF LEN(p_dir) = 2
p_dir = CURDIR(p_dir)
ELSE
*-- otherwise, isolate the directory part from the drive letter
p_dir = SUBSTR(p_dir,3)
ENDIF
ENDIF

*-- strip the '\' from the front of the directory name if it is there
IF SUBSTR(p_dir,1,1) = '\'
p_dir = SUBSTR(p_dir,2)
ENDIF

*-- if there are no more backslashes in the directory name, then will
*-- be only one directory level deep, so return the root directory
IF .NOT. '\' $ p_dir
RETURN f_drive + '\'
ENDIF

*-- otherwise, parse and strip off the trailing directory

*-- if directory = '\APPS\CLIPPER\TEST' this will return '\APPS\CLIPPER'
*-- if directory = 'F:\USERS\RICHARD' this will return 'F:\USERS'

RETURN ( f_drive + '\' + SUBSTR( p_dir, 1, RAT('\',p_dir)-1 ) )


  3 Responses to “Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : RLIB.ZIP
Filename : RL_PAREN.PRG

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/