VB程序员博客

Private Declare Function RtlMoveMemory Lib "kernel32.dll" (Destination As Any, Source As Any, ByRef Length As Long)
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
Private Declare Function NetApiBufferFree Lib "NETAPI32.DLL" (Buffer As Any) As Long
Private Type USER_INFO_0
    usri0_name As Long
End Type
Dim lngWin32apiResultCode As Long
    Dim strServerName        As String
    Dim lngBufPtr As Long
    Dim lngMaxLen            As Long
    Dim lngEntriesRead        As Long
    Dim lngTotalEntries      As Long
    Dim lngResumeHandle      As Long
    Dim udtUserInfo0 As USER_INFO_0
    Dim lngEntry              As Long

Private Sub Command1_Click()
        strServerName = StrConv("", vbUnicode)
    Do
        lngWin32apiResultCode = NetUserEnum(strServerName, 0, 0, lngBufPtr, lngMaxLen, lngEntriesRead, lngTotalEntries, lngResumeHandle)
        If (lngWin32apiResultCode = NERR_Success) Or (lngWin32apiResultCode = ERROR_MORE_DATA) Then
            For lngEntry = 0 To lngEntriesRead - 1
                RtlMoveMemory udtUserInfo0, ByVal lngBufPtr + Len(udtUserInfo0) * lngEntry, Len(udtUserInfo0)
                cboUsers.AddItem PointerToString(udtUserInfo0.usri0_name)
            Next
        End If
        If lngBufPtr <> 0 Then
            NetApiBufferFree lngBufPtr
        End If
    Loop Until lngEntriesRead = lngTotalEntriesEnd Sub

如果这个函数用不了，那换一个也行，只要能enum到所有用户就行

外接程序->外接程序管理器->Component Serverices Add-In For VB5.0/6.0中选择“在启动中加载 ”和“加载卸载”项
试一下

楼上说的已经是加载的呀

程序运行好 RtlMoveMemory 这个程序段就错误

Private Declare Function NetUserEnum Lib "netapi32.dll" (ByVal ServerName As String, ByVal Level As Long, ByVal filter As Long, bufptr As Any, ByVal prefmaxlen As Long, entriesread As Long, totalentries As Long, resume_handle As Long) As Long
Private Declare Function RtlMoveMemory Lib "kernel32.dll" (Destination As Any, Source As Any, ByRef Length As Long)
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
Private Declare Function NetApiBufferFree Lib "netapi32.dll" (Buffer As Any) As Long
Private Type USER_INFO_0
    usri0_name As Long
End Type
Dim lngWin32apiResultCode As Long
    Dim strServerName        As String
    Dim lngBufPtr As Long
    Dim lngMaxLen            As Long
    Dim lngEntriesRead        As Long
    Dim lngTotalEntries      As Long
    Dim lngResumeHandle      As Long
    Dim udtUserInfo0 As USER_INFO_0
    Dim lngEntry              As Long

Private Sub Command1_Click()
        strServerName = StrConv("", vbUnicode)
    Do
        lngWin32apiResultCode = NetUserEnum(strServerName, 0, 0, lngBufPtr, lngMaxLen, lngEntriesRead, lngTotalEntries, lngResumeHandle)
        If (lngWin32apiResultCode = NERR_Success) Or (lngWin32apiResultCode = ERROR_MORE_DATA) Then
            For lngEntry = 0 To lngEntriesRead - 1
                RtlMoveMemory udtUserInfo0, ByVal lngBufPtr + Len(udtUserInfo0) * lngEntry, Len(udtUserInfo0)
                cboUsers.AddItem PointerToString(udtUserInfo0.usri0_name)
            Next
        End If
        If lngBufPtr <> 0 Then
            NetApiBufferFree lngBufPtr
        End If
      Loop Until lngEntriesRead = lngTotalEntries
End Sub

Function PointerToString(lngPointer As Long) As String
''把返回的ASCII代码转换成字符
  Dim bytBuffer(255) As Byte   
    lstrcpy bytBuffer(0), ByVal lngPointer
    PointerToString = Left$(bytBuffer, lstrlen(lngPointer))
End Function

提示缺少PointerToString这个函数未定义

我在网上找了一个PointerToString函数 ，结果还不行