UNC (Universal Naming Convention)

下図の様なLAN接続での例

参考URL

http://www.atmarkit.co.jp/icd/root/91/5787091.html

'================================================================
'= UNCパスを取得
'=    (WNetEnumResource.bas)
'================================================================
#include "Windows.bi"

#define RESOURCETYPE_ANY &H0
#define RESOURCE_CONNECTED &H1

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_WNetOpenEnum& Lib "mpr" Alias "WNetOpenEnumA" (ByVal dwScope&, ByVal dwType&, ByVal dwUsage&, lpNetResource As NETRESOURCE, lphEnum&)

' WNetOpenEnum 関数を呼び出して開始したネットワークリソースの列挙を継続
Declare Function Api_WNetEnumResource& Lib "mpr" Alias "WNetEnumResourceA" (ByVal hEnum&, lpcCount&, lpBuffer As Any, lpBufferSize&)

' WNetOpenEnum 関数を呼び出して開始したネットワークリソースの列挙を終了
Declare Function Api_WNetCloseEnum& Lib "mpr" Alias "WNetCloseEnum" (ByVal hEnum&)

' 指定された文字列のバイトまたは文字の長さを返す
Declare Function Api_lstrlen& Lib "Kernel32" Alias "lstrlenA" (ByVal lpString As Any)

' 文字列をコピーする
Declare Function Api_lstrcpy& Lib "Kernel32" Alias "lstrcpyA" (ByVal lpszString1 As Any, ByVal lpszString2 As Any)

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

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

'================================================================
'=
'================================================================
Declare Function LetterToUNC(DriveLetter As String) As String
Function LetterToUNC(DriveLetter As String) As String
    Var hEnum As Long
    Var ns(1023) As NETRESOURCE
    Var entries As Long
    Var nStatus As Long
    Var LocalName As String
    Var UNCName As String
    Var i As Long
    Var r As Long

    '列挙開始
    nStatus = Api_WNetOpenEnum(RESOURCE_CONNECTED, RESOURCETYPE_ANY, 0, ByVal 0, hEnum)

    LetterToUNC = DriveLetter

    '列挙からの成功をチェック
    If ((nStatus = 0) And (hEnum <> 0)) Then
        'エントリー数を設定
        entries = 1024

        'リソースを列挙
        nStatus = Api_WNetEnumResource(hEnum, entries, ns(0), CLng(Len(ns(0))) * 1024)

        '成功をチェック
        If nStatus = 0 Then
            For i = 0 To entries - 1

                'ローカル名を取得
                LocalName = ""
                If ns(i).lpLocalName <> 0 Then
                    LocalName = Space$(Api_lstrlen(ns(i).lpLocalName) + 1)
                    r = Api_lstrcpy(LocalName, ns(i).lpLocalName)
                End If

                '最後のNullを削除
                If Len(LocalName) <> 0 Then
                    LocalName = Left$(LocalName, (Len(LocalName) - 1))
                End If

                If UCase$(LocalName) = UCase$(DriveLetter) Then
                    'リモート名を取得
                    UNCName = ""
                    If ns(i).lpRemoteName <> 0 Then
                        UNCName = Space$(Api_lstrlen(ns(i).lpRemoteName) + 1)
                        r = Api_lstrcpy(UNCName, ns(i).lpRemoteName)
                    End If

                    '最後のNullを削除
                    If Len(UNCName) <> 0 Then
                        UNCName = Left$(UNCName, (Len(UNCName) - 1))
                    End If

                    'UNC pathを返す
                    LetterToUNC = UNCName

                    'loopを抜ける
                    Exit For
                End If
            Next i
        End If
    End If

    ' End enumeration
    nStatus = Api_WNetCloseEnum(hEnum)
End Function

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var DriveName As String

    DriveName = Edit1.GetWindowText
    If Right$(DriveName, 1) <> ":" Then DriveName = DriveName & ":"
    
    Text1.SetWindowText "UNC path: " & LetterToUNC(DriveName)        
End Sub

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