VBA/Corel Draw: How to send binary and text file i

I want to send Corel Draw .CDR drawing binary files and XML SVG files from the application to a server via HTTP POST.

I have done some research and this existing post seems closest but doesn't work for my situation: How can I send an HTTP POST request to a server from Excel using VBA?

I've added a user-custom button to the Corel Draw tool pane and created a macro to run when this button is pressed. The macro contains the following code.



Sub OpenLabelPrintExport()
    '
    ' Recorded 24/06/2008
    '
    ' Description:
    '
    '

' Add a reference to Microsoft WinHTTP Services
Const HTTPREQUEST_SETCREDENTIALS_FOR_SERVER = 0

    'MsgBox "hello"

    Dim expflt As ExportFilter
    Dim expopt As StructExportOptions
    Dim responseText As String
    Set expopt = New StructExportOptions
    expopt.UseColorProfile = False
    ' expopt.DontExportFonts
    Set expflt = ActiveDocument.ExportEx("C:\afile.svg", cdrSVG, cdrAllPages, expopt)
    expflt.Finish

    file = "C:\afile.svg"

    Dim oS As ADODB.STREAM
    Set oS = New STREAM

    oS.Type = 2
    oS.Open
    oS.LoadFromFile file

    Dim contentlength As Integer
    contentlength = oS.Size

sEntityBody = "-----boundary" & vbCrLf
sEntityBody = sEntityBody & "Content-Dispostion: form-data; name=fileInputElementName; filename=""" + sFileName + """" & vbCrLf
sEntityBody = sEntityBody & "Content-Transfer-Encoding: 7bit" & vbCrLf
sEntityBody = sEntityBody & "Content-Type: text/xml" & vbCrLf & vbCrLf
' did use oS
sEntityBody = sEntityBody & "text" & vbCrLf
sEntityBody = sEntityBody & "-----boundary--" & vbCrLf & vbCrLf

' Set xhr = New MSXML2.XMLHTTP30

Dim xhr As WinHttp.WinHttpRequest
Set xhr = New WinHttpRequest

xhr.Open "POST", sUrl, False
xhr.SetRequestHeader "Content-Type", "multipart/form-data; boundary=""-----boundary"""
xhr.Send sEntityBody

End Sub

On my server, I have the following Perl CGI script to accept the file:


#!/usr/bin/perl -wT

use strict;
use CGI;
use CGI::Carp qw ( fatalsToBrowser );
use File::Basename;

$CGI::POST_MAX = 1024 * 5000;
my $safe_filename_characters = "a-zA-Z0-9_.-";
my $upload_dir = "/usr/lib/cgi-bin/";

my $query = new CGI;
my $filename = $query->param("file");
my $email_address = $query->param("email_address");

if ( !$filename )
{
 print $query->header ( );
 print "There was a problem uploading your file (try a smaller file).";
 exit;
}

my ( $name, $path, $extension ) = fileparse ( $filename, '\..*' );
$filename = $name . $extension;
$filename =~ tr/ /_/;
$filename =~ s/[^$safe_filename_characters]//g;

if ( $filename =~ /^([$safe_filename_characters]+)$/ )
{
 $filename = $1;
}
else
{
 die "Filename contains invalid characters";
}

my $upload_filehandle = $query->upload("file");

open ( UPLOADFILE, ">$upload_dir/$filename" ) or die "$!";
binmode UPLOADFILE;

while (  )
{
 print UPLOADFILE;
}

close UPLOADFILE;

print STDOUT "success";

I have tested the server-side script with a HTML form on a brower.

I would like advise on getting the VBA script that runs in Corel Draw to work correctly. I have searched and searched and can't seem to find a definitive answer to sending binary and text files from a VBA enabled application to a server via HTTP POST. I have bought some books on the subject too but am no wiser.

I need this to work with Corel Draw 12 and Corel Draw X4.

Thanks in advance.

回答1:

