Solved

VBScript: OLEDB Persistence Provider Error.

Posted on 2008-10-16
3
1,451 Views
Last Modified: 2013-11-29
I am not a vbscript developer, I have a bare understanding of the language and what it does from knowledge of other languages (php, sql, xhtml, javascript etc).  I have found a vbscript online that connects to active directory and pulls down information into an xml file and saves it as html.

I have implemented this script for 10 other servers and terminal servers that all work correctly.  However this is the first time doing it on a 64bit Windows Server 2003.  All others have been 32 bit.

The script is not exactly as it was how I found it, I have modified it and added to it to meet my needs including some code that I wrote of my own (From basic vbscript understanding)

I am getting these errors:

Microsoft OLEDB Persistence Provider: Requested conversion is not supported.

and

Script: scriptname
Line: 53
Char: 1
Error: Requested conversion is not supported.
Code: 80040E1D
Source: Microsoft OLEDB Persistence Provider

Line 53 is this line:
rsAD.Save xml, adPersistXML

I've attached the entire code.  The issue is not with the XML file - the HTML file saves correctly but all the active directory information that should be there, is not there.  

The script works fine on a 32bit server.  

I have tried executing the script with both \system32\cscript and \syswow64\cscript
Const adPersistXML = 1
Const ForWriting = 2
'on error resume next
 
Dim XML,XSL, FSO
Dim WshShell, WshNet, rsAD, Com, ConAD, f
 
'We need to get details from attributes that are only available from the LDAP provider
'We cannot assume that the AdsSecurity.DLL is available on the client to retrieve our DN
 
'What we do know, is who we are (samaccountname) and that must be unique within a domain
Set WshNet = WScript.CreateObject("WScript.Network")
sUsername = WshNet.UserName
 
'Wscript.Network knows the Netbios Domain, but we might not know our DNS domainname
sPrefix = "LDAP://"
Set cont = GetObject(sPrefix & "rootdse")
sDN = cont.get("defaultnamingcontext")
 
 
'Alright - we are now prep'd to do a little search to get our adspath...
'We will open an ADO connection to AD
Set conAD = CreateObject( "ADODB.Connection" )
Set com = CreateObject( "ADODB.Command" )
 
'set the provider
conAD.Provider = "ADSDSOObject"
' Open a connection object
conAD.Open "Active Directory Provider"
Set Com.ActiveConnection = conADa
 
'what do we want to find - well our details...
sFilter = "(samaccountname=" & sUsername & ")"
'what do we need to know?
sAttributes = "givenname,sn,telephoneNumber,mail,streetAddress,l,st,postalCode,co,mobile,company,facsimileTelephoneNumber,title,department,wWWHomePage,ipphone,postOfficeBox"
 
'build the command string
Com.CommandText = "<" & sPrefix & sDN & ">;" & sFilter & ";" & sAttributes
 
' Set some preferences for search
Com.Properties( "Page Size" ) = 512
Com.Properties( "TimeOut" ) = 30 ' seconds
 
'Execute the query to get our objects from Active Directory.
Set rsAD = CreateObject("ADODB.Recordset")
Set rsAD = Com.Execute
 
If (Err.Number <> 0) Then
    WScript.Echo Err.Number, "on Execute"
End If
'WScript.Echo "LDAP user objects:" & rsAD.RecordCount
Set xml = CreateObject("Microsoft.XMLDOM")
rsAD.Save xml, adPersistXML
XML.async = False
 
Set xsl = CreateObject("Microsoft.XMLDOM")
XSL.async = False
'Load the XSL file. We keep it in the same path as the script, but it could be stored anyway. e.g. Webserver
XSL.load "\\king2003\netlogon\DeploySignatures\signature.xml"
 
XSL.preserveWhiteSpace = True
'Lets Save the signature file to disk to the profile - we are aiming for the Outlook signature path
Set WshShell = CreateObject("Wscript.Shell")
sUserProfile = WshShell.ExpandEnvironmentStrings("%appdata%")
sSignaturePath= sUserProfile & "\Microsoft\Signatures\"
 
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(sUserProfile & "\Microsoft") = False Then
      Set f = fso.CreateFolder(sUserProfile & "\Microsoft")
End If
If fso.FolderExists(sUserProfile & "\Microsoft\Signatures") = False Then
      Set f = fso.CreateFolder(sUserProfile & "\Microsoft\Signatures")
