Option Compare Database
Option Explicit
'-------------------------------------------------------------------------------------'
' Funktion: LoadJCLControl
'
' Beschreibung: Steuert die Erstellung des Load JCL Scripts.
'
' Parameter: strDB2SourceQualifier
' strDataSet
' strDisposition
' intNumSegments
' strDB2Env
' strDB2Job
' strJobName
' strJobTyp
' strJobInitFile
' strJobOKFile
' strJobFailFile
' strSegment
' boolDeleteKey (Optional)
' lngDCID (Optional)
'
' Rückgabe: LoadJCLControl
'-------------------------------------------------------------------------------------'
Private Function LoadJCLControl(ByVal strDB2SourceQualifier As String, _
ByVal strDataSet As String, _
ByVal strDisposition As String, _
ByVal intNumSegments As Integer, _
ByVal strDB2Env As String, _
ByVal strDB2Job As String, _
ByVal strJobName As String, _
ByVal strJobTyp As String, _
ByVal strJobInitFile As String, _
ByVal strJobOKFile As String, _
ByVal strJobFailFile As String, _
ByVal strSegment As String, _
Optional ByVal boolDeleteKey As Boolean, _
Optional ByVal lngDCID As Long) As Boolean
On Error GoTo LoadJCLControl_Err
Dim strErrMsg As String
Dim strDB2ODBCCnn As String
Dim boolODBCErr As Boolean
LoadJCLControl = WriteJCLHeader()
If LoadJCLControl = True Then
If boolDeleteKey = True Then
LoadJCLControl = WriteJCLDelInit(strDB2Env)
If LoadJCLControl = True Then
LoadJCLControl = WriteJCLDelKeyControl(lngDCID, _
strDB2Env)
End If
End If
End If
strDB2ODBCCnn = DB2ODBCCnn(strDB2Env)
If Len(strDB2ODBCCnn) = 0 Then
boolODBCErr = True
LoadJCLControl = False
ElseIf Len(strDB2ODBCCnn) <> 0 Then
LoadJCLControl = LoadJCLSysrecs(strDB2SourceQualifier, _
strDataSet, _
strDisposition, _
intNumSegments, _
strDB2Env, _
strDB2Job, _
strSegment)
If LoadJCLControl = True Then
LoadJCLControl = WriteJCLTrailer(strDB2Job, _
intNumSegments, _
strDB2Env, _
strJobInitFile, _
strJobOKFile, _
strJobFailFile, _
boolDeleteKey)
If LoadJCLControl = True Then
LoadJCLControl = WriteJCLLoadRC(intNumSegments, _
strDB2Env)
End If
End If
End If
LoadJCLControl_Exit:
If LoadJCLControl = False Then
If boolODBCErr = False Then
strErrMsg = "Fehler bei der Erstellung des Load Scripts!"
ElseIf boolODBCErr = True Then
strErrMsg = modPublDecl.gconDB2 & " ODBC Verbindungsname konnte " & _
"nicht ausgelesen werden!"
End If
Call ShowMsgBox(strErrMsg & modPublDecl.gconJobAborted, _
modPublDecl.gconOkCritStyle, _
"Load Script erstellen", _
True)
End If
Exit Function
LoadJCLControl_Err:
LoadJCLControl = False
Resume LoadJCLControl_Exit
End Function
'-------------------------------------------------------------------------------------'
' Funktion: LoadJCLSysRecs
'
' Beschreibung: Ergänzt das Load File (Vorlage: Tabelle 'tblJCLTplDB2LdaFiles')
' um die zu ladenden Tabellen.
' Falls mehr als 100 Tabellen verarbeitet werden müssen, wird der
' Qualifier in einer Schleife (intCnt1 = 1 bis intNumSegments) um
' strSegment und intCnt1 ergänzt.
'
' Parameter: strDB2SourceQualifier
' strDataSet
' strDisposition
' intNumSegments
' strDB2Env
' strDB2JobName
' strSegment
'
' Rückgabe: LoadJCLSysrecs
'-------------------------------------------------------------------------------------'
Private Function LoadJCLSysrecs(ByVal strDB2SourceQualifier As String, _
ByVal strDataSet As String, _
ByVal strDisposition As String, _
ByVal intNumSegments As Integer, _
ByVal strDB2Env As String, _
ByVal strDB2JobName As String, _
ByVal strSegment As String) As Boolean
On Error GoTo LoadJCLSysrecs_Err
Dim dbDAOJCLTables As DAO.Database
Dim rstDAOJCLTables As DAO.Recordset
Dim dbDAOJCLLoadFiles As DAO.Database
Dim rstDAOJCLLoadFiles As DAO.Recordset
Dim strSQL As String
Dim strZeile As String
Dim strDB2FullQual As String
Dim intCnt1 As Integer
Dim intCnt2 As Integer
Dim intSysrecCnt As Integer
Dim intFileNum As Integer
Dim intRstCnt As Integer
Dim intPart As Integer
Dim strWorkPart As String
Dim strUtilQual As String
For intCnt1 = 1 To intNumSegments
strWorkPart = InitialSegment(strSegment, _
intNumSegments, _
intCnt1)
strDB2FullQual = DB2FullQual(strDataSet, _
strDB2SourceQualifier)
intFileNum = FreeFile()
Open modPublDecl.gstrJCLFileGen For Append As #intFileNum
VBA.Width intFileNum, 80
strSQL = modSQL.QSelDelTable("tblJCLTplDB2LdaFiles", _
False)
Set dbDAOJCLLoadFiles = CurrentDb()
Set rstDAOJCLLoadFiles = dbDAOJCLLoadFiles.OpenRecordset(strSQL, _
dbOpenSnapshot)
With rstDAOJCLLoadFiles
.MoveFirst
Do While Not .EOF
strZeile = !JCLLoadFilesRecord
Select Case Trim(strZeile)
Case modPublDecl.gconJCLCommentInit & " LOAD STATEMENTS"
Print #intFileNum, strZeile
strZeile = modPublDecl.gconJCLCommentInit
Print #intFileNum, strZeile
strWorkPart = WorkSegment(strWorkPart, _
True, _
False, _
False)
strZeile = modPublDecl.gconDsnSysInLead & strDB2FullQual & _
strWorkPart & ","
Print #intFileNum, strZeile
strZeile = modPublDecl.gconPunchLead & modPublDecl.gconDispShare
Print #intFileNum, strZeile
Case "//UTIL EXEC DSNUPROC,SYSTEM=" & modPublDecl.gconDB2ODBC & _
",UID='" & modPublDecl.gconDB2Job & "',UTPROC=''"
strUtilQual = IIf(intNumSegments > 1, _
Format(intCnt1, "#") & Right(strDB2Env, 1), _
Right(strDB2Env, 1))
strZeile = Left(strZeile, 6) & strUtilQual & _
Mid(strZeile, 7, Len(strZeile))
Print #intFileNum, strZeile
Case modPublDecl.gconJCLCommentInit & " TABLE INPUT"
Print #intFileNum, strZeile
strZeile = modPublDecl.gconJCLCommentInit
Print #intFileNum, strZeile
intRstCnt = 0
intSysrecCnt = 0
strSQL = modSQL.QSelTblFldOrderByFld("tblJCLTables", _
"*", _
"UmgebTabelle")
Set dbDAOJCLTables = CurrentDb()
Set rstDAOJCLTables = dbDAOJCLTables.OpenRecordset(strSQL, _
dbOpenSnapshot)
With rstDAOJCLTables
.MoveFirst
If intCnt1 > 1 Then
intCnt2 = (intCnt1 - 1) * modPublDecl.gconUnLoadMaxNo
For intCnt2 = 1 To (intCnt1 - 1) * _
modPublDecl.gconUnLoadMaxNo
.MoveNext
Next intCnt2
End If
strWorkPart = WorkSegment(strWorkPart, _
False, _
True, _
True)
Do Until .EOF Or intRstCnt = modPublDecl.gconUnLoadMaxNo
strZeile = SysRecDetail(modPublDecl.gconDsnSysRecLead, _
Format(intRstCnt, "00"), _
strDB2FullQual, _
strWorkPart, _
!UmgebTabelle)
Print #intFileNum, strZeile
Print #intFileNum, strDisposition
intSysrecCnt = intSysrecCnt + 1
intRstCnt = intRstCnt + 1
.MoveNext
Loop
.Close
End With
Set dbDAOJCLTables = Nothing
Set rstDAOJCLTables = Nothing
Case Else
Print #intFileNum, strZeile
End Select
.MoveNext
Loop
.Close
End With
Close #intFileNum
Next intCnt1
LoadJCLSysrecs = True
LoadJCLSysrecs_Exit:
Close #intFileNum
Set dbDAOJCLLoadFiles = Nothing
Set rstDAOJCLLoadFiles = Nothing
Exit Function
LoadJCLSysrecs_Err:
LoadJCLSysrecs = False
Resume LoadJCLSysrecs_Exit
End Function
'-------------------------------------------------------------------------------------'
' Funktion: WriteJCLHeader
'
' Beschreibung: Erstellt aus einer Vorlage (Tabelle 'tblJCLTplDB2Header') den Header
' des JCL Scripts.
'
' Parameter: Ohne
'
' Rückgabe: WriteJCLHeader
'-------------------------------------------------------------------------------------'
Private Function WriteJCLHeader() As Boolean
On Error GoTo WriteJCLHeader_Err
Dim dbDAO As DAO.Database
Dim rstDAO As DAO.Recordset
Dim strSQL As String
Dim intFileNum As Integer
Call modPublic.SetStatusBarText(18, _
False, _
0)
Call modPublDecl.Sleep(modPublDecl.gconSleep * 4)
intFileNum = FreeFile()
Open modPublDecl.gstrJCLFileGen For Output As #intFileNum
VBA.Width intFileNum, 80
strSQL = modSQL.QSelDelTable("tblJCLTplDB2Header", _
False)
Set dbDAO = CurrentDb()
Set rstDAO = dbDAO.OpenRecordset(strSQL, _
dbOpenSnapshot)
With rstDAO
.MoveFirst
Do Until .EOF
Print #intFileNum, !JCLDB2HeaderRecord
.MoveNext
Loop
.Close
End With
WriteJCLHeader = True
WriteJCLHeader_Exit:
Set dbDAO = Nothing
Set rstDAO = Nothing
Close #intFileNum
Exit Function
WriteJCLHeader_Err:
WriteJCLHeader = False
Resume WriteJCLHeader_Exit
End Function
'-------------------------------------------------------------------------------------'
' Funktion: WriteJCLDelInit
'
' Beschreibung: Erstellt aus einer Vorlage (Tabelle 'tblJCLTplDB2DelInit') die
' Initialisierung des Löschens von Keys oder Tabellen in JCL Scripts.
'
' Parameter: strDB2Env
'
' Rückgabe: WriteJCLDelInit
'-------------------------------------------------------------------------------------'
Private Function WriteJCLDelInit(ByVal strDB2Env As String) As Boolean
On Error GoTo WriteJCLDelInit_Err
Dim dbDAO As DAO.Database
Dim rstDAO As DAO.Recordset
Dim strSQL As String
Dim intFileNum As Integer
Dim vntZeile As Variant
Dim strODBCCnn As String
strODBCCnn = DB2ODBCCnn(strDB2Env)
intFileNum = FreeFile()
Open modPublDecl.gstrJCLFileGen For Append As #intFileNum
VBA.Width intFileNum, 80
strSQL = modSQL.QSelDelTable("tblJCLTplDB2DelInit", _
False)
Set dbDAO = CurrentDb()
Set rstDAO = dbDAO.OpenRecordset(strSQL, _
dbOpenSnapshot)
With rstDAO
Do Until .EOF
If !JCLDB2DelInitRecord = " DSN SYSTEM(" & modPublDecl.gconODBCCnn & ")" Then
vntZeile = Split(!JCLDB2DelInitRecord, modPublDecl.gconODBCCnn, -1)
vntZeile = vntZeile(0) & strODBCCnn & vntZeile(1)
Print #intFileNum, vntZeile
Else
Print #intFileNum, !JCLDB2DelInitRecord
End If
.MoveNext
Loop
.Close
End With
WriteJCLDelInit = True
WriteJCLDelInit_Exit:
Close #intFileNum
Set dbDAO = Nothing
Set rstDAO = Nothing
Exit Function
WriteJCLDelInit_Err:
WriteJCLDelInit = False
Resume WriteJCLDelInit_Exit
End Function
'-------------------------------------------------------------------------------------'
' Funktion: WriteJCLDelKeyControl
'
' Beschreibung: Steuert, falls Schlüsseldaten vor dem Laden gelöscht werden sollen,
' das Schreiben der SQL DELETE Anweisungen in das JCL Load Script.
'
' Parameter: lngDCID
' strDB2Env
'
' Rückgabe: WriteJCLDelKeyControl
'-------------------------------------------------------------------------------------'
Private Function WriteJCLDelKeyControl(ByVal lngDCID As Long, _
ByVal strDB2Env As String) As Boolean
On Error GoTo WriteJCLDelKeyControl_Err
Dim dbDAO As DAO.Database
Dim rstDAO As DAO.Recordset
Dim dbDAOKeyDel As DAO.Database
Dim rstDAOKeyDel As DAO.Recordset
Dim strSQL As String
Dim lngDelDCID As Long
strSQL = modSQL.QSelDistTablesKeyDel(lngDCID)
Set dbDAOKeyDel = CurrentDb()
Set rstDAOKeyDel = dbDAOKeyDel.OpenRecordset(strSQL, _
dbOpenSnapshot)
With rstDAOKeyDel
If Not .EOF Then
Do Until .EOF
lngDelDCID = !DelDCID
strSQL = modSQL.QSelDelCorrTableField("tblDB2DMCMFiles", _
"DCID", _
lngDelDCID, _
False, _
False)
Set dbDAO = CurrentDb()
Set rstDAO = dbDAO.OpenRecordset(strSQL, _
dbOpenSnapshot)
With rstDAO
If Not .EOF Then
Call WriteJCLDelKey(strDB2Env, _
lngDCID, _
lngDelDCID)
End If
.Close
End With
.MoveNext
Loop
.Close
End If
End With
WriteJCLDelKeyControl = True
WriteJCLDelKeyControl_Exit:
Set dbDAO = Nothing
Set rstDAO = Nothing
Set dbDAOKeyDel = Nothing
Set rstDAOKeyDel = Nothing
Exit Function
WriteJCLDelKeyControl_Err:
WriteJCLDelKeyControl = False
Resume WriteJCLDelKeyControl_Exit
End Function
'-------------------------------------------------------------------------------------'
' Funktion: WriteJCLDelKey
'
' Beschreibung: Schreibt, falls Tabellenschlüsselinhalte vor dem Laden gelöscht werden
' sollen, entsprechende SQL DELETE Anweisungen in das JCL Load Script.
'
' Parameter: strDB2Env
' lngDCID
' lngDelDCID
'
' Rückgabe: WriteJCLDelKey
'-------------------------------------------------------------------------------------'
Private Function WriteJCLDelKey(ByVal strDB2Env As String, _
ByVal lngDCID As Long, _
ByVal lngDelDCID As Long) As Boolean
On Error GoTo WriteJCLDelKey_Err
Dim dbDAO As DAO.Database
Dim rstDAO As DAO.Recordset
Dim strSQL As String
Dim intFileNum As Integer
Dim strDB2Key As String
Dim strDB2KeyVal As String
Dim boolKeyNumeric As Boolean
boolKeyNumeric = KeyNumeric(strDB2Env)
strDB2Key = GetDB2Key(strDB2Env)
If Len(strDB2Key) <> 0 Then
intFileNum = FreeFile()
Open modPublDecl.gstrJCLFileGen For Append As #intFileNum
strSQL = modSQL.QSelDCTablesKeyDel(lngDCID, _
lngDelDCID, _
"*", _
"*")
Set dbDAO = CurrentDb()
Set rstDAO = dbDAO.OpenRecordset(strSQL, _
dbOpenSnapshot)
With rstDAO
Do Until .EOF
strDB2KeyVal = IIf(boolKeyNumeric = True, _
!DB2KeyVal, _
"'" & !DB2KeyVal & "'")
Print #intFileNum, modPublDecl.gconDeleteFrom & UCase(strDB2Env) & _
modPublDecl.gconFullStop & !Tabelle & _
" WHERE " & strDB2Key & " = " & strDB2KeyVal
.MoveNext
Loop
.Close
End With
WriteJCLDelKey = True
Else
WriteJCLDelKey = False
End If
WriteJCLDelKey_Exit:
Close #intFileNum
Set dbDAO = Nothing
Set rstDAO = Nothing
Exit Function
WriteJCLDelKey_Err:
WriteJCLDelKey = False
Resume WriteJCLDelKey_Exit
End Function
'-------------------------------------------------------------------------------------'
' Funktion: WriteJCLTrailer
'
' Beschreibung: Erstellt aus einer Vorlage (Tabelle 'tblJCLTplDB2Trailer') den Trailer
' des JCL Unload/Load/Delete/Clear Scripts.
'
' Parameter: strDB2Job
' intNumSegments
' strDB2Env (Optional)
' strJobInitFile (Optional)
' strJobOKFile (Optional)
' strJobFailFile (Optional)
' boolDeleteKey (Optional)
'
' Rückgabe: WriteJCLTrailer
'-------------------------------------------------------------------------------------'
Private Function WriteJCLTrailer(ByVal strDB2Job As String, _
ByVal intNumSegments As Integer, _
Optional ByVal strDB2Env As String, _
Optional ByVal strJobInitFile As String, _
Optional ByVal strJobOKFile As String, _
Optional ByVal strJobFailFile As String, _
Optional ByVal boolDeleteKey As Boolean) As Boolean
On Error GoTo WriteJCLTrailer_Err
Const conRCLead As String = "// "
Const conRCThen As String = "// THEN"
Const conRCAnd As String = modPublDecl.gconSpace & "AND"
Const conRCOr As String = modPublDecl.gconSpace & "OR"
Dim dbDAO As DAO.Database
Dim rstDAO As DAO.Recordset
Dim strSQL As String
Dim intFileNum As Integer
Dim intCnt As Integer
Dim strZeile As String
Dim strZeileTmp As String
Dim avntZeile As Variant
Dim intLen As Integer
Dim strEnvChar As String
Dim boolThen As Boolean
If Not IsMissing(strDB2Env) Then
strEnvChar = Trim(Right(strDB2Env, 1))
End If
intFileNum = FreeFile()
Open modPublDecl.gstrJCLFileGen For Append As #intFileNum
VBA.Width intFileNum, 80
strSQL = modSQL.QSelDelTable("tblJCLTplDB2Trailer", _
False)
Set dbDAO = CurrentDb()
Set rstDAO = dbDAO.OpenRecordset(strSQL, _
dbOpenSnapshot)
With rstDAO
.MoveFirst
Do Until .EOF
strZeile = Trim(!JCLDB2TrailerRecord)
If strZeile = "//IFOK IF (DB.RC = 0) THEN" Then
avntZeile = Split(strZeile, "DB.RC", -1)
If strDB2Job = modPublDecl.gconUnloadJob Then ' UNLOAD Trailer
If intNumSegments > 1 Then
For intCnt = 1 To intNumSegments
boolThen = False
If intCnt = 1 Then
strZeile = avntZeile(0) & modPublDecl.gconDB2UNLOAD & _
intCnt & modPublDecl.gconRC & " = 0" & conRCAnd
ElseIf intCnt = intNumSegments Then
strZeile = conRCLead & modPublDecl.gconDB2UNLOAD & _
intCnt & modPublDecl.gconRC & " = 0)"
boolThen = True
Else
strZeile = conRCLead & modPublDecl.gconDB2UNLOAD & _
intCnt & modPublDecl.gconRC & " = 0" & conRCAnd
End If
Print #intFileNum, strZeile
If boolThen = True Then
Print #intFileNum, conRCThen
End If
Next intCnt
Else
strZeile = avntZeile(0) & modPublDecl.gconDB2UNLOAD & _
modPublDecl.gconRC & avntZeile(1)
Print #intFileNum, strZeile
End If
ElseIf strDB2Job = modPublDecl.gconLoadJob Then ' LOAD Trailer
strZeile = avntZeile(0) & modPublDecl.gconLoadUtilRC & " < 8 ) THEN" & _
Mid(avntZeile(1), 6, Len(avntZeile(1)))
strZeileTmp = strZeile
If intNumSegments > 1 Then
For intCnt = 1 To intNumSegments
boolThen = False
If intCnt = 1 Then
strZeile = Left(strZeile, 15) & intCnt & _
strEnvChar & Mid(strZeile, 16, 16) & _
conRCAnd
ElseIf intCnt = intNumSegments Then
strZeile = Mid(strZeile, 12, 4) & intCnt & _
strEnvChar & Mid(strZeile, 16, 16)
If boolDeleteKey = True Then
strZeile = conRCLead & strZeile & conRCAnd
Print #intFileNum, strZeile
strZeile = conRCLead & modPublDecl.gconDB2SQL2RC & " = 0)"
Else
strZeile = conRCLead & strZeile & ")"
End If
boolThen = True
Else
strZeile = conRCLead & Mid(strZeile, 12, 4) & intCnt & _
strEnvChar & Mid(strZeile, 16, 16) & _
conRCAnd
End If
Print #intFileNum, strZeile
If boolThen = True Then
Print #intFileNum, conRCThen
End If
strZeile = strZeileTmp
Next intCnt
Else
intLen = Len(strZeile) - 15
If boolDeleteKey = True Then
strZeile = Left(strZeile, 15) & strEnvChar & _
Mid(strZeile, 16, intLen - 6) & conRCAnd
Print #intFileNum, strZeile
strZeile = conRCLead & modPublDecl.gconDB2SQL2RC & " = 0)"
Print #intFileNum, strZeile
strZeile = conRCThen
Else
strZeile = Left(strZeile, 15) & strEnvChar & _
Mid(strZeile, 16, intLen)
End If
Print #intFileNum, strZeile
End If
ElseIf strDB2Job = gconDeleteJob Then ' DELETE Trailer
strZeile = avntZeile(0) & modPublDecl.gconDB2DELRC & avntZeile(1)
Print #intFileNum, strZeile
ElseIf strDB2Job = gconClearJob Then ' CLEAR Trailer
strZeile = avntZeile(0) & modPublDecl.gconDB2SQL2RC & avntZeile(1)
Print #intFileNum, strZeile
End If
ElseIf strZeile = _
"//IFNOK IF (" & modPublDecl.gconLoadUtilRC & " GE 8 ! ABEND) THEN" Then
If strDB2Job = modPublDecl.gconLoadJob Then ' LOAD Trailer
strZeileTmp = strZeile
If intNumSegments > 1 Then
For intCnt = 1 To intNumSegments
boolThen = False
strZeile = Mid(strZeileTmp, 13, 4) & intCnt & _
strEnvChar & Mid(strZeileTmp, 17, 25)
If intCnt = 1 Then
strZeile = Left(strZeileTmp, 12) & modPublDecl.gconSpace & _
"(" & strZeile & ")" & conRCOr
ElseIf intCnt = intNumSegments Then
strZeile = conRCLead & modPublDecl.gconSpace & _
"(" & strZeile & "))"
boolThen = True
Else
strZeile = conRCLead & modPublDecl.gconSpace & _
"(" & strZeile & ")" & conRCOr
End If
Print #intFileNum, strZeile
If boolThen = True Then
Print #intFileNum, conRCThen
End If
Next intCnt
Else
intLen = Len(strZeile) - 15
strZeile = Left(strZeile, 16) & strEnvChar & _
Mid(strZeile, 17, intLen)
Print #intFileNum, strZeile
End If
End If
Else
Print #intFileNum, strZeile
End If
.MoveNext
Loop
.Close
End With
WriteJCLTrailer = True
WriteJCLTrailer_Exit:
Close #intFileNum
Set dbDAO = Nothing
Set rstDAO = Nothing
Exit Function
WriteJCLTrailer_Err:
WriteJCLTrailer = False
Call ShowMsgBox("Fehler bei der Verarbeitung des " & modPublDecl.gconDB2 & _
" JCL Trailers!", _
modPublDecl.gconOkCritStyle, _
modPublDecl.gconDB2 & " JCL Trailer", _
True)
Resume WriteJCLTrailer_Exit
End Function
'-------------------------------------------------------------------------------------'
' Funktion: WriteJCLLoadRC
'
' Beschreibung: Verwendet eine Vorlage (Tabelle 'tblJCLTplDB2LdaRC') um das LOAD JCL
' Script um die JCL Scriptbefehle zum Auslesen des/der Return Codes zu
' erweitern.
'
' Parameter: intNumSegments
' strDB2Env
'
' Rückgabe: WriteJCLLoadRC
'-------------------------------------------------------------------------------------'
Private Function WriteJCLLoadRC(ByVal intNumSegments As Integer, _
ByVal strDB2Env As String) As Boolean
On Error GoTo WriteJCLLoadRC_Err
Const conLoadUtilRCLine As String = "//IFOK IF (" & _
modPublDecl.gconLoadUtilRC & " = "
Dim dbDAO As DAO.Database
Dim rstDAO As DAO.Recordset
Dim strSQL As String
Dim intFileNum As Integer
Dim intCnt As Integer
Dim strZeile As String
Dim avntZeile As Variant
Dim strEnvChar As String
Dim strZaehler As String
Dim intStep As Integer
strEnvChar = Trim(Right(strDB2Env, 1))
intFileNum = FreeFile()
Open modPublDecl.gstrJCLFileGen For Append As #intFileNum
VBA.Width intFileNum, 80
intStep = modPublDecl.gconRCStartStep
For intCnt = 1 To intNumSegments
strZaehler = IIf(intNumSegments > 1, CStr(intCnt), vbNullString)
strSQL = modSQL.QSelDelTable("tblJCLTplDB2LdaRC", _
False)
Set dbDAO = CurrentDb()
Set rstDAO = dbDAO.OpenRecordset(strSQL, _
dbOpenSnapshot)
With rstDAO
.MoveFirst
Do Until .EOF
strZeile = !DB2LoadRC
Select Case strZeile
Case conLoadUtilRCLine & "4) THEN", _
conLoadUtilRCLine & "0) THEN", _
"//SYSUT2 DD DSN=" & modPublDecl.gconDefHostID & _
".UTIL.RC,DISP=(,CATLG,DELETE),UNIT=HSMP,"
avntZeile = Split(strZeile, modPublDecl.gconUtil, -1)
strZeile = avntZeile(0) & modPublDecl.gconUtil & strZaehler & _
strEnvChar & avntZeile(1)
Case "//STEP EXEC PGM=" & modPublDecl.gconSearchExecCmd
intStep = intStep + 1
avntZeile = Split(strZeile, " EXEC", -1)
strZeile = avntZeile(0) & intStep & " EXEC" & avntZeile(1)
End Select
Print #intFileNum, strZeile
.MoveNext
Loop
.Close
End With
Next intCnt
WriteJCLLoadRC = True
WriteJCLLoadRC_Exit:
Close #intFileNum
Set dbDAO = Nothing
Set rstDAO = Nothing
Exit Function
WriteJCLLoadRC_Err:
WriteJCLLoadRC = False
Call ShowMsgBox("Fehler bei der Verarbeitung der Return Code Anweisungen!", _
modPublDecl.gconOkCritStyle, _
"Return Code Anweisungen verarbeiten", _
True)
Resume WriteJCLLoadRC_Exit
End Function
'-------------------------------------------------------------------------------------'
' Funktion: InitialSegment
'
' Beschreibung: Setzt das Segment (den Part) des JCL Scripts bei mehr als 100 Sysrecs
' (intNumSegments > 1) aus dem Segmentbezeichner und der Segmentnummer
' zusammen.
'
' Parameter: strSegment
' intNumSegments
' intCnt
'
' Rückgabe: InitialSegment
'-------------------------------------------------------------------------------------'
Private Function InitialSegment(ByVal strSegment As String, _
ByVal intNumSegments As Integer, _
ByVal intCnt As Integer) As String
InitialSegment = IIf(intNumSegments > 1, _
strSegment & Format(intCnt, "0"), _
vbNullString)
End Function
'-------------------------------------------------------------------------------------'
' Funktion: DB2FullQual
'
' Beschreibung: Setzt den vollständigen Data Set Qualifier zusammen.
'
' Parameter: strDataSet
' strQualifier
'
' Rückgabe: DB2FullQual
'-------------------------------------------------------------------------------------'
Private Function DB2FullQual(ByVal strDataSet As String, _
ByVal strQualifier As String) As String
DB2FullQual = IIf(Len(strDataSet) <> 0, _
strQualifier & modPublDecl.gconFullStop & strDataSet, _
strQualifier)
End Function
'-------------------------------------------------------------------------------------'
' Funktion: WorkSegment
'
' Beschreibung: Erweitert Segmentbezeichner und Segmentnummer um den Delimiter (Punkt).
' Sind nicht mehr als 100 Sysrecs vorhanden, wird ein Nullstring
' zurückgegeben.
'
' Parameter: strWorkPart
' boolDelLead
' boolDelEnd
' boolFullStop
'
' Rückgabe: WorkSegment
'-------------------------------------------------------------------------------------'
Private Function WorkSegment(ByVal strWorkPart As String, _
ByVal boolDelLead As Boolean, _
ByVal boolDelEnd As Boolean, _
ByVal boolFullStop As Boolean) As String
If Len(strWorkPart) <> 0 Then
If boolDelLead = True Then
WorkSegment = modPublDecl.gconFullStop & strWorkPart
ElseIf boolDelEnd = True Then
WorkSegment = strWorkPart & modPublDecl.gconFullStop
End If
Else
WorkSegment = IIf(boolFullStop = True, modPublDecl.gconFullStop, vbNullString)
End If
End Function
'-------------------------------------------------------------------------------------'
' Funktion: SysRecDetail
'
' Beschreibung: Baut den SYSREC Detailsatz auf.
'
' Parameter: strSysRecLead
' strCnt
' strFullQual
' strWorkPart
' strUmgebTabelle
'
' Rückgabe: SysRecDetail
'-------------------------------------------------------------------------------------'
Private Function SysRecDetail(ByVal strSysRecLead As String, _
ByVal strCnt As String, _
ByVal strFullQual As String, _
ByVal strWorkPart As String, _
ByVal strUmgebTabelle As String) As String
SysRecDetail = strSysRecLead & strCnt & modPublDecl.gconSysRecMid & _
strFullQual & strWorkPart & _
Trim(Mid(strUmgebTabelle, _
InStr(1, strUmgebTabelle, modPublDecl.gconFullStop) + 1, _
Len(strUmgebTabelle))) & ","
End Function
'-------------------------------------------------------------------------------------'
' Funktion: KeyNumeric
'
' Beschreibung: Ermittelt, ob das Schlüsselfeld (Key) numerisch ist.
' Zur Verfügung stehen ausschließlich die Datentypen CHAR (maximale
' Feldlänge 20 Zeichen), DECIMAL, FLOAT, INTEGER und SMALLINT.
'
' Parameter: strDB2Env
'
' Rückgabe: KeyNumeric
'-------------------------------------------------------------------------------------'
Private Function KeyNumeric(ByVal strDB2Env As String) As Boolean
Dim dbDAO As DAO.Database
Dim rstDAO As DAO.Recordset
Dim strSQL As String
strSQL = modSQL.QSelDelCorrTableField("tblDB2EnvCfg", _
"DB2Env", _
strDB2Env, _
False, _
False)
Set dbDAO = CurrentDb()
Set rstDAO = dbDAO.OpenRecordset(strSQL, _
dbOpenSnapshot)
With rstDAO
If Not .EOF Then
KeyNumeric = IIf(Trim(!DB2KeyDataType) = "CHAR", False, True)
End If
.Close
End With
Set dbDAO = Nothing
Set rstDAO = Nothing
End Function
'-------------------------------------------------------------------------------------'
' Prozedur: SetStatusBarText
'
' Beschreibung: Aktualisiert, gesteuert durch boolProgressBar, den Statusleisten- oder
' Fortschrittsbalkentext.
'
' Parameter: bytMessageFlag
' boolInitMeter
' intCnt
'-------------------------------------------------------------------------------------'
Public Sub SetStatusBarText(ByVal bytMessageFlag As Byte, _
ByVal boolInitMeter As Boolean, _
ByVal intCnt As Integer)
On Error GoTo SetStatusBarText_Err
Const conInitialize As String = " wird initialisiert"
Const conDelete As String = "löschen"
Dim strStatBarMsg As String
Dim boolTripleStop As Boolean
boolTripleStop = True
Select Case bytMessageFlag
Case 1 ' UNLOAD
strStatBarMsg = "Entladevorgang" & conInitialize
Case 2 ' LOAD
strStatBarMsg = "Ladevorgang" & conInitialize
Case 3 ' DELETE
strStatBarMsg = "Löschvorgang" & conInitialize
Case 4 ' Key sichern
strStatBarMsg = "Keys sichern"
Case 5 ' Umgebungen/Tabellen auslesen
strStatBarMsg = modPublDecl.gconIBMDB2 & modPublDecl.gconSpace & _
"Umgebungen/Tabellen aktualisieren"
Case 6 ' Verbindung zur IBM DB2 herstellen
strStatBarMsg = "Verbindung zur" & modPublDecl.gconSpace & _
modPublDecl.gconIBMDB2 & modPublDecl.gconSpace & _
"herstellen"
Case 7 ' Erfolg des JCL Laufs überprüfen
strStatBarMsg = "Ergebnis des" & modPublDecl.gconSpace & _
modPublDecl.gstrJobTyp & modPublDecl.gconSpace & _
"Jobs ermitteln"
Case 8 ' Ausgewählte (Mehrfachauswahl) Keys löschen
strStatBarMsg = "Ausgewählte Keys" & modPublDecl.gconSpace & _
conDelete & "." & modPublDecl.gconSpace & "Verbleibend:" & _
modPublDecl.gconSpace & modPublDecl.glngNumKeys & _
modPublDecl.gconSpace & "Keys"
boolTripleStop = False
Case 9, 10 ' Alle Keys löschen/übernehmen
strStatBarMsg = "Alle Keys" & modPublDecl.gconSpace & _
IIf(bytMessageFlag = 9, conDelete, _
"übernehmen")
Case 11 ' Ausgewählte (Mehrfachauswahl) Keys übernehmen
strStatBarMsg = "Ausgewählte Keys übernehmen"
Case 12 ' CLEAR
strStatBarMsg = modPublDecl.gconDB2 & modPublDecl.gconSpace & "Umgebung" & _
modPublDecl.gconSpace & modPublDecl.gstrDeleteEnv & _
modPublDecl.gconSpace & conDelete
Case 13 ' DCID und gesicherte Keys löschen
strStatBarMsg = "DCID und gesicherte Keys" & modPublDecl.gconSpace & _
conDelete
Case 14 ' Job Output löschen
strStatBarMsg = modPublDecl.gconIBMZOS & " Job Output wird gelöscht"
Case 15 ' Currently unused
strStatBarMsg = vbNullString
Case 16 ' Bericht generieren
strStatBarMsg = "Angeforderter Bericht wird generiert"
Case 17 ' Currently unused
strStatBarMsg = vbNullString
Case 18 ' JCL Script generieren
strStatBarMsg = "JCL Script generieren und zum Host senden"
Case 19 ' Zeitaufwändige SQL Abfrage ausführen
strStatBarMsg = "SQL Abfragen werden ausgeführt"
Case 20 ' Currently unused
strStatBarMsg = vbNullString
Case 21, 22 ' Verifizierung DB2 Tabellen und Attribute
strStatBarMsg = "Verifizierung" & modPublDecl.gconSpace & _
modPublDecl.gconDB2TablesAttribs & _
IIf(bytMessageFlag = 21, conInitialize, _
modPublDecl.gconSpace & _
"erfolgreich beendet.")
If bytMessageFlag = 22 Then
boolTripleStop = False
End If
Case 23 ' SQL Statements generieren
strStatBarMsg = "SQL Statements generieren und prüfen"
Case 24 ' Tabellenverknüpfungen aktualisieren
strStatBarMsg = "Tabellenverknüpfungen werden aktualisiert"
Case 25 ' Tabellen und Attribute verifizieren
strStatBarMsg = modPublDecl.gconDB2TablesAttribs & gconSpace & _
"verifizieren"
End Select
If boolInitMeter = True Then
SysCmd acSysCmdInitMeter, strStatBarMsg & _
IIf(boolTripleStop = True, modPublDecl.gconTripleStop, vbNullString), _
intCnt
ElseIf boolInitMeter = False Then
SysCmd acSysCmdSetStatus, strStatBarMsg & _
IIf(boolTripleStop = True, modPublDecl.gconTripleStop, vbNullString)
End If
SetStatusBarText_Exit:
Exit Sub
SetStatusBarText_Err:
Resume SetStatusBarText_Exit
End Sub
