'Lunascape Co., LTD.  All rights reserved.
'**Start Encode**

Option Explicit

'-------------------------------------------------------------------------------
' Function get_template_html_standard_black
'-------------------------------------------------------------------------------
Function get_template_html_standard_black()
    Dim s
    s = _
"<html>" + VbCrLf + _
"<head>" + VbCrLf + _
"<meta http-equiv='Content-Type' content='text/html; charset=x-sjis'>" + VbCrLf + _
"<title>Links</title>" + VbCrLf + _
"<style>" + VbCrLf + _
"<!--" + VbCrLf + _
"td {font-size: 10.5pt}" + VbCrLf + _
"A:Hover {color: #eeeeee}" + VbCrLf + _
"A {text-decoration:none}" + VbCrLf + _
"-->" + VbCrLf + _
"</style>" + VbCrLf + _
"</head>" + VbCrLf + _
"<body bgcolor='#000000' text='#E0E0E0' link='#BBBBBB' vlink='#AAAAAA' alink='#AAAAAA'>" + VbCrLf + _
"<h1>收藏夹</h1>" + VbCrLf + _
"%CONTENT%" + VbCrLf + _
"</body>"

    get_template_html_standard_black = s
End Function

'-------------------------------------------------------------------------------
' Function get_folder_template_html_standard_black
'-------------------------------------------------------------------------------
Function get_folder_template_html_standard_black()
    Dim s
    s = _
"<p>" + VbCrLf + _
"<dl>" + VbCrLf + _
"<p>" + VbCrLf + _
"<dt><font size = 4><b>%TITLE%</b></font>" + VbCrLf + _
"<font size = 2></font><p>" + VbCrLf + _
"<dl><p>" + VbCrLf + _
"%ITEMS%" + VbCrLf + _
"</dl>" + VbCrLf + _
"</dl>"
    get_folder_template_html_standard_black = s
End Function

'-------------------------------------------------------------------------------
' Function get_item_template_html_standard_black
'-------------------------------------------------------------------------------
Function get_item_template_html_standard_black()
    Dim s
    s = _
"<dt><a href ='%URL%'>%TITLE%</a><font color = '#AAAAAA' size = 2>　　</font><p>" + VbCrLf
    get_item_template_html_standard_black = s
End Function

'-------------------------------------------------------------------------------
' Function get_template_html
'-------------------------------------------------------------------------------
Function get_template_html()
    get_template_html = get_template_html_standard_black()
End Function

'-------------------------------------------------------------------------------
' Function get_folder_template_html
'-------------------------------------------------------------------------------
Function get_folder_template_html()
    get_folder_template_html = get_folder_template_html_standard_black()
End Function

'-------------------------------------------------------------------------------
' Function get_item_template_html
'-------------------------------------------------------------------------------
Function get_item_template_html()
    get_item_template_html = get_item_template_html_standard_black()
End Function

'-------------------------------------------------------------------------------
' Function convert_favorite_folder
'-------------------------------------------------------------------------------
Function convert_favorite_folder(lunascape, idFolderItem)
    Dim strHtml
    'フォルダテンプレートを読み込む
    strHtml = strHtml + get_folder_template_html()
    strHtml = Replace(strHtml, "%TITLE%", lunascape.ItemTitle(idFolderItem))

    Dim idFirstChild
    idFirstChild = lunascape.GetChildItemID(idFolderItem)

    '子アイテムをHTML化
    Dim strItems
    strItems = ""

    Dim idNextItem
    idNextItem = idFirstChild
    Do While idNextItem <> ""
        Dim itemType
        itemType = lunascape.ItemType(idNextItem)

        If itemType = "FAVORITE_FOLDER" Then
            strItems = strItems + convert_favorite_folder(lunascape, idNextItem) + VbCrLf
        ElseIf itemType = "FAVORITE_LINK" Then
            strItems = strItems + convert_favorite_item(lunascape, idNextItem) + VbCrLf
        End If

        idNextItem = lunascape.GetNextSiblingItemID(idNextItem)
    Loop

    '子アイテムのHTMLを挿入
    strHtml = Replace(strHtml, "%ITEMS%", strItems)

    convert_favorite_folder = strHtml
