'-----------------------------' 'WendelSoft Shrink 2.0 ' 'Copyright 2000 (c) WendelSoft' '24.11.00 - 02.12.00 ' 'Wendel Scardua ' '-----------------------------' DEFINT A-Z CLS PRINT "WendelSoft Shrink 2.0 beta" PRINT PRINT "Compactar ou Extrair (C ou E) ? "; DO: opcao$ = UCASE$(INPUT$(1)): LOOP UNTIL opcao$ = "C" OR opcao$ = "E" OR opcao$ = CHR$(27) PRINT opcao$ IF opcao$ = CHR$(27) THEN SYSTEM INPUT "Origem :", orig$ IF orig$ = "" THEN SYSTEM INPUT "Destino :", dest$ IF dest$ = "" THEN SYSTEM OPEN orig$ FOR BINARY AS #1 OPEN dest$ FOR BINARY AS #2 Byte$ = " " 'Seleciona sistema de compacta‡„o:Max deve ser +q 3 CONST Max = 40 CONST Stp = 4 DIM keyitem$(0 TO 255) SELECT CASE opcao$ CASE "C" ERASE keyitem$ ct = 0: lng = 0 Buffer$ = "": keylist$ = "" sk1& = 1 fl1& = LOF(1) DO UNTIL sk1& > fl1& lng = 8192 IF lng > fl1& - sk1& + 1 THEN lng = fl1& - sk1& + 1 Buffer$ = SPACE$(lng) GET #1, sk1&, Buffer$ idx = -1: value = 0 FOR z = 0 TO 255 k = INSTR(Buffer$, CHR$(z)) IF k = 0 THEN value = 0: idx = z: cut = lng: EXIT FOR IF k > value THEN value = k: idx = z: cut = k - 1 NEXT cidx$ = CHR$(idx) lng = cut Buffer$ = LEFT$(Buffer$, lng) sk1& = sk1& + lng LOCATE 6, 1: PRINT USING "Posi‡„o:######## de ########"; sk1& - 1; fl1&; IF lng >= Max THEN tb = Max ELSE tb = (lng \ Stp) * Stp lng = 0 ctc = -1 FOR i = tb TO 3 STEP -Stp LOCATE 7, 1: PRINT USING "Bloco Tamanho:##"; i; ends = LEN(Buffer$) - i + 1 j = 1 3 DO UNTIL j > ends IF (ends - j) MOD 10 = 0 THEN LOCATE 7, 20: PRINT USING "Cont.Reg.:#####"; ends - j; IF ctc = 255 THEN EXIT FOR bl$ = MID$(Buffer$, j, i) av = INSTR(bl$, cidx$) IF av > 0 THEN j = j + av + 1: GOTO 3 ELSEIF j > 1 THEN IF MID$(Buffer$, j - 1, 1) = cidx$ THEN j = j + 1: GOTO 3 END IF p = j + i IF INSTR(p, Buffer$, bl$) = 0 THEN FOR j2 = j + 1 TO ends bt$ = MID$(Buffer$, j2, 4) IF INSTR(j2 + i, Buffer$, bt$) > 0 THEN EXIT FOR NEXT j = j2 GOTO 3 END IF inc = -1 DO 4 p = INSTR(p, Buffer$, bl$) IF p = 0 THEN EXIT DO IF MID$(Buffer$, p - 1, 1) = cidx$ THEN p = p + 1: GOTO 4 IF inc THEN ctc = ctc + 1 Buffer$ = LEFT$(Buffer$, p - 1) + cidx$ + CHR$(ctc) + MID$(Buffer$, p + i) p = p + 2 ends = ends - i + 2 IF inc THEN keylist$ = keylist$ + CHR$(i) + bl$ Buffer$ = LEFT$(Buffer$, j - 1) + cidx$ + CHR$(ctc) + MID$(Buffer$, j + i) inc = 0 ends = ends - i + 2 p = p - i + 2 j = j + 1 END IF LOOP j = j + 1 LOOP IF i > 3 AND i < 7 THEN i = 3 + Stp NEXT PUT #2, SEEK(2), cidx$ size = LEN(keylist$) PUT #2, SEEK(2), size PUT #2, SEEK(2), keylist$ keylist$ = "" size = LEN(Buffer$) PUT #2, SEEK(2), size PUT #2, SEEK(2), Buffer$ Buffer$ = "" LOCATE 8, 1: PRINT USING "Taxa Parcial:####.##% "; (SEEK(2) - 1) / sk1& * 100 LOOP comp# = (fl1& \ 512) * 51200 / fl1& taxa# = LOF(2) / fl1& * 100 LOCATE 8, 1: PRINT USING "Taxa :####.##% "; taxa#; CLOSE #1, #2 LOCATE 9, 1 IF taxa# >= 100 THEN PRINT "Compacta‡„o mal-sucedida: Destino maior que origem" ELSEIF taxa# >= comp# THEN PRINT "Compacta‡„o mal-sucedida: Nao rendeu 1 cluster" ELSE PRINT "Compacta‡„o bem-sucedida" END IF CASE "E" cidx$ = " " DO UNTIL SEEK(1) > LOF(1) GET #1, SEEK(1), cidx$ GET #1, SEEK(1), size ctd = -1 FOR clr = 0 TO 255: keyitem$(clr) = "": NEXT DO UNTIL size = 0 GET #1, SEEK(1), Byte$ s = ASC(Byte$) size = size - s - 1 ctd = ctd + 1 keyitem$(ctd) = SPACE$(s) GET #1, SEEK(1), keyitem$(ctd) LOOP GET #1, SEEK(1), size Buffer$ = SPACE$(size) GET #1, SEEK(1), Buffer$ nBuffer$ = "" DO UNTIL Buffer$ = "" p = INSTR(Buffer$, cidx$) IF p = 0 THEN EXIT DO nBuffer$ = nBuffer$ + LEFT$(Buffer$, p - 1) + keyitem$(ASC(MID$(Buffer$, p + 1, 1))) Buffer$ = MID$(Buffer$, p + 2) LOOP nBuffer$ = nBuffer$ + Buffer$ PUT #2, SEEK(2), nBuffer$ LOCATE 7, 1: PRINT USING "De:######## Para:########"; SEEK(1) - 1; SEEK(2) - 1; Buffer$ = "" LOOP CLOSE #1, #2 END SELECT IF orig$ <> "from.tmp" THEN LOCATE 15, 1: PRINT "Apagar origem [s/n] ? "; DO: k$ = UCASE$(INPUT$(1)): LOOP UNTIL k$ = "S" OR k$ = "N" PRINT k$ IF k$ = "S" THEN KILL orig$ END IF PRINT : PRINT "Concluˇdo !": BEEP SYSTEM