新しく発言する EXIT インデックスへ

構造体、レコード型でのバイナリファイルへ...

　　構造体、レコード型でのバイナリファイルへのアクセス 山中和義 2008/02/29 20:42:14  (修正1回)
　　└つづき 山中和義 2008/02/29 20:42:55  (修正1回)
　　　└つづき（構造体、レコード型サポート関連） 山中和義 2008/02/29 20:44:04  (修正2回)
　　　　└つづき（構造体定義部分） 山中和義 2008/02/29 20:46:12  (修正1回)
　　　　　└つづき 山中和義 2008/02/29 20:49:03  (修正1回)
　　　　　　├ネストする構造体の場合（親子関係） 山中和義 2008/03/03 13:19:43  (修正2回)
　　　　　　└SUBStructDefの構造 山中和義 2008/03/04 10:48:06  (修正1回)

　　構造体、レコード型でのバイナリファイルへのアクセス 山中和義 2008/02/29 20:42:14  (修正1回)  ツリーへ
構造体、レコード型でのバイナリファイルへのアクセス 返事を書く ノートメニュー
山中和義 <drdlxujciw> 2008/02/29 20:42:14 ** この記事は1回修正されてます
!BMPファイル（圧縮なし）のデータを数値表示する　　参考 http://www.kk.iij4u.or.jp/~kondo/bmp/

OPTION CHARACTER byte

LET BFile$=StructDim$("BITMAPFILEHEADER") !Dim BFile As BITMAPFILEHEADER
LET BInfo$=StructDim$("BITMAPINFOHEADER") !Dim BInfo As BITMAPINFOHEADER
LET BPalt$=StructDim$("RGBQUAD") !Dim BPalt As RGBQUAD


file getname f$,"BMPファイル|*.BMP" !ファイル名を得る
IF f$="" THEN STOP


OPEN #1: NAME f$, ACCESS INPUT
LET cp=0 !読み込み現在位置

!---------- ファイルヘッダ部
LET p=0 !読み込み位置
CALL fseek(p) !Get #1,0,BFile　※VisualBasic
CALL fread(BFile$,p)

PRINT GetValOf$(BFile$,"BITMAPFILEHEADER","bfType") !BFile.bfType
LET bfSize=GetValOf(BFile$,"BITMAPFILEHEADER","bfSize") !BFile.bfSize
PRINT bfSize
PRINT GetValOf(BFile$,"BITMAPFILEHEADER","bfReserved1")
PRINT GetValOf(BFile$,"BITMAPFILEHEADER","bfReserved2")
LET bfOffBits=GetValOf(BFile$,"BITMAPFILEHEADER","bfOffBits")
PRINT bfOffBits
PRINT


!---------- 情報ヘッダ部（Windows Bitmap）
CALL fread(BInfo$,p) !Get #1, ,BInfo

PRINT GetValOf(BInfo$,"BITMAPINFOHEADER","biSize")
LET biWidth=GetValOf(BInfo$,"BITMAPINFOHEADER","biWidth")
PRINT biWidth
LET biHeight=GetValOf(BInfo$,"BITMAPINFOHEADER","biHeight")
PRINT biHeight
PRINT GetValOf(BInfo$,"BITMAPINFOHEADER","biPlanes")
LET biBitCount=GetValOf(BInfo$,"BITMAPINFOHEADER","biBitCount")
PRINT biBitCount
LET biCompression=GetValOf(BInfo$,"BITMAPINFOHEADER","biCompression")
PRINT biCompression
PRINT GetValOf(BInfo$,"BITMAPINFOHEADER","biSizeImage")
PRINT GetValOf(BInfo$,"BITMAPINFOHEADER","biXPelsPerMeter")
PRINT GetValOf(BInfo$,"BITMAPINFOHEADER","biYPelsPerMeter")
PRINT GetValOf(BInfo$,"BITMAPINFOHEADER","biClrUsed")
PRINT GetValOf(BInfo$,"BITMAPINFOHEADER","biClrImportant")
PRINT


!---------- 情報ヘッダ部（パレット部）
IF biBitCount<=8 THEN
FOR k=0 TO 2^biBitCount-1
CALL fread(BPalt$,p) !Get #1, ,BPalt

