frmattrib.frm

这是我在编写文件管理系统时

VERSION 5.00
Begin VB.Form frmAttrib 
   Caption         =   "File Attributes"
   ClientHeight    =   6240
   ClientLeft      =   1920
   ClientTop       =   915
   ClientWidth     =   5850
   Icon            =   "frmAttrib.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   6240
   ScaleWidth      =   5850
   Begin VB.Frame Frame3 
      Height          =   1935
      Left            =   120
      TabIndex        =   22
      Top             =   4200
      Width           =   5535
      Begin VB.Label lblSystemDate 
         AutoSize        =   -1  'True
         Height          =   195
         Left            =   120
         TabIndex        =   23
         Top             =   240
         Width           =   45
      End
   End
   Begin VB.CommandButton cmdErrHandler 
      Caption         =   "Err"
      Height          =   375
      Left            =   3480
      TabIndex        =   20
      Top             =   6720
      Width           =   1455
   End
   Begin VB.CommandButton cmdAttrib 
      Caption         =   "Attrib"
      Height          =   375
      Left            =   1920
      TabIndex        =   19
      Top             =   6720
      Width           =   1095
   End
   Begin VB.DriveListBox drvList 
      Height          =   315
      Left            =   2640
      TabIndex        =   18
      Top             =   240
      Width           =   3015
   End
   Begin VB.CommandButton cmdExit 
      Caption         =   "Exit"
      Height          =   495
      Left            =   4320
      TabIndex        =   17
      Top             =   3600
      Width           =   1335
   End
   Begin VB.Frame Frame2 
      Caption         =   "Change Attributes"
      Height          =   1695
      Left            =   2640
      TabIndex        =   11
      Top             =   2400
      Width           =   1575
      Begin VB.CheckBox Check6 
         Caption         =   "Hidden"
         Height          =   255
         Left            =   120
         TabIndex        =   16
         Top             =   600
         Width           =   855
      End
      Begin VB.CheckBox Check7 
         Caption         =   "System"
         Height          =   255
         Left            =   120
         TabIndex        =   15
         Top             =   1320
         Width           =   1095
      End
      Begin VB.CheckBox Check8 
         Caption         =   "ReadOnly"
         Height          =   255
         Left            =   120
         TabIndex        =   14
         Top             =   840
         Width           =   1095
      End
      Begin VB.CheckBox Check9 
         Caption         =   "Archive"
         Height          =   255
         Left            =   120
         TabIndex        =   13
         Top             =   1080
         Width           =   975
      End
      Begin VB.CheckBox Check10 
         Caption         =   "Normal"
         Height          =   255
         Left            =   120
         TabIndex        =   12
         Top             =   360
         Width           =   975
      End
   End
   Begin VB.CommandButton cmdChange_Attrib 
      Caption         =   "Change File_Attributes"
      Height          =   495
      Left            =   4320
      TabIndex        =   10
      Top             =   2520
      Width           =   1335
   End
   Begin VB.Frame Frame1 
      Caption         =   "Current Attributes"
      Height          =   1695
      Left            =   120
      TabIndex        =   4
      Top             =   2400
      Width           =   1455
      Begin VB.CheckBox Check5 
         Caption         =   "Normal"
         Height          =   255
         Left            =   120
         TabIndex        =   9
         Top             =   360
         Width           =   855
      End
      Begin VB.CheckBox Check1 
         Caption         =   "Hidden"
         Height          =   255
         Left            =   120
         TabIndex        =   8
         Top             =   600
         Width           =   975
      End
      Begin VB.CheckBox Check2 
         Caption         =   "System"
         Height          =   255
         Left            =   120
         TabIndex        =   7
         Top             =   1320
         Width           =   975
      End
      Begin VB.CheckBox Check3 
         Caption         =   "ReadOnly"
         Height          =   255
         Left            =   120
         TabIndex        =   6
         Top             =   840
         Width           =   1095
      End
      Begin VB.CheckBox Check4 
         Caption         =   "Archive"
         Height          =   255
         Left            =   120
         TabIndex        =   5
         Top             =   1080
         Width           =   1095
      End
   End
   Begin VB.DirListBox Dir1 
      Height          =   1665
      Left            =   2640
      TabIndex        =   1
      Top             =   600
      Width           =   3015
   End
   Begin VB.FileListBox File1 
      Height          =   2040
      Left            =   120
      TabIndex        =   0
      Top             =   240
      Width           =   2415
   End
   Begin VB.Label lblSys 
      Height          =   375
      Left            =   1800
      TabIndex        =   21
      Top             =   3000
      Visible         =   0   'False
      Width           =   615
   End
   Begin VB.Label lblAttrib 
      AutoSize        =   -1  'True
      Caption         =   "xxxx"
      Height          =   195
      Left            =   120
      TabIndex        =   3
      Top             =   6600
      Width           =   300
   End
   Begin VB.Label lblName 
      AutoSize        =   -1  'True
      Caption         =   "xxxx"
      Height          =   195
      Left            =   960
      TabIndex        =   2
      Top             =   6600
      Width           =   300
   End
