概要
開発プログラムの納品時、ライブラリ一括で持っていくのは簡単ですが、実際には、修正メンバーのみ持っていく事も多いです。
ですので、複数のメンバー名とソースファイル名を指定して、SAVF に保管し PC にダウンロードするスクリプトを作りました。
ついでに、客先からデータファイルを持って帰る事もあるので、複数のオブジェクト名を指定して SAVF に保管し PC にダウンロード出来る様にもしました。
ついでなので、ライブラリバックアップも出来るようにしました(^o^)。
開発プログラムの納品時、ライブラリ一括で持っていくのは簡単ですが、実際には、修正メンバーのみ持っていく事も多いです。
ですので、複数のメンバー名とソースファイル名を指定して、SAVF に保管し PC にダウンロードするスクリプトを作りました。
ついでに、客先からデータファイルを持って帰る事もあるので、複数のオブジェクト名を指定して SAVF に保管し PC にダウンロード出来る様にもしました。
ついでなので、ライブラリバックアップも出来るようにしました(^o^)。
このページに書かれている事を実行して、何が起こっても私は知りません。
まぁ、このページに到達された方なら大丈夫でしょうけど(^o^)。
スクリプト re977001.hta の固定値をご自分の環境に合わせて変更し、起動して下さい。
『移送用ライブラリ』に保管ファイルが作られます。また、保管ファイルの名前は固定です。
BASP21 と iSeries Access とか Client Access は、自力でインストールして下さい。
当然ですが、保管ジョブとＦＴＰは別ジョブなので、移送用ライブラリに QTEMP は使えません。
［re977001.hta：ここから］======================================================================
<html>
<head>
<HTA:APPLICATION
APPLICATIONNAME="ＡＳ保管＆ダウンロード"
ICON="wupdmgr.exe"
SCROLL="no"
/>
<style type="text/css">
<!--
body,select,input,td {
font-family : monospace;
}
h1 {
margin-top : 0.5em;
padding-top : 0.2em;
padding-bottom : 0.2em;
margin-bottom : 0.5em;
padding-left : 1em;
color : #3333ff;
background-color : #99ffff;
font-size : 130%;
}
p {
margin-top : 0 em;
padding-top : 0 em;
padding-bottom : 0 em;
margin-bottom : 0 em;
}
textarea.data_list {
font-family : monospace;
font-size : 150%;
}
textarea.log_list {
font-family : monospace;
}
input.pc_file {
width : 23em;
}
input.text {
font-family : monospace;
width : 8em;
}
-->
</style>
</head>
<body onload="onload_proc()">
<form id="form_main" onsubmit="">
<h1 id="page_title">対象ＡＳ</h1>
<p>保管するオブジェクト名・ソースメンバー名を、改行で区切って入れて下さい。</p>
<table >
<tr><td colspan="2">
<input type=button onclick="Download_source_member()" value="メンバー①" />
<input type=button onclick="Download_object()" value="オブジェクト②" />
<input type=button onclick="Download_Lib()" value="ライブラリ③" />
</td></tr>
<tr>
<td>
<textarea class="data_list" name="member_lists" rows="13" cols="10"></textarea>
</td>
<td class="form_options">
<dl>
<dt>ダウンロードフォルダ（末尾の \ は無くても可）①②③</dt>
<dd>
<input class="pc_file" name="data_dir" value="C:\_D\_Dairy\" />
</dd>
<dt>ソースファイル①</dt>
<dd>
<select name="Source_file_name" size="5" >
<option value="QCLPSRC,QCLPSAVF,112">QCLPSRC</option>
<option value="QDDSSRC,QDDSSAVF,92" >QDDSSRC</option>
<option value="QDSPSRC,QDSPSAVF,112">QDSPSRC</option>
<option value="QPRTSRC,QPRTSAVF,112">QPRTSRC</option>
<option value="QRPGSRC,QRPGSAVF,112" selected>QRPGSRC</option>
</select>
</dd>
<dt>対象ＡＳ①②③</dt>
<dd>
<!--
<input class="text" name="AS_SYSTEM" value="" />
-->
<select name="AS_SYSTEM" size="2" >
<option value="192.168.100.100" selected>自社</option>
<option value="192.168.100.110" >客先</option>
</select>
<input name="SAV_PRV" type="checkbox">TGTRLS(*PRV)
<input name="SAV_DTACPR" type="checkbox">DTACPR(*HIGH)
</dd>
<dt>保管対象ライブラリ名①②③</dt>
<dd>
<input class="text" name="AS_lib_from" value="PGMLIB" />
</dd>
<dt>移送用ライブラリ名①②③（QTEMP不可）</dt>
<dd>
<input class="text" name="AS_lib_to" value="QGPL" />
</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>
<textarea class="log_list" id="results" rows="12" cols="80"></textarea>
</form>
<script language="VBScript">
option explicit
Const C_title_text = "ＡＳ保管＆ダウンロード"
'接続初期値
Const C_Default_AS = "192.168.100.100"
Const C_Default_user = "USERID"
Const C_Default_pass = "PASSWORD"
Const C_window_width = 615
Const C_window_height = 680
dim rt,i
'--------------------------------------------------------------------------------
'オブジェクトのダウンロード
Sub Download_object()
dim L_AS400
dim L_conarray
dim L_SRCF,L_SAVF,L_SRCF_LEN
dim L_AS_CMD,L_cmd_str
dim LA_member,L_member
dim L_FTP
dim L_server_file,L_Local_file
'１．ＡＳ／４００接続
'３．移動用ＳＡＶＦの削除＆作成
'５．ソースファイルのＳＡＶＦへの保管（たーげっとも考慮）
'６．ＳＡＶＦのＦＴＰダウンロード
'１．ＡＳ／４００接続
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_CMD = createobject("cwbx.Command")
Set L_AS_CMD.system = L_AS400
On Error Resume Next
'３．移動用ＳＡＶＦの削除＆作成
L_SAVF = "OBJECTSAVF"
L_cmd_str = "DLTF " & document.all("AS_lib_to").value & "/" & L_SAVF
Call S_add_result(L_cmd_str)
L_AS_CMD.run L_cmd_str
'こけても無視
If Err = -2147467259 Then Err.Clear
L_cmd_str = "CRTSAVF " & document.all("AS_lib_to").value & "/" & L_SAVF
Call S_add_result(L_cmd_str)
L_AS_CMD.run L_cmd_str
If Err.Number <> 0 Then
Call S_add_result(Err.Description) '結果メッセージの表示
Set L_AS_CMD = Nothing
Set L_AS400 = Nothing
exit sub
end if
'４．保管オブジェクト文字列の作成 → L_SRCF
L_SRCF ="("
LA_member = Split(document.all("member_lists").value,vbcrlf)
for i = 0 to UBound(LA_member) 'それぞれのメンバー毎の処理
L_member = trim(LA_member(i))
if L_member <> "" then 'ブランク行は無視で。
L_SRCF = L_SRCF & L_member & " "
end if
next
L_SRCF = L_SRCF & ")"
'５．ソースファイルのＳＡＶＦへの保管
L_cmd_str = "SAVOBJ " & L_SRCF
L_cmd_str = L_cmd_str & " " & document.all("AS_lib_from").value
L_cmd_str = L_cmd_str & " *SAVF SAVF("
L_cmd_str = L_cmd_str & document.all("AS_lib_to").value & "/" & L_SAVF & ")"
if document.all("SAV_DTACPR").checked then
L_cmd_str = L_cmd_str & " DTACPR(*HIGH)"
end if
if document.all("SAV_PRV").checked then
L_cmd_str = L_cmd_str & " TGTRLS(*PRV)"
end if
Call S_add_result(L_cmd_str)
L_AS_CMD.run L_cmd_str
If Err.Number <> 0 Then
Call S_add_result(Err.Description) '結果メッセージの表示
Set L_AS_CMD = Nothing
Set L_AS400 = Nothing
exit sub
end if
Set L_AS_CMD = Nothing
Set L_AS400 = Nothing
On Error Goto 0
'６．ＳＡＶＦのＦＴＰダウンロード
Set L_FTP = CreateObject("basp21.FTP") ' WSH
If Err.Number <> 0 Then
Call S_add_result(Err.Description) '結果メッセージの表示
Set L_AS_CMD = Nothing
Set L_AS400 = Nothing
exit sub
end if
'接続
rt = L_FTP.Connect(document.all("AS_SYSTEM").value,document.all("AS_UID").value,document.all("AS_PWD").value)
If rt <> 0 Then
Call S_add_result("ＦＴＰ接続失敗" & vbcrlf & document.all("AS_SYSTEM").value) '結果メッセージの表示
Set L_FTP = Nothing
exit sub
end if
'ダウンロード
L_server_file = document.all("AS_lib_to").value & "/" & L_SAVF
L_Local_file = document.all("data_dir").value & "\" & L_SAVF
Call S_add_result("get " & L_server_file & " " & L_Local_file) '結果メッセージの表示
rt = L_FTP.GetFile(L_server_file,L_Local_file,1) ' バイナリファイルの受信
If rt <> 1 Then
Call S_add_result("ＦＴＰＧＥＴ失敗" & vbcrlf & L_server_file & vbcrlf & L_Local_file & vbcrlf & L_FTP.GetReply()) '結果メッセージの表示
Set L_FTP = Nothing
exit sub
end if
Set L_FTP = Nothing
Set L_AS_CMD = Nothing
Set L_AS400 = Nothing
Call S_add_result("ダウンロード完了") '結果メッセージの表示
end sub
'--------------------------------------------------------------------------------
'ライブラリダウンロード
Sub Download_Lib()
dim L_AS400
dim L_conarray
dim L_SRCF,L_SAVF,L_SRCF_LEN
dim L_AS_CMD,L_cmd_str
dim LA_member
dim L_FTP
dim L_server_file,L_Local_file
'１．ＡＳ／４００接続
'２．移動用ＳＲＣＦの削除＆作成
'３．移動用ＳＡＶＦの削除＆作成
'４．ソースメンバーのコピー
'５．ソースファイルのＳＡＶＦへの保管（たーげっとも考慮）
'６．ＳＡＶＦのＦＴＰダウンロード
'１．ＡＳ／４００接続
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_CMD = createobject("cwbx.Command")
Set L_AS_CMD.system = L_AS400
L_SAVF = trim(document.all("AS_lib_from").value)
if len(L_SAVF) > 10 Then
L_SAVF = left(L_SAVF,10)
end if
On Error Resume Next
'３．移動用ＳＡＶＦの削除＆作成
L_cmd_str = "DLTF " & document.all("AS_lib_to").value & "/" & L_SAVF
Call S_add_result(L_cmd_str)
L_AS_CMD.run L_cmd_str
'こけても無視
If Err = -2147467259 Then Err.Clear
L_cmd_str = "CRTSAVF " & document.all("AS_lib_to").value & "/" & L_SAVF
Call S_add_result(L_cmd_str)
L_AS_CMD.run L_cmd_str
If Err.Number <> 0 Then
Call S_add_result(Err.Description) '結果メッセージの表示
Set L_AS_CMD = Nothing
Set L_AS400 = Nothing
exit sub
end if
'５．ソースファイルのＳＡＶＦへの保管
L_cmd_str = "SAVLIB " & document.all("AS_lib_from").value & " *SAVF SAVF("
L_cmd_str = L_cmd_str & document.all("AS_lib_to").value & "/" & L_SAVF & ")"
L_cmd_str = L_cmd_str & " SAVACT(*LIB)"
if document.all("SAV_DTACPR").checked then
L_cmd_str = L_cmd_str & " DTACPR(*HIGH)"
end if
if document.all("SAV_PRV").checked then
L_cmd_str = L_cmd_str & " TGTRLS(*PRV)"
end if
Call S_add_result(L_cmd_str)
L_AS_CMD.run L_cmd_str
If Err.Number <> 0 Then
Call S_add_result(Err.Description) '結果メッセージの表示
Set L_AS_CMD = Nothing
Set L_AS400 = Nothing
exit sub
end if
Set L_AS_CMD = Nothing
Set L_AS400 = Nothing
On Error Goto 0
'６．ＳＡＶＦのＦＴＰダウンロード
Set L_FTP = CreateObject("basp21.FTP") ' WSH
If Err.Number <> 0 Then
Call S_add_result(Err.Description) '結果メッセージの表示
Set L_AS_CMD = Nothing
Set L_AS400 = Nothing
exit sub
end if
'接続
rt = L_FTP.Connect(document.all("AS_SYSTEM").value,document.all("AS_UID").value,document.all("AS_PWD").value)
If rt <> 0 Then
Call S_add_result("ＦＴＰ接続失敗" & vbcrlf & document.all("AS_SYSTEM").value) '結果メッセージの表示
Set L_FTP = Nothing
exit sub
end if
'ダウンロード
L_server_file = document.all("AS_lib_to").value & "/" & L_SAVF
L_Local_file = document.all("data_dir").value & "\" & L_SAVF
Call S_add_result("get " & L_server_file & " " & L_Local_file) '結果メッセージの表示
rt = L_FTP.GetFile(L_server_file,L_Local_file,1) ' バイナリファイルの受信
If rt <> 1 Then
Call S_add_result("ＦＴＰＧＥＴ失敗" & vbcrlf & L_server_file & vbcrlf & L_Local_file & vbcrlf & L_FTP.GetReply()) '結果メッセージの表示
Set L_FTP = Nothing
exit sub
end if
Set L_FTP = Nothing
Set L_AS_CMD = Nothing
Set L_AS400 = Nothing
Call S_add_result("ダウンロード完了") '結果メッセージの表示
end sub
'--------------------------------------------------------------------------------
'ソースファイルのダウンロード
Sub Download_proc()
dim L_AS400
dim L_conarray
dim L_SRCF,L_SAVF,L_SRCF_LEN
dim L_AS_CMD,L_cmd_str
dim LA_member
dim L_FTP
dim L_server_file,L_Local_file
'１．ＡＳ／４００接続
'２．移動用ＳＲＣＦの削除＆作成
'３．移動用ＳＡＶＦの削除＆作成
'４．ソースメンバーのコピー
'５．ソースファイルのＳＡＶＦへの保管（たーげっとも考慮）
'６．ＳＡＶＦのＦＴＰダウンロード
'１．ＡＳ／４００接続
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_CMD = createobject("cwbx.Command")
Set L_AS_CMD.system = L_AS400
On Error Resume Next
'２．移動用ＳＲＣＦの削除＆作成
L_conarray = split(document.all("Source_file_name").value,",")
L_SRCF = L_conarray(0)
L_SAVF = L_conarray(1)
L_SRCF_LEN = L_conarray(2)
L_cmd_str = "DLTF " & document.all("AS_lib_to").value & "/" & L_SRCF
Call S_add_result(L_cmd_str)
L_AS_CMD.run L_cmd_str
'こけても無視
If Err = -2147467259 Then Err.Clear
L_cmd_str = "CRTSRCPF " & document.all("AS_lib_to").value & "/" & L_SRCF & " RCDLEN(" & L_SRCF_LEN & ") IGCDTA(*YES)"
Call S_add_result(L_cmd_str)
L_AS_CMD.run L_cmd_str
If Err.Number <> 0 Then
Call S_add_result(Err.Description) '結果メッセージの表示
Set L_AS_CMD = Nothing
Set L_AS400 = Nothing
exit sub
end if
'３．移動用ＳＡＶＦの削除＆作成
L_cmd_str = "DLTF " & document.all("AS_lib_to").value & "/" & L_SAVF
Call S_add_result(L_cmd_str)
L_AS_CMD.run L_cmd_str
'こけても無視
If Err = -2147467259 Then Err.Clear
L_cmd_str = "CRTSAVF " & document.all("AS_lib_to").value & "/" & L_SAVF
Call S_add_result(L_cmd_str)
L_AS_CMD.run L_cmd_str
If Err.Number <> 0 Then
Call S_add_result(Err.Description) '結果メッセージの表示
Set L_AS_CMD = Nothing
Set L_AS400 = Nothing
exit sub
end if
'４．ソースメンバーのコピー
LA_member = Split(document.all("member_lists").value,vbcrlf)
for i = 0 to UBound(LA_member) 'それぞれのメンバー毎の処理
if LA_member(i) <> "" then 'ブランク行は無視で。
L_cmd_str = "CPYSRCF " & document.all("AS_lib_from").value & "/" & L_SRCF
L_cmd_str = L_cmd_str & " " & document.all("AS_lib_to").value & "/" & L_SRCF
L_cmd_str = L_cmd_str & " " & LA_member(i)
Call S_add_result(L_cmd_str)
L_AS_CMD.run L_cmd_str
If Err.Number <> 0 Then
Call S_add_result(Err.Description) '結果メッセージの表示
Set L_AS_CMD = Nothing
Set L_AS400 = Nothing
exit sub
end if
end if
next
'５．ソースファイルのＳＡＶＦへの保管
L_cmd_str = "SAVOBJ " & L_SRCF
L_cmd_str = L_cmd_str & " " & document.all("AS_lib_to").value
L_cmd_str = L_cmd_str & " *SAVF SAVF("
L_cmd_str = L_cmd_str & document.all("AS_lib_to").value & "/" & L_SAVF & ")"
if document.all("SAV_DTACPR").checked then
L_cmd_str = L_cmd_str & " DTACPR(*HIGH)"
end if
if document.all("SAV_PRV").checked then
L_cmd_str = L_cmd_str & " TGTRLS(*PRV)"
end if
Call S_add_result(L_cmd_str)
L_AS_CMD.run L_cmd_str
If Err.Number <> 0 Then
Call S_add_result(Err.Description) '結果メッセージの表示
Set L_AS_CMD = Nothing
Set L_AS400 = Nothing
exit sub
end if
Set L_AS_CMD = Nothing
Set L_AS400 = Nothing
On Error Goto 0
'６．ＳＡＶＦのＦＴＰダウンロード
Set L_FTP = CreateObject("basp21.FTP") ' WSH
If Err.Number <> 0 Then
Call S_add_result(Err.Description) '結果メッセージの表示
Set L_AS_CMD = Nothing
Set L_AS400 = Nothing
exit sub
end if
'接続
rt = L_FTP.Connect(document.all("AS_SYSTEM").value,document.all("AS_UID").value,document.all("AS_PWD").value)
If rt <> 0 Then
Call S_add_result("ＦＴＰ接続失敗" & vbcrlf & document.all("AS_SYSTEM").value) '結果メッセージの表示
Set L_FTP = Nothing
exit sub
end if
'ダウンロード
L_server_file = document.all("AS_lib_to").value & "/" & L_SAVF
L_Local_file = document.all("data_dir").value & "\" & L_SAVF
Call S_add_result("get " & L_server_file & " " & L_Local_file) '結果メッセージの表示
rt = L_FTP.GetFile(L_server_file,L_Local_file,1) ' バイナリファイルの受信
If rt <> 1 Then
Call S_add_result("ＦＴＰＧＥＴ失敗" & vbcrlf & L_server_file & vbcrlf & L_Local_file & vbcrlf & L_FTP.GetReply()) '結果メッセージの表示
Set L_FTP = Nothing
exit sub
end if
Set L_FTP = Nothing
Set L_AS_CMD = Nothing
Set L_AS400 = Nothing
Call S_add_result("ダウンロード完了") '結果メッセージの表示
end sub
'--------------------------------------------------------------------------------
'結果ログの追加
sub S_add_result(P_msg)
dim L_time,L_time_text
L_time = time
L_time_text = right("00" & datepart("h",L_time),2) & ":" & right("00" & datepart("n",L_time),2) & ":" & right("00" & datepart("s",L_time),2)
document.all.form_main("results").value = document.all.form_main("results").value & L_time_text & " " & P_msg & vbcrlf
end sub
'--------------------------------------------------------------------------------
'添付オブジェクト操作
Sub Download_source_member()
if document.all.form_main.member_lists.value <> "" then
Download_proc()
msgbox "ダウンロードが完了しました。"
else
msgbox "ダウンロードするソースメンバー名を指定して下さい。"
end if
end sub
'--------------------------------------------------------------------------------
sub onload_proc()
document.title = C_title_text
document.all("page_title").innerText = C_title_text
rt = window.resizeTo(C_window_width,C_window_height)
'初期値設定
document.all("AS_SYSTEM").value = C_Default_AS
document.all("AS_UID").value = C_Default_user
document.all("AS_PWD").value = C_Default_pass
end sub
'--------------------------------------------------------------------------------
</script>
</body></html>
［re977001.hta：ここまで］======================================================================