1: DECLARE FUNCTION Dec2Bin$ (nn!) 2: DECLARE FUNCTION Bin2Dec! (nn$) 3: 'Syntax: AR -{l|a|r} A:archive [F:file] 4: dd$ = "-a A:NEW0.AR f:*.exe" 5: dd$ = UCASE$(dd$) + " " 6: IF INSTR(UCASE$(dd$), "-L") <> 0 THEN Mde = 1 7: IF INSTR(dd$, "-") = 0 OR INSTR(UCASE$(dd$), "-A") <> 0 THEN Mde = 2 8: IF INSTR(UCASE$(dd$), "-R") <> 0 THEN Mde = 3 9: IF INSTR(UCASE$(dd$), "A:") = 0 THEN Arc$ = "NEW.AR" ELSE Arc$ = MID$(dd$, INSTR(UCASE$(dd$), "A:") + 2, (INSTR(INSTR(UCASE$(dd$), "A:") + 2, dd$, " ") - INSTR(UCASE$(dd$), "A:")) - 2) 10: IF INSTR(UCASE$(dd$), "F:") = 0 THEN Fil$ = "*.*" ELSE Fil$ = MID$(dd$, INSTR(UCASE$(dd$), "F:") + 2, (INSTR(INSTR(UCASE$(dd$), "F:") + 2, dd$, " ") - INSTR(UCASE$(dd$), "F:")) - 2) 11: 'PRINT Mde, Arc$, Fil$ 12: ON Mde GOTO ListFile, AddFile, RemoveFile 13: 14: ListFile: 15: DIM Hdr AS STRING * 3 16: PRINT "Listing " + Fil$ + " from " + Arc$ + "." 17: xx1 = FREEFILE 18: OPEN Arc$ FOR BINARY AS #xx1 19: IF LOF(xx1) = 0 THEN CLOSE xx1: PRINT "Invaild Archive.": GOTO LastLn 20: GET #xx1, , Hdr 21: IF Hdr <> "TaR" THEN CLOSE xx1: PRINT "Invaild Archive.": GOTO LastLn 22: DIM Bytes AS STRING * 1 23: DIM Byte AS STRING * 1000 24: DO UNTIL INSTR(Byte, "\*") <> 0 25: GET #xx1, , Bytes 26: IF INSTR(Bytes, "\*") <> 0 THEN lstChr = INSTR(Bytes, "\*") 27: LOOP 28: CLOSE xx1 29: GOTO LastLn 30: AddFile: 31: PRINT "Creating " + Arc$ + " from " + Fil$ + "." 32: ss$ = DIR$(Fil$) 33: DO 34: IF ss$ = "" THEN EXIT DO 35: xx2 = FREEFILE 36: OPEN ss$ FOR BINARY ACCESS READ AS #xx2 37: ts$ = ts$ + CHR$(LEN(ss$)) + ss$ + CHR$(LEN(Dec2Bin$(LOF(xx2)))) + Dec2Bin$(LOF(xx2)) 38: CLOSE xx2 39: pstss$ = ss$: ss$ = DIR$ 40: LOOP UNTIL ss$ = "" OR pstss$ = ss$ 41: Hdr$ = "TaR" 42: DIM Byte AS STRING * 1000 43: xx1 = FREEFILE 44: OPEN Arc$ FOR BINARY AS #xx1 45: PUT #xx1, , Hdr$ 46: ts$ = ts$ + "\*" 47: PUT #xx1, , ts$ 48: ss$ = DIR$(Fil$) 49: DO 50: IF ss$ = "" THEN EXIT DO 51: xx2 = FREEFILE 52: OPEN ss$ FOR BINARY ACCESS READ AS #xx2 53: FOR q = 1 TO LOF(xx2) 54: GET #xx2, , Byte 55: IF q + LEN(Byte) > LOF(xx2) THEN g$ = MID$(Byte, 1, (LOF(xx2) - q) + 1): PUT #xx1, , g$ ELSE PUT #xx1, , Byte 56: q = (q + LEN(Byte)) - 1 57: NEXT q 58: PRINT ss$ 59: CLOSE xx2 60: pstss$ = ss$: ss$ = DIR$ 61: LOOP UNTIL ss$ = "" OR pstss$ = ss$ 62: CLOSE xx1 63: 64: 65: GOTO LastLn 66: RemoveFile: 67: PRINT "Removing " + Fil$ + " from " + Arc$ + "." 68: LastLn: 69: 70: FUNCTION Bin2Dec (nn$) 71: FOR q = 1 TO LEN(nn$) 72: f1$ = STRING$(2 - LEN(HEX$(ASC(MID$(nn$, q, 1)))), "0") + HEX$(ASC(MID$(nn$, q, 1))) + f1$ 73: NEXT q 74: Bin2Dec = VAL("&H" + f1$) 75: END FUNCTION 76: 77: FUNCTION Dec2Bin$ (nn) 78: f$ = HEX$(nn) 79: f1$ = STRING$(LEN(f$) MOD 2, "0") + f$ 80: FOR q = 1 TO LEN(f1$) STEP 2 81: f2$ = CHR$(VAL("&H" + MID$(f1$, q, 2))) + f2$ 82: NEXT q 83: Dec2Bin$ = f2$ 84: END FUNCTION 85: |