VERSION 5.00
Begin VB.Form frmDir
BackColor = &H00000000&
BorderStyle = 0 'None
Caption = "AI Dir"
ClientHeight = 9000
ClientLeft = 1170
ClientTop = 345
ClientWidth = 12000
ForeColor = &H00FFFFFF&
LinkTopic = "Form1"
Picture = "frmDir.frx":0000
ScaleHeight = 9000
ScaleWidth = 12000
ShowInTaskbar = 0 'False
StartUpPosition = 2 'CenterScreen
WindowState = 2 'Maximized
Begin VB.TextBox txtFileName
BackColor = &H00000000&
BeginProperty Font
Name = "Xenotron"
Size = 14.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFF80&
Height = 360
Left = 480
TabIndex = 15
Top = 105
Width = 10800
End
Begin VB.CommandButton Command1
Caption = "Command1"
Height = 195
Left = 120
TabIndex = 6
Top = 1170
Visible = 0 'False
Width = 75
End
Begin VB.TextBox dirCriteria
BackColor = &H00000000&
BeginProperty Font
Name = "Xenotron"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFF80&
Height = 375
Left = 9555
MaxLength = 11
TabIndex = 4
Text = "*.*"
Top = 4860
Width = 1605
End
Begin VB.FileListBox dirFile
Appearance = 0 'Flat
BackColor = &H00000000&
BeginProperty Font
Name = "OCR A Extended"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFF80&
Height = 2565
Left = 570
TabIndex = 2
Top = 5760
Width = 10695
End
Begin VB.DirListBox dirDir
Appearance = 0 'Flat
BackColor = &H00000000&
BeginProperty Font
Name = "OCR A Extended"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFF80&
Height = 2340
Left = 555
TabIndex = 1
Top = 2355
Width = 10665
End
Begin VB.DriveListBox dirDrive
BackColor = &H00000000&
BeginProperty Font
Name = "Xenotron"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFF80&
Height = 255
Left = 600
TabIndex = 0
Top = 885
Width = 2745
End
Begin VB.Label Label2
AutoSize = -1 'True
BackColor = &H00000000&
Caption = " Bytes on Disk"
BeginProperty Font
Name = "OCR A Extended"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0080FF80&
Height = 180
Index = 7
Left = 3930
TabIndex = 14
Top = 1215
Width = 1470
End
Begin VB.Label Label2
AutoSize = -1 'True
BackColor = &H00000000&
Caption = "Bytes Free"
BeginProperty Font
Name = "OCR A Extended"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0080FF80&
Height = 180
Index = 9
Left = 4350
TabIndex = 13
Top = 1470
Width = 1050
End
Begin VB.Label lblBOD
Alignment = 2 'Center
BackColor = &H00000000&
BeginProperty Font
Name = "Xenotron"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFF80&
Height = 255
Left = 5400
TabIndex = 12
Top = 1200
Width = 1875
End
Begin VB.Label lblBF
Alignment = 2 'Center
BackColor = &H00000000&
BeginProperty Font
Name = "Xenotron"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFF80&
Height = 255
Left = 5400
TabIndex = 11
Top = 1470
Width = 1875
End
Begin VB.Label Label2
AutoSize = -1 'True
BackColor = &H00000000&
Caption = "File System"
BeginProperty Font
Name = "OCR A Extended"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0080FF80&
Height = 180
Index = 4
Left = 4230
TabIndex = 10
Top = 945
Width = 1155
End
Begin VB.Label lblFN
Alignment = 2 'Center
BackColor = &H00000000&
BeginProperty Font
Name = "Xenotron"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFF80&
Height = 255
Left = 5400
TabIndex = 9
Top = 930
Width = 1860
End
Begin VB.Label Label2
AutoSize = -1 'True
BackColor = &H00000000&
Caption = "Volume Name"
BeginProperty Font
Name = "OCR A Extended"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0080FF80&
Height = 180
Index = 0
Left = 4215
TabIndex = 8
Top = 675
Width = 1155
End
Begin VB.Label lblVolName
Alignment = 2 'Center
BackColor = &H00000000&
BeginProperty Font
Name = "Xenotron"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFF80&
Height = 255
Left = 5400
TabIndex = 7
Top = 660
Width = 1860
End
Begin VB.Label lblFileName
BackStyle = 0 'Transparent
BeginProperty Font
Name = "Tahoma"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0000FF00&
Height = 375
Left = 120
TabIndex = 5
Top = 8520
Width = 6375
End
Begin VB.Label lblReturn
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
BeginProperty Font
Name = "OCR A Extended"
Size = 20.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0000FF00&
Height = 435
Left = 3885
TabIndex = 3
Top = 5085
Width = 2985
End
End
Attribute VB_Name = "frmDir"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" _
(ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters As Long) As Long
Private Declare Function GetDiskFreeSpaceEx Lib "kernel32" Alias "GetDiskFreeSpaceExA" _
(ByVal lpRootPathName As String, lpBytesAvailable As Currency, lpTotalBytes As Currency, lpFreeBytes As Currency) As Long
Private Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" _
(ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
'Private Const FILE_CASE_SENSITIVE_SEARCH = &H1
'Private Const FILE_CASE_PRESERVED_NAMES = &H2
'Private Const FILE_UNICODE_ON_DISK = &H4
'Private Const FILE_PERSISTENT_ACLS = &H8
'Private Const FILE_FILE_COMPRESSION = &H10
'Private Const FILE_VOLUME_IS_COMPRESSED = &H8000
'Private Const FS_CASE_IS_PRESERVED = FILE_CASE_PRESERVED_NAMES
'Private Const FS_CASE_SENSITIVE = FILE_CASE_SENSITIVE_SEARCH
'Private Const FS_UNICODE_STORED_ON_DISK = FILE_UNICODE_ON_DISK
'Private Const FS_PERSISTENT_ACLS = FILE_PERSISTENT_ACLS
'Private Const FS_VOL_IS_COMPRESSED = FILE_VOLUME_IS_COMPRESSED
'Private Const FS_FILE_COMPRESSION = FILE_FILE_COMPRESSION
Private Sub Command1_Click()
Dim lRet As Long, aRoot$, aVN$, lSerial As Long, lMaxFileName As Long
Dim lFlags As Long, aFN$, A$
aRoot$ = Left$(dirDrive.Drive, 2) & "\"
aVN$ = Space$(255)
aFN$ = Space$(255)
lRet = GetVolumeInformation(aRoot$, aVN$, Len(aVN$), lSerial, lMaxFileName, lFlags, aFN$, Len(aFN$))
aVN$ = aVN$ & Chr$(0): lblVolName.Caption = Left$(aVN$, InStr(aVN$, Chr$(0)) - 1): If lblVolName.Caption = "" Then lblVolName.Caption = "{volume has no label}"
aFN$ = aFN$ & Chr$(0): lblFN.Caption = Left$(aFN$, InStr(aFN$, Chr$(0)) - 1)
Dim lSecPerClus As Long, lBytePerSec As Long, lNumFreeClus As Long, lTotClus As Long
lRet = GetDiskFreeSpace(aRoot$, lSecPerClus, lBytePerSec, lNumFreeClus, lTotClus)
Dim dDC As Double, dFS As Double
On Local Error Resume Next
err.clear
Dim cBA@, cBOD@, cBF@, m#
lRet = GetDiskFreeSpaceEx(aRoot$, cBA@, cBOD@, cBF@)
If err.Number Then
lblBOD.Caption = "????"
lblBF.Caption = "????"
Else
m# = 10000@ / (1024# * 1024#)
lblBOD.Caption = Int(cBOD@ * m#) & " meg"
lblBF.Caption = Int(cBF@ * m#) & " meg"
End If
End Sub
Private Sub dirCriteria_Change()
On Error GoTo err
dirFile.Pattern = dirCriteria.Text
GoTo okay
err:
MsgBox "Error! number:" & err.Number & " possibly due to " & err.Description, vbOKOnly, "ERROR"
okay:
End Sub
Private Sub dirDir_Change()
On Error GoTo err
dirFile.Path = dirDir.Path
txtFileName.Text = dirDir.Path
GoTo okay
err:
MsgBox "Error! possibly due to " & err.Description, vbOKOnly, "Error!"
okay:
End Sub
Private Sub dirDrive_Change()
erg& = GetVolumeInformation(dirDrive.Drive, VolName$, 127&, _
VolNumber&, MCM&, FSF&, FSys$, 127&)
If erg& = 0 Then
MsgBox "There is no media in the drive", vbOKOnly, "Error!"
Exit Sub
End If
On Error GoTo err
Command1_Click
dirDir.Path = dirDrive.Drive
GoTo okay
err:
MsgBox "Error! possibly due to " & err.Description, vbOKOnly, "Error!"
dirDrive = "c:\"
okay:
End Sub
Private Sub dirFile_Click()
'If dirFile.FileName = "*.txt" Then
' frmTextEdit.Show
'End If
If Right(dirDir.Path, 1) = "\" Then
txtFileName.Text = dirDir.Path & dirFile.filename
Else
txtFileName.Text = dirDir.Path & "\" & dirFile.filename
End If
End Sub
Private Sub dirFile_DblClick()
If Dir(txtFileName.Text) = "" Then
Call MsgBox("The file in the text box does not exist.", vbExclamation, "File Open Error")
Exit Sub
End If
Call ShellExecute(hwnd, "Open", txtFileName.Text, "", App.Path, 1)
End Sub
Private Sub dirFile_PathChange()
On Error GoTo err
dirFile.Pattern = dirCriteria.Text
GoTo okay
err:
MsgBox "Error! possibly due to " & err.Description, vbOKOnly, "Error!"
dirFile.Pattern = "*.*"
okay:
End Sub
Private Sub Form_Load()
Command1_Click
End Sub
Private Sub lblReturn_Click()
Unload Me
End Sub
