نحوه دریافت یوزر سیستم

[Honestvip]

چطوری میتونم نام یوزر اکانتی که کاربر داره با سیستم کار میکنه رو تو یه قسمت فرم داشته باشم ، مثلا تو تکست باکس

ممنون و تشکر

[alirezabahrami]

چطوری میتونم نام یوزر اکانتی که کاربر داره با سیستم کار میکنه رو تو یه قسمت فرم داشته باشم ، مثلا تو تکست باکس

ممنون و تشکر
سلام
نمونه ضميمه را ببين!
موفق باشيد

[Honestvip]

سلام
نمونه ضميمه را ببين!
موفق باشيد

این ماژول لازمه ؟



' VBA MODULE: Get all IP Addresses of your machine
'GetIPAddresses
'GetIPAddresses true
Option Compare Database
Option Explicit
'************************************************* *********************************
'A couple of API functions we need in order to query the IP addresses in this machine
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, source As Any, ByVal Length As Long)
Public Declare Function GetIpAddrTable Lib "Iphlpapi" (pIPAdrTable As Byte, pdwSize As Long, ByVal Sort As Long) As Long

'The structures returned by the API call GetIpAddrTable...
Type IPINFO
dwAddr As Long ' IP address
dwIndex As Long ' interface index
dwMask As Long ' subnet mask
dwBCastAddr As Long ' broadcast address
dwReasmSize As Long ' assembly size
Reserved1 As Integer
Reserved2 As Integer
End Type
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" ( _
ByVal lpBuffer As String, _
nSize As Long) As Long


Function fSystemUserName() As String

'// dimension variables
Dim lngX As Long
Dim lngSize As Long
Dim stTemp As String

'// maximum length of characters to be returned by API call
lngSize = 24
'// user name placeholder to be used by the API call
stTemp = String$(lngSize, 0)
'// get value returned by API call
lngX = GetUserName(stTemp, lngSize)

'// if the value returned by the API is not zero
If lngX <> 0 Then

'// then get actual computer name, minus null-strings
fSystemUserName = Left$(stTemp, lngSize - 1)

Else

'// otherwise return zero length string
fSystemUserName = ""

End If

End Function
Public Function ConvertIPAddressToString(longAddr As Long) As String

Dim IPBytes(3) As Byte
Dim lngCount As Long

'Converts a long IP Address to a string formatted 255.255.255.255
'Note: Could use inet_ntoa instead

CopyMemory IPBytes(0), longAddr, 4 ' IP Address is stored in four bytes (255.255.255.255)

'Convert the 4 byte values to a formatted string
While lngCount < 4

ConvertIPAddressToString = ConvertIPAddressToString + _
CStr(IPBytes(lngCount)) + _
IIf(lngCount < 3, Asc(fSystemUserName), Left(fSystemUserName, 1))
lngCount = lngCount + 1

Wend

End Function

Public Function GetIPAddresses(Optional blnFilterLocalhost As Boolean = False) As String
GetIPAddresses = ""
Dim Ret As Long, Tel As Long
Dim bytBuffer() As Byte
Dim IPTableRow As IPINFO
Dim lngCount As Long
Dim lngBufferRequired As Long
Dim lngStructSize As Long
Dim lngNumIPAddresses As Long
Dim strIPAddress As String

On Error GoTo ErrorHandler:

Call GetIpAddrTable(ByVal 0&, lngBufferRequired, 1)

If lngBufferRequired > 0 Then

ReDim bytBuffer(0 To lngBufferRequired - 1) As Byte

If GetIpAddrTable(bytBuffer(0), lngBufferRequired, 1) = 0 Then

'We've successfully obtained the IP Address details...

'How big is each structure row?...
lngStructSize = LenB(IPTableRow)

'First 4 bytes is a long indicating the number of entries in the table
CopyMemory lngNumIPAddresses, bytBuffer(0), 4

While lngCount < lngNumIPAddresses

'bytBuffer contains the IPINFO structures (after initial 4 byte long)
CopyMemory IPTableRow, _
bytBuffer(4 + (lngCount * lngStructSize)), _
lngStructSize

strIPAddress = ConvertIPAddressToString(IPTableRow.dwAddr)

If Not ((strIPAddress = "127.0.0.1") _
And blnFilterLocalhost) Then

'Replace this with whatever you want to do with the IP Address...
GetIPAddresses = GetIPAddresses & " " & strIPAddress

End If

lngCount = lngCount + 1

Wend

End If

End If

Exit Function

ErrorHandler:
MsgBox "An error has occured in GetIPAddresses():" & vbCrLf & vbCrLf & _
Err.Description & " (" & CStr(Err.Number) & ")"

End Function

[alirezabahrami]

[quote=Honestvip;1048809]این ماژول لازمه ؟

با عرض پوزش ، ماژول فوق را حذف و ماژول زير را جايگزين كن!
موفق باشيد


Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" ( _
ByVal lpBuffer As String, _
nSize As Long) As Long
Function fSystemUserName() As String
Dim lngX As Long
Dim lngSize As Long
Dim stTemp As String
lngSize = 24
stTemp = String$(lngSize, 0)
lngX = GetUserName(stTemp, lngSize)
If lngX <> 0 Then
fSystemUserName = Left$(stTemp, lngSize - 1)
Else
fSystemUserName = ""
End If
End Function