PRINT USING "### 番　": k;
PRINT GetValOf2(BPalt$,"RGBQUAD","rgbBlue"), !BPalt　※符号なし
PRINT GetValOf2(BPalt$,"RGBQUAD","rgbGreen"),
PRINT GetValOf2(BPalt$,"RGBQUAD","rgbRed"),
PRINT GetValOf2(BPalt$,"RGBQUAD","rgbReserved")
NEXT k
END IF
PRINT


IF biCompression<>0 THEN
PRINT "圧縮形式は未サポートです。"
STOP
END IF
 
　　└つづき 山中和義 2008/02/29 20:42:55  (修正1回)  ツリーへ
Re: 構造体、レコード型でのバイナリファイルへのアクセス 返事を書く ノートメニュー
山中和義 <drdlxujciw> 2008/02/29 20:42:55 ** この記事は1回修正されてます
つづき


!---------- 画像データ部
LET p=bfOffBits !ファイル内の画像データの先頭位置
CALL fseek(p)

FOR y=1 TO biHeight
SELECT CASE biBitCount
CASE 1,4
LET t=biWidth*biBitCount/8
IF MOD(t,4)>0 THEN LET t=t+4-MOD(t,4) !４バイト境界

LET BData$=REPEAT$(CHR$(0),t) !１行分の画像データ
CALL fread(BData$,p) !Get #1, ,BData

FOR x=0 TO t-1
PRINT "(";8/biBitCount*x+1;",";y;")",
LET b=CVI2(BData$,x,SizeOf("Byte",""))
IF biBitCount=1 THEN
PRINT right$("0000000"&BSTR$(b,2),8)
ELSE
PRINT INT(b/16); !上4bit
PRINT MOD(b,16) !下4bit
END IF
NEXT x

CASE ELSE
FOR x=1 TO biWidth !１行分の画像データ
LET BData$=REPEAT$(CHR$(0),biBitCount/8) !１ピクセル分の画像データ
CALL fread(BData$,p) !Get #1, ,BData

PRINT "(";x;",";y;")",
FOR k=0 TO biBitCount/8-1 !256,24ビット,32ビット色
PRINT CVI2(BData$,k,SizeOf("Byte","")); !BData　※符号なし
NEXT k
PRINT
NEXT x

LET t=MOD(biWidth*biBitCount/8,4) !４バイト境界　※32ビット色は必要なし
IF t>0 THEN
FOR k=t+1 TO 4
LET dummy$=CHR$(0)
CALL fread(dummy$,p) !Get #1, ,dummy
PRINT CVI(dummy$,0,SizeOf("Byte",""));
PRINT
NEXT k
END IF

END SELECT
NEXT y


CLOSE #1


!ファイル関連
SUB fseek(p) !読み込み位置を設定する
IF p<cp THEN !前へ
SET #1: POINTER BEGIN
LET cp=0
END IF
FOR i=1 TO p-cp !skip it
CHARACTER INPUT #1: tmp$
NEXT i
LET cp=p !現在位置の更新
END SUB
SUB fread(r$,p) !レコードを読み込む
FOR i=1 TO LEN(r$) !read it
CHARACTER INPUT #1: r$(i:i)
NEXT i
LET p=p+LEN(r$) !現在位置の更新
LET cp=p
END SUB

END
 
　　　└つづき（構造体、レコード型サポート関連） 山中和義 2008/02/29 20:44:04  (修正2回)  ツリーへ
Re: つづき 返事を書く ノートメニュー
山中和義 <drdlxujciw> 2008/02/29 20:44:04 ** この記事は2回修正されてます
つづき（構造体、レコード型サポート関連）


!構造体、レコード型サポート関連

EXTERNAL FUNCTION CVI(s$,p,m) !文字列に埋め込まれたm*8ビット符号付き整数を取り出す
OPTION CHARACTER byte
LET n=0
FOR i=1 TO m
LET n=n+256^(i-1)*ORD(s$(p+i:p+i))
NEXT i
IF n<2^(m*8-1) THEN LET CVI=n ELSE LET CVI=n-2^(m*8)
END FUNCTION
EXTERNAL FUNCTION CVI2(s$,p,m) !文字列に埋め込まれたm*8ビット符号なし整数を取り出す
OPTION CHARACTER byte
LET n=0
FOR i=1 TO m
LET n=n+256^(i-1)*ORD(s$(p+i:p+i))
NEXT i
LET CVI2=n
END FUNCTION

