| Вопрос: Локальная сеть ХР, получить название компов | Добавлено: 01.04.05 13:44 |
Автор вопроса:  alexfor
|
|
Помогите, кто знает как выйти из ситуации, есть програмный код для получения списка компов в локальной сети. Под 98 все нормально, а под ХР загружаются рабочие группы. Как их обойти? Заранее благодарен!
Код: 'Модуль Option Explicit Dim Hostent_Addr As Long, Host As HOSTENT, Hostip_addr As Long, Temp_ip_address() As Byte, i As Integer, strWinsockNotResponding As Long, CompInLan As String, CompInLanIP As String Private Declare Function WNetOpenEnum Lib "mpr.dll" Alias "WNetOpenEnumA" (ByVal dwScope As Long, ByVal dwType As Long, ByVal dwUsage As Long, lpNetResource As Any, lphEnum As Long) As Long Private Declare Function WNetEnumResource Lib "mpr.dll" Alias "WNetEnumResourceA" (ByVal hEnum As Long, lpcCount As Long, ByVal lpBuffer As Long, lpBufferSize As Long) As Long Private Declare Function WNetCloseEnum Lib "mpr.dll" (ByVal hEnum As Long) As Long Private Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long Private Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal wVersionRequired&, lpWSAData As WSADATA) As Long Private Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal hostname$) As Long Private Declare Sub RtlMoveMemory Lib "KERNEL32" (hpvDest As Any, ByVal hpvSource&, ByVal cbCopy As Long) Private Declare Function GlobalAlloc Lib "KERNEL32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long Private Declare Function GlobalFree Lib "KERNEL32" (ByVal hMem As Long) As Long Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long) Private Declare Function CopyPointer2String Lib "KERNEL32" Alias "lstrcpyA" (ByVal NewString As String, ByVal OldString As Long) As Long 'Public Declare Function NetLocalGroupDelMembers Lib "netapi32.dll" (ByVal psServer As Long, ByVal psLocalGroup As Long, ByVal lLevel As Long, uMember As LOCALGROUP_MEMBERS_INFO_0, ByVal lMemberCount As Long) As Long 'Public Declare Function NetLocalGroupGetMembers Lib "netapi32.dll" (ByVal psServer As Long, ByVal psLocalGroup As Long, ByVal lLevel As Long, pBuffer As Long, ByVal lMaxLength As Long, plEntriesRead As Long, plTotalEntries As Long, phResume As Long) As Long Private Declare Function GetComputerName Lib "kernel32.dll" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long Private Const RESOURCE_CONNECTED = &H1 Private Const RESOURCE_GLOBALNET = &H2 Private Const RESOURCE_REMEMBERED = &H3 Private Const RESOURCETYPE_ANY = &H0 Private Const RESOURCETYPE_DISK = &H1 Private Const RESOURCETYPE_PRINT = &H2 Private Const RESOURCETYPE_UNKNOWN = &HFFFF Private Const RESOURCEUSAGE_CONNECTABLE = &H1 Private Const RESOURCEUSAGE_CONTAINER = &H2 Private Const RESOURCEUSAGE_RESERVED = &H80000000 Private Const GMEM_FIXED = &H0 Private Const GMEM_ZEROINIT = &H40 Private Const GPTR = (GMEM_FIXED Or GMEM_ZEROINIT) Private Const WS_VERSION_REQD = &H101 Private Const WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF& Private Const WS_VERSION_MINOR = WS_VERSION_REQD And &HFF& Private Const MIN_SOCKETS_REQD = 1 Private Const SOCKET_ERROR = -1 Private Const WSADescription_Len = 256 Private Const WSASYS_Status_Len = 128 Private Const RESOURCEDISPLAYTYPE_GROUP = &H5 Private 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 Private Type HOSTENT hName As Long hAliases As Long hAddrType As Integer hLength As Integer hAddrList As Long End Type Private Type WSADATA wversion As Integer wHighVersion As Integer szDescription(0 To WSADescription_Len) As Byte szSystemStatus(0 To WSASYS_Status_Len) As Byte iMaxSockets As Integer iMaxUdpDg As Integer lpszVendorInfo As Long End Type 'Private Type LOCALGROUP_MEMBERS_INFO_0 ' pSID As Long 'End Type Function hibyte(ByVal wParam As Integer) On Error Resume Next DoEvents hibyte = wParam \ &H100 And &HFF& DoEvents End Function Function lobyte(ByVal wParam As Integer) On Error Resume Next DoEvents lobyte = wParam And &HFF& DoEvents End Function Public Sub DoNetEnum() On Error Resume Next DoEvents Dim hEnum As Long, LPBuff As Long, NR As NETRESOURCE Dim cbBuff As Long, cCount As Long Dim p As Long, res As Long, i As Long NR.lpRemoteName = 0 cbBuff = 10000 cCount = &HFFFFFFFF DoEvents res = WNetOpenEnum(RESOURCE_GLOBALNET, 0, 0, NR, hEnum) If res = 0 Then LPBuff = GlobalAlloc(GPTR, cbBuff) res = WNetEnumResource(hEnum, cCount, LPBuff, cbBuff) If res = 0 Then p = LPBuff For i = 1 To cCount DoEvents CopyMemory NR, ByVal p, LenB(NR) DoNetEnum2 NR p = p + LenB(NR) DoEvents Next i End If DoEvents If LPBuff <> 0 Then GlobalFree (LPBuff) WNetCloseEnum (hEnum) End If End Sub Public Function PointerToString(p As Long) As String On Error Resume Next DoEvents Dim s As String s = String(255, Chr$(0)) DoEvents CopyPointer2String s, p PointerToString = Left(s, InStr(s, Chr$(0)) - 1) DoEvents End Function Public Sub DoNetEnum2(NR As NETRESOURCE) On Error Resume Next DoEvents Dim hEnum As Long, LPBuff As Long Dim cbBuff As Long, cCount As Long Dim p As Long, res As Long, i As Long, pSID As Long cbBuff = 10000 cCount = &HFFFFFFFF res = WNetOpenEnum(RESOURCE_GLOBALNET, 0, 0, NR, hEnum) DoEvents If res = 0 Then LPBuff = GlobalAlloc(GPTR, cbBuff) res = WNetEnumResource(hEnum, cCount, LPBuff, cbBuff) If res = 0 Then p = LPBuff For i = 1 To cCount DoEvents CopyMemory NR, ByVal p, LenB(NR) CompInLan = Right(PointerToString(NR.lpRemoteName), Len(PointerToString(NR.lpRemoteName)) - 2) p = p + LenB(NR) ' Загрузка ListView Dim Item As ListItem Set Item = frmMain.List1.ListItems.Add(, , CompInLan, , 1) DoEvents Next i End If If LPBuff <> 0 Then GlobalFree (LPBuff) WNetCloseEnum (hEnum) DoEvents End If DoEvents End Sub Public Function CompName() As String On Error Resume Next Dim Retval As Long CompName = Space(255) Retval = GetComputerName(CompName, 255) CompName = RTrim(CompName) If InStr(1, CompName, Chr(0), vbBinaryCompare) <> 0 Then CompName = Replace(CompName, Chr(0), "", 1) End If End Function ‘Событие Form_Load - Получение списка компьютеров локальной сети в ListView Private Sub Form_Load() DoNetEnum Dim clm As ColumnHeader Set clm = List1.ColumnHeaders.Add(1, "Компов в сети - ", , 3000, 0, 2) Dim s As String s = List1.ColumnHeaders(1).Text s = "Компов в сети - " List1.ColumnHeaders(1).Text = s & " " & List1.ListItems.Count List1.View = lvwReport End Sub |
| Ответы | Всего ответов: 23 |
|
Номер ответа: 1 Автор ответа:  Alexandrus ICQ: 496782368 Вопросов: 18 Ответов: 312 |
Web-сайт: Профиль | | #1 | Добавлено: 02.04.05 19:23 |
|
Есть пример обзора компов в сети работающий и под XP.
Показывает Имя,IP,комментарий. eMail давай! С ув. Alex |
||
|
Номер ответа: 2 Автор ответа: alexfor Вопросов: 28 Ответов: 68 |
Профиль | | #2 | Добавлено: 02.04.05 21:17 |
|
Привет теска! Огромное спасибо за отзыв и помощь.Мой адрес:alexformail@list.ru
С уважением Alex |
||
|
Номер ответа: 3 Автор ответа:  AlexandrusICQ: 496782368 Вопросов: 18 Ответов: 312 |
Web-сайт: Профиль | | #3 | Добавлено: 02.04.05 21:47 |
|
Мыльце проверь!
С ув. Alex |
||
|
Номер ответа: 4 Автор ответа:  Andrey999ICQ: 30852361 Вопросов: 73 Ответов: 168 |
Web-сайт: Профиль | | #4 | Добавлено: 03.04.05 01:05 |
| А в домене работать будет? Скинь мне тоже этот пример craigs@mail.ru | ||
|
Номер ответа: 5 Автор ответа: Morpheus Вопросов: 224 Ответов: 3777 |
Web-сайт: Профиль | | #5 | Добавлено: 03.04.05 02:36 |
| я тоже хочу!!!!!!!!!!!!! privmail[собака]nm.ru !!! | ||
|
Номер ответа: 6 Автор ответа: AlexandrusICQ: 496782368 Вопросов: 18 Ответов: 312 |
Web-сайт: Профиль | | #6 | Добавлено: 03.04.05 10:33 |
|
Andrey999 & Morpheus проверяют почту !
С ув. Alex |
||
|
Номер ответа: 7 Автор ответа: GlooMICQ: 348453688 Вопросов: 88 Ответов: 356 |
Web-сайт: Профиль | | #7 | Добавлено: 03.04.05 12:43 |
| root@vbland.net!!!! | ||
|
Номер ответа: 8 Автор ответа: AlexandrusICQ: 496782368 Вопросов: 18 Ответов: 312 |
Web-сайт: Профиль | | #8 | Добавлено: 03.04.05 14:44 |
|
Eug: Уже что-ли почту проверь !
С ув. Alex |
||
|
Номер ответа: 9 Автор ответа: АлександрРазработчик Offline Client ICQ: 204034 Вопросов: 106 Ответов: 1919 |
Профиль | | #9 | Добавлено: 04.04.05 09:20 |
alexander@vbnet.ru !!!  )
|
||
|
Номер ответа: 10 Автор ответа: KAMICQ: 190197618 Вопросов: 25 Ответов: 97 |
Профиль | | #10 | Добавлено: 04.04.05 18:08 |
| Блин, киньте и мне пожалуйста: kam-unfcl@yandex.ru | ||
|
Номер ответа: 11 Автор ответа: AlexandrusICQ: 496782368 Вопросов: 18 Ответов: 312 |
Web-сайт: Профиль | | #11 | Добавлено: 04.04.05 21:57 |
|
Alexandr & KAM - OK !
С ув. Alex |
||
|
Номер ответа: 12 Автор ответа: AgentFireICQ: 192496851 Вопросов: 75 Ответов: 3178 |
Профиль | | #12 | Добавлено: 04.04.05 22:02 |
|
Привет теска!
Привет! alexandrus, было бы очень неплохо поиметь программку такого типа, даже ее саму, поэтому не составит ли Вам труда кидануть мне ее на мыло?
[mailto:NoviksPlavnik@mail.ru] С ув. Noviks |
||
|
Номер ответа: 13 Автор ответа:  AlexandrusICQ: 496782368 Вопросов: 18 Ответов: 312 |
Web-сайт: Профиль | | #13 | Добавлено: 04.04.05 22:06 |
|
Послал в раздел 'Примеры'.
С увю Alex. |
||
|
Номер ответа: 14 Автор ответа: AlexandrusICQ: 496782368 Вопросов: 18 Ответов: 312 |
Web-сайт: Профиль | | #14 | Добавлено: 04.04.05 22:11 |
|
Noviks ищи в почте !
С ув. Alex |
||
|
Номер ответа: 15 Автор ответа: AgentFireICQ: 192496851 Вопросов: 75 Ответов: 3178 |
Профиль | | #15 | Добавлено: 04.04.05 22:33 |
|
Пасиба огромное!
С ув. Noviks |
||