program Utf8PathBug;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Winapi.Windows;

type
  EFBException = class(Exception)
  private
    FSqlCode: Integer;
    FErrorCode: Word;
    FSqlState: RawByteString;
  public
    constructor Create(const AMsg: string; ASqlCode: Integer; AErrorCode: Word; const ASqlState: RawByteString);
  end;

  EFBExceptionClass = class of EFBException;

{ EFBException }

constructor EFBException.Create(const AMsg: string; ASqlCode: Integer;
  AErrorCode: Word; const ASqlState: RawByteString);
begin
  inherited Create(AMsg);

  FSqlCode := ASqlCode;
  FErrorCode := AErrorCode;
  FSqlState := ASqlState;
end;

procedure SetConsoleToUTF8;
begin
  if IsConsole then
    SetConsoleOutputCP(65001);
end;

procedure Test;
type
  {$IFDEF CPUX64}
  PtrInt = IntPtr;
  {$ELSE}
  PtrInt = type Longint;
  {$ENDIF}

  {$IFDEF FB25_UP}
  const
    FB_SQLSTATE_SIZE  = 6;
  {$ENDIF}

  ISCStatus = type PtrInt;
  PISCStatus = ^ISCStatus;
  PPISCStatus = ^PISCStatus;
  isc_db_handle = PPointer;
  IscDbHandle = type isc_db_handle;
  PIscDbHandle = ^IscDbHandle;
  ISC_LONG = type Integer;
  ISCLong = ISC_LONG;

const
  fb_shutrsn_svc_stopped      = -1;
  fb_shutrsn_app_stopped      = -3;
  ISC_STATUS_LENGTH = 20;

  CLASS_MASK = $F0000000;

  CLASS_ERROR   = 0;

  CODE_MASK  = $0000FFFF; // for msg-file codes

type
  TStatusVector = array[0..ISC_STATUS_LENGTH - 1] of ISCStatus;
  PStatusVector = ^TStatusVector;

var
  isc_attach_database: function(user_status: PISCStatus; file_length: Smallint; file_name: PAnsiChar; handle: PIscDbHandle; dpb_length: Smallint; dpb: PAnsiChar): ISCStatus; stdcall;
  isc_detach_database: function(user_status: PISCStatus; handle: PIscDbHandle): ISCStatus; stdcall;
  fb_interpret: function(buffer: PAnsiChar; v: integer; status_vector: PPISCStatus): ISCStatus; stdcall;
  isc_sqlcode: function(user_status: PISCStatus): ISCLong; stdcall;
  isc_sql_interprete: procedure(SQLCODE: Smallint; buffer: PAnsiChar; buffer_length: Smallint); stdcall;
  {$IFDEF FB25_UP}
  fb_shutdown: function(timeout: Cardinal; const reason: Integer): Integer; stdcall;
  fb_sqlstate: procedure(buffer: PAnsiChar; const user_status: PISCStatus); stdcall;
  {$ENDIF}

  function InterpreteStatusVector(StatusVector: PStatusVector): RawByteString;
  var
    Len: Integer;
    Buffer: array[0..512] of AnsiChar;
  begin
    Result := '';
    while True do
    begin
      Len := fb_interpret(Buffer, SizeOf(Buffer), @StatusVector);
      if Len > 0 then
        Result := Result + Copy(Buffer, 0, Len) + #13#10
      else
        Break;
    end;
  end;

  function SQLInterprete(SqlCode: Smallint): RawByteString;
  var
    I: Integer;
  begin
    SetLength(Result, 255);
    isc_sql_interprete(SqlCode, PAnsiChar(Result), 255);
    for I := 1 to 255 do
      if Result[I] = #0 then
        Break;
    SetLength(Result, i-1);
  end;

  {$IFDEF FB25_UP}
  function GetSqlState(StatusVector: PFStatusVector): RawByteString;
  begin
    SetLength(Result, FB_SQLSTATE_SIZE);
    fb_sqlstate(PAnsiChar(Result), StatusVector);
  end;
  {$ENDIF}

  procedure CheckApiCall(const Status: ISCStatus; StatusVector: PStatusVector);

    function GetStstusClass(Status: ISCStatus): Word;
    begin
      Result := (Status and CLASS_MASK) shr 30;
    end;

    function GetStatusCode(Status: ISCStatus): Word;
    begin
      Result := (Status and CODE_MASK) shr 0;
    end;

  var
    SqlCode: ISCLong;
    ErrorCode: Word;
    Msg: string;
    SqlState: RawByteString;
  begin
    if Status <> 0 then
    begin
      if (GetStstusClass(Status) = CLASS_ERROR) then
      begin
        SqlCode := isc_sqlcode(@StatusVector);
        Msg := string(InterpreteStatusVector(StatusVector));
        if SqlCode <> 0 then
          Msg := Msg + string(SQLInterprete(SqlCode)); // may be range check error here!
        ErrorCode := GetStatusCode(Status);
        {$IFDEF FB25_UP}
        SqlState := GetSqlState(StatusVector);
        {$ENDIF}
        Msg := Msg + #13#10 + Format('Status Code = %d, SQL Code = %d, Error Code = %d', [Status, SqlCode, ErrorCode]);

        raise EFBException.Create(Msg, SqlCode, ErrorCode, SqlState);
      end;
    end;
  end;

  procedure AttachDatabase(const FileName: RawByteString; var DbHandle: IscDbHandle; Params: AnsiString);
  var
    StatusVector: TStatusVector;
  begin
    FillChar(StatusVector, SizeOf(StatusVector), 0);
    CheckApiCall(isc_attach_database(@StatusVector, Length(FileName), Pointer(FileName),
      @DBHandle, Length(Params), PAnsiChar(Params)), @StatusVector);
  end;

  procedure DetachDatabase(var DbHandle: IscDbHandle);
  var
    StatusVector: TStatusVector;
  begin
    FillChar(StatusVector, SizeOf(StatusVector), 0);
    CheckApiCall(isc_detach_database(@StatusVector, @DbHandle), @StatusVector);
    DbHandle := nil;
  end;

  function UnicodeStringToUTF8(const S: UnicodeString): RawByteString;
  begin
    SetLength(Result, WideCharToMultiByte(CP_UTF8, 0, PWideChar(S), Length(S), nil, 0, nil, nil));
    WideCharToMultiByte(CP_UTF8, 0, PWideChar(S), Length(S), PAnsiChar(Result), Length(Result), nil, nil);
  end;

