Перевод из двоичной системы счисления в восьмеричную

CLS
DEFDBL A-Z
INPUT "vvedite chislo"; a$: INPUT "vvedite q"; q: INPUT "vvedite p"; p
FOR i = 1 TO LEN(a$)
    IF MID$(a$, i, 1) <> "." THEN b$ = b$ + MID$(a$, i, 1) ELSE r = i - LEN(a$)
NEXT
DIM c(LEN(b$)): u$ = "0123456789ABCDEF": m = 1E6
FOR i = 1 TO LEN(b$): FOR j = 1 TO LEN(u$)
        IF UCASE$(MID$(b$, i, 1)) = MID$(u$, j, 1) THEN c(i) = j - 1
NEXT: NEXT
FOR i = LEN(b$) TO 1 STEP -1
    IF r >= 0 THEN z = z + c(i) * q ^ r ELSE d = d + c(i) * q ^ r * m
    r = r + 1
NEXT
DO
    c$ = MID$(u$, (z MOD p) + 1, 1) + c$: z = z \ p
LOOP UNTIL z = 0
DO
    l = l + 1: d = d * p
    f$ = f$ + MID$(u$, INT(d / m) + 1, 1): d = d - INT(d / m) * m
LOOP UNTIL d = 0 OR l = 10
PRINT STRING$(80, 196); c$ + "." + f$

CLS
DEFDBL A-Z
INPUT "vvedite chislo"; a$: INPUT "vvedite q"; q: INPUT "vvedite p"; p
FOR i = 1 TO LEN(a$)
    IF MID$(a$, i, 1) <> "." THEN b$ = b$ + MID$(a$, i, 1) ELSE r = i - LEN(a$)
NEXT
DIM c(LEN(b$)): u$ = "0123456789ABCDEF": m = 1E6
FOR i = 1 TO LEN(b$): FOR j = 1 TO LEN(u$)
        IF UCASE$(MID$(b$, i, 1)) = MID$(u$, j, 1) THEN c(i) = j - 1
        IF c(i) >= q THEN PRINT "oshibka: chislo ne sootvetstvuet ss": END
NEXT: NEXT
FOR i = LEN(b$) TO 1 STEP -1
    IF r >= 0 THEN z = z + c(i) * q ^ r ELSE d = d + c(i) * q ^ r * m
    r = r + 1
NEXT
DO
    c$ = MID$(u$, (z MOD p) + 1, 1) + c$: z = z \ p
LOOP UNTIL z = 0
DO
    l = l + 1: d = d * p
    f$ = f$ + MID$(u$, INT(d / m) + 1, 1): d = d - INT(d / m) * m
LOOP UNTIL d = 0 OR l = 10
PRINT STRING$(80, 196); c$ + "." + f$

CLS
DEFDBL A-Z
INPUT "vvedite chislo"; a$: INPUT "vvedite q"; q
FOR i = 1 TO LEN(a$)
    IF MID$(a$, i, 1) <> "." THEN b$ = b$ + MID$(a$, i, 1) ELSE r = i - LEN(a$)
NEXT
DIM c(LEN(b$)): u$ = "0123456789ABCDEF": m = 1E6
FOR i = 1 TO LEN(b$): FOR j = 1 TO LEN(u$)
        IF UCASE$(MID$(b$, i, 1)) = MID$(u$, j, 1) THEN c(i) = j - 1
        IF c(i) >= q THEN PRINT "oshibka: chislo ne sootvetstvuet ss": END
NEXT: NEXT
INPUT "vvedite p"; p
FOR i = LEN(b$) TO 1 STEP -1
    IF r >= 0 THEN z = z + c(i) * q ^ r ELSE d = d + c(i) * q ^ r * m
    r = r + 1
NEXT
DO
    c$ = MID$(u$, (z MOD p) + 1, 1) + c$: z = z \ p
LOOP UNTIL z = 0
DO
    l = l + 1: d = d * p
    f$ = f$ + MID$(u$, INT(d / m) + 1, 1): d = d - INT(d / m) * m
LOOP UNTIL d = 0 OR l = 10
PRINT STRING$(80, 196); c$ + "." + f$

CLS
DEFDBL A-Z
INPUT "vvedite chislo"; a$: INPUT "vvedite q"; q: INPUT "vvedite p"; p
u$ = "0123456789ABCDEF": k = INSTR(a$, "."): r = (LEN(a$) - k) * (k <> 0)
a$ = MID$(a$, 1, k - 1) + MID$(a$, k + 1, LEN(a$) - k)
FOR i = LEN(a$) TO 1 STEP -1: j = INSTR(u$, UCASE$(MID$(a$, i, 1))) - 1
    IF r >= 0 THEN z = z + j * q ^ r ELSE d = d + j * q ^ r
    r = r + 1
NEXT
DO
    c$ = MID$(u$, (z MOD p) + 1, 1) + c$: z = z \ p
LOOP UNTIL z = 0
DO
    l = l + 1: d = VAL(STR$(d)) * p
    f$ = f$ + MID$(u$, INT(d) + 1, 1): d$ = STR$(d)
    d = VAL(RIGHT$(d$, LEN(d$) - INSTR(d$, ".") + 1))
