5748284 [rkeene@sledge /home/rkeene/devel/archive/quickbasic]$ cat -n cmptst1.bas
   1: DECLARE FUNCTION IntToBin$ (t!)
   2: DECLARE FUNCTION Compress$ (q$)
   3: DECLARE FUNCTION Decompress$ (q$)
   4: DECLARE FUNCTION Compress1$ (t$)
   5: test$ = test$ + "/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\"
   6: outt$ = Compress$(test$)
   7: PRINT "--------------------"
   8: PRINT "in : "; LEN(test$)
   9: PRINT "out: "; LEN(outt$)
  10: PRINT outt$
  11: 
  12: 
  13: 
  14: 
  15: 
  16: 
  17: 
  18: 
  19: 
  20: 
  21: 
  22: 
  23: 
  24: 
  25: FUNCTION Compress$ (q$)
  26: tmp$ = q$
  27: 'FOR r = 1 TO LEN(q$)
  28: 'tmp$ = tmp$ + IntToBin$(ASC(MID$(q$, r, 1)))
  29: 'NEXT r
  30: 'MrkEr = VAL(MID$(tmp$, 1, 1)): Cntr = 1
  31: FOR r = 1 TO LEN(tmp$)
  32: IF ASC(MID$(tmp$, r, 1)) = MrkEr THEN Cntr = Cntr + 1
  33: IF ASC(MID$(tmp$, r, 1)) <> MrkEr THEN output$ = output$ + CHR$(Cntr) + CHR$(MrkEr): Cntr = 1: MrkEr = ASC(MID$(tmp$, r, 1))
  34: NEXT r
  35: 'IF ASC(MID$(tmp$, r, 1)) <> MrkEr THEN output$ = output$ + CHR$(Cntr) + CHR$(MrkEr): Cntr = 1: MrkEr = ASC(MID$(tmp$, r, 1))
  36: Compress$ = output$
  37: END FUNCTION
  38: 
  39: FUNCTION Compress1$ (t$)
  40: d = VAL("&H" + HEX$(MID$(t$, q + 0, 1)) + HEX$(MID$(t$, q + 1, 1)) + HEX$(MID$(t$, q + 2, 1)))
  41: 
  42: END FUNCTION
  43: 
  44: FUNCTION Decompress$ (q$)
  45: tmp$ = ""
  46: FOR r = 1 TO LEN(q$)
  47: IF ASC(MID$(q$, r, 1)) < 128 THEN t$ = t$ + STRING$(ASC(MID$(q$, r, 1)), "1")
  48: IF ASC(MID$(q$, r, 1)) > 127 THEN t$ = t$ + STRING$(ASC(MID$(q$, r, 1)) - 127, "0")
  49: NEXT r
  50: Decompress$ = t$
  51: END FUNCTION
  52: 
  53: FUNCTION IntToBin$ (t)
  54: m$ = HEX$(t)
  55: 'PRINT m$
  56: FOR m = 0 TO LEN(m$) - 1 STEP 2
  57: FOR q = 1 TO 2
  58: IF MID$(m$, q + m, 1) = "0" THEN nbl1$ = nbl1$ + "0000"
  59: IF MID$(m$, q + m, 1) = "1" THEN nbl1$ = nbl1$ + "0001"
  60: IF MID$(m$, q + m, 1) = "2" THEN nbl1$ = nbl1$ + "0010"
  61: IF MID$(m$, q + m, 1) = "3" THEN nbl1$ = nbl1$ + "0011"
  62: IF MID$(m$, q + m, 1) = "4" THEN nbl1$ = nbl1$ + "0100"
  63: IF MID$(m$, q + m, 1) = "5" THEN nbl1$ = nbl1$ + "0101"
  64: IF MID$(m$, q + m, 1) = "6" THEN nbl1$ = nbl1$ + "0110"
  65: IF MID$(m$, q + m, 1) = "7" THEN nbl1$ = nbl1$ + "0111"
  66: IF MID$(m$, q + m, 1) = "8" THEN nbl1$ = nbl1$ + "1000"
  67: IF MID$(m$, q + m, 1) = "9" THEN nbl1$ = nbl1$ + "1001"
  68: IF MID$(m$, q + m, 1) = "A" THEN nbl1$ = nbl1$ + "1010"
  69: IF MID$(m$, q + m, 1) = "B" THEN nbl1$ = nbl1$ + "1100"
  70: IF MID$(m$, q + m, 1) = "C" THEN nbl1$ = nbl1$ + "1011"
  71: IF MID$(m$, q + m, 1) = "D" THEN nbl1$ = nbl1$ + "1101"
  72: IF MID$(m$, q + m, 1) = "E" THEN nbl1$ = nbl1$ + "1110"
  73: IF MID$(m$, q + m, 1) = "F" THEN nbl1$ = nbl1$ + "1111"
  74: NEXT q, m
  75: IntToBin$ = STRING$(8 - LEN(nbl1$), "0") + nbl1$
  76: END FUNCTION
  77:
5748285 [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:00:57