[RaggiTech]

كاتب الموضوع : Boutemine Oualid

السلام عليكم و رحمة الله و بركاته

هذه الشفرة تمكننا من اضافة خاصية الدخول الى البرنامج باسم المستعمل و كلمة المرور الخاصية بحساب ال Windows User أي الذي نستعمله عند فتح الكمبيوتر

ملاحظة
الشفرة لا تعمل اذا كان الحساب غير محمي بكلمة مرور

الشفرة تستعمل دالة ال API المسماة LogonUser

كود :

Module mod_environ
' these declrations are public on purpose
' they are use to store your login account
' even the login user in not necessary, cause you can retrieve it with GetMyUserName
' it's mandatory for the pass
Public MyUserPassword As String = ""
Public Enum LogonType As Integer
'This logon type is intended for users who will be interactively using the computer, such as a user being logged on
'by a terminal server, remote shell, or similar process.
'This logon type has the additional expense of caching logon information for disconnected operations;
'therefore, it is inappropriate for some client/server applications,
'such as a mail server.
LOGON32_LOGON_INTERACTIVE = 2
'This logon type is intended for high performance servers to authenticate plaintext passwords.
'The LogonUser function does not cache credentials for this logon type.
LOGON32_LOGON_NETWORK = 3
'This logon type is intended for batch servers, where processes may be executing on behalf of a user without
'their direct intervention. This type is also for higher performance servers that process many plaintext
'authentication attempts at a time, such as mail or Web servers.
'The LogonUser function does not cache credentials for this logon type.
LOGON32_LOGON_BATCH = 4
'Indicates a service-type logon. The account provided must have the service privilege enabled.
LOGON32_LOGON_SERVICE = 5
'This logon type is for GINA DLLs that log on users who will be interactively using the computer.
'This logon type can generate a unique audit record that shows when the workstation was unlocked.
LOGON32_LOGON_UNLOCK = 7
'This logon type preserves the name and password in the authentication package, which allows the server to make
'connections to other network servers while impersonating the client. A server can accept plaintext credentials
'from a client, call LogonUser, verify that the user can access the system across the network, and still
'communicate with other servers.
'NOTE: Windows NT: This value is not supported.
LOGON32_LOGON_NETWORK_CLEARTEXT = 8
'This logon type allows the caller to clone its current token and specify new credentials for outbound connections.
'The new logon session has the same local identifier but uses different credentials for other network connections.
'NOTE: This logon type is supported only by the LOGON32_PROVIDER_WINNT50 logon provider.
'NOTE: Windows NT: This value is not supported.
LOGON32_LOGON_NEW_CREDENTIALS = 9
End Enum
Public Enum LogonProvider As Integer
'Use the standard logon provider for the system.
'The default security provider is negotiate, unless you pass NULL for the domain name and the user name
'is not in UPN format. In this case, the default provider is NTLM.
'NOTE: Windows 2000/NT: The default security provider is NTLM.
LOGON32_PROVIDER_DEFAULT = 0
End Enum
' Declare the logon types as constants
Const LOGON32_LOGON_INTERACTIVE As Long = 2
Const LOGON32_LOGON_NETWORK As Long = 3
' Declare the logon providers as constants
Const LOGON32_PROVIDER_DEFAULT As Long = 0
Const LOGON32_PROVIDER_WINNT50 As Long = 3
Const LOGON32_PROVIDER_WINNT40 As Long = 2
Const LOGON32_PROVIDER_WINNT35 As Long = 1
Const MAX_ENTRY As Integer = 32768
Declare Auto Function LogonUser Lib "advapi32.dll" (ByVal lpszUsername As String, _
ByVal lpszDomain As String, ByVal lpszPassword As String, ByVal dwLogonType As LogonType, _
ByVal dwLogonProvider As LogonProvider, ByRef phToken As IntPtr) As Integer
#Region "FUNCTIONS"
Function GetUserDomain() As String
If TypeOf My.User.CurrentPrincipal Is _
Security.Principal.WindowsPrincipal Then
Dim parts() As String = Split(My.User.Name, "\")
Dim domain As String = parts(0)
Return domain
Else
Return ""
End If
End Function
Function GetUserName() As String
If TypeOf My.User.CurrentPrincipal Is _
Security.Principal.WindowsPrincipal Then
Dim parts() As String = Split(My.User.Name, "\")
Dim username As String = parts(1)
Return username
Else
Return My.User.Name
End If
End Function
Public Function ValidateLogin( _
ByVal Username As String, _
ByVal Password As String, _
ByVal Domain As String) As Boolean
' This is the token returned by the API call
' Look forward to a future article covering
' the uses of it
Dim token As IntPtr
' Call the API
If Not LogonUser(Username, _
Domain, _
Password, _
LOGON32_LOGON_NETWORK, _
LOGON32_PROVIDER_DEFAULT, token) = 0 Then
' Since the API didn't return 0, return TRUE to the caller
Return True
Else
' Bad credentials, return FALSE
Return False
End If
End Function
#End Region
End Module