ファイル埋め込み

 投稿者：しばっち  投稿日：2015年 1月29日(木)19時08分5秒
  フルカラーの画像データに任意のファイルを埋め込みます。
RGB各8Bitから各下位3,3,2bit(=1byte)を利用します。
つまり、1dotにつき1byteずつ書き込んでいきます。
埋め込み可能なファイル上限は画像サイズ(横dot × 縦dot)になります。
また、埋め込みファイルの判定に判別文字列+復元用にファイル名の長さ(1byte)+
ファイル名+ファイルサイズ(4byte)をヘッダーとして使用しています。

※このプログラムでは、復元されたファイルの一部が欠損・欠落するようです。

!' ステガノグラフィー
OPTION CHARACTER BYTE
DECLARE EXTERNAL FUNCTION GETDATA
PUBLIC NUMERIC XSIZE,YSIZE,ADR
FILE GETNAME F$,"BMP,JPG,GIF,PNGファイル|*.BMP;*.JPG;*.GIF;*.PNG"
IF F$="" THEN STOP
CALL PICTURELOAD(F$,XSIZE,YSIZE)
LET KEY$="Steganography" !'判別文字列
LET ADR=0
LET D$=""
FOR I=1 TO LEN(KEY$)
   LET D$=D$&CHR$(GETDATA)
NEXT I
IF D$<>KEY$ THEN
   PRINT "任意ファイルを画像に埋め込みます"
   PRINT XSIZE*YSIZE-(LEN(KEY$)+5+255);"Byteまで"
   FILE GETNAME F$,"埋め込みファイル|*.*"
   IF F$="" THEN STOP
   FILE SPLITNAME (F$) PATH$, NAME$, EXT$
   LET NAME$=NAME$&EXT$
   PRINT "埋め込みファイル:";NAME$
   OPEN #1:NAME F$
   ASK #1 : FILESIZE FSIZE
   PRINT "ファイルサイズ:";FSIZE;"Byte"
   IF XSIZE*YSIZE-(LEN(KEY$)+LEN(NAME$)+5)<FSIZE THEN
      PRINT "ファイルが大き過ぎます。"
      CLOSE #1
      STOP
   END IF
   LET ADR=0
   FOR I=1 TO LEN(KEY$)
      CALL PUTDATA(ORD(KEY$(I:I)))
   NEXT I
   LET NAMESIZE=LEN(NAME$)
   CALL PUTDATA(NAMESIZE)
   FOR I=1 TO NAMESIZE
      CALL PUTDATA(ORD(NAME$(I:I)))
   NEXT I
   LET FSIZE$=MKL$(FSIZE)
   FOR I=1 TO 4
      CALL PUTDATA(ORD(FSIZE$(I:I)))
   NEXT I
   FOR I=1 TO FSIZE
      CHARACTER INPUT #1 : A$
      CALL PUTDATA(ORD(A$))
   NEXT I
   CLOSE #1
   FILE GETSAVENAME F$,"保存BMP,PNGファイル|*.BMP;*.PNG"
   IF F$="" THEN STOP
   IF POS(F$,".")=0 THEN LET F$=F$&".png"
   GSAVE F$
ELSE
   LET ADR=LEN(KEY$)
   PRINT "画像からファイルを抽出します"
   LET NAMESIZE=GETDATA
   LET FILENAME$=""
   FOR I=1 TO NAMESIZE
      LET FILENAME$=FILENAME$&CHR$(GETDATA)
   NEXT I
   PRINT "抽出ファイル名:";FILENAME$
   LET S$=""
   FOR I=1 TO 4
      LET S$=S$&CHR$(GETDATA)
   NEXT I
   LET FSIZE=CVL(S$)
   PRINT "ファイルサイズ:";FSIZE
   FILE GETSAVENAME F$,"抽出ファイル|*.*"
   IF F$="" THEN STOP
   OPEN #1:NAME F$
   ERASE #1
   FOR I=1 TO FSIZE
      PRINT #1:CHR$(GETDATA);
   NEXT I
   CLOSE #1
