home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #1 / monster.zip / monster / DATABASE / LIBMAN.ZIP / LIBMAN.CLA next >
Text File  |  1994-01-25  |  14KB  |  398 lines
  1.  
  2. !▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄
  3. !█                                     █
  4. !█ LIBMAN.CLA                                 █
  5. !█ List and extract oject modules from TopSpeed library file         █
  6. !█                                     █
  7. !█ Revision  : 1                             █
  8. !█                                     █
  9. !█ Copyright : Bobcat Systems (c) 1994                     █
  10. !█ Author    : Robert J. Pupazzoni, Bobcat Systems             █
  11. !█                                     █
  12. !█ Compiler  : Clarion Professional Developer v.2.1, Batch 2105         █
  13. !█                                     █
  14. !█ REVISION HISTORY                             █
  15. !█   1 Created                                 █
  16. !█                                     █
  17. !▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀
  18.  
  19. LIBMAN         PROGRAM
  20.  
  21.          INCLUDE('STD_KEYS.CLA')
  22.          INCLUDE('CTL_KEYS.CLA')
  23.  
  24.          MAP
  25.            PROC(BldModTbl)
  26.            PROC(ShowModTbl)
  27.            PROC(ExtractMod)
  28.            FUNC(Confirm),LONG
  29.            PROC(ChkErr)
  30.          .
  31.  
  32. sgLibFName   STRING(64)                 ! LIB file name
  33. sgObjFName   STRING(64)                 ! OBJ file name
  34.  
  35. oLibFile     DOS,PRE(OLF),NAME(sgLibFName)     ! LIB file
  36. Record           RECORD                 !
  37.          STRING(255)             !
  38.          . .                 !
  39.  
  40. oObjFile     DOS,PRE(OOB),NAME(sgObjFName)     ! OBJ file
  41. Record           RECORD                 !
  42.          STRING(255)             !
  43.          . .                 !
  44.  
  45. gTHEADR         GROUP,PRE(THD),OVER(OLF:Record)     ! THEADR Module record:
  46. ibRecType      BYTE                 !   Record Type
  47. isRecLen       SHORT                 !   Record Length
  48. ibNameLen      BYTE                 !   Module Name length
  49. sName           STRING(12)             !   Module Name
  50.          .                     !
  51.  
  52. tModules     TABLE,PRE(TMO)             ! Modules Table:
  53. ilStart           LONG                 !   Starting file offset
  54. ilSize           LONG                 !   Module size
  55. sName           STRING(255)             !   Module name
  56.          .                     !
  57.  
  58. wCover         SCREEN      HUE(7,0,0)
  59.            ROW(1,1)      PAINT(1,80),HUE(14,4)
  60.            ROW(25,1)  PAINT(1,80),HUE(0,7)
  61.            ROW(6,2)      PAINT(5,78),HUE(0,3)
  62.            ROW(2,1)      REPEAT(4);STRING('▒{80}') .
  63.            ROW(6,1)      REPEAT(5);STRING('▒<0{78}>▒') .
  64.            ROW(11,1)  REPEAT(14);STRING('▒{80}') .
  65.            ROW(6,2)      STRING('┌─{76}┐')
  66.            ROW(7,2)      REPEAT(3);STRING('│<0{76}>│') .
  67.            ROW(10,2)  STRING('└─{76}┘')
  68.            ROW(1,23)  STRING('LIBMAN - TopSpeed Library Manager 0.1')
  69.            ROW(25,3)  STRING('Written by Robert Pupazzoni, Bobcat Systems' |
  70.                 & ' {15}CIS ID:[70441,204]')
  71.            ROW(8,5)      STRING('Enter library (.LIB) file name:')
  72.          COL(37)  ENTRY(@S40),USE(sgLibFName),SEL(14,4),REQ
  73.          .
  74.  
  75.   CODE
  76.   OPEN(wCover)                     !
  77.   LOOP                         !
  78.     ALERT                     !
  79.     ALERT(Esc_Key)                 !
  80.     ACCEPT                     !
  81.     IF KEYCODE() = Esc_Key THEN BREAK.         !
  82.     OPEN(oLibFile)                 !
  83.     IF ERRORCODE() THEN BEEP; CYCLE.         !
  84.     BldModTbl()                     !
  85.     ShowModTbl()                 !
  86.     CLOSE(oLibFile)                 !
  87.   .                         !
  88.   RETURN                     !
  89.  
  90.  
  91. !═════════════════════════════════════════════════════════════════════════
  92. !              Build module table
  93. !═════════════════════════════════════════════════════════════════════════
  94. BldModTbl    PROCEDURE
  95.  
  96.          ! Screens:
  97. wScreen         SCREEN      WINDOW(7,43),PRE(SCR),HUE(0,3)
  98.            ROW(1,1)      STRING('┌─{41}┐')
  99.            ROW(2,1)      REPEAT(5);STRING('│<0{41}>│') .
  100.            ROW(7,1)      STRING('└─{41}┘')
  101.            ROW(3,4)      STRING('Scanning library file... please wait.')
  102.            ROW(5,17)  STRING('(')
  103.          COL(21)  STRING('% done)')
  104. ssPctDone     COL(18)  STRING(@N3),HUE(15,3)
  105.          .
  106.  
  107.          ! Locals:
  108. ilFileSize   LONG                 ! File size
  109. ilOffset     LONG                 ! File offset
  110.  
  111.   CODE
  112.   OPEN(wScreen)                     ! Open screen
  113.   ilOffset   = 1                 ! Set starting offset
  114.   ilFileSize = BYTES(oLibFile)             ! Get file size
  115.   LOOP WHILE ilOffset <= ilFileSize         ! Loop while not eof
  116.     GET(oLibFile, ilOffset, 255)         !   Get record
  117.     IF THD:ibRecType = 80H             !   If it's a module header
  118.       DO UpdModSize                 !     Update previous mod size
  119.       DO AddNewMod                 !     Add module to table
  120.     .                         !   Endif
  121.     ilOffset += (3 + THD:isRecLen)         !   Move file pointer
  122.     SCR:ssPctDone = 100 * (ilOffset / ilFileSize)!   Update % done
  123.   .                         ! End loop
  124.   DO UpdModSize                     ! Update final mod size
  125.   SORT(tModules, TMO:sName)             ! Sort by module name
  126.   CLOSE(wScreen)                 ! Close screen
  127.   RETURN                     !
  128.  
  129. !─────────────────────────────────────────────────────────────────────────
  130. AddNewMod    ROUTINE      ! Add new object module to table
  131. !─────────────────────────────────────────────────────────────────────────
  132.   CLEAR(tModules)                 ! Clear table record
  133.   TMO:ilStart = ilOffset             ! Set mod starting offset
  134.   TMO:ilSize  = 0                 ! We don't know this yet...
  135.   TMO:sName   = SUB(THD:sName, 1, THD:ibNameLen) ! Set mod name
  136.   ADD(tModules)                     ! Add to table
  137.  
  138. !─────────────────────────────────────────────────────────────────────────
  139. UpdModSize   ROUTINE      ! Update module size
  140. !─────────────────────────────────────────────────────────────────────────
  141.   GET(tModules, RECORDS(tModules))         ! Get previous mod record
  142.   IF NOT ERRORCODE()                 ! If found
  143.     TMO:ilSize = (ilOffset - TMO:ilStart) - 1     !   Now we know the size
  144.     PUT(tModules)                 !   Update it
  145.   .                         ! Endif
  146.  
  147.  
  148. !═════════════════════════════════════════════════════════════════════════
  149. !              Show module table
  150. !═════════════════════════════════════════════════════════════════════════
  151. ShowModTbl   PROCEDURE
  152.  
  153.          ! Screens:
  154. wScreen         SCREEN      WINDOW(24,80),AT(1,1),PRE(SCR),HUE(0,7)
  155.            ROW(4,3)      PAINT(19,74),HUE(11,1)
  156.            ROW(3,77)  PAINT(1,1),HUE(0,3)
  157.            ROW(1,1)      STRING('┌─{24}<0{29}>─{25}┐')
  158.            ROW(2,1)      STRING('│<0{78}>│')
  159.            ROW(3,1)      STRING('│<0{75}>▄<0,0>│')
  160.            ROW(4,1)      REPEAT(19);STRING('│<0{75}>█<0,0>│') .
  161.            ROW(23,1)  STRING('│<0,0>▀{74}<0,0>│')
  162.            ROW(24,1)  STRING('└─{78}┘')
  163.            ROW(1,27)  STRING('O B J E C T   M O D U L E S')
  164.            ROW(3,6)      STRING('Module Name {7}Offset    Size')
  165.               REPEAT(17),INDEX(ibRepNdx)
  166.            ROW(5,5)        POINT(1,70),USE(?Point),SEL(14,4),REQ
  167. ssName         COL(6)        STRING(15)
  168. ssStart         COL(23)    STRING(@N_7)
  169. ssSize         COL(32)    STRING(@N_7)
  170.               .
  171. ssULArrow     COL(4)      STRING(1),HUE(14,1)
  172. ssLLArrow      ROW(21,4)  STRING(1),HUE(14,1)
  173. ssLRArrow     COL(75)  STRING(1),HUE(14,1)
  174. ssURArrow      ROW(5,75)  STRING(1),HUE(14,1)
  175.          .
  176.  
  177. wKeyLine     SCREEN      WINDOW(1,80),AT(25,1),HUE(0,7)
  178.            ROW(1,18)  STRING('<<')
  179.          COL(19)  STRING('Enter'),HUE(4,7)
  180.          COL(24)  STRING('> Extract Module {14}<<')
  181.          COL(55)  STRING('Esc'),HUE(4,7)
  182.          COL(58)  STRING('> Exit')
  183.          .
  184.  
  185.          ! Equates:
  186. eScrlRows    EQUATE(17)                 ! Rows in scroll area
  187. eUpArrow     EQUATE('')             ! Up arrow symbol
  188. eDnArrow     EQUATE('')             ! Down arrow symbol
  189.  
  190.          ! Locals:
  191. ilTblNdx     LONG                 ! Table index
  192. ilTopRow     LONG                 ! Top row offset
  193. ibRepNdx     BYTE                 ! Repeat index
  194. ibSavRepNdx  BYTE                 ! Saved repeat index
  195.  
  196.   CODE
  197.   OPEN(wKeyLine)                 ! Open screens
  198.   OPEN(wScreen)                     !
  199.   DO FirstPage                     ! Display first page
  200.   LOOP                         ! Loop
  201.     ALERT                     !
  202.     ALERT(Esc_Key)                 !
  203.     ALERT(Up_Key)                 !
  204.     ALERT(Down_Key)                 !
  205.     ACCEPT                     !   Get keystroke
  206.     CASE KEYCODE()                 !   Process keystroke
  207.       OF Esc_Key;   BREAK             !
  208.       OF Enter_Key; DO GetRecord         !
  209.             ExtractMod()         !
  210.       OF Up_Key;    DO MoveUp             !
  211.       OF Down_Key;  DO MoveDown             !
  212.       OF PgUp_Key;  DO PrevPage             !
  213.       OF PgDn_Key;  DO NextPage             !
  214.       OF Ctrl_PgUp; DO FirstPage         !
  215.       OF Ctrl_PgDn; DO LastPage             !
  216.   . .                         ! End loop
  217.   CLOSE(wScreen)                 ! Close screens
  218.   CLOSE(wKeyLine)                 !
  219.   DO Quit                     ! Clean-up and exit
  220.  
  221. !─────────────────────────────────────────────────────────────────────────
  222. Quit         ROUTINE      ! Clean up and exit
  223. !─────────────────────────────────────────────────────────────────────────
  224.   RETURN                     ! Return to caller
  225.  
  226. !─────────────────────────────────────────────────────────────────────────
  227. FirstPage    ROUTINE      ! Display first page
  228. !─────────────────────────────────────────────────────────────────────────
  229.   ilTopRow = 0                     !
  230.   DO ShowTable                     !
  231.  
  232. !─────────────────────────────────────────────────────────────────────────
  233. LastPage     ROUTINE      ! Display first page
  234. !─────────────────────────────────────────────────────────────────────────
  235.   ilTopRow = RECORDS(tModules) - eScrlRows     !
  236.   IF ilTopRow < 0 THEN ilTopRow = 0.         !
  237.   DO ShowTable                     !
  238.  
  239. !─────────────────────────────────────────────────────────────────────────
  240. NextPage     ROUTINE      ! Display next page
  241. !─────────────────────────────────────────────────────────────────────────
  242.   ilTopRow += eScrlRows                 !
  243.   IF ilTopRow > RECORDS(tModules) - eScrlRows     !
  244.     DO LastPage                     !
  245.   ELSE                         !
  246.     DO ShowTable                 !
  247.   .                         !
  248.  
  249. !─────────────────────────────────────────────────────────────────────────
  250. PrevPage     ROUTINE      ! Display previous page
  251. !─────────────────────────────────────────────────────────────────────────
  252.   IF ilTopRow > 0                 !
  253.     ilTopRow -= eScrlRows             !
  254.     IF ilTopRow < 0 THEN ilTopRow = 0.         !
  255.     DO ShowTable                 !
  256.   .                         !
  257.  
  258. !─────────────────────────────────────────────────────────────────────────
  259. MoveUp         ROUTINE      ! Move up one line
  260. !─────────────────────────────────────────────────────────────────────────
  261.   IF ibRepNdx > 1                 !
  262.     ibRepNdx -= 1                 !
  263.   ELSIF ilTopRow > 0                 !
  264.     ilTopRow -= 1                 !
  265.     DO ShowTable                 !
  266.   .                         !
  267.  
  268. !─────────────────────────────────────────────────────────────────────────
  269. MoveDown     ROUTINE      ! Move up down one line
  270. !─────────────────────────────────────────────────────────────────────────
  271.   IF ibRepNdx < eScrlRows             !
  272.     ibRepNdx += 1                 !
  273.   ELSIF ilTopRow < RECORDS(tModules) - eScrlRows !
  274.     ilTopRow += 1                 !
  275.     DO ShowTable                 !
  276.   .                         !
  277.  
  278. !─────────────────────────────────────────────────────────────────────────
  279. GetRecord    ROUTINE      ! Get currently highlighted record
  280. !─────────────────────────────────────────────────────────────────────────
  281.   GET(tModules, ilTopRow + ibRepNdx)         !   Get record
  282.  
  283. !─────────────────────────────────────────────────────────────────────────
  284. ShowTable    ROUTINE      ! Display current table page
  285. !─────────────────────────────────────────────────────────────────────────
  286.   ibSavRepNdx = ibRepNdx             ! Save repeat index
  287.   LOOP ibRepNdx = 1 TO eScrlRows         ! Loop for each row
  288.     GET(tModules, ilTopRow + ibRepNdx)         !   Get record
  289.     IF ERRORCODE()                 !   If not found
  290.       SCR:ssName = ''                 !     Blank screen line
  291.     ELSE                     !   Else
  292.       SCR:ssName  = TMO:sName             !     Set screen fields
  293.       SCR:ssStart = TMO:ilStart             !
  294.       SCR:ssSize  = TMO:ilSize             !
  295.   . .                         ! End loop
  296.   DO Arrows                     ! Display scroll arrows
  297.   ibRepNdx = ibSavRepNdx             ! Restore repeat index
  298.  
  299. !──────────────────────────────────────────────────────────────────────────
  300. Arrows         ROUTINE      ! Display scroll arrows
  301. !──────────────────────────────────────────────────────────────────────────
  302.   SCR:ssULArrow = ' '                 !
  303.   SCR:ssLLArrow = ' '                 !
  304.   IF ilTopRow > 0                 !
  305.     SCR:ssULArrow = eUpArrow             !
  306.   .                         !
  307.   IF ilTopRow + eScrlRows < RECORDS(tModules)     !
  308.     SCR:ssLLArrow = eDnArrow             !
  309.   .                         !
  310.   SCR:ssURArrow = SCR:ssULArrow             !
  311.   SCR:ssLRArrow = SCR:ssLLArrow             !
  312.  
  313.  
  314. !═════════════════════════════════════════════════════════════════════════
  315. !        Extract selected object module from library
  316. !═════════════════════════════════════════════════════════════════════════
  317. ExtractMod   PROCEDURE
  318.  
  319.          ! Locals:
  320. ilOffset     LONG                 !
  321.  
  322.          ! Screens:
  323. wScreen         SCREEN      WINDOW(6,50),PRE(SCR),HUE(0,7)
  324.            ROW(1,1)      STRING('┌<0{37}>─{11}┐')
  325.            ROW(2,1)      REPEAT(4);STRING('│<0{48}>│') .
  326.            ROW(6,1)      STRING('└─{48}┘')
  327.            ROW(1,4)      STRING('Extracting Module:')
  328. ssName         COL(23)  STRING(15),HUE(0,7)
  329.            ROW(4,4)      STRING('Write .OBJ to what file?')
  330.          COL(29)  ENTRY(@S20),USE(sgObjFName),HUE(0,3),SEL(14,4),REQ
  331.          .
  332.  
  333.   CODE
  334.   OPEN(wScreen)                     !
  335.   SCR:ssName = TMO:sName             !
  336.   LOOP                         !
  337.     ALERT                     !
  338.     ALERT(Esc_Key)                 !
  339.     ACCEPT                     !
  340.     IF KEYCODE() = Esc_Key THEN BREAK.         !
  341.     OPEN(oObjFile)                 !
  342.     IF ERRORCODE() THEN BREAK.             !
  343.     CLOSE(oObjFile)                 !
  344.     IF Confirm() THEN BREAK.             !
  345.   .                         !
  346.   IF NOT KEYCODE() = Esc_Key             !
  347.     CREATE(oObjFile); ChkErr()             !
  348.     ilOffset = TMO:ilStart             !
  349.     SET(oLibFile, ilOffset)             !
  350.     LOOP WHILE (ilOffset - TMO:ilStart) < TMO:ilSize
  351.       NEXT(oLibFile)                 !
  352.       OOB:Record = OLF:Record             !
  353.       ADD(oObjFile); ChkErr()             !
  354.       ilOffset += SIZE(OLF:record)         !
  355.     .                         !
  356.     CLOSE(oObjFile)                 !
  357.   .                         !
  358.   CLOSE(wScreen)                 !
  359.   RETURN                     !
  360.  
  361.  
  362. !═════════════════════════════════════════════════════════════════════════
  363. !        Confirm overwrite of existing file
  364. !═════════════════════════════════════════════════════════════════════════
  365. Confirm         FUNCTION
  366.  
  367.          ! Return:
  368. bbRetVal     BYTE                 !
  369.  
  370.          ! Screens:
  371. wScreen         SCREEN      WINDOW(5,50),HUE(15,4)
  372.            ROW(1,1)      STRING('╔═{48}╗')
  373.            ROW(2,1)      REPEAT(3);STRING('║<0{48}>║') .
  374.            ROW(5,1)      STRING('╚═{48}╝')
  375.            ROW(3,4)      STRING('File already exists!  Overwrite?')
  376.          COL(38)  MENU,USE(?Menu),REQ
  377.          COL(38)    STRING(' Yes '),SEL(0,7)
  378.          COL(44)    STRING(' No '),SEL(0,7)
  379.          .          .
  380.  
  381.   CODE
  382.   bbRetVal = 0                     !
  383.   OPEN(wScreen)                     !
  384.   ACCEPT                     !
  385.   IF CHOICE() = 1 THEN bbRetVal = 1.         !
  386.   CLOSE(wScreen)                 !
  387.   RETURN( bbRetVal )                 !
  388.  
  389.  
  390. !═════════════════════════════════════════════════════════════════════════
  391. !               Check for errors
  392. !═════════════════════════════════════════════════════════════════════════
  393. ChkErr         PROCEDURE
  394.  
  395.   CODE
  396.   IF ERRORCODE() THEN STOP(ERROR()); RETURN.
  397.  
  398.