-
ハンディターミナルはそれ自身単体で使用するわけではなく、 データファイルの送受信処理をパソコンと行い、 そのデータファイルのデータを使用して処理を進めることはよくあります。
それで今回は、ファイルの送受信を行う XFILE命令 について説明します。
[書式] XFILE "[ドライブ名:]ファイル名"[, "プロトコル指定"] <引き数> ドライブ名:ドライブ指定("A" OR "D") <各ドライブに対応する通信プロトコル> "A":Ymodem, BHT-Ir, BHT "D":Ymodemのみ ファイル名:ファイル指定 プロトコル指定:以下の各指定を文字列で行う。 ■伝送方向: ・省略時(デフォルト):BHTからファイル送信 ・"R"または"r" :パソコンまたは他BHTからファイル受信 ■シリアル番号: ・省略時(デフォルト):シリアル番号の付加無し ・"S"または"s" :伝送ブロックにシリアル番号を付加 ■水平パリティチェック(BCC): ・省略時(デフォルト):水平パリティの付加無し ・"P"または"p" :伝送ブロックに水平パリティを付加 ■伝送モニタ: ・省略時(デフォルト):シリアル番号の表示無し ・"M"または"m" :伝送ブロックのシリアル番号を表示 ■ファイル受信時のフィールド末尾の空白の扱い: ・省略時(デフォルト):空白をデータとして扱わない ・"T"または"t" :空白をデータとして扱う ■リンク確立時のタイムアウト時間: ・"1"~"8":30秒~240秒で30秒間隔 ・"9" :タイムアウトなし ■ファイル名同一チェック: ・省略時(デフォルト):同一チェックを行う (ファイル名で指定した名前と同じ 名前で送られてきたファイルのみ受信) ・"N"または"n" :同一チェックを行わない (送信側と異なるファイル名にて受信可能)
■プロトコル指定の例
XFILE "TEST.DAT", "RSPMT1"
この例はほぼ全てのプロトコル指定を行っています。 つまり、ファイル「TEST.DAT」の受信でシリアル番号の付加、水平パリティの付加、シリアル番号の表示、フィールド末尾の空白をデータ、 リンク確立時のタイムアウト時間30秒の指定です。
私があるシステムで XFILE命令 を使った受信時は以下のコマンドでした。 フィールド末尾の空白ですが、データとしないと FIELD命令 で指定した分の桁数が確保されない気がしました。 でもファイルを読込んだ時には、文字列の右側の空白を取除く(トリム)必要があります。
XFILE "TEST.DAT", "RPMT"
■XFILE命令 をラップした関数について
受信と送信に分けて関数を作ってみました。
'--------------------------------------- 'ファイル送信 '--------------------------------------- 'Function GfSndFile%(pintFp%, pstrSpeed$, pstrFile$, pstrOption$) '引 数: ' pintFp% :ファイル番号 ' pstrSpeed$ :送信スピード ' pstrFile$ :送信ファイル名 ' pstrOption$ :送信オプション '戻り値: ' GfSndFile% :送信OK(GcTrue%)NG(GcFalse%) '--------------------------------------- Function GfSndFile%(pintFp%, pstrSpeed$, pstrFile$, pstrOption$) On Error Goto GfSndFile.ErrProc OPEN "COM1:" + pstrSpeed$ AS pintFp% XFILE pstrFile$, pstrOption$ GfSndFile% = GcTrue% GfSndFile.Return '終了処理 CLOSE pintFp% On Error Goto 0 Exit Function '----- 'エラー処理 '----- GfSndFile.ErrProc GfSndFile% = GcFalse% Resume GfSndFile.Return End Function '--------------------------------------- 'ファイル受信 '--------------------------------------- 'Function GfRcvFile%(pintFp%, pstrSpeed$, pstrFile$, pstrOption$) '引 数: ' pintFp% :ファイル番号 ' pstrSpeed$ :受信スピード ' pstrFile$ :受信ファイル名 ' pstrOption$ :受信オプション("R")以外のオプション '戻り値: ' GfRcvFile% :受信OK(GcTrue%)NG(GcFalse%) '--------------------------------------- Function GfRcvFile%(pintFp%, pstrSpeed$, pstrFile$, pstrOption$) On Error Goto GfRcvFile.ErrProc OPEN "COM1:" + pstrSpeed$ AS pintFp% XFILE pstrFile$, "R" + pstrOption$ GfRcvFile% = GcTrue% GfRcvFile.Return '終了処理 CLOSE pintFp% On Error Goto 0 Exit Function '----- 'エラー処理 '----- GfRcvFile.ErrProc GfRcvFile% = GcFalse% Resume GfRcvFile.Return End Function
=====
2016/04/02:の時の情報
PR -
簡単なメニュー表示・選択を行うユーザ関数を作ってみました。
この関数はメニュー表示データを文字列の配列で渡して、 ハンディの「△」「▽」キーで選択行を移動させて、 「ENT」キーの押下でメニュー選択を行います。
実際の表示は以下の様な感じです。
各数字キーを押下することで、メニューの選択が直接その行に移動します。 但し、この関数なのですが問題が在りまして、 各数字キーで直接移動するのはいいのですが、 1~9までにしか対応していません。 そのため、9個までのメニューは良いのですが、それ以上のメニューの場合は問題が在ります。
この辺りは、参考にされた場合は改造等をして下さい。
では以下にこの関数のソースを示します。
'--------------------------------------- 'メニュー表示・選択 '--------------------------------------- 'Function MfGetMenu$(Byval pnY%, Byval pColorBack&, Byref parrMenu$(), Byval pnMenuMax%, Byval pnMenu%) '引 数: ' pnY% :画面行位置 ' pColorBack& :背景色:指定色 ' parrMenu$() :メニュー文字列配列 ' pnMenuMax% :メニュー行のMAX値 ' pnMenu% :最初のメニューの位置 '戻り値: ' MfGetMenu$ :選択されたメニューの番号文字列 '--------------------------------------- Function MfGetMenu$(Byval pnY%, Byval pColorBack&, Byref parrMenu$(), Byval pnMenuMax%, Byval pnMenu%) Private nMenu% : nMenu% = pnMenu% Private strMenu$: strMenu$ = "" Private strBuf$: strBuf$ ="" Private strMenuMax$: strMenuMax$ = MID$(STR$(pnMenuMax%), 2) private color& ' 文字色の変数を定義 private bkcolor& ' 背景色の変数を定義 'エラー処理宣言 On Error Goto MfGetMenu.ErrProc While strMenu$ = "" Locate 1, (pnY% - 1) * 2 + 1, 0 Private i% For i% = 1 to pnMenuMax% If i% = nMenu% Then color& = .grColor.Black ' 文字色:黒色 bkcolor& = pColorBack& ' 背景色:指定色 Else color& = .grColor.Black ' 文字色:黒色 bkcolor& = .grColor.White ' 背景色:白色 Endif Call GsSetTextColor(color&, bkcolor&) Call GsPrintFull(MID$(STR$(i%), 2) + ":" + parrMenu$(i%)) Next strBuf$ = GfGetKey$ 'キーを1文字取得 IF "1" <= strBuf$ And strBuf$ <= strMenuMax$ THEN 'メニューの番号文字の場合 nMenu% = VAL(strBuf$) ELSE 'メニューの番号文字以外の場合 SELECT strBuf$ CASE CHR$(13) '[ENT]キー文字の場合 strMenu$ = MID$(STR$(nMenu%), 2) CASE "E" '[↑]キーの場合 If nMenu% > 1 Then nMenu% = nMenu% - 1 Else '先頭の場合、最下行へ移動 nMenu% = pnMenuMax% Endif CASE "M" 'SHIFT+[↑]キーの場合 If nMenu% > 1 Then nMenu% = nMenu% - 1 Else '先頭の場合、最下行へ移動 nMenu% = pnMenuMax% Endif CASE "F" '[↓]キーの場合 If nMenu% < pnMenuMax% Then nMenu% = nMenu% + 1 Else '最下行の場合、先頭へ移動 nMenu% = 1 Endif CASE "N" 'SHIFT+[↓]キーの場合 If nMenu% < pnMenuMax% Then nMenu% = nMenu% + 1 Else '最下行の場合、先頭へ移動 nMenu% = 1 Endif END SELECT ENDIF WEND 'メニュー番号を返す MfGetMenu$ = strMenu$ MfGetMenu.Return '関数戻り On Error Goto 0 Exit Function '----- 'エラー処理 '----- MfGetMenu.ErrProc Resume MfGetMenu.Return End Function
尚、この関数を実行する例のメインのソースは以下になります。
SCREEN 1 '漢字モード LOCATE , , 2 'カーソルをブロック表示 'メニュー Const MENU.CNT% = 9 PRIVATE strArrTxMenu$(MENU.CNT%), strRet$, intLoop%, intMenu% strArrTxMenu$(1) = "メニュー1 " strArrTxMenu$(2) = "メニュー2 " strArrTxMenu$(3) = "メニュー3 " strArrTxMenu$(4) = "メニュー4 " strArrTxMenu$(5) = "メニュー5 " strArrTxMenu$(6) = "メニュー6 " strArrTxMenu$(7) = "メニュー7 " strArrTxMenu$(8) = "メニュー8 " strArrTxMenu$(9) = "終了 " intMenu% = 1 '最初の選択メニュー番号 intLoop% = GcTrue% WHILE intLoop% strRet$ = MfGetMenu$(1, .grColor.Yellow, strArrTxMenu$, MENU.CNT%, intMenu%) If strRet$ = "9" Then intLoop% = GcFalse% Else LOCATE 1, 21 PRINT "SEL=" + strRet$; intMenu% = VAL(strRet$) '前回の選択番号 Endif WEND END
=====
2016/04/02:の時の情報
-
さらに、文字列を扱うユーザ定義関数として使えそうなものを作成してみました。
関数定義 引数 戻り値 指定バイト数内に収まる文字列を戻す
Function GfCut$(pstrValue$, pintMax%)[255]
pstrValue$:対象文字列
pintMax%:指定バイトGfCut$:結果文字列 横幅一杯でのテキスト表示
Sub GsPrintFull(Byval pstrSrc$)
pstrSrc$:対象文字列
'--------------------------------------- '指定バイト数内に収まる文字列を戻す関数 '--------------------------------------- 'Function GfCut$(pstrValue$, pintMax%)[255] '引 数: ' pstrValue$:対象文字列 ' pintMax%:指定バイト数 '戻り値: ' GfCut$ :結果文字列 '--------------------------------------- Function GfCut$(pstrValue$, pintMax%)[255] 'エラー処理宣言 On Error Goto GfCut.ErrProc Private intPos%, intErr%, intLoop%, intChr%, strRet$[255] intPos% = 0 intErr% = GcFalse% intLoop% = GcTrue% While intLoop% = GcTrue% 'ASCIIコード取得 intChr% = Asc(Mid$(pstrValue$, intPos% + 1, 1)) '2バイト文字(先頭バイトがSJISコード??) If &H80 <= intChr% And intChr% <= &H9F Then intPos% = intPos% + 2 If intPos% > pintMax% Then '最大バイト長を超える場合、前の状態に戻すフラグON intErr% = GcTrue% End If If intPos% >= pintMax% Then '最大バイト長に達する場合は、その場で終了 If intErr% = GcTrue% Then strRet$ = Mid$(pstrValue$, 1, intPos% - 2) Else strRet$ = Mid$(pstrValue$, 1, intPos%) End If intLoop% = GcFalse% End If '1バイト文字 Else intPos% = intPos% + 1 If intPos% >= pintMax% Then '最大バイト長に達する場合は、その場で終了 strRet$ = Mid$(pstrValue$, 1, intPos%) intLoop% = GcFalse% End If End If WEnd GfCut$ = strRet$ GfCut.Return '関数戻り On Error Goto 0 Exit Function '----- 'エラー処理 '----- GfCut.ErrProc GfCut$ = "" Resume GfCut.Return End Function const McMaxColumns% = 20 '画面の半角桁数MAX '--------------------------------------- '横幅一杯でのテキスト表示 '--------------------------------------- 'Sub GsPrintFull(Byval pstrSrc$) '引 数: ' pstrSrc$:対象文字列 '--------------------------------------- Sub GsPrintFull(Byval pstrSrc$) 'エラー処理宣言 On Error Goto GsPrintFull.ErrProc Private strWK$[255] strWK$ = GfCut$(pstrSrc$ + " ", McMaxColumns%) If Len(strWK$) < McMaxColumns% Then strWK$ = strWK$ + LEFT$(" ", McMaxColumns% - Len(strWK$)) Endif Print strWK$; GsPrintFull.Return '関数戻り On Error Goto 0 Exit Sub '----- 'エラー処理 '----- GsPrintFull.ErrProc Resume GsPrintFull.Return End Sub
尚、GfCut$関数は、以前存在した「ハンディターミナル(BHT)の部屋」というサイトからの引用です。
また、GsPrintFull関数は画面の横幅を20文字と限定しています。(フォントの設定が24ドット)
=====
2016/04/02:の時の情報
-
前回はバイナリサーチ(SEARCH.FN3)の紹介を行いましたが、 この検索では1個のコードに対して処理する機能しかありません。
コードは昇順にしないとバイナリサーチは利用できないので、 1レコードの中に複数コードが存在しソートできない場合などのデータファイルの場合には利用できません。
複数コードの条件付けを行い検索できるのが、拡張関数の サーチ処理関数(SEARCH.FN3) です。 今回はこの拡張関数について説明します。
■サーチ処理関数(SEARCH.FN3)について
この関数は以下の4個の機能があります。
機能番号 処理内容 .fcAndSrch 1 「AND」サーチ(レコード番号検索) .fcOrSrch 2 「OR」サーチ(レコード番号検索) .fcAndSrchN 11 「AND」サーチ件数(件数のみ検索) .fcOrSrchN 12 「OR」サーチ件数(件数のみ検索)
「レコード番号検索」と「件数のみ検索」で関数に渡す引数の書式が異なります。
[書式1] CALL "SEARCH.FN3" .fcAndSrch FILENO%, RSTART, REND, RECORD, STRING1$, STRING2$... RSTART, REND, RECORD は、整数型(%),長整数型(&),実数型(指定無し)が使用可能 [書式2] CALL "SEARCH.FN3" .fcAndSrch FILENO%, RSTART, REND, RECORD, STRING$(), STRINGN% RSTART, REND, RECORD は、整数型(%),長整数型(&),実数型(指定無し)が使用可能 <引き数> .fcAndSrch:機能番号指定 FILENO% :ファイル番号 RSTART :検索開始レコード番号 REND :検索終了レコード番号 FIELDNO% :フィールド番号 STRINGn$ :検索条件 STRING$() :検索条件(配列指定時) STRINGN% :検索条件数(配列指定時) STRINGn$やSTRING$()は「検索方法」+「フィールド番号」+「検索文字列」で指定します。 「検索方法」、「フィールド番号」は数値を「CHR$関数」で文字列化 <戻り値> RECORDNO :検索結果(レコード番号) ・RECORDNO には、検索条件に一致するデータが見つかったレコード番号が返されます。 見つからなかった場合、0 が返されます。 ・RECORDNO は、整数型の最大値(32767)を超える場合あるので、 変数に代入する場合、長整数型変数か実数型変数を推奨します
今回の検索関数を使用する例のために以下の様なデータファイルを想定します。 これは今まで使ってきたTEST.DATに削除フラグを追加しています。 ファイル名はTEST2.DATとします。
項目名 フィールド長 内容 品番 16 商品コードの文字列 数量 12 商品の数量を文字列で格納 削除フラグ 1 "1":削除済み 、 "0"削除されていない
サーチ処理関数(SEARCH.FN3) を使う上で OR条件 よりも AND条件 を 使う方が多いと思うので、 AND条件 を例にとります。
品番と削除フラグの AND条件 でデータファイル( TEST2.DAT )を検索する 関数が以下の様になります。関数コールの書式は検索条件に文字列配列を使った「書式2」で行っています。
'--------------------------------------- 'データ検索その2 '--------------------------------------- 'Function MfSearchData2%(Byval pstrCD$, Byval pintDel%, Byref plngNum&, Byref plngRecNo&) '引 数: ' pstrCD$ :コード ' pintDel% :削除フラグ ' pdblVal$ :数量 ' plngRecNo& :レコードNO '戻り値: ' MfSearchData2% :読込OK:GcTrue%, NG:GcFalse% '--------------------------------------- Function MfSearchData2%(Byval pstrCD$, Byval pintDel%, Byref plngNum&, Byref plngRecNo&) 'エラー処理宣言 On Error Goto MfSearchData2.ErrProc 'フィールドサイズ(既に宣言済み) ' Const COL.CD% = 16 ' Const COL.NUM% = 12 ' Const COL.DEL% = 1 '戻り値の初期化 MfSearchData2% = GcFalse% 'FIELD関連変数 PRIVATE FILENO%, REC.CD$, REC.NUM$, REC.DEL$ 'TEST.DAT2ファイルを、ファイル番号#1としてオープンします FILENO% = 1 OPEN GcTEST2.DAT$ AS FILENO% RECORD 2147483647 FIELD #FILENO%, COL.CD% AS REC.CD$, COL.NUM% AS REC.NUM$, COL.DEL% AS REC.DEL$ '検索データの整形 PRIVATE WK.CD$, WK.DEL$ WK.CD$ = LEFT$(pstrCD$ + GfSpc$(COL.CD%), COL.CD%) If pintDel% = GcTrue% Then WK.DEL$ = "1" Else WK.DEL$ = "0" EndIf 'レコードNO検索 PRIVATE RSTART&, REND&, RECORDNO&, STRING$(2)[64], STRINGN% RSTART& = 1 REND& = LOF(FILENO%) 'ファイルの最後まで検索 STRINGN% = 2 '検索条件配列の個数 STRING$(0) = CHR$(0) + CHR$(1) + WK.CD$ '検索条件(=条件),フィールド番号(1:場所CD) STRING$(1) = CHR$(0) + CHR$(3) + WK.DEL$ '検索条件(=条件),フィールド番号(3:削除フラグ) CALL "SEARCH.FN3" .fcAndSrch FILENO%, RSTART&, REND&, RECORDNO&, STRING$(), STRINGN% If RECORDNO& > 0 Then 'レコードNOが返された場合,レコードの取得 GET FILENO%, RECORDNO& '数値文字列を返す plngNum& = VAL(REC.NUM$) plngRecNo& = RECORDNO& '正常を返す MfSearchData2% = GcTrue% Endif MfSearchData2.Return '関数戻り If FILENO% > 0 Then Close FILENO% Endif On Error Goto 0 Exit Function '----- 'エラー処理 '----- MfSearchData2.ErrProc MfSearchData2% = GcFalse% Resume MfSearchData2.Return End Function
■検索関数の利用上記の検索関数の動作をテストするソースを以下に記します。
SCREEN 1 '漢字モード LOCATE , , 2 'カーソルをブロック表示 '最初は書き込み処理の連続 PRIVATE W% W% = MfPutData2%("CD0001", 100, GcTrue%, 0) W% = MfPutData2%("CD0002", 102, GcFalse%, 0) W% = MfPutData2%("CD0003", 1030, GcTrue%, 0) W% = MfPutData2%("CD0101", 201, GcTrue%, 0) W% = MfPutData2%("CD0201", 202, GcFalse%, 0) W% = MfPutData2%("CD1001", 500, GcTrue%, 0) PRIVATE CD$, RNO&, NUM& CD$ = "CD0001" '削除ONで検索⇒検索OK W% = MfSearchData2%(CD$, GcTrue%, NUM&, RNO&) IF W% = GcTrue% THEN PRINT CD$ + "(" + STR$(RNO&) + "):" + STR$(NUM&) ELSE PRINT CD$ + ":Not Found" ENDIF CD$ = "CD0002" '削除ONで検索⇒検索NG W% = MfSearchData2%(CD$, GcTrue%, NUM&, RNO&) IF W% = GcTrue% THEN PRINT CD$ + "(" + STR$(RNO&) + "):" + STR$(NUM&) ELSE PRINT CD$ + ":Not Found" ENDIF CD$ = "CD0002" '削除OFFで検索⇒検索OK W% = MfSearchData2%(CD$, GcFalse%, NUM&, RNO&) IF W% = GcTrue% THEN PRINT CD$ + "(" + STR$(RNO&) + "):" + STR$(NUM&) ELSE PRINT CD$ + ":Not Found" ENDIF CD$ = "CD0201" '削除OFFで検索⇒検索OK W% = MfSearchData2%(CD$, GcFalse%, NUM&, RNO&) IF W% = GcTrue% THEN PRINT CD$ + "(" + STR$(RNO&) + "):" + STR$(NUM&) ELSE PRINT CD$ + ":Not Found" ENDIF WAIT 0, &h01 'キー入力待ち END
最初のテストデータの書き込みで使っている関数 MfPutData2% は、下の方にソースがありますのでそちらを参照下さい。 また、これによって作成された TEST2.DAT は以下の図の様になります。(デバッガ上でのシミュレーションでのファイル参照ですが)
品番コードと削除フラグの指定を合わせて検索しています。
このソースの実行結果は以下の図の様になります。
関数 MfPutData2% のソースです。
Const GcTEST2.DAT$ = "TEST2.DAT" '--------------------------------------- 'データ書込(TEST2.DAT) '--------------------------------------- 'Function MfPutData2%(Byval pstrCD$, Byval plngNum&, Byval pintDel%, Byval plngRecNo&) '引 数: ' pstrCD$ :コード ' plngNum& :数量 ' pintDel% :削除フラグ ' plngRecNo& :レコードNO(0:レコード追加) '戻り値: ' MfPutData2% :書込OK:GcTrue%, NG:GcFalse% '--------------------------------------- Function MfPutData2%(Byval pstrCD$, Byval plngNum&, Byval pintDel%, Byval plngRecNo&) 'エラー処理宣言 On Error Goto MfPutData2.ErrProc 'フィールドサイズ Const COL.CD% = 16 Const COL.NUM% = 12 Const COL.DEL% = 1 '戻り値の初期化 MfPutData2% = GcFalse% PRIVATE FILENO%, REC.CD$, REC.NUM$, REC.DEL$ FILENO% = 0 'TEST.DAT2ファイルを、ファイル番号#1としてオープンします FILENO% = 1 OPEN GcTEST2.DAT$ AS FILENO% RECORD 2147483647 FIELD #FILENO%, COL.CD% AS REC.CD$, COL.NUM% AS REC.NUM$, COL.DEL% AS REC.DEL$ 'フィールドへデータ設定 REC.CD$ = LEFT$(pstrCD$ + GfSpc$(COL.CD%), COL.CD%) '既定の桁数分スペースを付加 REC.NUM$ = RIGHT$(GfSpc$(COL.NUM%) + STR$(plngNum&), COL.NUM%) '既定の桁数分スペースを付加 REC.DEL$ = "0" If pintDel% = GcTrue% Then REC.DEL$ = "1" Endif If plngRecNo& = 0 Then 'レコードNOが0の場合,レコードの最後尾に追加 PUT FILENO% Else 'レコードNOが指定された場合,レコードの上書 PUT FILENO%, plngRecNo& Endif '正常を返す MfPutData2% = GcTrue% MfPutData2.Return '関数戻り If FILENO% > 0 Then Close FILENO% Endif On Error Goto 0 Exit Function '----- 'エラー処理 '----- MfPutData2.ErrProc Resume MfPutData2.Return End Function
=====
2016/04/02:の時の情報
-
マスタデータファイルを検索する場合によく使われるバイナリサーチがあります。 バイナリサーチとは日本語では二分検索と言われるもので、 プログラマの方ならば説明の必要もないぐらい一般的なものだと思います。
前提条件として検索対象となるコードを、昇順ソートしてファイルに登録しておきます。
バイナリサーチでは最初に先頭レコード(左側)と最終レコード(右側)の中央に位置するコードが、 検索コードより大きいかまたは、小さいかを比較します。
中央のコードが大きい場合は、中央の位置を次の処理の右側とします。 また、中央のコードが小さい場合は、中央の位置を次の処理の左側とします。 再度、左側と右側の中央の位置を求めて、中央のコードと検索コードの比較を行います。
これを繰り返すことで領域を狭めていき最終的に目的のコードが見つかるまで行います。 (結果的に見つからない場合もありますが)
これらの一連の処理を BSEARCH.FN3 は行っています。■バイナリサーチ処理関数(BSEARCH.FN3)についてCALL "BSEARCH.FN3" .fcBSrcOp FILENO%, FIELDNO%, STRING$, RECORDNO <引き数> .fcBSrcOp: オープンされているファイルのバイナリサーチ指定 FILENO% : ファイル番号 FIELDNO%: フィールド番号 STRING$ : 検索文字列 FILENUM%: 検索ファイル数 <戻り値> RECORDNO:検索結果(レコード番号) ・RECORDNO には、検索条件に一致するデータが見つかったレコード番号が返されます。 見つからなかった場合、0 が返されます。 ・RECORDNO は、整数型の最大値(32767)を超える場合あるので、 変数に代入する場合、長整数型変数か実数型変数を推奨します
オープンされていないファイルのサーチもできるのですが、検索した結果、対象のレコードデータを 取得して何かの処理を行うのが普通だと思いますので、オープン済みファイルが対象のものだけを扱います。
それではこれを使った検索の関数をテストデータファイルを例に使ったものが以下に様になります。
'--------------------------------------- 'データバイナリ検索 '--------------------------------------- 'Function MfBSearchData%(Byval pstrCD$, Byref plngNum&, Byref plngRecNo&) '引 数: ' pstrCD$ :コード文字列 ' plngNum& :数値を返す ' plngRecNo& :レコードNOを返す '戻り値: ' MfBSearchData% :検索OK:GcTrue%, NG:GcFalse% '--------------------------------------- Function MfBSearchData%(Byval pstrCD$, Byref plngNum&, Byref plngRecNo&) 'エラー処理宣言 On Error Goto MfBSearchData.ErrProc ' Const COL.CD% = 10 '[MfPutData%]で定義済み ' Const COL.NUM% = 26 '戻り値の初期化 MfBSearchData% = GcFalse% plngRecNo& = 0 PRIVATE FILENO%, FIELDNO%, STRING$, RECORDNO&, 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$ '検索文字列を既定の桁数分スペースを付加 REC.CD$ = LEFT$(pstrCD$ + GfSpc$(COL.CD%), COL.CD%) '既定の桁数分スペースを付加 FIELDNO% = 1 'バイナリ検索 CALL "BSEARCH.FN3" .fcBSrcOp FILENO%, FIELDNO%, REC.CD$, RECORDNO& If RECORDNO& > 0 Then 'レコードNOが返された場合,レコードの取得 GET FILENO%, RECORDNO& '数値文字列を返す plngNum& = VAL(REC.NUM$) plngRecNo& = RECORDNO& '正常を返す MfBSearchData% = GcTrue% Endif MfBSearchData.Return '関数戻り If FILENO% > 0 Then Close FILENO% Endif On Error Goto 0 Exit Function '----- 'エラー処理 '----- MfBSearchData.ErrProc plngNum& = 0 Resume MfBSearchData.Return End Function
■検索関数の利用上記の検索関数の動作をテストするソースを以下に記します。
SCREEN 1 '漢字モード LOCATE , , 2 'カーソルをブロック表示 '最初は書き込み処理の連続 W% = MfPutData%("CD0001", 100, 0) W% = MfPutData%("CD0002", 102, 0) W% = MfPutData%("CD0003", 1030, 0) W% = MfPutData%("CD0101", 201, 0) W% = MfPutData%("CD0201", 202, 0) W% = MfPutData%("CD1001", 500, 0) 'バイナリサーチでの検索各種 PRIVATE CD$, RNO&, NUM& CD$ = "CD0101" W% = MfBSearchData%(CD$, NUM&, RNO&) IF W% = GcTrue% THEN PRINT CD$ + "(" + STR$(RNO&) + "):" + STR$(NUM&) ELSE PRINT CD$ + ":Not Found" ENDIF CD$ = "CD0003" W% = MfBSearchData%(CD$, NUM&, RNO&) IF W% = GcTrue% THEN PRINT CD$ + "(" + STR$(RNO&) + "):" + STR$(NUM&) ELSE PRINT CD$ + ":Not Found" ENDIF CD$ = "CD0002" W% = MfBSearchData%(CD$, NUM&, RNO&) IF W% = GcTrue% THEN PRINT CD$ + "(" + STR$(RNO&) + "):" + STR$(NUM&) ELSE PRINT CD$ + ":Not Found" ENDIF 'コードを発見できない検索 CD$ = "CD0005" W% = MfBSearchData%(CD$, NUM&, RNO&) IF W% = GcTrue% THEN PRINT CD$ + "(" + STR$(RNO&) + "):" + STR$(NUM&) ELSE PRINT CD$ + ":Not Found" ENDIF WAIT 0, &h01 'キー入力待ち END
最初のテストデータの書き込みは、コードが重複せずに昇順に行っています。 このファイルはマスタデータとして考えていますので、コードの重複はあり得ません。
尚、ユーザ関数 MfPutData% は以下の記事にありますので、参照して下さい。
BHT-BASIC4.0:データファイルの取り扱いについてその2(書込み・読込みの実用的な関数)
バイナリサーチの3番目まではレコードの内容を読めていますが、 4番目のコード"CD0005"はテストデータ書込みで行っていないので レコードは検索できません。
このソースの実行結果は以下の図の様になります。
=====
2016/04/02:の時の情報