打印本文 打印本文 关闭窗口 关闭窗口
用VB6.0自制压缩与解压缩程序(三)
作者:武汉SEO闵涛  文章来源:敏韬网  点击数3585  更新时间:2009/4/23 15:43:22  文章录入:mintao  责任编辑:mintao
End Function

 

'''' --------------------------------------

'''' 建立文件夹(含多层结构)

''''

'''' --------------------------------------

''''

Public Sub CreateFloder(floder As String)

    Dim i As Integer

    Dim Path As String

    Dim FloderStr() As String

   

    On Error Resume Next

    FloderStr = Split(floder, "\")

    Path = FloderStr(0)

    For i = 1 To UBound(FloderStr) - 1

        Path = Path & "\" & FloderStr(i)

        If Not DirExists(Path) Then

           MkDir Path

        End If

    Next

End Sub

 

'''' --------------------------------------

'''' 获得长文件名的短文件名

''''

'''' --------------------------------------

''''

Function GetShortFileName(FileName As String) As String

    Dim str As String

    str = String(LenB(FileName), Chr(0))

   

    If GetShortPathName(FileName, str, LenB(FileName)) <> 0 Then

        str = Left(str, InStr(str, vbNullChar) - 1)

        If str = "" Then

            GetShortFileName = FileName

        Else

            GetShortFileName = str

        End If

    Else

        GetShortFileName = FileName

    End If

End Function

 

'''' --------------------------------------

'''' 获得文件名

''''

'''' --------------------------------------

''''

Public Function GetFileName(fileNamePath As String) As String

    Dim AuxVar() As String

   

    AuxVar() = Split(fileNamePath, "\", , vbTextCompare)

    GetFileName = AuxVar(UBound(AuxVar))

End Function

 

'''' --------------------------------------

'''' 获得文件的扩展名

''''

'''' --------------------------------------

''''

Public Function GetExt(FileName As String) As String

    Dim AuxVar() As String

   

    On Error Resume Next

    AuxVar() = Split(FileName, "\", , vbTextCompare)

    AuxVar() = Split(AuxVar(UBound(AuxVar)), ".", , vbTextCompare)

    GetExt = AuxVar(UBound(AuxVar))

End Function

 

'''' --------------------------------------

'''' 测试文件是否存在(不能测试隐含文件和系统文件)

''''

'''' --------------------------------------

''''

Public Function FileExists(FileName As String) As Boolean

  On Error Resume Next

  FileExists = (Dir$(FileName) <> "")

End Function

 

'''' --------------------------------------

'''' 查找文件

''''

'''' --------------------------------------

''''

Function GetFiles(filespec As String, Optional Attributes As VbFileAttribute) As String()

    Dim result() As String

    Dim FileName As String, count As Long, path2 As String

    Const ALLOC_CHUNK = 50

   

    ReDim result(0 To ALLOC_CHUNK) As String

    FileName = Dir$(filespec, Attributes)

    Do While Len(FileName)

        count = count + 1

        If count > UBound(result) Then

            ReDim Preserve result(0 To count + ALLOC_CHUNK) As String

        End If

        result(count) = FileName

上一页  [1] [2] [3] [4] [5]  下一页

打印本文 打印本文 关闭窗口 关闭窗口