Attribute VB_Name = "modIP"
Option Explicit

Public Const MAX_PREFERRED_LENGTH As Long = -1
Public Const NERR_SUCCESS As Long = 0&
Public Const ERROR_MORE_DATA As Long = 234&

Public Const SV_TYPE_ALL As Long = &HFFFFFFFF
Public Const SV_TYPE_WORKSTATION As Long = &H1
Public Const SV_TYPE_SERVER As Long = &H2

Public Const STYPE_DISKTREE As Long = 0
Public Const STYPE_PRINTQ As Long = 1
Public Const STYPE_DEVICE As Long = 2
Public Const STYPE_IPC As Long = 3
Public Const STYPE_SPECIAL As Long = &H80000000
Public Const STYPE_TEMPORARY As Long = &H40000000
Public Const ACCESS_READ  As Long = &H1
Public Const ACCESS_WRITE As Long = &H2
Public Const ACCESS_CREATE As Long = &H4
Public Const ACCESS_EXEC As Long = &H8
Public Const ACCESS_DELETE As Long = &H10
Public Const ACCESS_ATRIB As Long = &H20
Public Const ACCESS_PERM As Long = &H40
Public Const ACCESS_ALL As Long = ACCESS_READ Or ACCESS_WRITE Or ACCESS_CREATE Or ACCESS_EXEC Or ACCESS_DELETE Or ACCESS_ATRIB Or ACCESS_PERM

Public Const PERM_FILE_READ = &H1   'user has read access
Public Const PERM_FILE_WRITE = &H2  'user has write access
Public Const PERM_FILE_CREATE = &H4 'user has create access

Public Const WSADESCRIPTION_LEN = 256
Public Const WSASYS_STATUS_LEN = 128


'ネットワーク接続定数
Public Const RESOURCETYPE_DISK = &H1      'ディスク
Public Const CONNECT_UPDATE_PROFILE = &H1 '次回ログオン時に再接続
Public Const RESOURCE_CONNECTED = &H1
Public Const RESOURCETYPE_ANY = &H0
Public Const RESOURCEDISPLAYTYPE_SHARE = &H3


'ネットワークエラー定数
Public Const ERROR_SUCCESS = 0                                  '正常終了
Public Const ERROR_BAD_NETPATH = 53                             'ネットワークパスが不正
Public Const ERROR_ACCESS_DENIED = 8                            'ネットワーク資源へのアクセスが拒否されました｡
Public Const ERROR_ALREADY_ASSIGNED = 85                        'lpLocalName で指定したローカルデバイスは既にネットワーク資源に接続されています。
Public Const ERROR_BAD_DEV_TYPE = 66                            'ローカルデバイスの種類とネットワーク資源の種類が一致しません｡
Public Const ERROR_BAD_DEVICE = 1200                            'lpLocalName で指定した値が無効です。
Public Const ERROR_BAD_NET_NAME = 67                            'lpRemoteName で指定した値を、どのネットワーク資源のプロバイダも受け付けません。資源の名前が無効か、指定した資源が見つかりません。
Public Const ERROR_BAD_PROFILE = 1206                           'ユーザープロファイルの形式が正しくありません｡
Public Const ERROR_BAD_PROVIDER = 1204                          'lpProvider で指定した値がどのプロバイダとも一致しません。
Public Const ERROR_BUSY = 170                                   'ルーターまたはプロバイダがビジー（ おそらく初期化中）です。この関数をもう一度呼び出してください。
Public Const ERROR_CANCELLED = 1223                             'ネットワーク資源のプロバイダのいずれかでユーザーがダイアログボックスを使って接続操作を取り消したか､接続先の資源が接続操作を取り消しました｡
Public Const ERROR_CANNOT_OPEN_PROFILE = 1205                   '恒久的な接続を処理するためのユーザープロファイルを開くことができません｡
Public Const ERROR_DEVICE_ALREADY_REMEMBERED = 1202             'lpLocalName で指定したデバイスのエントリは既にユーザープロファイル内に存在します。
Public Const ERROR_EXTENDED_ERROR = 1208                        'ネットワーク固有のエラーが発生しました。エラーの説明を取得するには、WNetGetLastError 関数を使います。
Public Const ERROR_INVALID_PASSWORD = 86                        '指定したパスワードが無効です｡
Public Const ERROR_NO_NET_OR_BAD_PATH = 1203                    'ネットワークコンポーネントが開始されていないか､指定した名前が利用できないために､操作を行えませんでした｡
Public Const ERROR_NO_NETWORK = 1222                            'ネットワークに接続されていません｡
Public Const ERROR_DEVICE_IN_USE = 2404                         '指定したデバイスがアクティブなプロセスによって使用中のため､切断できません｡
Public Const ERROR_NOT_CONNECTED = 2250                         'lpName パラメータで指定した名前がリダイレクトされているデバイスを表していないか、lpName で指定したデバイスにシステムが接続していません。
Public Const ERROR_OPEN_FILES = 2401                            '開いているファイルがあり、fForce が FALSE です。



