Advertisement

01.15.2008 at 03:03PM PST, ID: 23085695
[x]
Attachment Details
[x]
The Solution Rating System

With so many solutions, how can you tell which solutions are most likely to help you and which ones are not? To provide you with a tool to use, we rate our solutions based on various elements that most accurately determine if a solution is a quality solution. To explain what factors affect the solution rating, here are the elements we take into consideration when formulating our solution rating.

  • The Grade of the Solution
  • The Zone Rank of the Expert Providing the Solution
  • The Number of Author and Expert Comments
  • The Number of Experts Contributing
  • The Feedback of the Community

Your Input Matters
Because of the way the system is set up, the most important variable in this equation is you. As a member of Experts Exchange, you are able to cast your vote on the quality of the solutions in regard to how complete, accurate, helpful and easy to understand each solution is. When you provide your feedback, each rating is adjusted accordingly. So, if you see a solution that has a poor rating that you think is a good solution, let us know by rating it. As you do, the rating will be adjusted and will become more accurate for other members of our site.

If you have any suggestions that you would like to make for our rating system, please ask a question in the Suggestions Zone of Community Support.

Thank you!
7.6

LDAP Query from VB to VB.Net help - URGENT!!!!!!

Asked by computer12 in .NET, Miscellaneous Programming

Tags:

I have an Class in VB6.0 that gets the list of Distribution lists from a DATABASE
And  query all the user details from LDAP who belong to these Group of Distribution lists
 and save in the Database again.
Here is the old code that i got in VB6.0
Can some one guide me how to query the LDAP in VB.Net
I am able to query and get the ADSPATH for a distribution list. But having trouble getting the user details from that perticular distribution list.
Start Free Trial 
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:

Public Sub main()
On Error GoTo errCatcher
Dim cnn As New Connection
Dim rst As New Recordset
Dim sql As String
 
 
Dim i As Integer
Dim reg As AppUtil.Registry
Dim strDirLogPath
Set reg = New AppUtil.Registry
strDirLogPath = reg.GetValue("software", "ExchangeData", "", "DirLogPath")
'strserver = reg.GetValue("software", "ExchangeData", "", "Server")
strUser = reg.GetValue("software", "cmsnet", "", "User")
strDsn = reg.GetValue("software", "cmsnet", "", "Dsn")
strPassword = reg.GetValue("software", "cmsnet", "", "Pwd")
 
 
sql = "SELECT ID, DL_NAME, DL_ALIAS FROM DISTRIBUTION_LISTS"
 
cnn.Open strDsn, strUser, strPassword
Set rst = cnn.Execute(sql)
 
 
 
Set varLog1 = New AppUtil.Log
Set varOptions1 = New AppUtil.Options
Set varLog1.Options = varOptions1
 
varOptions1.Start = Now
varOptions1.LogDir = strDirLogPath
varOptions1.Preview = True
varOptions1.LogError = True
varOptions1.Major = 1
varOptions1.Minor = 0
varLog1.LogOpen varOptions1
 
While Not rst.EOF
    If rst("DL_NAME") = "" Or IsNull(rst("DL_NAME")) Then
        'log warning - not a fatal error
        varLog1.LogError "Distribution List with id=[" & rst("ID") & "] has no value", varOptions1
    Else
        load rst("DL_NAME"), rst("DL_ALIAS")
    End If
    rst.MoveNext
Wend
 
'For i = 1 To DList.Count
    'If DList(i) <> "" Then
        'load (DList(i))
    '********
    'Else
    '    MsgBox "DList(" & i & ") is empty."
    '********
    'End If
'Next
 
varLog1.LogLine "No of Records Inserted :" & intInsert & "    No of Records Updated :" & intUpdate
 
 
endSub:
varLog1.LogClose
Set rst = Nothing
Set cnn = Nothing
 
Exit Sub
errCatcher:
varLog1.LogError "An error occured in the [Main] function. Error Number: " & Err.Number & " .Error Description: " & Err.Description, varOptions1
GoTo endSub
End Sub
 
Public Sub load(strDl As String, strAlias As String)
 
Dim objConn As New ADODB.Connection
Dim objRS As New ADODB.Recordset
Dim strQuery As String
Dim strDLAdspath As String              'var to hold Adspath of a Distribution List
Dim objDL As IADsGroup                  'IADs Group object for a Distribution List
Dim objdl1 As IADsGroup
Dim user As IADs                        'member object for a Distribution List
Dim user1 As IADs
 
objConn.Provider = "ADsDSOObject"  'The ADSI OLE-DB provider
objConn.Open "ADs Provider"
On Error GoTo errhandler
 
