Software602 Home . products . download . support . register . how to buy . . view cart . . . contact us . . . .
Software602 Home . . . . . .
. .
.
.
Print2PDF 8.0 Home
.
Overview
.
What's New
.
Shared Printer
.
Conversion Services
.
Demos & Screenshots
.
Our Customers
.
Download Trial
.
Documentation
.
System Requirements
.
Licensing FAQ
.
Click here to compare Print2PDF editions
Questions? Contact Us
How to Buy, Purchasing
Print2PDF supports Microsoft Windows Vista, 64-bit (x64) and PDF/A
.

Convert any document (DOC/XLS/PPT/EML/TXT) to PDF/A from a SOAP web service using VBScript (VB/VBS/VBA)

Print2PDF 8.0 now 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 practices 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:

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>profile.ini</Profile> to use whatever Print2PDF profile for conversion (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.
' ///////////////////////////////////////////////////////////
' // Print2PDF Web Service Example (soap-example-file.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

Leave a Comment

Comments for this post will be closed in 44 hours.

.
.
  © 2008 Software602, Inc. All rights reserved.