Simple VBScript (VB/VBS/VBA) for converting documents (DOC/XLS/PPT/EML) to PDF from a SOAP web service

Article created on October 22nd, 2009 in category PDF Conversion viewed 5,078 times

Print2PDF includes an easily accessible web service. Once the Windows Service has been installed and integrated into Microsoft Internet Information Services, you can call the web service from virtually any programming language that can communicate via HTTP to the server. Unify PDF conversion in your organization using the same Print2PDF profiles (e.g. Standard, Archive PDF/A-1a).

Please note the following ways to access the Print2PDF web service:

You can access the interactive web application at http://localhost/Print2PDF/
View the .NET generated documentation at http://localhost/Print2PDF_service/
Obtain the web service description language file at http://localhost/Print2PDF_service/?WSDL

Print2PDF Service Manager

Below is a very simple SOAP call sample using VBScript. Please note the following:

This example should only be used on files less than 1MB, anything larger will timeout due to the non-native Base64 functions. Use an external component for larger files.
Change profile.ini as desired (e.g. profile.ini = STANDARD, profile004.ini = PDF/A).
Change the constants at the top of the file to specify the server URL, input file, and output file.

Copy the content below into a text file and save it as print2pdf-soap.vbs:

' ///////////////////////////////////////////////////////////
' // Print2PDF Web Service Example (print2pdf-soap.vbs)
' ///////////////////////////////////////////////////////////
 
' // SOAP URL and input file to convert
Const SOAPSERVER = "http://localhost/Print2PDF_service/default.asmx"
Const INPUTDIR = "C:\"
Const INPUTFILE = "test.doc"
Const OUTPUTDIR = "C:\"
Const OUTPUTFILE = "test.pdf"
 
WScript.Echo "Reading file from disk..."
 
' // Read file using ADODB Stream
Const adTypeBinary = 1
Const adTypeText = 2
Const adSaveCreateOverWrite = 2
Dim BinaryStream, ReadFile
Set BinaryStream = CreateObject("ADODB.Stream")
BinaryStream.Type = adTypeBinary
BinaryStream.Open
BinaryStream.LoadFromFile INPUTDIR & INPUTFILE
ReadFile = BinaryStream.Read
BinaryStream.Close
 
' // SOAP Request
Dim SOAPRes, Temp, SOAPMessage, http, output
Const SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS = 13056
SOAPMessage = "<soap:Envelope xmlns:soap=""http://www.w3.org/2003/05/soap-envelope"">" & _
"<soap:Body>" & _
    "<ConvertFile xmlns=""http://software602.com/print2pdf/"">" & _
        "<Input>" & Base64Encode(BinaryToString(ReadFile)) & "</Input>" & _
        "<FileName>" & INPUTFILE & "</FileName>" & _
        "<Profile>profile.ini</Profile>" & _
    "</ConvertFile>" & _
"</soap:Body>" & _
"</soap:Envelope>"
 
WScript.Echo "Sending SOAP payload to server..."
 
' // Setup the SOAP packet and set it to ignore all cert errors (if self-signed cert)
Set xmlhttp = CreateObject("MSXML2.ServerXMLHTTP")
xmlhttp.setTimeouts 60000, 60000, 60000, 60000
xmlhttp.setOption 2, SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS
 
xmlhttp.open "POST", SOAPSERVER, False
xmlhttp.setRequestHeader "Man", POST & " " & SOAPSERVER & " HTTP/1.1"
xmlhttp.setRequestHeader "MessageType", "CALL"
xmlhttp.setRequestHeader "Content-Type", "text/xml"
xmlhttp.send(SoapMessage)
 
' // Response
SOAPRes = Split(xmlhttp.responseText, "<")
Temp = Split(SOAPRes(5), ">")
 
If Temp(1) = 0 then
    ' Success, save output to disk
    Temp = Split(SOAPRes(7), ">")
    Output = Base64ToBSTR(Temp(1))
 
    Set BinaryStream = CreateObject("ADODB.Stream")
    BinaryStream.Type = adTypeText
    BinaryStream.Open
    BinaryStream.WriteText Output
    BinaryStream.SaveToFile OUTPUTDIR & OUTPUTFILE, adSaveCreateOverWrite
 
    WScript.Echo "Conversion complete."
