DECLARE FUNCTION W$ (a%) DECLARE SUB WRITEHEAD () OPTION BASE 0 CONST SYNCHRO = 3 DIM a AS INTEGER, I AS INTEGER DIM SHARED CNT AS LONG DIM C AS LONG DIM COUNT(4) AS INTEGER DIM SHARED ST(4) AS STRING DIM D(4, 141) AS INTEGER DIM SHARED DSTWAV AS STRING DIM DST AS STRING, SRC AS STRING DIM SHARED FREQ AS INTEGER: FREQ = 22050 DATA 0,63,63,0,-64,-64,0,63,63,0,-64,-64,256 DATA 0,32,55,64,55,32,0,-33,-56,-65,-56,-33,0,55,55,0,-56,-56,256 DATA 0,63,63,0,-64,-64,0,63,63,0,-64,-64,0,63,63,0,-64,-64,0,63,63,0,-64,-64,0,63,63,0,-64,-64,0,63,63,0,-64,-64,0,63,63,0,-64,-64,0,63,63,0,-64,-64,256 DATA 0,16,29,36,38,41,41,42,42,42,42,42,0,-17,-30,-37,-41,-42,-43,-43,-43,-43,-43,-18,0,26,34,38,39,41,0,-17,-29,-36,-39,-39,0,55,55,0,-56,-56,256 DATA 0,15,40,53,60,63,65,65,66,66,66,66,66,65,65,65,65,65,64,64,64,64,64,63,63,62,62,62,61,60,50,0,-39,-56,-64,-69,-71,-72,-73,-73,-73,-73,-73,-72,-72,-72,-72,-71,-71,-71,-71,-71,-70,-70,-70,-70,-70,-69,-69,-69,-69,-68,-66,-6,256 CLS RESTORE FOR J = 0 TO 4 I = 0 DO: I = I + 1: READ a: IF a = 256 THEN EXIT DO D(J, I) = a + 128: ST(J) = ST(J) + CHR$(a + 128) LOOP COUNT(J) = I NEXT J INPUT "Enter binary file name: ", SRC DST = "": INPUT "Enter target file name (Enter for default): ", DST IF DST = "" THEN DST = SRC LDST = LEN(DST) IF LDST < 16 THEN DST = DST + STRING$(16 - LDST, 32) DPOS = INSTR(SRC, ".") DSTWAV = SRC IF DPOS > 0 THEN DSTWAV = LEFT$(DSTWAV, DPOS - 1) IF LEN(DSTWAV) > 8 THEN DSTWAV = LEFT$(DSTWAV, 8) DSTWAV = DSTWAV + ".wav" PRINT "Audio file name: "; DSTWAV FOR I = 1 TO 16 Q% = ASC(MID$(DST, I)) NM$ = NM$ + W$(Q%) NEXT I GOSUB T1 CNT = (512& + 2& + 32&) * LEN(ST(2)) + 4& * LEN(ST(SYNCHRO)) + LEN(AD$ + NM$) + LNG + LEN(CS$) + LEN(ST(4)) CALL WRITEHEAD FOR I = 1 TO 512: PRINT #1, ST(2); : NEXT: PRINT #1, ST(SYNCHRO); PRINT #1, ST(2); ST(SYNCHRO); PRINT #1, AD$; NM$; PRINT #1, ST(2); ST(SYNCHRO); GOSUB WR PRINT #1, CS$; PRINT #1, ST(4); FOR I = 1 TO 32: PRINT #1, ST(2); : NEXT: PRINT #1, ST(SYNCHRO); CLOSE 1 END T1: SM& = 0 OPEN SRC FOR BINARY AS #2 AD0$ = INPUT$(4, #2): AD$ = "": FOR I = 1 TO 4: AD$ = AD$ + W$(ASC(MID$(AD0$, I))): NEXT C = 0: LNG = 0 DO E$ = INPUT$(1, #2): IF E$ = "" THEN EXIT DO a% = ASC(E$) SM& = SM& + CLNG(a%): IF SM& > 65535 THEN SM& = SM& - 65535 C = C + 1 LNG = LNG + LEN(W$(a%)) LOOP PRINT "Checksum="; HEX$(C) CLOSE #2 CS1% = CINT(SM& AND 255) CS2% = CINT((SM& AND NOT 255) / 256) CS$ = W$(CS1%) + W$(CS2%) RETURN WR: OPEN SRC FOR BINARY AS #2 DC$ = INPUT$(4, #2) DO E$ = INPUT$(1, #2): IF E$ = "" THEN EXIT DO a% = ASC(E$) PRINT #1, W$(a%); LOOP CLOSE #2 RETURN FUNCTION W$ (V%) T$ = "" FOR G% = 0 TO 7 U% = 2 ^ G% T$ = T$ + ST((V% AND U%) / U%) NEXT G% W$ = T$ END FUNCTION SUB WRITEHEAD OPEN DSTWAV FOR OUTPUT ACCESS WRITE AS #1 PRINT #1, "RIFF"; Z$ = MKL$(CNT + 36): PRINT #1, Z$; PRINT #1, "WAVEfmt "; Z$ = MKL$(16): PRINT #1, Z$; 'subchunk size Z$ = MKI$(1): PRINT #1, Z$; 'PCM Z$ = MKI$(1): PRINT #1, Z$; 'Mono Z$ = MKL$(FREQ): PRINT #1, Z$; 'kHz Z$ = MKL$(FREQ): PRINT #1, Z$; 'Byterate Z$ = MKI$(1): PRINT #1, Z$; 'Blockalign Z$ = MKI$(8): PRINT #1, Z$; 'bit PRINT #1, "data"; Z$ = MKL$(CNT): PRINT #1, Z$; END SUB