Lunascapeスクリプト「タイトルURLコピー（複数）.vbs」の出力形式をリンクリストにする

前回と同じ内容なので、ついでにこちらも変更を加えてしまう。

改変したところは以下の通り：

スポンサードリンク

'全タブのタイトルとURLをClipBoardにコピーする。
'Shift　キーを押しながら実行で「これより右」
'Ctrl　キーを押しながら実行で「これより左」に対応

Option Explicit

Dim luna,tabNumber,i
Dim kcheck,starttab,endtab,tabstep
Dim tutext,oclip,document,dcid,cltext,deftitle

Sub fin
luna.Result = 0
Set oclip = Nothing
Set document = Nothing
Set luna = Nothing
WScript.Quit
End Sub

Sub clget(tutext)
Set oclip = document.parentWindow.clipboardData
cltext = oclip.getData("text")
cltext = tutext
oclip.setData "text",cltext
End Sub

Set luna = CreateObject("Lunascape2.LunascapeAPI")

luna.Result = luna.ShiftDown
luna.Result = luna.CtrlDown

tabNumber = luna.GetCount - 1

Luna.Result = 0

If luna.ShiftDown = true Then luna.Result = 1
If luna.CtrlDown = true Then luna.Result = 2

kcheck = luna.Result

Select Case kcheck
Case 1
luna.MessageBox "このタブより右のタイトルとURLを全てCopyします"
Case 2
luna.MessageBox "このタブより左のタイトルとURLを全てCopyします"
End Select

Select Case kcheck
Case 0
starttab = 0
endtab = tabnumber
tabstep = 1
Case 1
starttab = luna.ActiveIndex
endtab = tabnumber
tabstep = 1
Case 2
starttab = luna.ActiveIndex
endtab = 0
tabstep = -1
End Select

'Add
tutext =tutext & "<ul>"

For i=starttab To endtab step tabstep

luna.ActiveIndex(i)
dcid = luna.GetDocumentID(i)

Set document = luna.GetDocumentObject(dcid)

If document Is Nothing Then
Call luna.MessageBox("Document オブジェクトを作成できません")
fin
End If

On Error Resume Next
deftitle = document.title
If Err.Number = 0 Then

If deftitle = "" Then deftitle = "notitle"
'tutext =tutext & deftitle & " : " & luna.URL &chr(13)
tutext =tutext & "<li><a href=""" & luna.URL & """ target=""_blank"" >" & deftitle & "</a></li>" &chr(13)
End If

Next

'Add
tutext =tutext & "</ul>"

clget(tutext)
fin