VB.NET-TIPS などプログラミングについて

前回使用した拡張関数 ファイル情報提供関数(FILE.FN3) を利用して、 データファイルの存在確認を行う関数を作ってみます。

尚、この拡張関数の1番目の機能である .fcInfGetF(指定されたファイルの情報の獲得) を 使いますが、これの説明は以下の記事にありますので、参照して下さい。

データファイルの削除等について（KILL、CLFILEのラッパ関数）

この拡張関数を使用した、ファイル存在確認関数は以下の様になります。

'---------------------------------------
'ファイル存在チェック関数
'---------------------------------------
'Function GfFileExist%(Byval pstrFileName$)
'引　数：
'	pstrFileName$:ファイル名
'戻り値:
'	GfFileExist%	:存在OK:GcTrue%, NG:GcFalse%
'---------------------------------------
	Function GfFileExist%(Byval pstrFileName$)
		'エラー処理宣言
		On Error Goto GfFileExist.ErrProc

		Private INF$
		INF$ = GfSpc$(40)		' 40 文字分の領域を確保
		CALL "FILE.FN3" .fcInfGetF pstrFileName$,INF$
		If INF$ = "" Then
			'NULL文字はファイルが存在しない
			GfIsNum% = GcFalse%
		Else
			GfIsNum% = GcTrue%
		End If

GfFileExist.Return	'関数戻り
		On Error Goto 0
		Exit Function
'-----
'エラー処理
'-----
GfFileExist.ErrProc
		GfFileExist% = GcFalse%
		Resume GfFileExist.Return
	End Function

ファイル情報の結果が返される文字列変数（INF$）の内容がNULLであれば、ファイルが存在しないことを示しています。



=====
2016/04/02：の時の情報

データファイルのファイル削除やレコード削除を行う場合、 その都度 KILL命令 や CLFILE命令 を実行するよりも ラッパ関数を作って、それをコールする方がソース的にすっきりすると思います。

KILL命令の定義は以下の様です。

KILL <ファイル名> 

　<ファイル名>："[ドライブ名:]ファイル名[<S>]"の書式の文字列式
　　　　　（"ファイル名"は"ファイル名称"＋"."＋"拡張子"）

KILL命令のラッパ関数は以下の様になります。

'---------------------------------------
'ファイル削除(KILL命令のラップ)
'---------------------------------------
'Function GfKill%(Byval pstrFileName$)
'引　数：
'	pstrFileName$ ：ファイル名
'---------------------------------------
	Function GfKill%(Byval pstrFileName$)
		'エラー処理宣言
		On Error Goto GfKill.ErrProc
		'戻り値の初期化
		GfKill% = GcFalse%
		'指定ファイル名の削除
		KILL pstrFileName$
		GfKill% = GcTrue%
GfKill.Return	'関数戻り
		On Error Goto 0
		Exit Function
'-----
'エラー処理
'-----
GfKill.ErrProc
		Resume GfKill.Return
	End Function

エラー処理は何もしていませんが、ここでエラー内容などを表示するといいと思います。


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

CLFILE ［#］<ファイル番号>

　<ファイル番号>：1～16の値を返す数値式
　　　　　　（OPEN命令で指定したファイル番号を指定）

CLFILE命令のラッパ関数は以下の様になります。

'---------------------------------------
'ファイルレコード削除(CLFILE命令のラップ)
'---------------------------------------
'Function GfClFile%()
'---------------------------------------
	Function GfClFile%
		'エラー処理宣言
		On Error Goto GfClFile.ErrProc
		'フィールドサイズ
'		Const COL.CD% = 10	'上の関数[MfPutData%]で定義済み
'		Const COL.NUM% = 26
		'戻り値の初期化
		GfClFile% = GcFalse%
		PRIVATE FILENO%, REC.CD$, REC.NUM$
		'TEST.DATファイルを、ファイル番号#1としてオープンします
		FILENO% = 1
		OPEN GcTEST.DAT$ AS FILENO% RECORD 2147483647
		FIELD #FILENO%, COL.CD% AS REC.CD$, COL.NUM% AS REC.NUM$
		'レコード削除
		CLFILE #FILENO%
		GfClFile% = GcTrue%
GfClFile.Return	'関数戻り
		If FILENO% > 0 Then
			Close FILENO%
		Endif
		On Error Goto 0
		Exit Function
'-----
'エラー処理
'-----
GfClFile.ErrProc
		Resume GfClFile.Return
	End Function

この関数は、"TEST.DAT"ファイルのレコード削除しかできない関数をラップしたものです。
FIELD命令はフィールド変数を固定でしか宣言できないのでこの様な感じになりました。 この部分を汎用性を持たせるのは少し大変なので、固定でもいいかなと思います。 方法が無いことは無いのですが、やはりFIELD命令がネックになります。

