概要
本番も近くなると『このＬＦ、キーなんだっけ？』とドキュメントを開く時間も無くなります。
で、DSPFD でキーフィールド名調べて、PF のソース見て項目名確認したりします。
のが、面倒なので、まとめてやってくれるスクリプトを作りました。
ライブラリも、面倒なのでライブラリリスト指定で一番上を見に行きます。
本番も近くなると『このＬＦ、キーなんだっけ？』とドキュメントを開く時間も無くなります。
で、DSPFD でキーフィールド名調べて、PF のソース見て項目名確認したりします。
のが、面倒なので、まとめてやってくれるスクリプトを作りました。
ライブラリも、面倒なのでライブラリリスト指定で一番上を見に行きます。
このページに書かれている事を実行して、何が起こっても私は知りません。
まぁ、このページに到達された方なら大丈夫でしょうけど(^o^)。
スクリプト re974001.hta の固定値をご自分の環境に合わせて変更し、そのディレクトリに UDB_Dic というディレクトリを作ってから、スクリプトを起動して下さい。
左上には調べたいファイル名、縦長のテキストボックスには調べたいライブラリリストを指定して下さい。
ＤＳＰＦＤとＤＳＰＦＦＤを実行して、結果をそれっぽく表示します。
UDB_Dic ディレクトリには、項目名情報テキストを格納します。『項目名再取得』のチェックを入れると作り直します。
『オブジェクト情報』のチェックを入れるとＤＳＰＯＢＪＤの結果もそれっぽく表示します。
ＤＤＳ名の４桁表示は、おまけです。まぁ、適当にソースいじって下さい。
iSeries Access とか Client Access は、自力でインストールして下さい。
［re974001.hta：ここから］======================================================================
<html>
<head>
<HTA:APPLICATION
APPLICATIONNAME="ＡＳ／４００ ＤＳＰＦＤ表示"
ICON="wiaacmgr.exe"
/>
<style type="text/css">
<!--
body,select,input,td,textarea {
font-family : monospace;
font-size : 100%;
}
h1 {
margin-top : 0.5em;
padding-top : 0.2em;
padding-bottom : 0.2em;
margin-bottom : 0.2em;
padding-left : 1 em;
color : #3333ff;
background-color : #99ffff;
font-size : 130%;
}
table.soto_waku {
margin-left : 1 em;
border-style : solid none none solid ;
border-width : 0pix ;
}
table.naka_waku {
margin-left : 1em;
border-style : solid none none solid ;
border-width : 1pix ;
}
td.naka_waku {
margin-top : 0em;
margin-bottom : 0em;
text-align : center;
border-style : none solid solid none ;
border-width : 1pix ;
}
textarea.cmd_list {
font-family : monospace;
}
input.text {
width : 8em;
}
input.button {
font-size : 80%;
}
span.UL {
text-decoration : underline;
}
-->
</style>
</head>
<body onload="S_onload_proc()" onkeyup="S_Keyup_on_body()">
<form id="form_main" onsubmit="">
<h1 id="page_title"></h1>
<table class="soto_waku" ><tr>
<td class="soto_waku" valign="top">
<input class="text" name="Target_file" accesskey="f" value="TOKMASL"/>
<br>
<input class="button" name="Execute" type="button" onclick="S_AS_commands_check()" value="(F10)表示"/>
<br>
<textarea class="cmd_list" id="Target_libl" rows="14" cols="10">
QTEMP
DTALIB1
DTALIB2
QGPL </textarea>
<br>
<select name="connect_AS" size="1" accesskey="a" >
<option value="192.168.100.100" selected>自社</option>
<option value="192.168.100.110" >客先</option>
</select>
<br>
<input class="text" name="connect_user" accesskey="u" />
<br>
<input class="text" name="connect_pass" accesskey="w" type="password" />
<br>
<input id="Special_Font" type="checkbox" onclick="S_Click_Special_Font()" checked><label for="Special_Font">特殊フォント</label>
<br>
<input id="Reget_field_name" type="checkbox" ><label for="Reget_field_name">項目名再取得</label>
<br>
<input id="DSPOBJD" type="checkbox" ><label for="DSPOBJD">オブジェクト情報</label>
</td>
<td class="soto_waku" valign="top">
基本情報
<table id="BASE" title="基本情報（BASATR・MBR）" class="naka_waku" cellspacing="0"></table>
並び順
<table id="ACCPTH" title="並び順（ACCPTH）" class="naka_waku" cellspacing="0"></table>
選択条件
<table id="SELECT" title="選択条件（SELECT）" class="naka_waku" cellspacing="0"></table>
オブジェクト情報
<table id="OBJECT" title="オブジェクト情報（DSPOBJD）" class="naka_waku" cellspacing="0"></table>
</td>
</tr></table>
</form>
<script language="VBScript">
option explicit
Const C_title_text = "ＡＳ／４００ ＤＳＰＦＤ表示 V1.1"
Const C_initial_width = 630
Const C_initial_height = 580
Const C_DFT_AS_SYSTEM = "192.168.100.100"
Const C_DFT_AS_UID = "USERID"
Const C_DFT_AS_PWD = "PASSWORD"
Const C_FD_outfile_lib = "QGPL" 'DSPFD の OUTFILE 格納ライブラリ。QTEMP 不可。
Const C_FD_BASATR_file = "FD_BASATR" 'DSPFD の OUTFILE 格納ファイル名：BASATR
Const C_FD_MBR_file = "FD_MBR" 'DSPFD の OUTFILE 格納ファイル名：MBR
Const C_FD_ACCPTH_file = "FD_ACCPTH" 'DSPFD の OUTFILE 格納ファイル名：ACCPTH
Const C_FD_SELECT_file = "FD_SELECT" 'DSPFD の OUTFILE 格納ファイル名：SELECT
Const C_OBJD_file = "DSPOBJDOUT" 'DSPOBJD の OUTFILE 格納ファイル名
Const CA_BASATR_Fields = "ATFILE,ATLIB,ATFTYP,ATTXT" 'BASATR から必要な項目を並べる。
Const CA_MBR_Fields = "MBBOF,MBBOL,MBNRCD,MBBOLF" 'MBR から必要な項目を並べる。
Const CA_ACCPTH_Fields = "APKEYN,APKEYF,APKSEQ" 'ACCPTH から必要な項目を並べる。
Const CA_SELECT_Fields = "SORULE,SOFLD,SOCOMP,SOVALU" 'SELECT から必要な項目を並べる。
Const CA_OBJD_Fields = "ODCDAT,ODCTIM,ODSRCD,ODSRCT,ODSRCL,ODSRCF,ODSRCM" 'OBJDOUT から必要な項目を並べる。
Const CA_BASATR_title = "ファイル,ライブラリ,タイプ,テキスト" 'BASATR から必要な項目を並べる。
Const CA_MBR_title = "物理ファイル,ライブラリ,件数,レコード様式名" 'MBR から必要な項目を並べる。
Const CA_ACCPTH_title = "№,項目,A/D" 'ACCPTH から必要な項目を並べる。
Const CA_SELECT_title = "選択除外,項目,比較,値" 'SELECT から必要な項目を並べる。
Const CA_OBJD_title = "ファイル作成日,ファイル作成時刻,ソース変更日,ソース変更時刻,ソースライブラリ,ソースファイル,ソースメンバー" 'OBJDOUT から必要な項目を並べる。
Const C_Dic_path = "UDB_Dic\" 'fdf 格納ディレクトリ。スクリプトのあるディレクトリの中に作ってね。末尾には \ を。
Const C_Dic_ext = ".txt" 'fdf 定義ファイル拡張子。dds名、項目名のタブ区切りテキストです。
Const C_ffd_outfile_name = "DSPFFDOUT"
Const C_Normal_Font = "monospace"
Const C_Special_Font = "エミュレータフォント：ゴシック,monospace"
dim G_AS400,G_AS_CMD
dim G_Target_file
dim L_ADO_con
dim rt,i
dim LA_commands()
dim LA_Libl()
dim L_constr
'--------------------------------------------------------------------------------
'『表示』ボタン押下時の処理
Sub S_AS_commands_check()
Err.Clear
G_Target_file = trim(document.all("Target_file").value)
if G_Target_file = "" then
S_OK_msg "ファイル名を指定して下さい。"
exit sub
end if
'ＡＳ／４００接続
Call S_AS_connect()
If Err.Number <> 0 Then exit sub
'ライブラリリスト設定＆ＤＳＰＦＤＯＵＴ
Call S_AS_cmd_execute()
If Err.Number <> 0 Then exit sub
end sub
'--------------------------------------------------------------------------------
'ライブラリリスト設定＆ＤＳＰＦＤＯＵＴ
sub S_AS_cmd_execute()
dim L_Libl_str
dim LA_temp_Libl,L_temp_Lib
dim L_cmd_str
dim L_ADO_con,L_RS
dim L_SQL_str
dim L_cur_row,L_cell_data
dim L_ATFTYP,L_PF_name,L_PF_lib
dim L_column_dic
dim LA_temp_fields
dim L_temp_text
' On Error Resume Next
'結果テーブルの初期化
'１行目はタイトル行なので、削除しません。
For i = (document.all("ACCPTH").rows.length - 1) to 1 Step - 1
document.all("ACCPTH").deleteRow(i)
Next
For i = (document.all("SELECT").rows.length - 1) to 1 Step - 1
document.all("SELECT").deleteRow(i)
Next
'オブジェクト情報テーブルは取り合えず、全行消します。
For i = (document.all("OBJECT").rows.length - 1) to 0 Step - 1
document.all("OBJECT").deleteRow(i)
Next
'で、表示する必要があるなら、用意しときます。
if document.all("DSPOBJD").checked then
'オブジェクト情報テーブル
Call S_Initialize_2retsu_table(CA_OBJD_Fields,CA_OBJD_title,"OBJECT")
end if
err.clear
'初期ライブラリリストの設定
if document.all("Target_libl").value <> "" then
L_Libl_str = ""
'オブジェクト名配列の作成：LA_objects
LA_temp_Libl = Split(document.all("Target_libl").value,vbcrlf)
for i = 0 to UBound(LA_temp_Libl) 'それぞれのメンバー毎の処理
L_temp_Lib = trim(LA_temp_Libl(i))
if ( ( L_temp_Lib <> "" ) and ( left(L_temp_Lib,1) <> "#" ) ) then
L_Libl_str = L_Libl_str & " " & L_temp_Lib
end if
next
'実際のライブラリリストの変更
if L_Libl_str <> "" then
L_cmd_str = "CHGLIBL (" & L_Libl_str & ")"
G_AS_CMD.run L_cmd_str
If Err.Number <> 0 Then
Call S_Err_msg(L_cmd_str) '結果メッセージの表示
Exit sub
end if
end if
end if
'ＡＤＯによるレコードセットに対する処理
Set L_ADO_con = F_Set_ADO_con()
Set L_RS = CreateObject("ADODB.Recordset")
L_RS.CursorType = 0 'adOpenForwardOnly
L_RS.LockType = 1 'adLockReadOnly
'ＢＡＳＡＴＲ項目の表示
Call S_Display_2retsu_table(L_ADO_con,L_RS,"BASATR",C_FD_BASATR_file,CA_BASATR_Fields)
If Err.Number <> 0 Then exit sub
'後で使う項目を取っときます。
L_ATFTYP = L_RS.fields.item("ATFTYP")
L_PF_name = trim(L_RS.fields.item("ATFILE"))
L_PF_lib = trim(L_RS.fields.item("ATLIB"))
L_RS.Close
'ＭＢＲ項目の表示
Call S_Display_2retsu_table(L_ADO_con,L_RS,"MBR",C_FD_MBR_file,CA_MBR_Fields)
If Err.Number <> 0 Then exit sub
'後で使う項目を取っときます。
if trim(L_RS.fields.item("MBBOF")) <> "" then L_PF_name = trim(L_RS.fields.item("MBBOF"))
if trim(L_RS.fields.item("MBBOL")) <> "" then L_PF_lib = trim(L_RS.fields.item("MBBOL"))
L_RS.Close
'L_PF_name を元に、ディクショナリ作成
Set L_column_dic = F_create_column_dic(L_PF_name,L_PF_lib) 'ＤＤＳ名変換ディクショナリ定義
'ＡＣＣＰＴＨテーブル
Call S_Display_Ichiran_table(L_ADO_con,L_RS,L_column_dic,"ACCPTH","APKEYF",CA_ACCPTH_Fields,C_FD_ACCPTH_file)
If Err.Number <> 0 Then exit sub
'ＳＥＬＥＣＴテーブル
if L_ATFTYP <> "P" then
Call S_Display_Ichiran_table(L_ADO_con,L_RS,L_column_dic,"SELECT","SOFLD",CA_SELECT_Fields,C_FD_SELECT_file)
If Err.Number <> 0 Then exit sub
end if
'ＤＳＰＯＢＪＤ項目の表示
if document.all("DSPOBJD").checked then
'オブジェクト情報テーブル
Call S_Display_2retsu_table(L_ADO_con,L_RS,"OBJECT",C_OBJD_file,CA_OBJD_Fields)
If Err.Number <> 0 Then exit sub
L_RS.Close
'mmddyy → yymmdd
L_temp_text = document.all("ODCDAT").innerHTML
document.all("ODCDAT").innerHTML = right(L_temp_text,2) & "/" & left(L_temp_text,2) & "/" & mid(L_temp_text,3,2)
L_temp_text = document.all("ODCTIM").innerHTML
document.all("ODCTIM").innerHTML = left(L_temp_text,2) & ":" & mid(L_temp_text,3,2) & ":" & right(L_temp_text,2)
L_temp_text = document.all("ODSRCD").innerHTML
document.all("ODSRCD").innerHTML = left(L_temp_text,2) & "/" & mid(L_temp_text,3,2) & "/" & right(L_temp_text,2)
L_temp_text = document.all("ODSRCT").innerHTML
document.all("ODSRCT").innerHTML = left(L_temp_text,2) & ":" & mid(L_temp_text,3,2) & ":" & right(L_temp_text,2)
' msgbox document.all("ODCDAT").innerHTML
end if
L_ADO_con.close
Set L_column_dic = nothing
Set L_ADO_con = nothing
On Error Goto 0
end sub
'--------------------------------------------------------------------------------
'２列表示型のテーブル表示（BASATR・MBR
sub S_Display_2retsu_table(P_ADO_con,P_RS,P_Table_id,P_FD_file,PA_Fields)
dim L_cmd_str
dim L_SQL_str
dim LA_temp_fields,L_temp_text
'ＤＳＰＦＤ－ＢＡＳＡＴＲ
if P_Table_id = "OBJECT" then
L_cmd_str = "DSPOBJD " & G_Target_file & " *FILE OUTPUT(*OUTFILE) "
else
L_cmd_str = "DSPFD " & G_Target_file & " *" & P_Table_id & " *OUTFILE "
end if
L_cmd_str = L_cmd_str & "OUTFILE(" & C_FD_outfile_lib & "/" & P_FD_file & ")"
G_AS_CMD.run L_cmd_str
If Err.Number <> 0 Then
Call S_Err_msg(L_cmd_str) '結果メッセージの表示
Exit sub
end if
'ＢＡＳＡＴＲ
L_SQL_str = "Select " & PA_Fields & " from " & C_FD_outfile_lib & "." & P_FD_file
P_RS.Open L_SQL_str,P_ADO_con,,,&H0001 'adCmdText
If Err.Number <> 0 Then
Call S_Err_msg(L_SQL_str) '結果メッセージの表示
exit sub
end if
'テーブル項目の表示
LA_temp_fields = Split(PA_Fields,",")
For i = 0 to UBound(LA_temp_fields) 'それぞれのメンバー毎の処理
L_temp_text = trim(P_RS.fields.item(LA_temp_fields(i)))
if L_temp_text = "" then L_temp_text = "-"
document.all(LA_temp_fields(i)).innerText = L_temp_text
next
'レコードセットの項目を使ったりするので、クローズは外でやります。
end sub
'--------------------------------------------------------------------------------
'一覧表示型のテーブル表示（ACCPTH・SELECT
sub S_Display_Ichiran_table(P_ADO_con,P_RS,P_column_dic,P_TABLE_id,P_Key_field,PA_Fields,P_FD_file)
dim L_cmd_str
dim L_SQL_str
dim L_cur_row,L_cell_data
'ＤＳＰＦＤコマンド実行
L_cmd_str = "DSPFD " & G_Target_file & " *" & P_TABLE_id & " *OUTFILE "
L_cmd_str = L_cmd_str & "OUTFILE(" & C_FD_outfile_lib & "/" & P_FD_file & ")"
G_AS_CMD.run L_cmd_str
If Err.Number <> 0 Then
Call S_Err_msg(L_cmd_str) '結果メッセージの表示
Exit sub
end if
'ＳＱＬ文を元に、一覧表示
L_SQL_str = "Select " & PA_Fields & " from " & C_FD_outfile_lib & "." & P_FD_file
P_RS.Open L_SQL_str,P_ADO_con,,,&H0001 'adCmdText
If Err.Number <> 0 Then
Call S_Err_msg(L_SQL_str) '結果メッセージの表示
exit sub
end if
Do While ( Not P_RS.EOF )
'DDS名配列・属性配列・値配列です。
rt = document.all(P_TABLE_id).insertRow()
L_cur_row = document.all(P_TABLE_id).rows.length - 1
For i = 0 To (P_RS.Fields.Count -1) Step 1
rt = document.all(P_TABLE_id).rows(L_cur_row).insertcell()
document.all(P_TABLE_id).rows(L_cur_row).cells(i).classname = "naka_waku"
'項目表示
L_cell_data = trim(P_RS(i))
if L_cell_data = "" then L_cell_data = "-"
document.all(P_TABLE_id).rows(L_cur_row).cells(i).innerHTML = L_cell_data
Next
'項目名
rt = document.all(P_TABLE_id).rows(L_cur_row).insertcell()
document.all(P_TABLE_id).rows(L_cur_row).cells(P_RS.Fields.Count).classname = "naka_waku"
document.all(P_TABLE_id).rows(L_cur_row).cells(P_RS.Fields.Count).innerHTML = P_column_dic.item(trim(P_RS.fields.item(P_Key_field)))
'末尾４桁
rt = document.all(P_TABLE_id).rows(L_cur_row).insertcell()
document.all(P_TABLE_id).rows(L_cur_row).cells(P_RS.Fields.Count+1).classname = "naka_waku"
document.all(P_TABLE_id).rows(L_cur_row).cells(P_RS.Fields.Count+1).innerHTML = right(trim(P_RS.fields.item(P_Key_field)),4)
P_RS.MoveNext
Loop
P_RS.Close
end sub
'--------------------------------------------------------------------------------
'ＡＳ／４００接続
sub S_AS_connect()
Set G_AS400 = createobject("cwbx.AS400System")
G_AS400.define document.all("connect_AS").value
G_AS400.UserID = document.all("connect_user").value
G_AS400.Password = document.all("connect_pass").value
Set G_AS_CMD = createobject("cwbx.Command")
Set G_AS_CMD.system = G_AS400
end sub
'--------------------------------------------------------------------------------
' Ｂｏｄｙでのキーアップイベント → F10 で実行
sub S_Keyup_on_body()
'Ｆ１０
if window.event.keyCode = 121 then document.all("Execute").onclick
end sub
'--------------------------------------------------------------------------------
sub S_onload_proc()
dim LA_temp_fields,LA_temp_title
dim L_cur_row
'初期値設定
document.title = C_title_text
document.all.page_title.innerText = C_title_text
rt = window.resizeTo(C_initial_width,C_initial_height)
document.all("connect_AS").value = C_DFT_AS_SYSTEM
document.all("connect_user").value = C_DFT_AS_UID
document.all("connect_pass").value = C_DFT_AS_PWD
'フォント初期設定
Call S_Click_Special_Font()
'テーブル初期配置
'基本情報テーブル
Call S_Initialize_2retsu_table(CA_BASATR_Fields,CA_BASATR_title,"BASE")
'メンバー情報テーブル
Call S_Initialize_2retsu_table(CA_MBR_Fields,CA_MBR_title,"BASE")
'並び順情報テーブル
Call S_Initialize_Ichiran_table(CA_ACCPTH_title,"ACCPTH")
'選択条件情報テーブル
Call S_Initialize_Ichiran_table(CA_SELECT_title,"SELECT")
'オブジェクト情報テーブル
if document.all("DSPOBJD").checked then
Call S_Initialize_2retsu_table(CA_OBJD_Fields,CA_OBJD_title,"OBJECT")
end if
end sub
'--------------------------------------------------------------------------------
'一覧表示型のテーブル初期表示（BASATR・MBR
sub S_Initialize_2retsu_table(PA_Fields,PA_title,P_Table_id)
dim LA_temp_fields,LA_temp_title
dim L_cur_row
LA_temp_fields = Split(PA_Fields,",")
LA_temp_title = Split(PA_title,",")
For i = 0 to UBound(LA_temp_fields) 'それぞれのメンバー毎の処理
'行追加
rt = document.all(P_Table_id).insertRow()
L_cur_row = document.all(P_Table_id).rows.length - 1
'タイトルセル追加
rt = document.all(P_Table_id).rows(L_cur_row).insertcell()
document.all(P_Table_id).rows(L_cur_row).cells(0).classname = "naka_waku"
document.all(P_Table_id).rows(L_cur_row).cells(0).innerHTML = LA_temp_title(i)
'値セル追加
rt = document.all(P_Table_id).rows(L_cur_row).insertcell()
document.all(P_Table_id).rows(L_cur_row).cells(1).classname = "naka_waku"
document.all(P_Table_id).rows(L_cur_row).cells(1).id = LA_temp_fields(i)
document.all(P_Table_id).rows(L_cur_row).cells(1).innerHTML = LA_temp_fields(i)
next
end sub
'--------------------------------------------------------------------------------
'一覧表示型のテーブル初期表示（ACCPTH・SELECT
sub S_Initialize_Ichiran_table(PA_title,P_TABLE_id)
dim LA_temp_title
'並び順情報テーブル
LA_temp_title = Split(PA_title,",")
'行追加
rt = document.all(P_TABLE_id).insertRow() '１行目
For i = 0 to UBound(LA_temp_title) 'それぞれのメンバー毎の処理
'タイトルセル追加
rt = document.all(P_TABLE_id).rows(0).insertcell()
document.all(P_TABLE_id).rows(0).cells(i).classname = "naka_waku"
document.all(P_TABLE_id).rows(0).cells(i).innerHTML = LA_temp_title(i)
next
rt = document.all(P_TABLE_id).rows(0).insertcell()
document.all(P_TABLE_id).rows(0).cells(i).classname = "naka_waku"
document.all(P_TABLE_id).rows(0).cells(i).innerHTML = "テキスト"
rt = document.all(P_TABLE_id).rows(0).insertcell()
document.all(P_TABLE_id).rows(0).cells(i+1).classname = "naka_waku"
document.all(P_TABLE_id).rows(0).cells(i+1).innerHTML = "４桁"
end sub
'--------------------------------------------------------------------------------
Sub S_Click_Special_Font()
'フォント指定変更時の処理
dim L_selectorText
for i = 0 to document.styleSheets(0).rules.length - 1
L_selectorText = document.styleSheets(0).rules(i).selectorText
if L_selectorText = "BODY" or L_selectorText = "INPUT" or L_selectorText = "SELECT" or L_selectorText = "TD" or L_selectorText = "TEXTAREA" then
if document.all("Special_Font").checked then
document.styleSheets(0).rules(i).style.fontFamily = C_Special_Font
else
document.styleSheets(0).rules(i).style.fontFamily = C_Normal_Font
end if
end if
next
end sub
'--------------------------------------------------------------------------------
sub S_OK_msg(P_msg)
msgbox P_msg,0,C_title_text
end sub
'--------------------------------------------------------------------------------
sub S_Err_msg(P_msg)
msgbox P_msg & vbcrlf & Err.Description,0,C_title_text
end sub
'--------------------------------------------------------------------------------
Sub S_create_ffdf(P_PF_Name,P_PF_lib,P_ffd_file_path,P_dic)
'項目名定義ファイルの作成
dim L_cmd_str,L_SQL_str
dim L_ADO_con,L_RS
dim L_fso,L_write_file
'ＤＳＰＦＦＤのＯＵＴＦＩＬＥ出力 dspffd &L/&N *outfile outfile(qgpl/dspffdout)
L_cmd_str = "DSPFFD " & P_PF_lib & "/" & P_PF_Name & " *OUTFILE OUTFILE(" & C_FD_outfile_lib & "/" & C_ffd_outfile_name & ")"
G_AS_CMD.run L_cmd_str
If Err.Number <> 0 Then
Call S_Err_msg(L_cmd_str) '結果メッセージの表示
Exit sub
end if
'ＡＤＯによるレコードセットに対する処理
Set L_ADO_con = F_Set_ADO_con()
Set L_RS = CreateObject("ADODB.Recordset")
L_RS.CursorType = 0 'adOpenForwardOnly
L_RS.LockType = 1 'adLockReadOnly
'ＳＱＬ文を元に、テキストファイル作成
L_SQL_str = "Select WHFLDI,WHFTXT from " & C_FD_outfile_lib & "." & C_ffd_outfile_name
L_RS.Open L_SQL_str,L_ADO_con,,,&H0001 'adCmdText
If Err.Number <> 0 Then
Call S_Err_msg(L_SQL_str) '結果メッセージの表示
exit sub
end if
Set L_fso = CreateObject("Scripting.FileSystemObject")
Set L_write_file = L_fso.OpenTextFile(P_ffd_file_path,2,true)
Do While ( Not L_RS.EOF )
L_write_file.WriteLine trim(L_RS.fields.item("WHFLDI")) & vbtab & trim(L_RS.fields.item("WHFTXT"))
P_dic.add trim(L_RS.fields.item("WHFLDI")),trim(L_RS.fields.item("WHFTXT"))
L_RS.MoveNext
Loop
L_write_file.Close
Set L_fso = nothing
L_RS.Close
Set L_RS = nothing
Set L_ADO_con = nothing
end sub
'--------------------------------------------------------------------------------
Function F_Set_ADO_con()
'ADO接続定義の作成
dim L_Con_Str
' ODBC for AS/400
L_Con_Str = "DRIVER=Client Access ODBC Driver (32-bit);"
L_Con_Str = L_Con_Str & " SYSTEM=" & document.all("connect_AS").value & ";"
L_Con_Str = L_Con_Str & " UID=" & document.all("connect_user").value & ";"
L_Con_Str = L_Con_Str & " PWD=" & document.all("connect_pass").value & ";"
L_Con_Str = L_Con_Str & " SIGNON=" & document.all("connect_user").value & ";"
On Error Resume Next
Set F_Set_ADO_con = CreateObject("ADODB.Connection")
F_Set_ADO_con.ConnectionString = L_Con_Str
F_Set_ADO_con.ConnectionTimeout = 20
F_Set_ADO_con.Open
If Err.Number <> 0 Then
Call S_Err_msg(L_Con_Str) '結果メッセージの表示
end if
On Error Goto 0
end Function
'--------------------------------------------------------------------------------
Function F_create_column_dic(P_PF_Name,P_PF_lib)
'ファイル名をもらって、カラム名ディクショナリオブジェクトを作ります。
dim L_ffd_file_path
dim LA_temp_array
dim L_dic
dim L_fso,L_file
dim test
'項目名定義ファイルパスの編集
L_ffd_file_path = left(document.location.pathname,InStrRev(document.location.pathname,"\")) & C_Dic_path & P_PF_Name & C_Dic_ext
Set L_fso = CreateObject("Scripting.FileSystemObject")
Set L_dic = CreateObject("Scripting.Dictionary")
if (Not L_fso.FileExists(L_ffd_file_path) ) or document.all("Reget_field_name").checked then
'ディクショナリは参照渡しで帰ってきます。
CAll S_create_ffdf(P_PF_Name,P_PF_lib,L_ffd_file_path,L_dic)
else
'ディクショナリ元ファイルが存在します。
Set L_file = L_fso.OpenTextFile(L_ffd_file_path,1)
Do While L_file.AtEndOfLine <> True
LA_temp_array = split(L_file.ReadLine,vbtab)
L_dic.add LA_temp_array(0),LA_temp_array(1)
Loop
L_file.Close
set L_file = nothing
end if
set F_create_column_dic = L_dic
set L_dic = nothing
set L_fso = nothing
end Function
'--------------------------------------------------------------------------------
</script>
</body></html>
［re974001.hta：ここまで］======================================================================