'strQuery = "<LDAP://SWILNTS801>;(&(objectClass=groupofnames)(cn=" & strDl & "));adspath;subtree"
'strQuery = "<LDAP://" & strserver & ">;(&(objectClass=groupofnames)(cn=" & strDl & "));adspath;subtree"
strQuery = "<LDAP://ou=Groups,dc=us,dc=ad,dc=fusa,dc=com>;(&(objectClass=group)(cn=" & strDl & "));adspath;subtree"
Set objRS = objConn.Execute(strQuery)
 
Do While Not objRS.EOF
    strDLAdspath = objRS(0)
    objRS.MoveNext
Loop
objRS.Close
           
           Set objDL = GetObject(strDLAdspath)
           For Each user In objDL.Members
               Select Case user.Class
                    Case "organizationalPerson"
                         collect user.ADsPath, strDl, strAlias
                    Case "groupOfNames"
                          Set objdl1 = GetObject(user.ADsPath)
                            For Each user1 In objdl1.Members
                                    Select Case user1.Class
                                    Case "organizationalPerson"
                                          collect user1.ADsPath, strDl, strAlias
                                    Case Else
                                          varLog1.LogLine "Proccesing group -  " & user.Name & ". This group includes a subgroup: " & user1.Name & " which will not be processed."
                                    End Select
                            Next
                        
                End Select
            Next
endSub:
Set objRS = Nothing
Set objConn = Nothing
Exit Sub
errhandler:
   
        varLog1.LogError "Distribution List " & strDl & " not found. Error Description :  " & Err.Description & " Error Number : " & Err.Number, varOptions1
        GoTo endSub
    
End Sub
 
'ADsPath and Distribution List is passed
Public Sub collect(strMemADsPath As String, strDl As Variant, strAlias As String)
 
Dim objRs1 As New ADODB.Recordset
Dim strADOQueryString As String         'LDAP query string
Dim objConn1 As New ADODB.Connection
objConn1.Provider = "ADsDSOObject"  'The ADSI OLE-DB provider
objConn1.Open "ADs Provider"
 
Dim strSql2 As String
Dim objRs2 As New ADODB.Recordset
Dim objConn2 As New ADODB.Connection
Dim objCmd As New ADODB.Command
 
Dim strError As String
On Error GoTo ErrH
strError = "ADODB Connection Error"
 
objConn2.Open strDsn, strUser, strPassword
'objconn2.Open (
'objConn2.Open "cms_dev", "cms_dev", "cms_dev"
 
Dim conn1 As New ADODB.Connection
Dim objMember As IADs
Dim strUserId As String
Dim strContact_Dl As String
 
Dim a As String
Dim b As String
Dim intCount As Integer
Dim strTelPhone() As String             'array var used to restrict one phone no
 