'コンピュータ名タイプを指定する列挙型の宣言
Public Enum COMPUTER_NAME_FORMAT
    ComputerNameNetBIOS                             'NetBIOS名
    ComputerNameDnsHostname                         'DNSホスト名
    ComputerNameDnsDomain                           'DNSドメイン名
    ComputerNameDnsFullyQualified                   '完全修飾DNS名
    ComputerNamePhysicalNetBIOS                     '物理的なNetBIOS名
    ComputerNamePhysicalDnsHostname                 '物理的なDNSホスト名
    ComputerNamePhysicalDnsDomain                   '物理的なDNSドメイン名
    ComputerNamePhysicalDnsFullyQualified           '物理的な完全修飾DNS名
    ComputerNameMax                                 '未使用
End Enum

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

Public Type WSADATA
    wVersion As Integer
    wHighVersion As Integer
    szDescription(WSADESCRIPTION_LEN) As Byte
    szSystemStatus(WSASYS_STATUS_LEN) As Byte
    iMaxSockets As Integer
    iMaxUdpDg As Integer
    lpVendorInfo As Long
End Type

Public Type hostent
    h_name As Long
    h_aliases As Long
    h_addrtype As Integer
    h_length As Integer
    h_addr_list As Long
End Type

Public Type SERVER_INFO_100
  sv100_platform_id As Long
  sv100_name As Long
End Type

Public Type SHARE_INFO_0
    shi0_netname As Long
End Type

Public Type SHARE_INFO_1
    shi1_netname As Long
    shi1_type As Long
    shi1_remark As Long
End Type

Public Type SHARE_INFO_2
    shi2_netname As Long
    shi2_type As Long
    shi2_remark As Long
    shi2_permissions As Long
    shi2_max_uses As Long
    shi2_current_uses As Long
    shi2_path As Long
    shi2_passwd As Long
End Type

Public Type FILE_INFO_3
    fi3_id As Long
    fi3_permissions As Long
    fi3_num_locks As Long
    fi3_pathname As Long
    fi3_username As Long
End Type



'キーボードステータス
Public Declare Function GetAsyncKeyState Lib "user32" _
    (ByVal vKey As Long) As Integer

'メモリコピー
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
    (Destination As Any, _
    Source As Any, _
    ByVal Length As Long)

'ホスト名取得
Public Declare Function gethostname Lib "wsock32" _
    (ByVal Name As String, _
    ByVal namelen As Long) As Long

'名前解決
Public Declare Function gethostbyname Lib "wsock32" _
    (ByVal Name As String) As Long

'Winsockスタート
Public Declare Function WSAStartup Lib "wsock32" _
    (ByVal wVersionRequested As Integer, _
    lpWSAData As Any) As Long
'Winsock終了
Public Declare Function WSACleanup Lib "wsock32" () As Long

'Winsockエラー取得
Public Declare Function WSAGetLastError Lib "wsock32" () As Integer

'ネットユーザーグループ列挙
Public Declare Function NetUserGetGroups Lib "Netapi32" _
    (lpServer As Any, _
    username As Byte, _
    ByVal Level As Long, _
    lpBuffer As Long, _
    ByVal prefmaxlen As Long, _
    lpEntriesRead As Long, _
    lpTotalEntries As Long) As Long

