home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 6_2008-2009.ISO / data / zips / SearchMySt2118966302008.psc / frmBuild.frm < prev    next >
Text File  |  2008-06-26  |  8KB  |  262 lines
  1. VERSION 5.00
  2. Begin VB.Form frmBuild 
  3.    Caption         =   "Build Reference Database"
  4.    ClientHeight    =   3885
  5.    ClientLeft      =   60
  6.    ClientTop       =   345
  7.    ClientWidth     =   6285
  8.    Icon            =   "frmBuild.frx":0000
  9.    LinkTopic       =   "Form1"
  10.    ScaleHeight     =   3885
  11.    ScaleWidth      =   6285
  12.    StartUpPosition =   3  'Windows Default
  13.    Begin VB.CheckBox chkClear 
  14.       Caption         =   "Clear Database"
  15.       Height          =   495
  16.       Left            =   240
  17.       TabIndex        =   11
  18.       ToolTipText     =   "Empties the Database before populating"
  19.       Top             =   3360
  20.       Width           =   1335
  21.    End
  22.    Begin VB.CommandButton cmdPopulate 
  23.       Caption         =   "Populate Database"
  24.       Enabled         =   0   'False
  25.       Height          =   495
  26.       Left            =   1680
  27.       TabIndex        =   10
  28.       ToolTipText     =   "Store the files in the database"
  29.       Top             =   3360
  30.       Width           =   3015
  31.    End
  32.    Begin VB.CommandButton cmdScan 
  33.       Caption         =   "Start Scan"
  34.       Height          =   495
  35.       Left            =   1680
  36.       TabIndex        =   8
  37.       ToolTipText     =   "Scan Path above for the selected files"
  38.       Top             =   1545
  39.       Width           =   3015
  40.    End
  41.    Begin VB.TextBox txtScanPath 
  42.       Height          =   285
  43.       Left            =   1635
  44.       TabIndex        =   6
  45.       Text            =   "C:\"
  46.       Top             =   1065
  47.       Width           =   4095
  48.    End
  49.    Begin VB.CommandButton cmdBrScan 
  50.       Caption         =   "..."
  51.       Height          =   285
  52.       Left            =   5715
  53.       TabIndex        =   5
  54.       ToolTipText     =   "Change the Scan Path"
  55.       Top             =   1065
  56.       Width           =   375
  57.    End
  58.    Begin VB.CheckBox chkExt 
  59.       Caption         =   "Usercontrols"
  60.       Height          =   255
  61.       Index           =   3
  62.       Left            =   4830
  63.       TabIndex        =   3
  64.       Tag             =   "*.ctl"
  65.       Top             =   465
  66.       Value           =   1  'Checked
  67.       Width           =   1215
  68.    End
  69.    Begin VB.CheckBox chkExt 
  70.       Caption         =   "Class Modules"
  71.       Height          =   255
  72.       Index           =   2
  73.       Left            =   3190
  74.       TabIndex        =   2
  75.       Tag             =   "*.cls"
  76.       Top             =   465
  77.       Value           =   1  'Checked
  78.       Width           =   1575
  79.    End
  80.    Begin VB.CheckBox chkExt 
  81.       Caption         =   "Bas Modules"
  82.       Height          =   255
  83.       Index           =   1
  84.       Left            =   1800
  85.       TabIndex        =   1
  86.       Tag             =   "*.bas"
  87.       Top             =   465
  88.       Value           =   1  'Checked
  89.       Width           =   1215
  90.    End
  91.    Begin VB.CheckBox chkExt 
  92.       Caption         =   "Forms"
  93.       Height          =   255
  94.       Index           =   0
  95.       Left            =   630
  96.       TabIndex        =   0
  97.       Tag             =   "*.frm"
  98.       Top             =   465
  99.       Value           =   1  'Checked
  100.       Width           =   1215
  101.    End
  102.    Begin VB.Label lblPath 
  103.       Height          =   855
  104.       Left            =   120
  105.       TabIndex        =   9
  106.       Top             =   2280
  107.       Width           =   6015
  108.    End
  109.    Begin VB.Label Label3 
  110.       Caption         =   "Start Scanning At:"
  111.       Height          =   255
  112.       Left            =   195
  113.       TabIndex        =   7
  114.       Top             =   1125
  115.       Width           =   1935
  116.    End
  117.    Begin VB.Label Label2 
  118.       Alignment       =   2  'Center
  119.       Caption         =   "Scan For:"
  120.       Height          =   255
  121.       Left            =   1695
  122.       TabIndex        =   4
  123.       Top             =   105
  124.       Width           =   2895
  125.    End
  126. End
  127. Attribute VB_Name = "frmBuild"
  128. Attribute VB_GlobalNameSpace = False
  129. Attribute VB_Creatable = False
  130. Attribute VB_PredeclaredId = True
  131. Attribute VB_Exposed = False
  132. 'Program needs a reference to dao360.dll
  133. 'Do not need to have MS Access installed
  134. 'May need to register it
  135. 'Possible Locations:
  136. 'C:\Program Files\Common Files\Microsoft Shared\DAO\dao360.dll
  137. 'C:\WINDOWS\ServicePackFiles\i386
  138. 'Download site
  139. 'http://www.domainpunch.com/support/articles/dao.php
  140.  
  141. 'As written, the db gets cleared before each populate
  142. 'If you have numerous sources, just uncheck
  143. 'the 'Clear Database' checkbox each time
  144. 'you scan/populate.  You will likely wind up
  145. 'with a lot of dupes, as I did, but the
  146. 'companion app allows you to delete entries
  147. Option Explicit
  148. Private DB As DAO.Database
  149. Private DBPath As String
  150. Private Files() As String
  151. Private FCnt As Long
  152. Private Sub Form_Load()
  153.  'rename the file, change the path as desired
  154.  DBPath = App.Path & "\Ref.mdb"
  155. End Sub
  156.  
  157. Private Sub Form_Unload(Cancel As Integer)
  158.  Set DB = Nothing
  159. End Sub
  160.  
  161. Private Sub cmdBrScan_Click()
  162.  Dim Br As String
  163.  Br = BrowseForFolderByPath(txtScanPath.Text, hWnd, "Select Path to Start Scanning")
  164.  If Len(Br) Then
  165.   txtScanPath.Text = Br
  166.  End If
  167. End Sub
  168.  
  169. Private Function GetSpec() As String
  170.  Dim i As Long
  171.  For i = 0 To 3
  172.   If chkExt(i).Value = vbChecked Then
  173.    If i <> 3 Then
  174.     GetSpec = GetSpec & chkExt(i).Tag & "; "
  175.    Else
  176.     GetSpec = GetSpec & chkExt(i).Tag
  177.    End If
  178.   End If
  179.  Next
  180. End Function
  181. Private Sub cmdScan_Click()
  182.  DoScan
  183. End Sub
  184. Private Sub cmdPopulate_Click()
  185.  Populate
  186. End Sub
  187. Private Sub DoScan()
  188.  Dim Spec As String
  189.  Spec = GetSpec
  190.  If Len(Spec) = 0 Then
  191.   MsgBox "No VB File types selected"
  192.   chkExt(0).SetFocus
  193.   Exit Sub
  194.  End If
  195.  If (Len(txtScanPath.Text) = 0) Or _
  196.     (FolderExists(txtScanPath.Text) = False) Then
  197.   MsgBox "Invalid Scan Path"
  198.   txtScanPath.SetFocus
  199.   Exit Sub
  200.  End If
  201.  'get the files
  202.  EnumFilesStringArrayWildCard txtScanPath.Text, Files, FCnt, Spec, True
  203.  lblPath.Caption = "Done. " & FCnt & " Files Found"
  204.  cmdPopulate.Enabled = CBool(FCnt)
  205.  cmdScan.Enabled = False
  206. End Sub
  207. Private Sub DeletePrev()
  208.  Dim i As Long
  209.  Dim RS As Recordset
  210.  Set RS = DB.OpenRecordset("Main")
  211.  RS.MoveLast
  212.  RS.MoveFirst
  213.  For i = 1 To RS.RecordCount
  214.   RS.Delete
  215.   RS.MoveNext
  216.  Next
  217.  RS.Close
  218. End Sub
  219. Private Sub Populate()
  220.  Dim RS As DAO.Recordset
  221.  Dim i As Long
  222.  Dim FTitle As String
  223.  Set DB = OpenDatabase(DBPath)
  224.  If chkClear.Value = vbChecked Then
  225.   DeletePrev
  226.  End If
  227.  Set RS = DB.OpenRecordset("Main")
  228.  For i = 1 To FCnt
  229.   lblPath.Caption = "Processing File " & i & " of " & FCnt
  230.   lblPath.Refresh
  231.   FTitle = FileTitle(Files(i))
  232.   RS.AddNew
  233.   RS.Fields("Path").Value = Files(i)
  234.   RS.Fields("Type").Value = LCase$(Right$(Files(i), 3))
  235.   RS.Fields("Name").Value = Left$(FTitle, Len(FTitle) - 4)
  236.   RS.Fields("Text").Value = ReadFileBinary(Files(i))
  237.   RS.Fields("Date").Value = FileDateTime(Files(i))
  238.   RS.Fields("Size").Value = FileLen(Files(i))
  239.   RS.Update
  240.  Next
  241.  RS.Close
  242.  lblPath.Caption = lblPath.Caption & vbNewLine & "Compacting Database"
  243.  DB.Close
  244.  CompactDB DBPath
  245.  lblPath.Caption = lblPath.Caption & vbNewLine & "Done!"
  246.  cmdScan.Enabled = True
  247.  cmdPopulate.Enabled = False
  248. End Sub
  249. Private Sub KillExists(ByVal FilePath As String)
  250.  On Error Resume Next
  251.  Kill FilePath
  252. End Sub
  253. Private Sub CompactDB(ByVal FilePath As String)
  254.  Dim TmpFN As String
  255.  TmpFN = App.Path & "\Temp.mdb"
  256.  KillExists TmpFN
  257.  CompactDatabase FilePath, TmpFN, dbLangGeneral
  258.  KillExists FilePath
  259.  Name TmpFN As FilePath
  260. End Sub
  261.  
  262.