End Function

'-------------------------------------------------------------------------------
' Function convert_favorite_item
'-------------------------------------------------------------------------------
Function convert_favorite_item(lunascape, idItem)
    'アイテムのurl
    Dim strHref
    strHref = lunascape.ItemURL(idItem)
    'アイテムのタイトル
    Dim strTitle
    strTitle = lunascape.ItemTitle(idItem)

    Dim strHtml

    'アイテムテンプレートを読み込む
    strHtml = strHtml + get_item_template_html()
    strHtml = Replace(strHtml, "%URL%", strHref)
    strHtml = Replace(strHtml, "%TITLE%", strTitle)

    convert_favorite_item = strHtml
End Function

'-------------------------------------------------------------------------------
' Function convert_favorites
'-------------------------------------------------------------------------------
Function convert_favorites(lunascape)
    Dim strHtml
    strHtml = ""

    'ルートアイテムを取得
    Dim idRoot
    idRoot = lunascape.GetRootItemID()

    Dim idFirstChild
    idFirstChild = lunascape.GetChildItemID(idRoot)

    'ルート以下の出力
    Dim idNextItem
    idNextItem = idFirstChild
    Do While idNextItem <> ""
        Dim itemType
        itemType = lunascape.ItemType(idNextItem)

        If itemType = "FAVORITE_FOLDER" Then
            strHtml = strHtml + convert_favorite_folder(lunascape, idNextItem) + VbCrLf
        ElseIf itemType = "FAVORITE_LINK" Then
            strHtml = strHtml  + convert_favorite_item(lunascape, idNextItem) + VbCrLf
        End If

        idNextItem = lunascape.GetNextSiblingItemID(idNextItem)
    Loop

    convert_favorites = strHtml
End Function

'-------------------------------------------------------------------------------
' Function build_favorites_html
'-------------------------------------------------------------------------------
Function build_favorites_html(lunascape)
    'お気に入りをHTML化
    Dim strFavoritesHtml
    strFavoritesHtml = convert_favorites(lunascape)

    Dim strHtml
    strHtml = get_template_html()
    'HTML化したお気に入りを挿入
    strHtml = Replace(strHtml, "%CONTENT%", strFavoritesHtml)

    build_favorites_html = strHtml
End Function

'-------------------------------------------------------------------------------
' Function write_favorites
'-------------------------------------------------------------------------------
Sub write_favorites(lunascape)
    '保存するファイル名を取得
    Dim strSaveFileName
    strSaveFileName = lunascape.InputBox("请输入要保存的文件名", "收藏夹.html")

    If strSaveFileName <> "" Then
        Dim savedFolder
        savedFolder = lunascape.UserPath + "applicationdata\Temp\"
        '出力するHTMLファイルを作成
        Dim htmlFilePath
        htmlFilePath = savedFolder + strSaveFileName

        Dim strHtml
        strHtml = build_favorites_html(lunascape)

        'HTMLファイルに出力
        Dim fso
        Set fso = WScript.CreateObject("Scripting.FileSystemObject")

        Dim fHtml
        Set fHtml = fso.OpenTextFile(htmlFilePath, 2, True, 0)

        fHtml.Write(strHtml)
        lunascape.MessageBox("已成功导出收藏夹。")

        '保存したフォルダを開く
        Dim objShell
        Set objShell = CreateObject("Shell.Application")
        objShell.Open(savedFolder)
    End If
End Sub

'-------------------------------------------------------------------------------
' Function main
'-------------------------------------------------------------------------------
Sub main()
    Dim lunascape
    Set lunascape = CreateObject("Lunascape2.LunascapeAPI")

    write_favorites(lunascape)
End Sub

'-------------------------------------------------------------------------------
' Function OnClick
'-------------------------------------------------------------------------------
Function OnClick()
    OnClick = True
    write_favorites(lunascape)
End Function

main()
