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 '''

  1<webmethod(enablesession:=true)>   
  2Return ExchangeServerNameVal ' Same As Prop1 = PropVal   
  3End Get   
  4Set(ByVal Value As String)   
  5ExchangeServerNameVal = Trim(Value)   
  6End Set   
  7End Property 
  8
  9''定义类UserMailService的属性DomainName（DNS主域名）   
 10Private DomainNameVal As String   
 11Public Property DomainName() As String   
 12Get   
 13Return DomainNameVal ' Same As Prop1 = PropVal   
 14End Get   
 15Set(ByVal Value As String)   
 16DomainNameVal = Trim(Value)   
 17End Set   
 18End Property 
 19
 20  
 21''定义类UserMailService的属性ExchangeFirstOrganizationName（Exchange邮件存储系统组织名）   
 22Private ExchangeFirstOrganizationNameVal As String   
 23Public Property ExchangeFirstOrganizationName() As String   
 24Get   
 25Return ExchangeFirstOrganizationNameVal   
 26End Get   
 27Set(ByVal Value As String)   
 28ExchangeFirstOrganizationNameVal = Trim(Value)   
 29End Set   
 30End Property 
 31
 32  
 33''定义类UserMailService的属性ADUserDept（用户所在组织单元OU）   
 34Private ActiveDsOrganizationUnitNameVal As String   
 35Public Property ActiveDsOrganizationUnitName() As String   
 36Get   
 37Return ActiveDsOrganizationUnitNameVal   
 38End Get   
 39Set(ByVal Value As String)   
 40ActiveDsOrganizationUnitNameVal = Trim(Value)   
 41End Set   
 42End Property 
 43
 44  
 45''定义类UserMailService的属性UserGroupName（用户所加入的组）   
 46Private UserGroupNameVal As String   
 47Public Property UserGroupName() As String   
 48Get   
 49Return UserGroupNameVal   
 50End Get   
 51Set(ByVal Value As String)   
 52UserGroupNameVal = Trim(Value)   
 53End Set   
 54End Property 
 55
 56  
 57''定义类UserMailService的属性AccountName（用户账户名）   
 58Private AccountNameVal As String   
 59Public Property AccountName() As String   
 60Get   
 61Return AccountNameVal   
 62End Get   
 63Set(ByVal Value As String)   
 64AccountNameVal = Trim(Value)   
 65End Set   
 66End Property 
 67
 68''定义类UserMailService的属性AccountPassword（用户密码）   
 69Private AccountPasswordVal As String   
 70Public Property AccountPassword() As String   
 71Get   
 72Return AccountPasswordVal   
 73End Get   
 74Set(ByVal Value As String)   
 75AccountPasswordVal = Trim(Value)   
 76End Set   
 77End Property 
 78
 79''定义类UserMailService的属性UserFirstName（用户姓氏）   
 80Private UserFirstNameVal As String   
 81Public Property UserFirstName() As String   
 82Get   
 83Return UserFirstNameVal   
 84End Get   
 85Set(ByVal Value As String)   
 86UserFirstNameVal = Trim(Value)   
 87End Set   
 88End Property 
 89
 90''定义类UserMailService的属性UserLastName（用户名字）   
 91Private UserLastNameVal As String   
 92Public Property UserLastName() As String   
 93Get   
 94Return UserLastNameVal   
 95End Get   
 96Set(ByVal Value As String)   
 97UserLastNameVal = Trim(Value)   
 98End Set   
 99End Property 
100
101''定义类UserMailService的属性UserMailBoxName（用邮箱名）   
102Private UserMailBoxNameVal As String   
103Public Property UserMailBoxName() As String   
104Get   
105Return UserMailBoxNameVal   
106End Get   
107Set(ByVal Value As String)   
108UserMailBoxNameVal = Trim(Value)   
109End Set   
110End Property 
111
112  
113''定义类UserMailService的ReadOnly属性State（创建连接的状态）   
114''True(创建成功），False（创建失败）   
115Private StateVal As Boolean   
116Public Property State() As Boolean   
117Get   
118Return StateVal   
119End Get   
120Set(ByVal Value As Boolean)   
121StateVal = Value   
122End Set   
123End Property   
124End Class 
125
126  
127Public Class DBaseLogin 
128
129'//Defined Function LoginDBase   
130'//Function descriptoin   
131'//本函数获取数据表中的当前登录的用户的信息，使用DataSet绑定数据库和007user表,   
132'//本函数有2个参数，ILinkedSqlServer为公共函数LinkedSqlServer的返回值SqlConnection，   
133'// IPublicApplication为公共数据结构PublicApplicationVal   
134'//本函数返回查询到的 DataSet，包含字段所有字段 
135
136'//Begin define function LoginDBase   
137Public Function LoginDBase(ByVal ILinkedSqlServer As SqlConnection, _   
138ByVal IPublicApplication As Comm.PublicApplicationVal) As DataSet 
139
140Dim strSql As String 
141
142Dim objDA As SqlDataAdapter   
143Dim objDS As New DataSet() 
144
145''//查询条件是字符型字段   
146strSql = "select * from " &amp; IPublicApplication.DBTable &amp; _   
147" WHERE " &amp; IPublicApplication.QueryFieldName &amp; _   
148"='" &amp; IPublicApplication.QueryFieldVale &amp; "'" 
149
150objDA = New SqlDataAdapter(strSql, ILinkedSqlServer)   
151objDA.Fill(objDS, "'" &amp; IPublicApplication.DBTable &amp; "'") 
152
153objDA = Nothing 
154
155LoginDBase = objDS   
156End Function   
157'//End define function LoginDBase 
158
159End Class   
160End Namespace</webmethod(enablesession:=true)>