Set objMember = GetObject(strMemADsPath)
       'strUserId = objMember.Get("uid")
       strUserId = objMember.Get("sAMAccountName")
 
        'strADOQueryString = "<LDAP://SWILNTS801>;(&(objectClass=organizationalPerson)(uid=" & strUserId & "));uid,sn,givenname,title,department,company,telephonenumber,l,Extension-Attribute-1;subtree"
        strADOQueryString = "<LDAP://ou=Accounts,dc=us,dc=ad,dc=fusa,dc=com>;(&(objectClass=organizationalPerson)(sAMAccountName=" & strUserId & "));sAMAccountName,sn,givenname,title,department,company,telephonenumber,l,extensionAttribute1;subtree"
        Set objRs1 = objConn1.Execute(strADOQueryString)
          If Not objRs1.EOF Then
          
                  'strNetworkAlias = Mid$(objRs1("uid"), 1, 20)
                  strNetworkAlias = Mid$(objRs1("sAMAccountName"), 1, 20)
                  strFirstName = Mid$(NULLtoNA(objRs1("givenName")), 1, 20)
                  strLastName = Mid$(NULLtoNA(objRs1("sn")), 1, 40)
                  strTitle = NULLtoNA(objRs1("title"))
                  strDepartment = NULLtoNA(objRs1("department"))
                  strCompany = NULLtoNA(objRs1("Company"))
                  strPhoneNumber = Mid$(NULLtoNA(objRs1("telephoneNumber")), 1, 20)
                  strLocality = Mid$(NULLtoNA(objRs1("l")), 1, 40)
                  strMailStop = Mid$(NULLtoNA(objRs1("extensionAttribute1")), 1, 80)
                  strPhoneNote = ""
                        
                        'If strDepartment <> "" Then
                        '    strDepartment = "Dept-" & strDepartment
                        'End If
                        
                        'If strTitle <> "" Then
                        '    strTitle = "Title-" & strTitle
                        'End If
                         
                        'If strDepartment <> "" And strTitle <> "" Then
                        '   strPhoneNote = strDepartment & "<br>" & strTitle
                        'Else
                        '   strPhoneNote = strDepartment & strTitle
                        'End If
                    
                        
                        If strDepartment <> "" And strTitle <> "" Then
                            strContact_Dl = "Title-" & strTitle & "," & "Dept-" & strDepartment
                        ElseIf strDepartment <> "" Then
                            strContact_Dl = "Title-N/A" & "," & "Dept-" & strDepartment
                        ElseIf strTitle <> "" Then
                            strContact_Dl = "Title-" & strTitle & "," & "Dept-N/A"
                        Else
                            strContact_Dl = "Title-N/A" & "," & "Dept-N/A"
                        End If
 
                         
                        If strPhoneNumber <> "" Then
                          strTelPhone = Split(strPhoneNumber, ",")
                          strPhoneNumber = strTelPhone(0)
                        End If
                  
                  'strPhoneNote = "Dept-" & strDepartment & "<br>Title-" & strTitle
         End If
         objRs1.Close
         objConn1.Close
         
      Set objRs1 = Nothing
   
   'If strAlias <> "" Then
   '  strContact_Dl = strAlias
   'Else
   '  strContact_Dl = strDl
   'End If
   
   strContact_Dl = Replace(strContact_Dl, "'", "''")
   strPhoneNumber = Replace(strPhoneNumber, "'", "''")
   strFirstName = Replace(strFirstName, "'", "''")
   strLastName = Replace(strLastName, "'", "''")
   strPhoneNote = Replace(strPhoneNote, "'", "''")
   strLocality = Replace(strLocality, "'", "''")
   strMailStop = Replace(strMailStop, "'", "''")
     
   strSql2 = "select * from contacts where login_id='" & strNetworkAlias & "' and source_tid = 165 "
    objRs2.Open strSql2, objConn2, adOpenStatic, adLockOptimistic
   
          If objRs2.RecordCount = 0 Then
                strError = "Unable to insert the record with login_id,contact_desc,first_name,last_name,phone_note,phone1,city,addr_line3 :" & _
                strNetworkAlias & "," & strContact_Dl & "," & strFirstName & "," & strLastName & "," & strPhoneNote & "," & strPhoneNumber & "," & strLocality & "," & strMailStop
                Set objCmd.ActiveConnection = objConn2
                objCmd.CommandType = adCmdText
                objCmd.CommandText = "Insert Into contacts(contact_id,contact_tid,contact_desc,phone1,first_name,last_name,phone_note,city,addr_line3,login_id,source_tid)" & _
                "values(contacts_seq.nextval,174,'" & strContact_Dl & "','" & strPhoneNumber & "','" & strFirstName & "','" & strLastName & "','" & strPhoneNote & "','" & strLocality & "','" & strMailStop & "','" & strNetworkAlias & "',165)"
                objCmd.Execute
                intInsert = intInsert + 1
          Else
                strError = "Unable to update login_id  " & strNetworkAlias
                
                'a = Trim$(objRs2("contact_desc"))
                'intCount = InStr(1, a, strContact_Dl)
                'If intCount = 0 Then
                '    b = a & "," & strContact_Dl
                'Else
                '    b = a
                'End If
                
                b = strContact_Dl
                strSql2 = "update contacts set  phone1 = '" & strPhoneNumber & "',first_name = '" & strFirstName & "' ,last_name = '" & strLastName & "',phone_note = '" & strPhoneNote & "',city = '" & strLocality & "',addr_line3 ='" & strMailStop & "',contact_desc='" & b & "' where login_id = '" & strNetworkAlias & "'and source_tid = 165 "
                Set objCmd.ActiveConnection = objConn2
                objCmd.CommandType = adCmdText
                objCmd.CommandText = strSql2
                objCmd.Execute
                intUpdate = intUpdate + 1
          End If
 
exitSub:
Set objConn2 = Nothing
Set objRs2 = Nothing
 
Exit Sub
ErrH:
    varLog1.LogError strError & Err.Description & " Error Number : " & Err.Number, varOptions1
    GoTo exitSub
End Sub
[+][-]01.16.2008 at 05:08AM PST, ID: 20671380

View this solution now by starting your 7-day free trial. Setting up your free trial is quick, easy, and secure. We will return you to this solution, unlocked, when you're done.

 

About this solution

Zones: .NET, Miscellaneous Programming
Tags: vb.Net
Sign Up Now!
Solution Provided By: JonMny
Participating Experts: 1
Solution Grade: B
 
 
 
Loading Advertisement...
20080716-EE-VQP-32 / EE_QW_2_20070628