End
Attribute VB_Name = "frmAttrib"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim mFileSysObj As New FileSystemObject  ' General declaration
Dim fName As String
Dim File, FileAttrib

Private Sub Check1_GotFocus()
cmdExit.SetFocus
End Sub

Private Sub Check10_Click()
If Check10.Value = 1 Then
Check6.Value = 0
Check7.Value = 0
Check8.Value = 0
Check9.Value = 0
End If
End Sub

Private Sub Check2_GotFocus()
cmdExit.SetFocus
End Sub

Private Sub Check3_GotFocus()
cmdExit.SetFocus
End Sub

Private Sub Check4_GotFocus()
cmdExit.SetFocus
End Sub

Private Sub Check5_GotFocus()
cmdExit.SetFocus
End Sub

Private Sub Check6_Click()
If Check10.Value = 1 Then Check6.Value = 0
End Sub

Private Sub Check7_Click()
If Check10.Value = 1 Then Check7.Value = 0
End Sub

Private Sub Check8_Click()
If Check10.Value = 1 Then Check8.Value = 0
End Sub

Private Sub Check9_Click()
If Check10.Value = 1 Then Check9.Value = 0
End Sub

Private Sub cmdChange_Attrib_Click()
On Error GoTo errhandler
Dim X, Y, Z, V, W
File = lblName
If Check6.Value = 1 Then X = vbHidden
If Check7.Value = 1 Then Y = vbSystem
If Check8.Value = 1 Then Z = vbReadOnly
If Check9.Value = 1 Then V = vbArchive
If Check10.Value = 1 Then W = vbNormal
SetAttr File, X + Y + Z + V + W
cmdAttrib_Click
Exit Sub
errhandler:
End Sub

Private Sub cmdExit_Click()
End
End Sub

Private Sub cmdAttrib_Click()
Dim FileAttrib
Check1.Value = 0
Check2.Value = 0
Check3.Value = 0
Check4.Value = 0
Check5.Value = 0

FileAttrib = GetAttr(lblName)
lblAttrib = FileAttrib
If FileAttrib = 0 Then Check5.Value = 1
If FileAttrib = 1 Then Check3.Value = 1
If FileAttrib = 2 Then Check1.Value = 1
If FileAttrib = 4 Then Check2.Value = 1
If FileAttrib = 32 Then Check4.Value = 1
If FileAttrib = 3 Then
Check3.Value = 1
Check1.Value = 1
End If
If FileAttrib = 7 Then
Check1.Value = 1
Check2.Value = 1
Check3.Value = 1
End If
If FileAttrib = 5 Then
Check2.Value = 1
Check3.Value = 1
End If
If FileAttrib = 6 Then
Check1.Value = 1
Check2.Value = 1
End If
If FileAttrib = 39 Then
Check1.Value = 1
Check2.Value = 1
Check3.Value = 1
Check4.Value = 1
End If
If FileAttrib = 33 Then
Check3.Value = 1
Check4.Value = 1
End If
If FileAttrib = 34 Then
Check1.Value = 1
Check4.Value = 1
End If
If FileAttrib = 35 Then
Check1.Value = 1
Check3.Value = 1
Check4.Value = 1
End If
If FileAttrib = 36 Then
Check2.Value = 1
Check4.Value = 1
End If
If FileAttrib = 37 Then
Check2.Value = 1
Check3.Value = 1
Check4.Value = 1
End If
If FileAttrib = 38 Then
Check1.Value = 1
Check2.Value = 1
Check4.Value = 1
End If
If FileAttrib = 39 Then Check1.Value = 1 And Check2.Value = 1 And Check3.Value = 1 And Check4.Value = 1
Check6.Value = 0
Check7.Value = 0
Check8.Value = 0
Check9.Value = 0
Check10.Value = 0
End Sub

