5748234 [rkeene@sledge /home/rkeene/devel/archive/quickbasic]$ cat -n unpack2.bas
   1: DECLARE FUNCTION MyAlgoryth! (Siz!, LenTTL!)
   2: DECLARE FUNCTION ILength$ (txt$, num!)
   3: DECLARE FUNCTION LastPart$ (t$)
   4: CLS
   5: INPUT "PackedFile-->", Pack$
   6: OPEN Pack$ FOR BINARY AS #2
   7: DIM ff AS STRING * 1000
   8: DIM nme AS STRING * 12
   9: DIM nth AS STRING * 1
  10: DIM SHARED Back AS LONG
  11: DO UNTIL LOC(2) = LOF(2)
  12: GET #2, , nme
  13: flnm$ = RTRIM$(LTRIM$(nme))
  14: CLS
  15: DO UNTIL ff = "¯"
  16: GET #2, , nth
  17: PRINT nth; " <> ¯"; dbd; LOC(2); Back; LEN(ttl$); filsiz
  18: SLEEP
  19: Back = LOC(2)
  20: IF nth = "¯" THEN dbd = 0: EXIT DO
  21: IF dbd = 1 AND nth <> "¯" THEN fil$ = fil$ + nth
  22: IF nth = "®" THEN dbd = 1
  23: LOOP
  24: filsiz = VAL(fil$)
  25: fil$ = ""
  26: PRINT filsiz
  27: OPEN flnm$ FOR BINARY AS #1
  28: ttl$ = ILength$(flnm$, 12) + "®" + LTRIM$(RTRIM$(STR$(filsiz)))
  29: FOR mm = 0 TO (filsiz - 1)
  30: GET #2, , ff
  31: 'PUT #1, , ff
  32: IF LEN(ff) + mm > filsiz THEN place = MyAlgoryth(LEN(ff), filsiz - mm): gg$ = LEFT$(ff, filsiz - mm): PRINT mm; filsiz; place: PUT #1, , gg$: GET #2, place - 1, nth: mm = mm + LEN(gg$): EXIT FOR ELSE PUT #1, , ff
  33: percn = (mm / (filsiz + 1)) * 100
  34: LOCATE 2, 1: PRINT flnm$; " is"; filsiz; "bytes long and is"; INT(percn); "percent done."; mm
  35: mm = (mm + LEN(ff)) - 1
  36: NEXT mm
  37: CLOSE 1
  38: LOOP
  39: CLOSE 1, 2, 3, 4, 5, 6, 7, 8, 9
  40: 
  41: FUNCTION ILength$ (txt$, num)
  42: IF LEN(txt$) < num THEN ILength$ = STRING$(num - LEN(txt$), 32) + txt$
  43: END FUNCTION
  44: 
  45: FUNCTION LastPart$ (t$)
  46: FOR q = LEN(t$) TO 1 STEP -1
  47: IF MID$(t$, q, 1) = "\" THEN EXIT FOR ELSE nn$ = MID$(t$, q, 1) + nn$
  48: NEXT q
  49: LastPart$ = nn$
  50: END FUNCTION
  51: 
  52: FUNCTION MyAlgoryth (num1, num2)
  53: MyAlgoryth = ((LOC(2) - num1) + num2)
  54: END FUNCTION
  55: 
5748235 [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:10:32