'================================================================
'= ネットワーク上にフォルダを作成
'=    (SHBrowseForFolder3.bas)

'================================================================
#include "Windows.bi"
#include "File.bi"

Type BROWSEINFO
    hWndOwner       As Long
    pIDLRoot        As Long
    pszDisplayName  As Long
    lpszTitle       As Long
    ulFlags         As Long
    lpfnCallback    As Long
    lParam          As Long
    iImage          As Long
End Type

' 「フォルダの参照」ダイアログを開く
Declare Function Api_SHBrowseForFolder& Lib "shell32" Alias "SHBrowseForFolder" (lpbi As BROWSEINFO)

' アイテムＩＤリストをファイルシステムのパス名に変換
Declare Function Api_SHGetPathFromIDList& Lib "shell32" Alias "SHGetPathFromIDList" (ByVal pidList&, ByVal lpBuffer$)

' ある文字列の末尾に別の文字列を結合
Declare Function Api_lstrcat& Lib "Kernel32" Alias "lstrcatA" (ByVal lpString1$, ByVal lpString2$)

#define BIF_RETURNONLYFSDIRS &H1        'ファイルシステムディレクトリのみを返す
#define CSIDL_NETWORK &H12              'ネットワークコンピュータ(仮想フォルダ)
#define MAX_PATH 260                    '

Var Shared Edit1 As Object
Var Shared Text1 As Object
Var Shared Button1 As Object

Edit1.Attach GetDlgItem("Edit1") : Edit1.SetFontSize 14
Text1.Attach GetDlgItem("Text1") : Text1.SetFontSize 14
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var pidList As Long
    Var Buffer As String
    Var bi As BROWSEINFO
    Var NetPath As String
    Var NewFolder As String
    Var Ret As Long
    
    bi.hWndOwner = GethWnd
    bi.pIDLRoot = CSIDL_NETWORK
    bi.ulFlags = BIF_RETURNONLYFSDIRS
    bi.lpszTitle = Api_lstrcat("ネットワークの参照", "")

    pidList = Api_SHBrowseForFolder(bi)
    If pidList Then
        Buffer = Space$(MAX_PATH)
        Ret = Api_SHGetPathFromIDList(pidList, Buffer)
        If Ret Then
            NetPath = Left$(Buffer, InStr(Buffer, Chr$(0)) - 1)
            Text1.SetWindowText NetPath
        Else
            Text1.SetWindowText "パス取得に失敗しました。"
            Exit Sub
        End If
    Else
        Text1.SetWindowText "失敗しました"
        Exit Sub
    End If
    
    '作成するフォルダ名
    NewFolder = NetPath & "\" & Edit1.GetWindowText
    
    'フォルダを作成
    MkDir NewFolder
    Text1.SetWindowText NewFolder & "を作成しました。"
End Sub

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