過去ログ

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　Ｐａｇｅ       9
━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
　　　通常モードに戻る　　┃　　ＩＮＤＥＸ　　┃　　≪前へ　　│　　次へ≫　　　
━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
　▼お気に入りの復元（Bug→IE）(vbs)  YAma(作成うますけ氏) 02/8/1(木) 9:48

　───────────────────────────────────────
　■題名 ： お気に入りの復元（Bug→IE）(vbs)
　■名前 ： YAma(作成うますけ氏)
　■日付 ： 02/8/1(木) 9:48
　-------------------------------------------------------------------------
   
' お気に入りの復元

' 説明 ：BugBrowserのお気に入りをWindowsのお気に入りに復元する

' 製作者：うますけ

' 製作日：2000/11/30



　　Call RecoverFavorite

　　MsgBox "終了しました"

　　WScript.Quit



Function RecoverFavorite()

Dim FSO

Dim txtStrm

Dim BugWeb

Dim objShell 'WScriptシェル

Dim strOpenFileName '読み込みファイル名

Dim strValue 'ファイル内容

Dim strURL 'URL

Dim BaseDir '書き込み基準ディレクトリ

Dim Msg



　　Const ForReading = 1 '読み込み専用



　　Set BugWeb = CreateObject("BugWeb.BugBrowserAPI")

　　Set objShell = CreateObject("WScript.Shell")

　　Set FSO = CreateObject("Scripting.FileSystemObject")



　　'BugBrowserのFavoritesファイル取得

　　strOpenFileName = BugWeb.ApplicationPath & "\" & "BugWeb_Cache.dat"

　　Set txtStrm = FSO.OpenTextFile(strOpenFileName, ForReading, False)



　　'Favoritesの上書き確認

　　Msg = MsgBox("お気に入りを上書きしますか？", 4, "お気に入り上書き")



　　If Msg = 6 Then 'vbYes

　　　　'お気に入りの上書き

　　　　'Favoriteフォルダを取得

　　　　BaseDir = objShell.SpecialFolders("Favorites") & "\"

　　ElseIf Msg = 7 Then 'vbNo

　　　　'ベースディレクトリ設定

　　　　BaseDir = BugWeb.ApplicationPath & "\Favorites\"

　　　　'Favariteフォルダを作成

　　　　MakeFol (BaseDir)

　　Else

　　　　WScript.Quit

　　End If



　　'処理ループ

　　Do Until txtStrm.AtEndOfStream



　　　　'1行読込

　　　　strValue = txtStrm.ReadLine



　　　　'条件判断

　　　　If Len(strValue) = 1 Then

　　　　　　Select Case strValue

　　　　　　Case 0 'ディレクトリ作成

　　　　　　　　strValue = txtStrm.ReadLine

　　　　　　　　BaseDir = BaseDir & strValue

　　　　　　　　MakeFol (BaseDir)

　　　　　　　　'作ったフォルダを基準ディレクトリにする

　　　　　　　　BaseDir = BaseDir & "\"



　　　　　　Case 1 'ディレクトリを1段上げる

　　　　　　　　BaseDir = FSO.GetParentFolderName(BaseDir)

　　　　　　　　BaseDir = BaseDir & "\"



　　　　　　Case 2 '書き込み

　　　　　　　　strValue = txtStrm.ReadLine 'ファイル名

　　　　　　　　strValue = BaseDir & strValue & ".url"

　　　　　　　　strURL = txtStrm.ReadLine 'URL

　　　　　　　　Call MakeURL(strValue, strURL)

　　　　　　End Select

　　　　End If

　　Loop



　　'終了処理

　　Set objShell = Nothing

　　Set txtStrm = Nothing

　　Set FSO = Nothing

End Function



'フォルダ作成

Function MakeFol(strPath)

Dim FSO

Dim Fol



　　If strPath = "" Then Exit Function



　　Set FSO = CreateObject("Scripting.FileSystemObject")



　　'フォルダの有無の確認

　　If FSO.FolderExists(strPath) = True Then Exit Function



　　Set Fol = FSO.CreateFolder(strPath)



　　'終了処理

　　Set Fol = Nothing

　　Set FSO = Nothing

End Function



'URLショートカット作成

Function MakeURL(Path, URL)

Dim Shell

Dim ShortCut



　　Set Shell = CreateObject("WScript.Shell")



　　If URL = "" Then

　　URL = "http://www"

End If



　　'ショートカットファイル作成

　　Set ShortCut = Shell.CreateShortcut(Path)

　　'URL設定

　　ShortCut.TargetPath = URL

　　'保存

　　ShortCut.Save



　　'終了処理

　　Set ShortCut = Nothing

　　Set Shell = Nothing

End Function


				  
━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
　　　通常モードに戻る　　┃　　ＩＮＤＥＸ　　┃　　≪前へ　　│　　次へ≫　　　
━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　Ｐａｇｅ       9