PC Plus SuperCD 45/SuperCD45.iso/talleres/vbasic/Form1.frm

Text File | 2000-01-29 | 9KB | 298 lines

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Form1
   Caption         =   "Form1"
   ClientHeight    =   5760
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   8175
   LinkTopic       =   "Form1"
   ScaleHeight     =   5760
   ScaleWidth      =   8175
   StartUpPosition =   3  'Windows Default
   Begin MSComctlLib.ImageList ImageList1
      Left            =   240
      Top             =   4560
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
         NumListImages   =   3
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
            Picture         =   "Form1.frx":0000
            Key             =   "open"
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
            Picture         =   "Form1.frx":0524
            Key             =   "file"
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
            Picture         =   "Form1.frx":0A72
            Key             =   "closed"
         EndProperty
      EndProperty
   End
   Begin MSComctlLib.TreeView TreeView1
      Height          =   4695
      Left            =   2520
      TabIndex        =   10
      Top             =   240
      Width           =   5535
      _ExtentX        =   9763
      _ExtentY        =   8281
      _Version        =   393217
      Indentation     =   706
      Style           =   5
      ImageList       =   "ImageList1"
      Appearance      =   1
   End
   Begin VB.TextBox Destination
      Height          =   375
      Left            =   5520
      TabIndex        =   8
      Text            =   "e:\backup"
      Top             =   5160
      Width           =   2535
   End
   Begin VB.TextBox Source
      Height          =   375
      Left            =   1440
      TabIndex        =   6
      Text            =   "f:\dermot"
      Top             =   5160
      Width           =   2535
   End
   Begin VB.CommandButton ReadCatalogue
      Caption         =   "Read Catalogue"
      Height          =   495
      Left            =   120
      TabIndex        =   5
      Top             =   240
      Width           =   1215
   End
   Begin VB.CommandButton SaveCatalogue
      Caption         =   "Save Catalogue"
      Height          =   495
      Left            =   120
      TabIndex        =   4
      Top             =   3840
      Width           =   1215
   End
   Begin VB.CommandButton ResetArchive
      Caption         =   "Reset Archive"
      Height          =   495
      Left            =   120
      TabIndex        =   3
      Top             =   3120
      Width           =   1215
   End
   Begin VB.CommandButton CopyFiles
      Caption         =   "Copy Files"
      Height          =   495
      Left            =   120
      TabIndex        =   2
      Top             =   2400
      Width           =   1215
   End
   Begin VB.CommandButton ChangedFiles
      Caption         =   "Changed Files"
      Height          =   495
      Left            =   120
      TabIndex        =   1
      Top             =   1680
      Width           =   1215
   End
   Begin VB.CommandButton Directory
      Caption         =   "Directory"
      Height          =   495
      Left            =   120
      TabIndex        =   0
      Top             =   960
      Width           =   1215
   End
   Begin VB.Label Label2
      Caption         =   "Destination"
      Height          =   255
      Left            =   4440
      TabIndex        =   9
      Top             =   5160
      Width           =   975
   End
   Begin VB.Label Label1
      Caption         =   "Source"
      Height          =   255
      Left            =   720
      TabIndex        =   7
      Top             =   5160
      Width           =   615
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Const MAX_PATH = 260
Const INVALID_HANDLE = -1

Private Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End Type

Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long

Private Type WIN32_FIND_DATA
        dwFileAttributes As Long
        ftCreationTime As FILETIME
        ftLastAccessTime As FILETIME
        ftLastWriteTime As FILETIME
        nFileSizeHigh As Long
        nFileSizeLow As Long
        dwReserved0 As Long
        dwReserved1 As Long
        cFileName As String * MAX_PATH
        cAlternate As String * 14
End Type

Dim fd As WIN32_FIND_DATA
Dim tree As BNodeList
Dim changedTree As BNodeList
Dim sDir As String, dDir As String
Dim catalog As Catalogue
' this function creates a BNodeList of all the files in the currentPath.
' it is called recursively to build up a complete directory tree
Function FindFiles(currentPath As String, prev As BNode) As BNodeList
Dim h As Long, more As Boolean
Dim n As BNode, p As BNodeList, list As BNodeList, fn As String, attr As Integer

Set list = New BNodeList

h = FindFirstFile(currentPath & "\*.*", fd)
more = h <> INVALID_HANDLE
While more
    fn = TrimString(fd.cFileName)
    If Left(fn, 1) <> "." Then
        attr = fd.dwFileAttributes
        Call list.Add(fn, attr, Nothing, fn)
        Set n = list(fn)
        Set n.prevBNode = prev
        If attr And vbDirectory Then
            Set p = FindFiles(currentPath & "\" & fn, n)
            Set n.nextBNode = p
        End If
    End If
    more = FindNextFile(h, fd)
Wend

Set FindFiles = list
FindClose (h)

End Function
Private Sub Directory_Click()
sDir = Source.Text
dDir = Destination.Text
If sDir = "" Or dDir = "" Then
    MsgBox ("You must enter a source directory and a destination")
    Exit Sub
End If

Set tree = FindFiles(sDir, Nothing)

' load the TreeView control
Dim t As Node
TreeView1.Nodes.Clear
Set t = TreeView1.Nodes.Add()
t.Key = "a1"
t.Text = dDir
t.Image = "closed"
t.ExpandedImage = "open"
AddTNodes TreeView1, tree, t.Key

End Sub
Private Sub AddTNodes(tv As TreeView, bnlist As BNodeList, level As String)
Dim bn As BNode, t As Node, nlevel As String, i As Integer

i = 1
For Each bn In bnlist
nlevel = level & "." & i
    Set t = tv.Nodes.Add(level, tvwChild, level & "." & i)
    t.Text = bn.fileName
    If Not bn.nextBNode Is Nothing Then
        t.Image = "closed"
        t.ExpandedImage = "open"
        AddTNodes tv, bn.nextBNode, nlevel
    Else
        t.Image = "file"
    End If
    i = i + 1
Next
End Sub
Function TrimString(s1 As String) As String
Dim i As Long

i = InStr(s1, Chr(0))

TrimString = Left(s1, i - 1)
End Function
' builds the changedTree BNodeList from the files in the
'source directory and adds them to the catalogue
Private Sub ChangedFiles_Click()

Set changedTree = tree.Changed(Nothing)
If Not catalog Is Nothing Then
    Call catalog.Add(changedTree)
End If

End Sub
' copies files in changedTree from sDir to dDir
Private Sub CopyFiles_Click()

If Not changedTree Is Nothing Then
    Screen.MousePointer = vbHourglass
    Call changedTree.CopyFiles(dDir, sDir)
    Screen.MousePointer = vbDefault
End If

End Sub
Private Sub ListView1_ItemClick(ByVal i As MSComctlLib.ListItem)
Dim x As ListItem

Set x = i

c.RestoreFile i

End Sub
' resets the archive bit on the files in changedTree
Private Sub ResetArchive_Click()
Dim fbu As Long

fbu = changedTree.ResetArchiveBit(sDir)
MsgBox ("Total files backed up " & fbu)

End Sub
' saves the catalogue to disk
Private Sub SaveCatalogue_Click()

catalog.WriteCatalogue

End Sub
' reads the catalogue from disk
Private Sub ReadCatalogue_Click()
Dim restoreTree As New BNodeList, t As New Token
Set catalog = New Catalogue

dDir = Destination.Text

Call catalog.ReadCatalogue(dDir & "\" & "test.cat")

End Sub