VB crashing on the DAO.recordset close when upgrading the oracle 7 to 10g

[sonulove457]

hi,
When i am trying to close the recordset after retreving the data from the oracle then on close the vb is crashing. this was earlier working fine wid oracle 7.
thanx,
sonu

[si_the_geek]

Welcome to VBForums

It is hard to tell without seeing your code and knowing exactly what the error is... but I suspect a likely cause of the issue is that you are using DAO, which has been recommended against for 10 years.

Does it work properly if you use ADO instead? (or if you are using VB2002 or later, ADO.Net?)

[sonulove457]

hi,
I am using vb6.0 application. actually it is an big old application all connections made through DAO.

Private Sub CopyTable(ByVal StageNo%, ByVal ReportHeading$, ByVal TableName$, _
                      ByVal configFile$, Optional Par1$)
    Dim snp As DAO.Recordset
    Dim n As Long
    Dim numrec As Long
    Dim i As Integer
    Dim InsertSQL As String
    'Dim tabAccess As DAO.Recordset
    Dim tabAccess As DAO.Recordset
    Dim SQL As String
    Dim ClearSQL As String
    Dim iRecreateTable As Boolean
    Dim Start
    Dim a$
    Dim nTransStart As Integer
    Dim pwd As String
    Dim SyncField$
    Dim SyncFieldAppend As Boolean
    Dim msg$
    
    msg$ = GetIni(TableName$, "StatusMessage", configFile$)
    SyncField$ = GetIni(TableName$, "SyncField", configFile$)
    SyncFieldAppend = IIf(GetIni(TableName$, "SyncAppend", configFile$) = "", False, True)

    Start = Now
    ShowMessage "(Stage " & StageNo & ") Setting up " & msg$ & " ..."
    If SyncField = "" Then
        iRecreateTable = True
        ClearSQL = GetIni(TableName$, "ClearSQL", configFile$)
        If ClearSQL <> "" Then
            For i = 0 To gCache.TableDefs.Count - 1
                If UCase$(gCache.TableDefs(i).Name) = UCase$(TableName$) Then
                    iRecreateTable = False
                    i = gCache.TableDefs.Count
                End If
            Next i
            If Not iRecreateTable Then
                gCache.Execute ClearSQL   'Clear table if exists
            End If
        Else
            'Delete table and add in the latest structure
            On Local Error Resume Next
            gCache.Execute "DROP TABLE [" & TableName$ & "]"
            On Local Error GoTo 0
        End If
    Else
        iRecreateTable = False
    End If
    ShowMessage "(Stage " & StageNo & ") Extracting " & msg$ & " ..."

    numrec = 10000
    If GetIni(TableName$, "ViewTable", configFile$) = "" Then
        If GetSnapshot("select count(rowid) from " & TableName$) Then
            numrec = gSnapshot.fields(0)
        End If
    Else
        SQL = GetIni(TableName$, "Count", configFile$)
        If SQL <> "" Then
            If GetSnapshot(SQL) Then
                numrec = gSnapshot.fields(0)
            End If
        End If
    End If
    SQL = GetCopyTableQuery(TableName$, configFile$)
    If SQL = "" Then SQL = "SELECT * FROM " & TableName$
    
    SQL = SubField(SQL, "" & gSysPar.UserID, "<USERID>")
    
    
    ShowMessage "(Stage " & StageNo & ") Downloading " & msg$ & " ..."
    Dim iSuccess As Integer
    
    If UCase$(GetIni(TableName$, "DataSource", configFile$)) = "ACCESS" Then
        SQL = ReplaceParameterFields(SQL, ReportHeading$, configFile$, "Access", Par1$)
        Set snp = gCache.OpenRecordset(SQL, dbOpenSnapshot)
        iSuccess = Not (snp.EOF)
    Else
        SQL = ReplaceParameterFields(SQL, ReportHeading$, configFile$, "Oracle", Par1$)
        iSuccess = GetSnapshot(SQL)
        Set snp = gSnapshot
    End If
    
    If iRecreateTable Then   'Recreate the table
        Dim tabNew As TableDef
        Dim fieldNew As Field
        GetFieldStructure GetIni(TableName$, "Heading", configFile$), snp.fields.Count
        ' Create a new Table
        Set tabNew = gCache.CreateTableDef(TableName$)
        If iHeadingCount > 0 Then
            For i = 0 To iHeadingCount - 1
                Select Case snp.fields(i).Type
                Case dbText, dbBinary, dbMemo, dbChar
                    Set fieldNew = tabNew.CreateField(FieldInfo(i), dbText, snp.fields(i).Size)
                    fieldNew.AllowZeroLength = True
                    tabNew.fields.Append fieldNew
                 'Code added by Aliza for Oracle upgrade added dbDecimal-Start
                Case dbDouble, dbFloat
                'Code added by Aliza for Oracle upgrade-End
                    tabNew.fields.Append tabNew.CreateField(FieldInfo(i), dbDouble)
                Case dbCurrency
                    tabNew.fields.Append tabNew.CreateField(FieldInfo(i), dbCurrency)
                Case dbLong, dbInteger, dbByte, dbNumeric, dbDecimal
                    tabNew.fields.Append tabNew.CreateField(FieldInfo(i), dbLong)
                Case dbDate, dbTimeStamp
                    tabNew.fields.Append tabNew.CreateField(FieldInfo(i), dbDate)
                Case Else
                    MsgBox "Unknown data type !"
                End Select
            Next i
        Else
            For i = 0 To snp.fields.Count - 1
                Select Case snp.fields(i).Type
            
                Case dbText, dbBinary, dbMemo, dbChar

                    Set fieldNew = tabNew.CreateField(snp.fields(i).Name, dbText, snp.fields(i).Size)
                    fieldNew.AllowZeroLength = True
                    tabNew.fields.Append fieldNew
                'Code added by Aliza for Oracle upgrade added dbDecimal-Start
                Case dbDouble, dbFloat
                'Code added by Aliza for Oracle upgrade-End
                    tabNew.fields.Append tabNew.CreateField(snp.fields(i).Name, dbDouble)
                Case dbCurrency
                    tabNew.fields.Append tabNew.CreateField(snp.fields(i).Name, dbCurrency)
                Case dbLong, dbInteger, dbByte, dbNumeric, dbDecimal
                    tabNew.fields.Append tabNew.CreateField(snp.fields(i).Name, dbLong)
                Case dbDate, dbTimeStamp
                    tabNew.fields.Append tabNew.CreateField(snp.fields(i).Name, dbDate)
                Case Else
                    MsgBox "Unknown data type !"
                End Select
            Next i
        End If
        
        'Create indexes
        Dim idxNew As Index
        i = 1
        a$ = GetIni(TableName$, "Index" & i, configFile$)
        While a$ <> ""
            Set idxNew = tabNew.CreateIndex(a$)
            idxNew.fields.Append idxNew.CreateField(a$)
            tabNew.Indexes.Append idxNew
            i = i + 1
            a$ = GetIni(TableName$, "Index" & i, configFile$)
        Wend
        
        gCache.TableDefs.Append tabNew
    End If
    
    If iSuccess Then
        If SyncField = "" Then
            'Set tabAccess = gCache.OpenTable(TableName$)
            Set tabAccess = gCache.OpenRecordset(TableName$, dbOpenTable)
        Else
            'Set tabAccess = gCache.OpenTable(GetIni(TableName$, "SyncTable", configFile$))
            Set tabAccess = gCache.OpenRecordset(GetIni(TableName$, "SyncTable", configFile$), dbOpenTable)
        End If
        
        'Get data
        BeginTrans
        nTransStart = 0
        snp.MoveFirst
        
        If SyncField <> "" Then
            'tabAccess.Index = "PrimaryKey"
            tabAccess.Index = SyncField
        End If
        
        While Not snp.EOF
            ShowProgress n / numrec * 100
            n = n + 1
            If SyncField = "" Then
                tabAccess.AddNew
                For i = 0 To snp.fields.Count - 1
                    If snp.fields(i).Type = dbBinary Then
                        If IsNull(snp(i)) Then
                            tabAccess(i) = Null
                        Else
                            tabAccess(i) = "????"
                        End If
                    Else
                        tabAccess(i) = snp(i)
                    End If
                Next i
                tabAccess.Update
                ShowMessage "(Stage " & StageNo & ") Downloading " & msg$ & " ..." & n
            Else
                'Synchronise
                tabAccess.Seek "=", snp.fields(SyncField)
                If Not tabAccess.NoMatch() Then
                    tabAccess.Edit
                    For i = 0 To snp.fields.Count - 1
                        If UCase$(snp.fields(i).Name) <> UCase$(SyncField$) Then
                            If snp.fields(i).Type = dbBinary Then
                                tabAccess(snp(i).Name) = "????"
                            Else
                                If SyncFieldAppend = True Then
                                    If Len(tabAccess(snp(i).Name) & snp(i)) < tabAccess(snp(i).Name).Size Then
                                        tabAccess(snp(i).Name) = tabAccess(snp(i).Name) & snp(i)
                                    End If
                                Else
                                    tabAccess(snp(i).Name) = snp(i)
                                End If
                            End If
                        End If
                    Next i
                    tabAccess.Update
                End If
                ShowMessage "(Stage " & StageNo & ") Synchronising " & msg$ & " ..." & n
            End If
            snp.MoveNext
            nTransStart = nTransStart + 1
            If nTransStart >= 500 Then
                CommitTrans
                BeginTrans
                nTransStart = 1
                DoEvents
            End If
            
        Wend
        CommitTrans
        HideProgress
        tabAccess.Close
        Set tabAccess = Nothing
    Else
        'MsgBox "There's nothing to copy ..."
    End If
    ShowMessage "Extraction Done .. "
    snp.Close   ----the vb application crashes here.... 
    Set snp = Nothing
    Exit Sub
