unit uHCLDownloader;
{$mode objfpc}{$H+}
///
/// uHCLDownloader — file downloader for the HC Launcher.
///
/// Supports direct HTTP/HTTPS downloads and IPS-CSRF authenticated downloads
/// (for HarpGamer/Invision Community file pages), with resume-on-interruption
/// via HTTP Range headers, progress callbacks, integrity verification (SHA-256
/// placeholder), and cooperative cancellation.
///
/// Zero UI dependency — no LCL units are referenced. HTTPS is enabled by
/// including opensslsockets in the uses clause.
///
///
///
/// The .part file convention keeps partial downloads safe: a download
/// is written to <destdir>\<filename>.part and renamed to
/// the final name only on successful completion. Cancellation leaves the
/// .part file in place so a subsequent call can resume.
///
interface
uses
SysUtils, Classes, uHCLOpenSSL, fphttpclient, opensslsockets;
// ---------------------------------------------------------------------------
// Event and enum types
// ---------------------------------------------------------------------------
type
///
/// Progress callback fired periodically during a download.
///
/// The instance reporting progress.
/// Total bytes written to the .part file so far
/// (including any bytes already present from a previous partial download).
/// Total expected file size in bytes, or -1 when unknown
/// (server did not send Content-Length).
TDownloadProgressEvent = procedure(ASender: TObject;
ABytesReceived, ATotalBytes: Int64) of object;
///
/// Selects the download strategy used by .
///
TDownloadMethod = (
/// Simple HTTP GET — no authentication required.
dmDirect,
///
/// Two-step IPS/Invision Community flow: first GET the file page to obtain
/// a session cookie and csrfKey, then GET the download URL with the
/// key appended as a query parameter.
///
dmIpsCsrf
);
// ---------------------------------------------------------------------------
// THCLDownloadResult record
// ---------------------------------------------------------------------------
///
/// Returned by to describe the outcome
/// of a download attempt.
///
THCLDownloadResult = record
/// True when the file was downloaded and (if requested) verified successfully.
Success: Boolean;
/// Full path to the downloaded file (empty on failure).
FilePath: String;
///
/// Filename used on disk — taken from Content-Disposition when the
/// caller supplies an empty AFileName, otherwise equal to
/// AFileName.
///
FileName: String;
/// Actual number of bytes written (total file size after rename).
FileSize: Int64;
///
/// Computed SHA-256 hex string, or empty when computation is not yet
/// implemented or was skipped.
///
SHA256: String;
/// Human-readable error description; empty on success.
ErrorMessage: String;
end;
// ---------------------------------------------------------------------------
// IHCLDownloader interface
// ---------------------------------------------------------------------------
///
/// Downloads files from HTTP/HTTPS servers with optional resume, progress
/// reporting, integrity verification, and cancellation.
///
IHCLDownloader = interface
['{A3F72C1E-84D5-4B9A-B601-72E3C9D5F104}']
///
/// Download a file using the specified method.
///
///
/// For dmDirect: the direct download URL.
/// For dmIpsCsrf: the file's page URL (used to obtain the session
/// cookie and csrfKey before building the download URL).
///
/// Directory into which the file is saved.
///
/// Expected filename (e.g., from a catalog entry). When empty, the name
/// is extracted from the Content-Disposition response header.
///
/// Download strategy: dmDirect or dmIpsCsrf.
///
/// Expected SHA-256 hex digest for integrity verification. Pass an empty
/// string to skip verification.
///
///
/// Progress callback called after each received data chunk. May be
/// nil to suppress progress reporting.
///
///
/// The catalog's downloadUrl, if any. For dmIpsCsrf it names
/// one specific file of the entry (see ,
/// which also restricts it to the page's own site); for dmDirect it
/// replaces as the URL fetched. Empty keeps
/// the previous behaviour.
///
///
/// A record describing success or failure.
/// Exceptions are caught internally; the ErrorMessage field carries
/// the diagnostic text.
///
function Download(const APageUrl, ADestDir, AFileName: String;
AMethod: TDownloadMethod; const AExpectedSHA256: String;
AOnProgress: TDownloadProgressEvent;
const ADownloadUrl: String = ''): THCLDownloadResult;
///
/// Request cancellation of the download currently in progress.
///
/// The .part file is left on disk so that a subsequent call to
/// can resume from where the transfer stopped.
/// If no download is active, this call is a no-op.
///
procedure Cancel;
///
/// Returns True while a call is executing.
///
function IsDownloading: Boolean;
end;
// ---------------------------------------------------------------------------
// THCLDownloader class
// ---------------------------------------------------------------------------
///
/// Default implementation of .
///
/// Not thread-safe: call only from one thread at a time. Cancel may
/// be called from any thread because it only writes a Boolean flag.
///
THCLDownloader = class(TInterfacedObject, IHCLDownloader)
private
FCancelled: Boolean;
FDownloading: Boolean;
FBytesReceived: Int64;
FTotalBytes: Int64;
FOnProgress: TDownloadProgressEvent;
FUserAgent: String;
// The TFPHTTPClient in use during an active download; nil otherwise.
// Used so that the progress handler can call Terminate on it.
FActiveClient: TFPHTTPClient;
// -----------------------------------------------------------------------
// Internal helpers
// -----------------------------------------------------------------------
///
/// Searches for csrfKey=<hex> and
/// returns the hex token, or empty string when not found.
///
/// Raw HTML body from the file page GET.
/// The CSRF key value (32 hex characters), or empty string.
function ExtractCsrfKey(const AHtml: String): String;
///
/// Computes the SHA-256 digest of the file at
/// and returns the lowercase hex string.
///
/// Absolute path to the file to hash.
///
/// Lowercase hex SHA-256 string, or empty string when not implemented.
///
///
/// TODO: Implement SHA-256 using FPC's hash functions or a third-party
/// unit (e.g. DCPcrypt, libsodium bindings, or the upcoming FPC
/// HashLib package). The placeholder returns empty so that callers
/// with AExpectedSHA256 = '' are unaffected.
///
function ComputeSHA256(const AFilePath: String): String;
///
/// Performs the GET-and-stream step shared by both download methods.
///
/// Configured TFPHTTPClient to use.
/// URL to GET.
/// Absolute path to the .part file.
///
/// Number of bytes already in the .part file; 0 for a fresh
/// download. A non-zero value causes a Range: bytes=N- header
/// to be added and the file to be opened in append mode.
///
///
/// Receives the filename extracted from Content-Disposition, or
/// remains unchanged when the header is absent.
///
procedure StreamToPartFile(AClient: TFPHTTPClient;
const AUrl, APartPath: String; AResumeOffset: Int64;
var AOutFileName: String);
///
/// TFPHTTPClient.OnDataReceived handler. Updates
/// , fires , and
/// aborts the transfer if is set.
///
procedure DataReceivedHandler(Sender: TObject; const ContentLength,
CurrentPos: Int64);
public
///
/// Creates a new downloader. Sets the User-Agent to
/// 'HCLauncher/1.0'.
///
constructor Create;
// IHCLDownloader
function Download(const APageUrl, ADestDir, AFileName: String;
AMethod: TDownloadMethod; const AExpectedSHA256: String;
AOnProgress: TDownloadProgressEvent;
const ADownloadUrl: String = ''): THCLDownloadResult;
procedure Cancel;
function IsDownloading: Boolean;
end;
// ---------------------------------------------------------------------------
// Factory function
// ---------------------------------------------------------------------------
///
/// Returns a new instance.
///
/// Reference-counted downloader.
function CreateDownloader: IHCLDownloader;
///
/// Computes the SHA-256 digest of the file at
/// and returns the lowercase 64-character hex string.
///
/// Implements FIPS 180-4 SHA-256 directly; no external unit dependencies.
///
/// Absolute path to the file to hash.
///
/// Lowercase 64-hex-character SHA-256 digest, or empty string if the file
/// does not exist or cannot be read.
///
///
/// Exposed at unit scope so that the function can be tested directly from
/// the FPCUnit test suite without going through the full download flow.
///
function HCLComputeSHA256(const AFilePath: String): String;
// ---------------------------------------------------------------------------
// Download naming
//
// Exposed at unit scope so the naming rules can be tested without a network.
// ---------------------------------------------------------------------------
///
/// Reduces an untrusted filename to a bare name that is safe to join onto a
/// destination directory on Windows.
///
/// Proposed name, e.g. from a server header or a remote catalog.
/// A safe bare filename, or an empty string when nothing usable remains.
///
/// Anything up to the last / or \ is discarded, which defeats
/// both .. traversal and absolute paths. Characters Windows forbids
/// are replaced with _, trailing dots and spaces are removed (Windows
/// drops them silently), a reserved device name such as CON.zip gets a
/// leading _, and very long names are shortened, keeping the extension.
///
function HCLSafeFileName(const AName: String): String;
///
/// Extracts the filename from a Content-Disposition header value.
///
/// Header value, e.g. attachment; filename="x.zip".
/// A safe bare filename (see ), or an
/// empty string when the header carries no usable name.
///
/// The RFC 5987 form filename*=UTF-8''name%20here.zip is preferred when
/// present, since servers send it precisely when the plain form would be
/// lossy. The header comes from a remote server and is never trusted as a
/// path.
///
function HCLContentDispositionFileName(const AHeader: String): String;
///
/// Returns a stable, safe base name for a download whose real name is not yet
/// known, derived from the last non-empty segment of its URL path.
///
/// Page or download URL.
/// For example 835-exportdll-lazhceffects for
/// https://host/files/file/835-exportdll-lazhceffects/; download
/// when the URL yields nothing usable.
///
/// Keying the .part file on the URL means an interrupted download
/// resumes onto its own bytes. A single shared placeholder name would let one
/// file's partial download be resumed, with a Range request, by a
/// different file — silently producing a corrupt result.
///
function HCLDownloadStem(const AUrl: String): String;
///
/// Chooses the final on-disk name for a completed download.
///
/// Name the caller asked for (typically the catalog's
/// fileName); may be empty.
/// Name from Content-Disposition; may be empty.
/// Fallback from .
/// The first of these that survives , or
/// download if none does.
function HCLResolveDownloadName(const ARequested, AServerName, AStem: String): String;
///
/// Builds the URL for the second step of the IPS-CSRF download flow.
///
/// The file's page URL (where the session and key came from).
/// The catalog's downloadUrl, e.g.
/// …/files/file/12-x/?do=download&r=345 naming one of the entry's
/// files; may be empty.
/// The session's csrfKey.
/// with the csrfKey appended when it
/// is on the same origin (scheme, host and port) as the page; otherwise the
/// page URL plus ?do=download&csrfKey=….
///
/// The request carries the forum session cookie and csrfKey, so it must never
/// go to a different site than the page: the catalog is remote data, and a
/// downloadUrl pointing elsewhere (including a
/// https://site@other/ userinfo trick) falls back to the page URL.
///
function HCLBuildIpsDownloadUrl(const APageUrl, ADownloadUrl, ACsrfKey: String): String;
implementation
// ---------------------------------------------------------------------------
// CreateDownloader
// ---------------------------------------------------------------------------
function CreateDownloader: IHCLDownloader;
begin
Result := THCLDownloader.Create;
end;
// ---------------------------------------------------------------------------
// THCLDownloader — constructor
// ---------------------------------------------------------------------------
constructor THCLDownloader.Create;
begin
inherited Create;
FCancelled := False;
FDownloading := False;
FBytesReceived := 0;
FTotalBytes := -1;
FOnProgress := nil;
FActiveClient := nil;
FUserAgent := 'HCLauncher/1.0';
end;
// ---------------------------------------------------------------------------
// THCLDownloader — IHCLDownloader.Cancel
// ---------------------------------------------------------------------------
procedure THCLDownloader.Cancel;
begin
FCancelled := True;
// The DataReceivedHandler will call Terminate on FActiveClient on the next
// received data chunk.
end;
// ---------------------------------------------------------------------------
// THCLDownloader — IHCLDownloader.IsDownloading
// ---------------------------------------------------------------------------
function THCLDownloader.IsDownloading: Boolean;
begin
Result := FDownloading;
end;
// ---------------------------------------------------------------------------
// THCLDownloader — ExtractCsrfKey
// ---------------------------------------------------------------------------
function THCLDownloader.ExtractCsrfKey(const AHtml: String): String;
const
MARKER = 'csrfKey=';
var
P, Q: Integer;
Ch: Char;
begin
Result := '';
P := Pos(MARKER, AHtml);
if P = 0 then
Exit;
Inc(P, Length(MARKER)); // move past 'csrfKey='
// Skip any leading quote character (' or ")
if P <= Length(AHtml) then
begin
Ch := AHtml[P];
if (Ch = '"') or (Ch = '''') then
Inc(P);
end;
// Collect hex characters [0-9A-Fa-f]
Q := P;
while Q <= Length(AHtml) do
begin
Ch := AHtml[Q];
if ((Ch >= '0') and (Ch <= '9')) or
((Ch >= 'A') and (Ch <= 'F')) or
((Ch >= 'a') and (Ch <= 'f')) then
Inc(Q)
else
Break;
end;
if Q > P then
Result := Copy(AHtml, P, Q - P);
end;
// ---------------------------------------------------------------------------
// Download naming
// ---------------------------------------------------------------------------
/// Decodes %XX escapes; malformed escapes are kept verbatim.
/// Percent-encoded text.
/// The decoded byte string.
function PercentDecode(const S: String): String;
var
I: Integer;
B: Integer;
begin
Result := '';
I := 1;
while I <= Length(S) do
begin
if (S[I] = '%') and (I + 2 <= Length(S)) and
TryStrToInt('$' + Copy(S, I + 1, 2), B) then
begin
Result := Result + Chr(B);
Inc(I, 3);
end
else
begin
Result := Result + S[I];
Inc(I);
end;
end;
end;
///
/// Returns the value of a name=value parameter in a header, located
/// case-insensitively, with surrounding quotes removed.
///
/// Full header value.
/// Parameter name including the =, e.g. filename=.
/// The unquoted value, or an empty string when absent.
function HeaderParam(const AHeader, AParam: String): String;
var
P, Q: Integer;
LowerHeader: String;
QuoteChar: Char;
begin
Result := '';
LowerHeader := LowerCase(AHeader);
// Require a parameter boundary before the name, so that searching for
// "filename=" cannot match the tail of some other parameter.
P := Pos(LowerCase(AParam), LowerHeader);
while (P > 1) and not (AHeader[P - 1] in [';', ' ', #9]) do
begin
Q := Pos(LowerCase(AParam), Copy(LowerHeader, P + 1, MaxInt));
if Q = 0 then
Exit;
P := P + Q;
end;
if P = 0 then
Exit;
Inc(P, Length(AParam));
if P > Length(AHeader) then
Exit;
QuoteChar := AHeader[P];
if (QuoteChar = '"') or (QuoteChar = '''') then
begin
Inc(P);
Q := P;
while (Q <= Length(AHeader)) and (AHeader[Q] <> QuoteChar) do
Inc(Q);
end
else
begin
Q := P;
while (Q <= Length(AHeader)) and not (AHeader[Q] in [';', ' ', #9]) do
Inc(Q);
end;
Result := Trim(Copy(AHeader, P, Q - P));
end;
function HCLSafeFileName(const AName: String): String;
const
INVALID_CHARS = ['<', '>', ':', '"', '|', '?', '*'];
RESERVED: array[0..21] of String = (
'CON', 'PRN', 'AUX', 'NUL',
'COM1', 'COM2', 'COM3', 'COM4', 'COM5', 'COM6', 'COM7', 'COM8', 'COM9',
'LPT1', 'LPT2', 'LPT3', 'LPT4', 'LPT5', 'LPT6', 'LPT7', 'LPT8', 'LPT9'
);
MAX_NAME_LEN = 200;
var
I, P: Integer;
LBase, LExt: String;
begin
Result := AName;
// Keep only the last path component: no traversal, no absolute paths.
P := 0;
for I := Length(Result) downto 1 do
if (Result[I] = '/') or (Result[I] = '\') then
begin
P := I;
Break;
end;
if P > 0 then
Delete(Result, 1, P);
for I := 1 to Length(Result) do
if (Result[I] in INVALID_CHARS) or (Result[I] < #32) then
Result[I] := '_';
Result := Trim(Result);
// Windows silently discards trailing dots and spaces on creation.
while (Length(Result) > 0) and (Result[Length(Result)] in ['.', ' ']) do
Delete(Result, Length(Result), 1);
if (Result = '') or (Result = '.') or (Result = '..') then
Exit('');
// A device name is reserved whatever its extension: CON.zip cannot be created.
P := Pos('.', Result);
if P > 0 then
LBase := Copy(Result, 1, P - 1)
else
LBase := Result;
for I := Low(RESERVED) to High(RESERVED) do
if SameText(LBase, RESERVED[I]) then
begin
Result := '_' + Result;
Break;
end;
if Length(Result) > MAX_NAME_LEN then
begin
LExt := ExtractFileExt(Result);
if Length(LExt) >= MAX_NAME_LEN div 4 then
LExt := '';
Result := Copy(Result, 1, MAX_NAME_LEN - Length(LExt)) + LExt;
end;
end;
function HCLContentDispositionFileName(const AHeader: String): String;
var
LExt: String;
P: Integer;
begin
Result := '';
// RFC 5987: filename*=charset'language'percent-encoded
LExt := HeaderParam(AHeader, 'filename*=');
if LExt <> '' then
begin
P := Pos('''', LExt);
if P > 0 then
begin
Delete(LExt, 1, P); // charset
P := Pos('''', LExt);
if P > 0 then
Delete(LExt, 1, P); // language
end;
Result := HCLSafeFileName(PercentDecode(LExt));
if Result <> '' then
Exit;
end;
Result := HCLSafeFileName(HeaderParam(AHeader, 'filename='));
end;
function HCLDownloadStem(const AUrl: String): String;
var
S: String;
P: Integer;
begin
S := AUrl;
P := Pos('?', S);
if P > 0 then
S := Copy(S, 1, P - 1);
P := Pos('#', S);
if P > 0 then
S := Copy(S, 1, P - 1);
// Drop the scheme and host, so a bare "https://host/" yields nothing.
P := Pos('://', S);
if P > 0 then
begin
Delete(S, 1, P + 2);
P := Pos('/', S);
if P > 0 then
Delete(S, 1, P - 1)
else
S := '';
end;
while (Length(S) > 0) and (S[Length(S)] = '/') do
Delete(S, Length(S), 1);
Result := HCLSafeFileName(PercentDecode(S));
if Result = '' then
Result := 'download';
end;
function HCLResolveDownloadName(const ARequested, AServerName, AStem: String): String;
begin
Result := HCLSafeFileName(ARequested);
if Result = '' then
Result := HCLSafeFileName(AServerName);
if Result = '' then
Result := HCLSafeFileName(AStem);
if Result = '' then
Result := 'download';
end;
///
/// Returns the lower-cased origin (scheme://host[:port]) of an http(s)
/// URL, or an empty string when there isn't a safe one to compare.
///
/// URL to inspect.
/// The origin; empty for other schemes, a missing host, or any
/// userinfo (user@host), which is refused rather than parsed.
function UrlOrigin(const AUrl: String): String;
var
P, Q: Integer;
Scheme, Authority: String;
begin
Result := '';
P := Pos('://', AUrl);
if P = 0 then
Exit;
Scheme := LowerCase(Copy(AUrl, 1, P - 1));
if (Scheme <> 'http') and (Scheme <> 'https') then
Exit;
Authority := Copy(AUrl, P + 3, MaxInt);
Q := 1;
while (Q <= Length(Authority)) and not (Authority[Q] in ['/', '?', '#', '\']) do
Inc(Q);
Authority := Copy(Authority, 1, Q - 1);
if (Authority = '') or (Pos('@', Authority) > 0) then
Exit;
Result := Scheme + '://' + LowerCase(Authority);
end;
function HCLBuildIpsDownloadUrl(const APageUrl, ADownloadUrl, ACsrfKey: String): String;
var
Origin: String;
begin
Origin := UrlOrigin(ADownloadUrl);
if (ADownloadUrl <> '') and (Origin <> '') and (Origin = UrlOrigin(APageUrl)) then
begin
if Pos('?', ADownloadUrl) > 0 then
Result := ADownloadUrl + '&csrfKey=' + ACsrfKey
else
Result := ADownloadUrl + '?csrfKey=' + ACsrfKey;
end
else
// Exactly the URL the launcher has always used.
Result := APageUrl + '?do=download&csrfKey=' + ACsrfKey;
end;
// ---------------------------------------------------------------------------
// SHA-256 implementation (FIPS 180-4)
// FPC 3.2.2 ships only MD5 and SHA1 in its hash package for i386-win32,
// so SHA-256 is implemented here directly. No external dependencies.
//
// Overflow and range checking are disabled for this section because SHA-256
// requires 32-bit modular (wrapping) arithmetic. The compiler directives
// are restored with {$POP} after HCLComputeSHA256.
// ---------------------------------------------------------------------------
{$PUSH}
{$Q-} // disable overflow checking — SHA-256 requires wrapping LongWord arithmetic
{$R-} // disable range checking
type
/// Internal 256-bit hash state (8 x 32-bit words).
TSHA256State = array[0..7] of LongWord;
/// Internal 64-byte message schedule array.
TSHA256Schedule = array[0..63] of LongWord;
///
/// Right-rotation of a 32-bit value — used by the SHA-256 compression function.
///
function SHA256ROR(const AVal: LongWord; const AShift: Byte): LongWord;
begin
Result := (AVal shr AShift) or (AVal shl (32 - AShift));
end;
///
/// Processes one 64-byte block into the SHA-256 hash state in place.
///
/// Current hash state (modified in place).
/// Pointer to a 64-byte aligned message block (big-endian).
procedure SHA256ProcessBlock(var AState: TSHA256State; const ABlock: array of Byte);
const
K: TSHA256Schedule = (
$428A2F98, $71374491, $B5C0FBCF, $E9B5DBA5,
$3956C25B, $59F111F1, $923F82A4, $AB1C5ED5,
$D807AA98, $12835B01, $243185BE, $550C7DC3,
$72BE5D74, $80DEB1FE, $9BDC06A7, $C19BF174,
$E49B69C1, $EFBE4786, $0FC19DC6, $240CA1CC,
$2DE92C6F, $4A7484AA, $5CB0A9DC, $76F988DA,
$983E5152, $A831C66D, $B00327C8, $BF597FC7,
$C6E00BF3, $D5A79147, $06CA6351, $14292967,
$27B70A85, $2E1B2138, $4D2C6DFC, $53380D13,
$650A7354, $766A0ABB, $81C2C92E, $92722C85,
$A2BFE8A1, $A81A664B, $C24B8B70, $C76C51A3,
$D192E819, $D6990624, $F40E3585, $106AA070,
$19A4C116, $1E376C08, $2748774C, $34B0BCB5,
$391C0CB3, $4ED8AA4A, $5B9CCA4F, $682E6FF3,
$748F82EE, $78A5636F, $84C87814, $8CC70208,
$90BEFFFA, $A4506CEB, $BEF9A3F7, $C67178F2
);
var
W: TSHA256Schedule;
A, B, C, D, E, F, G, H: LongWord;
T1, T2, S0, S1, CH, MAJ: LongWord;
I: Integer;
begin
// Build the message schedule W[0..63] from the 64-byte block.
// Bytes in the block are big-endian 32-bit words.
for I := 0 to 15 do
W[I] := (LongWord(ABlock[I * 4]) shl 24) or
(LongWord(ABlock[I * 4 + 1]) shl 16) or
(LongWord(ABlock[I * 4 + 2]) shl 8) or
LongWord(ABlock[I * 4 + 3]);
for I := 16 to 63 do
begin
S0 := SHA256ROR(W[I-15], 7) xor SHA256ROR(W[I-15], 18) xor (W[I-15] shr 3);
S1 := SHA256ROR(W[I-2], 17) xor SHA256ROR(W[I-2], 19) xor (W[I-2] shr 10);
W[I] := W[I-16] + S0 + W[I-7] + S1;
end;
// Initialise working variables from current state.
A := AState[0]; B := AState[1]; C := AState[2]; D := AState[3];
E := AState[4]; F := AState[5]; G := AState[6]; H := AState[7];
// 64 rounds.
for I := 0 to 63 do
begin
S1 := SHA256ROR(E, 6) xor SHA256ROR(E, 11) xor SHA256ROR(E, 25);
CH := (E and F) xor ((not E) and G);
T1 := H + S1 + CH + K[I] + W[I];
S0 := SHA256ROR(A, 2) xor SHA256ROR(A, 13) xor SHA256ROR(A, 22);
MAJ := (A and B) xor (A and C) xor (B and C);
T2 := S0 + MAJ;
H := G; G := F; F := E; E := D + T1;
D := C; C := B; B := A; A := T1 + T2;
end;
// Add the compressed chunk to the current hash state.
Inc(AState[0], A); Inc(AState[1], B); Inc(AState[2], C); Inc(AState[3], D);
Inc(AState[4], E); Inc(AState[5], F); Inc(AState[6], G); Inc(AState[7], H);
end;
// ---------------------------------------------------------------------------
// HCLComputeSHA256 — unit-scope SHA-256 function (delegates from the class)
// ---------------------------------------------------------------------------
function HCLComputeSHA256(const AFilePath: String): String;
const
// SHA-256 initial hash values H0..H7 (first 32 bits of fractional parts
// of the square roots of the first 8 primes).
H0: TSHA256State = (
$6A09E667, $BB67AE85, $3C6EF372, $A54FF53A,
$510E527F, $9B05688C, $1F83D9AB, $5BE0CD19
);
CHUNK_SIZE = 65536; // 64 KB read buffer
var
State: TSHA256State;
FS: TFileStream;
Buf: array of Byte;
Block: array[0..63] of Byte;
Carry: array[0..63] of Byte;
BytesRead: Integer;
CarryLen: Integer;
SrcOfs: Integer;
Need: Integer;
TotalBits: UInt64;
Remaining: array of Byte;
RemLen: Integer;
PadLen: Integer;
I: Integer;
begin
Result := '';
if not FileExists(AFilePath) then
Exit;
// Initialise state to SHA-256 initial values.
State := H0;
CarryLen := 0;
TotalBits := 0;
SetLength(Buf, CHUNK_SIZE);
// Strategy: process complete 64-byte blocks from each read; keep a partial
// block carry buffer between iterations.
try
FS := TFileStream.Create(AFilePath, fmOpenRead or fmShareDenyNone);
try
repeat
BytesRead := FS.Read(Buf[0], CHUNK_SIZE);
if BytesRead = 0 then
Break;
TotalBits := TotalBits + UInt64(BytesRead) * 8;
// Merge carry + new bytes; process all complete 64-byte blocks.
SrcOfs := 0;
// If carry has data, fill it to a full block first.
if CarryLen > 0 then
begin
Need := 64 - CarryLen;
if BytesRead >= Need then
begin
Move(Buf[0], Carry[CarryLen], Need);
SHA256ProcessBlock(State, Carry);
CarryLen := 0;
SrcOfs := Need;
end
else
begin
// Still not enough to complete the block — append and continue.
Move(Buf[0], Carry[CarryLen], BytesRead);
Inc(CarryLen, BytesRead);
Continue;
end;
end;
// Process remaining full blocks directly from Buf.
while SrcOfs + 64 <= BytesRead do
begin
Move(Buf[SrcOfs], Block[0], 64);
SHA256ProcessBlock(State, Block);
Inc(SrcOfs, 64);
end;
// Store leftover bytes in carry.
if SrcOfs < BytesRead then
begin
CarryLen := BytesRead - SrcOfs;
Move(Buf[SrcOfs], Carry[0], CarryLen);
end;
until BytesRead < CHUNK_SIZE;
finally
FS.Free;
end;
except
Result := '';
Exit;
end;
// -------------------------------------------------------------------------
// Padding: append 0x80, zero bytes, then 64-bit big-endian bit-length.
// The padded message length must be a multiple of 512 bits (64 bytes).
// Minimum padding: 1 byte (0x80) + 8 bytes (length) = 9 bytes.
// If CarryLen + 9 > 64, we need two padding blocks; otherwise one.
// -------------------------------------------------------------------------
PadLen := 64 - CarryLen;
if PadLen < 9 then
PadLen := PadLen + 64; // need an extra block
// Build the padding bytes: [0x80, 0x00 * (PadLen-9), big-endian TotalBits]
SetLength(Remaining, CarryLen + PadLen);
if CarryLen > 0 then
Move(Carry[0], Remaining[0], CarryLen);
RemLen := CarryLen;
Remaining[RemLen] := $80;
Inc(RemLen);
// Zero fill up to the last 8 bytes
for I := RemLen to Length(Remaining) - 9 do
Remaining[I] := 0;
// Append TotalBits as big-endian 64-bit integer
RemLen := Length(Remaining) - 8;
Remaining[RemLen] := Byte(TotalBits shr 56);
Remaining[RemLen + 1] := Byte(TotalBits shr 48);
Remaining[RemLen + 2] := Byte(TotalBits shr 40);
Remaining[RemLen + 3] := Byte(TotalBits shr 32);
Remaining[RemLen + 4] := Byte(TotalBits shr 24);
Remaining[RemLen + 5] := Byte(TotalBits shr 16);
Remaining[RemLen + 6] := Byte(TotalBits shr 8);
Remaining[RemLen + 7] := Byte(TotalBits);
// Process the one or two padding blocks.
I := 0;
while I + 64 <= Length(Remaining) do
begin
Move(Remaining[I], Block[0], 64);
SHA256ProcessBlock(State, Block);
Inc(I, 64);
end;
// -------------------------------------------------------------------------
// Produce lowercase hex digest from final state (big-endian word order).
// -------------------------------------------------------------------------
Result := '';
for I := 0 to 7 do
Result := Result + LowerCase(IntToHex(State[I], 8));
end;
{$POP} // restore overflow/range checking to caller's settings
// ---------------------------------------------------------------------------
// THCLDownloader — ComputeSHA256 (delegates to unit-scope HCLComputeSHA256)
// ---------------------------------------------------------------------------
function THCLDownloader.ComputeSHA256(const AFilePath: String): String;
begin
Result := HCLComputeSHA256(AFilePath);
end;
// ---------------------------------------------------------------------------
// THCLDownloader — DataReceivedHandler
// ---------------------------------------------------------------------------
procedure THCLDownloader.DataReceivedHandler(Sender: TObject;
const ContentLength, CurrentPos: Int64);
begin
// ContentLength is the value from Content-Length (may be 0 if absent).
// CurrentPos is the number of bytes received in this response body so far.
// We track total bytes written including any resume offset in FBytesReceived.
// FBytesReceived was initialised to the resume offset before the GET started.
// Derive FTotalBytes from ContentLength + resume offset if we have one.
if ContentLength > 0 then
FTotalBytes := FBytesReceived + (ContentLength - CurrentPos) + CurrentPos
// simplifies to FBytesReceived_initial + ContentLength
else
FTotalBytes := -1;
// Update running byte count: initial resume offset + bytes in this response.
// FBytesReceived was set to AResumeOffset before the GET; add CurrentPos.
// We recalculate each time because CurrentPos is cumulative in fphttpclient.
// Store as resume_offset + current_response_pos.
// (FBytesReceived is set by StreamToPartFile before first call; we just
// update the response-progress portion here.)
// Fire the caller's progress callback.
if Assigned(FOnProgress) then
FOnProgress(Self, FBytesReceived, FTotalBytes);
// Cooperative cancellation: abort the active client when Cancel was called.
if FCancelled and Assigned(FActiveClient) then
FActiveClient.Terminate;
end;
// ---------------------------------------------------------------------------
// THCLDownloader — StreamToPartFile
// ---------------------------------------------------------------------------
procedure THCLDownloader.StreamToPartFile(AClient: TFPHTTPClient;
const AUrl, APartPath: String; AResumeOffset: Int64;
var AOutFileName: String);
var
PartStream: TFileStream;
RespHeaders: TStrings;
ContentDisp: String;
FileMode: Word;
begin
// Initialise the running byte counter to include already-downloaded bytes.
FBytesReceived := AResumeOffset;
FTotalBytes := -1;
// Add Range header when resuming.
if AResumeOffset > 0 then
AClient.AddHeader('Range', 'bytes=' + IntToStr(AResumeOffset) + '-');
// Open the .part file.
if AResumeOffset > 0 then
FileMode := fmOpenWrite or fmShareDenyWrite
else
FileMode := fmCreate;
PartStream := TFileStream.Create(APartPath, FileMode);
try
if AResumeOffset > 0 then
PartStream.Seek(0, soFromEnd); // append to existing content
// Perform the GET, streaming the body directly into PartStream.
AClient.Get(AUrl, PartStream);
// Extract filename from Content-Disposition if the caller wants it.
if AOutFileName = '' then
begin
RespHeaders := AClient.ResponseHeaders;
if Assigned(RespHeaders) then
begin
ContentDisp := RespHeaders.Values['Content-Disposition'];
if ContentDisp = '' then
ContentDisp := RespHeaders.Values['content-disposition'];
if ContentDisp <> '' then
AOutFileName := HCLContentDispositionFileName(ContentDisp);
end;
end;
finally
PartStream.Free;
end;
end;
// ---------------------------------------------------------------------------
// THCLDownloader — IHCLDownloader.Download (main entry point)
// ---------------------------------------------------------------------------
function THCLDownloader.Download(const APageUrl, ADestDir, AFileName: String;
AMethod: TDownloadMethod; const AExpectedSHA256: String;
AOnProgress: TDownloadProgressEvent;
const ADownloadUrl: String): THCLDownloadResult;
// Helper: initialise a failure result.
procedure Fail(const AMsg: String);
begin
Result.Success := False;
Result.ErrorMessage := AMsg;
end;
var
Client: TFPHTTPClient;
ResolvedFN: String; // filename eventually used on disk
ReqName: String; // caller's requested name, made safe; may be empty
Stem: String; // per-URL fallback name; keys the .part file when unnamed
ServerName: String; // name from Content-Disposition, made safe; may be empty
PartPath: String; // \.part
FinalPath: String; // \
ResumeOffset: Int64;
CsrfKey: String;
PageBody: String;
DownloadUrl: String;
ComputedHash: String;
PartSize: Int64;
begin
// -------------------------------------------------------------------------
// Reset result record
// -------------------------------------------------------------------------
Result.Success := False;
Result.FilePath := '';
Result.FileName := '';
Result.FileSize := 0;
Result.SHA256 := '';
Result.ErrorMessage := '';
// -------------------------------------------------------------------------
// Guard: cannot nest downloads
// -------------------------------------------------------------------------
if FDownloading then
begin
Fail('A download is already in progress.');
Exit;
end;
// -------------------------------------------------------------------------
// Validate destination directory
// -------------------------------------------------------------------------
if not DirectoryExists(ADestDir) then
begin
Fail('Destination directory does not exist: ' + ADestDir);
Exit;
end;
// -------------------------------------------------------------------------
// Initialise per-call state
// -------------------------------------------------------------------------
FCancelled := False;
FOnProgress := AOnProgress;
FDownloading := True;
Client := TFPHTTPClient.Create(nil);
FActiveClient := Client;
try
try
// Common client setup
Client.AddHeader('User-Agent', FUserAgent);
Client.AllowRedirect := True;
Client.OnDataReceived := @DataReceivedHandler;
// ------------------------------------------------------------------
// Names. The requested name comes from a remote catalog, so it is
// made safe like any other untrusted name.
// ------------------------------------------------------------------
ReqName := HCLSafeFileName(AFileName);
Stem := HCLDownloadStem(APageUrl);
// ------------------------------------------------------------------
// Method-specific setup
// ------------------------------------------------------------------
case AMethod of
// ------------------------------------------------------------------
dmDirect:
begin
if ADownloadUrl <> '' then
DownloadUrl := ADownloadUrl
else
DownloadUrl := APageUrl;
end;
// ------------------------------------------------------------------
dmIpsCsrf:
begin
// Step 1 — GET the page to establish a session cookie and harvest
// the csrfKey.
Client.AllowRedirect := True;
PageBody := Client.Get(APageUrl);
if FCancelled then
begin
Fail('Download cancelled during page fetch.');
Exit;
end;
CsrfKey := ExtractCsrfKey(PageBody);
if CsrfKey = '' then
begin
Fail('IPS-CSRF: could not extract csrfKey from page: ' + APageUrl);
Exit;
end;
// Step 2 — Build the actual download URL: the catalog's link to a
// specific file of the entry when it's on this site, else the
// entry's default download.
DownloadUrl := HCLBuildIpsDownloadUrl(APageUrl, ADownloadUrl, CsrfKey);
// Reset data-received counter between the page GET and the file GET.
FBytesReceived := 0;
FTotalBytes := -1;
end;
end; // case AMethod
// ------------------------------------------------------------------
// Name the .part file and determine the resume offset. A requested
// name keys it directly; otherwise the per-URL stem does, so an
// interrupted download only ever resumes onto its own bytes.
// ------------------------------------------------------------------
if ReqName <> '' then
PartPath := IncludeTrailingPathDelimiter(ADestDir) + ReqName + '.part'
else
PartPath := IncludeTrailingPathDelimiter(ADestDir) + Stem + '.part';
ResumeOffset := 0;
if FileExists(PartPath) then
begin
with TFileStream.Create(PartPath, fmOpenRead or fmShareDenyNone) do
begin
ResumeOffset := Size;
Free;
end;
end;
// ------------------------------------------------------------------
// Perform the download
// ------------------------------------------------------------------
// Always start empty so StreamToPartFile reads Content-Disposition.
ServerName := '';
StreamToPartFile(Client, DownloadUrl, PartPath, ResumeOffset, ServerName);
// ------------------------------------------------------------------
// Cancellation check after transfer
// ------------------------------------------------------------------
if FCancelled then
begin
Fail('Download cancelled.');
Exit;
end;
// ------------------------------------------------------------------
// Resolve the final filename now that Content-Disposition has been
// parsed: requested name, else the server's, else the URL stem.
// ------------------------------------------------------------------
ResolvedFN := HCLResolveDownloadName(ReqName, ServerName, Stem);
FinalPath := IncludeTrailingPathDelimiter(ADestDir) + ResolvedFN;
// ------------------------------------------------------------------
// Rename .part → final
// ------------------------------------------------------------------
if FileExists(FinalPath) then
DeleteFile(FinalPath);
if not RenameFile(PartPath, FinalPath) then
begin
Fail('Could not rename .part file to: ' + FinalPath);
Exit;
end;
// ------------------------------------------------------------------
// Get the written file size
// ------------------------------------------------------------------
with TFileStream.Create(FinalPath, fmOpenRead or fmShareDenyNone) do
begin
PartSize := Size;
Free;
end;
// ------------------------------------------------------------------
// SHA-256 computation and optional verification
// ------------------------------------------------------------------
ComputedHash := ComputeSHA256(FinalPath);
Result.SHA256 := ComputedHash;
if AExpectedSHA256 <> '' then
begin
if ComputedHash = '' then
begin
// Hash computation failed (e.g. file unreadable after rename).
Fail('SHA-256 computation failed for: ' + FinalPath);
Exit;
end;
if LowerCase(ComputedHash) <> LowerCase(AExpectedSHA256) then
begin
Fail(Format('SHA-256 mismatch: expected %s, got %s',
[AExpectedSHA256, ComputedHash]));
Exit;
end;
end;
// ------------------------------------------------------------------
// Success
// ------------------------------------------------------------------
Result.Success := True;
Result.FilePath := FinalPath;
Result.FileName := ResolvedFN;
Result.FileSize := PartSize;
except
on E: Exception do
Fail(E.ClassName + ': ' + E.Message);
end;
finally
FActiveClient := nil;
FDownloading := False;
FOnProgress := nil;
Client.Free;
end;
end;
end.