END IF
END

EXTERNAL  SUB PUTDATA(N)
LET XX=MOD(ADR,XSIZE)
LET YY=INT(ADR/XSIZE)
LET ADR=ADR+1
CALL GETPOINT(XX,YY,R,G,B)
LET R=BITAND(R,BVAL("11111000",2))
LET R=BITOR(R,BITAND(N,BVAL("11100000",2))/32)
LET G=BITAND(G,BVAL("11111000",2))
LET G=BITOR(G,BITAND(N,BVAL("00011100",2))/4)
LET B=BITAND(B,BVAL("11111100",2))
LET B=BITOR(B,BITAND(N,BVAL("00000011",2)))
CALL PSET(XX,YY,R,G,B)
END SUB

EXTERNAL  FUNCTION GETDATA
LET XX=MOD(ADR,XSIZE)
LET YY=INT(ADR/XSIZE)
LET ADR=ADR+1
CALL GETPOINT(XX,YY,R,G,B)
LET GETDATA=BITAND(R,7)*32+BITAND(G,7)*4+BITAND(B,3)
END FUNCTION

EXTERNAL SUB RGB(X,R,G,B)
LET B=MOD(INT(X/65536),256)
LET G=MOD(INT(X/256),256)
LET R=MOD(X,256)
END SUB

EXTERNAL SUB GETPOINT(X,Y,R,G,B)
ASK PIXEL VALUE(X,Y) C
CALL RGB(C,R,G,B)
END SUB

EXTERNAL SUB PSET(X,Y,R,G,B)
SET COLOR COLORINDEX(R/255,G/255,B/255)
PLOT POINTS:X,Y
END SUB

EXTERNAL SUB PICTURELOAD(N$,XSIZE,YSIZE)
CLEAR
SET COLOR MODE "NATIVE"
SET POINT STYLE 1
GLOAD N$
LET XSIZE=PIXELX(1)
LET YSIZE=PIXELY(1)
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB

EXTERNAL FUNCTION MKL$(A)
OPTION CHARACTER BYTE
DECLARE STRING A$,B$,C$,D$
IF A<0 THEN LET A=A+2^32
LET A$=CHR$(MOD(A,256))
LET B$=CHR$(MOD(INT(A/256),256))
LET C$=CHR$(MOD(INT(A/65536),256))
LET D$=CHR$(MOD(INT(A/16777216),256))
LET MKL$=A$&B$&C$&D$
END FUNCTION

EXTERNAL FUNCTION CVL(A$)
OPTION CHARACTER BYTE
DECLARE NUMERIC A
LET A$=LEFT$(A$,4)
LET A=ORD(A$(1:1))+ORD(A$(2:2))*256+ORD(A$(3:3))*256^2+ORD(A$(4:4))*256^3
IF A>=2^31-1 THEN LET A=A-2^32
LET CVL=A
END FUNCTION
 		 

ファイル埋め込み

 投稿者：しばっち  投稿日：2015年 1月29日(木)19時09分20秒
  24bit BMPファイルに限定し、直接読み込んでファイル埋め込みをします。
このプログラムでは処理を分け、判別文字列をキーとして利用します。
キーが一致しないと復元しません。
なお、生成BMPファイルをJPG形式などの不可逆圧縮方式に一旦変換したファイルからは復元できません。
これで、秘蔵ファイルを隠蔽できます(笑)

DECLARE FUNCTION GETDATA
OPTION CHARACTER BYTE
OPTION BASE 0
INPUT  PROMPT "符号化(1) or 復元(2) ":SW
FILE GETNAME F$,"BMPファイル|*.bmp"
IF F$="" THEN STOP
DIM A$(54)
OPEN #1:NAME F$
FOR I=1 TO 54
   CHARACTER INPUT #1:A$(I)
