Pascal (Lazarus/Delphi)
Pascal (Lazarus/Delphi)
Upload File in Blocks (with Content-MD5 header) and Commit the Block List
See more Azure Cloud Storage Examples
Demonstrates how to upload a file in blocks and then commit the block list. This example includes a Content-MD5 header for each block.Chilkat Pascal (Lazarus/Delphi) Downloads
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.FileAccess,
Chilkat.AuthAzureStorage,
Chilkat.Rest,
Chilkat.BinData,
Chilkat.StringBuilder,
Chilkat.Xml,
Chilkat.Crypt2;
// ---------------------------------------------------------------------------
procedure RunDemo;
var
success: Boolean;
rest: TRest;
bTls: Boolean;
port: Integer;
bAutoReconnect: Boolean;
azAuth: TAuthAzureStorage;
xml: TXml;
fac: TFileAccess;
blockSize: Integer;
numBlocks: Integer;
crypt: TCrypt2;
sbResponseBody: TStringBuilder;
uriPath: TStringBuilder;
blockId: string;
dataBlock: TBinData;
contentMd5: string;
i: Integer;
xmlStr: string;
responseStr: string;
begin
success := False;
// Azure Blob Service Example: Upload a file in blocks, and then commit the block list.
// See also: https://msdn.microsoft.com/en-us/library/azure/dd135726.aspx
// This example requires the Chilkat API to have been previously unlocked.
// See Global Unlock Sample for sample code.
rest := TRest.Create;
// Connect to the Azure Storage Blob Service
bTls := True;
port := 443;
bAutoReconnect := True;
// In this example, the storage account name is "chilkat".
success := rest.Connect('chilkat.blob.core.windows.net',port,bTls,bAutoReconnect);
if (success <> True) then
begin
WriteLn(rest.LastErrorText);
Exit;
end;
// Provide Azure Cloud credentials for the REST call.
azAuth := TAuthAzureStorage.Create;
azAuth.AccessKey := 'AZURE_ACCESS_KEY';
// The account name used here should match the 1st part of the domain passed in the call to Connect (above).
azAuth.Account := 'chilkat';
azAuth.Scheme := 'SharedKey';
azAuth.Service := 'Blob';
// This causes the "x-ms-version: 2021-08-06" header to be automatically added.
azAuth.XMsVersion := '2021-08-06';
success := rest.SetAuthAzureStorage(azAuth);
// Note: The application does not need to explicitly set the following
// headers: Content-Length, x-ms-date, Authorization. These headers
// are automatically set by Chilkat.
// As the blocks are uploaded, we'll keep an XML block list for the subsequent commit..
xml := TXml.Create;
xml.Tag := 'BlockList';
// Any type of file can be uploaded in this way. It can a text file, binary file, anything...
// This example will upload an XML file that is approximately 275K in size. It can be downloaded
// at http://www.chilkatsoft.com/hamlet.xml
fac := TFileAccess.Create;
success := fac.OpenForRead('qa_data/xml/hamlet.xml');
// Assuming success for the example..
// We'll upload in 16K blocks (normally a program would upload in larger block sizes than this,
// but this is just an example...)
blockSize := 16384;
// How many 16K blocks? (Including 1 for the last partial block)
numBlocks := fac.GetNumBlocks(blockSize);
crypt := TCrypt2.Create;
crypt.HashAlgorithm := 'md5';
sbResponseBody := TStringBuilder.Create;
uriPath := TStringBuilder.Create;
dataBlock := TBinData.Create;
i := 0;
while i < numBlocks do
begin
dataBlock.Clear();
success := fac.ReadBlockBd(i,blockSize,dataBlock);
if (success = False) then
begin
WriteLn(fac.LastErrorText);
Exit;
end;
// Generate a base64 block ID.
// (Chilkat provides a helper method named GenBlockId to make this easy)
// A pre-base64 encoded block ID length of 4 is sufficient in this case because
// this file certainly won't have more than 99,999 blocks..
blockId := fac.GenBlockId(i,4,'base64');
// Add this blockId to the list of blocks to be committed.
xml.NewChild2('Latest',blockId);
// Build the URI path
uriPath.Clear();
success := uriPath.Append('/mycontainer/hamlet.xml?comp=block&blockId=');
success := uriPath.Append(blockId);
contentMd5 := crypt.HashBdENC(dataBlock);
rest.AddHeader('Content-MD5',contentMd5);
// Upload this block..
sbResponseBody.Clear();
success := rest.FullRequestBd('PUT',uriPath.GetAsString(),dataBlock,sbResponseBody);
if (success = False) then
begin
WriteLn(rest.LastErrorText);
Exit;
end;
// Verify that we received a 201 status code.
if (rest.ResponseStatusCode <> 201) then
begin
// Examine the request/response to see what happened.
WriteLn('response status code = ' + rest.ResponseStatusCode);
WriteLn('response status text = ' + rest.ResponseStatusText);
WriteLn('response header: ' + rest.ResponseHeader);
WriteLn('response body (if any): ' + sbResponseBody.GetAsString());
WriteLn('---');
WriteLn('LastRequestStartLine: ' + rest.LastRequestStartLine);
WriteLn('LastRequestHeader: ' + rest.LastRequestHeader);
Exit;
end;
i := i + 1;
end;
fac.FileClose();
// Now commit the blocks.
// Let's have a look at the XML that will commit the blocks:
xmlStr := xml.GetXml();
WriteLn(xmlStr);
// The XML will look like this:
// <?xml version="1.0" encoding="utf-8" ?>
// <BlockList>
// <Latest>MDAwMA==</Latest>
// <Latest>MDAwMQ==</Latest>
// <Latest>MDAwMg==</Latest>
// <Latest>MDAwMw==</Latest>
// <Latest>MDAwNA==</Latest>
// <Latest>MDAwNQ==</Latest>
// <Latest>MDAwNg==</Latest>
// <Latest>MDAwNw==</Latest>
// <Latest>MDAwOA==</Latest>
// <Latest>MDAwOQ==</Latest>
// <Latest>MDAxMA==</Latest>
// <Latest>MDAxMQ==</Latest>
// <Latest>MDAxMg==</Latest>
// <Latest>MDAxMw==</Latest>
// <Latest>MDAxNA==</Latest>
// <Latest>MDAxNQ==</Latest>
// <Latest>MDAxNg==</Latest>
// <Latest>MDAxNw==</Latest>
// </BlockList>
// --------------------------------------------------------------------------
// IMPORTANT: Remove the Content-MD5 header previously set in the loop above.
// --------------------------------------------------------------------------
rest.RemoveHeader('Content-MD5');
// Send the PUT Block List...
responseStr := rest.FullRequestString('PUT','/mycontainer/hamlet.xml?comp=blocklist',xmlStr);
if (rest.LastMethodSuccess <> True) then
begin
WriteLn(rest.LastErrorText);
Exit;
end;
// When successful, the Azure Storage service will respond with a 201 response status code,
// with no response body.
if (rest.ResponseStatusCode <> 201) then
begin
// Examine the request/response to see what happened.
WriteLn('response status code = ' + rest.ResponseStatusCode);
WriteLn('response status text = ' + rest.ResponseStatusText);
WriteLn('response header: ' + rest.ResponseHeader);
WriteLn('response body (if any): ' + responseStr);
WriteLn('---');
WriteLn('LastRequestStartLine: ' + rest.LastRequestStartLine);
WriteLn('LastRequestHeader: ' + rest.LastRequestHeader);
Exit;
end;
WriteLn('Success.');
rest.Free;
azAuth.Free;
xml.Free;
fac.Free;
crypt.Free;
sbResponseBody.Free;
uriPath.Free;
dataBlock.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.