favorites.bas

OpenPlayer代码

Attribute VB_Name = "Favorites"
'====================================================
'这是关于收藏夹操作的模块
'====================================================
Option Explicit

'==============================================
'初始化收藏夹,将Favorites.lst里面的信息添加到收藏夹列表框
'放在Form_Load 里面
'==============================================
Function initFavorites()
    Dim strLstFileName As String                            '收藏夹文件名
    Dim oFSO As New FileSystemObject
    Dim oTs As TextStream
    Dim strFavoritesTitle As String
    Dim strFavoritesItem As String
    Dim aLineArray() As String

    strLstFileName = App.Path & IIf(Len(App.Path) < 4, "Favorites.lst", "\Favorites.lst")
    Set oTs = oFSO.OpenTextFile(strLstFileName, ForReading, True)
    
        '循环文件里所有的行,一行一条
        While Not oTs.AtEndOfLine
            aLineArray = Split(oTs.ReadLine, "=")                       '以"="号为分隔符
            aLineArray(1) = Trim(aLineArray(1))
            If oFSO.FileExists(aLineArray(1)) Or UCase(Left(aLineArray(1), 7)) = UCase("http://") Then
                 ControlForm.List(2).AddItem (aLineArray(0))            '添加到列表框
                 ControlForm.List(3).AddItem (aLineArray(1))            '添加到列表框
            End If
        Wend
        
    Set oTs = Nothing
    Set oFSO = Nothing

End Function

'==============================================
'添加到收藏夹里面
'参数:
'MovieName      :动画的名称
'MovieFileName  :动画的路径
'==============================================
Function AddToFavorites(MovieName As String, MovieFileName As String)
    Dim strFileName As String
    Dim oFSO As New FileSystemObject
    Dim oTs As TextStream
    Dim strFavoritesTitle As String
    Dim strFavoritesItem As String
    Dim aLineArray() As String
    
    MovieName = getNote(MovieFileName).strMovieName
    MovieName = IIf(InStr(MovieName, "《") = 1, Mid(MovieName, 2, Len(MovieName) - 2), MovieName)       '去除书名号"《》"
    
    strFileName = App.Path & IIf(Len(App.Path) < 4, "Favorites.lst", "\Favorites.lst")
    
    Set oTs = oFSO.OpenTextFile(strFileName, ForAppending, True)
        If oFSO.FileExists(MovieFileName) Then
            ControlForm.List(2).AddItem (MovieName)
            ControlForm.List(3).AddItem (MovieFileName)
            oTs.WriteLine MovieName & "=" & MovieFileName                                               '一行一行写入
        End If
    Set oTs = Nothing
    Set oFSO = Nothing
End Function

'==============================================
'保存列表框中的所有的项
'==============================================
Sub FavoritesSave()
    Dim strFileName As String
    Dim oFSO As New FileSystemObject
    Dim oTs As TextStream
    Dim i As Long

    On Error GoTo ERROR:
    strFileName = App.Path & IIf(Len(App.Path) < 4, "Favorites.lst", "\Favorites.lst")
    
    Set oTs = oFSO.OpenTextFile(strFileName, ForWriting, True)
     
    '把列表框中的内容写入
    For i = 0 To ControlForm.List(2).ListCount - 1
        oTs.WriteLine ControlForm.List(2).List(i) & "=" & ControlForm.List(3).List(i)
    Next
        
    Set oTs = Nothing
    Set oFSO = Nothing
    Exit Sub
ERROR:
    '出错,重新列表 收藏夹件的内容
    ControlForm.List(2).Clear
    ControlForm.List(3).Clear
    Call initFavorites
    Set oTs = Nothing
    Set oFSO = Nothing
End Sub