'ローカルグループ列挙
Public Declare Function NetUserGetLocalGroups Lib "Netapi32" _
    (lpServer As Any, _
    username As Byte, _
    ByVal Level As Long, _
    ByVal Flags As Long, _
    lpBuffer As Long, _
    ByVal MaxLen As Long, _
    lpEntriesRead As Long, _
    lpTotalEntries As Long) As Long

Public Declare Function NetServerEnum Lib "Netapi32" _
    (ByVal ServerName As Long, _
    ByVal Level As Long, _
    buf As Any, _
    ByVal prefmaxlen As Long, _
    entriesread As Long, _
    totalentries As Long, _
    ByVal servertype As Long, _
    ByVal domain As Long, _
    resume_handle As Long) As Long

Public Declare Function NetShareEnum Lib "Netapi32" _
    (ByVal ServerName As Long, _
    ByVal Level As Long, _
    bufptr As Long, _
    ByVal prefmaxlen As Long, _
    entriesread As Long, _
    totalentries As Long, _
    resume_handle As Long) As Long

'ネットワーク管理関数の解放
Public Declare Function NetApiBufferFree Lib "Netapi32" _
    (ByVal pBuffer As Long) As Long

'ネットワークドライブの接続
Public Declare Function WNetAddConnection2 Lib "mpr" Alias "WNetAddConnection2A" _
    (ByRef lpNetResource As NETRESOURCE, _
    ByVal lpPassword As String, _
    ByVal lpUserName As String, _
    ByVal dwFlags As Long) As Long

'ネットワークドライブの切断
Public Declare Function WNetCancelConnection2 Lib "mpr" Alias "WNetCancelConnection2A" _
    (ByVal lpName As String, _
    ByVal dwFlags As Long, _
    ByVal fForce As Long) As Long


Public Declare Function lstrlenW Lib "kernel32" _
    (ByVal lpString As Long) As Long

'コンピュータ名を取得する関数の宣言
Public Declare Function GetComputerNameEx Lib "kernel32" Alias "GetComputerNameExA" _
    (ByVal NameType As COMPUTER_NAME_FORMAT, _
    ByVal lpBuffer As String, _
    lpnSize As Long) As Long


'ログインユーザー名
Public Declare Function GetUserName Lib "advapi32" Alias "GetUserNameA" _
    (ByVal lpBuffer As String, _
    lpnSize As Long) As Long

Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
    (ByVal hWnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    lParam As Any) As Long










Public Declare Function NetFileEnum Lib "Netapi32" _
    (ByVal ServerName As Long, _
    ByVal basepath As Long, _
    ByVal username As Long, _
    ByVal Level As Long, _
    bufptr As Long, _
    ByVal prefmaxlen As Long, _
    entriesread As Long, _
    totalentries As Long, _
    resume_handle As Long) As Long

Public Declare Function NetFileGetInfo Lib "Netapi32" _
    (ByVal ServerName As Long, _
    ByVal FileID As Long, _
    ByVal Level As Long, _
    bufptr As Long) As Long





Private Sub Auto_Open()

    If GetAsyncKeyState(vbKeyControl) Then

    Else
        Debug.Print ThisWorkbook.Worksheets("Setting").Cells(1, 2).Value
        If ThisWorkbook.Worksheets("Setting").Cells(1, 2).Value = True Then
            Application.Visible = False
            UserForm1.Show vbModeless
        End If
    End If

End Sub

Private Sub testGetIpAddres()

    Debug.Print GetIpAddress("PCName")

End Sub
Public Function GetIpAddress(sName As String) As String

    Dim wsa As WSADATA
    Dim tpHostent As hostent
    Dim pHostent As Long
    Dim btIP(3) As Byte

    If WSAStartup(&H101, wsa) <> 0 Then
        Exit Function
    End If

    pHostent = gethostbyname(sName & vbNullChar)
    If pHostent <> 0 Then
        CopyMemory tpHostent, ByVal pHostent, Len(tpHostent)
        CopyMemory pHostent, ByVal tpHostent.h_addr_list, Len(tpHostent.h_addr_list)
        CopyMemory btIP(0), ByVal pHostent, Len(pHostent)
        GetIpAddress = btIP(0) & "." & btIP(1) & "." & btIP(2) & "." & btIP(3)
    End If

    WSACleanup

