grot3:BHT-Basic

自作関数

自作関数について

作った関数をサンプルとして掲載します。

文字列の区切り文字(デリミタ)対応切り出し
文字列から空白、ハイフンを取り除く
パスワード管理

文字列の区切り文字(デリミタ)対応切り出し

 1: '+-----------------------------------------------------------------------------+
 2: '|  1、区切り文字で分割し、指定されたフィールドの文字列を返す                  |
 3: '|     SPLITX$( 文字列, デリミタ, フィールド番号)                              |
 4: '+-----------------------------------------------------------------------------+
 5: Function SPLITX$( StringX$, DELIMStr$, Fld% )
 6: 	Private MaxLen%:MaxLen% = LEN(StringX$)	'文字列長
 7: 	Private LoopNum%:LoopNum% = 0		'配列ナンバー
 8: 	Private InstrNum1%:InstrNum1% = 0		'デリミタ位置1
 9: 	Private InstrNum2%:InstrNum2% = 0		'デリミタ位置2
10: 	Dim SplitChr$(10)				'格納用配列変数
11:
12: 	'1、InstrNum1 に デリミタの位置を記録
13: 	'2、InstrNum2 に 次のデリミタの位置を記録
14: 	'3、MID$関数で文字列取得し、SplitChr$に配列として格納する
15: 	while InstrNum2% < MaxLen%
16: 		InstrNum2% = INSTR(InstrNum1% + 1, StringX$, DELIMStr$)
17: 		If InstrNum2% = 0 Then
18: 			InstrNum2% = MaxLen%
19: 		End If
20: 		If (InstrNum2% - InstrNum1% <> 1) Then
21: 			SplitChr$(LoopNum%) = MID$(StringX$, InstrNum1% + 1, InstrNum2% - InstrNum1% - 1 )
22: 		End If
23: 		InstrNum1% = InstrNum2%
24: 		LoopNum% = LoopNum% + 1
25: 	WEnd
26:
27: 	'引数で指定されたフィールド番号の文字列を戻り値に設定する。
28: 	SPLITX$ = SplitChr$(Fld% - 1)
29: End Function

文字列から空白、ハイフンを取り除く

 1:  ' 文字列変換関数
 2: '+-----------------------------------------------------------------------------+
 3: '|  引数に受け取った文字列から                                                 |
 4: '|  『" "(半角スペース)』、『-(ハイフン)』を 取り除く                          |
 5: '+-----------------------------------------------------------------------------+
 6: Function TRIMX$( StringX$ )
 7: Private MaxLoopNum% : MaxLoopNum% = 0
 8: Private LoopNum% : LoopNum% = 1
 9: TrimChr$ = ""
10: Private chkString$
11:
12: MaxLoopNum% = LEN(StringX$) + 1 'ループ用変数(文字数だけループする)
13:
14:	while LoopNum% < MaxLoopNum%
15:		chkString$ = Mid$(StringX$,LoopNum%,1)		    '文字列を人つずつ取り出し、
16:		If chkString$ <> " " And chkString$ <> "-" Then	    '空白やハイフンではなかったら、
17:			TrimChr$ = TrimChr$ + chkString$	    'TrimChr$に結合する。
18:		End If
19:		LoopNum%=LoopNum%+1
20:	WEnd
21:	TRIMX$ = TrimChr$
22: End Function

パスワード管理

マスタファイル『PASS.MST』で管理します。
マスターファイルのフィールドは、[業務コード(10桁)、パスワード(4桁)]の二つです。
以下コードは、パスワード取得関数(getPass)とパスワード変更関数(setPass)の二つです。

