home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / contro2r / form4.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-04-06  |  6.3 KB  |  220 lines
  1. VERSION 5.00
  2. Begin VB.Form Form4 
  3.    BorderStyle     =   1  'Fixed Single
  4.    Caption         =   "Scan File"
  5.    ClientHeight    =   2640
  6.    ClientLeft      =   45
  7.    ClientTop       =   330
  8.    ClientWidth     =   6855
  9.    LinkTopic       =   "Form4"
  10.    MaxButton       =   0   'False
  11.    ScaleHeight     =   2640
  12.    ScaleWidth      =   6855
  13.    StartUpPosition =   3  'Windows Default
  14.    Begin VB.CommandButton seek 
  15.       BackColor       =   &H00C0C0C0&
  16.       Caption         =   "&Seek"
  17.       BeginProperty Font 
  18.          Name            =   "Times New Roman"
  19.          Size            =   8.25
  20.          Charset         =   0
  21.          Weight          =   400
  22.          Underline       =   0   'False
  23.          Italic          =   0   'False
  24.          Strikethrough   =   0   'False
  25.       EndProperty
  26.       Height          =   735
  27.       Left            =   5880
  28.       Picture         =   "Form4.frx":0000
  29.       Style           =   1  'Graphical
  30.       TabIndex        =   9
  31.       ToolTipText     =   "Seek For *ico and load it"
  32.       Top             =   960
  33.       Width           =   855
  34.    End
  35.    Begin VB.CommandButton load 
  36.       Caption         =   "&Load"
  37.       BeginProperty Font 
  38.          Name            =   "Times New Roman"
  39.          Size            =   8.25
  40.          Charset         =   0
  41.          Weight          =   400
  42.          Underline       =   0   'False
  43.          Italic          =   0   'False
  44.          Strikethrough   =   0   'False
  45.       EndProperty
  46.       Height          =   735
  47.       Left            =   5880
  48.       Picture         =   "Form4.frx":0442
  49.       Style           =   1  'Graphical
  50.       TabIndex        =   8
  51.       ToolTipText     =   "Load Record Into Database"
  52.       Top             =   1800
  53.       Width           =   855
  54.    End
  55.    Begin VB.ListBox List2 
  56.       Height          =   2010
  57.       Left            =   3960
  58.       TabIndex        =   5
  59.       Top             =   360
  60.       Width           =   1815
  61.    End
  62.    Begin VB.FileListBox File1 
  63.       Height          =   1650
  64.       Left            =   -1320
  65.       MultiSelect     =   2  'Extended
  66.       Pattern         =   "*.ico"
  67.       TabIndex        =   4
  68.       Top             =   -1200
  69.       Visible         =   0   'False
  70.       Width           =   1815
  71.    End
  72.    Begin VB.CommandButton Command1 
  73.       Caption         =   "&Scan"
  74.       Height          =   735
  75.       Left            =   5880
  76.       Picture         =   "Form4.frx":0884
  77.       Style           =   1  'Graphical
  78.       TabIndex        =   3
  79.       Top             =   120
  80.       Width           =   855
  81.    End
  82.    Begin VB.ListBox List1 
  83.       Height          =   2010
  84.       Left            =   2040
  85.       TabIndex        =   2
  86.       Top             =   360
  87.       Width           =   1815
  88.    End
  89.    Begin VB.DirListBox Dir1 
  90.       Height          =   1890
  91.       Left            =   120
  92.       TabIndex        =   1
  93.       Top             =   480
  94.       Width           =   1815
  95.    End
  96.    Begin VB.DriveListBox Drive1 
  97.       Height          =   315
  98.       Left            =   120
  99.       TabIndex        =   0
  100.       Top             =   120
  101.       Width           =   1815
  102.    End
  103.    Begin VB.Label Label2 
  104.       Caption         =   "Pathname"
  105.       Height          =   255
  106.       Left            =   3960
  107.       TabIndex        =   7
  108.       Top             =   120
  109.       Width           =   1815
  110.    End
  111.    Begin VB.Label Label1 
  112.       Caption         =   "Filename"
  113.       Height          =   255
  114.       Left            =   2040
  115.       TabIndex        =   6
  116.       Top             =   120
  117.       Width           =   1815
  118.    End
  119. Attribute VB_Name = "Form4"
  120. Attribute VB_GlobalNameSpace = False
  121. Attribute VB_Creatable = False
  122. Attribute VB_PredeclaredId = True
  123. Attribute VB_Exposed = False
  124. Dim InitialFolder
  125. Dim totalFiles As Integer
  126. Private Sub Drive1_Change()
  127.     drvc2
  128. End Sub
  129. Private Sub Command1_Click()
  130. On Error GoTo pathac
  131. totalFiles = 0
  132. List1.clear
  133. List2.clear
  134.     ChDrive Drive1.Drive
  135.     ChDir Dir1.Path
  136.     InitialFolder = CurDir
  137.     Me.MousePointer = 11
  138.     ScanFolders
  139.     Me.MousePointer = 0
  140.     MsgBox "There are " & totalFiles & " under the " & InitialFolder & " folder", vbInformation, "dyr_workshop"
  141. Exit Sub
  142. pathac:
  143.     MsgBox "There's Some Path Access Errorr"
  144.     Exit Sub
  145. End Sub
  146. Sub ScanFolders()
  147. Dim subFolders As Integer
  148. Dim i As Integer
  149.     For i = 0 To File1.ListCount - 1
  150.         File1.Selected(i) = True
  151.         List1.AddItem File1.filename
  152.         List2.AddItem File1.Path
  153.     Next i
  154.     totalFiles = totalFiles + File1.ListCount
  155.     subFolders = Dir1.ListCount
  156.     If subFolders > 0 Then
  157.         For i = 0 To subFolders - 1
  158.             ChDir Dir1.List(i)
  159.             Dir1.Path = Dir1.List(i)
  160.             File1.Path = Dir1.List(i)
  161.             Form1.Refresh
  162.             ScanFolders
  163.         Next
  164.     End If
  165.     File1.Path = Dir1.Path
  166.     MoveUp
  167. End Sub
  168. Sub MoveUp()
  169.     If Dir1.List(-1) <> InitialFolder Then
  170.         ChDir Dir1.List(-2)
  171.         Dir1.Path = Dir1.List(-2)
  172.     End If
  173. End Sub
  174. Private Sub Dir1_Change()
  175.     ChDir Dir1.Path
  176.     File1.Path = Dir1.Path
  177. End Sub
  178. Private Sub Form_Load()
  179.     ChDrive App.Path
  180.     ChDir App.Path
  181. End Sub
  182. Private Sub List1_Click()
  183.     List2.ListIndex = List1.ListIndex
  184. End Sub
  185. Private Sub List2_Click()
  186.     List1.ListIndex = List2.ListIndex
  187. End Sub
  188. Private Sub load_Click()
  189. Dim i As Integer
  190. For i = 0 To List1.ListCount - 1
  191.     If List1.Selected(i) Then
  192.         Form1.Data1.Recordset.AddNew
  193.         Form1.Text1.Text = List1.List(i)
  194.         Form1.Text2.Text = List2.List(i)
  195.     If Right(List1.Text, 1) = "\" Then
  196.         Form1.Image1.Picture = LoadPicture(Form1.Text2.Text & Form1.Text1.Text)
  197.     Else
  198.         Form1.Image1.Picture = LoadPicture(Form1.Text2.Text & "\" & Form1.Text1.Text)
  199.     End If
  200.     Form1.Image1.Refresh
  201.     Form1.Data1.Recordset.Update
  202.     Form1.Data1.Recordset.MoveLast
  203.     End If
  204. Next i
  205. End Sub
  206. Private Sub seek_Click()
  207.     On Error GoTo xyz
  208.     Me.MousePointer = 11
  209.     Dim i As Integer
  210.     For i = 0 To List1.ListCount - 1
  211.         List1.Selected(i) = True
  212.         load_Click
  213.     Next i
  214.     Me.MousePointer = 0
  215.     MsgBox i & " Records Are Added", vbInformation, "dyr_workshop"
  216. Exit Sub
  217.     MsgBox "There's Nothing To Select", vbCritical, "dyr_workshop"
  218. Exit Sub
  219. End Sub
  220.