var
  Handle: THandle;
  DbHandle: IscDbHandle;
  ConnectionString: string;
  Ch: Char;
begin
  Handle := LoadLibrary('fbclient.dll');
  if Handle <= HINSTANCE_ERROR then
    RaiseLastOSError;

  try
    isc_attach_database := GetProcAddress(Handle, 'isc_attach_database');
    Assert(Assigned(isc_attach_database));
    isc_detach_database := GetProcAddress(Handle, 'isc_detach_database');
    Assert(Assigned(isc_detach_database));
    fb_interpret := GetProcAddress(Handle, 'fb_interpret');
    Assert(Assigned(fb_interpret));
    isc_sqlcode := GetProcAddress(Handle, 'isc_sqlcode');
    Assert(Assigned(isc_sqlcode));
    isc_sql_interprete := GetProcAddress(Handle, 'isc_sql_interprete');
    Assert(Assigned(isc_sql_interprete));
    {$IFDEF FB25_UP}
    fb_shutdown := GetProcAddress(Handle, 'fb_shutdown');
    Assert(Assigned(fb_shutdown));
    fb_sqlstate := GetProcAddress(Handle, 'fb_sqlstate');
    Assert(Assigned(fb_sqlstate));
    {$ENDIF}
    // #$00A3 - символ британского фунта стерлингов
    ConnectionString := ExtractFilePath(ParamStr(0)) + 'Проект, ценой в '#$00A3'30,000\data.fdb';
    ForceDirectories(ExtractFileDir(ConnectionString));
    WriteLn('ConnectionString: ' + ConnectionString);

    DbHandle := nil;
    AttachDatabase(UnicodeStringToUTF8(ConnectionString), DbHandle, #1'?'#1#3'0'#7'WIN1251'#$1C#6'SYSDBA'#$1D#9'masterkeyM'#0);
    DetachDatabase(DbHandle);
  finally
    {$IFDEF FB25_UP}
    fb_shutdown(60000, fb_shutrsn_app_stopped);
    {$ENDIF}
    FreeLibrary(Handle);
  end;
end;

begin
  try
    SetConsoleToUTF8;
    Test;
    WriteLn('Ok');
  except
    on E: Exception do
    begin
      WriteLn(E.Message);
    end;
  end;
  WriteLn('Press Enter to exit');
  ReadLn;
end.