End Sub

[VB Quest]

Hi there,

The details of the error we(Sonu's group) are getting are as follows-

The application was working fine on VB6 on Windows XP and Oracle 8i. MS access is used as local database.
We are now migrating oracle to 10G(both server and client). Because of this some VB reports are crashing when a DAO recordset is closed or DAO object is set to Nothing.

The error we get is :
VB6.EXE - Application Error, The instruction at "0x0306116a" referenced memory at "0x0306116a". The memory could not be "read".

Code snippet is as follows: It fails at 'hSnp.Close'

Private Sub FindReport(Heading$, ByVal IniFile$)
    Dim SQL$
    Dim i%, pos%, w%
    Dim sTemp$, sAlign$
    On Error GoTo FindReportError
    Dim NumPar%
    Dim hSnp As DAO.Recordset
    'Dim hTab As DAO.Recordset
    Dim hTab As DAO.Recordset
    Dim CommonField$
    Dim nRecCount As Long
    Dim NoFields As Integer
    Dim iExecute As Boolean
    '------------------
    ' Execute query
    '------------------
    Dim dataType$
    dataType$ = GetIni$(Heading$, "DataType", IniFile$)
    If dataType$ = "" Then dataType$ = gSysPar.DatabaseType

    iExecute = ReportExecute(Heading$, IniFile$, dataType$)
    '------------------
    ' Get SQL string
    '------------------
    ShowMessage "Getting Query..."
    SQL$ = ""
    i = 1
    sTemp = GetIni(Heading$, "SQL" & Format$(i), IniFile$)
    
    While sTemp$ <> ""
        SQL$ = SQL$ & " " & sTemp$
        i = i + 1
        sTemp = GetIni(Heading$, "SQL" & Format$(i), IniFile$)
    Wend
    CommonField$ = GetIni(Heading$, "CommonField", IniFile$)
    ReDim sField$(Len(CommonField$) / 2)

    '----------------------
    ' Substitute parameters
    '----------------------
    ShowMessage "Setting up parameters..."
    SQL = ReplaceParameterFields(SQL, Heading$, IniFile, dataType$)
    
    Dim sDataSource$
    Dim iRecordFound%
    sDataSource$ = GetIni$(Heading$, "DataSource", IniFile$)
    ShowMessage "Extracting data please wait..."

    If sDataSource$ <> "" Then      'Get data from other sources
        Dim nDb As Database
        Select Case GetIni$(Heading$, "DataType", IniFile$)
        Case "Access"
            Set nDb = OpenDatabase(sDataSource, False, True)
            'Set hSnp = nDb.CreateSnapshot(SQL)
            Set hSnp = nDb.OpenRecordset(SQL, dbOpenSnapshot)
        Case Else
            Set nDb = OpenDatabase("", False, False, sDataSource$)
            'Set hSnp = nDb.CreateSnapshot(SQL, 64)
        End Select
        If Not hSnp.EOF And Not hSnp.BOF Then 'No records found
            iRecordFound = True
        End If
    Else
        If GetSnapshot(SQL) Then        'Normal way of getting records
            iRecordFound = True
            Set hSnp = gSnapshot
        End If
    End If
    
    ShowMessage "Getting Records..."
    If iRecordFound Then
        'Set hTab = gCache.OpenTable("Reports")
        Set hTab = gCache.OpenRecordset("reports", dbOpenTable)
        Dim iFieldNo%
        Dim iCurrentRow%
        nRecCount = 0
        BeginTrans
        Do While Not hSnp.EOF
            hTab.AddNew
            For i = 0 To hSnp.fields.Count - 1
                Select Case Mid$(CommonField$, i * 2 + 1, 1)
                Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"
                    iFieldNo = Val(Mid$(CommonField$, i * 2 + 1, 1))
                    If iCurrentRow Then
                        hTab.fields(i) = Left$("" & hSnp.fields(i), 250)
                    Else
                        If "" & hSnp.fields(iFieldNo) <> sField$(iFieldNo) Then
                            sField$(iFieldNo) = "" & hSnp.fields(iFieldNo)
                            hTab.fields(i) = Left$("" & hSnp.fields(i), 250)
                            iCurrentRow = True
                        End If
                    End If
                Case Else
                    hTab.fields(i) = Left$("" & hSnp.fields(i), 250)
                End Select
            Next i
            hTab.Update
            iCurrentRow = False
            hSnp.MoveNext
            nRecCount = nRecCount + 1
            ShowMessage "Found " & nRecCount & " records ..."
        Loop
        CommitTrans
        NoFields = hSnp.fields.Count
        hSnp.Close
    End If
    Set hSnp = Nothing

    If sDataSource$ <> "" Then      'Close the other databases
        nDb.Close
        Set nDb = Nothing
    End If

End Sub

We are also trying to convert DAO to ADO in parallel but want to know if there's any solution for the above issue.

Thanks in adv.

[si_the_geek]

It looks to me as if both sets of code are not being careful as I would recommend with Object variables, for example in sonu's post idxNew is set and used but not released afterwards (with Set idxNew = Nothing), and in VBQuest's post hTab in neither closed nor released.

I haven't checked the code fully, but issues like the ones mentioned are likely to cause this sort of problem.


Another potential issue is the driver you are using to connect to the database - even if it works for other programs you should ensure that it is valid for 10g, and as you are using DAO that if possible it is an ODBC Driver (as opposed to an OLEDB Provider).