ab.com コミュニティ

コード: 全て選択

Declare Function SHGetSpecialFolderPath Lib "shell32" Alias "SHGetSpecialFolderPathA" (
	ByVal hwndOwner As HWND,
	ByVal lpszPath As BytePtr,
	ByVal nFolder As Long,
	ByVal fCreate As BOOL) As BOOL

コード: 全て選択

Declare Function SHGetSpecialFolderPath Lib "shell32" Alias "SHGetSpecialFolderPathA" (
	ByVal hwndOwner As HWND,
	ByVal lpszPath As BytePtr,
	ByVal nFolder As Long,
	ByVal fCreate As BOOL) As BOOL

Sub GetFavorite()
Dim hList As HWND
Dim hFind As HANDLE
Dim ffd As WIN32_FIND_DATA
Dim path[MAX_PATH-1] As Byte

	hList=GetDlgItem(hMainWnd,ListBox1)

	' ListBox1 の初期化
	SendMessage(hList,LB_RESETCONTENT,0,0)

	' 「Favorite」へのパスを取得
	SHGetSpecialFolderPath(hMainWnd,path,CSIDL_FAVORITES,FALSE)

	' 「Favorite」内にあるすべての「.url」を検索
	hFind=FindFirstFile(lstrcat(path,"\*.url"),ffd)
	If hFind<>INVALID_HANDLE_VALUE Then
		Do
			SendMessage(hList,LB_ADDSTRING,0,ffd.cFileName)
		Loop While FindNextFile(hFind,ffd)

		FindClose(hFind)
	End If
End Sub

コード: 全て選択

Declare Function SHGetSpecialFolderPath Lib "shell32.dll" Alias "SHGetSpecialFolderPathA" (hwndOwner as long,lpszPath as String,nFolder as long,fCreate as long) as long
const CSIDL_FAVORITES=&H6

sub GetFavorite()
	dim hLst as long

	hLst=GetDlgItem(hMainWnd,ListBox1)

	' ListBox1 の内容をリセット
	SendMessage(hLst,LB_RESETCONTENT,0,0)

	' 特殊フォルダ「Favorite」を指定
	dim buffer as String
	buffer=String$(255,Chr$(0))

	SHGetSpecialFolderPath(GetDesktopWindow(),buffer,&H6,FALSE)

	dim Find as WIN32_FIND_DATA
	dim hFind as DWord
	hFind=FindFirstFile(lstrcat(buffer,"\*.url"),Find)

	' Favorite フォルダ内の「*.url」を検索・セット
	do
		dim buf[255] as long
		wsprintf(buf,"Internet Shortcut")
		SendMessage(hLst,LB_ADDSTRING,0,buf)
	Loop while FindNextFile(hFind,Find)
	FindClose(hFind)
End Sub
'～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～
Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT)
	GetFavorite()
End Sub

コード: 全て選択

Declare Function SHGetSpecialFolderPath Lib "shell32.dll" Alias "SHGetSpecialFolderPathA" (hwndOwner As Long,lpszPath As String,nFolder As Long,fCreate As Long) As Long
Const CSIDL_FAVORITIES=&H6


Sub SetFavorite(lpszText As BytePtr, ParamNum As Long)
    Dim lvFind As LVFINDINFO
    Dim lvItem As LVITEM
    Dim nIndex As Long

	dim Find as WIN32_FIND_DATA
	dim hFind as DWord

	Dim ListViewNum As Long
	Dim buffer As String
	buffer=String$(255,Chr$(0))
	SHGetSpecialFolderPath(GetDesktopWindow(),buffer,&H6,FALSE)
	hFind=FindFirstFile(lstrcact(buffer,"\*."),Find)


    'ParamNumを元に、先頭からのインデックス番号を取得
    lvFind.flags=LVFI_PARAM
    lvFind.lParam=ParamNum
    Find.cFileName=SendDlgItemMessage(hMainWnd,ListView1,LVM_FINDITEM,-1,VarPtr(lvFind))


    'リストビューの「Favorites」欄を設定
	do
		lvItem.mask=LVIF_TEXT or LVIF_PARAM
	    lvItem.pszText=Find.cFileName
	    lvItem.iItem=0
	    lvItem.iSubItem=0
		lvItem.lParam=ListViewNum
		SendMessage(GetDlgItem(hMainWnd,ListView1),LVM_INSERTITEM,0,VarPtr(lvItem))
	Loop while FindNextFile(hFind,Find)
	FindClose(hFind)
End Sub

'Create イベントは変更なし

コード: 全て選択

Declare Function SHGetSpecialFolderPath Lib "shell32.dll" Alias "SHGetSpecialFolderPathA" (hwndOwner As Long,lpszPath As String,nFolder As Long,fCreate As Long) As Long
Const CSIDL_FAVORITIES=&H6


Sub SetMsgText_To_ListView(lpszText As BytePtr, ParamNum As Long)
    Dim lvFind As LVFINDINFO
    Dim lvItem As LVITEM
    Dim nIndex As Long

    'ParamNumを元に、先頭からのインデックス番号を取得
    lvFind.flags=LVFI_PARAM
    lvFind.lParam=ParamNum
    nIndex=SendDlgItemMessage(hMainWnd,ListView1,LVM_FINDITEM,-1,VarPtr(lvFind))


    'リストビューの「Favorite」欄を設定
	dim Favorite as long

	do
		Dim ListViewNum As Long
		Dim buffer As String
		buffer=String$(255,Chr$(0))

		SHGetSpecialFolderPath(GetDesktopWindow(),buffer,&H6,FALSE)

		'お気に入りのフォルダの中を検索
		dim Find as WIN32_FIND_DATA
		dim hFind as DWord
		Dim lvItem As LVITEM
		hFind=FindFirstFile(buffer+"\*.",Find)

		lvItem.mask=LVIF_TEXT or LVIF_PARAM
	    lvItem.pszText=Find.cFileName
	    lvItem.iItem=0
	    lvItem.iSubItem=0
		lvItem.lParam=ListViewNum
		SendDlgItemMessage(hMainWnd,ListView1,LVM_SETITEM,0,VarPtr(lvItem))
	Loop while FindNextFile(hFind, Find)
	FindClose(hFind)
End Sub


Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT)
    SendDlgItemMessage(hMainWnd,ListView1,LVM_SETEXTENDEDLISTVIEWSTYLE,0,LVS_EX_FULLROWSELECT)


    '----------------------------
    ' リストビューのカラムを設定
    '----------------------------
    Dim lc As LVCOLUMN
    lc.mask=LVCF_FMT or LVCF_WIDTH or LVCF_TEXT or LVCF_SUBITEM
    lc.fmt=LVCFMT_LEFT

    lc.cx=196
    lc.pszText="Favorite"
    lc.iSubItem=0
    SendDlgItemMessage(hMainWnd,ListView1,LVM_INSERTCOLUMN,0,VarPtr(lc))
End Sub