'TN3270ModTマン.mac
[TCPLINK SCRIPT HEADER]
DESCRIPTION=Module TimeStamp Information List(3270 Emulator)
[TCPLINK SCRIPT SOURCE]
'Option Explicit
Dim emlECLPSObj
Dim sThisSessionName, sThisMacroName
Dim sMsg
Dim Text, iDataPos
Dim iCnt, wCnt, wCnt_MemNfd, wCnt_SerchFail
Dim SPCCLEAR
Dim sDsName, sDsName1
Dim Row, Col, Rows, Cols, CurRow, CurCol
' 初期 -------------------------------------------
' 共通プロパティー値の設定
sThisMacroName = Replace(GetCommonMacroname(),".mac","")
sThisSessionName = GetCommonSessionName()
Set emlECLPSObj = CreateObject("TESSC.emlECLPS")
emlECLPSObj.SetConnectionByName(ThisSessionName)
Dim sTitle:sTitle = sThisMacroName
Dim iDebug:iDebug = 0
Dim lmilliseconds:lmilliseconds = 3000:
Dim lmilliseconds2: lmilliseconds2 = 1000
Dim BeginKey:BeginKey = "表示入力パネル"
Dim sLibNm:sLibNm = "xxxxxxxxxxxxxxx"
Dim sMemNm:sMemNm = ""
Dim sYYY:sYYY = "202" '西暦年の上位3桁
Dim IFileNm:IFileNm = sThisMacroName & "_I.txt"
Dim OFileNm:OFileNm = sThisMacroName & "_O.CSV"
iCnt= 0:wCnt= 0:wCnt_MemNfd = 0:wCnt_SerchFail= 0
sDsName1 = sLibNm & "(" & sMemNm & ")"
' 主処理 -----------------------------------------
If IsEnabelEnv(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+" & sYYY & vbCrLf & _
" 出力File名：" & OFileNm
MyVar = MsgBox (sMsg, vbYesNo, sTitle)
If MyVar = vbYES Then
wCnt = 0
Do Until file1.AtEndOfStream
sMemNm = file1.readline
iCnt = iCnt + 1
'■1.データセットとメンバーを指
' SPCCLEAR = " "
'クリヤー
'emlECLPSObj.SetText SPCCLEAR, 8,31
sDsName1 = sLibNm & "(" & sMemNm & ")"
SetBrowsMapDsnameGo(sDsName1)
SetWaitTime(lmilliseconds) '待機する時間
If IsFirstMap(BeginKey) Then
'■5.画面「表示入力パネル」から遷移しない
file2.WriteLine(sLibNm & "," & sMemNm)
wCnt_MemNfd = wCnt_MemNfd + 1
Else
'■2.画面「表示入力パネル」から遷移
'表示したモジュールからタイムスタンプ取得しファイル出力
' ①.文字列検索で検索値をセットして実行する
FindChars("F " & sMemNm & sYYY)
'検索値へカーソル移動
Enter
SetWaitTime(lmilliseconds) '待機する時間
' ②.文字列検索した行をファイル出力する
'画面の行数列数を取得
Rows = emlECLPSObj.NumRows:Cols = emlECLPSObj.NumCols
' 検索結果の行・列番号を取得
CurRow = emlECLPSObj.CursorPosRow:CurCol = emlECLPSObj.CursorPosCol
' 画面の取得開始位置を指定
iDataPos = CurCol + len(sMemNm)
' 検索値の取得
Text = emlECLPSObj.GetText(CurRow,iDataPos,20)
'■3.検索結果を含めて、テキストファイルへ書き出す
If CurRow > 4 Then
' ①検索成功の場合
file2.WriteLine(sLibNm & "," & sMemNm & "," & "#" & Text)
wCnt = wCnt + 1
Else
' ②検索失敗の場合
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 & sYYY & 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
Loop
' 終了 ---------------------------
filel.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
Else
MsgBox " 処理を中止しました。",vbExclamation,sTitle
End If
Else
MsgBox " 入力ファイルが存在しません。" & IFileNm,vbCritical,sTitle
End If
Else
MsgBox " 開始画面は「表示入力パネル」です。",vbCritical,sTitle
End If
End If
'**************************************************
'* 開数
'**************************************************
' 指定時間、処理を待機する -----------------------
Function SetWaitTime(lmilliseconds)
emlECLPSObj.Wait(lmilliseconds)
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
' 開始画面の判定 ---------------------------------
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
' 文字列の検索 -----------------------------------
Function FindChars(FindKey)
Dim row:row = 2 '画面位置（行）
Dim col:col = 18 '画面位置（列）
Dim sFindKey
sFindKey = FindKey & "[enter]"
emlECLPSObj.SendKeys sFindKey, row, col
End Function
' 表示入力画面でDS指定して実行する ---------------
Function SetBrowsMapDsnameGo(sDsName1)
Dim row:row = 11 '画面位置（行）
Dim col:col = 20 '画面位置（列）
Dim sDsName
sDsName = sDsName1 & "[enter]"
emlECLPSObj.SendKeys sDsName, row, col
End Function
' 空エンター -------------------------------------
Function Enter()
emlECLPSObj.SendKeys "[enter]"
End Function
' PF3で戻る --------------------------------------
Function PF3()
emlECLPSObj.SendKeys "[PF3]"
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
' 画面サイズの取得 -------------------------------
Function GetMapSize
' -表示スペース内での行数,桁数を取得-
Dim row:row = emlECLPSObj.NumRows '画面位置（行）
Dim col:col = emlECLPSObj.NumCols '画面位置（列）
sMsg = " 表示スペース：" & _
row & " 行 " & col & " 列 "
'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 CurPos
'-カーソル位置の行数,桁数を取得-
Dim row:row = emlECLPSObj.CursorPosRow '画面位置（行）
Dim col:col = emlECLPSObj.CursorPosCol '画面位置（列）
sMsg = " カーソル位置：" & _
row & " 行 " & col & " 列 "
MsgBox sMsg,, 64, sTitle
End Function
[TCPLINK SCRIPT HEADER]
DESCRIPTION=Module TimeStamp Information List(3270 Emulator)
[TCPLINK SCRIPT SOURCE]
'Option Explicit
Dim emlECLPSObj
Dim sThisSessionName, sThisMacroName
Dim sMsg
Dim Text, iDataPos
Dim iCnt, wCnt, wCnt_MemNfd, wCnt_SerchFail
Dim SPCCLEAR
Dim sDsName, sDsName1
Dim Row, Col, Rows, Cols, CurRow, CurCol
' 初期 -------------------------------------------
' 共通プロパティー値の設定
sThisMacroName = Replace(GetCommonMacroname(),".mac","")
sThisSessionName = GetCommonSessionName()
Set emlECLPSObj = CreateObject("TESSC.emlECLPS")
emlECLPSObj.SetConnectionByName(ThisSessionName)
Dim sTitle:sTitle = sThisMacroName
Dim iDebug:iDebug = 0
Dim lmilliseconds:lmilliseconds = 3000:
Dim lmilliseconds2: lmilliseconds2 = 1000
Dim BeginKey:BeginKey = "表示入力パネル"
Dim sLibNm:sLibNm = "xxxxxxxxxxxxxxx"
Dim sMemNm:sMemNm = ""
Dim sYYY:sYYY = "202" '西暦年の上位3桁
Dim IFileNm:IFileNm = sThisMacroName & "_I.txt"
Dim OFileNm:OFileNm = sThisMacroName & "_O.CSV"
iCnt= 0:wCnt= 0:wCnt_MemNfd = 0:wCnt_SerchFail= 0
sDsName1 = sLibNm & "(" & sMemNm & ")"
' 主処理 -----------------------------------------
If IsEnabelEnv(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+" & sYYY & vbCrLf & _
" 出力File名：" & OFileNm
MyVar = MsgBox (sMsg, vbYesNo, sTitle)
If MyVar = vbYES Then
wCnt = 0
Do Until file1.AtEndOfStream
sMemNm = file1.readline
iCnt = iCnt + 1
'■1.データセットとメンバーを指
' SPCCLEAR = " "
'クリヤー
'emlECLPSObj.SetText SPCCLEAR, 8,31
sDsName1 = sLibNm & "(" & sMemNm & ")"
SetBrowsMapDsnameGo(sDsName1)
SetWaitTime(lmilliseconds) '待機する時間
If IsFirstMap(BeginKey) Then
'■5.画面「表示入力パネル」から遷移しない
file2.WriteLine(sLibNm & "," & sMemNm)
wCnt_MemNfd = wCnt_MemNfd + 1
Else
'■2.画面「表示入力パネル」から遷移
'表示したモジュールからタイムスタンプ取得しファイル出力
' ①.文字列検索で検索値をセットして実行する
FindChars("F " & sMemNm & sYYY)
'検索値へカーソル移動
Enter
SetWaitTime(lmilliseconds) '待機する時間
' ②.文字列検索した行をファイル出力する
'画面の行数列数を取得
Rows = emlECLPSObj.NumRows:Cols = emlECLPSObj.NumCols
' 検索結果の行・列番号を取得
CurRow = emlECLPSObj.CursorPosRow:CurCol = emlECLPSObj.CursorPosCol
' 画面の取得開始位置を指定
iDataPos = CurCol + len(sMemNm)
' 検索値の取得
Text = emlECLPSObj.GetText(CurRow,iDataPos,20)
'■3.検索結果を含めて、テキストファイルへ書き出す
If CurRow > 4 Then
' ①検索成功の場合
file2.WriteLine(sLibNm & "," & sMemNm & "," & "#" & Text)
wCnt = wCnt + 1
Else
' ②検索失敗の場合
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 & sYYY & 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
Loop
' 終了 ---------------------------
filel.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
Else
MsgBox " 処理を中止しました。",vbExclamation,sTitle
End If
Else
MsgBox " 入力ファイルが存在しません。" & IFileNm,vbCritical,sTitle
End If
Else
MsgBox " 開始画面は「表示入力パネル」です。",vbCritical,sTitle
End If
End If
'**************************************************
'* 開数
'**************************************************
' 指定時間、処理を待機する -----------------------
Function SetWaitTime(lmilliseconds)
emlECLPSObj.Wait(lmilliseconds)
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
' 開始画面の判定 ---------------------------------
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
' 文字列の検索 -----------------------------------
Function FindChars(FindKey)
Dim row:row = 2 '画面位置（行）
Dim col:col = 18 '画面位置（列）
Dim sFindKey
sFindKey = FindKey & "[enter]"
emlECLPSObj.SendKeys sFindKey, row, col
End Function
' 表示入力画面でDS指定して実行する ---------------
Function SetBrowsMapDsnameGo(sDsName1)
Dim row:row = 11 '画面位置（行）
Dim col:col = 20 '画面位置（列）
Dim sDsName
sDsName = sDsName1 & "[enter]"
emlECLPSObj.SendKeys sDsName, row, col
End Function
' 空エンター -------------------------------------
Function Enter()
emlECLPSObj.SendKeys "[enter]"
End Function
' PF3で戻る --------------------------------------
Function PF3()
emlECLPSObj.SendKeys "[PF3]"
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
' 画面サイズの取得 -------------------------------
Function GetMapSize
' -表示スペース内での行数,桁数を取得-
Dim row:row = emlECLPSObj.NumRows '画面位置（行）
Dim col:col = emlECLPSObj.NumCols '画面位置（列）
sMsg = " 表示スペース：" & _
row & " 行 " & col & " 列 "
'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 CurPos
'-カーソル位置の行数,桁数を取得-
Dim row:row = emlECLPSObj.CursorPosRow '画面位置（行）
Dim col:col = emlECLPSObj.CursorPosCol '画面位置（列）
sMsg = " カーソル位置：" & _
row & " 行 " & col & " 列 "
MsgBox sMsg,, 64, sTitle
End Function
