おやじプログラマー日記 : BHT-BASIC4.0:データファイルの取り扱いについてその２（書込み・読込みの実用的な関数）

データファイルの書き込み、読み込みの処理を行う場合、その処理を行うそれぞれの場所で PUT命令 、 GET命令 を行うのも冗長なので、通常は関数化してそれをコールします。

今回テストデータファイルとして以下の2個のフィールドを持つファイルを想定します。

・第1フィールド：コードデータ（16バイト）
・第2フィールド：数量データ（12バイト）

FIELD命令 は以下の様になります。
フィールドサイズをわざわざCONST命令で定義していますが、この後でこれを有効に使います。フィールドサイズをどこかで定義しておけば、リテラルで FIELD命令 に記述するよりはソースがわかりやすと思います。

■書き込み関数について

データファイルに書き込む関数を以下の様に定義します。

Const GcTEST.DAT$ = "TEST.DAT"
'---------------------------------------
'データ書込
'---------------------------------------
'Function MfPutData%(Byval pstrCD$, Byval plngNum&, Byval plngRecNo&)
'引　数：
'	pstrCD$		:コード
'	pdblVal$	:数量
'	plngRecNo&	:レコードNO(0:レコード追加)
'戻り値:
'	MfPutData%	:書込OK:GcTrue%, NG:GcFalse%
'---------------------------------------
	Function MfPutData%(Byval pstrCD$, Byval plngNum&, Byval plngRecNo&)
		'エラー処理宣言
		On Error Goto MfPutData.ErrProc
		'フィールドサイズ
		Const COL.CD% = 16
		Const COL.NUM% = 12
		'戻り値の初期化
		MfPutData% = GcFalse%
		PRIVATE FILENO%, REC.CD$, REC.NUM$
		FILENO% = 0
		'TEST.DATファイルを、ファイル番号#1としてオープンします
		FILENO% = 1
		OPEN GcTEST.DAT$ AS FILENO% RECORD 2147483647
		FIELD #FILENO%, COL.CD% AS REC.CD$, COL.NUM% AS REC.NUM$
		'フィールドへデータ設定
		REC.CD$  = LEFT$(pstrCD$ + GfSpc$(COL.CD%), COL.CD%)	'既定の桁数分スペースを付加
		REC.NUM$ = RIGHT$(GfSpc$(COL.NUM%) + STR$(plngNum&), COL.NUM%)	'既定の桁数分スペースを付加

If plngRecNo& = 0 Then
			'レコードNOが０の場合,レコードの最後尾に追加
			PUT FILENO%
		Else
			'レコードNOが指定された場合,レコードの上書
			PUT FILENO%, plngRecNo&
		Endif
		'正常を返す
		MfPutData% = GcTrue%
MfPutData.Return	'関数戻り
		If FILENO% > 0 Then
			Close FILENO%
		Endif
		On Error Goto 0
		Exit Function
'-----
'エラー処理
'-----
MfPutData.ErrProc
		Resume MfPutData.Return
	End Function

フィールド変数に値を設定するところで、コードデータは右側に空白を付加してサイズ分のみ設定しています。また、数値は文字列化後、左側にに空白を付加してサイズ分のみ設定しています。

レコード番号の指定が０の場合は、ファイルの最後尾に追加書込みし、番号が呈されている場合はその番号で上書きします。

■読み込み関数について

データファイルに書き込む関数を以下の様に定義します。

'---------------------------------------
'データ読込
'---------------------------------------
'Function MfGetData%(Byref pstrCD$, Byref plngNum&, Byval plngRecNo&)
'引　数：
'	pstrCD$		:コード
'	pdblVal$	:数量
'	plngRecNo&	:レコードNO
'戻り値:
'	MfGetData%	:読込OK:GcTrue%, NG:GcFalse%
'---------------------------------------
	Function MfGetData%(Byref pstrCD$, Byref plngNum&, Byval plngRecNo&)
		'エラー処理宣言
		On Error Goto MfGetData.ErrProc
		'フィールドサイズ
'		Const COL.CD% = 10	'上の関数[MfPutData%]で定義済み
'		Const COL.NUM% = 26
		'戻り値の初期化
		MfGetData% = GcFalse%

PRIVATE FILENO%, REC.CD$, REC.NUM$
		FILENO% = 0
		'TEST.DATファイルを、ファイル番号#1としてオープンします
		FILENO% = 1
		OPEN GcTEST.DAT$ AS FILENO% RECORD 2147483647
		FIELD #FILENO%, COL.CD% AS REC.CD$, COL.NUM% AS REC.NUM$
		IF plngRecNo& <= LOF(#FILENO%) THEN
			'レコード数MAXを超えてはいない
			'読込
			GET FILENO%, plngRecNo&
			
			'値を返す
			pstrCD$ = GfTrim$(REC.CD$)	'コード
			plngNum& = VAL(GfTrim$(REC.NUM$))	'数量

'正常を返す
			MfGetData% = GcTrue%
		ENDIF
MfGetData.Return	'関数戻り
		If FILENO% > 0 Then
			Close FILENO%
		Endif
		On Error Goto 0
		Exit Function
'-----
'エラー処理
'-----
MfGetData.ErrProc
		Resume MfGetData.Return
	End Function

フィールド変数から値を返す変数に設定するところで、 GfTrim$ ユーザ関数で前後の空白を省いています。
レコード書込関数も読込関数もエラー処理では何もしていませんが、エラー内容等を表示することも必要ではと思いますので、実際のシステムで利用される方はご自身で追加してみて下さい。

尚、これらの関数を利用してテストしてみます。以下のソースにテスト処理を記述します。

このソースの実行結果は以下の図の様になります。