17. august 2004 - 09:34
#2
Det kan den godt. Eksemplet her andvender mixed mode:
Modul (Grupper):
Option Compare Database
Option Explicit
Private Declare Function LStrCpy Lib "kernel32" (ByVal Dest As String, ByVal Source As Any) As Integer
'Network
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function NetGetDCName Lib "NETAPI32.DLL" (ServerName As Any, DomainName As Any, DCNPtr As Long) As Long
Private Declare Function NetUserGetInfo Lib "NETAPI32.DLL" (ByVal server As String, ByVal userName As String, ByVal Level As Integer, Buffer As Any, ByVal cbBuffer As Integer, pcbTotal As Integer) As Integer
Private Declare Function NetUserGetGroups0 Lib "NETAPI32.DLL" Alias "NetUserGetGroups" (ServerName As Byte, userName As Byte, ByVal Level As Long, Buffer As Long, ByVal PrefMaxLen As Long, EntriesRead As Long, TotalEntries As Long) As Long
Private Declare Function NetApiBufferFree Lib "NETAPI32.DLL" (ByVal pBuffer As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function lstrlenA Lib "kernel32" (ByVal lpString As Long) As Long
Private Declare Function PtrToStr Lib "kernel32" Alias "lstrcpyW" (retval As Byte, ByVal Ptr As Long) As Long
Private Declare Function StrToPtr Lib "kernel32" Alias "lstrcpyW" (ByVal Ptr As Long, Source As Byte) As Long
Private Declare Function PtrToInt Lib "kernel32" Alias "lstrcpynW" (retval As Any, ByVal Ptr As Long, ByVal nCharCount As Long) As Long
Private Declare Function StrLen Lib "kernel32" Alias "lstrlenW" (ByVal Ptr As Long) As Long
Private Type MungeLong
X As Long
Dummy As Integer
End Type
Private Type MungeInt
XLo As Integer
XHi As Integer
Dummy As Integer
End Type
Private Declare Function GetVersionExA Lib "kernel32.dll" (lpVersionInformation As OSVERSIONINFO) As Integer
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Const winver9x As Integer = 1
Const winverNT As Integer = 2
Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (pTo As Any, uFrom As Any, ByVal lSize As Long)
Public Function listUserGroups(Groupname As String) As Boolean
listUserGroups = False
Dim Result As Long, BufPtr As Long, EntriesRead As Long
Dim TotalEntries As Long, ResumeHandle As Long, BufLen As Long
Dim SNArray() As Byte, GNArray(99) As Byte, UNArray() As Byte
Dim GName As String, i As Integer, UNPtr As Long
Dim TempPtr As MungeLong, TempStr As MungeInt
Dim DCName As String, UName As String
'get the name of a domain controller & the name of the user running us
DCName = GetPrimaryDCName()
UName = NT_User.Bruger7
SNArray = DCName & vbNullChar
UNArray = UName & vbNullChar
Result = NetUserGetGroups0(SNArray(0), UNArray(0), 0, BufPtr, -1, EntriesRead, TotalEntries)
If Result <> 0 And Result <> 234 Then ' 234 = more data; should never happen seeing as though we ask for all of it at once
MsgBox "Error " & Result & " enumerating group " & EntriesRead & " of " & TotalEntries
Exit Function
End If
For i = 1 To EntriesRead
Result = PtrToInt(TempStr.XLo, BufPtr + (i - 1) * 4, 2)
Result = PtrToInt(TempStr.XHi, BufPtr + (i - 1) * 4 + 2, 2)
LSet TempPtr = TempStr ' munge 2 Integers To a Long
'Copy string to array and convert to a string
Result = PtrToStr(GNArray(0), TempPtr.X)
GName = Left(GNArray, StrLen(TempPtr.X))
If GName = Groupname Then listUserGroups = True
Next i
Result = NetApiBufferFree(BufPtr) ' Don't leak memory
End Function
Function GetPrimaryDCName() As String
Dim Result As Long, DCName As String, DCNPtr As Long
Dim DCNArray(100) As Byte
Result = NetGetDCName(0&, 0&, DCNPtr)
If Result <> 0 Then
MsgBox "Unable to determine Domain Controller Name"
Exit Function
End If
Result = PtrToStr(DCNArray(0), DCNPtr)
Result = NetApiBufferFree(DCNPtr)
DCName = DCNArray()
GetPrimaryDCName = DCName
End Function
Modul (bruger):
Option Compare Text
Option Explicit
Option Base 0
Private Bruger As String
Type Bruger_Opl
navn As String
Banksted As String
End Type
Type WKSTA_INFO_101
wki101_platform_id As Long
wki101_computername As Long
wki101_langroup As Long
wki101_ver_major As Long
wki101_ver_minor As Long
wki101_lanroot As Long
End Type
Type WKSTA_USER_INFO_1
wkui1_username As Long
wkui1_logon_domain As Long
wkui1_logon_server As Long
wkui1_oth_domains As Long
End Type
Declare Function WNetGetUser& Lib "Mpr" Alias "WNetGetUserA" _
(lpName As Any, ByVal lpUserName$, lpnLength&)
Declare Function NetWkstaGetInfo& Lib "netapi32" _
(strServer As Any, ByVal lLevel&, pbBuffer As Any)
Declare Function NetWkstaUserGetInfo& Lib "netapi32" _
(reserved As Any, ByVal lLevel&, pbBuffer As Any)
Declare Sub lstrcpyW Lib "kernel32" (Dest As Any, ByVal src As Any)
Declare Sub LStrCpy Lib "kernel32" Alias "lstrcpy" (Dest As Any, ByVal src As Any)
Declare Sub RtlMoveMemory Lib "kernel32" _
(Dest As Any, src As Any, ByVal size&)
Declare Function NetApiBufferFree& Lib "netapi32" (ByVal Buffer&)
Private Function GetWorkstationInfo()
Dim ret As Long, Buffer(512) As Byte, i As Integer
Dim wk101 As WKSTA_INFO_101, pwk101 As Long
Dim wk1 As WKSTA_USER_INFO_1, pwk1 As Long
Dim cbusername As Long, userName As String
' Clear all of the display values.
userName = ""
' Windows 95 or NT - call WNetGetUser to get the name of the user.
userName = Space(256)
cbusername = Len(userName)
ret = WNetGetUser(ByVal 0&, userName, cbusername)
If ret = 0 Then
' Success - strip off the null.
userName = Left(userName, InStr(userName, Chr(0)) - 1)
Else
userName = ""
End If
Bruger = userName
End Function
Nu kan du så måle på, hvilke grupper den pågældende bruger er medlem af.
Ny bruger
Nybegynder
Opret
Preview