以下の関数は無理やり汎用性を持たせたCLFILE命令のラッパ関数です。

'---------------------------------------
'ファイルレコード削除(CLFILE命令のラップ)
'---------------------------------------
'Function GfClFile2%(Byval pstrFileName$)
'引　数：
'	pstrFileName$ ：ファイル名
'---------------------------------------
	Function GfClFile2%(Byval pstrFile$)
		'エラー処理宣言
		On Error Goto GfClFile2.ErrProc
		'戻り値の初期化
		GfClFile2% = GcFalse%
		'ファイル情報提供関数(FILE.FN3)の利用
		PRIVATE INF$, FieldNum%, I%, FSZ%(16)
		'40 文字分の領域を確保
		INF$ = "                                        "
		CALL "FILE.FN3" .fcInfGetF pstrFile$,INF$
		FieldNum% = ASC(MID$(INF$, 22, 1)) ' フィールド数の獲得
		FOR I% = 1 TO 16	'各フィールド幅の取得
			FSZ%(I%) = ASC(MID$(INF$, 22 + I%, 1))
		NEXT
		
		PRIVATE FILENO%, W$
		'指定ファイルを、ファイル番号#1としてオープンします
		FILENO% = 1
		OPEN pstrFile$ AS FILENO% RECORD 2147483647
		'フィールド定義をフィールド数毎に分けて処理
		SELECT FieldNum%
			CASE 1
				FIELD #FILENO%, FSZ%(1) AS W$
			CASE 2
				FIELD #FILENO%, FSZ%(1) AS W$, FSZ%(2) AS W$
			CASE 3
				FIELD #FILENO%, FSZ%(1) AS W$, FSZ%(2) AS W$, FSZ%(3) AS W$
			CASE 4
				FIELD #FILENO%, FSZ%(1) AS W$, FSZ%(2) AS W$, FSZ%(3) AS W$, FSZ%(4) AS W$
			CASE 5
				FIELD #FILENO%, FSZ%(1) AS W$, FSZ%(2) AS W$, FSZ%(3) AS W$, 
FSZ%(4) AS W$, FSZ%(5) AS W$
			CASE 6
				FIELD #FILENO%, FSZ%(1) AS W$, FSZ%(2) AS W$, FSZ%(3) AS W$, 
FSZ%(4) AS W$, FSZ%(5) AS W$, FSZ%(6) AS W$
			'....(この後必要な分作成???)
		END SELECT
		'レコード削除
		CLFILE #FILENO%
		GfClFile2% = GcTrue%
GfClFile2.Return	'関数戻り
		If FILENO% > 0 Then
			Close FILENO%
		Endif
		On Error Goto 0
		Exit Function
'-----
'エラー処理
'-----
GfClFile2.ErrProc
		Resume GfClFile2.Return
	End Function

ファイルのフィールド数、各フィールド幅の取得を行う為に、 拡張関数の "FILE.FN3" を使用しています。

CALL "FILE.FN3" .fcInfGetF FILENAME$, INF$

　FILENAME$：ファイル名

　INF$：ファイル情報が返される（40 文字、または、ヌル文字）
　　　　（必ず40 バイト以上の領域を確保しておく）

INF$の内容は以下の通りです。

位置	文字数	データ内容	値
1	12	ファイル名	文字列
13	2	(システムリザーブ)	-
15	2	最大レコード数	1～32767
17	2	レコード数	1～32767
19	2	1クラスタあたりのレコード数	0
21	1	レコード長	1～255
22	1	フィールド数	1～16
23	16	各フィールドのフィールド幅	1～254
39	2	(システムリザーブ)	-

=====
2016/04/02：の時の情報

ユーザ関数の引数の仮変数を普通の変数の様に使用することができます。 但し、文字列型変数の場合文字列長に関して注意する点があります。

今回は仮のユーザ関数として以下の様なものを宣言します。

'---------------------------------------
'引き数の仮変数のテスト
'---------------------------------------
'Sub MsTest(Byval pstrCD$)
'引　数：
'	pstrCD$		:コード
'---------------------------------------
	Sub MsTest(Byval pstrCD$)
		'エラー処理宣言
		On Error Goto MsTest.ErrProc
		'3文字を設定
		pstrCD$ = "123"
		PRINT "3文字を設定:" + pstrCD$
		'4文字を設定
		pstrCD$ = "1234"
		PRINT "4文字を設定:" + pstrCD$
		'5文字を設定
		pstrCD$ = "12345"
		PRINT "5文字を設定:" + pstrCD$
