[TCPLINK SCRIPT HEADER]
DESCRIPTION=Dataset Last Line(3270 Emulator)
[TCPLINK SCRIPT SOURCE]
'Option Explicit
Dim emlECLPSObj
Dim Row, Col
Dim sThisSessionName, sThisMacroName
Dim sMsg
'*********************************************************************
'* TN3270画面操作
'* 入力テキストの内容の複数のデータセット(メンバ)名を読んで、
'* 画面面操作フローに従い、データセット(メンバ)の行数をテキスト出力する
'*
'* 入力テキスト ：データセット(メンバ) ※複数行指定可
'* 画面操作(以下の繰返し)
'* '■1.データセットを選択して実行 ※メンバなしを考慮
'* '■2.最終行へJUMPする (L 9999)
'* '■3.先頭行の行値を取得する
'* 出力テキスト（CSV）：データセット(メンバ)、データセット、メンバ,行数
'*
'*********************************************************************
'------------------------------
' 初期
'------------------------------
'共通プロパティ値の設定
sThisMacroName = GetCommonMacroname()
sThisSessionName = GetCommonSessionName()
Set emlECLPSObj = CreateObject("TESSC.emlECLPS")
emlECLPSObj.SetConnectionByName(sThisSessionName)
Dim wOKCnt:wOKCnt = 0
Dim wNGCnt:wNGCnt = 0
Dim iLine:iLine = 0
Dim lmilliseconds1:lmilliseconds1 = 3000
Dim lmilliseconds2:lmilliseconds2 = 1000
Dim IfileName:Ifilename = "In.txt" '入力ファイル名
Dim OfileName:Ofilename = sThisMacroName & "_1" & ".csv" '出力ファイル名
Dim IfilenameFullPath:IfilenameFullPath = GetCurFdr & "\" & IFilename
'------------------------------
' 主処理
'------------------------------
Dim MyVar
Dim arrText
Dim iInCnt
Dim sDSN, sMbr
Dim sTitle:sTitle = sThisMacroName
Dim sDsName:sDsName = ""
Dim sDsName1:sDsName1 = ""
If IsEnableEnv(sTitle) = False Then
MsgBox "ヘルスチェック：利用不可です",64,sTitle
Else
' 処理開始画面の確認
If IsFirstMap1 Then
' 入力ファイルの内容をを配列へ読込む
arrText = GetFileToArr(IfilenameFullPath)
iInCnt = UBound(arrText)
If UBound(arrText) >= 1 Then
sMsg = "処理を開始しますか：" & vbCrlf & " " & vbCrlf & _
"入力DIR ：" & GetCurFdr & vbCrlf & _
"入力ファイル：" & Ifilename & vbCrlf & _
" 件数：" & iInCnt & vbCrlf & _
"出力ファイル：" & Ofilename
MyVar = MsgBox (sMsg,vbYesNo,sTitle)
If MyVar = vbNo Then
MsgBox " 処理を中止しました。",vbExclamation,sTitle
Else
' 出力ファイルの存在確認して存在していれば削除する
FileDel(Ofilename)
Set fso = CreateObject("Scripting.FileSystemObject")
Set file = fso.OpenTextFile(".\" & Ofilename,8,True)
' 配列のファイル名を1行ずつ表示
For i = 0 To iInCnt - 1
'MsgBox arrText(i)
sDsName1 = arrText(i)
'*** データセットを開いて最大行数を求める
iLine = DsBrows_Main_Ready(sDsName1)
' 文字列分割（データセットとメンバーに分割）
If sDsName1 <> "" Then
sDSN = ""
sMbr = ""
Dim arr
arr = Split(sDsName1,"(")
If UBound(arr) = 1 Then
sDSN = replace(arr(0),")","")
sMbr = replace(arr(1),")","")
End If
End If
'結果行数を確認
If iLine > 0 Then
'データセットメンバーの内容が表示できた時
file.WriteLine(sDsName1 & "," & sDSN & "," & sMbr & "," & iLine)
wOKCnt = wOKCnt + 1
'BROWS画面へ戻る
SetReturnKey
Else
'データセットメンバーが開けなかった時
file.WriteLine(sDsName1 & "," & sDSN & "," & sMbr & "," & "********")
wNGCnt = wNGCnt + 1
End If
' --- 待機する時間 ---
SetWaitTime(lmilliseconds1)
Next
' 出力ファイル後処理
file.Close
Set fso = Nothing
End If
End If
sMsg = "処理終了しました：" & vbCrlf & _
"入力：" & IFilename & " 件数：" & iInCnt & vbCrlf & _
"出力：" & Ofilename & vbCrlf & _
" OK件数：" & wOKCnt & vbCrlf & _
" NG件数：" & wNGCnt
MsgBox sMsg,64,sTitle
Else
MsgBox "処理開始の画面が違います",vbCritical,sTitle
End If
End If
'
' ************************************************
' 関数
' ************************************************
' ------------------------------------------------
' 画面操作フロー実行
' ------------------------------------------------
Function DsBrows_Main_Ready(sDsName)
Dim iLine:iLine = 0
DsBrows_Main_Ready = 0
'■1.データセットを選択して実行
SetMap1DsnameAndGo(sDsName)
SetWaitTime(lmilliseconds1) ' 待機
' メンバーなしの確認
If IsMbrNotFndChar(sDsName) = True Then
Exit Function
End If
SetWaitTime(lmilliseconds1) ' 待機
'■2.最終行へJUMPする (L 9999)
SetGoBottomKey
'■3.先頭行の行値を取得する
'待機する時間
SetWaitTime(lmilliseconds1) ' 待機
iLine = GetMaxLine
DsBrows_Main_Ready = iLine
End Function
' ------------------------------------------------
' カレントフォルダ取得
' ------------------------------------------------
Function GetCurFdr
GetCurFdr = ""
'ファイルシステムオブジェクト作成
Set fso = CreateObject("Scripting.FileSystemObject")
'カレントの絶対パス'
GetCurFdr = fso.GetAbsolutePathName(".")
End Function
' ------------------------------------------------
' 入力ファイルの配列読込
' ------------------------------------------------
Function GetFileToArr(IfilenameFullPath)
GetFileToArr = False
'ファイルシステムオブジェクト作成
Set objFS = CreateObject("Scripting.FileSystemObject")
' ファイルオープン
Set objText = objFS.OpenTextFile(IfilenameFullPath)
' 全行読み込む
strText = objText.ReadAll
' ファイルクローズ
objText.Close
' 改行で分割
arrText = Split(strText, vbCrLf)
'配列をセット
GetFileToArr = arrText
End Function
' ------------------------------------------------
' テキストファイルの存在確認をして削除する
' ------------------------------------------------
'テキストファイルの存在を確認して削除する
Function FileDel(Ofilename)
Dim file:FileDel = False
' ファイルの存在確認して存在していれば削除する
Set fso = CreateObject("Scripting.FileSystemObject")
file = Ofilename
If(fso.FileExists(file))Then
fso.DeleteFile file
End If
Set fso = Nothing
FileDel = True
End Function
' ------------------------------------------------
' 画面取得（最終行を表示して右方表示の行数値取得）
' ------------------------------------------------
Function GetMaxLine
Dim row, col '画面位置
Dim LenToGet
'値取得位置
row = 1
col = 57
LenToGet = 10
GetMaxLine = emlECLPSObj.GetText(row, col,LenToGet)
GetMaxLine = trim(GetMaxLine)
'MsgBox "右肩の数字を表示" & GetMaxLine,64,sTitle
'数値判定
'If IsNumeric(GetMaxLine) = False then
' MsgBox "数値ではありません",64,sTitle
'End If
End Function
' ------------------------------------------------
' 画面実行（データセットを指定して実行する）
' ------------------------------------------------
Function SetMap1DsnameAndGo(sDsName)
Dim row:row = 11 '画面位置（行）
Dim col:col = 20 '画面位置（列）
Dim SPCCLEAR
SPCCLEAR = " "
'クリヤー
emlECLPSObj.SetText SPCCLEAR, row, col
sDsName = sDsName & "[enter]"
emlECLPSObj.SendKeys sDsName, row, col
End Function
' ------------------------------------------------
' 画面実行（最終行へジャンプ）
' ------------------------------------------------
Function SetGoBottomKey
Dim row:row = 2 '画面位置（行）
Dim col:col = 18 '画面位置（列）
Dim sReturnKey
sReturnKey = "L 9999" & "[enter]"
emlECLPSObj.SendKeys sReturnKey, row, col
End Function
' ------------------------------------------------
' 画面実行（戻る）
' ------------------------------------------------
Function SetReturnKey
Dim row:row = 8 '画面位置（行）
Dim col:col = 31 '画面位置（列）
Dim sReturnKey
sReturnKey = "[PF3]"
emlECLPSObj.SendKeys sReturnKey, row, col
End Function
' ------------------------------------------------
' 画面の判定（メンバー文言）の存在判定
' ------------------------------------------------
Function IsMbrNotFndChar(sDsName)
Dim row:row = 1 '画面位置（行）
Dim col:col = 57 '画面位置（列）
Dim LenToGet:LenToGet = 22 '長さ
Dim StatusKey:StatusKey = "メンバーが見つからない"
Dim StatusChar
IsMbrNotFndChar = False
' 文字列の存在有無と判定
StatusChar = Trim(emlECLPSObj.GetText(row, col,LenToGet))
If StatusChar = StatusKey Then
IsMbrNotFndChar = True
End If
End Function
' ------------------------------------------------
' 画面の判定（開始画面）
' ------------------------------------------------
Function IsFirstMap1
Dim row:row = 1 '画面位置（行）
Dim col:col = 34 '画面位置（列）
Dim sBgnKey:sBgnKey = "表示入力パネル"
IsFirstMap1 = False
' 文字列の存在有無と判定
If emlECLPSObj.SearchText(sBgnKey, 1, row, col) Then
IsFirstMap1 = True
End If
End Function
' ------------------------------------------------
' 指定時間、処理を待機する
' ------------------------------------------------
Function SetWaitTime(lmilliseconds1)
emlECLPSObj.Wait(lmilliseconds1)
End Function
' ------------------------------------------------
' 共通プロパティの取得
' ------------------------------------------------
Function GetCommonMacroname
GetCommonMacroname = ThisMacroName
End Function
Function GetCommonSessionName
GetCommonSessionName = ThisSessionName
End Function
' ------------------------------------------------
' ヘルスチェック 利用可能判定
' ------------------------------------------------
Function IsEnableEnv(sTitle)
Dim bStarted:bStarted = emlECLPSObj.Started '
Dim bCommStarted:bCommStarted = emlECLPSObj.CommStarted '
Dim bAPIEnabled:bAPIEnabled = emlECLPSObj.APIEnabled '
Dim bReady:bReady = emlECLPSObj.Ready '
'
IsEnableEnv = False
If (bStarted = True and _
bCommStarted = True and _
bAPIEnabled = True and _
bReady = True) then
IsEnableEnv = True
Else
sMsg = " Started ：" & bStarted & vbCrlf & _
" CommStarted ：" & bCommStarted & vbCrlf & _
" APIEnabled ：" & bAPIEnabled & vbCrlf & _
" Ready ：" & bReady
Msgbox sMsg,64,sTitle
End If
End Function