End If
 
 
sOutputfile = sSignaturePath & sUsername & ".htm"
Set FSO = CreateObject("Scripting.Filesystemobject")
Set f = fso.OpenTextFile(sOutputFile,ForWriting,True)
f.Write xml.transformNode(xsl)
 
'Make it the default signature, if no signature is set.
'Is not dependant on any specific Office Version
'Outlook needs to be CLOSED - so ensure this script is run before outlook is loaded.
 
Call SetDefaultSignature(sUsername, "")
 
	Dim objFSO
	Dim strNWStatLoc
	Dim strLocStatLoc
	
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	strNWStatLoc = "\\king2003\netlogon\DeploySignatures\logo.gif"
	strLocStatLoc = sUserProfile & "\Microsoft\Signatures\"
	objFSO.CopyFile strNWStatLoc, strLocStatLoc, True
 
 
	'Cleanup
	Set objFSO = Nothing
 
 
 
Sub SetDefaultSignature(strSigName, strProfile)
    Const HKEY_CURRENT_USER = &H80000001
    strComputer = "."
        Set objreg = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
        strKeyPath = "Software\Microsoft\Windows NT\" & "CurrentVersion\Windows " & "Messaging Subsystem\Profiles\"
 
        ' get default profile name if none specified
        If strProfile = "" Then
            objreg.GetStringValue HKEY_CURRENT_USER, _
              strKeyPath, "DefaultProfile", strProfile
        End If
 
        ' build array from signature name
        myArray = StringToByteArray(strSigName, True)
        strKeyPath = strKeyPath & strProfile & "\9375CFF0413111d3B88A00104B2A6676"
        objreg.EnumKey HKEY_CURRENT_USER, strKeyPath, arrProfileKeys
        For Each subkey In arrProfileKeys
            strsubkeypath = strKeyPath & "\" & subkey
            'On Error Resume Next
            objreg.SetBinaryValue HKEY_CURRENT_USER, strsubkeypath, "New Signature", myArray
            objreg.SetBinaryValue HKEY_CURRENT_USER, strsubkeypath, "Reply-Forward Signature", myArray
        Next
End Sub
 
Public Function StringToByteArray(Data, NeedNullTerminator)
    Dim strAll
    strAll = StringToHex4(Data)
    If NeedNullTerminator Then
        strAll = strAll & "0000"
    End If
    intLen = Len(strAll) \ 2
    ReDim arr(intLen - 1)
    For i = 1 To Len(strAll) \ 2
        arr(i - 1) = CByte _
                   ("&H" & Mid(strAll, (2 * i) - 1, 2))
    Next
    StringToByteArray = arr
End Function
 
Public Function StringToHex4(Data)
    ' Input: normal text
    ' Output: four-character string for each character,
    '         e.g. "3204" for lower-case Russian B,
    '        "6500" for ASCII e
    ' Output: correct characters
    ' needs to reverse order of bytes from 0432
    Dim strAll
    For i = 1 To Len(Data)
        ' get the four-character hex for each character
        strChar = Mid(Data, i, 1)
        strTemp = Right("00" & Hex(AscW(strChar)), 4)
        strAll = strAll & Right(strTemp, 2) & Left(strTemp, 2)
    Next
    StringToHex4 = strAll
End Function

Open in new window

0
Comment
Question by:TawneyFollett
3 Comments
 
LVL 1

Accepted Solution

by:
TawneyFollett earned 0 total points
ID: 22818642
I Found the solution to my problem, it was that I added postOfficeBox to the attribute list and it doesn't seem to like it (This is odd though as I've added ipphone and l without any issues)
0

Featured Post

NAS Cloud Backup Strategies

This article explains backup scenarios when using network storage. We review the so-called “3-2-1 strategy” and summarize the methods you can use to send NAS data to the cloud

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Possible fixes for Windows 7 and Windows Server 2008 updating problem. Solutions mentioned are from Microsoft themselves. I started a case with them from our Microsoft Silver Partner option to open a case and get direct support from Microsoft. If s…
An article on effective troubleshooting
This video Micro Tutorial explains how to clone a hard drive using a commercial software product for Windows systems called Casper from Future Systems Solutions (FSS). Cloning makes an exact, complete copy of one hard disk drive (HDD) onto another d…
The viewer will learn how to successfully create a multiboot device using the SARDU utility on Windows 7. Start the SARDU utility: Change the image directory to wherever you store your ISOs, this will prevent you from having 2 copies of an ISO wit…

786 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