Solved

Dynamic listbox not working properly

Posted on 2009-05-06
9
736 Views
Last Modified: 2012-06-21
Experts,

I was previously assisted on this topic, however I've encountered another poblem.

My script pulls a query within AD for a list of users.  It then sorts that list of users alphabetically and puts the sorted items back into the original dictionary.

I am able to post the items to the GUI, but when I begin typing out the name of a person I want to select, the script is removing the incorrect entries.

For example, if I type "Fr", anything that doesn't have (or start with) "Fr" should be removed, and the others should remain.

I've posted my code, any help would be appreciated.
Set objRecordSet = objCommand.Execute
 

	objRecordSet.MoveFirst
 

	Do Until objRecordSet.EOF
 

		'msgbox objRecordSet.Fields("givenName").Value & " " & objRecordSet.Fields("sn").Value
 

		strUserAccount = UCase(objRecordSet.Fields("sAMAccountName").Value)

		strUserEntry = UCase(objRecordSet.Fields("givenName").Value) & " " & UCase(objRecordSet.Fields("sn").Value)

		strUserMail = objRecordSet.Fields("mail").Value

		

		If strUserAccount = "null" OR strUserEntry = "null" OR strUserMail = null then

			'skip record, do nothing

		Else

			dicUserNameList.Add strUserEntry,strUserAccount

		End If
 

		ObjRecordSet.MoveNext
 

	Loop
 

	msgbox "Entries created"

	Set objDictSorted = SortDict(dicUserNameList)

	window.setTimeout "BuildList()",200

End Sub
 

Function SortDict(ByVal objDict)

 

 Dim i, j, temp

 

 For Each i In objDict

  For Each j In objDict

   If(objDict.Item(i) <= objDict.Item(j)) Then

    temp = objDict.Item(i)

    objDict.Item(i) = objDict.Item(j)

    objDict.Item(j) = temp

   End If

  Next

 Next
 

 'For Each i In objDict

  'msgbox objDict.Item(i)

 'Next
 

 Set SortDict = dicUserNameList
 

End Function
 
 

Sub BuildList
 

	For Each strUser in dicUserNameList

			'msgbox strUser & " " & strUserEmail

			Set objOption = Document.createElement("OPTION")

			objOption.Text = dicUserNameList.Item(strUser)

			objOption.Value = dicUserNameList.Item(strUser)

			'msgbox objOption.Text & " " & objOption.Value

			UserNames.Add(objOption)

	Next
 

End Sub
 

Sub CheckValue
 

	msgbox UserNames.Value
 

End Sub
 

Sub CheckKey

	Set objOptions = UserNames.Options

		

	For Each strOption in objOptions

		strOption.RemoveNode

	Next

	

	If EnterName.Value = "" then

		

		For Each strUser in dicUserNameList

			'msgbox strUser & " " & strUserEmail

			Set objOption = Document.createElement("OPTION")

			objOption.Text = dicUserNameList.Item(strUser)

			objOption.Value = dicUserNameList.Item(strUser)			

			'msgbox objOption.Text & " " & objOption.Value

			UserNames.Add(objOption)

		Next

	

	Else 

		

		'For Each strUser in dicUserNameList

		For Each strUser in objDict

		

		strEntryLength = len(EnterName.Value)

		msgbox left(strUser,strEntryLength)

			If left(strUser,strEntryLength) = Ucase(EnterName.Value) then

				Set objOption = Document.createElement("OPTION")

				objOption.Text = dicUserNameList.Item(strUser)

				objOption.Value = dicUserNameList.Item(strUser)

				UserNames.Add(objOption)

			Else

				'Nothing, doesn't match.

			End If

		Next		

	End If

End Sub

Open in new window

0
Comment
Question by:piattnd
  • 5
  • 4
9 Comments
 
LVL 14

Expert Comment

by:rejoinder
ID: 24319139
Can you try this listbox/filter.
It will poll all users and list them in the box.  The listbox automatically sorts the names so you do not need to run additional code for that.  As you type in the lower text box, the names above are checked and filtered.  Double click the name in the listbox to jump to that individual.
<head>

<title>Your-App</title>

<HTA:APPLICATION 

     APPLICATIONNAME="Your-App"

     BORDER="thick"

     SCROLL="yes"

     SINGLEINSTANCE="yes"

     WINDOWSTATE="MAXIMIZE"

     ID="oHTA"