NEXT I
LET BFTYPE$=A$(1)&A$(2)
LET BFSIZE=CVL(A$(3)&A$(4)&A$(5)&A$(6))
LET RESERVED=CVI(A$(7)&A$(8))
LET RESERVED2=CVI(A$(9)&A$(10))
LET OFFSET=CVL(A$(11)&A$(12)&A$(13)&A$(14))
LET HEADERSIZE=CVL(A$(15)&A$(16)&A$(17)&A$(18))
LET XSIZE=CVL(A$(19)&A$(20)&A$(21)&A$(22))
LET YSIZE=CVL(A$(23)&A$(24)&A$(25)&A$(26))
LET PLANE=CVI(A$(27)&A$(28))
LET BITCOLOR=CVI(A$(29)&A$(30))
LET COMPRESS=CVL(A$(31)&A$(32)&A$(33)&A$(34))
IF BFTYPE$<>"BM" AND PLANE<>1 THEN
   PRINT "BMPファイルではありません"
   CLOSE #1
   STOP
END IF
IF HEADERSIZE<>40 AND COMPRESS<>0 AND BITCOLOR<>24 THEN
   PRINT "対応していません"
   CLOSE #1
   STOP
END IF
LET BW=INT((3*XSIZE+3)/4)*4
DIM R$(YSIZE),G$(YSIZE),B$(YSIZE),COL$(BW),V(10)
INPUT  PROMPT "判別キー=":KEY$
PRINT "BMPファイル読み込み中..."
FOR Y=YSIZE-1 TO 0 STEP -1
   LET S=INT((YSIZE-1-Y)/(YSIZE-1)*100)
   IF MOD(S,10)=0 AND V(INT(S/10))=0 THEN
      PRINT S;"%"
      LET V(INT(S/10))=1
   END IF
   FOR I=0 TO BW-1
      CHARACTER INPUT #1:COL$(I)
   NEXT I
   FOR X=0 TO XSIZE-1
      LET R$(Y)=R$(Y)&COL$(3*X+2)
      LET G$(Y)=G$(Y)&COL$(3*X+1)
      LET B$(Y)=B$(Y)&COL$(3*X)
   NEXT  X
NEXT Y
CLOSE #1
LET ADR=0
SELECT CASE SW
CASE 2
   LET D$=""
   FOR I=1 TO LEN(KEY$)
      LET D$=D$&CHR$(GETDATA)
   NEXT I
   IF KEY$<>D$ THEN
      PRINT "判別キーが一致しません"
      STOP
   END IF
   PRINT "画像からファイルを抽出します"
   LET NAMESIZE=GETDATA
   LET FILENAME$=""
   FOR I=1 TO NAMESIZE
      LET FILENAME$=FILENAME$&CHR$(GETDATA)
   NEXT I
   PRINT "抽出ファイル名:";FILENAME$
   LET S$=""
   FOR I=1 TO 4
      LET S$=S$&CHR$(GETDATA)
   NEXT I
   LET FSIZE=CVL(S$)
   PRINT "ファイルサイズ:";FSIZE
   FILE GETSAVENAME F$,"抽出ファイル|*.*"
   IF F$="" THEN STOP
   OPEN #1:NAME F$
   ERASE #1
   FOR I=1 TO FSIZE
      PRINT #1:CHR$(GETDATA);
   NEXT I
   CLOSE #1
