Pascal (Lazarus/Delphi)

Extract Files from Binary SOAP MTOM MIME

See more MIME Examples

This example demonstrates how to extract files from a binary SOAP MTOM MIME document. Pascal (Lazarus/Delphi)

program ChilkatDemo;

// Demonstrates using the Chilkat Pascal wrapper via the C bridge DLL.
// Builds as a console application under Lazarus (FPC) or Delphi.

{$IFDEF FPC}
  {$MODE DELPHI}
{$ENDIF}
{$APPTYPE CONSOLE}

uses
  {$IFDEF UNIX}
  cthreads,
  {$ENDIF}
  SysUtils,
  CkDllLoader,
  Chilkat.Mime,
  Chilkat.StringBuilder;

// ---------------------------------------------------------------------------

procedure RunDemo;
var
  success: Boolean;
  mime: TMime;
  numParts: Integer;
  sbFilename: TStringBuilder;
  name: string;
  i: Integer;
  mp: TMime;
  numReplaced: Integer;

begin
  success := False;

  //  This example requires the Chilkat API to have been previously unlocked.
  //  See Global Unlock Sample for sample code.

  mime := TMime.Create;

  //  In this example, we have a MIME file containing 8bit (non-encoded) binary data,
  //  and it is what I call "headless".  MIME is headless when it omits
  //  the top-level header.  The file we have here begins with the first
  //  boundary string.

  //  The structure the MIME to be loaded is:

  //  multipart/mixed (inferred because it is headless)
  //      application/xop+xml
  //      image/jpeg
  //      image/gif
  //      image/gif
  //  

  success := mime.LoadMimeFile('qa_data/mime/headless_binary_soap_mtom_mime.mim');
  if (success = False) then
    begin
      WriteLn(mime.LastErrorText);
      Exit;
    end;

  //  The MIME file loaded in this example contains this:

  //  --uuid:e74486f4-52b0-44b6-b829-156810fae20d
  //  Content-Type: application/xop+xml; charset=UTF-8; type="application/soap+xml"
  //  Content-Transfer-Encoding: binary
  //  Content-ID: <root.message@cxf.apache.org>
  //  
  //  <soap:Envelope xmlns:soap="http://www.w3.org/2003/05/soap-envelope"><soap:Body> ... </soap:Body></soap:Envelope>
  //  --uuid:e74486f4-52b0-44b6-b829-156810fae20d
  //  Content-Type: image/jpeg
  //  Content-Transfer-Encoding: binary
  //  Content-ID: <beee83b7-166c-494c-890a-def990e9887b-1496@cxf.apache.org>
  //  Content-Disposition: attachment;name="-2049913191"
  //  
  //  BINARY DATA HERE...
  //  
  //  --uuid:e74486f4-52b0-44b6-b829-156810fae20d
  //  Content-Type: image/gif
  //  Content-Transfer-Encoding: binary
  //  Content-ID: <beee83b7-166c-494c-890a-def990e9887b-1497@cxf.apache.org>
  //  Content-Disposition: attachment;name="-2049913188"
  //  
  //  BINARY DATA HERE...
  //  
  //  --uuid:e74486f4-52b0-44b6-b829-156810fae20d
  //  Content-Type: image/gif
  //  Content-Transfer-Encoding: binary
  //  Content-ID: <beee83b7-166c-494c-890a-def990e9887b-1498@cxf.apache.org>
  //  Content-Disposition: attachment;name="-2049913185"
  //  
  //  BINARY DATA HERE...
  //  
  //  --uuid:e74486f4-52b0-44b6-b829-156810fae20d--

  //  Get the number of MIME sub-parts.
  numParts := mime.NumParts;

  //  The 1st part at index 0 is the application/xop+xml.  We're just going to extract the JPG and GIF image files..
  sbFilename := TStringBuilder.Create;

  i := 1;
  mp := TMime.Create;
  while i < numParts do
    begin

      mime.PartAt(i,mp);

      //  By looking at the MIME above, the "name" attribute of the Content-Disposition header field seems
      //  to be the only possible name we can use for each image..
      sbFilename.Append('qa_output/');
      name := mp.GetHeaderFieldAttribute('Content-Disposition','name');
      sbFilename.Append(name);
      sbFilename.Append('.');
      sbFilename.Append(mp.ContentType);
      numReplaced := sbFilename.Replace('image/','');
      mp.SaveBody(sbFilename.GetAsString());
      WriteLn('output file: ' + sbFilename.GetAsString());
      sbFilename.Clear();
      i := i + 1;
    end;

  WriteLn('Success.');


  mime.Free;
  sbFilename.Free;
  mp.Free;

end;

// ---------------------------------------------------------------------------

begin

  try
    RunDemo;
  except
    on E: Exception do
      WriteLn('Unhandled exception: ', E.ClassName, ': ', E.Message);
  end;

  WriteLn;
  {$IFDEF MSWINDOWS}
  WriteLn('Press Enter to exit...');
  ReadLn;
  {$ENDIF}
end.