get domain name 1

[theOneAndOnlyOne]

hi,

does anyone know how I can receive the domain name of the user currently logged on?

Receiving the username is no problem.

Regards,

K.

 

[sunaj]

Hi,

In NT & 2000:
Environ("USERDOMAIN&quot

Alternatively you can parse the domain name from the result of the GetUserNameEx API.
Sunaj
'The gap between theory and practice is not as wide in theory as it is in practice'

 

[theOneAndOnlyOne]

thnx!

 

[M626]

Find where in Registry the Current Domain Lives and Change
Label1(Command1) to point where it is using the code below the module.

Put this code in a Module
'***********MODULE START*******
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_DYN_DATA = &H80000006

Private Const STANDARD_RIGHTS_READ = &H20000
Private Const KEY_QUERY_VALUE = &H1&
Private Const KEY_ENUMERATE_SUB_KEYS = &H8&
Private Const KEY_NOTIFY = &H10&
Private Const SYNCHRONIZE = &H100000
Private Const KEY_READ = ((STANDARD_RIGHTS_READ Or _
KEY_QUERY_VALUE Or _
KEY_ENUMERATE_SUB_KEYS Or _
KEY_NOTIFY) And _
(Not SYNCHRONIZE))
Private Const MAXLEN = 256
Private Const ERROR_SUCCESS = &H0&

Const REG_NONE = 0
Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_DWORD_LITTLE_ENDIAN = 4
Const REG_DWORD_BIG_ENDIAN = 5
Const REG_LINK = 6
Const REG_MULTI_SZ = 7
Const REG_RESOURCE_LIST = 8

Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Private Declare Function apiRegOpenKeyEx Lib "advapi32.dll" _
Alias "RegOpenKeyExA" (ByVal hKey As Long, _
ByVal lpSubKey As String, ByVal ulOptions As Long, _
ByVal samDesired As Long, ByRef phkResult As Long) _
As Long

Private Declare Function apiRegCloseKey Lib "advapi32.dll" _
Alias "RegCloseKey" (ByVal hKey As Long) As Long

Private Declare Function apiRegQueryValueEx Lib "advapi32.dll" _
Alias "RegQueryValueExA" (ByVal hKey As Long, _
ByVal lpValueName As String, ByVal lpReserved As Long, _
ByRef lpType As Long, lpData As Any, _
ByRef lpcbData As Long) As Long

Private Declare Function apiRegQueryInfoKey Lib "advapi32.dll" _
Alias "RegQueryInfoKeyA" (ByVal hKey As Long, _
ByVal lpClass As String, ByRef lpcbClass As Long, _
ByVal lpReserved As Long, ByRef lpcSubKeys As Long, _
ByRef lpcbMaxSubKeyLen As Long, _
ByRef lpcbMaxClassLen As Long, _
ByRef lpcValues As Long, _
ByRef lpcbMaxValueNameLen As Long, _
ByRef lpcbMaxValueLen As Long, _
ByRef lpcbSecurityDescriptor As Long, _
ByRef lpftLastWriteTime As FILETIME) As Long

Function fReturnRegKeyValue(ByVal lngKeyToGet As Long, _
ByVal strKeyName As String, _
ByVal strValueName As String) _
As String
Dim lnghKey As Long
Dim strClassName As String
Dim lngClassLen As Long
Dim lngReserved As Long
Dim lngSubKeys As Long
Dim lngMaxSubKeyLen As Long
Dim lngMaxClassLen As Long
Dim lngValues As Long
Dim lngMaxValueNameLen As Long
Dim lngMaxValueLen As Long
Dim lngSecurity As Long
Dim ftLastWrite As FILETIME
Dim lngType As Long
Dim lngData As Long
Dim lngTmp As Long
Dim strRet As String
Dim varRet As Variant
Dim lngRet As Long

On Error GoTo fReturnRegKeyValue_Err

'Open the key first
lngTmp = apiRegOpenKeyEx(lngKeyToGet, _
strKeyName, 0&, KEY_READ, lnghKey)

'Are we ok?
If Not (lngTmp = ERROR_SUCCESS) Then Err.Raise _
lngTmp + vbObjectError

lngReserved = 0&
strClassName = String$(MAXLEN, 0): lngClassLen = MAXLEN

'Get boundary values
lngTmp = apiRegQueryInfoKey(lnghKey, strClassName, _
lngClassLen, lngReserved, lngSubKeys, lngMaxSubKeyLen, _
lngMaxClassLen, lngValues, lngMaxValueNameLen, _
lngMaxValueLen, lngSecurity, ftLastWrite)

'How we doin?
If Not (lngTmp = ERROR_SUCCESS) Then Err.Raise _
lngTmp + vbObjectError

'Now grab the value for the key
strRet = String$(MAXLEN - 1, 0)
lngTmp = apiRegQueryValueEx(lnghKey, strValueName, _
lngReserved, lngType, ByVal strRet, lngData)
Select Case lngType
Case REG_SZ
lngTmp = apiRegQueryValueEx(lnghKey, strValueName, _
lngReserved, lngType, ByVal strRet, lngData)
varRet = Left(strRet, lngData - 1)
Case REG_DWORD
lngTmp = apiRegQueryValueEx(lnghKey, strValueName, _
lngReserved, lngType, lngRet, lngData)
varRet = lngRet
Case REG_BINARY
lngTmp = apiRegQueryValueEx(lnghKey, strValueName, _
lngReserved, lngType, ByVal strRet, lngData)
varRet = Left(strRet, lngData)
End Select

'All quiet on the western front?
If Not (lngTmp = ERROR_SUCCESS) Then Err.Raise _
lngTmp + vbObjectError

fReturnRegKeyValue_Exit:
fReturnRegKeyValue = varRet
lngTmp = apiRegCloseKey(lnghKey)
Exit Function
fReturnRegKeyValue_Err:
varRet = "Error: Key or Value Not Found."
Resume fReturnRegKeyValue_Exit
End Function

'********Module End**************

Put this code in you Form

Private Const STANDARD_RIGHTS_READ = &H20000
Private Const KEY_QUERY_VALUE = &H1&
Private Const KEY_ENUMERATE_SUB_KEYS = &H8&
Private Const KEY_NOTIFY = &H10&
Private Const SYNCHRONIZE = &H100000
Private Const KEY_READ = ((STANDARD_RIGHTS_READ Or _
KEY_QUERY_VALUE Or _
KEY_ENUMERATE_SUB_KEYS Or _
KEY_NOTIFY) And _
(Not SYNCHRONIZE))
Private Const MAXLEN = 256
Private Const ERROR_SUCCESS = &H0&

Const REG_NONE = 0
Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_DWORD_LITTLE_ENDIAN = 4
Const REG_DWORD_BIG_ENDIAN = 5
Const REG_LINK = 6
Const REG_MULTI_SZ = 7
Const REG_RESOURCE_LIST = 8

'Type FILETIME
' dwLowDateTime As Long
' dwHighDateTime As Long
'End Type

Private Declare Function apiRegOpenKeyEx Lib "advapi32.dll" _
Alias "RegOpenKeyExA" (ByVal hKey As Long, _
ByVal lpSubKey As String, ByVal ulOptions As Long, _
ByVal samDesired As Long, ByRef phkResult As Long) _
As Long

Private Declare Function apiRegCloseKey Lib "advapi32.dll" _
Alias "RegCloseKey" (ByVal hKey As Long) As Long

Private Declare Function apiRegQueryValueEx Lib "advapi32.dll" _
Alias "RegQueryValueExA" (ByVal hKey As Long, _
ByVal lpValueName As String, ByVal lpReserved As Long, _
ByRef lpType As Long, lpData As Any, _
ByRef lpcbData As Long) As Long

Private Declare Function apiRegQueryInfoKey Lib "advapi32.dll" _
Alias "RegQueryInfoKeyA" (ByVal hKey As Long, _
ByVal lpClass As String, ByRef lpcbClass As Long, _
ByVal lpReserved As Long, ByRef lpcSubKeys As Long, _
ByRef lpcbMaxSubKeyLen As Long, _
ByRef lpcbMaxClassLen As Long, _
ByRef lpcValues As Long, _
ByRef lpcbMaxValueNameLen As Long, _
ByRef lpcbMaxValueLen As Long, _
ByRef lpcbSecurityDescriptor As Long, _
ByRef lpftLastWriteTime As FILETIME) As Long

Function fReturnRegKeyValue(ByVal lngKeyToGet As Long, _
ByVal strKeyName As String, _
ByVal strValueName As String) _
As String
Dim lnghKey As Long
Dim strClassName As String
Dim lngClassLen As Long
Dim lngReserved As Long
Dim lngSubKeys As Long
Dim lngMaxSubKeyLen As Long
Dim lngMaxClassLen As Long
Dim lngValues As Long
Dim lngMaxValueNameLen As Long
Dim lngMaxValueLen As Long
Dim lngSecurity As Long
Dim ftLastWrite As FILETIME
Dim lngType As Long
Dim lngData As Long
Dim lngTmp As Long
Dim strRet As String
Dim varRet As Variant
Dim lngRet As Long

On Error GoTo fReturnRegKeyValue_Err

'Open the key first
lngTmp = apiRegOpenKeyEx(lngKeyToGet, _
strKeyName, 0&, KEY_READ, lnghKey)

'Are we ok?
If Not (lngTmp = ERROR_SUCCESS) Then Err.Raise _
lngTmp + vbObjectError

lngReserved = 0&
strClassName = String$(MAXLEN, 0): lngClassLen = MAXLEN

'Get boundary values
lngTmp = apiRegQueryInfoKey(lnghKey, strClassName, _
lngClassLen, lngReserved, lngSubKeys, lngMaxSubKeyLen, _
lngMaxClassLen, lngValues, lngMaxValueNameLen, _
lngMaxValueLen, lngSecurity, ftLastWrite)

'How we doin?
If Not (lngTmp = ERROR_SUCCESS) Then Err.Raise _
lngTmp + vbObjectError

'Now grab the value for the key
strRet = String$(MAXLEN - 1, 0)
lngTmp = apiRegQueryValueEx(lnghKey, strValueName, _
lngReserved, lngType, ByVal strRet, lngData)
Select Case lngType
Case REG_SZ
lngTmp = apiRegQueryValueEx(lnghKey, strValueName, _
lngReserved, lngType, ByVal strRet, lngData)
varRet = Left(strRet, lngData - 1)
Case REG_DWORD
lngTmp = apiRegQueryValueEx(lnghKey, strValueName, _
lngReserved, lngType, lngRet, lngData)
varRet = lngRet
Case REG_BINARY
lngTmp = apiRegQueryValueEx(lnghKey, strValueName, _
lngReserved, lngType, ByVal strRet, lngData)
varRet = Left(strRet, lngData)
End Select

'All quiet on the western front?
If Not (lngTmp = ERROR_SUCCESS) Then Err.Raise _
lngTmp + vbObjectError

fReturnRegKeyValue_Exit:
fReturnRegKeyValue = varRet
lngTmp = apiRegCloseKey(lnghKey)
Exit Function
fReturnRegKeyValue_Err:
varRet = "Error: Key or Value Not Found."
Resume fReturnRegKeyValue_Exit
End Function


Private Sub Command1_Click()
Label1 = fReturnRegKeyValue(HKEY_CURRENT_USER, _
"Software\Microsoft\Windows\CurrentVersion\Internet Settings\ZoneMap\ProtocolDefaults", "ftp&quot
'CHANGE THIS CODE USING THIS FORMAT TO POINT WHERE THE
CURRENT DOMAIN IS IN REGISTRY


End Sub