CASE 1
   PRINT "任意ファイルを画像ファイルに埋め込みます"
   PRINT XSIZE*YSIZE-(LEN(KEY$)+5+255);"Byteまで"
   FILE GETOPENNAME F$,"埋込ファイル|*.*"
   IF F$="" THEN STOP
   FILE SPLITNAME (F$) PATH$, NAME$, EXT$
   LET NAME$=NAME$&EXT$
   PRINT "埋め込みファイル:";NAME$
   OPEN #1:NAME F$
   ASK #1 : FILESIZE FSIZE
   PRINT "ファイルサイズ:";FSIZE;"Byte"
   IF XSIZE*YSIZE-(LEN(KEY$)+LEN(NAME$)+5)<FSIZE THEN
      PRINT "ファイルが大きすぎます"
      CLOSE #1
      STOP
   END IF
   PRINT "処理中..."
   LET ADR=0
   FOR I=1 TO LEN(KEY$)
      CALL PUTDATA(ORD(KEY$(I:I)))
   NEXT I
   LET NAMESIZE=LEN(NAME$)
   CALL PUTDATA(NAMESIZE)
   FOR I=1 TO NAMESIZE
      CALL PUTDATA(ORD(NAME$(I:I)))
   NEXT I
   LET FSIZE$=MKL$(FSIZE)
   FOR I=1 TO 4
      CALL PUTDATA(ORD(FSIZE$(I:I)))
   NEXT I
   FOR I=1 TO FSIZE
      CHARACTER INPUT #1 : P$
      CALL PUTDATA(ORD(P$))
   NEXT I
   CLOSE #1
   PRINT"BMPファイルに保存します"
   FILE GETSAVENAME F$,"保存BMPファイル|*.bmp"
   IF F$="" THEN STOP
   IF POS(F$,".")=0 THEN LET F$=F$&".bmp"
   LET BFTYPE$="BM"
   LET OFFSET=54
   LET HEADERSIZE=40
   LET PLANE=1
   LET BITCOLOR=24
   LET BW=INT((3*XSIZE+3)/4)*4
   LET BFSIZE=BW*YSIZE+OFFSET
   OPEN #1:NAME F$
   PRINT #1:BFTYPE$;
   PRINT #1:MKL$(BFSIZE);
   PRINT #1:MKI$(0);
   PRINT #1:MKI$(0);
   PRINT #1:MKL$(OFFSET);
   PRINT #1:MKL$(HEADERSIZE);
   PRINT #1:MKL$(XSIZE);
   PRINT #1:MKL$(YSIZE);
   PRINT #1:MKI$(PLANE);
   PRINT #1:MKI$(BITCOLOR);
   PRINT #1:REPEAT$(CHR$(0),24);
   FOR Y=YSIZE-1 TO 0 STEP -1
      FOR X=0 TO XSIZE-1
         LET C$=C$&B$(Y)(X+1:X+1)&G$(Y)(X+1:X+1)&R$(Y)(X+1:X+1)
      NEXT X
      LET C$=LEFT$(C$&REPEAT$(CHR$(0),4),BW)
      PRINT #1:C$;
      LET C$=""
   NEXT Y
   CLOSE #1
CASE ELSE
END SELECT

FUNCTION GETDATA
   LET X=MOD(ADR,XSIZE)
   LET Y=INT(ADR/XSIZE)
   LET ADR=ADR+1
   LET R=ORD(R$(Y)(X+1:X+1))
   LET G=ORD(G$(Y)(X+1:X+1))
   LET B=ORD(B$(Y)(X+1:X+1))
   LET GETDATA=BITAND(R,7)*32+BITAND(G,7)*4+BITAND(B,3)
END FUNCTION

SUB PUTDATA(N)
   LET X=MOD(ADR,XSIZE)
   LET Y=INT(ADR/XSIZE)
   LET ADR=ADR+1
   LET R=ORD(R$(Y)(X+1:X+1))
   LET G=ORD(G$(Y)(X+1:X+1))
   LET B=ORD(B$(Y)(X+1:X+1))
   LET R=BITAND(R,BVAL("11111000",2))
   LET R=BITOR(R,BITAND(N,BVAL("11100000",2))/32)
   LET G=BITAND(G,BVAL("11111000",2))
   LET G=BITOR(G,BITAND(N,BVAL("00011100",2))/4)
   LET B=BITAND(B,BVAL("11111100",2))
   LET B=BITOR(B,BITAND(N,BVAL("00000011",2)))
   LET R$(Y)(X+1:X+1)=CHR$(R)
   LET G$(Y)(X+1:X+1)=CHR$(G)
   LET B$(Y)(X+1:X+1)=CHR$(B)
END SUB
END

EXTERNAL FUNCTION CVI(A$)
OPTION CHARACTER BYTE
DECLARE NUMERIC A
LET A$=LEFT$(A$,2)
LET A=ORD(A$(1:1))+ORD(A$(2:2))*256
IF A>32767 THEN LET A=A-65536
LET CVI=A
END FUNCTION