Here is a working solution for Corel Draw 12. This is for exporting SVG - it could be extended to export .CDR and .PDF at the same time using the exporter object provided by Corel for the Visual Basic Application environment. For these two binary formats, base64 may be required to encode them before sending.

Credits:

credit http://www.vbforums.com/showthread.php?t=337424 extended this function to actually do the sending originally the function used Winsock - but this is unavailable in the Visual Basic Application environment of Corel Draw 12/XIV So I replaced this with a WinHttpRequest
credit: http://bytes.com/topic/asp-classic/answers/659406-winhttprequest-posting-byte-string-multipart-message-howto#post2618801 - for adding the req.setRequestHeader "Content-Type", "multipart/form-data; boundary=" & boundary line which is required in WinHttpRequest so that the server-side code on receiving the post can retrieve the actual file data and other params
credit: http://word.mvps.org/faqs/macrosvba/DeleteFiles.htm to delete the temporary file

Four parts to the solution provided below:

Instructions for installing the Corel Draw Visual Basic Application code (part 2 below)
The Corel Draw Visual Basic Application code
the server-side Perl CGI script to accept the file sent as a standard HTTP POST CGI message
test html form web page just to test the server-side Perl cgi script

1) Instructions

Corel Draw: Tools->Visual Basic->Visual Basic Editor
Back to Microsoft Visual Basic: View->Project Explorer
Open FileConverter->Modules->Recorded Macros
Paste in code. NOTE: May need to add-in objects required by script, such as WinHttpRequest, via the Object Browser: View->Object Browser
Close, back to...
Back to Corel Draw: Tools->Customization
In Option pop-up dialog: Options->Customization->Command Bars
Click New
Export To Server for tool bar name
click OK
Drag newly created toolbar onto top pane it should be 'absorbed' into it.
Right click on it
Customize->Export to server toolbar->Add new command
From drop down in 'Options' dialog, select Macros
Find FileConverter.RecordedMacros.DrawingExportToServer
Drag and drop this onto the newly created blank Export to server toolbar to create the button
To export a drawing to the server: create a drawing as usual and click the button

2) The Corel Draw Visual Basic Application code

Type URL
    Scheme As String
    Host As String
    Port As Long
    URI As String
    Query As String
End Type

Sub DrawingExportToServer()

    Dim expflt As ExportFilter
    Dim expopt As StructExportOptions
    Dim responseText As String
    Set expopt = New StructExportOptions
    expopt.UseColorProfile = False

    ' moved from BuildFileUploadRequest to here
    ' want to re-use this for generating a temporary file name that has minimal risk of clashing/overwriting an other temporary files
    Dim strBoundary As String
    strBoundary = RandomAlphaNumString(32)

    Dim tempExportFile As String
    tempExportFile = "C:\WINDOWS\Temp\tempExportFileCorelDraw_" & strBoundary & ".svg"

    Set expflt = ActiveDocument.ExportEx(tempExportFile, cdrSVG, cdrAllPages, expopt)
    expflt.Finish

    Dim realFilenameOfDrawing As String
    realFilenameOfDrawing = ActiveDocument.FileName
    realFilenameOfDrawing = realFilenameOfDrawing & ".svg"

    Dim strFile As String
    strFile = GetFileContents(tempExportFile)
    Dim strHttp As String

    sUrl = "http://myserver.com/cgi-bin/server_side_perl_script.cgi"

    Dim DestUrl As URL
    DestUrl = ExtractUrl(sUrl)

    strHttp = BuildFileUploadRequest(strFile, DestUrl, "file", realFilenameOfDrawing, "text/xml", strBoundary, sUrl)


    KillProperly (tempExportFile)

End Sub