EXTERNAL FUNCTION MKI$(n,m) !m*8ビット整数nを文字列変数に埋め込む
OPTION CHARACTER byte
LET r=MOD(n,256) !2^8
LET s$=CHR$(r)
FOR i=1 TO m-1
LET n=(n-r)/256
LET r=MOD(n,256)
LET s$=s$ & CHR$(r)
NEXT i
LET MKI$=s$
END FUNCTION


EXTERNAL FUNCTION StructDim$(strct$) !文字列を構造体として定義する
LET StructDim$=REPEAT$(CHR$(0),SizeOf(strct$,""))
END FUNCTION

EXTERNAL FUNCTION SizeOf(strct$,mem$) !メンバ変数の大きさを得る
SELECT CASE UCASE$(strct$)
CASE "BYTE" !数値型
LET SizeOf=1 !バイト数
CASE "INTEGER","WORD"
LET SizeOf=2
CASE "LONG","DWORD"
LET SizeOf=4

CASE ELSE
IF UCASE$(strct$(1:7))="STRING*" THEN !文字型　String*?
LET SizeOf=VAL(strct$(8:LEN(strct$)))

ELSE !構造体、レコード型
CALL StructDef(strct$,mem$, ofst,sz)
IF mem$="" THEN LET SizeOf=ofst ELSE LET SizeOf=sz !メンバ変数名がなければ構造体の大きさ

END IF
END SELECT
END FUNCTION

EXTERNAL FUNCTION OffsetOf(strct$,mem$) !メンバ変数の位置を得る
OPTION CHARACTER byte
CALL StructDef(strct$,mem$, ofst,sz)
LET OffsetOf=ofst
END FUNCTION

EXTERNAL FUNCTION GetValOf(s$,strct$,mem$) !メンバ変数の値を得る
OPTION CHARACTER byte
CALL StructDef(strct$,mem$, ofst,sz)
LET GetValOf=CVI(s$,ofst,sz)
END FUNCTION
EXTERNAL FUNCTION GetValOf2(s$,strct$,mem$)
OPTION CHARACTER byte
CALL StructDef(strct$,mem$, ofst,sz)
LET GetValOf2=CVI2(s$,ofst,sz)
END FUNCTION

EXTERNAL FUNCTION GetValOf$(s$,strct$,mem$) !メンバ変数の値を得る（文字型）
OPTION CHARACTER byte
CALL StructDef(strct$,mem$, ofst,sz)
LET GetValOf$=s$(ofst+1:ofst+sz)
END FUNCTION

EXTERNAL SUB SetValOf(s$,strct$,mem$, v) !メンバ変数の値を設定する
OPTION CHARACTER byte
CALL StructDef(strct$,mem$, ofst,sz)
LET s$(ofst+1:ofst+sz)=MKI$(v,sz)
END SUB

EXTERNAL SUB StructAdd(strct$,mem$, ofst) !親の構造体の位置を得る
CALL StructDef(strct$,mem$, ofst1,sz)
LET ofst=ofst+ofst1
END SUB
 
　　　　└つづき（構造体定義部分） 山中和義 2008/02/29 20:46:12  (修正1回)  ツリーへ
Re: つづき（構造体、レコード型サポート関連） 返事を書く ノートメニュー
山中和義 <drdlxujciw> 2008/02/29 20:46:12 ** この記事は1回修正されてます
つづき（構造体定義部分）


EXTERNAL SUB StructDef(s$,m$, ofst,sz) !メンバ変数の位置と大きさを得るために構造体を定義する
IF m$<>"" THEN PRINT s$;".";m$;" ="; !※

LET mm$=UCASE$(m$)
SELECT CASE UCASE$(s$)

CASE "BITMAPFILEHEADER"

!Type BITMAPFILEHEADER '14byte
! bfType As String*2 'ファイル識別子 "BM"
! bfSize As Long 'ファイルのサイズ
! bfReserved1 As Integer '未使用
! bfReserved2 As Integer '未使用
! bfOffBits As Long 'ピクセルデータの開始位置
!End Type

LET ofst=0

LET sz=SizeOf("String*2","")
IF mm$=UCASE$("bfType") THEN EXIT SUB
LET ofst=ofst+sz

LET sz=SizeOf("Long","")
IF mm$=UCASE$("bfSize") THEN EXIT SUB
LET ofst=ofst+sz