Private Sub cmdErrHandler_Click()
Dim theFile As File
On Error GoTo errhandler
   Set theFile = mFileSysObj.GetFile(File1.Path & "\" & _
                 File1.List(File1.ListIndex))

       lblSystemDate = "Created: [Unknown]" & _
                 vbNewLine & _
                 "Last Accessed: " & theFile.DateLastAccessed & _
                 vbNewLine & "Last Modified: " & _
                 theFile.DateLastModified & vbNewLine & _
                 "Size: " & theFile.Size & " bytes" & " = " & theFile.Size \ 1024 & " KB" & " = " & theFile.Size \ 1024 \ 1024 & " MB" & vbNewLine & _
                 "Drive: " & theFile.Drive & vbNewLine & _
                 "Path: " & theFile.Path & vbNewLine & _
                 "Parent Folder Name: " & _
                 mFileSysObj.GetParentFolderName( _
                 theFile.Path) & vbNewLine & _
                 "Short Name: " & theFile.ShortName
Exit Sub
errhandler:

End Sub



Private Sub Dir1_Change()
File1.Path = Dir1.Path
Dir1.Path = drvList.Drive
    File1.System = True
    File1.Hidden = True
    MousePointer = vbDefault

End Sub

Private Sub drvList_Change()
On Error GoTo errhandler
Dir1.Path = drvList.Drive

    MousePointer = vbDefault
    Exit Sub
errhandler:
MsgBox "Access denied!. ", vbCritical, Error
     drvList.Drive = Dir1.Path
End Sub

Private Sub File1_Click()
Dim theFile As File
On Error GoTo errhandler
    File1.System = True
    File1.Hidden = True
    File1.Path = Dir1.Path
    If Right(Dir1.Path, 1) = "\" Then
    fName = File1.Path + File1.FileName
    Else
    fName = File1.Path + "\" + File1.FileName
    End If
    lblName = fName
lblSys = FileName(lblName)
If lblSys = "SYS" Or lblSys = "sys" Then
Check7.Enabled = True
Else
Check7.Enabled = False
End If
   Set theFile = mFileSysObj.GetFile(File1.Path & "\" & _
                 File1.List(File1.ListIndex))
lblSystemDate = ""
       lblSystemDate = "Created: " & theFile.DateCreated & _
                 vbNewLine & _
                 "Last Accessed: " & theFile.DateLastAccessed & _
                 vbNewLine & "Last Modified: " & _
                 theFile.DateLastModified & vbNewLine & _
                 "Size: " & theFile.Size & " bytes" & " = " & theFile.Size \ 1024 & " KB" & " = " & theFile.Size \ 1024 \ 1024 & " MB" & vbNewLine & _
                 "Drive: " & theFile.Drive & vbNewLine & _
                 "Path: " & theFile.Path & vbNewLine & _
                 "Parent Folder Name: " & _
                 mFileSysObj.GetParentFolderName( _
                 theFile.Path) & vbNewLine & _
                 "Short Name: " & theFile.ShortName

cmdAttrib_Click
Exit Sub
errhandler:
cmdErrHandler_Click
cmdAttrib_Click
End Sub


Private Sub lbldate_Click(Index As Integer)

End Sub

Private Sub Form_Load()
Me.Left = Screen.Width / 2 - Me.Width / 2
Me.Top = Screen.Height / 2 - Me.Height / 2

Dir1.Path = App.Path
File1.ListIndex = 0
End Sub