{ An encapsulation of the Format function to gain a higher level of security
  Copyright (C) 2026 Ekkehard Domning (www.domis.de)

  License: modified LGPL with linking exception (like RTL, FCL and LCL)

  See the file COPYING.modifiedLGPL.txt, included in the Lazarus distribution,
  for details about the license.

  The Format function of FreePascal or Delphi contains the risk of an unwanted
  exception, if the format string and the passed parameters are not matching.
  This is very annoying and could not catched always during compile time.
  If the parameter string is passed dynamically, e.g. different fornmats for different
  languages, those faults could never catched during compile time.
  If for example, the format function is used to generate descriptive error messages
  for looging errors, the loss of information, caused by a simple typo in the
  formatstring, might be very expensive.

  One solution is presented here.
  The Format function is encapsulated by a new FormatEx function, which wrappes
  the call to the original function in an Try..Except-Block.
  The possible exception is catched and in the except block the passed parameters
  are listed and returned.
  Having this information in the log file, the damage might be much less, since the
  parameter value could be manually sorted and evaluated.
  Limitations:
   Some rare used cases are are not catched:
    The content of a Variant could not be resolverd.
    The Name of passed Classes are not resolved
   Wide- and Unicode- Chars and Strings are casted to AnsiString and may have losses


  Example:
  =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
  const
    TestPChar : PChar = 'ABC';
    TestPWChar : PWideChar = 'DEF';

  function TestFormatEx : String
  var
    ws : WideString;
    us : UnicodeString;
    wc : WideChar;
    v : Variant;
    money : Currency;
  begin
    ws := 'WideString';
    us := 'UnicodeString';
    wc := #65;
    v := 99;
    money := 12345678.90;

    Result := FormatEx('Test %d %s',[1.2345E9,money,27,'Test',#64,TestPChar,ws,us,wc,TestPWChar,@Self,v,Self]);
  end;
  =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-

  The function will return as following (Line-breaks added for readability):
    Invalid argument index in format "Test %d %s" with Parms:
    [0]: (Extended) 1234500000; [1]: (Currency) 12345678,9; [2]: (Integer) 27;
    [3]: (AnsiStr) Test; [4]: (Char) @; [5]: (PChar) ABC;
    [6]: (WideStr) WideString; [7]: (UnicodeStr) UnicodeString;
    [8]: (WideChar) A; [9]: (PWideChar) D; [10]: (Ptr) 00000000013FFDC8;
    [11]: (Variant) n/a ; [11]: (Unknown) n/a
}

unit uformatex;

{$mode ObjFPC}{$H+}

interface

uses
  Classes, SysUtils;

function FormatEx(const Fmt : AnsiString; const Args : array of const; const FormatSettings: TFormatSettings) : AnsiString;
function FormatEx(const Fmt : AnsiString; const Args : array of const) : AnsiString;


implementation

function FormatEx(const Fmt : AnsiString; const Args : array of const; const FormatSettings: TFormatSettings) : AnsiString;
var
  i : Integer;
  s : String;
  buf : array of Byte = Nil;
begin
  try
    Result := Format(Fmt,Args,FormatSettings);
  except
    on E : Exception do
    begin
      Result := E.Message;
      if Length(Args) > 0 then
      begin
        Result := Result+' with Parms: ';
        for i := 0 to High(Args) do
        begin
          s := ' ['+IntToStr(i)+']: ';
          if i > 0 then
            s := ';'+s;
          case Args[i].VType of
            vtInteger :
              Result := Result + s+ '(Integer) '+IntToStr(Args[i].VInteger);
            vtInt64 :
              Result := Result + s+ '(Int64) '+IntToStr(Args[i].VInt64^);
            vtQWord :
              Result := Result + s+ '(QWord) '+IntToStr(Int64(Args[i].VQWord^));
            vtCurrency :
              Result := Result + s+ '(Currency) '+FloatToStr(Args[i].VCurrency^);
            vtExtended :
              Result := Result + s+ '(Extended) '+FloatToStr(Args[i].VExtended^);
            vtString :
              Result := Result + s+ '(Str) '+ Args[i].VString^;
            vtChar :
              Result := Result + s+ '(Char) '+ Args[i].VChar;
            vtPChar :
              Result := Result + s+ '(PChar) '+ Args[i].VPChar;
            vtPWideChar :
              Result := Result + s+ '(PWideChar) '+ AnsiString(Args[i].VPWideChar^);
            vtWideChar :
              Result := Result + s+ '(WideChar) '+ AnsiChar(Args[i].VWideChar);
            vtWidestring :
              Result := Result + s+ '(WideStr) '+ AnsiString(WideString(Args[i].VWideString));
            vtAnsiString :
              Result := Result + s+ '(AnsiStr) '+ AnsiString(Args[i].VAnsiString);
            vtUnicodeString :
              Result := Result + s+ '(UnicodeStr) '+ AnsiString(UnicodeString(Args[i].VUnicodeString));
            vtVariant :
              Result := Result + s+ '(Variant) n/a ';
            vtPointer :
              begin
                // Keep the compiler calm
                SetLength(buf,SizeOf(PtrUInt)*2);
                Move(Args[i].VPointer,buf[0],Length(buf));
                Result := Result + s+ '(Ptr) '+ HexStr(PUInt64(@buf[0])^,Length(buf));
              end
          else
            Result := Result + s+ '(Unknown) n/a';
          end;
        end;
      end;
    end;
  end;
end;

function FormatEx(const Fmt : AnsiString; const Args : array of const) : AnsiString;
begin
  Result := FormatEx(Fmt,Args,DefaultFormatSettings);
end;

end.