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

 
Output of file : LOWBROW.PRG contained in archive : NN0306.ZIP
* Program: LowBrow.prg
* Author: E.O. Bell
* Version: Clipper Summer '87
* Copyright (c) 1989 Nantucket Corp. All Rights Reserved.
*
* Note(s): A quick and very dirty .OBJ file browser.
* How 'bout some borders and pick lists and
* all that other fancy stuff.
*
* Procs & Fncts: DEC2HEX()
* RECTYPE()
* PARSE()
* RECLEN()
* GETMODNAM()
* ISALPNUM()
* GETCHKSUM()
* RECNAME()

PARAMETER o_file
CLEAR
PUBLIC Handle

Recval = SPACE(0)
Rectype = SPACE(0)
BUFFER = SPACE(0)
Lenfil = 0
Modlen = 0
Curpos = 0
Newpos = 0
I = 0


Handle = FOPEN(o_file) && Open file.
IF FERROR() <> 0
? "Cannot open file, DOS error ", FERROR()
ELSE
? "object file opened.."
ENDIF

Lenfil = FSEEK(Handle, 0, 2) && Derive file length.
? "File length: ", Lenfil
Curpos = FSEEK(Handle, 0) && Reset file
&& position to bof.
DO WHILE FSEEK(Handle, 0, 1) < Lenfil && While not end of file
Recval = SPACE(1)
IF FREAD(Handle, @Recval, 1) <> 1 && get first byte.
? "CLIBBER->Error reading file..."
ELSE
Rectype = Parse(Recval) && Derive record type.
Modlen = Reclen(Handle) && Get record length.
@ 4,0 SAY "File offset:"
@ 4,17 SAY Curpos
@ 6,0 SAY "Record Value:"
@ 6,17 SAY RecType(Recval)
@ 7,0 SAY "Record Type:"
@ 7,17 SAY RecName(RecType(Recval))
@ 8,0 SAY "Record Length:"
@ 8,17 SAY ModLen
ENDIF

Curpos = FSEEK(Handle, 0, 1) && Get current file position.
Buffer = SPACE(Modlen)
FREAD(Handle, @Buffer, Modlen)
RecBuff = ""
Orphan = ""
Widow = ""
Para = ModLen % 16
NumLines = (ModLen - Para)/16
FOR i = 0 TO (NumLines -1)
Line = SUBSTR(Buffer, (i * 16) + 1, 16)
FOR j = 1 TO 16
RecBuff = RecBuff + DEC2HEX(BIN2I(SUBSTR(Line,j,1))) +" "
NEXT
RecBuff = RecBuff + " " + Line + CHR(13) + CHR(10)
NEXT

FOR k = Para TO 1 STEP -1
Widow = Widow + SUBSTR(Buffer, -k, 1)
Orphan = Orphan + DEC2HEX(BIN2I(SUBSTR(Buffer,-k,1))) + " "
NEXT

DO WHILE LEN(Orphan) < 48
Orphan = Orphan + " "
ENDDO
Orphan = Orphan + " " + Widow
RecBuff = RecBuff + Orphan + CHR(13) + CHR(10)

MEMOEDIT(RecBuff, 10, 0, 20, 79, .F.)

Newpos = FSEEK(Handle, 0, 1) && Get current file position.
IF !(Newpos >= (Curpos + Modlen)) && Check for new position.
? "CLIBBER->Error file pointer..."
BREAK
ENDIF
ENDDO && elihw

IF FCLOSE(Handle) && Close file.
? "file closed..."
ELSE
? "file not closed..."
ENDIF

RETURN && End of program.


* Function: DEC2HEX()
*
FUNCTION Dec2hex
PARAMETERS Value
PRIVATE Temp, One, Pos, HEX

Temp = INT(Value / 16)
IF Temp > 9
HEX = CHR(Temp + 55)
ELSE
HEX = CHR(Temp + 48)
ENDIF

Temp = MOD(Value, 16)
IF Temp > 9
One = CHR(Temp + 55)
ELSE
One = CHR(Temp + 48)
ENDIF

RETURN(HEX + One)


* Function: RECTYPE()
*
FUNCTION Rectype
PARAMETERS Recval
PRIVATE Byteval

Byteval = BIN2I(Recval)

RETURN(RTRIM(Dec2hex(Byteval) + "H"))



* Function: PARSE()
*
FUNCTION Parse
PARAMETERS Recval
PRIVATE Value

* Derive record type.
Value = Rectype(Recval)

RETURN(Recname(Value))



* Function: RECLEN()
*
FUNCTION Reclen
PARAMETERS Handle
PRIVATE Recval, Temp, I

Recval = SPACE(1)
Temp = ""
FOR I = 1 TO 2
IF FREAD(Handle, @Recval, 1) <> 1
? "RECLEN->Error reading file..."
ELSE
Temp = Temp + Recval
ENDIF
NEXT

RETURN(BIN2I(Temp))



* Function: GETMODNAM()
*
FUNCTION Getmodnam
PARAMETERS Modlen
PRIVATE Modbuf, Temp, I

Modbuf = SPACE(Modlen)
Temp = ""

IF FREAD(Handle, @Modbuf, Modlen) <> Modlen
? "GetModNam->Error reading file..."
ELSE
FOR I = 1 TO Modlen
IF Isalpnum(SUBSTR(Modbuf,I,1))
Temp = Temp + SUBSTR(Modbuf,I,1)
ENDIF
NEXT
RETURN(Temp)
ENDIF

RETURN("")



* Function: ISALPNUM()
*
FUNCTION Isalpnum
PARAMETER Oct

IF ((ASC(Oct) > 32) .AND. (ASC(Oct) < 58)) .OR. ;
((ASC(Oct) > 63) .AND. (ASC(Oct) < 127))
RETURN(.T.)
ENDIF

RETURN(.F.)



* Function: GETCHKSUM()
*
FUNCTION Getchksum
PARAMETERS Handle
PRIVATE Chksum, Temp

Chksum = SPACE(1)
IF FREAD(Handle, @Chksum, 1) <> 1
? "GetChkSum->Error reading file..."
RETURN(1)
ENDIF

RETURN(BIN2I(Chksum))



* Function: RECNAME()
*
FUNCTION Recname
PARAMETERS Value
PRIVATE Rlabel

Rlabel = ""
DO CASE
CASE Value = "7AH"
Rlabel = "BLKDEF"
CASE Value = "7CH"
Rlabel = "BLKEND"
CASE Value = "80H"
Rlabel = "THEADR"
CASE Value = "88H"
Rlabel = "COMENT"
CASE Value = "8AH"
Rlabel = "MODEND"
CASE Value = "8CH"
Rlabel = "EXTDEF"
CASE Value = "8EH"
Rlabel = "TYPDEF"
CASE Value = "90H"
Rlabel = "PUBDEF"
CASE Value = "94H"
Rlabel = "LINNUM"
CASE Value = "96H"
Rlabel = "LNAMES"
CASE Value = "98H"
Rlabel = "SEGDEF"
CASE Value = "9AH"
Rlabel = "GRPDEF"
CASE Value = "9CH"
Rlabel = "FIXUPP"
CASE Value = "A0H"
Rlabel = "LEDATA"
CASE Value = "A2H"
Rlabel = "LIDATA"
CASE Value = "B0H"
Rlabel = "COMDEF"
OTHERWISE
Rlabel = "UNKNOWN"
ENDCASE

RETURN(Rlabel)


* Function: NOP()
*
FUNCTION NOP
RETURN("")

* EOF: LOWBROW.PRG


  3 Responses to “Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : NN0306.ZIP
Filename : LOWBROW.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/