'================================================================
'= ネットワークドライブの割り当てを呼び出す
'=    (WNetConnectionDialog1.bas)
'================================================================
#include "Windows.bi"

#define CONNDLG_RO_PATH &H1
#define CONNDLG_CONN_POINT &H2
#define CONNDLG_USE_MRU &H4
#define CONNDLG_HIDE_BOX &H8
#define CONNDLG_PERSIST &H10
#define CONNDLG_NOT_PERSIST &H20

#define DISC_UPDATE_PROFILE &H1
#define DISC_NO_FORCE &H40
#define RESOURCETYPE_DISK &H1
#define NO_ERROR 0
#define WN_SUCCESS NO_ERROR

#define GMEM_FIXED &H0
#define GMEM_ZEROINIT &H40
#define GPTR (GMEM_FIXED Or GMEM_ZEROINIT)

Type CONNECTDLGSTRUCT
    cbStructure As Long
    hwndOwner   As Long
    lpConnRes   As Long
    dwFlags     As Long
    dwDevNum    As Long
End Type

Type DISCDLGSTRUCT
    cbStructure  As Long
    hwndOwner    As Long
    lpLocalName  As Long
    lpRemoteName As Long
    dwFlags      As Long
End Type

Type NETRESOURCE
    dwScope       As Long
    dwType        As Long
    dwDisplayType As Long
    dwUsage       As Long
    lpLocalName   As Long
    lpRemoteName  As Long
    lpComment     As Long
    lpProvider    As Long
End Type

' ネットワーク資源に接続するための汎用の参照ダイアログボックスを起動
Declare Function Api_WNetConnectionDialog1& Lib "mpr" Alias "WNetConnectionDialog1A" (lpConnectDlgStruct As Any)

' ネットワーク資源からの切断を試みる
Declare Function Api_WNetDisconnectDialog1& Lib "mpr" Alias "WNetDisconnectDialog1A" (lpDiscDlgStruct As Any)

' メモリブロックを確保しハンドルを取得
Declare Function Api_GlobalAlloc& Lib "kernel32" Alias "GlobalAlloc" (ByVal wFlags&, ByVal dwBytes&)

' メモリブロックのロックを解放
Declare Function Api_GlobalFree& Lib "kernel32" Alias "GlobalFree" (ByVal hMem&)

' ある位置から別の位置にメモリブロックを移動
Declare Sub CopyMemory Lib "Kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length&)

Var Shared Text1 As Object
Var Shared Button1 As Object
Var Shared Button2 As Object

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

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var cs As CONNECTDLGSTRUCT
    Var nr As NETRESOURCE
    Var Ret As Long

    nr.lpRemoteName = StrAdr("\\versapro\c" & Chr$(0))
    nr.dwType = RESOURCETYPE_DISK

    cs.cbStructure = Len(cs)
    cs.hwndOwner = GethWnd
    cs.lpConnRes = Api_GlobalAlloc(GPTR, Len(nr))

    CopyMemory ByVal cs.lpConnRes, nr, Len(nr)

    cs.dwFlags = CONNDLG_USE_MRU Or CONNDLG_HIDE_BOX Or CONNDLG_NOT_PERSIST

    Ret = Api_WNetConnectionDialog1(cs)

    If Ret = WN_SUCCESS Then
        A% = MessageBox("", "MapDrive Succeeded.", 0, 2)
        Text1.SetWindowText Chr$(cs.dwDevNum + 64) & ":"
    Else
        A% = MessageBox("", "Error!", 0, 2)
    End If
    Ret = Api_GlobalFree(cs.lpConnRes)
End Sub

'================================================================
'=
'================================================================
Declare Sub Button2_on edecl ()
Sub Button2_on()
    Var ds As DISCDLGSTRUCT
    Var Ret As Long

    ds.cbStructure = Len(ds)
    ds.hwndOwner = GethWnd
    ds.lpLocalName = StrAdr(Text1.GetWindowText & Chr$(0))
    ds.dwFlags = DISC_NO_FORCE Or DISC_UPDATE_PROFILE

    Ret = Api_WNetDisconnectDialog1(ds)

    If Ret = WN_SUCCESS Then
        Text1.SetWindowText ""
        A% = MessageBox("", "UnMapDrive Succeeded.", 0, 2)
    Else
        A% = MessageBox("", "Error!", 0, 2) 
    End If
End Sub

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