5748112 [rkeene@sledge /home/rkeene/devel/archive/quickbasic]$ cat -n compress.bas
   1: DECLARE SUB AddNode (SStr$)
   2: DECLARE SUB J (junk$)
   3: DECLARE SUB OpenFiles (file1$, file2$)
   4: DECLARE SUB ReadBuffer (f$)
   5: 'Objective: Find the longest matching, repeating string!
   6: CLEAR , , 3500
   7: DIM SHARED buffer AS STRING * 5000
   8: DIM SHARED search AS STRING * 25
   9: DIM SHARED hdr1 AS STRING * 1, hdr2 AS STRING * 1, hdr3 AS STRING * 1
  10: hdr1 = CHR$(213)
  11: hdr2 = CHR$(57)
  12: hdr3 = CHR$(45)
  13: CLS
  14: PRINT "/-----------------------------------------\"
  15: PRINT "|Keene-Lampton Compression Program Alpha-1|"
  16: PRINT "\-----------------------------------------/"
  17: PRINT
  18: 'INPUT "Input File-->", File1$
  19: 'INPUT "Output File-->", File2$
  20: file1$ = "command.com"
  21: file2$ = "comm.kam"
  22: OPEN file2$ FOR BINARY AS #1
  23: IF LOF(1) > 0 THEN CLOSE 1: KILL file2$ ELSE CLOSE 1
  24: OpenFiles file1$, file2$
  25: tmp$ = "KrAM"
  26: PUT #8, , tmp$
  27: ReadBuffer r$
  28: CLOSE 1, 2, 3, 4, 5, 6, 7, 8, 9, 10
  29: 
  30: SUB AddNode (SStr$)
  31: DIM Varchnk AS INTEGER
  32: Varchnk = Varchnk + 1
  33: PUT #8, , hdr1
  34: PUT #8, , hdr2
  35: PUT #8, , hdr3
  36: PUT #8, , SStr$
  37: PUT #8, , Varchnk
  38: PUT #8, , hdr3
  39: PUT #8, , hdr2
  40: PUT #8, , hdr1
  41: END SUB
  42: 
  43: SUB Compress (junk$)
  44: DIM onoff AS INTEGER
  45: PRINT "****** Next Chunk ******"
  46: FOR searcharea = 1 TO LEN(junk$) STEP LEN(search)
  47:    search = MID$(junk$, searcharea, LEN(search))
  48:    maxhitsofar = 0
  49:    FOR qqq = 100 TO LEN(junk$) STEP LEN(search)
  50:       IF search = MID$(junk$, qqq, LEN(search)) THEN onoff = 1 ELSE onoff = 0
  51:       'PRINT onoff; ":";
  52:       IF onoff = 1 THEN maxhitsofar = maxhitsofar + 1
  53:    NEXT qqq
  54:    PRINT maxhitsofar; ":";
  55: NEXT searcharea
  56: PUT #7, LOC(6), junk$
  57: END SUB
  58: 
  59: SUB J (junk$)
  60: FOR q = 1 TO LEN(junk$)
  61: IF INSTR(q + 1, junk$, Strd$) = 0 THEN
  62:         IF LEN(Strd$) > BigNum THEN BigNum = LEN(Strd$) - 1
  63:         IF LEN(Strd$) = 0 THEN q = q + 1 ELSE q = q + LEN(Strd$): Strd$ = LEFT$(Strd$, LEN(Strd$) - 1)
  64:         PRINT ".";
  65:         IF LEN(Strd$) > 7 THEN AddNode Strd$
  66:         Strd$ = ""
  67:         x = CSRLIN: y = POS(0): LOCATE 25, 1: PRINT "Current Pos: "; q; "  Largest String:"; BigNum; : LOCATE x, y
  68: ELSE
  69:         'PRINT strd$; ":";
  70:         PRINT "0";
  71:         Strd$ = Strd$ + MID$(junk$, q + 1, 1)
  72: END IF
  73: q = q - 1
  74: NEXT q
  75: AddNode Strd$
  76: PUT #7, , junk$
  77: PRINT BigNum; "<-- Large!!"
  78: END SUB
  79: 
  80: SUB OpenFiles (file1$, file2$)
  81: OPEN file2$ FOR BINARY AS #7
  82: IF LOF(7) <> 0 THEN CLOSE 7: KILL file2$ ELSE CLOSE 7
  83: OPEN "VMEM.SWP" FOR BINARY AS #7
  84: IF LOF(7) <> 0 THEN CLOSE 7: KILL "VMEM.SWP" ELSE CLOSE 7
  85: OPEN "FOTR.SWP" FOR BINARY AS #7
  86: IF LOF(7) <> 0 THEN CLOSE 7: KILL "FOTR.SWP" ELSE CLOSE 7
  87: OPEN file1$ FOR BINARY ACCESS READ AS #6
  88: OPEN file2$ FOR BINARY ACCESS WRITE AS #7
  89: OPEN "VMEM.SWP" FOR BINARY AS #8
  90: OPEN "FOTR.SWP" FOR BINARY AS #9
  91: 
  92: END SUB
  93: 
  94: SUB ReadBuffer (f$)
  95: 'Objective: To load and resize the buffer!
  96: FOR q = 0 TO LOF(6)
  97: GET #6, , buffer: Cnt = Cnt + 1
  98: IF LEN(buffer) + q > LOF(6) THEN m = ABS(((Cnt * LEN(buffer)) - LEN(buffer)) - LOF(6)) ELSE m = LEN(buffer)
  99: IF m = LEN(buffer) THEN J buffer ELSE J LEFT$(buffer, m)
 100: q = q + (m - 1)
 101: IF Cnt * LEN(buffer) > LOF(6) THEN END
 102: IF q + 1 = LOF(6) THEN EXIT FOR
 103: NEXT q
 104: END SUB
 105: 
5748113 [rkeene@sledge /home/rkeene/devel/archive/quickbasic]$

Click here to go back to the directory listing.
Click here to download this file.
last modified: 2000-05-09 21:01:08