EXTERNAL FUNCTION CVL(A$)
OPTION CHARACTER BYTE
DECLARE NUMERIC A
LET A$=LEFT$(A$,4)
LET A=ORD(A$(1:1))+ORD(A$(2:2))*256+ORD(A$(3:3))*256^2+ORD(A$(4:4))*256^3
IF A>=2^31-1 THEN LET A=A-2^32
LET CVL=A
END FUNCTION

EXTERNAL FUNCTION MKI$(A)
OPTION CHARACTER BYTE
DECLARE STRING A$,B$
IF A<0 THEN LET A=A+65536
LET A$=CHR$(MOD(A,256))
LET B$=CHR$(INT(A/256))
LET MKI$=A$&B$
END FUNCTION

EXTERNAL FUNCTION MKL$(A)
OPTION CHARACTER BYTE
DECLARE STRING A$,B$,C$,D$
IF A<0 THEN LET A=A+2^32
LET A$=CHR$(MOD(A,256))
LET B$=CHR$(MOD(INT(A/256),256))
LET C$=CHR$(MOD(INT(A/65536),256))
LET D$=CHR$(MOD(INT(A/16777216),256))
LET MKL$=A$&B$&C$&D$
END FUNCTION
 		 

ファイル埋め込み

 投稿者：しばっち  投稿日：2015年 1月29日(木)19時10分7秒
  16bitPCMステレオWAVファイルを直接読み込み、ファイルを埋め込みます。
16bit各左右のデータから下位4bitずつ(=1byte)を利用します。
サンプリング周波数×再生時間(秒)が埋め込み可能なファイルサイズ上限になります。
なお、生成WAVファイルをMP3形式などの不可逆圧縮方式に一旦変換したファイルからは復元できません。

DECLARE FUNCTION GETDATA
OPTION CHARACTER BYTE
DIM A$(30)
FILE GETOPENNAME F$,"WAVファイル|*.wav"
IF F$="" THEN STOP
OPEN #1:NAME F$
FOR I=1 TO 12
   CHARACTER INPUT #1:A$(I)
NEXT I
IF A$(1)&A$(2)&A$(3)&A$(4)<>"RIFF" THEN
   PRINT "WAVファイルではありません"
   CLOSE #1
   STOP
END IF
LET WAVEFILESIZE=CVL(A$(5)&A$(6)&A$(7)&A$(8))
IF A$(9)&A$(10)&A$(11)&A$(12)<>"WAVE" THEN
   PRINT "WAVファイルではありません"
   CLOSE #1
   STOP
END IF
DO
   FOR I=1 TO 4
      CHARACTER INPUT #1:A$(I)
   NEXT I
   SELECT CASE A$(1)&A$(2)&A$(3)&A$(4)
   CASE "fmt "
      FOR I=1 TO 4
         CHARACTER INPUT #1:A$(I)
      NEXT I
      LET HEADERSIZE=CVL(A$(1)&A$(2)&A$(3)&A$(4))
      FOR I=1 TO HEADERSIZE
         CHARACTER INPUT #1:A$(I)
      NEXT I
      LET WAVETYPE=CVI(A$(1)&A$(2))
      IF WAVETYPE<>1 THEN
         PRINT "対応していません"
         CLOSE #1
         STOP
      END IF
      LET CHANNEL=CVI(A$(3)&A$(4))
      IF CHANNEL<>2 THEN
         PRINT "ステレオではありません"
         CLOSE #1
         STOP
      END IF
      LET SAMPLINGFREQ=CVL(A$(5)&A$(6)&A$(7)&A$(8))
      LET DATARATE=CVL(A$(9)&A$(10)&A$(11)&A$(12))
      LET SAMPLESIZE=CVI(A$(13)&A$(14))
      LET SAMPLEBIT=CVI(A$(15)&A$(16))
      IF SAMPLEBIT<>16 THEN
         PRINT "16bit PCMではありません"
         CLOSE #1
         STOP
      END IF
   CASE "data"
      FOR I=1 TO 4
         CHARACTER INPUT #1:A$(I)
      NEXT I
      LET  PCMSIZE=CVL(A$(1)&A$(2)&A$(3)&A$(4))
      LET  SECOND=PCMSIZE/DATARATE
      EXIT DO
   CASE "fact"
      FOR I=1 TO 8
         CHARACTER INPUT #1:A$(I)
      NEXT I
      !'LET  SIZE=CVL(A$(1)&A$(2)&A$(3)&A$(4))
      !'LET  PCMSIZE=CVL(A$(5)&A$(6)&A$(7)&A$(8))
   CASE ELSE
      PRINT "対応していません"
      CLOSE #1
      STOP
   END SELECT
