ich habe unkontrollierte Programmabstürze bei nachfolgendem Formular. Der Absturz ereignet sich beim ersten, 5. oder 12. Öffnen des Fensters und an unterschiedlichen Stellen im Code - manchmal ganz am Anfang, manchmal mittendrin, manchmal aber auch erst am Ende. Die Fenster werden unterschiedlich weit aufgebaut. Es kommt die MS-Fehlermeldung
kbrun.exe hat ein Problem festgestellt und muss beendet werten. - dieses Problem auch an MS senden?
mit folgender Projektsignatur
AppName: kbrun.exe
AppVers: 0.0.0.0
ModName: kbrun.exe
ModVers: 0.0.0.0
Offset: 0034cbd8
Das Offset ist bei allen Abstürzen gleich. Der Cache wurde regelmäßig geleert.
Was kann ich tun, um den Fehler zu finden und zu beheben?
- Code: Select all
Dim sRecID as String
Private Sub Form_OnOpen()
'Allgemein
Dim iDS as Integer, iSP as Short, iPrime as Short = 0
'Window-Handling
Dim iLabLen as Short = 0, iFldLen as Integer = 0, iHight as Integer
Dim iFldH as Short = 20, iFldMaxLen as Short = 120
Dim iOffsetX as Short = 10, iOffsetY as Short = 5
Dim iFormX as Integer, iFormY as Integer = iOffsetX, iPosH as Integer
Dim sFont as String = "Arial", iFontSize as Short = 11
Dim nFontFakt as Single = 0.51 * 0.353 * 4 'Schriftbreite, pt-Breite, Screen
Dim nScreenPart as Single = 0.8
Dim iScreenW as Integer = ScreenW
Dim iScreenH as Integer = ScreenH
'DB-Handling
Dim iNCols as Short, iNRows as Integer
Dim sSQL as String
Dim sFldNames as Strings = New Strings, sFK as Strings = New Strings
Dim sCmbVal as Strings = New Strings
Dim vField[1,1] as Variant
'Control-Handling
Dim lb as Label, tb as TextBox, cmb as ComboBox, cb as CommandButton
Dim iPosX as Integer, iPosY as Integer, iCtlW as Integer, iCtlH as Integer
Dim sCtlName as String, sCtlType as String, sCtlGroup as String = "MyGroup"
'Arbeitsumgebung einrichten
Me.Caption = ho_FormCap
'Datenbank handeln, Feldnamen ermitteln
If Database.SetCurrentDatabase(ho_DB) Then
sSQL = "SELECT * FROM " & ho_TBL & ";"
sRecID = Records.Open(ho_DB, sSQL)
sFldNames = Records.FieldNames(sRecID)
iNCols = sFldNames.Length
iNRows = Records.Length(sRecID)
Records.First(sRecID)
EndIf
'Dimensionen der Felder ermitteln
'1: Name, 2: Länge des Namens, 3: Feldtyp, 4: Feldlänge, 5: Feldhöhe, 6:Wert
ReDim vField[1 To iNCols, 1 To 6]
For iSP = 1 To iNCols
vField[iSP, 1] = sFldNames.String(iSP)
vField[iSP, 2] = Len(vField[iSP, 1])
vField[iSP, 3] = FldType(ho_DB, ho_TBL, vField[iSP, 1])
vField[iSP, 4] = FldDim(ho_DB, ho_TBL, vField[iSP, 1])
If vField[iSP, 4] > iFldMaxLen Then
vField[iSP, 5] = Int(vField[iSP, 4] / iFldMaxLen + 1) * iFldH
vField[iSP, 4] = iFldMaxLen
Else
vField[iSP, 5] = iFldH
EndIf
If iNRows = 0 Then
vField[iSP, 6] = ""
Else
vField[iSP, 6] = Records.Value(sRecID, vField[iSP, 1])
EndIf
' Print iSP, vField[iSP, 1], vField[iSP, 2], vField[iSP, 3], _
' vField[iSP, 4], vField[iSP, 6] ', vField[iSP, 5]
iLabLen = Max(iLabLEn, vField[iSP, 2] * iFontSize * nFontFakt)
iFldLen = Max(iFldLen, vField[iSP, 4] * iFontSize * nFontFakt)
iFormY = iFormY + vField[iSP, 5] + iOffsetY
Next iSP
'Platzbedarf vertikal (X) und horizontal (Y) ermitteln und Fenstergröße setzen
iFormX = iOffsetX + iLabLen + iOffsetX + iFldLen + iOffsetX
iFormY = iFormY + iOffsetX
If iFormX > iScreenW * nScreenPart Then iFormX = iScreenW * nScreenPart
If iFormY > iScreenH * nScreenPart Then iFormY = iScreenH * nScreenPart
Me.Width = iFormX
Me.Height = iFormY
Me.X = Int(iScreenW - iFormX) / 2
Me.Y = Int(iScreenH - iFormY) / 2
Me.Visible = True
'Controlls erstellen
iPosH = iOffsetX
' Print
For iSP = 1 To iNCols
'Label anlegen
sCtlName = "lb" & iSP
sCtlType = "Label"
ControlAppend(sCtlName, sCtlType, sCtlGroup, _
iOffsetX, iPosH, iLabLen, iFldH, True)
lb = Control(sCtlName)
lb.FontName = sFont
lb.FontSize = iFontSize
lb.Caption = vField[iSP, 1]
'Primary und Foreign Key ermitten
If iPrime = 0 Then
If FldIsPrimary(ho_DB, ho_TBL, vField[iSP, 1]) Then iPrime = iSP
EndIf
sFK = ShowForeignKey(ho_DB, ho_TBL, vField[iSP, 1])
' Print iSP, vField[iSP, 1], vField[iSP, 2], vField[iSP, 3], _
' vField[iSP, 4], vField[iSP, 6] ', vField[iSP, 5]
'Feld anlegen,
If sFK.Length > 0 Then 'Foreign Key liegt vor
sCmbVal = CreateCMB(ho_DB, sFK)
sCtlName = "cmb" & iSP
sCtlType = "ComboBox"
ControlAppend(sCtlName, sCtlType, sCtlGroup, _
iOffsetX + iLabLen + iOffsetX, iPosH, iFldLen, vField[iSP,5], True)
cmb = Control(sCtlName)
cmb.FontName = sFont
cmb.FontSize = iFontSize
cmb.RemoveAll
For iDS = 1 To sCmbVal.Length
cmb.Append(sCmbVal.String(iDS))
Next iDS
cmb.Value = sCmbVal.String(vField[iSP, 6])
Else
If vField[iSP, 3] = "boolean" then
sCtlName = "cmb" & iSP
sCtlType = "ComboBox"
ControlAppend(sCtlName, sCtlType, sCtlGroup, _
iOffsetX + iLabLen + iOffsetX, iPosH, iFldLen, vField[iSP,5], True)
cmb = Control(sCtlName)
cmb.FontName = sFont
cmb.FontSize = iFontSize
cmb.RemoveAll
cmb.Append("Ja")
cmb.Append("Nein")
If iNRows > 0 Then
If vField[iSP, 6] = 0 Then
cmb.Value = "Nein"
ElseIf vField[iSP, 6] = 1 Then
cmb.Value = "Ja"
EndIf
Else
cmb.Value = " "
EndIf
Else
sCtlName = "tb" & iSP
sCtlType = "TextBox"
ControlAppend(sCtlName, sCtlType, sCtlGroup, _
iOffsetX + iLabLen + iOffsetX, iPosH, iFldLen, vField[iSP,5], True)
tb = Control(sCtlName)
tb.FontName = sFont
tb.FontSize = iFontSize
tb.Alignment = "AlignLeft" + "AlignTop"
tb.Value = vField[iSP, 6]
If iPrime = iSP Then tb.ReadOnly = True
EndIf
EndIf
'Höhe für die nächste Zeile berechnen
iPosH = iPosH + vField[iSP, 5] + iOffsetY
Next iSP
End Sub 'Form_OnOpen________________________________________________________
Private Function CreateCMB(sDB as String, sFK as Strings) as Strings
Dim iDS as Integer, iNRows as Integer, iSP as Short, iNCols as Short
Dim iFldPos as Short
Dim sFKDB as String, sFKTbl as String, sFKCol as String, sFKPos as String
Dim sSQL as String, sRID as String, sLfFld as String
Dim sFldNames as Strings = New Strings, sCmbVal as Strings = New Strings
' For iDS = 1 To sFK.Length
' Print iDS, sFK.String(iDS)
' Next iDS
sFKDB = sFK.String(1)
sFKTbl = sFK.String(2)
sFKCol = sFK.String(3)
sFKPos = sFK.String(4)
sLfFld = Right(sFKTbl, Len(sFKTbl) - 4)
If Database.CurrentDatabase <> sFKDB Then Database.SetCurrentDatabase(sFKDB)
sSQL = "SELECT * FROM " & sFKTbl & ";"
sRID = Records.Open(sFKDB, sSQL)
sFldNames = Records.FieldNames(sRID)
iNCols = sFldNames.Length
iNRows = Records.Length(sRID)
Records.First(sRID)
For iSP = 1 To iNCols
' Print iSP, sFldNames.String(iSP)
If Lower(sFldNames.String(iSP)) = Lower(sLfFld) Then
For iDS = 1 To iNRows
sCmbVal.Append(Records.Value(sRID, sLfFld))
Next iDS
Exit For
EndIf
Next iSP
Records.Close(sRID)
If Database.CurrentDatabase <> sDB Then Database.SetCurrentDatabase(sDB)
Return sCmbVal
End Function 'CreateCMB_____________________________________________________
