home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The World of Computer Software
/
World_Of_Computer_Software-02-386-Vol-2of3.iso
/
c
/
cliptree.zip
/
GPATH.PRG
< prev
next >
Wrap
Text File
|
1993-02-08
|
11KB
|
288 lines
/*┌──────────────────────────────────────────────────────────────────────┐
▌│ │
▌│ Program Name: GPATH.PRG Copyright: ************************* │
▌│ Date Created: 02/06/93 Language: Clipper 5.0 │
▌│ Time Created: 12:09:30 Author: Howard G. Smith │
▌│ c:/brief/clipper.src Altered: Kevin S. Gallagher │
▌│ │
▌│ * This function was downloaded from GRUMPFISH BBS │
▌│ * Tweaked main function to include "hidden directories" │
▌│ * Cleaned up coding for sake of reading code. │
▌│ * Revamped test function, the original didn't do much! │
▌│ * Added header file │
▌│ * Added static variables for achoice shell │
▌│ * Added option to optionally change to the selected dir in achoice() │
▌│ * Added option to change to another drive │
▌│ * Gave the program the look/feel of Norton Change Directory v4.5 │
▌│ * Alternate alert box function by: Stephen L. Woolstenhulme │
▌│ * Tweaked Steve's box to place a shadow around the alert box │
▌│ * Revisions made 02/08/93 to work with my file finder - KSG │
▌└──────────────────────────────────────────────────────────────────────┘
▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀ */
#include "include1.h"
#undef K_SPACE
#define K_SPACE 32
STATIC aBar_ :={}, /* these variables are mostly for the */ ;
nTotEle :=0, /* scrollbar and UDF for ACHOICE */ ;
sEle :=0, /* and if so desired can be removed */ ;
nChoice :=0, /* without much work! */ ;
aText_ :={}, ;
nErrCode:= 0 /* error code for disk array udfs */
function main( Parm1, Parm2 )
LOCAL cDefErr:=ERRORBLOCK(), DISK_ARR:= curdrive() + "DISK.DAT"
local oldcolor:= setcolor("W+/B,B+/W"), cStr, xCMD := "CD ", i:=1, aDirs_
local nTr :=3, nTc :=8, nBr :=20, nBc :=72, lWrite:= .F., lRead := .F.
/*
* bypass clippers error saver
*/
ERRORBLOCK( {|e| ERRORSAVER(e, cDefErr, "VTREE", "ERROR.TXT")})
IF VALTYPE(Parm1) == "C"
Parm1 := upper(Parm1)
DO CASE
CASE "/?" $ Parm1
CMDHELP()
CASE "/W" $ upper(Parm1)
lWrite:=.T.
CASE "/R" $ upper(Parm1)
lRead := .T.
OTHERWISE
//
ENDCASE
ENDIF
IF !EMPTY(Parm1)
DO CASE
CASE AT(":",Parm1)==2 .AND. AT("/",Parm1)==3 .AND. LEN(Parm1)==4
cStr := SUBS(Parm1,1,2)+"\"
lRead := IF(RIGHT(Parm1,1) == "R",.T.,.F.)
lWrite:= IF(RIGHT(Parm1,1) == "W",.T.,.F.)
CASE "/" $ Parm1 .AND. AT(":",Parm1) == 0
cStr := curdrive()
CASE AT(":",Parm1) == 2 .AND. LEN(Parm1) == 2
cStr := SUBS(Parm1,1,2)+"\"
IF cStr != curdrive()
DISK_ARR := SUBS(cStr,1,1)+SUBS(DISK_ARR,2)
IF VALTYPE(Parm2) == "C"
parm2 := upper(parm2)
lRead := IF("/R" $ Parm2,.T.,.F.)
lwrite:= IF("/W" $ Parm2,.T.,.F.)
ENDIF
ENDIF
OTHERWISE
cStr := curdrive()
ENDCASE
ELSE
cStr := curdrive()
ENDIF
if !DrvReady( SUBS( cStr,1,1) )
ALERT("ERROR READING "+cStr,{" QUIT "})
QUIT
endif
Panel( .F. )
SETCURSOR(0)
WideBox(nTr,nTc,nBr,nBc,"Directory Tree")
@ 4,11 say "Current Directory: "+cStr
@ 5,11 say replicate('─',59)
IF FILE( DISK_ARR ) .AND. !lRead
aDirs_:=FT_RESTARR(DISK_ARR,@nErrCode)
IF nErrCode <> 0
alert("ERROR")
ENDIF
ELSE
Msg("Scanning"," Disk for directories..; ",MsgColor)
aDirs_:=grafpath( cStr,{ | s | CENTER( MIDRow(), STR(i++,4) ) } )
IF lRead
IF(FILE(DISK_ARR),FERASE(DISK_ARR),NIL) // erase old file
FT_SAVEARR(aDirs_,DISK_ARR,@nErrCode) // create disk array
ENDIF
ENDIF
IF( LEN(aDirs_[1]) < 10, scroll(nTr+3,nTc+3,nBr-2,nBc-1),NIL)
nTotEle:= LEN(aDirs_[DIR_NAM])
aBar_ := ScrollBarDisplay( { nTr+1, nBc, nBr-1, nBc, "w+/b", 1 } )
aText_ := ACLONE(aDirs_)
@0,0 say PADR(" [ENTER]= file listing [F10]= exit",80) color "w+/rb"
keyboard chr(255)
ACHOICE( nTr+3,nTc+3,nBr-1,nBc-3 ,aDirs_[1],,"ashell",sEle)
cStr := IF(nChoice # 0, aDirs_[DIR_PATH,nChoice],NIL)
IF VALTYPE(cStr) == "C" .AND. LEN(cStr) > 3
cStr := SUBS( cStr, 1, RAT("\", cStr)-1 )
ENDIF
/*
* Function extracted from NANFOR.LIB - public domain library
* See SAVEARR.PRG for usage and sample function....
*/
IF lWrite
IF(FILE(DISK_ARR),FERASE(DISK_ARR),NIL) // erase old file
FT_SAVEARR(aDirs_,DISK_ARR,@nErrCode) // create disk array
ENDIF
IF pickone([ Change to ]+cStr+" ",{[ Yes ],[ No ]},12,2,[w+/rb])==1
IF upper(SUBS(cStr,1,3)) != curdrive()
RUN ( SUBS(cStr,1,2) )
endif
RUN (xCMD+cStr)
ENDIF
setcolor(oldcolor)
scroll()
SETCURSOR(1)
return nil
function grafpath(cCurpath, bMessg)
local adirlst := {}, aSubdirlst := {}, aRetArr := {{},{}}, aArr_:={}, x
local lLastNam, cnextpath, retval
cCurpath := IF(valtype(cCurpath) = "U", "\", Upper( cCurpath))
/*
* get directory information (names only)
*/
AEVAL(DIRECTORY(cCurpath+"*.*","DSH"),{ |a| IF( EVAL(OkBLOCK[1],a) .AND.;
!EVAL( OkBLOCK[2], a ), AADD( aDirLst, T_BRANCH + a[1]),) } ;
)
/*
* Build array of character pointers to each directory, and a graphic tree
* of the entire disk. You may need to increase the STACK size for many
* directories on a large disk.
*/
if !empty(aDirlst)
asort(aDirlst)
aDirlst[len(aDirlst)] = L_BRANCH + substr(aDirlst[len(aDirlst)],3)
endif
/*
* used to show our progress while filling arrays
*/
EVAL(bMessg,cCurpath)
AEVAL(aDirlst, {|cDir| cnextpath := cCurpath + SUBS(cDir, 3 ) + "\", ;
AADD( aRetarr[DIR_NAM], cDir ), ;
AADD( aRetarr[DIR_PATH], cNextpath), ;
lLastnam := (cDir == aDirlst[LEN(aDirlst)]), ;
aSubDirLst:= GRAFPATH(cNextpath,bMessg), ;
AEVAL(aSubdirlst[DIR_NAM], {|cDirNam| ;
AADD(aretarr[DIR_NAM], IF(lLastnam,NO_BRANCH,I_BRANCH)+ cDirNam)}), ;
AEVAL(aSubdirlst[DIR_PATH], {|cNewDirPath| ;
AADD(aretarr[DIR_PATH], cNewDirPath) } ) } )
if SUBS(cCurpath,2) == ":\" .OR. cCurpath == "\"
AADD( aretarr[DIR_NAM] , )
AADD( aretarr[DIR_PATH], )
AINS( aretarr[DIR_NAM] , 1 )
AINS( aretarr[DIR_PATH], 1 )
aretarr[DIR_NAM,1] := aretarr[DIR_PATH,1] := cCurpath
retval = aRetArr
else
retval = aRetArr
endif
return(retVal)
FUNCTION ashell( status, nElem, nRight )
local RetVal := 2, nKey := lastkey()
/*
* Pressing [ENTER] or [SPACEBAR] --> show files in diretory
* Pressing [F10] --> exits achoice
*/
DO CASE
CASE status == 0 .OR. nKey == 255
ScrollBarUpdate(aBar_,nElem,nTotEle,.T.)
CASE status == 1
keyboard CHR(K_CTRL_PGDN)
RetVal := 2
CASE status == 2
keyboard CHR(K_CTRL_PGUP)
RetVal := 2
CASE nKey == K_F10
nChoice := nElem
RetVal := 0
CASE nKey == K_HOME
keyboard CHR(K_CTRL_PGUP)
CASE nKey == K_END
keyboard CHR(K_CTRL_PGDN)
CASE nKey == K_ESC
alert("PRESS F10 TO EXIT")
RetVal := 2
CASE nKey == K_LEFT
keyboard CHR(K_DOWN)
CASE nKey == K_RIGHT
keyboard CHR(K_UP)
CASE nKey == K_SPACE .OR. nKey == K_ENTER
ShowFiles(aText_[2,nElem])
RetVal := 2
ENDCASE
return RetVal
/*
* Called from the achoice shell,shows all files in selected directory
*/
function ShowFiles( CurrDir )
local a:=directory(CurrDir+"*.*"), b:={},oldscrn
local nTr :=5,nTc :=30,nBr :=19,nBc :=50, oldcolor:=setcolor(MsgColor)
aeval(a, { |x| aadd(b,x[1]) } )
b:=asort(b)
if len(b) <> 0
oldscrn:=savescreen(nTr,nTc,nBr+1,nBc+2)
BoxShad(nTr,nTc,nBr,nBc,,5)
achoice(nTr+1,nTc+1,nBr-1,nBc-1,b)
restscreen(nTr,nTc,nBr+1,nBc+2,oldscrn)
else
alert("Zero files")
endif
setcolor(oldcolor)
return nil
Function WideBox(nTr,nTc,nBr,nBc,cMsg)
BoxShad(nTr,nTc,nBr,nBc,,7)
CENTER(nTr,' '+cMsg+' ')
Return (NIL)
Function Msg(Title,cText,cColor)
local aText := aDelimit(cText)
local i := MIDRow() - (Len(aText)/2)
local oldColor := setcolor( IF( cColor <> NIL, cColor, setcolor() ) )
CenterBox(aMaxLen(aText)+2,Len(aText)+2,Title)
AEVAL(aText, { | s | CENTER(i++,s) } )
setcolor(oldColor)
Return (NIL)
Function ColorOn
Return ( ISCOLOR() )
Function CenterBox(w,h,cStr)
WideBox(MIDRow()-(h/2),MIDCol()-(w/2),MIDRow()+(h/2),MIDCol()+(w/2),cStr)
Return (NIL)
/*
* Split a semicolon or otherwise delimited string into an Array
*/
STATIC function aDelimit(cStr,cDelim)
local x,a_:= {}
cDelim := IF(cDelim=NIL,[;],cDelim)
WHILE (x := AT(cDelim,cStr)) <> 0
AADD(a_, SUBS(cStr,1,x-1))
cStr := SUBS(cStr,x+len(cDelim))
ENDDO
AADD(a_,SUBS(cStr,x+len(cDelim)))
return (a_)
/*
* Return Length of largest string in array
*/
STATIC function aMaxLen(a_)
local MaxLen := 0
AEVAL(a_, { | s | MaxLen := Max(Len(s),MaxLen) } )
return (MaxLen)
/*
* gotta use a real function and not xtranslate else unresolved
* extern in code-block. (any other methods?)
*/
function Center(nRow, cMsg, cColor )
cColor := IF(valtype(cColor)=="U",MsgColor,cColor)
DevPos( nRow, int((maxcol() + 1 - len( cMsg )) / 2))
DevOut( cMsg, cColor )
return nil