LOOP
PRINT "サンプリング周波数";SAMPLINGFREQ;"Hz"
PRINT "演奏時間";SECOND;"秒"
LET NUM=PCMSIZE/SAMPLESIZE
LET HEADERSIZE=16
LET SAMPLESIZE=SAMPLEBIT/8*CHANNEL
LET DATARATE = SAMPLESIZE * SAMPLINGFREQ
LET PCMSIZE=NUM*SAMPLESIZE
LET WAVEFILESIZE=PCMSIZE+36
INPUT  PROMPT "符号化(1) or 復元(2) ":SW
INPUT  PROMPT "判別キー=":KEY$
SELECT CASE SW
CASE 2
   LET D$=""
   FOR I=1 TO LEN(KEY$)
      LET D$=D$&CHR$(GETDATA)
   NEXT I
   IF KEY$<>D$ THEN
      PRINT "判別キーが一致しません"
      STOP
   END IF
   PRINT "WAVファイルからファイルを抽出します"
   LET NAMESIZE=GETDATA
   LET FILENAME$=""
   FOR I=1 TO NAMESIZE
      LET FILENAME$=FILENAME$&CHR$(GETDATA)
   NEXT I
   PRINT "抽出ファイル名:";FILENAME$
   LET S$=""
   FOR I=1 TO 4
      LET S$=S$&CHR$(GETDATA)
   NEXT I
   LET FSIZE=CVL(S$)
   PRINT "ファイルサイズ:";FSIZE
   FILE GETSAVENAME F$,"抽出ファイル|*.*"
   IF F$="" THEN STOP
   OPEN #2:NAME F$
   ERASE #2
   FOR I=1 TO FSIZE
      PRINT #2:CHR$(GETDATA);
   NEXT I
   CLOSE #2
   CLOSE #1
CASE 1
   PRINT "任意ファイルをWAVファイルに埋め込みます"
   PRINT SAMPLINGFREQ*SECOND-(LEN(KEY$)+5+255);"Byteまで"
   FILE GETNAME F$,"埋め込みファイル|*.*"
   IF F$="" THEN STOP
   FILE SPLITNAME (F$) PATH$, NAME$, EXT$
   LET NAME$=NAME$&EXT$
   PRINT "埋め込みファイル:";NAME$
   OPEN #2:NAME F$
   ASK #2 : FILESIZE FSIZE
   PRINT "ファイルサイズ:";FSIZE;"Byte"
   IF SAMPLINGFREQ*SECOND-(LEN(KEY$)+LEN(NAME$)+5)<FSIZE THEN
      PRINT "ファイルが大き過ぎます。"
      CLOSE #2
      CLOSE #1
      STOP
   END IF
   FILE GETSAVENAME F$,"保存WAVファイル|*.wav"
   IF F$="" THEN STOP
   IF POS(F$,".")=0 THEN LET F$=F$&".wav"
   OPEN #3:NAME F$
   PRINT #3:"RIFF";
   PRINT #3:MKL$(WAVEFILESIZE);
   PRINT #3:"WAVEfmt ";
   PRINT #3:MKL$(HEADERSIZE);
   PRINT #3:MKI$(WAVETYPE);
   PRINT #3:MKI$(CHANNEL);
   PRINT #3:MKL$(SAMPLINGFREQ);
   PRINT #3:MKL$(DATARATE);
   PRINT #3:MKI$(SAMPLESIZE);
   PRINT #3:MKI$(SAMPLEBIT);
   PRINT #3:"data";
   PRINT #3:MKL$(PCMSIZE);
   FOR I=1 TO LEN(KEY$)
      CALL PUTDATA(ORD(KEY$(I:I)))
   NEXT I
   LET NAMESIZE=LEN(NAME$)
   CALL PUTDATA(NAMESIZE)
   FOR I=1 TO NAMESIZE
      CALL PUTDATA(ORD(NAME$(I:I)))
   NEXT I
   LET FSIZE$=MKL$(FSIZE)
   FOR I=1 TO 4
      CALL PUTDATA(ORD(FSIZE$(I:I)))
   NEXT I
   FOR I=1 TO FSIZE
      CHARACTER INPUT #2 : P$
      CALL PUTDATA(ORD(P$))
   NEXT I
   DO
      CHARACTER INPUT #1,IF MISSING THEN EXIT DO : P$
      PRINT #3:P$;
   LOOP
   CLOSE #1
   CLOSE #2
   CLOSE #3
