home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Media Share 9
/
MEDIASHARE_09.ISO
/
progmisc
/
dblib201.zip
/
LISTFILE.PRG
< prev
next >
Wrap
Text File
|
1993-03-11
|
14KB
|
340 lines
*-------------------------------------------------------------------------------
*-- Program.....: LISTFILE.PRG
*-- Programmer..: Kenneth J. Mayer (CIS: 71333,1030)
*-- Date........: 03/11/1993
*-- Notes.......: This program/set of routines is designed to display an ASCII
*-- file of up to 1,170 lines, and 254 characters per line
*-- on the screen. ** WARNING ** in dBASE IV, 1.5 -- if you get
*-- close to the 1,170 line limit, you will run out of memory.
*-- (If using version 2.0 or greater, you may be able to read
*-- in 10,000 lines ... the array capabilities allow up to
*-- 64K lines (65,535 elements), but I figured that 10000 was
*-- pretty huge ...)
*-- I have not yet figured out how to cope with that.
*-- It allows scrolling (up,down,left,right), and a few hot-keys
*-- as well:
*-- <Home> = the beginning/first character of the line
*-- <End> = the right side of a line
*-- <Ctrl><Home> = the top of the file
*-- <Ctrl><End> = the bottom of the file
*-- <PgUp>/<PgDn> = page up/down one screen at a time
*-- <Esc>/<Enter> = exit
*-- Rev. History: 01/25/1993 -- Original Release
*-- 02/24/1993 -- Minor modifications -- if user sends # of
*-- lines that would give a window larger than
*-- the screen can handle (nMaxLines + nRow >
*-- length of screen), we set the max number of
*-- lines to the length of the screen. Also
*-- Added <Enter> to exit routine.
*-- 03/11/1993 -- Minor change for version 2.0 -- allows up
*-- to 10,000 lines ... no guarantees on
*-- whether or not you will run out of memory.
*-- Usage.......: DO ListFile WITH <cFileName>,<nRow>[,<nMaxLines>[,<nTab>[,;
*-- <cColor>]]]
*-- Example.....: do listfile with "ListFile.PRG",5,18,3,"rg+/g"
*-- Parameters..: cFileName = name of file to list -- include extension and
*-- path if necessary
*-- nRow = starting row on screen (top of "window")
*-- nMaxLines = optional -- number of lines to display at one
*-- time -- if left off, routine will use as manu
*-- lines as possible from nRow to bottom of screen.
*-- nTab = optional -- number of spaces to use for tab
*-- characters at the beginning of a line. Ignores
*-- tabs after the first non-tab character in a line
*-- for speed's sake.
*-- cColor = optional -- provide color description for window,
*-- format: Foreground/Background. For example, to
*-- display the file in a window that has yellow text
*-- on a green background, the parameter would be:
*-- "rg+/g"
*-------------------------------------------------------------------------------
parameters cFileName,nRow,nMaxLines,nTab,cColor
private cWindow,cCursor,nDisplay,nBottom,nLastLine,x,nCount,nKey,;
nFirstLine,nCurrPos
save screen to sListFile && save screen description
cWindow = window() && store name of any "current" window on screen
cCursor = set("CURSOR") && save current cursor state
set cursor off && turn it off ...
activate screen && activate screen so we can display on TOP
&& of anything there.
if pCount() > 4 && if user gave us a set of colors to use
cColor = "COLOR "+cColor && define memvar with the word "COLOR" in it
else
cColor = "" && otherwise, set to 'nul'
endif
*-- if user gave a value for nMaxLines, and it's too big, we have
*-- set nMaxLines to bottom of screen.
if pCount() => 3 && we have a parameter passed for this
if set("DISPLAY") # "MONO" .and. set("DISPLAY") # "COLOR"
nDisplay = val(right(set("DISPLAY"),2))
if (nMaxLines + nRow) => nDisplay
nMaxLines = (nDisplay - 1) - nRow && if nDisplay gives 25,
&& set to 24, as the screen
&& goes from 0 to 24 ...
endif
else
if (nMaxLines + nRow) > 24
nMaxLines = 24 - nRow
endif
endif
endif
*-- if user didn't tell us how many lines to display ...
if pCount() = 2 && determine # of lines to display on screen ...
*-- find bottom of screen, and then subtract nRow from that ...
if set("DISPLAY") # "MONO" .and. set("DISPLAY") # "COLOR"
&& if we have such displays as EGA25, or VGA50 ...
nDisplay = val(right(set("DISPLAY"),2)) && get the value of the right
else && two characters
nDisplay = 25 && if MONO/COLOR, we have 25 lines possible
endif
if set("STATUS") = "ON" && if status line is on, we have two four
&& lines to work with
nDisplay = nDisplay - 4
endif
nMaxLines = (nDisplay - 1) - nRow && nDisplay - 1 is so we don't
&& go beyond last line (EGA25 gives
&& 25, but last line is number 24!)
endif
*-- bottom row of window is based on nMaxLines
nBottom = nRow + nMaxLines
*-- set default tab if needed ...
if pCount() < 4 && set default ... notice that if it's 0, that's
&& not 'undefined'
nTab = 5
endif
*-- get the number of lines in the text file
nLastLine = TextLine(cFileName) && obtain line number of last line of file
nVersion = val(right(version(),3)) && get version #
if nVersion < 2.0 && if less than version 2.0
if nLastLine > 1170 && max lines we can read into array
nLastLine = 1170 && is 1,170
endif
else && we have version 2.0 or greater
if nLastLine > 10000 && we can display 10,000 lines
nLastLine = 10000
endif
endif
*-- display a message for user to let them know we haven't just
*-- disappeared ...
@11,28 fill to 14,54 color n+/n
@10,26 to 13,52 double color rg+/gb
@11,27 say " Reading/Processing File " color rg+/gb
cLines = space(7)+transform(nLastLine,"99999")+" Lines"+space(7)
@12,27 say cLines color rg+/gb
*-- get it
x = AAppend(cFileName,"aFileList") && put file into array
*-- deal with tabs here
if nTab # 0
nCount = 1
do while nCount < nLastLine
do while chr(9) $ aFileList[nCount] && loop while there is a tab
&& in the line
aFileList[nCount] = ;
stuff(aFileList[nCount],at(chr(9),aFileList[nCount]),1,;
space(nTab))
enddo
nCount = nCount + 1
enddo
endif
*-- loop and pad each array element with spaces to 254 characters
nCount = 1
do while nCount < nLastLine
aFileList[nCount] = aFileList[nCount]+space(254-len(aFileList[nCount]))
nCount = nCount + 1
enddo
*-- remove message
restore screen from sListFile
*-- define window
define window wListFile from nRow,0 to nBottom,79 none &cColor.
activate window wListFile
*-- now that we're here, let's go ...
nKey = 0 && initialize to something we're not looking for
nFirstLine = 1 && First line to display out of list ...
nCurrPos = 1 && current position in string
*-----------------------------
*-- here's the actual loop ...
*-----------------------------
do while nKey # 27 .and. nKey # 13 && must press <Esc> to exit
*-- display loop
nCounter = 0
do while nCounter < nMaxLines
@nCounter,0 say substr(aFileList[nFirstLine+nCounter],nCurrPos,80)
nCounter = nCounter + 1
enddo
*-- get keypress
nKey = inkey(0) && wait for a keypress
*-- if keypress is one of the following, do something with it ...
do case
case nKey = 5 && up arrow = up one row
if nFirstLine > 1
nFirstLine = nFirstLine - 1
endif
case nKey = 24 && down arrow = down one row
if nFirstLine+nMaxLines < nLastLine
nFirstLine = nFirstLine + 1
endif
case nKey = 3 && <PgDn> = down one screen
if nFirstLine+nMaxLines < (nLastLine - nMaxLines)
nFirstLine = nFirstLine + nMaxLines
else
nFirstLine = nLastLine - nMaxLines
endif
case nKey = 18 && <PgDn> = up one screen
if nFirstLine - nMaxLines > 1
nFirstLine = nFirstLine - nMaxLines
else
nFirstLine = 1
endif
case nKey = 23 && <Ctrl><End> = End of File
nFirstLine = nLastLine - nMaxLines
case nKey = 29 && <Ctrl><Home> = Beginning of File
nFirstLine = 1
case nKey = 19 && <Left> = Back up one character
if nCurrPos > 1
nCurrPos = nCurrPos - 1
endif
case nKey = 4 && <Right> = Go RIGHT one character
if nCurrPos < 174 && 254-80 (width of string - screen width
nCurrPos = nCurrPos + 1
endif
case nKey = 2 && <End> = end of line
nCurrPos = 174 && show last character(s) on right side of text
case nKey = 26 && <Home> = beginning of line
nCurrPos = 1
endcase
enddo
*-- if here, we <Esc>aped out of the loop
deactivate window wListFile
release window wListFile
restore screen from sListFile
release screen sListFile
if .not. isblank(cWindow)
activate window &cWindow.
endif
release aFileList
set cursor &cCursor.
RETURN
*-- EoP: ListFile
FUNCTION AAppend
*-------------------------------------------------------------------------------
*-- Programmer..: Adam L. Menkes (Borland Technical Support)
*-- Date........: 03/11/1993
*-- Notes.......: Appends a text file into an array. This routine is limited to
*-- text files of 1,170 lines, and 254 characters per line.
*-- (Modified by KJM for this routine only to handle up to 10000
*-- lines for version 2.0 of dBASE IV)
*-- The text file must be an ASCII Txt formatted file. Taken from
*-- Technotes, April, 1992.
*-- Written for.: dBASE IV, 1.5
*-- Rev. History: 04/01/1992 -- Original Release
*-- 02/24/1993 -- Modified to deal with nLines possibly larger
*-- than 1170 -- if so, we blow up ... this has
*-- been fixed.
*-- 03/11/1993 -- Version 2.0 of dBASE IV allows up to 64K for
*-- an array, but I cut it off at 10,000 ...
*-- Calls.......: TextLine() Function in LOWLEVEL.PRG
*-- Called by...: Any
*-- Usage.......: AAppend(<cFileName>,<aArrayName>)
*-- Example.....: ?AAppend("CONFIG.DB","aConfig")
*-- Returns.....: .T.
*-- Parameters..: cFileName = Name of DOS Text file to read into array
*-- aArrayName = Name of array to create. If it already exists,
*-- this array will be destroyed and overwritten.
*-------------------------------------------------------------------------------
parameters cFileName, aArrayName
private aTArray, nLines, nX, nHandle
*-- assign array name to a temp variable name ...
aTArray = aArrayName
*-- if it exists, get rid of it, and then re-define it
release &aTArray
public &aTArray
nLines = TextLine(cFileName) && get number of lines
if val(right(version(0),3)) < 2 && version 2.0 or less
if nLines > 1170
nLines = 1170
endif
else
if nLines > 10000
nLines = 10000
endif
endif
declare &aTArray[min(nLines,10000)]
*-- get file handle
nHandle = fopen(cFileName)
*-- store the file into the array
nX = 1
do while nX <= nLines
store fgets(nHandle,254) to &aTArray[nX]
nX = nX + 1
enddo
*-- close the file
nHandle = fClose(nHandle)
RETURN .T.
*-- EoF: AAppend()
FUNCTION TextLine
*-------------------------------------------------------------------------------
*-- Programmer..: Adam L. Menkes (Borland Technical Support)
*-- Date........: 04/01/1992
*-- Notes.......: Returns the number of lines of text in an ASCII Text File
*-- Taken from TechNotes, April, 1992
*-- Written for.: dBASE IV, 1.5
*-- Rev. History: 04/01/1992 -- Original Release
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: TextLine(<cTextFile>)
*-- Example.....: ?TextLine("CONFIG.DB")
*-- Returns.....: Number of lines
*-- Parameters..: cTextFile = name of file
*-------------------------------------------------------------------------------
parameter cTextFile
private nLines, nHandle, cTemp, nClose
nLines = 0
if file(cTextFile) && if it exists ...
nHandle = fopen(cTextFile,"R")
do while .not. feof(nHandle)
cTemp = fgets(nHandle,254)
nLines = nLines + 1
enddo
nClose = fclose(nHandle)
endif
RETURN nLines
*-- EoF: TextLine()
*-------------------------------------------------------------------------------
*-- End of Program: LISTFILE.PRG
*-------------------------------------------------------------------------------