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

********************
* Name DISPSTRU.prg
* Date August 18, 1986
* Notice Copywright 1986, Stephen J. Straley
* Note A Procedure which simulates dBASEIII's
* Display Structure command in Clipper.
*
********************

PARAMETERS Infile

IF EMPTY(infile)
infile = SPACE(30)
@ ROW(),0 SAY "No data base in USE. Enter filename: " GET infile
READ
IF EMPTY(infile)
QUIT
ENDIF
ENDIF
*****
* Check to see if the clause 'TO PRINT' is added to the simulation
*****
search = AT("TO PRINT",UPPER(infile)) && <= Check for the words...
IF search <> 0 && <= There is no clause
toggle = .T.
infile = SUBSTR(infile,1,search-1) && <= There is the clause
ELSE
toggle = .F.
ENDIF
search = AT(".",infile) && check for file extention
IF search = 0
infile = TRIM(infile) + ".DBF"
ENDIF
IF !FILE(infile)
? "File Not Found"
QUIT
ENDIF
RUN DIR &infile > Tempfile.txt
CREATE Temp
USE Temp
APPEND BLANK
REPLACE field_name WITH "LINE", field_type WITH "C", field_len WITH 80
USE
CREATE Template FROM Temp
USE Template
ERASE Temp
APPEND FROM Tempfile.txt SDF
ERASE Tempfile.txt
GO 3
search = AT("of ",line)
direct = SUBSTR(line,search+3)
GO 5
search = AT("-",line)
datein = SUBSTR(line,search - 2,8)
USE &infile
ERASE Template
COPY STRUCTURE EXTENDED TO Template
USE Template
record = STR(LASTREC())
count = 1
IF toggle
SET PRINTER ON && Turn printer on due to PRINT cluase
ENDIF
? "Structure for database: " + TRIM(direct) + "\" + infile
? "Number of data records: " + record
? "Date of Last update : " + datein
? "Field Field Name Type Width Dec"
GO TOP
DO WHILE .NOT. EOF()
? RECNO()
?? SPACE(3)
?? field_name
?? SPACE(5)
?? TYPENAME()
?? SPACE(5)
?? field_len
?? SPACE(5)
IF field_dec > 0
?? field_dec
ENDIF
SKIP
count = count + 1
IF count > 16 && Allowing only 16 fields to be displayed
count = 1 && before the WAIT message appears
WAIT
ENDIF
ENDDO
USE
ERASE Template.dbf
ERASE Temp.dbf
IF toggle && Turn the printer off
SET PRINT OFF
ENDIF


***********************
** Function Typename **
***********************

FUNCTION Typename

DO CASE
CASE field_type = "N"
RETURN("Numeric ")
CASE field_type = "D"
RETURN("Date ")
CASE field_type = "M"
RETURN("Memo ")
CASE field_type = "C"
RETURN("Character")
CASE field_type = "L"
RETURN("Logical ")
ENDCASE
RETURN("Undefined")

*** EOF DISPSTRU.PRG