'API`s used to retrieve Folders, Files and Information.
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
'The FileTimeToSystemTime function converts a 64-bit file time to system time format.
Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
'The GetDriveType function determines whether a disk drive is a removable, fixed, CD-ROM, RAM disk, or network drive.
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long 'Specifies the file attributes of the file found.
ftCreationTime As FILETIME 'Specifies a FILETIME structure containing the time the file was created.
ftLastAccessTime As FILETIME 'Specifies a FILETIME structure containing the time that the file was last accessed.
ftLastWriteTime As FILETIME 'Specifies a FILETIME structure containing the time that the file was last written to.
nFileSizeHigh As Long 'Specifies the high-order DWORD value of the file size, in bytes.
nFileSizeLow As Long 'Specifies the low-order DWORD value of the file size, in bytes.
dwReserved0 As Long 'If the dwFileAttributes member includes the FILE_ATTRIBUTE_REPARSE_POINT attribute, this member specifies the reparse tag. Otherwise, this value is undefined and should not be used.
dwReserved1 As Long 'Reserved for future use.
cFileName As String * 260 'A null-terminated string that is the name of the file.
cAlternateFileName As String * 260 'A null-terminated string that is an alternative name for the file.
End Type
Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Public msLoadType As String
Public msSelectFile As String
Public msSelectPath As String
Private msFormTitle_Save As String
Private msFormTitle_Select As String
Private Sub Form_Load()
Dim i As Integer
Dim bytDriveType As Byte
Dim sPath As String
Dim sTmp As String
Dim sDriveName As String
Dim nNode As Node
With GridFileList
.ColWidth(0) = 2500
.ColWidth(1) = 1200
End With
msSelectFile = ""
msSelectPath = ""
'Set Drive List
With Drive
For i = 0 To .ListCount - 1
sDriveName = Mid(.List(i), 1, InStr(.List(i), ":"))
bytDriveType = GetDriveType(sDriveName)
Select Case bytDriveType
Case 1 'Unknown Drive.
Set nNode = Explorer.Nodes.Add(, , "Parent" & i, UCase(sDriveName), "drvunknown")
Case 2 'Removable Drive.
Set nNode = Explorer.Nodes.Add(, , "Parent" & i, UCase(sDriveName), "drvremove")
Case 3 'Fixed Drive.
Set nNode = Explorer.Nodes.Add(, , "Parent" & i, UCase(sDriveName), "drvfixed")
Case 4 'Network Drive.
Set nNode = Explorer.Nodes.Add(, , "Parent" & i, UCase(sDriveName), "drvremote")
Case 5 'CD-Rom.
Set nNode = Explorer.Nodes.Add(, , "Parent" & i, UCase(sDriveName), "drvcd")
Case 6 'Ram Disk.
Set nNode = Explorer.Nodes.Add(, , "Parent" & i, UCase(sDriveName), "drvram")
Case Else
Set nNode = Explorer.Nodes.Add(, , "Parent" & i, UCase(sDriveName), "drvunknown")
End Select
If bytDriveType = 3 Then
emuFolderList UCase(sDriveName) & "\", "Parent" & i
End If
Next
'Set File Type
With CboFileType
.Clear
Me.Caption = ""
Select Case msLoadType
Case "SAVE"
Me.Caption = msFormTitle_Save
.AddItem "*.*"
.AddItem "*.xls"
.AddItem "*.txt"
.ListIndex = 0
Case "PICSAVE"
Me.Caption = msFormTitle_Save
.AddItem "*.bmp"
.ListIndex = 0
Case "SELECT", "OPEN"
Me.Caption = msFormTitle_Select
.AddItem "*.*"
.ListIndex = 0
End Select
End With
End With
End Sub
Private Sub emuFolderList(asPath As String, avParentID As Variant)
Dim nNode As Node 'Node object for ExplorerTree.
Dim lReturn As Long 'Holds Search Handle of File.
Dim lNextFile As Long 'Return Search Handle of next Folder.
Dim sPath As String 'Path to search.
Dim sFolderName As String 'Name of Folder.
Dim i As Long 'Used to loop through Folders in frmMain.List1).
Dim WFD As WIN32_FIND_DATA 'Win32 Structure (VB Type).
'Return all Folders from selected Drive.
sPath = (asPath & "*.*") & Chr(0)
'Search for First Folder Handle.
lReturn = FindFirstFile(sPath, WFD)
'Loop through all Folders (One level).
Do
If (WFD.dwFileAttributes And vbDirectory) Then 'If a Folder is found add to List.
sFolderName = emuStripNullChar(WFD.cFileName) 'Strip vbNullChar from Folder Name.
If sFolderName <> "." And sFolderName <> ".." Then
List.AddItem sFolderName
End If
End If
lNextFile = FindNextFile(lReturn, WFD) 'Search for Handle of next Folder.
Loop Until lNextFile = False
'Close Handle of Folder.
lNextFile = FindClose(lReturn)
'Loop through List which has it`s sorted property set to True, then add
'Folder Path to ExplorerTree
For i = 0 To List.ListCount - 1
'If the Folder has an Attribute, set ForeColor to Grey
Set nNode = Explorer.Nodes.Add(avParentID, tvwChild, , List.List(i), "cldfolder", "opnfolder")
Next
'Clear frmMain.List.
List.Clear
End Sub
'Get File List
Private Sub emuFileList(asFolderPath As String)
Dim lReturn As Long 'Search Handle of specified Path.
Dim lNextFile As Long 'Search Handle of specified File.
Dim sPath As String 'Path to search.
Dim sFileName As String 'Filename (WFD.cFileName).
Dim lFileSize As Long
Dim sWriteDay As String
Dim sTmp As String
Dim sType As String
Dim WFD As WIN32_FIND_DATA 'Set Variable WFD as Structure(VBType) WIN32_FIND_DATA.
Dim SYSTIME As SYSTEMTIME 'Set variable SYSTIME as structure(VBType) SYSTEMTIME.
With GridFileList
.Rows = 1
If lReturn <= 0 Then Exit Sub 'If their are no Files to list, Exit sub.
Do
'If we find a Directory do nothing, else List Files taking off the Chr(0)
'Loop until lNextFile& = val(0), no more Files to List
If Not (WFD.dwFileAttributes And vbDirectory) = vbDirectory Then
sFileName = emuStripNullChar(WFD.cFileName)
On Error Resume Next
.Cell(flexcpPicture, .Rows - 1, 0) = ImageListFileType.ListImages("sys").Picture
sType = LCase(Right(sFileName, 3))
.Cell(flexcpPicture, .Rows - 1, 0) = ImageListFileType.ListImages(sType).Picture
End If
End If
lNextFile = FindNextFile(lReturn, WFD)
Loop Until lNextFile <= Val(0)
End With
'Close Search Handle.
lNextFile = FindClose(lReturn)
End Sub
Private Sub Explorer_Expand(ByVal Node As MSComctlLib.Node)
Dim i As Long
DoEvents
For i = Node.CHILD.FirstSibling.Index To Node.CHILD.LastSibling.Index
emuMakeTree Explorer.Nodes(i) ' Directory 정보의 변경없이 Tree의 정보만 갱신
Next
End Sub
'Explorer_NodeClick.
Private Sub Explorer_NodeClick(ByVal Node As MSComctlLib.Node)
Dim sNodePath As String
Dim bytDriveType As Byte
If Node.Parent Is Nothing Then
bytDriveType = GetDriveType(sNodePath)
Select Case bytDriveType
Case 1 'Unknown Drive.
Set TransparentImage.Picture = ImageList1.ListImages("drvunknown").Picture
Case 2 'Removable Drive.
Set TransparentImage.Picture = ImageList1.ListImages("drvremove").Picture
Case 3 'Fixed Drive.
Set TransparentImage.Picture = ImageList1.ListImages("drvfixed").Picture
Case 4 'Network Drive.
Set TransparentImage.Picture = ImageList1.ListImages("drvremote").Picture
Case 5 'CD-Rom.
Set TransparentImage.Picture = ImageList1.ListImages("drvcd").Picture
Case 6 'Ram Disk.
Set TransparentImage.Picture = ImageList1.ListImages("drvram").Picture
End Select
Else
Set TransparentImage.Picture = ImageList1.ListImages(1).Picture
End If
GridFileList.Rows = 1
TxtFile.Text = ""
emuMakeTree Node
End Sub
Private Sub emuMakeTree(Node As MSComctlLib.Node)
Dim sNodePath As String
Me.MousePointer = 11
sNodePath = Node.FullPath
If (InStr(1, sNodePath, ":")) <> 0 Then sNodePath = sNodePath & "\"
'If Not Children list Folders.
If Not Node.Children > 0 Then
emuFolderList sNodePath, Node.Index
End If
'List Files if Node is selected.
If Node.Selected = True And Node.Index > 1 Then
emuFileList (sNodePath)
End If
Me.MousePointer = 0
End Sub
Private Function emuStripNullChar(sInput As String) As String
Dim ix As Integer
ix = InStr(1, sInput, Chr(0))
If ix > 0 Then emuStripNullChar = Left(sInput, ix - 1)
End Function
Private Sub GridFileList_Click()
With GridFileList
If .Rows <= 1 Or .Row = 0 Then Exit Sub
TxtFile.Text = .TextMatrix(.Row, 0)
End With
End Sub
Private Sub GridFileList_DblClick()
If msLoadType <> "SAVE" And TxtFile.Text <> "" Then
CmdAcc_Click
End If
End Sub
Private Sub CmdAcc_Click()
Dim i As Integer
Dim sFileName As String
Dim sFilePath As String
If sFileName = "" Or sFilePath = "" Then Exit Sub
sFilePath = Explorer.SelectedItem.FullPath
Select Case msLoadType
Case "SAVE" ' Save
If CboFileType.Text = "*.*" Then
Select Case LCase(Right(sFileName, 4))
Case ".txt", ".xls"
Case Else
sFileName = sFileName & ".xls"
End Select
Else
sFileName = eduTextSplit(sFileName, ".")
sFileName = sFileName & Right(CboFileType.Text, 4)
End If
With GridFileList
For i = 1 To .Rows - 1
If LCase(sFileName) = LCase(.TextMatrix(i, 0)) Then
If eduConfirm(Me.Caption, eduGetHelpMesg(374) & vbCrLf & eduGetHelpMesg(375), sFileName) = 0 Then Exit Sub
Exit For
End If
Next
End With
Case "PICSAVE" ' Screen Capture
With GridFileList
For i = 1 To .Rows - 1
If LCase(sFileName) = LCase(.TextMatrix(i, 0)) Then
If eduConfirm(Me.Caption, eduGetHelpMesg(374) & vbCrLf & eduGetHelpMesg(375), sFileName) = 0 Then Exit Sub
Exit For
End If
Next
End With
Case Else ' Open
End Select
msSelectPath = sFilePath & "\"
msSelectFile = sFileName
eduWinKill Me
End Sub
Private Sub CmdCancel_Click()
eduWinKill Me
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case vbKeyEscape
eduWinKill Me
Case vbKeyReturn
CmdAcc_Click
End Select
End Sub
Private Sub TxtFile_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
CmdAcc_Click
End If
End Sub
위의 소스튼 제가 지금 만들고 있는 화면의 일부분 입니다.
파일의 size와 일자를 읽어 들이는 부분은 위의 스크립트를 참조하시면 됩니다.
첫댓글 위의 스크립트 중에서 맨 상위에 있는 privet 데이터 형 정의 부분과 emuFileList Event를 참조 하세요.