'================================================================
'= お気に入りに追加と整理
'=    (DoAddToFavDlg.bas)
'================================================================
#include "Windows.bi"

#define MAX_PATH 260
#define ERROR_Success 0                 '正常終了の戻り値を示す
#define S_OK 0
#define S_FALSE 1
#define SHGFP_TYPE_CURRENT 0            'フォルダの現在のパス名を返す
#define SHGFP_TYPE_DEFAULT 1            'フォルダのデフォルトのパス名を返す
#define CSIDL_FAVORITES &H6             'お気に入り(ファイルシステムディレクトリ)

' お気に入りに追加
Declare Function Api_DoAddToFavDlg& Lib "shdocvw" Alias "DoAddToFavDlg" (ByVal hWnd&, ByVal Path$, ByVal PathSize&, ByVal Title$, ByVal TitleSize&, ByVal pidl&)
   
' お気に入りの整理
Declare Function Api_DoOrganizeFavDlg& Lib "shdocvw" Alias "DoOrganizeFavDlg" (ByVal hWnd&, ByVal RootFolder$)

' CSIDLからパスを取得する関数
Declare Function Api_SHGetFolderPath& Lib "ShFolder" Alias "SHGetFolderPathA" (ByVal hwndOwner&, ByVal nFolder&, ByVal hToken&, ByVal dwFlags&, ByVal pPath$)

' 特殊フォルダのパスを取得。｢スタートメニュー｣｢送る｣｢最近使ったファイル｣
Declare Function Api_SHGetSpecialFolderLocation& Lib "shell32" Alias "SHGetSpecialFolderLocation" (ByVal hwndOwner&, ByVal nFolder&, pidl&)

' iniファイルに文字列を書き込む
Declare Function Api_WritePrivateProfileString& Lib "Kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName$, ByVal KeyName As Any, ByVal lpString As Any, ByVal lpFileName$)

' アイテムIDリストの解放
Declare Sub Api_CoTaskMemFree Lib "ole32" Alias "CoTaskMemFree" (ByVal hMem&)

Var Shared Edit(2) As Object
Var Shared Text(2) As Object
Var Shared Button(1) As Object

For i = 0 To 2
    If i < 2 Then
        Button(i).Attach GetDlgItem("Button" & Trim$(Str$(i + 1))) : Button(i).SetFontSize 14
    End If
    Edit(i).Attach GetDlgItem("Edit" & Trim$(Str$(i + 1))) : Edit(i).SetFontSize 14
    Text(i).Attach GetDlgItem("Text" & Trim$(Str$(i + 1))) : Text(i).SetFontSize 14
Next

'================================================================
'= お気に入りに追加(処理)
'================================================================
Declare Function AddFavourite(Title As String, Url As String) As String
Function AddFavourite(Title As String, Url As String) As String
    Var Success As Long
    Var ePos As Long
    Var PathSize As Long
    Var TitleSize As Long
    Var pidl As Long
    Var Path As String
    Var Ret As Long
  
    Title = Title & Chr$(0)
    TitleSize = Len(Title)
   
    Path = Space$(MAX_PATH) & Chr$(0)
    PathSize = Len(Path)
   
    If Api_SHGetSpecialFolderLocation(GethWnd, CSIDL_FAVORITES, pidl) = ERROR_Success Then
        Success = Api_DoAddToFavDlg(GethWnd, Path, PathSize, Title, TitleSize, pidl)

        If Success = 1 Then
             ePos = InStr(Path, Chr$(0))
             Path = Left$(Path, ePos - 1)
         
             ePos = InStr(Title, Chr$(0))
             Title = Left$(Title, ePos - 1)
      
             Edit(0).SetWindowText Path
             Edit(1).SetWindowText Title

             AddFavourite = Path
        End If
      
        Api_CoTaskMemFree pidl
    End If
End Function

'================================================================
'=
'================================================================
Declare Sub SaveItem(SectionName As String, KeyName As String, Value As String, iniFile As String)
Sub SaveItem(SectionName As String, KeyName As String, Value As String, iniFile As String)
    Var Ret As Long

    Ret = Api_WritePrivateProfileString(SectionName, KeyName, Value, iniFile)
End Sub

'================================================================
'= 
'================================================================
Declare Function GetFolderPath(CSIDL As Long) As String
Function GetFolderPath(CSIDL As Long) As String
    Var Path As String
    Var Tmp As String
    
    Path = Space$(MAX_PATH)
   
    If Api_SHGetFolderPath(GethWnd, CSIDL, 0, SHGFP_TYPE_CURRENT, Path) = S_OK Then
        GetFolderPath = Left$(Path, InStr(Path, Chr$(0)) - 1)
    End If
End Function

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    Edit(0).SetWindowText "F-Basic Programming Tips"
    Edit(1).SetWindowText "http://tokovalue.hp.infoseek.co.jp"
    Edit(2).SetWindowText ""
    ShowWindow -1
End Sub

'================================================================
'= お気に入りに追加
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var Title As String
    Var Url As String
    Var Ret As String

    Title = Edit(0).GetWindowText
   
    Url = Edit(1).GetWindowText
   
    Ret = AddFavourite(Title, Url)
   
    Edit(0).SetWindowText Title
    Edit(1).SetWindowText Url
    Edit(2).SetWindowText Ret
End Sub

'================================================================
'= お気に入りの整理
'================================================================
Declare Sub Button2_on edecl ()
Sub Button2_on()
    Var RootFolder As String
    Var Success As Long
  
   RootFolder = GetFolderPath(CSIDL_FAVORITES)
   Success = Api_DoOrganizeFavDlg(GethWnd, RootFolder)
End Sub

'================================================================
'=
'================================================================
Declare Sub MainForm_QueryClose edecl ()
Sub MainForm_QueryClose()
    End
End Sub

'================================================================
'=
'================================================================
While 1
    WaitEvent
Wend
Stop
End