BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
MouseIcon = "FolderViewListViewDemo.frx":0000
BackColor = 12632256
End
Begin MSComctlLib.ListView ListView1
Height = 7605
Left = 3990
TabIndex = 2
Top = -15
Width = 7740
_ExtentX = 13653
_ExtentY = 13414
View = 3
MultiSelect = -1 'True
LabelWrap = -1 'True
HideSelection = -1 'True
FullRowSelect = -1 'True
PictureAlignment= 5
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 0
Picture = "FolderViewListViewDemo.frx":001C
End
End
Begin VB.PictureBox Splitter
AutoRedraw = -1 'True
BorderStyle = 0 'None
Height = 7395
Left = 3360
ScaleHeight = 7395
ScaleWidth = 585
TabIndex = 0
Top = 0
Width = 585
End
Attribute VB_Name = "frmFvLvDemo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'------------------------------------
Private ArqExt As String
Private WinDir As String
Private SysDir As String
Private TempDir As String
Private SourcePath As String
Private sFolder As String
'Private sFile As String
Private sName As String
Private sExtension As String
Private sSize As String
Private sType As String
Private sModified As String
Private sTime As String
Private sCreated As String
Private sAccessed As String
Private sAttribute As String
Private sMsDos As String
Private sNone As String
Private m_MyDocs As String
'------------------------------
Private Start As Long
Private FvFilter As Variant
Private IsFAT As Boolean
Private InCab As Boolean
Private InZip As Boolean
Private Nodx As Node
Private TypeNew() As FTs
'------------------------------
Private WithEvents Archive As cArchive
Attribute Archive.VB_VarHelpID = -1
'------------------------------
Const MyComputer$ = "MyComputer"
Const Desktop$ = "Desktop"
Private Function NiceCase(ByVal Nam As String) As String
Dim UNam As String, LNam As String
On Error GoTo ProcedureError
UNam = Nam: LNam = Nam
CharUpper UNam: CharLower LNam
If Nam = UNam Or Nam = LNam Then
' If Nam = UCase$(Nam) Or Nam = LCase$(Nam) Then
NiceCase = StrConv(Nam, vbProperCase)
Else
NiceCase = Nam 'already mixed case so leave alone
End If
ProcedureExit:
Exit Function
ProcedureError:
If ErrMsgBox(Me.Name & ".NiceCase") = vbRetry Then Resume Next
End Function
Private Function BinarySearchTypeNew(sExt As String) As Integer
Dim iLow As Integer
Dim iHigh As Integer
Dim iMid As Integer
On Error Resume Next
BinarySearchTypeNew = -1
iLow = 1 '0 is reserved
iHigh = UBound(TypeNew) - LBound(TypeNew)
Do
iMid = (iLow + iHigh) \ 2
'always LCase so let's use faster binary compare
Select Case StrComp(sExt, TypeNew(iMid).Ext, vbBinaryCompare)
Case -1 '< Less than
iHigh = iMid - 1
Case 1 '> Greater than
iLow = iMid + 1
Case 0 '= Equal
BinarySearchTypeNew = iMid
Exit Do
End Select
Loop Until iHigh < iLow
End Function
Private Sub ShellSortTypeNewArray()
Dim iLowBound As Integer
Dim iHighBound As Integer
Dim iX As Integer
Dim iY As Integer
Dim Temp As FTs
On Error GoTo ProcedureError
' Get array bounds
iLowBound = LBound(TypeNew)
iHighBound = UBound(TypeNew)
' Get array middle
iY = (iHighBound - iLowBound + 1) \ 2
Do While iY > 0
' Sort lower portion
For iX = iLowBound To iHighBound - iY
If TypeNew(iX).Ext > TypeNew(iX + iY).Ext Then
Temp = TypeNew(iX)
TypeNew(iX) = TypeNew(iX + iY)
TypeNew(iX + iY) = Temp
End If
Next iX
' Sort upper portion
For iX = iHighBound - iY To iLowBound Step -1
If TypeNew(iX).Ext > TypeNew(iX + iY).Ext Then
Temp = TypeNew(iX)
TypeNew(iX) = TypeNew(iX + iY)
TypeNew(iX + iY) = Temp
End If
Next iX
' Divide array
iY = iY \ 2
Loop
ProcedureExit:
Exit Sub
ProcedureError:
If ErrMsgBox(Me.Name & ".ShellSortTypeNewArray") = vbRetry Then Resume Next
End Sub
Private Sub ace_FileFound(ByVal Count As Long, ByVal Filename As String, ByVal DateTime As Date, ByVal Size As Variant, ByVal CompSize As Variant, ByVal Method As Long, ByVal Attr As Variant, ByVal Path As String, ByVal flags As Long, ByVal Crc As Long, ByVal Comments As String)
With Master
.GridFormat = gface
.Index = Count
.Filename = Filename
.Size = Size
.Modified = DateTime
.Created = DateTime
.Accessed = DateTime
.Attr = Attr
.Path = Path
.CompSize = CompSize
.Method = Method
.flags = flags
.Encypted = (flags And 1) * -1 'Make it Boolean
.Crc = Crc
'.Sig = 0
.Comments = Comments
End With
LVAddCommon Master
End Sub
Private Sub cab_FileFound(ByVal Count As Long, ByVal Filename As String, ByVal MyDate As Date, ByVal Size As Variant, ByVal Attr As Variant, ByVal Path As String)
With Master
.GridFormat = gfCab
.Index = Count
.Filename = Filename
.Modified = MyDate
.Size = Size
.Attr = Attr
.Path = Path
End With
LVAddCommon Master
End Sub
Private Sub Archive_FileFound(ByVal Index As Long, ByVal Total As Long, ByVal Filename As String, ByVal ArchiveExt As String, ByVal Modified As Date, ByVal Size As Long, ByVal CompSize As Long, ByVal Method As Long, ByVal Attr As Long, ByVal Path As String, ByVal flags As Long, ByVal Crc As Long, ByVal Comments As String)
'<EhHeader>
On Error GoTo Archive_FileFound_Err
'</EhHeader>
Dim sMethod As String, sExt As String, FakePath As String
(.txt)