Option Compare Database
Option Explicit
'-------------------------------------------------------------------------------------'
' Funktion: TestTablesAndAttributes
'
' Beschreibung: Überprüft, ob alle Tabellen und Attribute übereinstimmen.
'
' Parameter: strQuellumgebung
' rboolAllTablesMatchErr
'
' Rückgabe: rboolAllTablesMatchErr
' TestTablesAndAttributes
'-------------------------------------------------------------------------------------'
Public Function TestTablesAndAttributes(ByVal strQuellumgebung As String, _
ByRef rboolAllTablesMatchErr As Boolean) As Boolean
On Error GoTo TestTablesAndAttributes_Err
Const conErr As String = "Fehlerhafte "
Const conErrMatch As String = "übereinstimmung(en)"
Const conTestInitStep As Byte = 1
Dim dbDAOTableDiff As DAO.Database
Dim rstDAOTableDiff As DAO.Recordset
Dim dbDAOAttribDiff As DAO.Database
Dim rstDAOAttribDiff As DAO.Recordset
Dim dbDAOJCLTables As DAO.Database
Dim rstDAOJCLTables As DAO.Recordset
Dim dbDAOErr As DAO.Database
Dim rstDAOErr As DAO.Recordset
Dim strSQL As String
Dim boolTableErr As Boolean
Dim boolAttribErr As Boolean
Dim boolAttribErrFound As Boolean
Dim intNumLoops As Integer
Dim intProgressCnt As Integer
Dim intNumTables As Integer
intNumTables = NumJCLTables()
intNumLoops = intNumTables + conTestInitStep
intProgressCnt = intNumLoops
Call SetStatusBarText(21, _
False, _
0)
Call HourGlassState(True)
DoEvents ' Ereignissteuerung an Betriebssystem übergeben
Call WriteSysIBMAttribute(modPublDecl.gstrZielUmgebung, _
"*", _
strQuellumgebung)
DoEvents ' Ereignissteuerung an Betriebssystem übergeben
If AllJCLTablesExistInSysIBM(intNumTables) = True Then
rboolAllTablesMatchErr = False
TestTablesAndAttributes = True
Call SetStatusBarText(25, _
True, _
intNumLoops)
strSQL = modSQL.QSelDelTable("tblDB2TableAttribErrLog", _
True)
CurrentDb.Execute strSQL
DoEvents ' Ereignissteuerung an Betriebssystem übergeben
SysCmd acSysCmdUpdateMeter, intNumLoops - intProgressCnt
strSQL = modSQL.QSelDelTable("tblDB2TableAttribErrLog", _
False)
Set dbDAOErr = CurrentDb()
Set rstDAOErr = dbDAOErr.OpenRecordset(strSQL, _
dbOpenDynaset)
strSQL = modSQL.QSelCorrUmgebTabelle(True)
Set dbDAOTableDiff = CurrentDb()
Set rstDAOTableDiff = dbDAOTableDiff.OpenRecordset(strSQL, _
dbOpenSnapshot)
With rstDAOTableDiff
If .EOF = False Then
If boolTableErr = False Then
rstDAOErr.AddNew
rstDAOErr!SubHeader = conErr & "Tabellen" & conErrMatch
rstDAOErr.Update
boolTableErr = True
End If
Do Until .EOF
rstDAOErr.AddNew
rstDAOErr!DB2EnvTable = !UmgebTabelle
rstDAOErr.Update
.MoveNext
Loop
End If
.Close
End With
Set dbDAOTableDiff = Nothing
Set rstDAOTableDiff = Nothing
intProgressCnt = intProgressCnt - 1
strSQL = modSQL.QSelCorrUmgebTabelle(False)
Set dbDAOJCLTables = CurrentDb()
Set rstDAOJCLTables = dbDAOJCLTables.OpenRecordset(strSQL, _
dbOpenSnapshot)
With rstDAOJCLTables
Do Until .EOF
strSQL = modSQL.QSelTableAttribs(!UmgebTabelle)
Set dbDAOAttribDiff = CurrentDb()
Set rstDAOAttribDiff = dbDAOAttribDiff.OpenRecordset(strSQL, _
dbOpenSnapshot)
With rstDAOAttribDiff
If Not .EOF Then
If boolAttribErr = False Then
rstDAOErr.AddNew
rstDAOErr!SubHeader = conErr & "Attrib" & conErrMatch & _
" - Umgebung.Tabelle Attribut(e):"
rstDAOErr.Update
boolAttribErr = True
End If
Do Until .EOF
rstDAOErr.AddNew
If boolAttribErrFound = False Then
rstDAOErr!DB2EnvTable = !UmgebTabelle
boolAttribErrFound = True
End If
rstDAOErr!DB2TableAttrib = !Attribut
rstDAOErr.Update
.MoveNext
Loop
End If
boolAttribErrFound = False
.Close
End With
Set dbDAOAttribDiff = Nothing
Set rstDAOAttribDiff = Nothing
.MoveNext
DoEvents ' Ereignissteuerung an Betriebssystem übergeben
intProgressCnt = intProgressCnt - 1
intProgressCnt = IIf(intProgressCnt = 0, intNumLoops, intProgressCnt)
SysCmd acSysCmdUpdateMeter, intNumLoops - intProgressCnt
Loop
.Close
End With
TestTablesAndAttributes = IIf(boolTableErr = True Or boolAttribErr = True, False, True)
If TestTablesAndAttributes = True Then
Call modPublic.SetStatusBarText(22, _
False, _
0)
End If
Else
rboolAllTablesMatchErr = True
TestTablesAndAttributes = False
End If
TestTablesAndAttributes_Exit:
Set dbDAOErr = Nothing
Set rstDAOErr = Nothing
Set dbDAOJCLTables = Nothing
Set rstDAOJCLTables = Nothing
SysCmd acSysCmdRemoveMeter
Call HourGlassState(False)
Exit Function
TestTablesAndAttributes_Err:
TestTablesAndAttributes = False
Resume TestTablesAndAttributes_Exit
End Function
'-------------------------------------------------------------------------------------'
' Funktion: AllJCLTablesExistInSysIBM
'
' Beschreibung: Prüft, ob alle Quelltabellen in der Zielumgebung vorhanden sind.
'
' Parameter: intNumTables
'
' Rückgabe: AllJCLTablesExistInSysIBM
'-------------------------------------------------------------------------------------'
Private Function AllJCLTablesExistInSysIBM(ByVal intNumTables As Integer) As Boolean
Dim dbDAO As DAO.Database
Dim rstDAO As DAO.Recordset
Dim strSQL As String
strSQL = modSQL.QSelAllJCLTablesExistingInSysIBM()
Set dbDAO = CurrentDb()
Set rstDAO = dbDAO.OpenRecordset(strSQL, _
dbOpenSnapshot)
With rstDAO
If Not .EOF Then ' Datensätze vorhanden = Anzahl Tabellen prüfen
.MoveLast
AllJCLTablesExistInSysIBM = IIf(.RecordCount = intNumTables, True, False)
Else ' Kein Datensatz vorhanden = Keine Tabellen vorhanden
AllJCLTablesExistInSysIBM = False
End If
.Close
End With
Set rstDAO = Nothing
Set dbDAO = Nothing
End Function
'-------------------------------------------------------------------------------------'
' Prozedur: WriteSysIBMAttribute
'
' Beschreibung: Schreibt, da die Sortierfolge einer DB2 Tabelle (strDB2Env.strTabelle)
' von der Sortierfolge einer Access Tabelle abweicht (EBCDIC/ASCII), die
' Attribute in eine Access Tabelle.
' Um den Vergleich der Attribute zu erleichtern wird die DB2 Zielumgebung
' durch die DB2 Quellumgebung ersetzt.
'
' Parameter: strDB2TargetEnv
' strDB2Table
' strDB2SourceEnv
'-------------------------------------------------------------------------------------'
Public Sub WriteSysIBMAttribute(ByVal strDB2TargetEnv As String, _
ByVal strDB2Table As String, _
ByVal strDB2SourceEnv As String)
On Error GoTo WriteSysIBMAtttribute_Err
Dim dbDAO As DAO.Database
Dim rstDAO As DAO.Recordset
Dim dbDAOSysTables As DAO.Database
Dim rstDAOSysTables As DAO.Recordset
Dim strSQL As String
strSQL = modSQL.QSelDelTable("tblSysIBMTableAttribs", _
True)
CurrentDb.Execute strSQL
strSQL = modSQL.QSelSysCreatsColsNames(UCase(Trim(strDB2TargetEnv)), _
UCase(strDB2Table))
Set dbDAOSysTables = CurrentDb()
Set rstDAOSysTables = dbDAOSysTables.OpenRecordset(strSQL, _
dbOpenSnapshot)
strSQL = modSQL.QSelDelTable("tblSysIBMTableAttribs", _
False)
Set dbDAO = CurrentDb()
Set rstDAO = dbDAO.OpenRecordset(strSQL, _
dbOpenDynaset)
With rstDAOSysTables
Do Until .EOF
rstDAO.AddNew
rstDAO!UmgebTabelle = strDB2SourceEnv & modPublDecl.gconFullStop & !TBNAME
rstDAO!Attribut = !Name
rstDAO.Update
.MoveNext
Loop
.Close
rstDAO.Close
End With
WriteSysIBMAttribute_Exit:
Set dbDAOSysTables = Nothing
Set rstDAOSysTables = Nothing
Set dbDAO = Nothing
Set rstDAO = Nothing
DoEvents ' Ereignissteuerung an Betriebssystem übergeben
Exit Sub
WriteSysIBMAttribute_Err:
Resume WriteSysIBMAttribute_Exit
End Sub
'-------------------------------------------------------------------------------------'
' Funktion: NumJCLTables
'
' Beschreibung: Ermittelt die Anzahl Load File Tabellen.
'
' Parameter: Ohne
'
' Rückgabe: NumJCLTables
'-------------------------------------------------------------------------------------'
Private Function NumJCLTables() As Integer
On Error GoTo NumJCLTables_Err
Dim dbDAO As DAO.Database
Dim rstDAO As DAO.Recordset
Dim strSQL As String
strSQL = modSQL.QSelDistTableField("tblJCLLoadFileTableAttribs", _
"UmgebTabelle")
Set dbDAO = CurrentDb()
Set rstDAO = dbDAO.OpenRecordset(strSQL, _
dbOpenSnapshot)
With rstDAO
.MoveLast
NumJCLTables = .RecordCount
.Close
End With
NumJCLTables_Exit:
Set dbDAO = Nothing
Set rstDAO = Nothing
Exit Function
NumJCLTables_Err:
Resume NumJCLTables_Exit
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
'-------------------------------------------------------------------------------------'
' Prozedur: HourGlassState
'
' Beschreibung: Ändert den Mauszeiger, gesteuert durch boolHourGlass, in eine Sanduhr
' bzw. setzt den Mauszeiger auf den Standardmauszeiger zurück.
'
' Parameter: boolHourGlass
'-------------------------------------------------------------------------------------'
Public Sub HourGlassState(ByVal boolHourGlass As Boolean)
DoCmd.Hourglass boolHourGlass
DoEvents ' Ereignissteuerung - Mauszeiger ändern
End Sub