' credit http://www.vbforums.com/showthread.php?t=337424
' extended this function to actually do the sending
' originally the function used Winsock - but this is unavailable in the Visual Basic Application environment of Corel Draw 12/XIV
' So I replaced this with a WinHttpRequest
' credit: http://bytes.com/topic/asp-classic/answers/659406-winhttprequest-posting-byte-string-multipart-message-howto#post2618801
' - for adding the req.setRequestHeader "Content-Type", "multipart/form-data; boundary=" & boundary
' line which is required in WinHttpRequest so that the server-side  code on receiving the post can retrieve the actual file data and other params
Private Function BuildFileUploadRequest(ByRef strData As String, _
                                        ByRef DestUrl As URL, _
                                        ByVal UploadName As String, _
                                        ByVal FileName As String, _
                                        ByVal MimeType As String, _
                                        ByVal aStrBoundary As String, _
                                        ByVal aUrlString As String) As String

    Dim strHttp As String ' holds the entire HTTP request
    Dim strBoundary As String 'the boundary between each entity
    Dim strBody As String ' holds the body of the HTTP request
    Dim lngLength As Long ' the length of the HTTP request

    ' create a boundary consisting of a random string
    'strBoundary = RandomAlphaNumString(32)
    strBoundary = aStrBoundary

    ' create the body of the http request in the form
    '
    ' --boundary
    ' Content-Disposition: form-data; name="UploadName"; filename="FileName"
    ' Content-Type: MimeType
    '
    ' file data here
    '--boundary--
    strBody = "--" & strBoundary & vbCrLf
    strBody = strBody & "Content-Disposition: form-data; name=""" & UploadName & """; filename=""" & _
                    FileName & """" & vbCrLf
    strBody = strBody & "Content-Type: " & MimeType & vbCrLf
    strBody = strBody & vbCrLf & strData
    strBody = strBody & vbCrLf & "--" & strBoundary & "--"

    ' find the length of the request body - this is required for the
    ' Content-Length header
    lngLength = Len(strBody)

    ' construct the HTTP request in the form:
    '
    ' POST /path/to/reosurce HTTP/1.0
    ' Host: host
    ' Content-Type: multipart-form-data, boundary=boundary
    ' Content-Length: len(strbody)
    '
    ' HTTP request body
    strHttp = "POST " & DestUrl.URI & "?" & DestUrl.Query & " HTTP/1.0" & vbCrLf
    strHttp = strHttp & "Host: " & DestUrl.Host & vbCrLf
    strHttp = strHttp & "Content-Type: multipart/form-data, boundary=" & strBoundary & vbCrLf
    strHttp = strHttp & "Content-Length: " & lngLength & vbCrLf & vbCrLf
    strHttp = strHttp & strBody


    Dim ContentType As String

    Dim xhr As New WinHttp.WinHttpRequest

    Dim anUploadName As String
    anUploadName = "file"

    Dim aFileName As String
    aFileName = "file"

    Dim aContentType As String
    aMimeType = "text/xml"

    ContentType = "multipart/form-data, boundary=" & strBoundary & vbCrLf

    xhr.Open "POST", aUrlString, False

    xhr.SetRequestHeader "Content-Type", ContentType

    xhr.Send strHttp

    BuildFileUploadRequest = strHttp
End Function



' this function retireves the contents of a file and returns it as a string
' this is also ture for binary files
Private Function GetFileContents(ByVal strPath As String) As String
    Dim StrReturn As String
    Dim lngLength As Long

    lngLength = FileLen(strPath)
    StrReturn = String(lngLength, Chr(0))

    On Error GoTo ERR_HANDLER

    Open strPath For Binary As #1

    Get #1, , StrReturn

    GetFileContents = StrReturn

    Close #1

    Exit Function

ERR_HANDLER:
    MsgBox Err.Description, vbCritical, "ERROR"

    Err.Clear
End Function


' generates a random alphanumeirc string of a given length
Private Function RandomAlphaNumString(ByVal intLen As Integer)
    Dim StrReturn As String

    Dim X As Integer
    Dim c As Byte

    Randomize

    For X = 1 To intLen
        c = Int(Rnd() * 127)

        If (c >= Asc("0") And c <= Asc("9")) Or _
           (c >= Asc("A") And c <= Asc("Z")) Or _
           (c >= Asc("a") And c <= Asc("z")) Then

            StrReturn = StrReturn & Chr(c)
        Else
            X = X - 1
        End If
    Next X

    RandomAlphaNumString = StrReturn
End Function





' returns as type URL from a string
Function ExtractUrl(ByVal strUrl As String) As URL
    Dim intPos1 As Integer
    Dim intPos2 As Integer

    Dim retURL As URL

    '1 look for a scheme it ends with ://
    intPos1 = InStr(strUrl, "://")

    If intPos1 > 0 Then
        retURL.Scheme = Mid(strUrl, 1, intPos1 - 1)
        strUrl = Mid(strUrl, intPos1 + 3)
    End If

    '2 look for a port
    intPos1 = InStr(strUrl, ":")
    intPos2 = InStr(strUrl, "/")

    If intPos1 > 0 And intPos1 < intPos2 Then
        ' a port is specified
        retURL.Host = Mid(strUrl, 1, intPos1 - 1)

        If (IsNumeric(Mid(strUrl, intPos1 + 1, intPos2 - intPos1 - 1))) Then
                retURL.Port = CInt(Mid(strUrl, intPos1 + 1, intPos2 - intPos1 - 1))
        End If
    ElseIf intPos2 > 0 Then
        retURL.Host = Mid(strUrl, 1, intPos2 - 1)
    Else
        retURL.Host = strUrl
        retURL.URI = "/"

        ExtractUrl = retURL
        Exit Function
    End If

    strUrl = Mid(strUrl, intPos2)

    ' find a question mark ?
    intPos1 = InStr(strUrl, "?")

    If intPos1 > 0 Then
        retURL.URI = Mid(strUrl, 1, intPos1 - 1)
        retURL.Query = Mid(strUrl, intPos1 + 1)
    Else
        retURL.URI = strUrl
    End If

    ExtractUrl = retURL
End Function

' url encodes a string
Function URLEncode(ByVal str As String) As String
        Dim intLen As Integer
        Dim X As Integer
        Dim curChar As Long
        Dim newStr As String

        intLen = Len(str)
        newStr = ""

        ' encode anything which is not a letter or number
        For X = 1 To intLen
            curChar = Asc(Mid$(str, X, 1))


            If curChar = 32 Then
                ' we can use a + sign for a space
                newStr = newStr & "+"
            ElseIf (curChar < 48 Or curChar > 57) And _
                (curChar < 65 Or curChar > 90) And _
                (curChar < 97 Or curChar > 122) Then


                newStr = newStr & "%" & Hex(curChar)
            Else
                newStr = newStr & Chr(curChar)
            End If
        Next X

        URLEncode = newStr
End Function

' decodes a url encoded string
Function UrlDecode(ByVal str As String) As String
        Dim intLen As Integer
        Dim X As Integer
        Dim curChar As String * 1
        Dim strCode As String * 2

        Dim newStr As String

        intLen = Len(str)
        newStr = ""

        For X = 1 To intLen
            curChar = Mid$(str, X, 1)

            If curChar = "%" Then
                strCode = "&h" & Mid$(str, X + 1, 2)

                If IsNumeric(strCode) Then
                    curChar = Chr(Int(strCode))
                Else
                    curChar = ""
                End If
                                X = X + 2
            End If

            newStr = newStr & curChar
        Next X

        UrlDecode = newStr
End Function

' credit: http://word.mvps.org/faqs/macrosvba/DeleteFiles.htm
Public Sub KillProperly(Killfile As String)
    If Len(Dir$(Killfile)) > 0 Then
        SetAttr Killfile, vbNormal
        Kill Killfile
    End If
End Sub

3) the server-side Perl CGI script to accept the file sent as a standard HTTP POST CGI message

#!/usr/bin/perl -w 

use strict;
use warnings;

use CGI;
use CGI::Carp qw ( fatalsToBrowser );
use File::Basename;

sub main
{
  my $rc = 0;
  my $errorMsg = "";

  $CGI::POST_MAX = 1024 * 5000;
  my $safe_filename_characters = "a-zA-Z0-9_.-";

  # NOTE: make sure that appropriate chmod permissions are set so that the script can create and write files to this directory
  my $upload_top_level = "/usr/lib/cgi-bin/drawings";

  # NOTE: make sure that appropriate chmod permissions are set in this file's parent holding directory and the file itself if already exists 
  # so that the script can create and write the file
  my $upload_log = "/usr/lib/cgi-bin/uploadlog.txt";


  my $query = new CGI;
  my $filename = $query->param("file");
  my $machineid = $query->param("machineid");

  my %allParams = $query->Vars;

  my $allParamsAsString = "";

  my $paramName = "";
  foreach $paramName ( keys ( %allParams ) )
  {
    $allParamsAsString .= "$paramName=".$allParams{$paramName};
  }

  if ( !$filename )
  {
   $rc = 1;
   $errorMsg = "Filename not specified.";
  }

  if ( $rc == 0 )
  {
    my ( $name, $path, $extension ) = fileparse ( $filename, '\..*' );
    $filename = $name . $extension;
    $filename =~ tr/ /_/;
    $filename =~ s/[^$safe_filename_characters]//g;

    if ( $filename =~ /^([$safe_filename_characters]+)$/ )
    {
     $filename = $1;
    }
    else
    {
     $rc = 1;
     $errorMsg = "Filename contains invalid characters.";
    }
  }

  if ( $rc == 0)
  {
    my $upload_filehandle = $query->upload("file"); # file is the file field in the form

    my $upload_path = "";

    # if a machine id is provided
    # then we make a subdirectory off of the main top level uploads directory
    if ( $machineid )
    {
      $upload_path = $upload_top_level."/".$machineid."/";

      if (!( -e $upload_path ))
      {
        mkdir $upload_path;
      }
    }
    else
    {
      $upload_path = $upload_top_level."/";
    }

    unless( open ( UPLOADFILE, ">$upload_path/$filename" ) )
    {
      $rc = 1;
      $errorMsg = "Cannot open $upload_path/$filename";
    }

    if ( $rc == 0 )
    {
      binmode UPLOADFILE;

      while ( <$upload_filehandle> )
      {
        print UPLOADFILE;
      }

      close UPLOADFILE;

      print STDOUT $query->header();
      $errorMsg = "Success.";
      print STDOUT responseToClient( "Success." );
    }
  }
  else
  {
    print STDOUT $query->header();
    print STDOUT responseToClient( $errorMsg );
  }

  # needs (f)locking
  open ( LOG, ">>$upload_log" );
  print LOG $filename.", ".$machineid.", ".$errorMsg.", ".$query->all_parameters.", ".$allParamsAsString."\n";
  close ( LOG );


}


sub responseToClient
{
  my ( $message ) = @_;

  my $response =
    "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"DTD/xhtml1-strict.dtd\">\n"
   ."<html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"en\">\n"
   ."<head>\n"
   ."<meta http-equiv=\"Content-Type\" content=\"text/html; charset=utf-8\" />\n"
   ."<title>".$message."</title>\n"
   ."</head>\n"
   ."<body>\n"
   ."<p>".$message."</p>\n"
   ."</body>\n"
   ."</html>\n\n";

  return $response;
}

main ();

4) test html form web page just to test the server-side Perl cgi script

<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
 <head>
   <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
   <title>File Upload</title>
 </head>
 <body>
   <form action="/cgi-bin/nsr_store_label.cgi" method="post"  
enctype="multipart/form-data">
     <p>File to Upload: <input type="file" name="file" /></p>
     <p>Machine id: <input type="text" name="machineid" /></p>
     <p><input type="submit" name="Submit" value="Submit Form" /></p>
   </form>
 </body>
</html>

回答2:

You can save the file locally, and then use cURL to post the data to your server (using the Shell command in VBA).