>

<APPLICATION:HTA>

</head>

 

<script language="VBScript">

 

set dicUserNameList = CreateObject("Scripting.Dictionary")

 

Sub Window_OnLoad

    Set objList = document.getElementById( "lst_UserNames" )

    If objList Is Nothing Then

        MsgBox "A problem was encountered while creating the listview." & vbCRLF & "Please see your administrator."

    Else

        With objList

            .View              = 3

            .Width             = 360

            .Height            = 140

            .SortKey           = 0

            .Arrange           = 0

            .LabelEdit         = 1

            .SortOrder         = 0

            .Sorted            = 1

            .MultiSelect       = 0

            .LabelWrap         = -1

            .HideSelection     = -1

            .HideColumnHeaders = 0

            .OLEDragMode       = 0

            .OLEDropMode       = 0

            .Checkboxes        = 0

            .FlatScrollBar     = 0

            .FullRowSelect     = 1

            .GridLines         = 0

            .HotTracking       = 0

            .HoverSelection    = 0

            .PictureAlignment  = 0

            .TextBackground    = 0

            .ForeColor         = -2147483640

            .BackColor         = -2147483643

            .BorderStyle       = 1

            .Appearance        = 1

            .MousePointer      = 0

            .Enabled           = 1

            .ColumnHeaders.Clear

            .ColumnHeaders.Add , , "Users", 200

            .ListItems.Clear

        End With

    End If

    

    Set adoCommand = CreateObject("ADODB.Command") 

    Set adoConnection = CreateObject("ADODB.Connection") 

    adoConnection.Provider = "ADsDSOObject" 

    adoConnection.Open "Active Directory Provider" 

    adoCommand.ActiveConnection = adoConnection 
 

    ' Search entire Active Directory domain. 

    Set objRootDSE = GetObject("LDAP://RootDSE") 

    strDNSDomain = objRootDSE.Get("defaultNamingContext") 

    strBase = "<LDAP://" & strDNSDomain & ">" 

    

    ' Filter on user objects. 

    strFilter = "(&(objectCategory=person)(objectClass=user))" 

    

    ' Comma delimited list of attribute values to retrieve. 

    strAttributes = "sAMAccountName,givenName,sn,mail" 

    

    ' Construct the LDAP syntax query. 

    strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree" 

    adoCommand.CommandText = strQuery 

    adoCommand.Properties("Page Size") = 100 

    adoCommand.Properties("Timeout") = 30 

    adoCommand.Properties("Cache Results") = False 

    

    ' Run the query. 

    Set adoRecordset = adoCommand.Execute 
 

    ' Enumerate the resulting recordset. 

    Do Until adoRecordset.EOF 

        ' Retrieve values and display. 

        strUserAccount = trim(UCase(adoRecordset.Fields("sAMAccountName").Value))

        strUserEntry   = trim(UCase(adoRecordset.Fields("givenName").Value & " " & adoRecordset.Fields("sn").Value))

        strUserMail    = trim(UCase(adoRecordset.Fields("mail").Value))

        if strUserAccount = "" then strUserAccount = null

        if strUserEntry   = "" then strUserEntry = null

        if strUserMail    = "" then strUserMail = null

        If IsNull(strUserAccount) OR IsNull(strUserEntry) OR IsNull(strUserMail) then

            'skip record, do nothing

        Else

            dicUserNameList.Add strUserEntry,strUserAccount

        End If

        adoRecordset.MoveNext

    loop

    txt_filterUserNames_onKeyUP

End Sub

 

Sub txt_filterUserNames_onKeyUP

    Set objList = document.getElementById( "lst_UserNames" )

    objList.ListItems.Clear

    if txt_filterUserNames.Value <> "" then

        for each User in dicUserNameList

            if InStr(UCase(User),UCase(txt_filterUserNames.Value)) then

                Set objListItem  = objList.ListItems.Add

                objListItem.Text = User

            end if

        next

    else

        for each User in dicUserNameList

            Set objListItem  = objList.ListItems.Add

            objListItem.Text = User

        next

    end if

End Sub
 

Private Sub lst_UserNames_DblClick()

    strUserEntry = lst_UserNames.SelectedItem.Text

    txt_filterUserNames.Value = strUserEntry

    txt_filterUserNames_onKeyUP

    msgbox strUserEntry

