'拡張データセットー覧マン_開発.mac
[TCPLINK SCRIPT HEADER]
DESCRIPTION=DataSet List Information(3270 Emulator)
[TCPLINK SCRIPT SOURCE]
'Option Explicit
Dim emlECLPSObj
Dim sThisSessionName, sThisMacroName
Dim sMsg, sTitle
Dim lmilliseconds1, lmilliseconds2
Dim Row, Col
Dim sDsName, sDsName1, sDsName2
Dim lMaxDSNs
Dim LenToGet
Dim lPageCnt
Dim OfileName
Dim DsName
Dim wCnt
Dim MyVar
Dim iVOLCnt1, iSPCCnt1, iATTCnt1
' 初期 -------------------------------------------
sDsName1 = "xxxxxxxxxxxxxxxx .*"
lmilliseconds1 = 3000:lmilliseconds2 = 1000
' 共通プロパティー値の設定
sThisMacroName = GetCommonMacroname()
sThisSessionName = GetCommonSessionName()
sTitle = sThisMacroName
Set emlECLPSObj = CreateObject("TESSC.emlECLPS")
emlECLPSObj.SetConnectionByName(sThisSessionName)
' 主処理 -----------------------------------------
If IsEnabelEnv(sTitle) = False Then
MsgBox "ヘルスチェック：利用不可です",64,sTitle
Else
' ファイルの存在確認して存在していれば削除する
FileDel(sThisMacroName)
' 処理開始画面の確認
If IsFirstMap34 Then
'************************
'*** データセット1(H) ***
'************************
' * ■VOL情報
MyVar = VOL_Main_Ready(sDsName1,1)
If MyVar = True Then
iVOLCnt1 = VOL_Main(sDsName1)
End If
SetReturnKey
'--- 待機する時間 ---
SetWaitTime(lmilliseconds1)
' * ■SPACE情報
MyVar = SPC_Main_Ready(sDsName1,0)
If MyVar = True Then
iSPCCntl = SPC_Main(sDsName1)
End If
SetReturnKey
'--- 特機する時間---
SetWaitTime(Imillisecondsl)
' * ■属性情報
MyVar = ATT_Main_Ready(sDsName1,0)
If MyVar = True Then
iATTCnt1 = ATT_Main(sDsName1)
End If
SetReturnKey
'--- 待機する時間 ---
SetWaitTime(lmilliseconds1)
' ------------------------------------
sMsg = "処理終了しました：" & vbCrLf & " " & vbCrLf & _
"対象 ：" & sDsName1 & vbCrLf & _
" 出力 ：" & sThisMacroName & "_1" & ".txt" & _
" 件数：" & iVOLCnt1 &" | " & iSPCCnt1
MsgBox sMsg, 64, sTitle
Else
MsgBox "処理開始の画面が違います",vbCritical,sTitle
End If
End If
'*************************************************
'* 関数
'*************************************************
' ************************************************
' * ■VOL情報
' ************************************************
Function VOL_Main_Ready(sDsName, iMsgON)
Dim MyVar
Main Ready = False
'■1.データセットを選択して実行
SetMap340ption1
SetMap34DsnameAndGo(sDsName)
SetWaitTime(lmilliseconds1)
If IsDsNotFndChar(sDsName) = True Then
VOL_Main_Ready = False
Exit Function
End If
'待機する時間
SetWaitTime(lmilliseconds1)
' ■2.データセットのメンバーー覧から総ページ数を求める
'最大データセット数の取得
lMaxDSNs = GetMaxDSNs
' ページ数の計算
lPageCnt = 01
lPageCnt = GetMaxPageVOL(lMaxDSNs)
If iMsgON = 1 Then
sMsg= " 処理を開始しますか：" & vbCrLf & "" & vbCrLf & _
" 情報抽出元：" & sDsName & vbCrLf & _
" メンバー数：" & MaxDSNs & "ページ数：" & IPageCnt & vbCrlf & _
" 出力 ：" & sThisMacroName & "_1" & ".txt"
MyVar = MsgBox (sMsg, vbYesNo,sTitle)
If MyVar = vbNo Then
MsgBox " 処理を中止しました。",vbExclamation,sTitle
Exit Function
End If
End If
VOL_Main_Ready = True
End Function
'
' データセットのボリューム情報を画面スクロールしながら取得する
Function VOL_Main(sDsName)
Dim rowMIN:rowMIN = 6
Dim rowMAX:rowMAX = 24
Dim wCnt
Dim LVOL, RVOL
'■3.データセットのメンバーー覧をスクロールしながら面面を
'出力したファイルへ書き出す。
Set fso = CreateObject("Scripting.FileSystemObject")
Ofilename = sThisMacroName & "_1" & ".txt"
Set file = fso.OpenTextFile(".\" & Ofilename, 8, True)
wCnt = 0
For a = 1 to lPageCnt
'画面の行範囲
For b = rowMIN to rowMAX
'データセットの取得
DsName = GetDsnLstName(b)
If not DsName = "" Then
VOL = Trim(GetVolumeName(b))
LVOL = Trim(Mid(VOL,1,6))
RVOL = Trim(Mid(VOL,7,1))
'
If IsEndLineWord(b) = False Then
wCnt = wCnt + 1
file.WriteLine(DsName & "," & LVOL & "," & RVOL)
Else
exit For
End If
End If
Next
' 終了文字列の存在確認と判定
If IsEndWord Then
Exit For
End If
' 次ページヘスクロールする
NextPageScroll
'0IA メッセージ確認 SetOIAWaitTime 待機する時間
SetWaitTime(lmilliseconds2)
Next
file.Close
Set fso = Nothing
VOL_Main = wCnt
End Function
' ************************************************
' * ■SPACE情報
' ************************************************
Function SPC_Main_Ready(sDsName, iMsgON)
Dim MyVar
SPC_Main_Ready = False
'■1.データセットを選択して実行
SetMap340ption2
SetMap34DsnameAndGo(sDsName)
If IsDsNotFndChar(sDsName) = True Then
SPC_Main_Ready = False
Exit Function
End If
'待機する時間
SetWaitTime(lmilliseconds1)
'■2.データセットのメンバーー覧から総ページ数を求める
'最大データセット数の取得
lMaxDSNs = GetMaxDSNs
'ページ数の計算
lPageCnt = 01
lPageCnt = GetMaxPageSPC(lMaxDSNs)
If iMsgON = 1 Then
sMsg = " 処理を開始しますか：" & vbCrLf & "" & vbCrLf & _
" 情報抽出元：" & sDsName & vbCrLf & _
" メンバー数：" & LMaxDSNs & " ページ数：" & lPageCnt & vbCrlf & _
" 出力 ：" & sThisMacroName & "_2" & ".txt"
MyVar = MsgBox (sMsg, vbYesNo,sTitle)
If MyVar = vbNo Then
MsgBox "処理を中止しました。",vbExclamation,sTitle
Exit Function
End If
End If
SPC_Main_Ready = True
End Function
' データセットのスペース情報を画面スクロールしながら取得する
Function SPC_Main(sDsName)
Dim rowMIN:rowMIN = 6
Dim rowMAX:rowMAX = 24
Dim SPCX: SPCX = ""
Dim wCnt
'■3.データセットのメンバーー覧をスクロールしながら面面を
'出力したファイルへ書き出す。
Set fso =CreateObject("Scripting.FileSystemObject")
Ofilename = sThisMacroName & "_2" & ".txt"
Set file = fso.OpenTextFile(".\" & Ofilename, 8, True)
wCnt = 0
For a = 1 to lPageCnt
'画面の行範囲
For b = rowMIN to rowMAX
'データセットの取得
DsName = GetDsnLstName(b)
If Not DsName = "" Then
'SPACE
SPCX = GetSPACE(b)
While InStr(SPCX, " ")
SPCX = Replace(SPCX, " ", " ")
Wend
' 空白区切りで配列保持
arr = Split(SPCX, " ")
SPCX = Join(arr, ",")
If IsEndLineWord(b) = False Then
wCnt = wCnt + 1
file.WriteLine (DsName & "," & SPCX)
Else
Exit For
End If
End If
Next
' 終了文字列の存在確認と判定
If IsEndWord Then
Exit For
End If
' 次ページヘスクロールする
NextPageScroll
'0IA メッセージ確認 SetOIAWaitTime 待機する時間
SetWaitTime(lmilliseconds2)
Next
file.Close
Set fso = Nothing
SPC_Main = wCnt
End Function
'
' ************************************************
' * ■属性情報
' ************************************************
Function ATT_Main_Ready(sDsName, iMsgON)
Dim MyVar
ATT_Main_Ready = False
'■1.データセットを選択して実行
SetMap340ption3
SetMap34DsnameAndGo(sDsName)
If IsDsNotFndChar(sDsName) = True Then
ATT_Main_Ready = False
Exit Function
End If
' 待機する時間
SetWaitTime(lmilliseconds1)
' ■2.データセットのメンバーー覧から総ページ数を求める
' 最大データセット数の取得
lMaxDSNs = GetMaxDSNs
' ページ数の計算
lPageCnt = 01
lPageCnt = GetMaxPageSPC(lMaxDSNs)
If iMsgON = 1 Then
sMsg = "処理を開始しますか：" & vbCrLf & "" & vbCrLf & _
"情報抽出元：" & sDsName & vbCrLf & _
"メンバー数：" & IMaxDSNs & " ページ数：" & lPageCnt & _
"出力 ：" & sThisMacroName & "_3" & ".txt"
MyVar = MsgBox (sMsg, vbYesNo,sTitle)
If MyVar = vbNo Then
MsgBox "処理を中止しました。",vbExclamation,sTitle
Exit Function
End If
End If
ATT_Main_Ready = True
End Function
’データセットの属性情報を画面スクロールしながら取得する
Function ATT_Main(sDsName)
Dim rowMIN:rowMIN = 6
Dim rowMAX:rowMAX = 24
Dim wCnt
'■3.データセットのメンバーー覧をスクロールしながら画面を
' 出力したファイルへ書き出す。
Set fso = CreateObject("Scripting.FileSystemObject")
Ofilename = sThisMacroName & "_3" & ".txt"
Set file = fso.OpenTextFile(".\" & Ofilename, 8, True)
wCnt = 0
For a = 1 to lPageCnt
'画面の行範囲
For b = rowMIN to rowMAX
'データセットの取得
DsName =Trim(GetDsnLstName(b))
If not DsName = "" Then
'SPACE
ATT = GetATTR(b)
'2文字以上の空白を空白1文字にする
While InStr(ATT, " ")
ATT = Replace(ATT, " "," ")
Wend
'空白区切りで配列保存
arr=Split(ATT," ")
ATT = Join(arr, ",")
If IsEndLineWord(b) = False Then
wCnt = wCnt + 1
file.WriteLine(DsName & "," & ATT )
Else
exit For
End If
End If
Next
'終了文字列の存在確認と判定
If IsEndWord Then
Exit For
End If
'次ページヘスクロールする
NextPageScroll
'0IA メッセージ確認 SetOIAWaitTime 待機する時間
SetWaitTime(Imilliseconds2)
Next
file.Close
Set fso = Nothing
ATT_Main = wCnt
End Function
'*************************************************
'* 関数２
'*************************************************
'
'テキストファイルの存在確認をして削除する
Function FileDel(sThisMacroName)
Dim file
FileDel = False
' ファイルの存在確認して存在していれば削除する
Set fso = CreateObject("Scripting.FileSystemObject")
file = sThisMacroName & "_1" & ".txt"
' ファイルの削除
If(fso.FileExists(file))Then
fso.DeleteFile file
End If
file = sThisMacroName & "_2" & ".txt"
' ファイルの削除
If(fso.FileExists(file))Then
fso.DeleteFile file
End If
file = sThisMacroName & "_3" & ".txt"
' ファイルの削除
If(fso.FileExists(file))Then
fso.DeleteFile file
End If
Set fso = Nothing
FileDel = True
End Function
' ページ数の取得(VOL) ----------------------------
Function GetMaxPageVOL(lMaxDSNs)
'ページ数の取得
Dim lPageCnt:lPageCnt = 01
Dim lLinebyPage:lLinebyPage = 19
lMaxDSNs = Int(lMaxDSNs)
lPageCnt = Int(lMaxDSNs / lLinebyPage + 0.5) + 1
GetMaxPageVOL = lPageCnt
End Function
' ページ数の取得(SPC) ----------------------------
Function GetMaxPageSPC(lMaxDSNs)
'ページ数の取得
Dim lPageCnt:lPageCnt = 01
Dim lLinebyPage:lLinebyPage = 17
lMaxDSNs = Int(lMaxDSNs)
lPageCnt = Int(lMaxDSNs / lLinebyPage + 0.5) + 1
GetMaxPageSPC = lPageCnt
End Function
' 次ページを表示 -------------------------------
Function NextPageScroll()
emlECLPSObj.SendKeys "[pf8]"
End Function
' 指定時間、処理を待機する -----------------------
Function SetWaitTime(lmilliseconds1)
emlECLPSObj.Wait(lmilliseconds1)
End Function
' 最大データセット数の取得 -----------------------
Function GetMaxDSNs
Dim row:row = 1 '画面位置（行）
Dim col:col = 75 '画面位置（列）
Dim LenToGet:LenToGet = 4
GetMaxDSNs = emlECLPSObj.GetText(row, col,LenToGet)
' 不要な文字を除去する
'[/] がある時は、それ以降のスペースを除いた文字にして、数値チェック
GetMaxDSNs = Trim(GetMaxDSNs)
If instr(1,GetMaxDSNs,"/") > 0 Then
GetMaxDSNs=Trim(mid(GetMaxDSNs,2))
End If
'数値判定
'If IsNumeric(GetMaxDSNs) = False Then
MsgBox "数値ではありません",64,sTitle
'End If
End Function
' データセットの存在確認判定 ---------------------
Function IsDsNotFndChar(sDsName)
Dim row:row = 1 '画面位置（行）
Dim col:col = 57 '画面位置（列）
Dim LenToGet:LenToGet = 22
Dim StatusChar
IsDsNotFndChar = False
'文字列の存在確認と判定
StatusChar = Trim(emlECLPSObj.GetText(row, col,LenToGet))
If StatusChar="データセット名がない" Then
MsgBox sDsName & "_" & " データセット名がない ",vbExclamation,sTitle
IsDsNotFndChar = True
End If
End Function
' 開始画面の判定 ---------------------------------
Function IsFirstMap34
Dim row:row = 1 '画面位置（行）
Dim col:col = 21 '画面位置（列）
Dim sBgnKey:sBgnKey= "データ・セット・リスト・ユー"
IsFirstMap34 = False
'文字列の存在確認と判定
If emlECLPSObj.SearchText(sBgnKey, 1, row, col) Then
IsFirstMap34 = True
End If
End Function
' オプション設定 ---------------------------------
Function SetMap340ption1
Dim row:row = 13 '画面位置（行）
Dim col:col = 5 '画面位置（列）
Dim sOotion:sOption = 1
emlECLPSObj.SetText "1", row, col
End Function
' オプション設定 ---------------------------------
Function SetMap340ption2
Dim row:row = 13 '画面位置（行）
Dim col:col = 5 '画面位置（列）
Dim sOotion:sOption = 2
emlECLPSObj.SetText "2", row, col
End Function
' オプション設定 --------------------------------
Function SetMap340ption3
Dim row:row = 13 '画面位置（行）
Dim col:col = 5 '画面位置（列）
Dim sOotion:sOption = 3
emlECLPSObj.SetText "3", row, col
End Function
' データセットを指定して実行する -----------------
Function SetMap34DsnameAndGo(sDsName)
Dim row:row = 8 '画面位置（行）
Dim col:col = 31 '画面位置（列）
Dim SPCCLEAR:SPCCLEAR = " "
' クリヤー
emlECLPSObj.SetText SPCCLEAR, row, col
sDsName = sDsName & "[enter]"
emlECLPSObj.SendKeys sDsName, 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 IsEndWord
Dim row:row = 4 '画面位置（行）
Dim col:col = 2 '画面位置（列）
Dim EndWord:EndWord = "終り"
IsEndWord = False
' 文字列の存在確認と判定
If emlECLPSObj.SearchText(EndWord,1,row, col) Then
IsEndWord = True
End If
End Function
' 終了文字の行判定 -------------------------------
Function IsEndLineWord(b)
Dim row:row = b '画面位置（行）
Dim col:col = 2 '画面位置（列）
Dim LenToGet:LenToGet = 8
IsEndLineWord = False
' 文字列の存在確認と判定
If emlECLPSObj.GetText(row, col,LenToGet) = " ********" Then
IsEndLineWord = True
End If
End Function
' データセット名の取得 ---------------------------
Function GetDsnLstName(b)
Dim row:row = b '画面位置（行）
Dim col:col = 11 '画面位置（列）
Dim LenToGet:LenToGet = 44
GetDsnLstName = Trim(emlECLPSObj.GetText(row, col, LenToGet))
End Function
' VOLUMEの取得 -----------------------------------
Function GetVokumeName(b)
'VOL名とマルチVOLフラグ
Dim row:row = b '画面位置（行）
Dim col:col = 74 '画面位置（列）
Dim LenToGet:LenToGet = 7
GetVokumeName = Trim(emlECLPSObj.GetText(row, col, LenToGet))
End Function
' SPCの取得 --------------------------------------
Function GetSPACE(b)
Dim row:row = b '画面位置（行）
Dim col:col = 55 '画面位置（列）
Dim LenToGet:LenToGet = 25
GetSPACE = Trim(emlECLPSObj.GetText(row, col,LenToGet))
End Function
' 属性の取得 -------------------------------------
Function GetATTR(b)
Dim row:row = b '画面位置（行）
Dim col:col = 55 '画面位置（列）
Dim LenToGet:LenToGet = 26
GetATTR = Trim(emlECLPSObj.GetText(row, col,LenToGet))
End Function
' カーソル位置の取得 -----------------------------
Function CurPos
' -カーソル位置の行数,桁数を取得-
Dim lCursorPosRow, lCursorPosCol
lCursorPosRow = emlECLPSObj.CursorPosRow
lCursorPosCol = emlECLPSObj.CursorPosCol
sMsg= "カーソル位置：" & lCursorPosRow & " 行 " &lCursorPosCol & " 列 "
'MsgBox sMsg,,64, sTitle
End Function
' 画面サイズの取得 -------------------------------
Function GetMapSize
'-表示スペース内での行数,桁数を取得-
Dim lNumRows, lNumCols
lNumRows = emlECLPSObj.NumRows
lNumCols = emlECLPSObj.NumCols
sMsg= "表示スペース：" & LNumRows & " 行 " & INumCols & " 列 "
'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 GetCommonMacroname
GetCommonMacroname = ThisMacroName
End Function
Function GetCommonSessionName
GetCommonSessionName = ThisSessionName
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
