home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic 4 Power Pack / Visual_Basic4_Power_Pack.bin / vb4files / novermdb / novermdb.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1996-11-20  |  4.2 KB  |  130 lines
  1. VERSION 4.00
  2. Begin VB.Form NoVerMDB 
  3.    BorderStyle     =   5  'Sizable ToolWindow
  4.    ClientHeight    =   4005
  5.    ClientLeft      =   195
  6.    ClientTop       =   1440
  7.    ClientWidth     =   8160
  8.    Height          =   4410
  9.    Left            =   135
  10.    LinkTopic       =   "Form1"
  11.    MaxButton       =   0   'False
  12.    MinButton       =   0   'False
  13.    ScaleHeight     =   4005
  14.    ScaleWidth      =   8160
  15.    ShowInTaskbar   =   0   'False
  16.    Top             =   1095
  17.    Width           =   8280
  18.    Begin VB.ListBox ListFiles 
  19.       Height          =   5325
  20.       Left            =   75
  21.       TabIndex        =   0
  22.       Top             =   30
  23.       Width           =   5880
  24.    End
  25. Attribute VB_Name = "NoVerMDB"
  26. Attribute VB_Creatable = False
  27. Attribute VB_Exposed = False
  28. 'FRMNoVerMDB by LCL 100413.2733@compuserve.com
  29. Option Explicit
  30. Function SearchMDB(ByVal DiskLetter$, l As ListBox, chMsg$, ByVal QuelleEXT As String) As Integer
  31. 'FRMNoVerMDB by LCL 100413.2733@compuserve.com
  32. ReDim tRep(0) As String
  33. Dim Repertoire$, FileExt$, lo&, nDir&, nFile&
  34. On Error Resume Next
  35. l.Clear
  36. Repertoire = Left(DiskLetter, 1) + ":\" '+ Left(CurDir, InStr(CurDir, ":")) + "\"
  37.     'NomVolume = Dir(Repertoire + "*.*", vbVolume)
  38.         
  39. Do Until Repertoire = "" Or Err > 0 Or DoEvents = 0
  40.            
  41.     FileExt = Dir(Repertoire + "*.*", vbNormal + vbHidden + vbSystem + vbDirectory + vbArchive)
  42.     Do Until FileExt = "" Or Err > 0 Or DoEvents = 0
  43.         If GetAttr(Repertoire + FileExt) And vbDirectory Then
  44.             lo& = FileLen(Repertoire + FileExt)
  45.             If Err = 53 Or Err = 76 Then
  46.                 '. .. Racine et Branche!...
  47.                 Err = 0
  48.             Else
  49.                 nDir& = nDir& + 1
  50.                 ReDim Preserve tRep(UBound(tRep) + 1)
  51.                 tRep(UBound(tRep)) = Repertoire + FileExt + "\"
  52.                 'Debug.Print tRep(UBound(tRep))
  53.             End If
  54.         ElseIf UCase(Right(Repertoire + FileExt, 4)) = "." + QuelleEXT Then
  55.             l.AddItem Repertoire + FileExt
  56.             l.TopIndex = l.ListCount - 1
  57.             nFile& = nFile& + 1
  58.         Else
  59.             nFile& = nFile& + 1
  60.         End If
  61.         FileExt = Dir
  62.     Loop
  63.     Repertoire = tRep(UBound(tRep))
  64.     If UBound(tRep) = 0 Then
  65.     Else
  66.         ReDim Preserve tRep(UBound(tRep) - 1)
  67.     End If
  68. If Err = 0 Then
  69.     chMsg = "Terminate with success for volume " + Left(CurDir, 2) + Chr(10) + _
  70.         Format(nDir) + " directories" + Chr(10) + _
  71.         Format(nFile) + " files"
  72.     chMsg = "Error n
  73. " + Format(Err) + " " + Error(Err)
  74. End If
  75. Erase tRep
  76. SearchMDB = Err
  77. Err = 0
  78. End Function
  79. Private Sub Form_Activate()
  80. 'FRMNoVerMDB by LCL 100413.2733@compuserve.com
  81. Dim index As Integer, chMsg$
  82. Dim db As Database, mdb$
  83. MousePointer = vbHourglass
  84. Screen.MousePointer = vbHourglass
  85. Enabled = False
  86. index = SearchMDB(IIf(Len(Command) = 0, CurDir, Command), listfiles, chMsg, "MDB")
  87. Select Case index
  88. Case 0
  89.     For index = 0 To listfiles.ListCount - 1
  90.         On Error Resume Next
  91.         mdb = listfiles.List(index)
  92.         Set db = Workspaces(0).OpenDatabase(mdb)
  93.         If Err = 0 Then
  94.             listfiles.List(index) = "V. " + db.Version + Chr(9) + mdb
  95.         Else
  96.             listfiles.List(index) = "Error " + Error(Err) + Chr(9) + mdb
  97.         End If
  98.         db.Close
  99.         Kill Left(mdb, Len(mdb) - 3) + "LDB"
  100.     Next index
  101. Case Else
  102. End Select
  103. MousePointer = vbNormal 'vbHourglass
  104. Screen.MousePointer = vbNormal 'vbHourglass
  105. Enabled = True
  106. MsgBox "Author : " + App.CompanyName + Chr(10) + _
  107.         App.LegalCopyright + Chr(10) + Chr(10) + _
  108.         chMsg + Chr(10) + Chr(10) + _
  109.         "Command : NoVerMDB.EXE [C:]", _
  110.         vbInformation, _
  111.         App.Title
  112. End Sub
  113. Private Sub Form_Load()
  114. 'FRMNoVerMDB by LCL 100413.2733@compuserve.com
  115. On Error Resume Next
  116. Caption = "LCL - Search n
  117. version all Jet MDBs"
  118. App.Title = Caption
  119. Top = (Screen.Height - Height) / 2
  120. Left = (Screen.Width - Width) / 2
  121. End Sub
  122. Private Sub Form_Resize()
  123. 'FRMNoVerMDB by LCL 100413.2733@compuserve.com
  124. On Error Resume Next
  125. listfiles.Top = 0
  126. listfiles.Left = 0
  127. listfiles.Width = ScaleWidth
  128. listfiles.Height = ScaleHeight
  129. End Sub
  130.