Страница: 1 | 2 |
|
Вопрос: Имя дисков в сети.
|
Добавлено: 18.01.09 13:58
|
|
Автор вопроса: Aston | ICQ: 214-179-991
|
Привет всем.
Тут возник непредвиденноя проблема у меня. Есть компьютеры в сети, при открытии определённых дисков для сети, им могут присваиваться сетевые имена. Можно ли как то узнать имена этих дисков в сети. И какое имя каждый открытый диск данного компьютера имеет в сети?
Ответить
|
Номер ответа: 6 Автор ответа: Smith
ICQ: adamis@list.ru
Вопросов: 153 Ответов: 3632
|
Профиль | | #6
|
Добавлено: 20.01.09 22:00
|
Вот те рабочий примерчик, просто скопируй и вставь в новый проект, на форму брось пару лэбэлов, листбокс и батон
- Option Explicit
- Private Const MAX_PREFERRED_LENGTH As Long = -1
- Private Const NERR_SUCCESS As Long = 0&
- Private Const ERROR_MORE_DATA As Long = 234&
- Private Const LB_SETTABSTOPS As Long = &H192
-
- Private Const SV_TYPE_ALL As Long = &HFFFFFFFF
- Private Const SV_TYPE_WORKSTATION As Long = &H1
- Private Const SV_TYPE_SERVER As Long = &H2
-
- Private Const STYPE_ALL As Long = -1
- Private Const STYPE_DISKTREE As Long = 0
- Private Const STYPE_PRINTQ As Long = 1
- Private Const STYPE_DEVICE As Long = 2
- Private Const STYPE_IPC As Long = 3
- Private Const STYPE_SPECIAL As Long = &H80000000
- Private Const ACCESS_READ As Long = &H1
- Private Const ACCESS_WRITE As Long = &H2
- Private Const ACCESS_CREATE As Long = &H4
- Private Const ACCESS_EXEC As Long = &H8
- Private Const ACCESS_DELETE As Long = &H10
- Private Const ACCESS_ATRIB As Long = &H20
- Private Const ACCESS_PERM As Long = &H40
- Private 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
- Private Type SERVER_INFO_100
- sv100_platform_id As Long
- sv100_name As Long
- End Type
-
- Private 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
-
- Private 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
-
- Private 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
-
- Private Declare Function NetApiBufferFree Lib "netapi32" _
- (ByVal Buffer As Long) As Long
-
- Private Declare Sub CopyMemory Lib "kernel32" _
- Alias "RtlMoveMemory" _
- (pTo As Any, uFrom As Any, _
- ByVal lSize As Long)
-
- Private Declare Function lstrlenW Lib "kernel32" _
- (ByVal lpString As Long) As Long
-
- Private Declare Function SendMessage Lib "user32" _
- Alias "SendMessageA" _
- (ByVal hwnd As Long, _
- ByVal wMsg As Long, _
- ByVal wParam As Long, _
- lParam As Any) As Long
-
-
- Private Sub Form_Load()
-
- ReDim TabArray(0 To 4) As Long
-
- TabArray(0) = 73
- TabArray(1) = 125
- TabArray(2) = 151
- TabArray(3) = 232
-
-
-
- Call SendMessage(List1.hwnd, LB_SETTABSTOPS, 0&, ByVal 0&)
- Call SendMessage(List1.hwnd, LB_SETTABSTOPS, 4&, TabArray(0))
- List1.Refresh
-
- Command1.Caption = "Net Share Enum"
- Label1.Caption = "call success (0) or error :"
- Label2.Caption = ""
-
- End Sub
-
-
- Private Sub Command1_Click()
-
- Dim bufptr As Long
- Dim dwServer As Long
- Dim dwEntriesread As Long
- Dim dwTotalentries As Long
- Dim dwResumehandle As Long
- Dim success As Long
- Dim nStructSize As Long
- Dim cnt As Long
- Dim usrname As String
- Dim bServer As String
- Dim shi2 As SHARE_INFO_2
-
-
- bServer = "\\" & Environ$("COMPUTERNAME") & vbNullString
-
-
- dwServer = StrPtr(bServer)
-
- success = NetShareEnum(dwServer, _
- 2, _
- bufptr, _
- MAX_PREFERRED_LENGTH, _
- dwEntriesread, _
- dwTotalentries, _
- dwResumehandle)
-
- List1.Clear
- Label2.Caption = success
-
- If success = NERR_SUCCESS And _
- success <> ERROR_MORE_DATA Then
-
- nStructSize = LenB(shi2)
-
- For cnt = 0 To dwEntriesread - 1
-
-
-
-
- CopyMemory shi2, ByVal bufptr + (nStructSize * cnt), nStructSize
-
- List1.AddItem GetPointerToByteStringW(shi2.shi2_netname) & vbTab & _
- GetConnectionType(shi2.shi2_type) & vbTab & _
- GetConnectionPermissions(shi2.shi2_permissions) & vbTab & _
- GetPointerToByteStringW(shi2.shi2_remark) & vbTab & _
- GetPointerToByteStringW(shi2.shi2_path)
-
- Next
-
- End If
-
- Call NetApiBufferFree(bufptr)
-
- End Sub
-
-
- Private Function GetConnectionPermissions(ByVal dwPermissions As Long) As String
-
-
-
-
-
-
- Dim tmp As String
-
- If (dwPermissions And ACCESS_READ) Then tmp = tmp & "R"
- If (dwPermissions And ACCESS_WRITE) Then tmp = tmp & " W"
- If (dwPermissions And ACCESS_CREATE) Then tmp = tmp & " C"
- If (dwPermissions And ACCESS_DELETE) Then tmp = tmp & " D"
- If (dwPermissions And ACCESS_EXEC) Then tmp = tmp & " E"
- If (dwPermissions And ACCESS_ATRIB) Then tmp = tmp & " A"
- If (dwPermissions And ACCESS_PERM) Then tmp = tmp & " P"
-
- If Len(tmp) = 0 Then tmp = "n/a"
-
- GetConnectionPermissions = tmp
-
-
- End Function
-
-
- Private Function GetConnectionType(ByVal dwConnectType As Long) As String
-
-
- Select Case dwConnectType
- Case STYPE_DISKTREE: GetConnectionType = "disk drive"
- Case STYPE_PRINTQ: GetConnectionType = "print queue"
- Case STYPE_DEVICE: GetConnectionType = "communication device"
- Case STYPE_IPC: GetConnectionType = "ipc"
- Case STYPE_SPECIAL: GetConnectionType = "administrative"
- Case Else
-
-
-
-
- Select Case (dwConnectType Xor STYPE_SPECIAL)
- Case STYPE_IPC: GetConnectionType = "ipc"
- Case Else: GetConnectionType = "undefined"
- End Select
-
- End Select
-
- End Function
-
-
- Public Function GetPointerToByteStringW(ByVal dwData As Long) As String
-
- Dim tmp() As Byte
- Dim tmplen As Long
-
- If dwData <> 0 Then
-
- tmplen = lstrlenW(dwData) * 2
-
- If tmplen <> 0 Then
-
- ReDim tmp(0 To (tmplen - 1)) As Byte
- CopyMemory tmp(0), ByVal dwData, tmplen
- GetPointerToByteStringW = tmp
-
- End If
-
- End If
-
- End Function
Взято отсюда
http://vbnet.mvps.org/index.html?code/network/netconnectionenum.htm
Ответить
|
Номер ответа: 10 Автор ответа: Aston
ICQ: 214-179-991
Вопросов: 42 Ответов: 272
|
Профиль | | #10
|
Добавлено: 22.01.09 22:12
|
Переработал твой кодик в Net Share Enum.
с 2 лэбэлами, кнопкой и списком
Если сможеш то подскажи можно ли как то указать диск и чтоб это АПИ выдало мне имя Shar или это АПИ всегда выбивает весь список и с него просто надо выбирать то что надо?
- Option Explicit
-
-
- Private Const MAX_PREFERRED_LENGTH As Long = -1
- Private Const NERR_SUCCESS As Long = 0&
- Private Const ERROR_MORE_DATA As Long = 234&
- Private Const LB_SETTABSTOPS As Long = &H192
-
- Private Const SV_TYPE_ALL As Long = &HFFFFFFFF
- Private Const SV_TYPE_WORKSTATION As Long = &H1
- Private Const SV_TYPE_SERVER As Long = &H2
-
- Private Const STYPE_ALL As Long = -1
- Private Const STYPE_DISKTREE As Long = 0
- Private Const STYPE_PRINTQ As Long = 1
- Private Const STYPE_DEVICE As Long = 2
- Private Const STYPE_IPC As Long = 3
- Private Const STYPE_SPECIAL As Long = &H80000000
- Private Const ACCESS_READ As Long = &H1
- Private Const ACCESS_WRITE As Long = &H2
- Private Const ACCESS_CREATE As Long = &H4
- Private Const ACCESS_EXEC As Long = &H8
- Private Const ACCESS_DELETE As Long = &H10
- Private Const ACCESS_ATRIB As Long = &H20
- Private Const ACCESS_PERM As Long = &H40
- Private 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
- Private Type SERVER_INFO_100
- sv100_platform_id As Long
- sv100_name As Long
- End Type
-
- Private 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
-
- Private 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
-
- Private Declare Function NetApiBufferFree Lib "netapi32" (ByVal Buffer As Long) As Long
-
- Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pTo As Any, uFrom As Any, ByVal lSize As Long)
-
- Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long
-
-
-
-
- Private Sub Form_Load()
-
- Command1.Caption = "Net Share Enum"
- Label1.Caption = "call success (0) or error :"
- Label2.Caption = ""
-
- End Sub
-
-
- Private Sub Command1_Click()
-
- Dim bufptr As Long
- Dim dwServer As Long
- Dim dwEntriesread As Long
- Dim dwTotalentries As Long
- Dim dwResumehandle As Long
- Dim success As Long
- Dim nStructSize As Long
- Dim cnt As Long
- Dim usrname As String
- Dim bServer As String
- Dim shi2 As SHARE_INFO_2
-
-
- bServer = "\\" & Environ$("COMPUTERNAME") & vbNullString
-
-
- dwServer = StrPtr(bServer)
-
- success = NetShareEnum(dwServer, 2, bufptr, MAX_PREFERRED_LENGTH, dwEntriesread, dwTotalentries, dwResumehandle)
-
- List1.Clear
- Label2.Caption = success
-
- If success = NERR_SUCCESS And success <> ERROR_MORE_DATA Then
-
- nStructSize = LenB(shi2)
-
- For cnt = 0 To dwEntriesread - 1
-
-
-
-
- CopyMemory shi2, ByVal bufptr + (nStructSize * cnt), nStructSize
-
- List1.AddItem GetPointerToByteStringW(shi2.shi2_netname) & vbTab & GetPointerToByteStringW(shi2.shi2_path)
-
- Next
-
- End If
-
- Call NetApiBufferFree(bufptr)
-
- End Sub
-
-
- Public Function GetPointerToByteStringW(ByVal dwData As Long) As String
-
- Dim tmp() As Byte
- Dim tmplen As Long
-
- If dwData <> 0 Then
-
- tmplen = lstrlenW(dwData) * 2
-
- If tmplen <> 0 Then
-
- ReDim tmp(0 To (tmplen - 1)) As Byte
- CopyMemory tmp(0), ByVal dwData, tmplen
- GetPointerToByteStringW = tmp
-
- End If
-
- End If
-
- End Function
-
Ответить
|
Номер ответа: 15 Автор ответа: Aston
ICQ: 214-179-991
Вопросов: 42 Ответов: 272
|
Профиль | | #15
|
Добавлено: 25.01.09 12:37
|
Как имя диска добавлять и имя сетевое, если диск расшарен я понял.
- Dim FSO As Object, Drives As Object, Drive As Object
-
- Private Sub Command1_Click()
-
- Set FSO = CreateObject("Scripting.FileSystemObject")
-
- Set Drives = FSO.Drives
-
- For Each Drive In Drives
- List1.AddItem Drive & vbtzb & Drive.ShareName
- Next
- Set FSO = Nothing
- End Sub
Но можно ли как то тут выбрать определённый диск и чтобы оно выдало мне сетевое имя, если оно есть, я не нашёл как.
Пытался
Drive = ":"
не катит)
Это конешно спасает моё положение, но хотелось бы получше разобраться и с одним димком вообще мароки у меня не будет.
А на счёт того АПИ NetShareEnum я смотрел, тоже привёл к тому что возврашает диски в список и ShareName, но там есть одно но. Если диск не расшарен, пишет просто название диска без двоеточия и не определить расшарин он или нет. А на счёт того как в той АПИ сделать так, чтоб возврашало по определённому диску, я чуть посмотрел, но потом бросил это дкло, так как моих знаний в АПИ для этого мало и оно там по дискам возврашает числовые значения, которые потом переводят в слова и там столько всякого, что я этим гиблым делом даже не занимался.
Этот твой пример с FSO по проще, хотя я первый раз с этим сталкиваюсь, но тут хоть понятно что ты делаешь и всё наглядно и просто. Единственное что не понял можно ли как по определённому диску узнавать)
Ответить
|
Страница: 1 | 2 |
Поиск по форуму