mfindfile.bas

这是网站里可以播放不同音乐的程序

'//该源码下载自www.aspx1.com(ａｓｐｘ１．ｃｏｍ)

Attribute VB_Name = "mFindFile"
'****************************************************************************
'人人为我，我为人人
'枕善居收藏整理
'发布日期：2007/03/15
'描    述：网页搜索音乐播放器  Ver 1.1.0
'网    站：http://www.Mndsoft.com/  (VB6源码博客)
'网    站：http://www.VbDnet.com/   (VB.NET源码博客,主要基于.NET2005)
'e-mail  ：[e-mail]
'e-mail  ：[e-mail]
'OICQ    ：88382850
'          如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************
Option Explicit
'文件处理模块

'========================================================
' 获取文件的文件名及后缀名，不包含路径
Function GetFileFullName$(ByVal strFileName$)
    Dim nPos&, nTmpStr$
    
    nTmpStr$ = strFileName$
    
    Do
        nPos& = InStr(1, nTmpStr$, "\")
        
        If nPos& = 0 Then Exit Do   '未找到 \ 符号，则取消搜索
        
        nTmpStr$ = Right(nTmpStr$, Len(nTmpStr) - nPos&)
    Loop
    
    GetFileFullName$ = nTmpStr$
End Function
'========================================================


'========================================================
' 获取文件的文件名,不包含路径及后缀名
Function GetFileName$(ByVal strFileName_WithOutDir$)
    Dim nPos&, nPosPrev&, nTmpStr$
    Dim strcut As String
    
    nTmpStr$ = strFileName_WithOutDir$
    
    On Error Resume Next
    
    nPos& = 0
    
    Do
        nPos& = InStr(nPos& + 1, nTmpStr$, ".")
        
        If nPos& = 0 Then Exit Do
        
        nPosPrev& = nPos&
    Loop
    
    If nPosPrev& = 0 Then
        GetFileName = strFileName_WithOutDir$
    Else
        If Left(strFileName_WithOutDir$, 4) = "http" Then
            strcut = "/"
        Else
            strcut = "\"
        End If

        GetFileName$ = Mid(strFileName_WithOutDir$, InStrRev(strFileName_WithOutDir$, strcut) + 1, nPosPrev& - 1)
    End If
End Function
'========================================================


'========================================================
' 获取文件的后缀名
Function GetFileSuffix$(ByVal strFileName_WithOutDir$)
    Dim nPos&, nPosPrev&, nTmpStr$
    
    nTmpStr$ = strFileName_WithOutDir$
    
    On Error Resume Next
    
    nPos& = 0
    
    Do
        nPos& = InStr(nPos& + 1, nTmpStr$, ".")
        
        If nPos& = 0 Then Exit Do
        
        nPosPrev& = nPos&
    Loop
    
    GetFileSuffix$ = UCase(Right(strFileName_WithOutDir, _
                        Len(strFileName_WithOutDir) - nPosPrev&))
End Function
'========================================================


'========================================================
' 获取文件的大小
Function GetFileLen$(ByVal strFileName$)
    Dim nLen As Double
    
    nLen = FileLen(strFileName$)
    
    If nLen < 1024 Then
        GetFileLen$ = CStr(nLen) & "字节"
    Else
        GetFileLen$ = Format((nLen / 1024), "Fixed") & "KB"
    End If
End Function
'========================================================


'========================================================
' 查找单一目录下的文件，将其查找到的文件的全路径及
' 名称添加到 ByRef colFiles 集合中。
Function FindFilesInSingleDir&(ByVal strDir$, _
                               ByVal strPattern$, _
                               ByRef colFiles As Collection)
    Dim cFind As New cFindFile
    Dim strFile$
    
    If Right(strDir, 1) <> "\" Then _
        strDir = strDir & "\"
        
    strFile = cFind.Find(strDir & strPattern)
    
    Do While Len(strFile)
        
        If (cFind.FileAttributes And vbDirectory) = 0 Then
            ' 将含有目录的文件名添加到集合中
            colFiles.Add strDir & strFile
        End If
        
        strFile = cFind.FindNext
    Loop
    
    FindFilesInSingleDir& = colFiles.Count
    
    Set cFind = Nothing
End Function
'========================================================


'========================================================
' 查找包含子目录下的文件，将其查找到的文件的全路径及
' 名称添加到 ByRef colFiles 集合中。
Function FindAllFiles&(ByVal strSearchPath$, _
                       strPattern As String, _
                       Optional colFiles As Collection, _
                       Optional colDirs As Collection, _
                       Optional blnDirsOnly As Boolean, _
                       Optional blnBoth As Boolean)
    Dim cFind As New cFindFile
    Dim strFile$
    Dim intDirsFound%
    
    If Right(strSearchPath, 1) <> "\" Then _
        strSearchPath = strSearchPath & "\"
    
    strFile = cFind.Find(strSearchPath & strPattern)
    
    Do While Len(strFile)
        If cFind.FileAttributes And vbDirectory Then
            If Left(strFile, 1) <> "." Then
                If blnDirsOnly Or blnBoth Then
                    addSingle strSearchPath & strFile
                End If
                
                intDirsFound = intDirsFound + 1
                
                intDirsFound = intDirsFound + FindAllFiles( _
                    strSearchPath & strFile & "\", strPattern, _
                    colFiles, colDirs, blnDirsOnly)
            End If
            
            strFile = cFind.FindNext()
        
        Else
            If Not blnDirsOnly Or blnBoth Then
                ' 将含有目录的文件名添加到播放列表
                addSingle strSearchPath & strFile
            End If
            
            strFile = cFind.FindNext()
        End If
        
        DoEvents
    Loop
    
    FindAllFiles = intDirsFound
    
    Set cFind = Nothing
End Function
'========================================================