MsTest.Return	'関数戻り
		On Error Goto 0
		Exit Sub
MsTest.ErrProc
		'エラー発生時にエラーコード表示
		PRINT "ERR=" + RIGHT$("00" + HEX$(ERR), 2)
		Resume MsTest.Return
	End Sub

この関数は仮変数である pstrCD$ に3文字～5文字までのテストデータを代入し 単にその内容を表示しています。
尚、エラー処理では発生したエラーコードを表示させています。

上記の関数の動作をテストするソースを以下に記します。

	SCREEN 1	'漢字モード
	LOCATE , , 2	'カーソルをブロック表示

	PRIVATE W$
	W$ = "0001"	'4文字データを代入
	CALL MsTest(W$)	'4文字データの変数の値を渡す

	WAIT 0, &h01 'キー入力待ち
	END

関数 MsTest の中でブレークポイントを設定し pstrCD$ の 内容を表示させてみます。 以下の図は MsTest に制御が移った直後の pstrCD$ ですが 文字列のサイズが4文字になっています。

呼出し元の変数 W$ はサイズが40文字のはずですが、 引き数としては4文字になっています。

さらにステップ実行すると以下の図になります。  pstrCD$ に"123"が設定されている様子です。
そのまま実行を継続すると、以下の図の表示なります。

5文字の設定のところでエラーが発生し、エラーコードが 0F(16進数) と表示されます。 このエラー内容は 「文字列長が範囲外です。」 です。
※結果的に、ユーザ関数の引数の文字列型仮変数に代入する場合は文字列長に注意が必要だということになります。



=====
2016/04/02：の時の情報

データファイルの読み込みで、最初に既に入力されているコードを検索し、 そのコードに対応したレコード番号で行う場合があります。 データのメンテナンス処理ではこの方法が普通かと思います。

今回は標準関数の SEARCH関数 を使ってみます。

SEARCH関数の定義は以下の様です。