LET sz=SizeOf("Integer","")
IF mm$=UCASE$("bfReserved1") THEN EXIT SUB
LET ofst=ofst+sz

LET sz=SizeOf("Integer","")
IF mm$=UCASE$("bfReserved2") THEN EXIT SUB
LET ofst=ofst+sz

LET sz=SizeOf("Long","")
IF mm$=UCASE$("bfOffBits") THEN EXIT SUB
LET ofst=ofst+sz

IF m$<>"" THEN
PRINT m$;" は ";s$;" のメンバ変数ではありません。"
STOP
END IF


CASE "BITMAPINFOHEADER"

!Type BITMAPINFOHEADER '40byte
! biSize As Long 'ヘッダーのサイズ
! biWidth As Long '幅(ピクセル単位)
! biHeight As Long '高さ(ピクセル単位)
! biPlanes As Integer '常に１
! biBitCount As Integer '1ピクセルあたりのカラービット数
! biCompression As Long '圧縮方法
! biSizeImage As Long 'ピクセルデータの全バイト数
! biXPelsPerMeter As Long '0または水平解像度
! biYPelsPerMeter As Long '0または垂直解像度
! biClrUsed As Long '通常は0
! biClrImportant As Long '通常は0
!End Type

LET ofst=0

LET sz=SizeOf("Long","")
IF mm$=UCASE$("biSize") THEN EXIT SUB
LET ofst=ofst+sz

LET sz=SizeOf("Long","")
IF mm$=UCASE$("biWidth") THEN EXIT SUB
LET ofst=ofst+sz

LET sz=SizeOf("Long","")
IF mm$=UCASE$("biHeight") THEN EXIT SUB
LET ofst=ofst+sz

LET sz=SizeOf("Integer","")
IF mm$=UCASE$("biPlanes") THEN EXIT SUB
LET ofst=ofst+sz

LET sz=SizeOf("Integer","")
IF mm$=UCASE$("biBitCount") THEN EXIT SUB
LET ofst=ofst+sz

LET sz=SizeOf("Long","")
IF UCASE$(m$)=UCASE$("biCompression") THEN EXIT SUB
LET ofst=ofst+sz

LET sz=SizeOf("Long","")
IF mm$=UCASE$("biSizeImage") THEN EXIT SUB
LET ofst=ofst+sz

 
　　　　　└つづき 山中和義 2008/02/29 20:49:03  (修正1回)  ツリーへ
Re: つづき（構造体定義部分） 返事を書く ノートメニュー
山中和義 <drdlxujciw> 2008/02/29 20:49:03 ** この記事は1回修正されてます
つづき




LET sz=SizeOf("Long","")
IF mm$=UCASE$("biXPelsPerMeter") THEN EXIT SUB
LET ofst=ofst+sz

LET sz=SizeOf("Long","")
IF mm$=UCASE$("biYPelsPerMeter") THEN EXIT SUB
LET ofst=ofst+sz

LET sz=SizeOf("Long","")
IF mm$=UCASE$("biClrUsed") THEN EXIT SUB
LET ofst=ofst+sz

LET sz=SizeOf("Long","")
IF mm$=UCASE$("biClrImportant") THEN EXIT SUB
LET ofst=ofst+sz

IF m$<>"" THEN
PRINT m$;" は ";s$;" のメンバ変数ではありません。"
STOP
END IF


CASE "RGBQUAD"

!Type RGBQUAD '4byte
! rgbBlue As Byte '青の濃さ
! rgbGreen As Byte '緑の濃さ
! rgbRed As Byte '赤の濃さ
! rgbReserved As Byte '未使用(常に0)
!End Type

LET ofst=0

LET sz=SizeOf("Byte","")
IF mm$=UCASE$("rgbBlue") THEN EXIT SUB
LET ofst=ofst+sz

LET sz=SizeOf("Byte","")
IF mm$=UCASE$("rgbGreen") THEN EXIT SUB
LET ofst=ofst+sz

LET sz=SizeOf("Byte","")
IF mm$=UCASE$("rgbRed") THEN EXIT SUB
LET ofst=ofst+sz

LET sz=SizeOf("Byte","")
IF mm$=UCASE$("rgbReserved") THEN EXIT SUB
LET ofst=ofst+sz