Else
    ' Failure
    Temp = Split(SOAPRes(7), ">")
    WScript.Echo "Conversion failed." & VBCRLF & VBCRLF & Temp(1)
End if
 
' /////////////////////////////////
' // Base64 Functions
' /////////////////////////////////
 
Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
 
Function Base64Encode(inData)
    'rfc1521
    '2001 Antonin Foller, Motobit Software, http://Motobit.cz
    Dim cOut, sOut, I
 
    'For each group of 3 bytes
    For I = 1 To Len(inData) Step 3
        Dim nGroup, pOut, sGroup
 
        'Create one long from this 3 bytes.
        nGroup = &H10000 * Asc(Mid(inData, I, 1)) + _
        &H100 * MyASC(Mid(inData, I + 1, 1)) + MyASC(Mid(inData, I + 2, 1))
 
        'Oct splits the long To 8 groups with 3 bits
        nGroup = Oct(nGroup)
 
        'Add leading zeros
        nGroup = String(8 - Len(nGroup), "0") & nGroup
 
        'Convert To base64
        pOut = Mid(Base64, CLng("&o" & Mid(nGroup, 1, 2)) + 1, 1) + _
        Mid(Base64, CLng("&o" & Mid(nGroup, 3, 2)) + 1, 1) + _
        Mid(Base64, CLng("&o" & Mid(nGroup, 5, 2)) + 1, 1) + _
        Mid(Base64, CLng("&o" & Mid(nGroup, 7, 2)) + 1, 1)
 
        'Add the part To OutPut string
        sOut = sOut + pOut
 
        'Add a new line For Each 76 chars In dest (76*3/4 = 57)
        'If (I + 2) Mod 57 = 0 Then sOut = sOut + vbCrLf
    Next
    Select Case Len(inData) Mod 3
        Case 1: '8 bit final
            sOut = Left(sOut, Len(sOut) - 2) + "=="
        Case 2: '16 bit final
            sOut = Left(sOut, Len(sOut) - 1) + "="
    End Select
    Base64Encode = sOut
End Function
 
Function MyASC(OneChar)
    If OneChar = "" Then MyASC = 0 Else MyASC = Asc(OneChar)
End Function
 
Function BinaryToString(Binary)
    'Antonin Foller, http://www.motobit.com
    'Optimized version of a simple BinaryToString algorithm.
 
    Dim cl1, cl2, cl3, pl1, pl2, pl3
    Dim L
    cl1 = 1
    cl2 = 1
    cl3 = 1
    L = LenB(Binary)
 
    Do While cl1<=L
        pl3 = pl3 & Chr(AscB(MidB(Binary,cl1,1)))
        cl1 = cl1 + 1
        cl3 = cl3 + 1
        If cl3>300 Then
            pl2 = pl2 & pl3
            pl3 = ""
            cl3 = 1
            cl2 = cl2 + 1
            If cl2>200 Then
                pl1 = pl1 & pl2
                pl2 = ""
                cl2 = 1
            End If
        End If
    Loop
    BinaryToString = pl1 & pl2 & pl3
End Function
 
Function Base64ToBSTR(sBase64)
    For i = 1 To Len(sBase64) Step 4
        w1 = FindPos(Mid(sBase64, i, 1))
        w2 = FindPos(Mid(sBase64, i + 1, 1))
        w3 = FindPos(Mid(sBase64, i + 2, 1))
        w4 = FindPos(Mid(sBase64, i + 3, 1))
        If (w2 >= 0) Then ByteArray = ByteArray & chrB((w1 * 4 + Int(w2 / 16)) And 255)
        If (w3 >= 0) Then ByteArray = ByteArray & chrB((w2 * 16 + Int(w3 / 4)) And 255)
        If (w4 >= 0) Then ByteArray = ByteArray & chrB((w3 * 64 + w4) And 255)
    Next
    Base64ToBSTR = ByteArray
End Function
 
Function FindPos(sChar)
    If (Len(sChar) = 0) Then
        FindPos = -1
    Else
        FindPos = InStr(Base64, sChar) - 1
    End If
End Function

Tags: pdf, soap, software602, vba, vbs

vbscript pdf (54), vbscript vbs (50), vbscript ppt (27), vbscript soap (26), vbscript to convert pdf to text (25)

Comments are closed.

Latest Articles

BinaryNow

Articles