VBA / Corel Draw: Как отправить двоичный и текстовый файл в HTTP-запросе POST на сервер из скрипта VBA / VB6, запущенного из Corel Draw 12 / X4?

Question

Я хочу отправить двоичные файлы Corel Draw .CDR и XML-файлы SVG из приложения на сервер через HTTP POST.

Я провел некоторое исследование, и этот существующий пост кажется наиболее близким, но не подходит для моей ситуации: Как я могу отправить HTTP-запрос POST на сервер из Excel, используя VBA?

Я добавил пользовательскую кнопку на панель инструментов Corel Draw и создал макрос для запуска при нажатии этой кнопки. Макрос содержит следующий код.

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

На моем сервере у меня есть следующий CGI-скрипт Perl для принятия файла:

#!/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";

Я протестировал серверный скрипт с HTML-формой в браузере.

Я бы хотел посоветовать, чтобы скрипт VBA, работающий в Corel Draw, работал правильно. Я искал и искал и не могу найти окончательного ответа на отправку двоичных и текстовых файлов из приложения с поддержкой VBA на сервер через HTTP POST. Я тоже купил несколько книг на эту тему, но я не мудрее.

Мне это нужно для работы с Corel Draw 12 и Corel Draw X4.

Заранее спасибо.

Answer 1

Вот рабочее решение для Corel Draw 12. Это для экспорта SVG - его можно расширить для экспорта .CDR и .PDF одновременно, используя объект экспорта, предоставляемый Corel для среды приложений Visual Basic. Для этих двух двоичных форматов может потребоваться base64 для их кодирования перед отправкой.

Кредиты:

• credit http://www.vbforums.com/showthread.php?t=337424 расширил эту функцию, чтобы фактически выполнить отправку первоначально используемой функции Winsock - но это недоступно в среде приложений Visual Basic Corel Draw 12 / XIV, поэтому я заменил ее WinHttpRequest

• credit: http://bytes.com/topic/asp-classic/answers/659406-winhttprequest-posting-byte-string-multipart-message-howto#post2618801 - для добавления req.setRequestHeader "Content-Type", "multipart / form-data; border =" & border line, который требуется в WinHttpRequest, чтобы сервер Боковой код при получении поста может извлекать фактические данные файла и другие параметры

• кредит: http://word.mvps.org/faqs/macrosvba/DeleteFiles.htm для удаления временного файла

Четыре части решения, представленного ниже:

1. Инструкции по установке кода приложения Corel Draw Visual Basic (часть 2 ниже)
2. Код приложения Corel Draw Visual Basic
3. серверный CGI-скрипт Perl для приема файла, отправляемого в виде стандартного HTTP-сообщения POST CGI
4. тестирование веб-страницы в формате html только для тестирование серверного сценария Perl cgi

1) Инструкции

1. Corel Draw: Инструменты-> Visual Basic-> Редактор Visual Basic
2. Вернуться к Microsoft Visual Basic: View-> Project Explorer
3. Открыть FileConverter-> Модули-> Записанные макросы
4. Вставить в код. ПРИМЕЧАНИЕ. Может потребоваться добавить объекты, необходимые для сценария, например WinHttpRequest, через Обозреватель объектов: Вид-> Обозреватель объектов
5. Закрыть, вернуться к ...
6. Вернуться к Corel Draw: Инструменты-> Настройка
7. Во всплывающем диалоговом окне «Параметры»: «Параметры-> Настройка-> Панели команд»
8. Нажмите Новый
9. Экспорт на сервер для имени панели инструментов
10. нажмите ОК
11. Перетащите вновь созданную панель инструментов на верхнюю панель, она должна быть «поглощена» ею.
12. Щелкните правой кнопкой мыши по нему
13. Настройка-> Экспорт на панель инструментов сервера-> Добавить новую команду
14. В раскрывающемся меню «Параметры» выберите «Макросы»
15. Найти FileConverter.RecordedMacros.DrawingExportToServer
16. Перетащите его на только что созданную пустую панель инструментов «Экспорт на сервер», чтобы создать кнопку
17. Чтобы экспортировать чертеж на сервер: создайте чертеж как обычно и нажмите кнопку

2) Код приложения Corel Draw Visual Basic

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) серверный CGI-скрипт Perl для приема файла, отправляемого в виде стандартного сообщения HTTP POST CGI

#!/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) проверить веб-страницу формы html просто для test серверный скрипт Perl cgi

<!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>

Answer 2

Вы можете сохранить файл локально, а затем использовать cURL для отправки данных на ваш сервер (с помощью команды Shell в VBA).