5748262 [rkeene@sledge /home/rkeene/devel/archive/quickbasic]$ cat -n pack4.bas
   1: DECLARE FUNCTION Ilength$ (txt$)
   2: DECLARE FUNCTION LastPart$ (t$)
   3: INPUT "Filelist-->", aff$
   4: INPUT "PackedFile-->", Pack$
   5: OPEN Pack$ FOR BINARY AS #2
   6: OPEN aff$ FOR INPUT AS #3
   7: DIM ff AS STRING * 500
   8: DO UNTIL EOF(3)
   9: LINE INPUT #3, flnm$
  10: OPEN flnm$ FOR BINARY AS #1
  11: ttl$ = Ilength$(LastPart$(RTRIM$(LTRIM$(UCASE$(flnm$)))))
  12: FOR m = 1 TO LEN(ttl$)
  13: dd$ = MID$(ttl$, m, 1)
  14: PUT #2, , dd$
  15: NEXT m
  16: ffs = LOF(1)
  17: PUT #2, , ffs
  18: FOR mm = 0 TO LOF(1)
  19: GET #1, , ff
  20: IF LEN(ff$) + mm > LOF(1) THEN PRINT mm + LEN(ff$); " is greater than "; LOF(1); " so"; : gg$ = LEFT$(ff, LOF(1) - mm): PUT #2, , gg$: PRINT " put only the first "; LOF(1) - mm; " bytes.": m = m + LEN(gg$): EXIT FOR ELSE PUT #2, , ff
  21: PRINT LOF(1); LOF(2); LEN(ff$); LEN(gg$); mm
  22: 'SLEEP
  23: mm = mm + (LEN(ff) - 1)
  24: NEXT mm
  25: CLOSE 1
  26: LOOP
  27: CLOSE 1, 2, 3, 4, 5, 6, 7, 8, 9
  28: 
  29: FUNCTION Ilength$ (txt$)
  30: Ilength$ = STRING$(12 - LEN(txt$), 32) + txt$
  31: END FUNCTION
  32: 
  33: FUNCTION LastPart$ (t$)
  34: FOR q = LEN(t$) TO 1 STEP -1
  35: IF MID$(t$, q, 1) = "\" THEN EXIT FOR ELSE nn$ = MID$(t$, q, 1) + nn$
  36: NEXT q
  37: LastPart$ = nn$
  38: END FUNCTION
  39: 
5748263 [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:06:56