Option Compare Database
Option Explicit
Private Const mconGet As String * 4 = modPublDecl.gconGET & modPublDecl.gconSpace
Private Const mconPut As String * 4 = modPublDecl.gconPUT & modPublDecl.gconSpace
Private Const mconBye As String * 3 = "bye"
Private Const mconDelete As String * 7 = "delete" & modPublDecl.gconSpace
'-------------------------------------------------------------------------------------'
' Funktion: JCLJobControl
'
' Beschreibung: JCL Job Steuerung:
' - Erstellt FTP Befehlsscripte und FTP Parameterdateien.
' - Erstellt das JCL Script und benennt es um.
' - Sendet das modifizierte JCL Script zum Host.
' - Führt das FTP Delete und FTP Job Befehlsscript aus.
' - Löscht alle FTP Befehlsscripte und FTP Parameterdateien.
' - Löscht auf dem PC angelegte Dateien und JCL Scripte.
' - Löscht wahlweise den auf dem Host generierten Job Output.
'
' Parameter: strDB2Env
' strDB2Job
' strJobInitFile
' strJobInitFile
' strJobOKFile
' boolDeleteKey
' rdateJCLTime
' rboolJobStarted
' rboolJobResult
'
' Rückgabe: rdateJCLTime
' rboolJobStarted
' rboolJobResult
' JCLJobControl
'-------------------------------------------------------------------------------------'
Public Function JCLJobControl(ByVal strDB2Env As String, _
ByVal strDB2Job As String, _
ByVal strJobInitFile As String, _
ByVal strJobOKFile As String, _
ByVal strJobFailFile As String, _
ByVal boolDeleteKey As Boolean, _
ByRef rdateJCLTime As Date, _
ByRef rboolJobStarted As Boolean, _
ByRef rboolJobResult As Boolean) As Boolean
If CreateFtpFilesControl(strJobInitFile, _
strJobOKFile, _
strJobFailFile) = True Then
On Error Resume Next
ChDir (modPublDecl.gstrTempDir)
Call modPublic.ShellExecute(modPublDecl.gstrFtpDelCmd)
Call modPublic.ShellExecute(modPublDecl.gstrFtpJCLJobCmd)
Call modPublic.SetStatusBarText(7, _
False, _
0)
rdateJCLTime = JobExecTime(strDB2Env, _
strJobInitFile, _
strJobOKFile, _
strJobFailFile, _
rboolJobStarted, _
rboolJobResult)
SysCmd acSysCmdRemoveMeter
Call modPublic.DeletePCFiles(modPublDecl.gstrFtpJCLJobCmd, modPublDecl.gstrFtpJCLJobParam, _
modPublDecl.gstrFtpInitCmd, modPublDecl.gstrFtpInitParam, _
modPublDecl.gstrFtpOkCmd, modPublDecl.gstrFtpOkParam, _
modPublDecl.gstrFtpFailCmd, modPublDecl.gstrFtpFailParam, _
modPublDecl.gstrFtpDelCmd, modPublDecl.gstrFtpDelParam, _
modPublDecl.gstrFtpGetCmd, modPublDecl.gstrFtpGetParam, _
modPublDecl.gstrFtpPutCmd, modPublDecl.gstrFtpPutParam, _
strJobInitFile, strJobOKFile, strJobFailFile, _
modPublDecl.gstrJCLFileGen, modPublDecl.gstrJCLFileMod)
If strDB2Job = modPublDecl.gconLoadJob Then
Call modPublic.DeletePCFiles(modPublDecl.gconLoadFileGet, _
modPublDecl.gconLoadFilePut)
End If
JCLJobControl = True
Else
JCLJobControl = False
End If
End Function
'-------------------------------------------------------------------------------------'
' Funktion: CreateFtpFilesControl
'
' Beschreibung: Steuert die Erstellung der FTP Befehlsscripte und FTP Parameterdateien.
'
' Parameter: strJobInitFile
' strJobOKFile
' strJobFailFile
'
' Rückgabe: CreateFtpFilesControl
'-------------------------------------------------------------------------------------'
Public Function CreateFtpFilesControl(ByVal strJobInitFile As String, _
ByVal strJobOKFile As String, _
ByVal strJobFailFile As String) As Boolean
On Error GoTo CreateFtpFilesControl_Err
Dim intLoopCnt As Integer
Dim strPutGet As String
Dim avntFTPCmdData() As Variant
avntFTPCmdData = Array(modPublDecl.gstrFtpDelCmd, modPublDecl.gstrFtpDelParam, _
strJobInitFile, strJobOKFile, strJobFailFile, _
modPublDecl.gstrFtpJCLJobCmd, modPublDecl.gstrFtpJCLJobParam, _
modPublDecl.gstrJCLFileMod, modPublDecl.gconJCLJobName, _
modPublDecl.gstrFtpDelJobCmd, modPublDecl.gstrFtpDelJobParam, _
modPublDecl.gstrDelJCLJobPC, modPublDecl.gconDelJCLJobHost, _
modPublDecl.gstrFtpInitCmd, modPublDecl.gstrFtpInitParam, _
strJobInitFile, modPublDecl.gstrTempDir & strJobInitFile, _
modPublDecl.gstrFtpOkCmd, modPublDecl.gstrFtpOkParam, _
strJobOKFile, modPublDecl.gstrTempDir & strJobOKFile, _
modPublDecl.gstrFtpFailCmd, modPublDecl.gstrFtpFailParam, _
strJobFailFile, modPublDecl.gstrTempDir & strJobFailFile)
Call modPublic.GetLoginInfo(False)
CreateFtpFilesControl = CreateFtpCmdFile(avntFTPCmdData(intLoopCnt), _
avntFTPCmdData(intLoopCnt + 1))
If CreateFtpFilesControl = True Then
CreateFtpFilesControl = CreateFtpDelParam(avntFTPCmdData(intLoopCnt + 1), _
avntFTPCmdData(intLoopCnt + 2), _
avntFTPCmdData(intLoopCnt + 3), _
avntFTPCmdData(intLoopCnt + 4))
If CreateFtpFilesControl = True Then
For intLoopCnt = LBound(avntFTPCmdData) + 5 To UBound(avntFTPCmdData) Step 4
CreateFtpFilesControl = CreateFtpCmdFile(avntFTPCmdData(intLoopCnt), _
avntFTPCmdData(intLoopCnt + 1))
If CreateFtpFilesControl = True Then
strPutGet = LCase(IIf(intLoopCnt <= 9, mconPut, mconGet))
CreateFtpFilesControl = CreateFtpParam(avntFTPCmdData(intLoopCnt + 1), _
avntFTPCmdData(intLoopCnt + 2), _
avntFTPCmdData(intLoopCnt + 3), _
strPutGet)
End If
Next intLoopCnt
End If
End If
CreateFtpFilesControl_Exit:
Exit Function
CreateFtpFilesControl_Err:
CreateFtpFilesControl = False
Resume CreateFtpFilesControl_Exit
End Function
'-------------------------------------------------------------------------------------'
' Funktion: CreateFtpCmdFile
'
' Beschreibung: Erstellt das FTP Befehlsscript strFtpCmdFile.
'
' Parameter: strFtpCmdFile
' strFtpParam
'
' Rückgabe: CreateFtpCmdFile
'-------------------------------------------------------------------------------------'
Public Function CreateFtpCmdFile(ByVal strFtpCmdFile As String, _
ByVal strFtpParam As String) As Boolean
On Error GoTo CreateFtpCmdFile_Err
Dim intFileNum As Integer
intFileNum = FreeFile()
Open strFtpCmdFile For Output As #intFileNum
Print #intFileNum, "ftp -vin -s: " & strFtpParam & modPublDecl.gconSpace & _
Forms(modPublDecl.gconFrmHM).lblFTPServer.Caption
CreateFtpCmdFile = True
CreateFtpCmdFile_Exit:
Close #intFileNum
Exit Function
CreateFtpCmdFile_Err:
CreateFtpCmdFile = False
Call FTPFileCreateErrMsg(strFtpCmdFile)
Resume CreateFtpCmdFile_Exit
End Function
'-------------------------------------------------------------------------------------'
' Funktion: CreateFtpDelParam
'
' Beschreibung: Steuert die Erstellung der gconFtpDelParam FTP Parameterdatei.
'
' Parameter: strFtpParaFile
' avntFTPDelFiles() = Parametrisiertes Array
'
' Rückgabe: CreateFtpDelParam
'-------------------------------------------------------------------------------------'
Private Function CreateFtpDelParam(ByVal strFtpParaFile As String, _
ParamArray avntFTPDelFiles() As Variant) As Boolean
On Error GoTo CreateFtpDelParam_Err
Dim intFileNum As Integer
Dim intCnt As Integer
intFileNum = FreeFile()
Open strFtpParaFile For Output As #intFileNum
Print #intFileNum, FTPUser()
Print #intFileNum, mconDelete & modPublDecl.gconJCLJobName
For intCnt = LBound(avntFTPDelFiles) To UBound(avntFTPDelFiles)
Print #intFileNum, mconDelete & avntFTPDelFiles(intCnt)
Next intCnt
Print #intFileNum, mconBye
CreateFtpDelParam = True
CreateFtpDelParam_Exit:
Close #intFileNum
Exit Function
CreateFtpDelParam_Err:
CreateFtpDelParam = False
Call FTPFileCreateErrMsg(modPublDecl.gstrFtpDelParam)
Resume CreateFtpDelParam_Exit
End Function
'-------------------------------------------------------------------------------------'
' Funktion: CreateFTPParam
'
' Beschreibung: Steuert die Erstellung der FTP Parameterdatei strFtpParamFile.
'
' Parameter: strFtpParamFile
' strSourceFile
' strDestinationFile
' strPutGet
'
' Rückgabe: CreateFtpParam
'-------------------------------------------------------------------------------------'
Private Function CreateFtpParam(ByVal strFtpParamFile As String, _
ByVal strSourceFile As String, _
ByVal strDestinationFile As String, _
ByVal strPutGet As String) As Boolean
On Error GoTo CreateFTPParam_Err
Dim intFileNum As Integer
intFileNum = FreeFile()
Open strFtpParamFile For Output As #intFileNum
Print #intFileNum, FTPUser()
If strPutGet = LCase(mconPut) Then
Print #intFileNum, "quote site filetype=jes"
End If
Print #intFileNum, strPutGet & strSourceFile & modPublDecl.gconSpace & strDestinationFile
Print #intFileNum, mconBye
CreateFtpParam = True
CreateFTPParam_Exit:
Close #intFileNum
Exit Function
CreateFTPParam_Err:
CreateFtpParam = False
Resume CreateFTPParam_Exit
End Function
'-------------------------------------------------------------------------------------'
' Prozedur: DeleteJobOutput
'
' Beschreibung: Steuert das Löschen des Job Outputs auf dem Host.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Public Sub DeleteJobOutput()
On Error GoTo DeleteJobOutput_Err
Dim strJobName As String
Dim strJobTyp As String
If modPublic.zOSJCLCfgUpdInProgress() = False Then
If modPublic.JobNameTyp(modPublDecl.gconDelJCLJob, _
strJobName, _
strJobTyp) = True Then
Call modPublic.SetStatusBarText(14, _
False, _
0)
Call modPublDecl.Sleep(modPublDecl.gconSleep * 10)
If CreateFtpDelJobControl(strJobName, _
strJobTyp) = True Then
Call modPublic.ShellExecute(modPublDecl.gstrFtpDelJobCmd)
End If
Call KillFtpDeleteJobFiles
End If
End If
DeleteJobOutput_Exit:
SysCmd acSysCmdRemoveMeter
Exit Sub
DeleteJobOutput_Err:
Call modPublic.ShowMsgBox("Fehler beim Löschen des Job Outputs!", _
modPublDecl.gconOkExcStyle, _
"Job Output löschen", _
True)
Resume DeleteJobOutput_Exit
End Sub
'-------------------------------------------------------------------------------------'
' Funktion: CreateFtpDelJobControl
'
' Beschreibung: Steuert die Erstellung der FTP Befehlsscripte und FTP Parameterdateien
' zur Löschung des Job Outputs auf dem Host.
'
' Parameter: strJobName
' strJobTyp
'
' Rückgabe: CreateFtpDelJobControl
'-------------------------------------------------------------------------------------'
Private Function CreateFtpDelJobControl(ByVal strJobName As String, _
ByVal strJobTyp As String) As Boolean
On Error GoTo CreateFtpDelJobControl_Err
CreateFtpDelJobControl = CreateFtpCmdFile(modPublDecl.gstrFtpDelJobCmd, _
modPublDecl.gstrFtpDelJobParam)
If CreateFtpDelJobControl = True Then
CreateFtpDelJobControl = CreateFtpParam(modPublDecl.gstrFtpDelJobParam, _
modPublDecl.gstrDelJCLJobPC, _
modPublDecl.gconDelJCLJob, _
mconPut)
If CreateFtpDelJobControl = True Then
CreateFtpDelJobControl = CreateDelJCLJobFile(strJobName, _
strJobTyp)
End If
End If
CreateFtpDelJobControl_Exit:
Exit Function
CreateFtpDelJobControl_Err:
CreateFtpDelJobControl = False
Resume CreateFtpDelJobControl_Exit
End Function
'-------------------------------------------------------------------------------------'
' Funktion: CreateDelJCLJobFile
'
' Beschreibung: Steuert die Erstellung des gconDelJCLJobPC JCL Scripts.
'
' Parameter: strJobName
' strJobTyp
'
' Rückgabe: CreateDelJCLJobFile
'-------------------------------------------------------------------------------------'
Private Function CreateDelJCLJobFile(ByVal strJobName As String, _
ByVal strJobTyp As String) As Boolean
On Error GoTo CreateDelJCLJobFile_Err
Dim dbDAO As DAO.Database
Dim rstDAO As DAO.Recordset
Dim strSQL As String
Dim strZeile As String
Dim intFileNum As Integer
Dim avntZeile As Variant
strSQL = modSQL.QSelDelTable("tblJCLTplDelJCLOutput", _
False)
Set dbDAO = CurrentDb()
Set rstDAO = dbDAO.OpenRecordset(strSQL, _
dbOpenSnapshot)
intFileNum = FreeFile()
Open modPublDecl.gconDelJCLJobPC For Output As #intFileNum
With rstDAO
Do Until .EOF
strZeile = !DeleteJCLOutputRecord
Select Case True
Case InStr(1, strZeile, modPublDecl.gconDB2JobName, vbTextCompare) > 0
avntZeile = Split(strZeile, modPublDecl.gconDB2JobName, -1)
strZeile = avntZeile(0) & strJobName & avntZeile(1)
avntZeile = Split(strZeile, modPublDecl.gconDB2JobTyp, -1)
strZeile = avntZeile(0) & strJobTyp & avntZeile(1)
Case Trim(strZeile) = modPublDecl.gconJCLUser
strZeile = Trim(strZeile) & UCase(modPublDecl.gstrHostID)
Case strZeile = modPublDecl.gconDelJobOutpExecCmd
strZeile = GetJobDelExecCmd()
If strZeile = vbNullString Then
Resume CreateDelJCLJobFile_Err
End If
End Select
Print #intFileNum, strZeile
.MoveNext
Loop
.Close
End With
CreateDelJCLJobFile = True
CreateDelJCLJobFile_Exit:
Close #intFileNum
Set dbDAO = Nothing
Set rstDAO = Nothing
Exit Function
CreateDelJCLJobFile_Err:
CreateDelJCLJobFile = False
Resume CreateDelJCLJobFile_Exit
End Function
'-------------------------------------------------------------------------------------'
' Funktion: GetJobDelExecCmd
'
' Beschreibung: Exec Kommando des Delete Job Output Rexx Scripts ermitteln.
'
' Parameter: Ohne
'
' Rückgabe: GetJobDelExecCmd
'-------------------------------------------------------------------------------------'
Private Function GetJobDelExecCmd() As String
On Error GoTo GetJobDelExecCmd_Err
Dim dbDAO As DAO.Database
Dim rstDAO As DAO.Recordset
Dim strSQL As String
strSQL = modSQL.QSelDelTable("tblDB2DMConfig", _
False)
Set dbDAO = CurrentDb()
Set rstDAO = dbDAO.OpenRecordset(strSQL, _
dbOpenSnapshot)
With rstDAO
GetJobDelExecCmd = IIf(.EOF = False, UCase(!JobDeleteExecCommand), vbNullString)
.Close
End With
GetJobDelExecCmd_Exit:
Set dbDAO = Nothing
Set rstDAO = Nothing
Exit Function
GetJobDelExecCmd_Err:
GetJobDelExecCmd = vbNullString
Resume GetJobDelExecCmd_Exit
End Function
'-------------------------------------------------------------------------------------'
' Prozedur: KillFtpDeleteJobFiles
'
' Beschreibung: Löscht die von der Funktion CreateFtpDelJobControl auf dem PC angelegten
' Dateien.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub KillFtpDeleteJobFiles()
On Error GoTo KillFtpDeleteJobFiles_Err
Call modPublic.DeletePCFiles(modPublDecl.gstrFtpDelCmd, _
modPublDecl.gstrFtpDelJobCmd, _
modPublDecl.gstrFtpDelJobParam, _
modPublDecl.gstrDelJCLJobPC)
KillFtpDeleteJobFiles_Exit:
Exit Sub
KillFtpDeleteJobFiles_Err:
Resume KillFtpDeleteJobFiles_Exit
End Sub
'-------------------------------------------------------------------------------------'
' Funktion: JobExecTime
'
' Beschreibung: Ermittelt die Laufzeit des Jobs.
'
' Parameter: strDB2Env
' strJobInitFile
' strJobOKFile
' strJobFailFile
' rboolJobStarted
' rboolJobResult
'
' Rückgabe: rboolJobStarted
' rboolJobResult
' JobExecTime
'-------------------------------------------------------------------------------------'
Private Function JobExecTime(ByVal strDB2Env As String, _
ByVal strJobInitFile As String, _
ByVal strJobOKFile As String, _
ByVal strJobFailFile As String, _
ByRef rboolJobStarted As Boolean, _
ByRef rboolJobResult As Boolean) As Date
On Error GoTo JobExecTime_Err
Dim dbDAO As DAO.Database
Dim rstDAO As DAO.Recordset
Dim strSQL As String
Dim dateStartTime As Date
Dim dateEndTime As Date
Dim intProgBarMaxInd As Integer
Call modPublic.HourGlassState(True)
strSQL = modSQL.QSelDelCorrTableField("tblJCLJobsRunning", _
"DB2Environment", _
strDB2Env, _
False, _
False)
Set dbDAO = CurrentDb()
Set rstDAO = dbDAO.OpenRecordset(strSQL, _
dbOpenSnapshot)
With rstDAO
dateStartTime = !JobInitiated
dateEndTime = !JobTimeOut
.Close
End With
intProgBarMaxInd = ProgBarInd(dateEndTime)
Set dbDAO = Nothing
Set rstDAO = Nothing
Do While Now() <= dateEndTime
If rboolJobStarted = False Then
Call UpdateJobTimeRemaining(modPublDecl.gconINIT, _
dateEndTime, _
intProgBarMaxInd)
If GetFile(modPublDecl.gstrFtpInitCmd, _
strJobInitFile) = True Then
rboolJobStarted = True
End If
End If
Call UpdateJobTimeRemaining(modPublDecl.gconSpace & modPublDecl.gconOK & _
modPublDecl.gconSpace, _
dateEndTime, _
intProgBarMaxInd)
If GetFile(modPublDecl.gstrFtpOkCmd, _
strJobOKFile) = True Then
rboolJobResult = True
rboolJobStarted = True
Exit Do
Else
Call UpdateJobTimeRemaining(modPublDecl.gconFAIL, _
dateEndTime, _
intProgBarMaxInd)
If GetFile(modPublDecl.gstrFtpFailCmd, _
strJobFailFile) = True Then
rboolJobResult = False
rboolJobStarted = True
Exit Do
End If
End If
DoEvents ' Ereignissteuerung an Betriebssystem übergeben
Loop
JobExecTime_Exit:
SysCmd acSysCmdRemoveMeter
JobExecTime = Now() - dateStartTime
Call modPublic.HourGlassState(False)
Exit Function
JobExecTime_Err:
Resume JobExecTime_Exit
End Function
'-------------------------------------------------------------------------------------'
' Prozedur: UpdateJobTimeRemaining
'
' Beschreibung: Aktualisiert den während der Prüfung auf Erfolg des JCL Laufs angezeigten
' Fortschrittsbalken und Fortschrittsbalkentext.
'
' Parameter: strFile
' dateEndTime
' intProgBarMaxInd
'-------------------------------------------------------------------------------------'
Private Sub UpdateJobTimeRemaining(ByVal strFile As String, _
ByVal dateEndTime As Date, _
ByVal intProgBarMaxInd As Integer)
On Error GoTo UpdateJobTimeRemaining_Err
Dim strStatBarMsg As String
Dim lngNow As Long
Dim lngEnd As Long
Dim intProgBarCurInd As Integer
strStatBarMsg = "Ergebnis (" & UCase(strFile) & ") des " & _
StrConv(modPublDecl.gstrJobTyp, vbProperCase) & " Jobs ermitteln" & _
modPublDecl.gconTripleStop
intProgBarCurInd = ProgBarInd(dateEndTime)
SysCmd acSysCmdInitMeter, strStatBarMsg, intProgBarMaxInd
SysCmd acSysCmdUpdateMeter, IIf(intProgBarMaxInd < 0, intProgBarMaxInd, _
intProgBarMaxInd - intProgBarCurInd)
UpdateJobTimeRemaining_Exit:
Exit Sub
UpdateJobTimeRemaining_Err:
Resume UpdateJobTimeRemaining_Exit
End Sub
'-------------------------------------------------------------------------------------'
' Funktion: GetFile
'
' Beschreibung: Überträgt mittels des Befehlsscripts strCmdFile die Host Datei strFTPFile
' per FTP auf den PC und überprüft, ob die übertragene Datei Daten enthält.
'
' Parameter: strCmdFile
' strFTPFile
'
' Rückgabe: GetFile
'-------------------------------------------------------------------------------------'
Private Function GetFile(ByVal strCmdFile As String, _
ByVal strFtpFile As String) As Boolean
On Error GoTo GetFile_Err
Dim strFTPFileTarget As String
strFTPFileTarget = modPublDecl.gstrTempDir & strFtpFile
Call modPublic.ShellExecute(strCmdFile)
Call modPublDecl.Sleep(modPublDecl.gconSleep * 2)
If FileLen(strFTPFileTarget) = 0 Then
Kill strFTPFileTarget
GetFile = False
ElseIf FileLen(strFTPFileTarget) > 0 Then
GetFile = True
End If
GetFile_Exit:
Exit Function
GetFile_Err:
GetFile = False
Resume GetFile_Exit
End Function
'-------------------------------------------------------------------------------------'
' Prozedur: FTPFileCreateErrMsg
'
' Beschreibung: Fehlermeldung, falls die FTP Dateierstellung fehlschlug.
'
' Parameter: strDatei
'-------------------------------------------------------------------------------------'
Private Sub FTPFileCreateErrMsg(ByVal strDatei As String)
Call modPublic.ShowMsgBox("Die FTP-Datei '" & strDatei & "' konnte nicht erstellt " & _
"werden!", _
modPublDecl.gconOkExcStyle, _
"FTP Dateierstellung", _
True)
End Sub
'-------------------------------------------------------------------------------------'
' Funktion: FtpPutGetLoadFile
'
' Beschreibung: Steuert die Übertragung des Load Files mittels FTP Befehlsscripten und
' FTP Parameterdateien mit 'get' vom IBM Host auf den PC und mit 'put'
' vom PC zum IBM Host.
'
' Parameter: boolPut
' strSegment
' strLoadFile
'
' Rückgabe: FtpPutGetLoadFile
'-------------------------------------------------------------------------------------'
Public Function FtpPutGetLoadFile(ByVal boolPut As Boolean, _
ByVal strLoadFileSegment As String, _
ByVal strLoadFile As String) As Boolean
On Error GoTo FtpPutGetLoadFile_Err
Dim intFileNum As Integer
Dim strFtpCmdFile As String
Dim strFtpPara As String
intFileNum = FreeFile()
strFtpPara = IIf(boolPut = True, _
mconPut & strLoadFile & modPublDecl.gconSpace & "'" & strSegment & "'", _
mconGet & "'" & strSegment & "'" & modPublDecl.gconSpace & strLoadFile)
strFtpCmdFile = IIf(boolPut = True, modPublDecl.gstrFtpPutCmd, modPublDecl.gstrFtpGetCmd)
Open strFtpCmdFile For Output As #intFileNum
Print #intFileNum, strFtpPara
Close #intFileNum
Call modPublic.ShellExecute(strFtpCmdFile)
FtpPutGetLoadFile = IIf(boolPut = False And FileLen(strLoadFile) = 0, False, True)
FtpPutGetLoadFile_Exit:
Exit Function
FtpPutGetLoadFile_Err:
FtpPutGetLoadFile = False
Resume FtpPutGetLoadFile_Exit
End Function
'-------------------------------------------------------------------------------------'
' Funktion: JobResult
'
' Beschreibung: Boolesche Variablen auswerten und Ergebnis des Programmlaufs anzeigen.
'
' Parameter: boolJobStarted
' boolJobResult
' strJobType
' boolDeleteKey
' dateJCLTime
' intNumSegments
' strDB2Env
'
' Rückgabe: JobResult
'-------------------------------------------------------------------------------------'
Public Function JobResult(ByVal boolJobStarted As Boolean, _
ByVal boolJobResult As Boolean, _
ByVal strJobType As String, _
ByVal boolDeleteKey As Boolean, _
ByVal dateJCLTime As Date, _
ByVal intNumSegments As Integer, _
ByVal strDB2Env As String) As Boolean
On Error GoTo JobResult_Err
Const conJCLLdaUtil As String = modPublDecl.gconUtil & _
modPublDecl.gconFullStop & _
modPublDecl.gconDsnuProc
Const conRCEQNull As String = " = 0"
Const conRCGTNull As String = " > 0"
Const conRCGTEQEight As String = " >= 8"
Dim dbDAO As DAO.Database
Dim rstDAO As DAO.Recordset
Dim strSQL As String
Dim strEnvChar As String
Dim strJob As String
Dim strReturnCode As String
Dim strJobTime As String
Dim strJobTimeMsg As String
Dim strJobResult As String
Dim strTitelMeldung As String
Dim intJobRC As Integer ' 1=OK; 2=FAIL; 3=NOT RUN; 4=LOAD RC=4
Dim strUtilName As String
Dim strRCMeldung As String
Dim intMsgBoxStyle As Integer
modPublDecl.gboolJobTimeOut = False
strJobTime = Format(dateJCLTime, modPublDecl.gcondateMinsSecs) & " Minuten."
If boolJobStarted = True And boolJobResult = True Then
strJobTimeMsg = "Dauer des JCL Laufs " & strJobTime & vbCrLf & vbCrLf
Else
modPublDecl.gboolJobTimeOut = True
strSQL = modSQL.QSelDelCorrTableField("tblJCLJobsRunning", _
"DB2Environment", _
strDB2Env, _
False, _
False)
Set dbDAO = CurrentDb()
Set rstDAO = dbDAO.OpenRecordset(strSQL, _
dbOpenDynaset)
With rstDAO
If !JobTimeOut < Now() Then ' Time Out
strJobTimeMsg = "Time Out nach " & strJobTime
Else ' ABEND (Abnormal End)
strJobTimeMsg = "Abbruch nach " & strJobTime & vbCrLf & vbCrLf & _
"Der Job wurde womöglich mit ABEND " & _
"(Abnormal End) abgebrochen."
End If
.Close
End With
End If
modPublDecl.gboolLoadRCFour = False
modPublDecl.gboolLoadRCEight = False
strRCMeldung = "Return Code(s):" & vbCrLf
If strJobType = modPublDecl.gconLoadJob Then
strJob = IIf(boolDeleteKey = True, "Key(s) löschen und laden", "Laden")
If modPublDecl.gboolJobTimeOut = True Then
strReturnCode = strJobTimeMsg
intJobRC = 2
Else
strEnvChar = Trim(Right(strDB2Env, 1))
If boolJobResult = True Then
strReturnCode = strJobTimeMsg & _
ReturnCodeMsg(intNumSegments, _
strDB2Env, _
strJobType)
Select Case True
Case modPublDecl.gboolLoadRCEight
intJobRC = 2
strReturnCode = strRCMeldung & _
Left(conJCLLdaUtil, 4) & strEnvChar & _
Mid(conJCLLdaUtil, 5, Len(conJCLLdaUtil)) & _
modPublDecl.gconRC & conRCGTEQEight
Case modPublDecl.gboolLoadRCFour
intJobRC = 4
Case Else
intJobRC = 1
End Select
End If
End If
ElseIf strJobType = modPublDecl.gconUnloadJob Then
strJob = "Entladen"
If modPublDecl.gboolJobTimeOut = True Then
strReturnCode = strJobTimeMsg
intJobRC = 2
Else
strReturnCode = strRCMeldung & modPublDecl.gconDB2UNLOAD & modPublDecl.gconRC
If boolJobResult = True Then
strReturnCode = strJobTimeMsg & strReturnCode & conRCEQNull
intJobRC = 1
Else
strReturnCode = strReturnCode & conRCGTNull
intJobRC = 2
End If
End If
ElseIf strJobType = modPublDecl.gconDeleteJob Or strJobType = modPublDecl.gconClearJob Then
If strJobType = modPublDecl.gconDeleteJob Then
strJob = "Löschen"
ElseIf strJobType = modPublDecl.gconClearJob Then
strJob = "Tabelleninhalt(e) löschen"
End If
If modPublDecl.gboolJobTimeOut = True Then
strReturnCode = strJobTimeMsg
intJobRC = 2
Else
strRCMeldung = IIf(strJobType = modPublDecl.gconDeleteJob, _
modPublDecl.gconDB2DEL, _
modPublDecl.gconDB2SQL2) & _
modPublDecl.gconRC
If boolJobResult = True Then
strReturnCode = strRCMeldung & conRCEQNull
intJobRC = 1
Else
strReturnCode = strRCMeldung & conRCGTNull
intJobRC = 2
End If
End If
End If
If boolJobStarted = False And modPublDecl.gboolJobTimeOut = False Then
strReturnCode = strJobType & " - Jobverarbeitung nicht erfolgreich!"
intJobRC = 3
End If
strTitelMeldung = "[" & strJob & " - Job "
If intJobRC = 1 Or intJobRC = 4 Then
JobResult = True
strTitelMeldung = strTitelMeldung & modPublDecl.gconOK
intMsgBoxStyle = IIf(intJobRC = 1, _
modPublDecl.gconOkInfStyle, _
modPublDecl.gconYNDef2ExcStyle)
ElseIf intJobRC = 2 Or intJobRC = 3 Then
JobResult = False
intMsgBoxStyle = modPublDecl.gconYNCritStyle
strTitelMeldung = IIf(intJobRC = 2, _
strTitelMeldung & modPublDecl.gconFAIL, _
strTitelMeldung & "nicht gelaufen")
End If
strTitelMeldung = strTitelMeldung & "]"
If intJobRC = 1 Then
Call modPublic.ShowMsgBox(strReturnCode & vbCrLf & vbCrLf & _
"Der Job Output wird nach Bestätigung dieser " & _
"Meldung gelöscht!", _
intMsgBoxStyle, _
strTitelMeldung, _
False)
Call DeleteJobOutput
ElseIf intJobRC = 2 Or intJobRC = 3 Or intJobRC = 4 Then
If modPublic.ShowMsgBox(strReturnCode & vbCrLf & vbCrLf & _
"Job Output löschen?" & vbCrLf & vbCrLf & _
"Falls Sie den Job Output im 'Flasher' einsehen " & _
"möchten, diese Meldung mit 'Nein' bestätigen und " & _
"die Anwendung nicht schließen.", _
intMsgBoxStyle, _
strTitelMeldung, _
IIf(intJobRC = 4, False, True)) = vbYes Then
Call DeleteJobOutput
End If
End If
JobResult_Exit:
Set dbDAO = Nothing
Set rstDAO = Nothing
Exit Function
JobResult_Err:
Resume JobResult_Exit
End Function
'-------------------------------------------------------------------------------------'
' Funktion: CreateFtpGetRCParam
'
' Beschreibung: Steuert die Erstellung der gconFTPGetRcParam FTP Parameterdatei.
'
' Parameter: intCnt
' strDB2Env
'
' Rückgabe: CreateFtpGetRCParam
'-------------------------------------------------------------------------------------'
Private Function CreateFtpGetRCParam(ByVal intCnt As Integer, _
ByVal strDB2Env As String) As Boolean
On Error GoTo CreateFtpGetRCParam_Err
Dim intFileNum As Integer
Dim stfDB2EnvTrail As String * 1
stfDB2EnvTrail = Trim(Right(strDB2Env, 1))
intFileNum = FreeFile()
Open modPublDecl.gstrFtpGetRcParam For Output As #intFileNum
Print #intFileNum, FTPUser()
Print #intFileNum, mconGet & "'" & _
modPublDecl.gstrHostID & modPublDecl.gconFullStop & _
modPublDecl.gconUtil & intCnt & stfDB2EnvTrail & modPublDecl.gconRC & _
"' " & modPublDecl.gstrTempDir & _
modPublDecl.gconUtil & intCnt & stfDB2EnvTrail & modPublDecl.gconRC
Print #intFileNum, mconBye
CreateFtpGetRCParam = True
CreateFtpGetRCParam_Exit:
Close #intFileNum
Exit Function
CreateFtpGetRCParam_Err:
CreateFtpGetRCParam = False
Call FTPFileCreateErrMsg(modPublDecl.gstrFtpGetRcParam)
Resume CreateFtpGetRCParam_Exit
End Function
'-------------------------------------------------------------------------------------'
' Funktion: ReturnCodeMsg
'
' Beschreibung: Baut die Meldung mit den ausgelesenen Return Codes des LOAD Jobs auf.
'
' Parameter: intNumSegments
' strDB2Env
' strJobType
'
' Rückgabe: ReturnCodeMsg
'-------------------------------------------------------------------------------------'
Private Function ReturnCodeMsg(ByVal intNumSegments As Integer, _
ByVal strDB2Env As String, _
ByVal strJobType As String) As String
On Error GoTo ReturnCodeMsg_Err
Dim intCnt As Integer
Dim intFileNum As Integer
Dim strRCMeldung As String
Dim strEnvChar As String
Dim strZeile As String
Dim strPCDateiname As String
Dim strHostFileName As String
Dim strUtilRCLeft As String
Dim strUtilRCMid As String
Dim strUtil As String
Dim strRCCnt As String
modPublDecl.gboolLoadRCFour = False
strEnvChar = Trim(Right(strDB2Env, 1))
Call CreateFtpCmdFile(modPublDecl.gstrFtpGetRcCmd, _
modPublDecl.gstrFtpGetRcParam)
For intCnt = 0 To intNumSegments - 1
ReDim Preserve modPublDecl.gavntLoadRC(intCnt)
intCnt = IIf(UBound(modPublDecl.gavntLoadRC) > 0, intCnt + 1, 0)
Call CreateFtpGetRCParam(intCnt, strDB2Env)
Call modPublic.ShellExecute(modPublDecl.gstrFtpGetRcCmd)
Next intCnt
strRCMeldung = "Return Code(s):" & vbCrLf
strUtilRCLeft = Left(modPublDecl.gconLoadUtilRC, 4)
strUtilRCMid = Mid(modPublDecl.gconLoadUtilRC, 5, Len(modPublDecl.gconLoadUtilRC))
For intCnt = LBound(modPublDecl.gavntLoadRC) To UBound(modPublDecl.gavntLoadRC)
intFileNum = FreeFile()
strUtil = IIf(intNumSegments > 1, _
modPublDecl.gconUtil & intCnt + 1, _
modPublDecl.gconUtil)
strHostFileName = strUtil & strEnvChar & modPublDecl.gconRC
modPublDecl.gavntLoadRC(intCnt) = strHostFileName
strPCDateiname = modPublDecl.gstrTempDir & strHostFileName
On Error Resume Next
Open strPCDateiname For Input As #intFileNum
Line Input #intFileNum, strZeile
If strJobType = modPublDecl.gconLoadJob And Trim(CInt(strZeile)) = 4 Then
modPublDecl.gboolLoadRCFour = True
ElseIf strJobType = modPublDecl.gconLoadJob And Trim(CInt(strZeile)) >= 8 Then
modPublDecl.gboolLoadRCEight = True
End If
strRCCnt = IIf(UBound(modPublDecl.gavntLoadRC) > 0, CStr(intCnt + 1), vbNullString)
strRCMeldung = strRCMeldung & _
strUtilRCLeft & strRCCnt & strEnvChar & _
strUtilRCMid & " = " & _
IIf(Trim(strZeile) <> "", Trim(strZeile), "?")
If intCnt < UBound(modPublDecl.gavntLoadRC) Then
strRCMeldung = strRCMeldung & IIf(intCnt Mod 2 = 0, vbTab, vbCrLf)
End If
Close #intFileNum
Next intCnt
ReturnCodeMsg_Exit:
ReturnCodeMsg = strRCMeldung
Close #intFileNum
Exit Function
ReturnCodeMsg_Err:
If Err.Number = modPublDecl.gconFileNotFound Then
Resume Next
Else
Resume ReturnCodeMsg_Exit
End If
End Function
'-------------------------------------------------------------------------------------'
' Funktion: DelJobRCFiles
'
' Beschreibung: Erstellt, abhängig vom Parameter boolHost, die gconFTPDelParam
' Parameterdatei zur Löschung der Return Code Dateien auf dem Host bzw.
' löscht die im lokalen Temp Verzeichnis angelegten Return Code Dateien.
'
' Parameter: boolHost
'
' Rückgabe: DelJobRCFiles
'-------------------------------------------------------------------------------------'
Public Function DelJobRCFiles(ByVal boolHost As Boolean) As Boolean
On Error GoTo DelJobRCFiles_Err
Dim intFileNum As Integer
Dim intCnt As Integer
If boolHost = True Then
intFileNum = FreeFile()
Open modPublDecl.gstrFtpDelParam For Output As #intFileNum
Print #intFileNum, FTPUser()
End If
For intCnt = LBound(modPublDecl.gavntLoadRC) To UBound(modPublDecl.gavntLoadRC)
If boolHost = True Then
Print #intFileNum, mconDelete & modPublDecl.gavntLoadRC(intCnt)
If intCnt = UBound(modPublDecl.gavntLoadRC) Then
Print #intFileNum, mconBye
End If
ElseIf boolHost = False Then
Kill modPublDecl.gstrTempDir & modPublDecl.gavntLoadRC(intCnt)
End If
Next intCnt
DelJobRCFiles = True
DelJobRCFiles_Exit:
If boolHost = True Then
Close #intFileNum
End If
Exit Function
DelJobRCFiles_Err:
If boolHost = True Then
DelJobRCFiles = False
Call FTPFileCreateErrMsg(modPublDecl.gstrFtpDelParam)
Resume DelJobRCFiles_Exit
ElseIf boolHost = False And Err.Number = modPublDecl.gconFileNotFound Then
Resume Next
End If
End Function
'-------------------------------------------------------------------------------------'
' Funktion: FTPUser
'
' Beschreibung: Baut die FTP Benutzer(in)zeile auf.
'
' Parameter: Ohne
'
' Rückgabe: FTPUser
'-------------------------------------------------------------------------------------'
Private Function FTPUser() As String
FTPUser = "user" & modPublDecl.gconSpace & LCase(modPublDecl.gstrHostID) & _
modPublDecl.gconSpace & LCase(modPublDecl.gstrHostPwd)
End Function
'-------------------------------------------------------------------------------------'
' Funktion: FillLoadRCArray
'
' Beschreibung: Füllt das Array modPublDecl.gavntLoadRC() mit dem/den vom JCL Load Job
' zurückgegebenen Returncode(s).
'
' Parameter: strDB2Env
' intNumSegments
'
' Rückgabe: FillLoadRCArray
'-------------------------------------------------------------------------------------'
Public Function FillLoadRCArray(ByVal strDB2Env As String, _
ByVal intNumSegments As Integer) As Boolean
On Error GoTo FillLoadRCArray_Err
Dim intCnt As Integer
For intCnt = 0 To intNumSegments - 1
ReDim Preserve modPublDecl.gavntLoadRC(intCnt)
modPublDecl.gavntLoadRC(intCnt) = modPublDecl.gconUtil & _
IIf(intNumSegments > 1, intCnt + 1, vbNullString) & _
Trim(Right(strDB2Env, 1)) & modPublDecl.gconRC
Next intCnt
FillLoadRCArray = True
FillLoadRCArray_Exit:
Exit Function
FillLoadRCArray_Err:
FillLoadRCArray = False
Resume FillLoadRCArray_Exit
End Function
'-------------------------------------------------------------------------------------'
' Funktion: ProgBarInd
'
' Beschreibung: Berechnet den aktuellen Index (in Sekunden) des Fortschrittsbalkens.
'
' Parameter: dateEnd
'
' Rückgabe: ProgBarInd
'-------------------------------------------------------------------------------------'
Private Function ProgBarInd(ByVal dateEnd As Date) As Integer
On Error GoTo ProgBarInd_Err
Dim dateDiff As Date
dateDiff = dateEnd - Now()
ProgBarInd = _
CLng((Mid(Format(dateDiff, modPublDecl.gconEurDateTime), 12, 2) * 3600 _
+ Mid(Format(dateDiff, modPublDecl.gconEurDateTime), 15, 2) * 60 _
+ Mid(Format(dateDiff, modPublDecl.gconEurDateTime), 18, 2)))
ProgBarInd_Exit:
Exit Function
ProgBarInd_Err:
Resume ProgBarInd_Exit
End Function