End Sub
 

</script>

<body>

Filter based on text keyed in filter box.  Double click the name you want to select.<br>

<OBJECT id="lst_UserNames" name="lst_UserNames" classid="clsid:BDD1F04B-858B-11D1-B16A-00C0F0283628"></OBJECT>

<br>Filter: <input type="text" size="40" id="txt_filterUserNames" name="txt_filterUserNames">

</body>

</html>

Open in new window

0
 
LVL 12

Author Comment

by:piattnd
ID: 24319149
An update on this:

The problem lies within my "sorting" function called SortDict (I got this code on the web, was just trying it out and can't figure it out).

Still need help on sorting the dictionary out!
0
 
LVL 12

Author Comment

by:piattnd
ID: 24319170
Got this message:


script-error.jpg
0
 
LVL 14

Expert Comment

by:rejoinder
ID: 24319771
If you don't have too many names in AD, you can add a line to the code above.
At line 97 add a line that says;
msgbox strUserEntry & "," & strUserAccount
When the HTA runs you will be looking for duplicate names - perhaps blank names?  Something to test out.
0
Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

 
LVL 14

Expert Comment

by:rejoinder
ID: 24320095
Since you want to sort and filter arrays, try using disconnected record sets.  They offer similar features as a temporary database.  You can add fields, field types and field lengths.  Once you have built up your table, you will be able to sort and filter the record set for output.  See below for a sample.
Here is an example which uses a disconnected record set.
http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_23675665.html




Const adVarChar = 200

Const VarCharMaxCharacters = 255

Const adFldIsNullable = 32
 
 

 

Set UsersDB = CreateObject("ADOR.Recordset")

UsersDB.Fields.Append "CN", adVarChar, VarCharMaxCharacters, adFldIsNullable

UsersDB.Fields.Append "DistinguishedName", adVarChar, VarCharMaxCharacters, adFldIsNullable

UsersDB.Open
 

'code to loop through users in AD

    UsersDB.AddNew

    UsersDB("CN") = strCN

    UsersDB("DistinguishedName") = strDN

    UsersDB.Update

    '.movenext

'loop
 

if txt_MyFilter.Value = "" then

    UsersDB.Filter = ""

else

    UsersDB.Filter = "CN LIKE '*" & txt_MyFilter.Value & "*'"

end if
 

UsersDB.Sort = "CN"
 

If UsersDB.RecordCount > 0 then

    UsersDB.MoveFirst

    Do Until UsersDB.EOF

        strCN = UsersDB.Fields.Item("CN").Value

        strDN = UsersDB.Fields.Item("DistinguishedName").Value

        UsersDB.MoveNext

    Loop

End if

Open in new window

0
 
LVL 12

Author Comment

by:piattnd
ID: 24331556
Unfortunately I'll be dealing with upwards of 2,000ish accounts.  Joyful eh?  :)

Thanks much, I'll give this second one a shot when I can.  I was able to take the code i had in place, combined with your original idea, and was able to make a NON sorting solution.  Now, to just figure out why sorting isn't working properly.
0
 
LVL 14

Accepted Solution

by:
rejoinder earned 500 total points
ID: 24331713
Did you look at this example or sorting a dictionary object...
http://support.microsoft.com/default.aspx/kb/246067
0
 
LVL 12

Author Comment

by:piattnd
ID: 24505178
I was able to track down a friend who actually had a function that did the sort.  I have yet to impliment it (haven't had time), but I appreciate your help!
0
 
LVL 12

Author Closing Comment

by:piattnd
ID: 31578641
Thanks again for the help!
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Suggested Solutions

Have you tried to learn about Unicode, UTF-8, and multibyte text encoding and all the articles are just too "academic" or too technical? This article aims to make the whole topic easy for just about anyone to understand.
Not sure what the best email signature size is? Are you worried about email signature image size? Follow this best practice guide.
In this tutorial viewers will learn how to define a gradient in CSS. Create a new HTML document with an internal stylesheet.: Create a div in CSS and name it Gradient. Define the background as "linear-gradient(to right, #ee3668, black)". Ensure you …
In this tutorial viewers will learn how to embed Flash content in a webpage using HTML5. Ensure your DOCTYPE declaration is set to HTML5: "<!DOCTYPE html>": Use the <object> tag to embed Flash content.: To specify that the object is Flash content, d…

708 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now