openfile.bas

mp3播放器

Attribute VB_Name = "openfile"
Public Const HTCAPTION = 2
Public Const WM_NCLBUTTONDOWN = &HA1
Public Declare Function ReleaseCapture Lib "user32" () As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Public Const HWND_TOPMOST = -1
Public Const SWP_SHOWWINDOWS = &H40
 '*******************************************************************
Public Declare Function ShowScrollBar Lib "user32" (ByVal hwnd As Long, ByVal wBar As Long, ByVal bShow As Long) As Long
Public Const SB_VERT = 1
Public Const WM_VSCROLL = &H115
Public Const SB_LINEDOWN = 1
Public Const SB_LINEUP = 0
Public Const WM_MOVE = &H3
Public mp3name As String
Public listnum As Long
Public lTotalTime As Long
 
Public Declare Function ShellExecute Lib "Shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Public Const SW_SHOWNORMAL = 1

Type DlgFileInfo
    iCount As Long
    sPath As String
    sFile() As String
End Type
Function GetDlgSelectFileInfo(strFilename As String) As DlgFileInfo
    
    '思路： 用CommonDialog控件选择文件后，其Filename属性值如下：
    '       1、如果选择的是"C:\Test.txt"，  Filename="C:\Test.txt"，    CurDir()="C:\"
    '       2、如果选择的是"C:\1\Test.txt"，Filename="C:\1\Test.txt"，  CurDir()="C:\1"
    '       3、如果选择的是"C:\1.txt"和"C:\2.txt"，则：
    '                                   Filename="C:\1 1.txt 2.txt"，  CurDir()="C:\1"
    '       因此先将路径分离开，再利用多文件之间插入的Chr$(0)字符分解各个文件名即可。
    
    Dim sPath, tmpStr As String
    Dim sFile() As String
    Dim iCount As Integer
    Dim i As Integer
        
    If Len(Trim(strFilename)) > 7 Then
        sPath = CurDir()  '获得当前的路径，因为在CommonDialog中改变路径时会改变当前的Path
        tmpStr = Right$(strFilename, Len(strFilename) - Len(sPath)) '将文件名分离出来
        
        If Left$(tmpStr, 1) = Chr$(0) Then
            '选择了多个文件(表现为第一个字符为空格)
            For i = 1 To Len(tmpStr)
                If Mid$(tmpStr, i, 1) = Chr$(0) Then
                    iCount = iCount + 1
                    ReDim Preserve sFile(iCount)
                Else
                    sFile(iCount) = sFile(iCount) & Mid$(tmpStr, i, 1)
                End If
            Next i
        Else
            '只选择了一个文件(注意：根目录下的文件名除去路径后没有"\"）
            iCount = 1
            ReDim Preserve sFile(iCount)
            If Left$(tmpStr, 1) = "\" Then tmpStr = Right$(tmpStr, Len(tmpStr) - 1)
            sFile(iCount) = tmpStr
        End If
        
        GetDlgSelectFileInfo.iCount = iCount
        ReDim GetDlgSelectFileInfo.sFile(iCount)
        
        If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"
        GetDlgSelectFileInfo.sPath = sPath
        
        For i = 1 To iCount
            GetDlgSelectFileInfo.sFile(i) = sFile(i)
        Next i
    End If
End Function

Function File_NamePath(cFileFullPath As String, cFileName As String, cFilePath As String)   '分离文件名和路径
    
    'Dim j As Integer
    Dim nStart As Integer
    
    nStart = Len(Trim(cFileFullPath))
        
    For j = Len(Trim(cFileFullPath)) To 1 Step -1
        If InStr(j, Trim(cFileFullPath), "\") > 0 Then
            nStart = j
            Exit For
        End If
    Next j
    
    cFileName = Right(Trim(cFileFullPath), Len(Trim(cFileFullPath)) - nStart)
    cFilePath = Left(Trim(cFileFullPath), nStart - 1)
    
End Function