IF m$<>"" THEN
PRINT m$;" は ";s$;" のメンバ変数ではありません。"
STOP
END IF


CASE ELSE
PRINT s$;" は未定義なデータ型です。"
STOP
END SELECT
END SUB

 
　　　　　　├ネストする構造体の場合（親子関係） 山中和義 2008/03/03 13:19:43  (修正2回)  ツリーへ
Re: つづき 返事を書く ノートメニュー
山中和義 <drdlxujciw> 2008/03/03 13:19:43 ** この記事は2回修正されてます
ネストする構造体の場合（親子関係）

●構造体0.変数1.変数2. … .変数N . メンバ変数 の参照

VisualBasicの文法で記述すると、

Type 構造体0
　　:
　変数1 As 構造体1
　　:
End Type
Type 構造体1
　　:
　変数2 As 構造体2
　　:
End Type

　　:
　　:

Type 構造体N-1
　　:
　変数N As 構造体N
　　:
End Type
Type 構造体N
　　:
　メンバ変数 As 基本データ型
　　:
End Type

Dim 変数 As 構造体0

と定義されている場合である。

参照例は、
　Print 変数.変数1.変数2. … .変数N.メンバ変数
とか
　With 変数.変数1.変数2. … .変数N
　　Print .メンバ変数
　End With
となる。



本サポートサブルーチンでは、

!定義部分
LET 変数$=structDim$("構造体0") !Dim 変数 As 構造体0

　:
　:



!位置算出部分
LET ofst1=0 !With 変数.変数1.変数2. … .変数N
CALL StructAdd("構造体0","変数1", ofst1) !親
CALL StructAdd("構造体1","変数2", ofst1)
　:
CALL StructAdd("構造体N-1","変数N", ofst1)

CALL StructDef("構造体N","メンバ変数", ofst2,sz) !.メンバ変数
LET ofst=ofst1 + ofst2 !親からの絶対位置


!参照部分
PRINT CVI(変数$,ofst,sz) !Print 変数.変数1.変数2.….変数N.メンバ変数


とすればよい。
 
　　　　　　└SUBStructDefの構造 山中和義 2008/03/04 10:48:06  (修正1回)  ツリーへ
Re: つづき 返事を書く ノートメニュー
山中和義 <drdlxujciw> 2008/03/04 10:48:06 ** この記事は1回修正されてます
SUB StructDef の構造

VisualBasic文法の構造体定義を機械的にコンバートする。
また、アライメントを考慮する場合は展開する必要があります。



EXTERNAL SUB StructDef(s$,m$, ofst,sz) !メンバ変数の位置と大きさを得るために構造体を定義する
!!!DEF align(x,s)=(INT((x-1)/s)+1)*s !<----- アライメント ※sバイト境界

IF m$<>"" THEN PRINT s$;".";m$;" ="; !※

LET mm$=UCASE$(m$)
SELECT CASE UCASE$(s$)

CASE "構造体1" !Type 構造体1　※構造体単位に

!Type 構造体1
! 変数1 As データ型1
! 変数2 As データ型2
!　　:
!　　:
! 変数N As データ型N
!End Type

　LET ofst=0

　LET sz=SizeOf("データ型1","") !変数1 As データ型1　※変数単位に
　IF mm$=UCASE$("変数1") THEN EXIT SUB
　LET ofst=ofst+sz

　LET sz=SizeOf("データ型2","") !変数2 As データ型2
　!!!LET ofst=align(ofst,sz) !<----- szバイト領域　※各メンバ変数に対して
　IF mm$=UCASE$("変数2") THEN EXIT SUB
　LET ofst=ofst+sz

　　:
　　:

　LET sz=SizeOf("データ型N","") !変数N As データ型N
　IF mm$=UCASE$("変数N") THEN EXIT SUB
　LET ofst=ofst+sz

　!!!LET ofst=align(ofst,4) !<----- ４バイト領域　※構造体全体に対して


　IF m$<>"" THEN !End Type
　PRINT m$;" は ";s$;" のメンバ変数ではありません。"
　STOP
　END IF


CASE "構造体2" !※他にあれば同様に続ける

　　:
　　:



CASE ELSE
　PRINT s$;" は未定義なデータ型です。"
　STOP
END SELECT
END SUB

インデックスへ EXIT
新規発言を反映させるにはブラウザの更新ボタンを押してください。