LOGIN活动目录
'*****************************************************************************************************
'//开始日期：2002年5月21日
'//结束日期：2002年5月
'*****************************************************************************************************
Option Explicit On
'Option Strict On
'//***************************************************************************************************
Imports System.Data.SqlClient
'//***************************************************************************************************
'//Begin defined namespace
'//Begin defined Class
Namespace Sunerp.CommClass.UserLogin
Public Class ActiveDsLogin
'//Defined Function LoginActiveDs
'//Function descriptoin
'//本函数以用户提供的证书验证用户，使用 LDAP 传输用户的证书，
'//使用 ActiveDs 对象的IADsOpenDSObject和 IADs 接口连接Active Directory，
'//使用参数ActiveDs.__MIDL___MIDL_itf_ads_0000_0018.ADS_SECURE_AUTHENTICATION
'//强制使用证书绑定用户。
'//本函数没有参数,用类ActiveDsLogin的属性ADserverName（主域控制器名），ADUserName（用户名）,
'//ADUserPWD（用户密码），ADUserDeptVal（用户所在组织结构）传值
'//Begin define function LoginActiveDs
Public Function LoginActiveDs() As Boolean
' Opens an Active Directory object
' Using specific credentials.
'定义 LDAP 绑定字符串，调用函数ParseDomainName(DomainName)解析域名
Dim strLDAP As String
strLDAP = "LDAP://" & ExchangeServerName & "/" & _
"cn=" & AccountNameVal & ",ou=" & ActiveDsOrganizationUnitNameVal & _
"," & ParseDomainName(DomainName)
Dim dso As ActiveDs.IADsOpenDSObject
Dim sobj As ActiveDs.IADs
Try
dso = GetObject("LDAP:")
sobj = dso.OpenDSObject(strLDAP, _
AccountNameVal, AccountPassword, _
ActiveDs.__MIDL___MIDL_itf_ads_0000_0018.ADS_SECURE_AUTHENTICATION)
sobj = Nothing
dso = Nothing
LoginActiveDs = True
State = True
Catch
' MsgBox("用户名或密码错误，请重新输入。")
LoginActiveDs = False
State = False
End Try
End Function
'//End define function LoginActiveDs
''//私有的解析域名函数 ParseDomainName
''//根域名 如:com net 等
''//主域域控制器名 如:sunrise Microsoft 等
''//子域名 如:msdn 等 (msdn.microsoft.com)
''//本函数有1个参数，为域名字符串，此处为 DomainName 属性的值
''//返回 LDAP 字符串 如 "DC=sunrise,DC=com"
Private Function ParseDomainName(ByVal IDomainName As String) As String
'解析域名
' DomainName 域名属性
Dim domainDC As String
Dim domTokens 'As String
domTokens = Split(Trim(IDomainName), ".", -1, 1)
domainDC = Join(domTokens, ",DC=")
domainDC = "DC=" & domainDC
ParseDomainName = domainDC
End Function
''定义类UserMailService的属性ExchangeServerName（Exchange DNS服务器名）
Private ExchangeServerNameVal As String
Public Property ExchangeServerName() As String
Get '''<WebMethod(EnableSession:=True)>
Return ExchangeServerNameVal ' Same As Prop1 = PropVal
End Get
Set(ByVal Value As String)
ExchangeServerNameVal = Trim(Value)
End Set
End Property
''定义类UserMailService的属性DomainName（DNS主域名）
Private DomainNameVal As String
Public Property DomainName() As String
Get
Return DomainNameVal ' Same As Prop1 = PropVal
End Get
Set(ByVal Value As String)
DomainNameVal = Trim(Value)
End Set
End Property
''定义类UserMailService的属性ExchangeFirstOrganizationName（Exchange邮件存储系统组织名）
Private ExchangeFirstOrganizationNameVal As String
Public Property ExchangeFirstOrganizationName() As String
Get
Return ExchangeFirstOrganizationNameVal
End Get
Set(ByVal Value As String)
ExchangeFirstOrganizationNameVal = Trim(Value)
End Set
End Property
''定义类UserMailService的属性ADUserDept（用户所在组织单元OU）
Private ActiveDsOrganizationUnitNameVal As String
Public Property ActiveDsOrganizationUnitName() As String
Get
Return ActiveDsOrganizationUnitNameVal
End Get
Set(ByVal Value As String)
ActiveDsOrganizationUnitNameVal = Trim(Value)
End Set
End Property
''定义类UserMailService的属性UserGroupName（用户所加入的组）
Private UserGroupNameVal As String
Public Property UserGroupName() As String
Get
Return UserGroupNameVal
End Get
Set(ByVal Value As String)
UserGroupNameVal = Trim(Value)
End Set
End Property
''定义类UserMailService的属性AccountName（用户账户名）
Private AccountNameVal As String
Public Property AccountName() As String
Get
Return AccountNameVal
End Get
Set(ByVal Value As String)
AccountNameVal = Trim(Value)
End Set
End Property
''定义类UserMailService的属性AccountPassword（用户密码）
Private AccountPasswordVal As String
Public Property AccountPassword() As String
Get
Return AccountPasswordVal
End Get
Set(ByVal Value As String)
AccountPasswordVal = Trim(Value)
End Set
End Property
''定义类UserMailService的属性UserFirstName（用户姓氏）
Private UserFirstNameVal As String
Public Property UserFirstName() As String
Get
Return UserFirstNameVal
End Get
Set(ByVal Value As String)
UserFirstNameVal = Trim(Value)
End Set
End Property
''定义类UserMailService的属性UserLastName（用户名字）
Private UserLastNameVal As String
Public Property UserLastName() As String
Get
Return UserLastNameVal
End Get
Set(ByVal Value As String)
UserLastNameVal = Trim(Value)
End Set
End Property
''定义类UserMailService的属性UserMailBoxName（用邮箱名）
Private UserMailBoxNameVal As String
Public Property UserMailBoxName() As String
Get
Return UserMailBoxNameVal
End Get
Set(ByVal Value As String)
UserMailBoxNameVal = Trim(Value)
End Set
End Property
''定义类UserMailService的ReadOnly属性State（创建连接的状态）
''True(创建成功），False（创建失败）
Private StateVal As Boolean
Public Property State() As Boolean
Get
Return StateVal
End Get
Set(ByVal Value As Boolean)
StateVal = Value
End Set
End Property
End Class
Public Class DBaseLogin
'//Defined Function LoginDBase
'//Function descriptoin
'//本函数获取数据表中的当前登录的用户的信息，使用DataSet绑定数据库和007user表,
'//本函数有2个参数，ILinkedSqlServer为公共函数LinkedSqlServer的返回值SqlConnection，
'// IPublicApplication为公共数据结构PublicApplicationVal
'//本函数返回查询到的 DataSet，包含字段所有字段
'//Begin define function LoginDBase
Public Function LoginDBase(ByVal ILinkedSqlServer As SqlConnection, _
ByVal IPublicApplication As Comm.PublicApplicationVal) As DataSet
Dim strSql As String
Dim objDA As SqlDataAdapter
Dim objDS As New DataSet()
''//查询条件是字符型字段
strSql = "select * from " & IPublicApplication.DBTable & _
" WHERE " & IPublicApplication.QueryFieldName & _
"='" & IPublicApplication.QueryFieldVale & "'"
objDA = New SqlDataAdapter(strSql, ILinkedSqlServer)
objDA.Fill(objDS, "'" & IPublicApplication.DBTable & "'")
objDA = Nothing
LoginDBase = objDS
End Function
'//End define function LoginDBase
End Class
End Namespace