End Function
Sub testGetUserGroups()

    Dim strGroups() As String
    Dim i As Long

    strGroups = GetUserGroups("PCName", "User1", True)
    For i = 0 To UBound(strGroups)
        Debug.Print strGroups(i)
    Next i

End Sub
Public Function GetUserGroups(ByVal ServerName As String, _
    ByVal username As String, Optional bLocalGroups _
    As Boolean = False) As String()

    Dim bytUser() As Byte
    Dim bytServer() As Byte

    Dim lBuffer As Long
    Dim lEntries As Long
    Dim lMaxLen As Long
    Dim lTotalEntries As Long
    Dim lRet As Long
    Dim lGroups() As Long
    Dim sGroups() As String
    Dim bytBuffer() As Byte
    Dim iCtr As Integer
    Dim lLen As Long

    If bLocalGroups Then
        ServerName = vbNullChar
    Else
        If Left(ServerName, 2) <> "\\" Then
            ServerName = "\\" & ServerName
        End If
    End If

    bytServer = ServerName & vbNullChar
    bytUser = username & vbNullChar

    If bLocalGroups Then
        lRet = NetUserGetLocalGroups(bytServer(0), bytUser(0), 0, 0, _
        lBuffer, 1024, lMaxLen, lTotalEntries)

    Else
        lRet = NetUserGetGroups(bytServer(0), bytUser(0), 0, _
        lBuffer, 1024, lMaxLen, lTotalEntries)

    End If

    If lRet = 0 And lMaxLen > 0 Then
        ReDim lGroups(lMaxLen - 1) As Long
        ReDim sGroups(lMaxLen - 1) As String
        CopyMemory lGroups(0), ByVal lBuffer, lMaxLen * 4
        For iCtr = 0 To lMaxLen - 1
            lLen = lstrlenW(lGroups(iCtr)) * 2
            If lLen > 0 Then
                ReDim bytBuffer(lLen - 1) As Byte
                CopyMemory bytBuffer(0), ByVal lGroups(iCtr), _
                lLen
                sGroups(iCtr) = bytBuffer
            End If
        Next
    Else
        ReDim sGroups(0) As String
    End If

    If lBuffer > 0 Then
        NetApiBufferFree (lBuffer)
    End If

    GetUserGroups = sGroups

End Function
Private Sub testsubGetComputerName()

    Dim lpBuffer As String
    Dim lngRet As Long
    Dim blRet As Boolean

    lpBuffer = String(255, vbNullChar)
    lngRet = GetComputerNameEx(ComputerNameNetBIOS, lpBuffer, Len(lpBuffer))
    If lngRet <> 0 Then
        Debug.Print Left(lpBuffer, InStr(lpBuffer, vbNullChar) - 1)
    End If

    lpBuffer = String(255, vbNullChar)
    lngRet = GetComputerNameEx(ComputerNameDnsDomain, lpBuffer, Len(lpBuffer))
    If lngRet <> 0 Then
        Debug.Print Left(lpBuffer, InStr(lpBuffer, vbNullChar) - 1)
    End If

    lpBuffer = String(255, vbNullChar)
    lngRet = GetUserName(lpBuffer, Len(lpBuffer))
    If lngRet <> 0 Then
        Debug.Print Left(lpBuffer, InStr(lpBuffer, vbNullChar) - 1)
    End If

End Sub