CASE ELSE
END SELECT

FUNCTION GETDATA
   CHARACTER INPUT #1:Z$
   LET L$=Z$
   CHARACTER INPUT #1:Z$
   LET L$=L$&Z$
   CHARACTER INPUT #1:Z$
   LET R$=Z$
   CHARACTER INPUT #1:Z$
   LET R$=R$&Z$
   LET L=CVI(L$)
   LET R=CVI(R$)
   LET GETDATA=BITAND(L,15)*16+BITAND(R,15)
END FUNCTION

SUB PUTDATA(N)
   CHARACTER INPUT #1:Z$
   LET L$=Z$
   CHARACTER INPUT #1:Z$
   LET L$=L$&Z$
   CHARACTER INPUT #1:Z$
   LET R$=Z$
   CHARACTER INPUT #1:Z$
   LET R$=R$&Z$
   LET L=CVI(L$)
   LET R=CVI(R$)
   LET L=BITAND(R,BVAL("1111111111110000",2))
   LET L=BITOR(L,BITAND(N,BVAL("11110000",2))/16)
   LET R=BITAND(R,BVAL("1111111111110000",2))
   LET R=BITOR(R,BITAND(N,BVAL("00001111",2)))
   PRINT #3:MKI$(L);MKI$(R);
END SUB
END

EXTERNAL FUNCTION CVI(A$)
OPTION CHARACTER BYTE
DECLARE NUMERIC A
LET A=ORD(A$(1:1))+ORD(A$(2:2))*256
IF A>32767 THEN LET A=A-65536
LET CVI=A
END FUNCTION

EXTERNAL FUNCTION CVL(A$)
OPTION CHARACTER BYTE
DECLARE NUMERIC A
LET A=ORD(A$(1:1))+ORD(A$(2:2))*256+ORD(A$(3:3))*256^2+ORD(A$(4:4))*256^3
IF A>=2^31-1 THEN LET A=A-2^32
LET CVL=A
END FUNCTION

EXTERNAL FUNCTION MKI$(X)
OPTION CHARACTER BYTE
DECLARE STRING A$,B$
LET A=INT(X)
IF A<0 THEN LET A=A+65536
LET A$=CHR$(MOD(A,256))
LET B$=CHR$(INT(A/256))
LET MKI$=A$&B$
END FUNCTION

EXTERNAL FUNCTION MKL$(X)
OPTION CHARACTER BYTE
DECLARE STRING A$,B$,C$,D$
LET A=INT(X)
IF A<0 THEN LET A=A+2^32
LET A$=CHR$(MOD(A,256))
LET B$=CHR$(MOD(INT(A/256),256))
LET C$=CHR$(MOD(INT(A/65536),256))
LET D$=CHR$(MOD(INT(A/16777216),256))
LET MKL$=A$&B$&C$&D$
END FUNCTION
 		 

戻る