'-----------------------------'
'WendelSoft ShrJR 1.0         '
'Copyright 2000 (c) WendelSoft'
'06.12.00 - 06.12.00          '
'Wendel Scardua               '
'-----------------------------'
DEFINT A-Z
CLS
PRINT "WendelSoft ShrJR 1.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$ = " "
SELECT CASE opcao$
   CASE "C"
      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&;
         FOR z = 0 TO 255
            LOCATE 7, 1: PRINT USING "Ascii:### Tam:####"; z; lng;
            IF lng < 4 THEN EXIT FOR
            IF z <> idx THEN
               cs$ = CHR$(z)
               bs$ = STRING$(4, z)
               restrit = 1
               DO
1                 p = INSTR(restrit, Buffer$, bs$)
                  IF p = 0 THEN EXIT DO
                  IF p > 1 THEN IF MID$(Buffer$, p - 1, 1) = cs$ THEN restrit = p + 1: GOTO 1
                  FOR j = 5 TO 255
                     IF MID$(Buffer$, p + j - 1, 1) <> cs$ THEN EXIT FOR
                  NEXT
                  IF j = idx AND j > 5 THEN j = j - 1
                  Buffer$ = LEFT$(Buffer$, p - 1) + cidx$ + CHR$(j - 1) + cs$ + MID$(Buffer$, p + j - 1)
                  restrit = p + 3
               LOOP
               lng = LEN(Buffer$)
            END IF
         NEXT
         LOCATE 7, 1: PRINT USING "Ascii:### Tam:####"; z; lng;
         PUT #2, SEEK(2), cidx$
         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
         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) + STRING$(ASC(MID$(Buffer$, p + 1, 1)), MID$(Buffer$, p + 2, 1))
            Buffer$ = MID$(Buffer$, p + 3)
         LOOP
         nBuffer$ = nBuffer$ + Buffer$
         PUT #2, SEEK(2), nBuffer$
         LOCATE 7, 1: PRINT USING "De:########  Para:########"; SEEK(1) - 1; SEEK(2) - 1;
         Buffer$ = "": nBuffer$ = ""
      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