LOOP UNTIL INSTR(d$, ".") = 0 OR l = 20
PRINT STRING$(80, 196); c$ + "." + f$

CLS: u$ = "0123456789ABCDEF"
INPUT "vvedite chislo"; a$: INPUT "vvedite q"; q: INPUT "vvedite p"; p
FOR i = LEN(a$) TO 1 STEP -1: j = INSTR(u$, UCASE$(MID$(a$, i, 1))) - 1
    z = z + j * q ^ r: r = r + 1
NEXT
DO
    c$ = MID$(u$, (z MOD p) + 1, 1) + c$: z = z \ p
LOOP UNTIL z = 0
PRINT STRING$(80, 196); c$

CLS
u$ = "0123456789ABCDEF"
INPUT "vvedite chislo: ", w$
INPUT "vvedite q: ", q
INPUT "vvedite p: ", p
DIM a(LEN(w$) - 1)
FOR i = 0 TO LEN(w$) - 1
    a(i) = INSTR(u$, UCASE$(MID$(w$, i + 1, 1))) - 1
NEXT
PRINT STRING$(80, 196); all_to_all$(a(), LEN(w$), q, p, u$)
FUNCTION all_to_all$ (a(), la, q, p, u$)
DO
    j = 0: snos = 0
    FOR i = 0 TO la - 1
        snos = snos * q
        snos = snos + a(i)
        IF (snos < p) AND (i > 0) AND (j > 0) THEN
            a(j) = 0: j = j + 1
        END IF
        IF (snos >= p) THEN
            a(j) = snos \ p
            snos = snos MOD p
            j = j + 1
        END IF
    NEXT
    res$ = MID$(u$, snos + 1, 1) + res$
    la = j
LOOP WHILE (la > 0)
all_to_all$ = res$
END FUNCTION

CLS
INPUT "vvedite chislo: ", a$
INPUT "vvedite q: ", q
INPUT "vvedite p: ", p
PRINT STRING$(80, 196); all_to_all$(a$, q, p)
FUNCTION all_to_all$ (a$, q, p)
u$ = "0123456789ABCDEF"
DO
    snos = 0
    FOR i = 1 TO LEN(a$)
        snos = snos * q
        snos = snos + INSTR(u$, UCASE$(MID$(a$, i, 1))) - 1
        IF (snos < p) AND (LEN(w$) > 0) THEN w$ = w$ + CHR$(48)
        IF (snos >= p) THEN
            w$ = w$ + MID$(u$, (snos \ p) + 1, 1)
            snos = snos MOD p
        END IF
    NEXT
    res$ = MID$(u$, snos + 1, 1) + res$
    a$ = w$
    w$ = ""
LOOP WHILE (LEN(a$) > 0)
all_to_all$ = res$
END FUNCTION

d3# = (drob# - verxdrob#) * 10#
  d4# = d3# + .000000004000002# ',,баг функции фикс вылечен дабавлением дроби целому числу
  n# = FIX(d4#)

 CLS
 '0-99 9
'100 199 9
'300 399 9
'
'0 тыщ 27
'1 тыщ 27
'3 тыщ 27
'0-9999 деститыщ =27*3=81
'
'0 дестыщ 81
'1        81
'3        81
'0-9 9999 = 81*3= 243
'
'0 стотыщ 243
'9*3*3*3(*3*3*3*3)
'  до сотни
'    до тыс
'      до дес тыс
'                9999 9999 =19683 числа которые имеют числа 0,1,3
 
 REM n$ = "txtm2.txt"  заремлено вывод в фаил при поиске ошибки функции FIX()
  REM  OPEN n$ FOR OUTPUT AS #1
 s# = 0#
REM   PRINT #1, "Это хранится в файле"
 FOR i# = 0# TO 9999# 'ищет только цифры 0,1,3 первые от 0 до 9999 (результат 81 числа содержат только 0,1,3 на диаппазоне от 0 до 9999)
REM   PRINT #1, "i#= "; i#
  s# = 0#
 n# = 0#
 REM крутим число 8 раз
 FOR y# = 1# TO 8#
 pokaz# = 10# ^ y#
 drob# = i# / pokaz#
 verxdrob# = FIX(drob#)
 d3# = (drob# - verxdrob#) * 10#
  d4# = d3# + .000000004000002# ',,баг функции фикс вылечен дабавлением дроби целому числу
  n# = FIX(d4#)
 REM  PRINT #1, " y#= "; y#; " pokaz#= "; pokaz#; " drob#= "; drob#; " verxdrob#= "; verxdrob#; " d3#= "; d3#; " n#= "; n#
 REM PRINT n#
 IF n# = 0# OR n# = 1# OR n# = 3# AND n# <> 2# AND n# <> 4# AND n# <> 5# AND n# <> 6# AND n# <> 7# AND n# <> 8# AND n# <> 9# THEN tr# = 1 ELSE tr# = 0#
 s# = s# + tr#
 IF s# < 8# THEN flag# = 0# ELSE flag# = 1#
 n# = 0#
 NEXT y#
 sflag# = sflag# + flag#
REM  PRINT #1, " sflag#= "; sflag#
 NEXT i#
 PRINT sflag#
 END