Attribute VB_Name = "Module2"
Option Explicit
Public Function NetConnect(ByVal strResource As String, ByVal strUser As String, ByVal strPass As String) As Long

    Dim tpNetResource As NETRESOURCE
    Dim lngRet As Long

    '接続先文字列整形
    If strResource = "" Then
        strResource = "\\" & Environ$("COMPUTERNAME") & "\IPC$"
    ElseIf InStr(strResource, "\") = 0 Then
        strResource = "\\" & strResource & "\IPC$"
    ElseIf Left(strResource, 2) <> "\\" Then
        strResource = "\\" & strResource
    ElseIf InStr(Mid(strResource, 3), "\") = 0 Then
        strResource = strResource & "\IPC$"
    End If

    'ネットワークリソース設定
    With tpNetResource
        .dwType = RESOURCETYPE_DISK             'リソースタイプ
        .lpLocalName = vbNullString             'ローカル名（割り当てるドライブ）
        .lpRemoteName = strResource             'リモートパス（要はサーバ等の共用パス）
        .dwScope = RESOURCE_CONNECTED
        .dwDisplayType = RESOURCEDISPLAYTYPE_SHARE
    End With

    '次回ログオン時に再接続しない場合
    lngRet = WNetAddConnection2(tpNetResource, strPass, strUser, 0)

    NetConnect = lngRet

End Function
Public Function NetClose(ByVal strResource As String) As Long

    Dim lngRet As Long

    '接続先文字列整形
    If strResource = "" Then
        strResource = "\\" & Environ$("COMPUTERNAME") & "\IPC$"
    ElseIf InStr(strResource, "\") = 0 Then
        strResource = "\\" & strResource & "\IPC$"
    ElseIf Left(strResource, 2) <> "\\" Then
        strResource = "\\" & strResource
    ElseIf InStr(Mid(strResource, 3), "\") = 0 Then
        strResource = strResource & "\IPC$"
    End If

    lngRet = WNetCancelConnection2(strResource, CONNECT_UPDATE_PROFILE, True)
    NetClose = lngRet

End Function
Public Function ConnectionError(lngRet As Long) As String

    Dim strRet As String

    Select Case lngRet
    Case ERROR_SUCCESS
        strRet = "正常終了"
    Case ERROR_BAD_NETPATH
        strRet = "ネットワークパスが不正"
    Case ERROR_ACCESS_DENIED
        strRet = "ネットワーク資源へのアクセスが拒否されました｡"
    Case ERROR_ALREADY_ASSIGNED
        strRet = "lpLocalName で指定したローカルデバイスは既にネットワーク資源に接続されています。"
    Case ERROR_BAD_DEV_TYPE
        strRet = "ローカルデバイスの種類とネットワーク資源の種類が一致しません｡"
    Case ERROR_BAD_DEVICE
        strRet = "lpLocalName で指定した値が無効です。"
    Case ERROR_BAD_NET_NAME
        strRet = "lpRemoteName で指定した値を、どのネットワーク資源のプロバイダも受け付けません。資源の名前が無効か、指定した資源が見つかりません。"
    Case ERROR_BAD_PROFILE
        strRet = "ユーザープロファイルの形式が正しくありません｡"
    Case ERROR_BAD_PROVIDER
        strRet = "lpProvider で指定した値がどのプロバイダとも一致しません。"
    Case ERROR_BUSY
        strRet = "ルーターまたはプロバイダがビジー（ おそらく初期化中）です。この関数をもう一度呼び出してください。"
    Case ERROR_CANCELLED
        strRet = "ネットワーク資源のプロバイダのいずれかでユーザーがダイアログボックスを使って接続操作を取り消したか､接続先の資源が接続操作を取り消しました｡"
    Case ERROR_CANNOT_OPEN_PROFILE
        strRet = "恒久的な接続を処理するためのユーザープロファイルを開くことができません｡"
    Case ERROR_DEVICE_ALREADY_REMEMBERED
        strRet = "lpLocalName で指定したデバイスのエントリは既にユーザープロファイル内に存在します。"
    Case ERROR_EXTENDED_ERROR
        strRet = "ネットワーク固有のエラーが発生しました。エラーの説明を取得するには、WNetGetLastError 関数を使います。"
    Case ERROR_INVALID_PASSWORD
        strRet = "指定したパスワードが無効です｡"
    Case ERROR_NO_NET_OR_BAD_PATH
        strRet = "ネットワークコンポーネントが開始されていないか､指定した名前が利用できないために､操作を行えませんでした｡"
    Case ERROR_NO_NETWORK
        strRet = "ネットワークに接続されていません｡"
    Case ERROR_DEVICE_IN_USE
        strRet = "指定したデバイスがアクティブなプロセスによって使用中のため､切断できません｡"
    Case ERROR_NOT_CONNECTED
        strRet = "lpName パラメータで指定した名前がリダイレクトされているデバイスを表していないか、lpName で指定したデバイスにシステムが接続していません。"
    Case ERROR_OPEN_FILES
        strRet = "開いているファイルがあり、fForce が FALSE です。"
    End Select
    ConnectionError = strRet

End Function
Sub testGetShareEnum()

    Dim strArry() As String
    Dim i As Long

    strArry = GetShareEnum("PCName", "User1", "Pass1", 0)

    For i = 0 To UBound(strArry)
        Debug.Print strArry(i)
    Next i

End Sub
Public Function GetShareEnum(strServer As String, strUser As String, strPass As String, Optional lngShareType As Long = -1) As String()

    Dim bufptr          As Long
    Dim dwServer        As Long
    Dim dwEntriesread   As Long
    Dim dwTotalentries  As Long
    Dim dwResumehandle  As Long
    Dim lngRet          As Long
    Dim nSize           As Long
    Dim i               As Long
    Dim tpShareInfo2    As SHARE_INFO_2
    Dim tpShareInfo0    As SHARE_INFO_0
    Dim tpShareInfo1    As SHARE_INFO_1
    Dim strIP           As String
    Dim strTmp()        As String

    'IPで接続
    strIP = GetIpAddress(strServer)

    '接続
    lngRet = NetConnect(strIP & "\IPC$", strUser, strPass)
    If lngRet <> ERROR_SUCCESS Then
        MsgBox "Error:NetConnect " & CStr(lngRet) & vbCrLf & ConnectionError(lngRet), vbCritical
        Exit Function
    End If

    '共有リソース列挙
    dwServer = StrPtr(strIP)
    lngRet = NetShareEnum(dwServer, _
                            1, _
                            bufptr, _
                            MAX_PREFERRED_LENGTH, _
                            dwEntriesread, _
                            dwTotalentries, _
                            dwResumehandle)

    If lngRet = NERR_SUCCESS And lngRet <> ERROR_MORE_DATA Then
        nSize = LenB(tpShareInfo1)
        'ReDim strTmp(dwEntriesread - 1) As String
        For i = 0 To dwEntriesread - 1
            CopyMemory tpShareInfo1, ByVal bufptr + (nSize * i), nSize


            If lngShareType = -1 Then
                If Sgn(strTmp) = 0 Then
                    ReDim strTmp(0) As String
                Else
                    ReDim Preserve strTmp(UBound(strTmp) + 1) As String
                End If
                strTmp(UBound(strTmp)) = GetPointerToByteStringW(tpShareInfo1.shi1_netname)
            Else
                If tpShareInfo1.shi1_type = lngShareType Then
                    If Sgn(strTmp) = 0 Then
                        ReDim strTmp(0) As String
                    Else
                        ReDim Preserve strTmp(UBound(strTmp) + 1) As String
                    End If
                    strTmp(UBound(strTmp)) = GetPointerToByteStringW(tpShareInfo1.shi1_netname)

                End If
            End If



        Next
    End If

    Call NetApiBufferFree(bufptr)

    lngRet = NetClose(strIP & "\IPC$")
    If lngRet <> ERROR_SUCCESS Then
        MsgBox "Error:NetClose " & CStr(lngRet) & vbCrLf & ConnectionError(lngRet), vbCritical
        Exit Function
    End If

    GetShareEnum = strTmp


End Function
Sub testGetFileEnum()

    Dim strArry() As String
    Dim i As Long

    strArry = GetFileEnum(vbNullString, "User1", "Pass1", 0)

    For i = 0 To UBound(strArry)
        Debug.Print strArry(i)
    Next i

End Sub

Public Function GetFileEnum(strServer As String, strUser As String, strPass As String, Optional lngShareType As Long = -1) As String()

    Dim bufptr          As Long
    Dim dwServer        As Long
    Dim dwEntriesread   As Long
    Dim dwTotalentries  As Long
    Dim dwResumehandle  As Long
    Dim lngRet          As Long
    Dim nSize           As Long
    Dim i               As Long
    Dim strIP           As String
    Dim strTmp()        As String
    Dim tpFileInfo3     As FILE_INFO_3


    If strServer <> vbNullString And strServer <> Environ$("COMPUTERNAME") Then
        'IPで接続
        strIP = GetIpAddress(strServer)

        '接続
        lngRet = NetConnect(strIP, strUser, strPass)
        If lngRet <> ERROR_SUCCESS Then
            MsgBox "Error:NetConnect " & CStr(lngRet) & vbCrLf & ConnectionError(lngRet), vbCritical
            Exit Function
        End If
    End If

    '共有リソース列挙
    dwServer = StrPtr(strIP)
    nSize = LenB(tpFileInfo3)
    lngRet = NetFileEnum(dwServer, _
                         0&, _
                         0&, _
                         3, _
                         bufptr, _
                         MAX_PREFERRED_LENGTH, _
                         dwEntriesread, _
                         dwTotalentries, _
                         dwResumehandle)

    If lngRet = NERR_SUCCESS And lngRet <> ERROR_MORE_DATA Then
        ReDim strTmp(dwEntriesread - 1) As String
        For i = 0 To dwEntriesread - 1
            CopyMemory tpFileInfo3, ByVal bufptr + (nSize * i), nSize
            strTmp(i) = GetPointerToByteStringW(tpFileInfo3.fi3_username) & vbTab & _
                        GetPermissionType(tpFileInfo3.fi3_permissions) & vbTab & _
                        GetPointerToByteStringW(tpFileInfo3.fi3_pathname)
        Next
    End If


    Call NetApiBufferFree(bufptr)

    If strServer <> vbNullString And strServer <> Environ$("COMPUTERNAME") Then
        lngRet = NetClose(strIP)
        If lngRet <> ERROR_SUCCESS Then
            MsgBox "Error:NetClose " & CStr(lngRet) & vbCrLf & ConnectionError(lngRet), vbCritical
            Exit Function
        End If
    End If
    GetFileEnum = strTmp


End Function


'cmdExecute
'txtServer
'cmbShare
'txtUser
'txtPass
'lstAccess
'cmdShareGet
'Label1
'Label2
'Label3
'Label4
'Label5
'cmdSaveSetting


VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} UserForm1
   Caption         =   "UserForm1"
   ClientHeight    =   6885
   ClientLeft      =   45
   ClientTop       =   390
   ClientWidth     =   6930
   OleObjectBlob   =   "UserForm1.frx":0000
   StartUpPosition =   1  'オーナー フォームの中央
End
Attribute VB_Name = "UserForm1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Const ADDR_SERVER = "B2"
Private Const ADDR_USER = "B4"
Private Const ADDR_SHARE = "B5"
Private Sub CommandButton1_Click()
    Unload Me
    Application.Quit

End Sub

Private Sub cmdExecute_Click()

    Dim strTmp() As String
    Dim i As Long

    strTmp = GetFileEnum(txtServer.Value, txtUser.Value, txtPass.Value)

    For i = 0 To UBound(strTmp)
        lstAccess.AddItem strTmp(i)
    Next i

End Sub

Private Sub cmdSaveSetting_Click()

    Dim i As Long

    With ThisWorkbook.Worksheets("Setting")
        .Range(ADDR_SERVER).Value = txtServer.Value
        .Range(ADDR_USER).Value = txtUser.Value
        For i = 0 To cmbShare.ListCount - 1
            .Range(ADDR_SHARE).Offset(i, 0).Value = cmbShare.List(i)
        Next i
    End With

End Sub

Private Sub cmdShareGet_Click()

    Dim strTmp() As String
    Dim i As Long

    strTmp = GetShareEnum(txtServer.Value, txtUser.Value, txtPass.Value)
    cmbShare.Clear
    For i = 0 To UBound(strTmp)
        cmbShare.AddItem strTmp(i)
    Next i


End Sub


Private Sub UserForm_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

    If GetAsyncKeyState(vbKeyControl) Then
        cmdSaveSetting.Visible = True
    End If


End Sub

Private Sub UserForm_Initialize()

    Dim i As Long
    With ThisWorkbook.Worksheets("Setting")
        txtServer.Value = .Range(ADDR_SERVER).Value
        txtUser.Value = .Range(ADDR_USER).Value
        cmbShare.Clear
        If .Range(ADDR_SHARE).Value <> "" Then
            Do While .Range(ADDR_SHARE).Offset(i, 0).Value <> ""
                cmbShare.AddItem .Range(ADDR_SHARE).Offset(i, 0).Value
                i = i + 1
            Loop
        End If
    End With

End Sub

Private Sub UserForm_Terminate()

    If GetAsyncKeyState(vbKeyControl) Then
        Application.Visible = True
    Else
        Application.Quit
    End If

End Sub