home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 3_2004-2005.ISO / Data / Zips / OE_Email_E1721843192004.psc / DBXFiles.cls < prev    next >
Text File  |  2004-03-09  |  4KB  |  111 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "DBXFiles"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15.                         ' dbx folders to ignore
  16. Const FOLDERS_DBX = "folders.dbx"
  17. Const POP3UIDL_DBX = "pop3uidl.dbx"
  18.  
  19.  
  20. '****
  21. ' Function to return paths of OE dbx files
  22. '       Searches for all identity paths of current user
  23. ' Parameters: None
  24. ' Returns   : array of path strings
  25. '**********
  26. Public Function GetStoreFolder() As String()
  27.     Const IDENTITY_KEY = "HKEY_CURRENT_USER\Identities"
  28.     Const STORE_FOLDER_KEY = "Software\Microsoft\Outlook Express"
  29.     Dim arrStoreFolderValue() As String
  30.     Dim collOEKeys, collOEVersion, collOEValues As Collection
  31.     Dim varSubkey As Variant
  32.     Dim nCount, nSize, nResult As Integer
  33.     Dim strUserProfile As String * 255
  34.     Dim strProfilePath As String
  35.     Dim nLoop As Integer
  36.     
  37.     Set collOEKeys = EnumRegistryKeys(IDENTITY_KEY)
  38.                                 ' get identities
  39.     If collOEKeys.Count > 0 Then
  40.         For Each varSubkey In collOEKeys
  41.           If Not EmptyString(varSubkey) Then
  42.             nCount = nCount + 1
  43.             ReDim Preserve arrStoreFolderValue(nCount)
  44.             arrStoreFolderValue(nCount - 1) = varSubkey & "\"
  45.           End If
  46.         Next
  47.     End If
  48.                                 ' get OE version
  49.     For nLoop = 0 To UBound(arrStoreFolderValue) - 1
  50.         arrStoreFolderValue(nLoop) = IDENTITY_KEY & "\" & arrStoreFolderValue(nLoop) & _
  51.                         STORE_FOLDER_KEY
  52.         Set collOEVersion = EnumRegistryKeys(arrStoreFolderValue(nLoop))
  53.         arrStoreFolderValue(nLoop) = arrStoreFolderValue(nLoop) & "\" & collOEVersion.Item(1)
  54.     Next
  55.                                 ' get OE folder location
  56.     For nLoop = 0 To UBound(arrStoreFolderValue) - 1
  57.         Set collOEValues = EnumRegistryValues(arrStoreFolderValue(nLoop))
  58.         arrStoreFolderValue(nLoop) = collOEValues("Store Root")
  59.     Next
  60.                                 ' get userprofile value
  61.     nResult = ExpandEnvironmentStrings("%UserProfile%", strUserProfile, 255)
  62.     strProfilePath = Left(strUserProfile, nResult - 1)
  63.     
  64.     For nLoop = 0 To UBound(arrStoreFolderValue) - 1
  65.         'arrStoreFolderValue(nLoop) = collOEValues("Store Root")
  66.         arrStoreFolderValue(nLoop) = Replace(arrStoreFolderValue(nLoop), "%UserProfile%", strProfilePath)
  67.     Next
  68.     
  69.     GetStoreFolder = arrStoreFolderValue
  70. End Function
  71. '****
  72. ' Function to return all dbx files in a path
  73. ' Parameters: strPath-> file path
  74. ' Returns   : arrFiles-> array of dbx files
  75. '**********
  76. Public Sub GetDBXFilesInPath(ByVal strPath As String, ByRef arrFiles() As String)
  77.     Dim strFileName As String
  78.     Dim nCount As Integer
  79.     
  80.     strFileName = Dir(strPath & "*.dbx")
  81.     If strFileName <> "" Then
  82.         If Not ExcludeDBX(strFileName) Then
  83.             nCount = nCount + 1
  84.             ReDim Preserve arrFiles(nCount)
  85.             arrFiles(0) = strPath & strFileName
  86.         End If
  87.         Do While strFileName <> ""
  88.             strFileName = Dir
  89.             If strFileName <> "" And Not ExcludeDBX(strFileName) Then
  90.                 nCount = nCount + 1
  91.                 ReDim Preserve arrFiles(nCount)
  92.                 arrFiles(nCount - 1) = strPath & strFileName
  93.             End If
  94.         Loop
  95.     End If
  96.  
  97. End Sub
  98. '****
  99. ' Function to check if a dbx folder is to be excluded
  100. ' Parameters: strFolder-> folder name
  101. ' Returns   : True/false
  102. '**********
  103. Private Function ExcludeDBX(ByVal strFolder As String) As Boolean
  104.  
  105.     ExcludeDBX = LCase(strFolder) = FOLDERS_DBX Or _
  106.        LCase(strFolder) = POP3UIDL_DBX
  107.           
  108. End Function
  109.  
  110.  
  111.