1:  '定数定義ファイルインクルード
2:  '$Include:'lib500.dim'
3:  '関数定義ファイルインクルード
4:  '$Include:'libPa500.def'
5:  '$Include:'libCo500.def'
6:
7:  ' 変数の宣言
8:   Private waitPtn%
9:   Private passColumn$
10:  Private passWord$
11:
12:  ' フィールド変数
13:  Private SRC.FL.VAL1$[10]
14:  Private SRC.FL.VAL2$[4]
15:
16:  ' パスワード取得関数
17: '+-----------------------------------------------------------------------------+
18: '|     指定された業務コードに設定されているパスワードを                        |
19: '|     マスタファイル(PASS.MST)から取得する                                    |
20: '|     getPass$( 業務コード)                                                   |
21: '|     ※パスワードが設定されていない場合文字列 "none" を返す                  |
22: '+-----------------------------------------------------------------------------+
23:  Function getPass$( WORK$ )
24:
25:	Open "PASS.MST" as #10 RECORD 10
26:
27:		private SRC.FILENO% : SRC.FILENO% = 10		'ファイル番号
28:		private SRC.RSTART : SRC.RSTART = 1		'開始行
29:		private SRC.Fl.Len				'最終行
30:		private SRC.RECORD				'結果用
31:		private SRC.Fl.Ref$(1)				'検索条件
32:		private SRC.FL.REFCNT% : SRC.FL.REFCNT% = 1	'検索条件数
33:
34:		FIELD #10, 10 as SRC.FL.VAL1$, 4 as SRC.FL.VAL2$
35:		SRC.Fl.Len =  LOF(#10)
36:
37:		' パスワードの取得
38:		SRC.Fl.Ref$(0) = CHR$(0) + CHR$(1) + WORK$
39:		CALL "SEARCH.FN3" 1 SRC.FILENO%, SRC.RSTART, SRC.Fl.Len, SRC.RECORD, SRC.Fl.Ref$(), SRC.FL.REFCNT%
40:
41:		'検索結果の分岐
42:		IF SRC.RECORD = 0 then
43:			getPass$ = "none"
44:		Else
45:			get #10, SRC.RECORD
46:			getPass$ = SRC.FL.VAL2$
47:		End If
48:	Close #10
49:  End Function
50:
51:  ' パスワード設定関数
52: '+-----------------------------------------------------------------------------+
53: '|     指定された業務コードに設定されているパスワードを                        |
54: '|     マスタファイル(PASS.MST)から取得する                                    |
55: '|     setPass$( 業務コード, 引数1)                                            |
56: '+-----------------------------------------------------------------------------+
57:  Sub setPass$( WORK$ )
58:	private inputPass$
59:	Private passExact$ : passExact$ = "false" '旧パスワード入力判定用
60:	
61:	private SRC.FILENO% : SRC.FILENO% = 10		'ファイル番号
62:	private SRC.RSTART : SRC.RSTART = 1		'開始行
63:	private SRC.Fl.Len				'最終行
64:	private SRC.RECORD				'結果用
65:	private SRC.Fl.Ref$(1)				'検索条件
66:	private SRC.FL.REFCNT% : SRC.FL.REFCNT% = 1	'検索条件数
67:
68:	screen 1	'画面漢字モード
69:	Out &H6080, 1	'小フォントを指定
70:	
71:	'現パスワードの取得
72:	passWord$ = getPass$( WORK$ )
73:	If passWord$ = "none" Then
74:		passExact$ = "true"
75:	End If
76:	
77:	'旧パスワードの入力
78:	'入力判定が正になるまで繰り返し。(M1キーでエスケープ)
79:	While passExact$ <> "true"
80:		Cls
81:		locate 2,6
82:		OUT &h60B0, 0		'数字入力指定
83:		print "旧パスワード：";
84:		locate 1,25
85:		print "M1 キャンセル";
86:
87:		'4桁にしばるため、LIWaitInputKey500を使用。
88:		waitPtn% = LIWaitInputKey500%( 4, 4, Lc.CMD.NUMERIC, "", Lc.DCP.ADDWRITE, "M1", Lc.SCR.KANJI, _
	Lc.WAT.NORMAL, Lc.RAT.NORMAL, Lc.DFT.SMALL, 6, 16, "", Lc.CUR.BLOCK, Lc.True, _
	Lc.COL.BLACK, Lc.COL.WHITE, 1, 4 )
89:		inputPass$ = LIGetInputData$
90:		
91:		IF inputPass$ = "M1" Then
92:			exit Sub
93:		End If
94:		
95:		IF passWord$ = inputPass$ Then
96:			passExact$ = "true"
97:		End If
98:	WEnd
99:
100:	Open "PASS.MST" as #10 RECORD 10
101:	FIELD #10, 10 as SRC.FL.VAL1$, 4 as SRC.FL.VAL2$
102:	SRC.Fl.Len =  LOF(#10)
103:
104:	' パスワードが設定されていた場合、行番号を取得する。
105:	If passWord$ <> "none" Then
106:		SRC.Fl.Ref$(0) = CHR$(0) + CHR$(1) + WORK$
107:		CALL "SEARCH.FN3" 1 SRC.FILENO%, SRC.RSTART, SRC.Fl.Len, SRC.RECORD, SRC.Fl.Ref$(), SRC.FL.REFCNT%
108:	End If
109:
110:	'新パスワードの入力
111:	Cls
112:	locate 2,6
113:	OUT &h60B0, 0		'数字入力指定
114:	print "新パスワード：";
115:	locate 1,25
116:	print "M1 キャンセル";
117:	'4桁にしばるため、LIWaitInputKey500を使用。
118:	waitPtn% = LIWaitInputKey500%( 4, 4, Lc.CMD.NUMERIC, "", Lc.DCP.ADDWRITE, "M1", Lc.SCR.KANJI, _
	Lc.WAT.NORMAL, Lc.RAT.NORMAL, Lc.DFT.SMALL, 6, 16, "", Lc.CUR.BLOCK, Lc.True, _
	Lc.COL.BLACK, Lc.COL.WHITE, 1, 4 )
119:	inputPass$ = LIGetInputData$
120:
121:	IF inputPass$ = "M1" Then
122:		Close #10
123:		exit Sub
124:	End If
125:
126:	SRC.FL.VAL1$ = WORK$
127:	SRC.FL.VAL2$ = inputPass$
128:
129:	If SRC.RECORD <> 0 Then
130:		put #10, SRC.RECORD
131:	Else
132:		put #10
133:	End If
134:	Close #10
135: End Sub

ライブラリとして使用するため、.defファイルに以下を記述。
※ライブラリについてはこちらを参照ください。
Declare Function getPass$( WORK$ )
Declare Sub setPass$( WORK$ )