home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / magazine / nan_news / vol3 / no6 / lowbrow.prg < prev    next >
Encoding:
Text File  |  1989-05-01  |  5.6 KB  |  281 lines
  1. * Program: LowBrow.prg
  2. * Author:  E.O. Bell
  3. * Version: Clipper Summer '87
  4. * Copyright (c) 1989 Nantucket Corp. All Rights Reserved.
  5. *
  6. * Note(s): A quick and very dirty .OBJ file browser.
  7. *          How 'bout some borders and pick lists and
  8. *          all that other fancy stuff.
  9. *
  10. *          Procs & Fncts: DEC2HEX()
  11. *                         RECTYPE()
  12. *                         PARSE()
  13. *                         RECLEN()
  14. *                         GETMODNAM()
  15. *                         ISALPNUM()
  16. *                         GETCHKSUM()
  17. *                         RECNAME()
  18.  
  19. PARAMETER o_file
  20. CLEAR
  21. PUBLIC Handle
  22.  
  23. Recval  = SPACE(0)
  24. Rectype = SPACE(0)
  25. BUFFER  = SPACE(0)
  26. Lenfil  = 0
  27. Modlen  = 0
  28. Curpos  = 0
  29. Newpos  = 0
  30. I       = 0
  31.  
  32.  
  33. Handle = FOPEN(o_file)                 && Open file.
  34. IF FERROR() <> 0
  35.    ? "Cannot open file, DOS error ", FERROR()
  36. ELSE
  37.    ? "object file opened.."
  38. ENDIF
  39.  
  40. Lenfil = FSEEK(Handle, 0, 2)           && Derive file length.
  41. ? "File length: ", Lenfil
  42. Curpos = FSEEK(Handle, 0)              && Reset file
  43.                                        && position to bof.
  44. DO WHILE FSEEK(Handle, 0, 1) < Lenfil  && While not end of file
  45.    Recval = SPACE(1)
  46.    IF FREAD(Handle, @Recval, 1) <> 1   && get first byte.
  47.       ? "CLIBBER->Error reading file..."
  48.    ELSE
  49.       Rectype = Parse(Recval)          && Derive record type.
  50.       Modlen = Reclen(Handle)          && Get record length.
  51.       @ 4,0  SAY "File offset:"
  52.       @ 4,17 SAY Curpos
  53.       @ 6,0  SAY "Record Value:"
  54.       @ 6,17 SAY RecType(Recval)
  55.       @ 7,0  SAY "Record Type:"
  56.       @ 7,17 SAY RecName(RecType(Recval))
  57.       @ 8,0  SAY "Record Length:"
  58.       @ 8,17 SAY ModLen
  59.    ENDIF
  60.  
  61.    Curpos = FSEEK(Handle, 0, 1)   && Get current file position.
  62.    Buffer = SPACE(Modlen)
  63.    FREAD(Handle, @Buffer, Modlen)
  64.    RecBuff = ""
  65.    Orphan = ""
  66.    Widow = ""
  67.    Para = ModLen % 16
  68.    NumLines = (ModLen - Para)/16
  69.    FOR i = 0 TO (NumLines -1)
  70.       Line = SUBSTR(Buffer, (i * 16) + 1, 16)
  71.       FOR j = 1 TO 16
  72.          RecBuff = RecBuff + DEC2HEX(BIN2I(SUBSTR(Line,j,1))) +" "
  73.       NEXT
  74.       RecBuff = RecBuff + "    " + Line + CHR(13) + CHR(10)
  75.    NEXT
  76.  
  77.    FOR k = Para TO 1 STEP -1
  78.       Widow = Widow + SUBSTR(Buffer, -k, 1)
  79.       Orphan = Orphan + DEC2HEX(BIN2I(SUBSTR(Buffer,-k,1))) + " "
  80.    NEXT
  81.  
  82.    DO WHILE LEN(Orphan) < 48
  83.       Orphan = Orphan + " "
  84.    ENDDO
  85.    Orphan = Orphan + "    " + Widow
  86.    RecBuff = RecBuff + Orphan + CHR(13) + CHR(10)
  87.  
  88.    MEMOEDIT(RecBuff, 10, 0, 20, 79, .F.)
  89.  
  90.    Newpos = FSEEK(Handle, 0, 1)     && Get current file position.
  91.    IF !(Newpos >= (Curpos + Modlen))   && Check for new position.
  92.       ? "CLIBBER->Error file pointer..."
  93.       BREAK
  94.    ENDIF
  95. ENDDO                                  && elihw
  96.  
  97. IF FCLOSE(Handle)                      && Close file.
  98.    ? "file closed..."
  99. ELSE
  100.    ? "file not closed..."
  101. ENDIF
  102.  
  103. RETURN                                 && End of program.
  104.  
  105.  
  106. * Function: DEC2HEX()
  107. *
  108. FUNCTION Dec2hex
  109. PARAMETERS Value
  110. PRIVATE Temp, One, Pos, HEX
  111.  
  112. Temp = INT(Value / 16)
  113. IF Temp > 9
  114.    HEX = CHR(Temp + 55)
  115. ELSE
  116.    HEX = CHR(Temp + 48)
  117. ENDIF
  118.  
  119. Temp = MOD(Value, 16)
  120. IF Temp > 9
  121.    One = CHR(Temp + 55)
  122. ELSE
  123.    One = CHR(Temp + 48)
  124. ENDIF
  125.  
  126. RETURN(HEX + One)
  127.  
  128.  
  129. * Function: RECTYPE()
  130. *
  131. FUNCTION Rectype
  132. PARAMETERS Recval
  133. PRIVATE Byteval
  134.  
  135. Byteval = BIN2I(Recval)
  136.  
  137. RETURN(RTRIM(Dec2hex(Byteval) + "H"))
  138.  
  139.  
  140.  
  141. * Function: PARSE()
  142. *
  143. FUNCTION Parse
  144. PARAMETERS Recval
  145. PRIVATE Value
  146.  
  147. * Derive record type.
  148. Value = Rectype(Recval)
  149.  
  150. RETURN(Recname(Value))
  151.  
  152.  
  153.  
  154. * Function: RECLEN()
  155. *
  156. FUNCTION Reclen
  157. PARAMETERS Handle
  158. PRIVATE Recval, Temp, I
  159.  
  160. Recval = SPACE(1)
  161. Temp = ""
  162. FOR I = 1 TO 2
  163.    IF FREAD(Handle, @Recval, 1) <> 1
  164.       ? "RECLEN->Error reading file..."
  165.    ELSE
  166.       Temp = Temp + Recval
  167.    ENDIF
  168. NEXT
  169.  
  170. RETURN(BIN2I(Temp))
  171.  
  172.  
  173.  
  174. * Function: GETMODNAM()
  175. *
  176. FUNCTION Getmodnam
  177. PARAMETERS Modlen
  178. PRIVATE Modbuf, Temp, I
  179.  
  180. Modbuf = SPACE(Modlen)
  181. Temp = ""
  182.  
  183. IF FREAD(Handle, @Modbuf, Modlen) <> Modlen
  184.    ? "GetModNam->Error reading file..."
  185. ELSE
  186.    FOR I = 1 TO Modlen
  187.       IF Isalpnum(SUBSTR(Modbuf,I,1))
  188.          Temp = Temp + SUBSTR(Modbuf,I,1)
  189.       ENDIF
  190.    NEXT
  191.    RETURN(Temp)
  192. ENDIF
  193.  
  194. RETURN("")
  195.  
  196.  
  197.  
  198. * Function: ISALPNUM()
  199. *
  200. FUNCTION Isalpnum
  201. PARAMETER Oct
  202.  
  203. IF ((ASC(Oct) > 32) .AND. (ASC(Oct) < 58)) .OR. ;
  204.       ((ASC(Oct) > 63) .AND. (ASC(Oct) < 127))
  205.    RETURN(.T.)
  206. ENDIF
  207.  
  208. RETURN(.F.)
  209.  
  210.  
  211.  
  212. * Function: GETCHKSUM()
  213. *
  214. FUNCTION Getchksum
  215. PARAMETERS Handle
  216. PRIVATE Chksum, Temp
  217.  
  218. Chksum = SPACE(1)
  219. IF FREAD(Handle, @Chksum, 1) <> 1
  220.    ? "GetChkSum->Error reading file..."
  221.    RETURN(1)
  222. ENDIF
  223.  
  224. RETURN(BIN2I(Chksum))
  225.  
  226.  
  227.  
  228. * Function: RECNAME()
  229. *
  230. FUNCTION Recname
  231. PARAMETERS Value
  232. PRIVATE Rlabel
  233.  
  234. Rlabel = ""
  235. DO CASE
  236.    CASE Value = "7AH"
  237.       Rlabel = "BLKDEF"
  238.    CASE Value = "7CH"
  239.       Rlabel = "BLKEND"
  240.    CASE Value = "80H"
  241.       Rlabel = "THEADR"
  242.    CASE Value = "88H"
  243.       Rlabel = "COMENT"
  244.    CASE Value = "8AH"
  245.       Rlabel = "MODEND"
  246.    CASE Value = "8CH"
  247.       Rlabel = "EXTDEF"
  248.    CASE Value = "8EH"
  249.       Rlabel = "TYPDEF"
  250.    CASE Value = "90H"
  251.       Rlabel = "PUBDEF"
  252.    CASE Value = "94H"
  253.       Rlabel = "LINNUM"
  254.    CASE Value = "96H"
  255.       Rlabel = "LNAMES"
  256.    CASE Value = "98H"
  257.       Rlabel = "SEGDEF"
  258.    CASE Value = "9AH"
  259.       Rlabel = "GRPDEF"
  260.    CASE Value = "9CH"
  261.       Rlabel = "FIXUPP"
  262.    CASE Value = "A0H"
  263.       Rlabel = "LEDATA"
  264.    CASE Value = "A2H"
  265.       Rlabel = "LIDATA"
  266.    CASE Value = "B0H"
  267.       Rlabel = "COMDEF"
  268.    OTHERWISE
  269.       Rlabel = "UNKNOWN"
  270. ENDCASE
  271.  
  272. RETURN(Rlabel)
  273.  
  274.  
  275. * Function: NOP()
  276. *
  277. FUNCTION NOP
  278. RETURN("")
  279.  
  280. * EOF: LOWBROW.PRG
  281.