Try this in XP ? (memory leak) 
Author Message
 Try this in XP ? (memory leak)

The behaviour is the same under Win98/A97
and under WinME/A2K, but I've never tested
it with Win2K/Axp or even WinNT.  If anybody
wants to have a go (or make suggestions about
the code), I'm curious about how it goes.
In Access 2K+ you will have to set a reference
to DAO.

(david)

The following is very close to code provided by
Marc-Andre Fontaine in Jan 2000.  It was intended
to compare two databases, but you can run it on
just one target database, comparing to itself. The
target database should have a lot of tables if you
have time.  (The comparison takes only seconds
but the code may take minutes to run to completion)

Each time there is an 'error' reading a property,
you loose some memory.  You get 'errors' because
there are properties enumerated that are not valid.
The memory is released when the Workspace goes
out of scope, but only after a long delay while
Access is unresponsive  (It won't run with 'break
on all errors' because the idea is to move on to the
next property etc)
If you have 'system monitor installed, you can
watch the memory loss and return.

-------------

Public Function findDiscrepancies(newFileName As String, _
                            fileName As String) As Variant
Dim newField  As DAO.Field
Dim oldField  As DAO.Field
Dim wrkJet    As DAO.Workspace
Dim isField   As Boolean
Dim isProp    As Boolean
Dim myProp    As DAO.Property
Dim newBDD    As DAO.Database
Dim remoteBDD As DAO.Database
Dim lx        As Long
Dim i As Integer, j As Integer

Dim newTabledef As TableDef, oldTabledef As TableDef
Dim newTabledefs As TableDefs, oldTabledefs As TableDefs
Dim aName As String, sSourceTable As String
Dim newTables() As String
Dim fieldDiscrepancies() As String
Dim sPwd as String
      sPwd = ""
Set wrkJet = DBEngine.CreateWorkspace("", CurrentUser, sPwd)
Set newBDD = wrkJet.OpenDatabase(newFileName, , True)
Set remoteBDD = wrkJet.OpenDatabase(fileName, , True)
      '1- Find the new tables

On Error GoTo errorHandler
isField = False
Set oldTabledefs = remoteBDD.TableDefs
Call SysCmd(acSysCmdInitMeter, "progress", newBDD.TableDefs.Count)
      'ProgressBar.Min = 0
      'ProgressBar.Max = newBDD.TableDefs.Count
      'ProgressBar.Visible = True
For Each newTabledef In newBDD.TableDefs
          'ProgressBar.Value = ProgressBar.Value + 1
    lx = lx + 1
    Call SysCmd(acSysCmdUpdateMeter, lx)
    If ((newTabledef.Attributes And DB_SYSTEMOBJECT) = 0) Then
        Set oldTabledef = oldTabledefs(newTabledef.Name)
        '2- if no error at this point the table exist look for new Fields
        For Each newField In newTabledef.Fields
            isField = True
            Set oldField = oldTabledef(newField.Name)
            '3- if no error at this point check for the fields Properties
            For Each myProp In newField.Properties
                isProp = True
                If (oldField.Properties(myProp.Name) <> myProp _
                And myProp.Name <> "OrdinalPosition" _
                And myProp.Name < "ColumnOrder") Then
                       'Msgbox "some bull"
                End If
continue_property:
            Next
            isProp = False
continue_field:
        Next
        isField = False
continue:
    End If
Next
Call SysCmd(acSysCmdSetStatus, "Releasing Memory")
DoEvents

newBDD.Close
Set newBDD = Nothing
remoteBDD.Close
Set remoteBDD = Nothing
wrkJet.Close
Set wrkJet = Nothing

Call SysCmd(acSysCmdClearStatus)
MsgBox "completed"

'findDiscrepancies = newTables
Exit Function
errorHandler:
         If (isProp = True) Then
             Resume continue_property
         End If
      If isField Then
          ReDim Preserve fieldDiscrepancies(j)
          fieldDiscrepancies(i) = newField.Name + vbCrLf + newTabledef.Name
          j = j + 1
          'MsgBox "New field " + vbCrLf + newField.Name + vbCrLf + "in Table" + vbCrLf + newTabledef.Name
          Resume continue_field
      Else
          ReDim Preserve newTables(i)
          newTables(i) = newTabledef.Name
          i = i + 1
          Resume continue 'No need to go through the fields of the new table...
      End If
End Function



Wed, 22 Sep 2004 13:46:24 GMT  
 Try this in XP ? (memory leak)

Quote:

>The behaviour is the same under Win98/A97
>and under WinME/A2K, but I've never tested
>it with Win2K/Axp or even WinNT.  If anybody
>wants to have a go (or make suggestions about
>the code), I'm curious about how it goes.
>In Access 2K+ you will have to set a reference
>to DAO.

>(david)

>The following is very close to code provided by
>Marc-Andre Fontaine in Jan 2000.  It was intended
>to compare two databases, but you can run it on
>just one target database, comparing to itself. The
>target database should have a lot of tables if you
>have time.  (The comparison takes only seconds
>but the code may take minutes to run to completion)

>Each time there is an 'error' reading a property,
>you loose some memory.  You get 'errors' because
>there are properties enumerated that are not valid.
>The memory is released when the Workspace goes
>out of scope, but only after a long delay while
>Access is unresponsive  (It won't run with 'break
>on all errors' because the idea is to move on to the
>next property etc)
>If you have 'system monitor installed, you can
>watch the memory loss and return.

[...]

Hi David
I see the exact same phenomenon on Windows XP Pro SP1 / Access XP /
SP1 with your code.
I have modified your code somewhat. Most noteably, I open the
databases exclusively instead of read only. In the modified version, I
still see the memory usage go up, but much less so. In your case,
memory goes up about 75MB, in the modified case about 40MB.
Moreover, the closing of the databases  is a matter of a few seconds,
not of minutes.
Greetings
Matthias Klaey
www.kcc.ch

Public Function findDisc2(newFileName As String, _
                            fileName As String) As Variant
Dim newField  As DAO.Field
Dim oldField  As DAO.Field
Dim myProp    As DAO.Property
Dim newBDD    As DAO.Database
Dim remoteBDD As DAO.Database
Dim newTabledef As TableDef, oldTabledef As TableDef
Dim newTabledefs As TableDefs, oldTabledefs As TableDefs

Dim lngErr      As Long
Dim varPrpName  As Variant
Dim varPrpValue As Variant

On Error GoTo errorHandler
Set newBDD = DBEngine.OpenDatabase(newFileName, True)
Set remoteBDD = DBEngine.OpenDatabase(fileName, True)
'1- Find the new tables

Set oldTabledefs = remoteBDD.TableDefs
For Each newTabledef In newBDD.TableDefs
    If ((newTabledef.Attributes And DB_SYSTEMOBJECT) = 0) Then
        On Error Resume Next
        Set oldTabledef = oldTabledefs(newTabledef.Name)
        lngErr = Err.Number
        On Error GoTo errorHandler
        If lngErr = 0 Then
           '2- if no error at this point the table exist look for new
Fields
           For Each newField In newTabledef.Fields
               On Error Resume Next
               Set oldField = oldTabledef(newField.Name)
               lngErr = Err.Number
               On Error GoTo errorHandler
               If lngErr = 0 Then
                  '3- if no error at this point check for the fields
Properties
                  For Each myProp In newField.Properties
                     On Error Resume Next
                     varPrpName = myProp.Name
                     lngErr = Err.Number
                     On Error GoTo errorHandler
                     If lngErr = 0 Then
                        On Error Resume Next
                        varPrpValue = myProp.Value
                        lngErr = Err.Number
                        On Error GoTo errorHandler
                        If lngErr = 0 Then
                           ' Do some stuff
                        End If
                     End If
                  Next
               End If
               Debug.Print "Field = " & oldField.Name
           Next
        End If
        Debug.Print "Table = " & oldTabledef.Name
    End If
Next

msgbox "Before newBDD.Close"
newBDD.Close
Set newBDD = Nothing
msgbox "Before remoteBDD.Close"
remoteBDD.Close
Set remoteBDD = Nothing
msgbox "completed"
Exit Function

errorHandler:
   msgbox Err.Number & " " & Err.Description
End Function



Thu, 30 Sep 2004 23:23:55 GMT  
 
 [ 2 post ] 

 Relevant Pages 

1. Memory Leaks/Resource Leaks

2. OLE Automation Problems - MEMORY HOG (Memory Leak?)

3. memory leak in vitual memory

4. memory leak on vitual memory

5. Memory Leak -- Out of Memory

6. ADO Memory Leak results in out of memory

7. Memory leaks using shell from VBA with winAPI kernel32

8. Email Reports - Memory leak?

9. Horrible Memory Leaks...

10. large number of execute statements / memory leak ?

11. Memory Leak in VB ACCESS 2k ?

12. SR2 causes memory leak!???

 

 
Powered by phpBB® Forum Software