概要
ソースを見るだけだったら、ＳＥＵよりも秀丸の方が見やすい訳で。
エミュレータでソースダウンロードは結構面倒なので、単純化したスクリプトを作りました。
登録：2008/09/06
ソースを見るだけだったら、ＳＥＵよりも秀丸の方が見やすい訳で。
エミュレータでソースダウンロードは結構面倒なので、単純化したスクリプトを作りました。
登録：2008/09/06
このページに書かれている事を実行して、何が起こっても私は知りません。
まぁ、このページに到達された方なら大丈夫でしょうけど(^o^)。
スクリプト re973001.hta の固定値をご自分の環境に合わせて変更し、スクリプトを起動して下さい。
ダウンロードしたいメンバー名を改行で区切って適当に入れて下さい。ダウンロードボタンを押して下さい。
ライブラリ名とソースファイル名は、テキストボックスに入力があればその値を使いますし、入力が無ければリストボックスで選択されている値を使用します。
指定されているライブラリ／ソースファイルに指定メンバーが存在していれば、ダウンロードされますし、存在しなければその旨がまとめて通知されます。
取り合えず、プログラムとか画面とかメンバー名をまとめて入れといて、ソースファイル選択→ダウンロード→ソースファイル選択→ダウンロードを繰り返すので、ずぼらで良い感じです♪
iSeries Access とか Client Access は、自力でインストールして下さいね。
［re973001.hta：ここから］======================================================================
<html>
<head>
<HTA:APPLICATION
APPLICATIONNAME="ＡＳソースダウンロード"
ICON="winmine.exe"
BORDER="dialog"
SCROLL="no"
/>
<style type="text/css">
<!--
body,select,input,td,textarea {
font-family : monospace;
}
h1 {
display : none;
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%;
}
textarea.data_list {
font-family : monospace;
font-size : 150%;
}
input.pc_file {
width : 23em;
}
input.text {
font-family : monospace;
width : 8em;
}
p,table,dl {
margin-top : 0em;
margin-bottom : 0em;
}
-->
</style>
</head>
<body onload="S_onload_proc()">
<form id="form_main" onsubmit="">
<h1 id="page_title"></h1>
<p>ソースメンバー名を改行で区切って入れて下さい。</p>
<table ><tr>
<td>
<textarea class="data_list" name="member_lists" rows="11" cols="10"></textarea>
</td>
<td class="form_options">
<dl>
<dt>
<input type="button" onclick="S_Download_source_member()" value="D)ダウンロード" accesskey="d" />
</dt>
<dt>ダウンロードフォルダ（末尾の \ は無くても可）</dt>
<dd>
<input class="pc_file" name="data_dir" value="C:\_D\_Dairy\" />
</dd>
</dl>
<table><tr>
<td>
<dl>
<dt>ライブラリ名</dt>
<dd>
<input class="text" name="AS_lib_name_i" value="" />
</dd>
<dd>
<select name="AS_lib_name_l" size="6" >
<option value="SRCLIB1" selected>SRCLIB1</option>
<option value="SRCLIB2">SRCLIB2</option>
<option value="SRCLIB3">SRCLIB2</option>
</select>
</dd>
</dl>
</td>
<td>
<dl>
<dt>ソースファイル</dt>
<dd>
<input class="text" name="Source_file_name_i" value="" />
</dd>
<dd>
<select name="Source_file_name_l" size="6" >
<option value="QCLPSRC">QCLPSRC</option>
<option value="QCPYSRC">QCPYSRC</option>
<option value="QDDSSRC">QDDSSRC</option>
<option value="QDSPSRC">QDSPSRC</option>
<option value="QPRTSRC">QPRTSRC</option>
<option value="QRPGSRC" selected>QRPGSRC</option>
</select>
</dd>
</dl>
</td>
</tr></table>
<dl>
<dt>対象ＡＳ</dt>
<dd>
<select name="AS_SYSTEM" size="3" >
<option value="192.168.0.100" >社内：Ａ</option>
<option value="192.168.0.101" selected>社内：Ｂ</option>
<option value="192.168.0.102" >大阪</option>
</select>
</dd>
<dt>ユーザーＩＤ／パスワード</dt>
<dd>
<input class="text" name="AS_UID" value="" />
／<input class="text" name="AS_PWD" value="" type="password"/>
</dd>
</dl>
</td>
</tr></table>
</form>
<script language="VBScript">
option explicit
Const C_title_text = "ＡＳソースダウンロード"
Const C_initial_width = 545
Const C_initial_height = 385
Const C_ext = ".rpg"
Const C_DFT_AS_SYSTEM = "192.168.0.100"
Const C_DFT_AS_UID = "USER"
Const C_DFT_AS_PWD = "PASS"
dim rt,i
'--------------------------------------------------------------------------------
'ソースファイルのダウンロード
Sub S_Download_proc()
dim L_AS400,L_AS_DLR
dim LA_member
dim L_LIB_name,L_SRC_name
dim L_count,L_Result
L_LIB_name = document.all("AS_lib_name_l").value
if trim(document.all("AS_lib_name_i").value) <> "" then L_LIB_name = document.all("AS_lib_name_i").value
L_SRC_name = document.all("Source_file_name_l").value
if trim(document.all("Source_file_name_i").value) <> "" then L_SRC_name = document.all("Source_file_name_i").value
L_count = 0
L_Result = ""
'１．ＡＳ／４００接続
Set L_AS400 = createobject("cwbx.AS400System")
L_AS400.define document.all("AS_SYSTEM").value
L_AS400.UserID = document.all("AS_UID").value
L_AS400.Password = document.all("AS_PWD").value
'データ転送定義
Set L_AS_DLR = createobject("cwbx.DatabaseDownloadRequest")
Set L_AS_DLR.system = L_AS400
LA_member = Split(document.all("member_lists").value,vbcrlf)
for i = 0 to UBound(LA_member) 'それぞれのメンバー毎の処理
if LA_member(i) <> "" then 'ブランク行は無視で。
' 転送用の AS/400 ファイル名を設定します
L_AS_DLR.AS400File = L_LIB_name & "/" & L_SRC_name & "(" & LA_member(i) & ")"
' PC ファイル・タイプをアスキー形式テキストに設定します
L_AS_DLR.pcFile.FileType = 1
'PC ファイルの名前を設定します
L_AS_DLR.pcFile.Name = document.all("data_dir").value & "\" & LA_member(i) & C_ext
'文字コード変換？
L_AS_DLR.Convert65535 = true
'転送処理です。
Err.Clear
On Error Resume Next
L_AS_DLR.Download
If Err.Number <> 0 Then
L_Result = L_Result & vbcrlf & "× " & L_AS_DLR.AS400File & " → " & L_AS_DLR.pcFile.Name
else
L_Result = L_Result & vbcrlf & "○ " & L_AS_DLR.AS400File & " → " & L_AS_DLR.pcFile.Name
L_count = L_count + 1
end if
On Error Goto 0
end if
next
Set L_AS_DLR = Nothing
Set L_AS400 = Nothing
Call S_OK_msg(L_count & " 件ダウンロードしました。" & L_Result)
end sub
'--------------------------------------------------------------------------------
'ダウンロード処理
Sub S_Download_source_member()
if document.all("member_lists").value <> "" then
S_Download_proc()
else
Call S_OK_msg("ダウンロードするソースメンバーを指定して下さい。")
end if
end sub
'--------------------------------------------------------------------------------
sub S_onload_proc()
'初期値設定
document.title = C_title_text
document.all("page_title").innerText = C_title_text
rt = window.resizeTo(C_initial_width,C_initial_height)
document.all("AS_SYSTEM").value = C_DFT_AS_SYSTEM
document.all("AS_UID").value = C_DFT_AS_UID
document.all("AS_PWD").value = C_DFT_AS_PWD
end sub
'--------------------------------------------------------------------------------
sub S_OK_msg(P_msg)
msgbox P_msg,0,C_title_text
end sub
</script>
</body></html>
［re973001.hta：ここまで］======================================================================