SEARCH(［#］<ファイル番号>,<フィールド変数>,<検索データ>［,<開始レコード>］)

　<ファイル番号>：1～16の値を返す数値式
　　　　　　（OPEN命令で指定したファイル番号を指定）
　<フィールド変数>：文字型単純変数
　　　　　　（FIELD命令の前に宣言されている変数を指定）
　<検索データ>：文字列式

　<開始レコード>：数値式
　　　　　　（検索を開始するレコードの番号を指定、省略時は先頭から）

　返す値：検索できたレコード番号、見つからない場合は０が返る
　　　　　　（返す値は長整数型変数か実数型変数で代入）

データファイルからコードを指定し検索する関数を以下の様に定義します。

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

		PRIVATE FILENO%, REC.CD$, REC.NUM$
		'TEST.DATファイルを、ファイル番号#1としてオープンします
		FILENO% = 1
		OPEN GcTEST.DAT$ AS FILENO% RECORD 2147483647
		FIELD #FILENO%, COL.CD% AS REC.CD$, COL.NUM% AS REC.NUM$
		
		PRIVATE W$
		W$ = LEFT$(pstrCD$ + GfSpc$(COL.CD%), COL.CD%)	'既定の桁数分スペースを付加
		IF plngRecNo& <= 0 THEN
			'先頭から検索
			plngRecNo& = SEARCH(#FILENO%, REC.CD$, W$)
		ELSE
			'指定レコード位置から検索
			plngRecNo& = SEARCH(#FILENO%, REC.CD$, W$, plngRecNo&)
		ENDIF
		IF plngRecNo& <> 0 THEN
			'読込
			GET FILENO%, plngRecNo&
			'値を返す
			plngNum& = VAL(GfTrim$(REC.NUM$))	'数量
			'正常を返す
			MfSearchData% = GcTrue%
		ENDIF
MfSearchData.Return	'関数戻り
		If FILENO% > 0 Then
			Close FILENO%
		Endif
		On Error Goto 0
		Exit Function
'-----
'エラー処理
'-----
MfSearchData.ErrProc
		Resume MfSearchData.Return
	End Function

SEARCH関数 に指定する検索データは、 関数[MfPutData%]でコードの後ろにスペースを付加したので、その処理を行っています。 
この時、ワーク変数の W$ を宣言していますが、 
引き数の変数 pstrCD$ は、コール元で代入された文字列長分しかサイズが無いので、 
それ以上の長さの文字列を代入できないためです。 

レコード番号の指定が０の場合は、ファイルの先頭からの検索を行います。

上記の検索関数の動作をテストするソースを以下に記します。

	SCREEN 1				'漢字モード
	LOCATE , , 2			'カーソルをブロック表示
	'最初は書き込み処理の連続
	PRIVATE W%
	W% = MfPutData%("CD0001", 100, 0)
	W% = MfPutData%("CD0002", 102, 0)
	W% = MfPutData%("CD0101", 201, 0)
	W% = MfPutData%("CD0201", 202, 0)
	W% = MfPutData%("CD1001", 500, 0)
	W% = MfPutData%("CD0003", 1030, 0)
	W% = MfPutData%("CD0002", 1022, 0)
	
	PRIVATE CD$, RNO&, NUM&
	CD$ = "CD0101": RNO& = 0
	W% = MfSearchData%(CD$, NUM&, RNO&)
	IF W% = GcTrue% THEN
		PRINT CD$ + "(" + STR$(RNO&) +  "):" + STR$(NUM&)
	ELSE
		PRINT CD$ + ":Not Found"
	ENDIF
	CD$ = "CD0003": RNO& = 0
	W% = MfSearchData%(CD$, NUM&, RNO&)
	IF W% = GcTrue% THEN
		PRINT CD$ + "(" + STR$(RNO&) +  "):" + STR$(NUM&)
	ELSE
		PRINT CD$ + ":Not Found"
	ENDIF
	CD$ = "CD0002" 	'RNO&は上の続きで
	W% = MfSearchData%(CD$, NUM&, RNO&)
	IF W% = GcTrue% THEN
		PRINT CD$ + "(" + STR$(RNO&) +  "):" + STR$(NUM&)
	ELSE
		PRINT CD$ + ":Not Found"
	ENDIF
	WAIT 0, &h01 'キー入力待ち
	END

2番目の検索から分かるように、コードは順番に並んでいなくても検索できています。 
つまり SEARCH関数 は、指定されたレコード位置からベタに検索し、
指定された検索データが等しいものが見つかった時点で、検索を止めるようです。 

SEARCH関数 は特にバイナリサーチで行うわけではないので、
データ件数が多くて最後の方に目的のものが在る場合、時間が掛かるはずです。 

ハンディターミナルで入力されたデータを検索する場合は、 そこまで入力件数が多いわけではないと思うので、
この SEARCH関数 でも 問題無いのでしょう。 
このソースの実行結果は以下の図の様になります。 

※尚、バイナリサーチに関しては、拡張関数の中にバイナリサーチ処理関数(BSEARCH.FN3)があり、 これを使えば可能です。 この関数の使い方については別の記事で紹介します。



=====
2016/04/02：の時の情報

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

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

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

 FIELD命令 は以下の様になります。

	'フィールドサイズを定義
	CONST COL.CD% = 16	'コード
	CONST COL.NUM% = 12	'数量
	'フィールド変数
	PRIVATE REC.CD$, REC.NUM$
	'フィールド定義
	FIELD #1, COL.CD% AS REC.CD$, COL.NUM% AS REC.NUM$

フィールドサイズをわざわざ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$
		'読込
		GET FILENO%, plngRecNo&
		'値を返す
		pstrCD$ = GfTrim$(REC.CD$)	'コード
		plngNum& = VAL(GfTrim$(REC.NUM$))	'数量
		'正常を返す
		MfGetData% = GcTrue%
MfGetData.Return	'関数戻り
		If FILENO% > 0 Then
			Close FILENO%
		Endif
		On Error Goto 0
		Exit Function
'-----
'エラー処理
'-----
MfGetData.ErrProc
		Resume MfGetData.Return
	End Function

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

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

	SCREEN 1	'漢字モード
	LOCATE , , 2	'カーソルをブロック表示
	'最初は書き込み処理の連続
	PRIVATE W%
	W% = MfPutData%("CD0001", 100, 0)
	W% = MfPutData%("CD0002", 102, 0)
	W% = MfPutData%("CD0101", 201, 0)
	W% = MfPutData%("CD0201", 202, 0)
	W% = MfPutData%("CD1001", 500, 0)
	
	PRIVATE CD$, NUM&, REC%
	REC% = 1
	W% = GcTrue%
	'読み込み処理をレコード番号１から順次行う
	WHILE W% = GcTrue%
		W% = MfGetData%(CD$, NUM&, REC%)
		IF W% = GcTrue% THEN
			PRINT CD$ + ":" + STR$(NUM&)
		END IF
		REC% = REC%  + 1
	WEND
	WAIT 0, &h01 'キー入力待ち
	END

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

MfGetData%関数のコールをレコード番号を１から順次カウントアップして与えています。 実際のレコードが無くなった時点で戻り値としてGcFalse%が返ってくるので、 その時にWHILEループが終わります。


=====
2016/04/02：の時の情報