[TCPLINK SCRIPT HEADER]
DESCRIPTION=Job Run TimeStamp Information List(3270 Emulator)
[TCPLINK SCRIPT SOURCE]
'Option Explicit
' *************************************************************
' 機能：指定したJOBの実行日時を取得する
' 入力：マクロ名+_I.txt メンバ名を行列記する
' 出力：マクロ名+_0.CSV LIB名、メンバ名、タイムスタンプ
' 変更履歴
' 2023.06.29 入力テキストに空行がある時は、処理対象としない
' *************************************************************
Dim emlECLPSObj
Dim sThisSessionName, sThisMacroName
Dim sMsg
Dim sDsName
Dim Row, Col, Rows, Cols, CurRow, CurCol
Dim iDataPos
Dim Text
' 初期 -------------------------------------------
Dim G_Ver:G_Ver = " 1.0 "
Dim iDebug:iDebug = 0
Dim lmilliseconds: lmilliseconds = 3000
Dim lmilliseconds2:lmilliseconds2 = 1000
Dim BeginKey:BeginKey = "表示入力パネル"
' 共通プロパティー値の設定 -----------------------
sThisMacroName = Replace(GetCommonMacroname(),".mac","")
sThisSessionName = GetCommonSessionName()
Set emlECLPSObj = CreateObject("TESSC.emlECLPS")
emlECLPSObj.SetConnectionByName(sThisSessionName)
Dim sTitle:sTitle = sThisMacroName
Dim IFileNm:IFileNm = sThisMacroName & "_I.txt"
Dim OFileNm:OFileNm = sThisMacroName & "_O.CSV"
Dim sMemNm:sMemNm = ""
Dim sLibNm:sLibNm = "ZLOGF\1"
sDsName = sLibNm & "(" & sMemNm & ")"
Dim iCnt, wCnt, wCnt_MemNfd, wCnt_SerchFail
iCnt=0:wCnt=0:wCnt_MemNfd =0:wCnt_SerchFail=0
' 主処理 ----------------------------------------
If IsEnableEnv(sTitle) = False Then
MsgBox " ヘルスチェック：利用不可です",64,sTitle
Else
'処理開始画面の確認
If IsFirstMap(BeginKey) Then
'*メンバー数分の繰返し開始
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileEXISTS(IFileNm) = True Then
Set file1 = fso.OpenTextFile(".\" & IFileNm)
Set file2 = fso.OpenTextFile(".\" & OFileNm, 2, True)
sMsg = " 入力File名：" & IFileNm & vbCrLf & _
" 対象LIB名 ：" & sLibNm & vbCrLf & _
" 検索ワード：" & "Member" & vbCrLf & _
" 出力File名：" & OFileNm
MyVar = MsgBox (sMsg, vbYesNo, sTitle & G_Ver)
If MyVar = vbYES Then
wCnt = 0
Do Until file1.AtEndOfStream
sMemNm = file1.readline
iCnt = iCnt + 1
'■1.データセットとメンバーを指定
If sMemNm <> "" Then
sDsName = sLibNm & "(" & sMemNm & ")"
SetBrowsMapDsnameGo(sDsName)
SetWaitTime(lmilliseconds) '待機する時間
If IsFirstMap(BeginKey) Then
'■5.画面「表示入力パネル」 'メンバー無しの時
file2.WriteLine(sLibNm & "," & sMemNm)
wCnt_MemNfd = wCnt_MemNfd + 1
Else
'■2.画面「表示入力パネル」から遷移
'表示したモジュールからタイムスタンプ取得しファイル出力
'①.文字列検索で検索値をセットして実行する
FindChars("F " & sMemNm)
'検索値へカーソル移動
Enter
SetWaitTime(lmilliseconds) '待機する時間
'②.文字列検索した行をファイル出力する
Rows = emlECLPSObj.NumRows:Cols= emlECLPSObj.NumCols '画面の行数列数を取得
CurRow = emlECLPSObj.CursorPosRow:CurCol = emlECLPSObj.CursorPosCol '検索結果の行列番号を取得
iDataPos = CurCol ' 画面の取得開始位置を指定
' 検索値の取得
Dim Text1, Text2, Text3, Text4
Text1 = emlECLPSObj.GetText(CurRow,iDataPos,8)
Text2 = emlECLPSObj.GetText(CurRow,iDataPos+11,8)
Text3 = emlECLPSObj.GetText(CurRow,iDataPos+23,8)
Text4 = emlECLPSObj.GetText(CurRow,iDataPos+35,8)
'Msgbox " Text1=" & Text1 & _
' " Text2=" & Text2 & _
' " Text3=" & Text3 & _
' " Text4=" & Text4
'■3.検索結果を含めて、テキストファイルへ書き出す
If CurRow > 4 then
' ①1検索成功の場合
file2.WriteLine(sLibNm &"," & sMemNm & "," & _
"#" & Text1 & "," & "#" & Text2 & "," & _
"#" & Text3 & "," & "#" & Text4)
wCnt = wCnt + 1
Else
' ②2検索失敗の場合
file2.WriteLine(sLibNm & "," & sMemNm)
wCnt_SerchFail = wCnt_SerchFail + 1
End If
If iDebug = 1 Then
sMsg = " 入力File名 ： " & IFileNm & vbCrLf & _
"【処理結果】 " & vbCrLf & _
" DSNAME ： " & sLibNm & "（" & sMemNm & "）" & vbCrLf & _
" 画面行列数 ：（" & Rows & "：" & Cols & "）" & vbCrLf & _
" 検索ワード ： " & "F " & sMemNm & vbCrLf & _
" Cur行列 ：（" & CurRow & "：" & CurCol & "）" & vbCrLf & _
" Get開始列 ： " & iDataPos & vbCrLf & _
" GetTEXT ： " & Text & vbCrLf & _
"出力File名 ： " & OFileNm
MyVar = MsgBox (sMsg,,sTitle & G_Ver)
End If
SetWaitTime(lmilliseconds2) '待機する時間
'■4.'前画面(画面「表示入カパネル」)に戻る
PF3
End If
End If
Loop
' 終了 -----------------------------------
file1.Close:file2.Close
Set fso = Nothing
sMsg = " 処理終了 " & vbCrlf & _
" 入力ファイル " & IFileNm & vbCrlf & _
" 件数 ：" & iCnt & VbCrlf & _
" 出カファイル ：" & OFileNm & vbCrlf & _
" 件数（正常） ：" & wCnt & vbCrlf & _
" 件数（メンバ否）：" & wCnt_MemNfd & vbCrlf & _
" 件数（検索否） ：" & wCnt_SerchFail
MsgBox sMsg, vbInformation, sTitle & G_Ver
Else
MsgBox " 処理続行に「いいえ」と応答 ",vbCritical,sTitle & G_Ver
End If
Else
MsgBox " 入力テキストファイルが存在しません " & IFileNm,vbCritical,sTitle & G_Ver
End If
Else
MsgBox " 開始画面は「表示入力パネル」です。" ,vbCritical,sTitle & G_Ver
End If
End If
' ************************************************
' 関数
' ************************************************
' ------------------------------------------------
' 画面の判定（開始画面）
' ------------------------------------------------
Function IsFirstMap(BeginKey)
Dim row:row = 1 '画面位置（行）
Dim col:col = 34 '画面位置（列）
IsFirstMap = False
' 文字列の存在有無と判定
If emlECLPSObj.SearchText(BeginKey, 1, row, col) Then
IsFirstMap = True
End If
End Function
' 入力DS名の表示結果画面の判定 -------------------
Function IsDsFound(Key)
Dim row:row = 1 '画面位置（行）
Dim col:col = 11 '画面位置（列）
IsDsFound = False
' 文字列の存在確認と判定
If emlECLPSObj.SearchText(Key, 1, row, col) Then
IsDsFound = True
End If
End Function
' 表示入力画面でDS指定して実行する ---------------
Function SetBrowsMapDsnameGo(sDsName)
Dim row:row = 11 '画面位置（行）
Dim col:col = 20 '画面位置（列）
Dim sDsName1
sDsName1 = sDsName & "[enter]"
emlECLPSObj.SendKeys sDsName1, row, col
End Function
' 文字列の検索 -----------------------------------
Function FindChars(FindKey)
Dim row:row = 2 '画面位置（行）
Dim col:col = 18 '画面位置（列）
Dim sFindKey
sFindKey = FindKey & "[enter]"
emlECLPSObj.SendKeys sFindKey, row, col
End Function
' 指定時間、処理を待機する -----------------------
Function SetWaitTime(lmilliseconds)
emlECLPSObj.Wait(lmilliseconds)
End Function
' 共通プロパティの取得 --------------------------
Function GetCommonMacroname
GetCommonMacroname = ThisMacroName
End Function
Function GetCommonSessionName
GetCommonSessionName = ThisSessionName
End Function
' 空エンター -------------------------------------
Function Enter()
emlECLPSObj.SendKeys "[enter]"
End Function
' PF3で戻る --------------------------------------
Function PF3()
emlECLPSObj.SendKeys "[PF3]"
End Function
' カーソル位置の取得 -----------------------------
Function CurPos
'-カーソル位置の行数,桁数を取得-
Dim lCursorPosRow, lCursorPosCol
lCursorPosRow = emlECLPSObj.CursorPosRow
lCursorPosCol = emlECLPSObj.CursorPosCol
sMsg = "カーソル位置：" & _
LCursorPosRow & " 行 " &ICursorPosCol & " 列 "
MsgBox sMsg,, 64, sTitle
End Function
' 画面サイズの取得 -------------------------------
Function GetMapSize
' -表示スペース内での行数,桁数を取得-
Dim lNumRows, lNumCols
lNumRows = emlECLPSObj.NumRows
lNumCols = emlECLPSObj.NumCols
sMsg = "表示スペース：" & _
INumRows & " 行 " & lNumCols & " 列 "
'MsgBox sMsg,, 64, sTitle
End Function
' 接続情報の取得 ---------------------------------
Function ConnectInfo
Dim sNameCommStarted, lHandle, sConnType
' 接続に関する情報
sName = emlECLPSObj.Name
lHandle = emlECLPSObj.Handle
sConnType = emlECLPSObj.ConnType
sMsg = "接続情報 Name：" & sName & _
"lHandle ： " & lHandle & _
"sConnType ： " & sConnType
'MsgBox sMsg,, 64, sTitle
End Function
' コードページの取得 ------------------------------
Function GetCodePage
Dim ICodePage, sMsgCode
' コードページ
ICodePage = emlECLPSObj.CodePage
sMsgCode = "CodePage ：" & ICodePage
GetCodePage = sMsgCode
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
