mORMot Open Source

Tohang

Member

Registered: 2010-06-24

Posts: 10

SynSQLite3 and Delphi 5 compilation

I try to compile Delphi 5 SynSQLite3 degan and edit soursce program. I've tested and works well as follows:

program SQLITED5;

uses
   WINDOWS,SynCommonsd5,SynSQLite3D5;

var S:string; Res:Integer;oLite:TSQLRequest;nHDB:TSQLite3DB;
begin
  Res:=sqlite3_open('G:\SynSQLite\SQLite3\Nwind.db',nHDB);
  if Res=SQLITE_OK then begin
     oLite.Prepare(nHDB,'Select * from customers');
     oLite.Step;
     S:=oLite.FieldUTF8(1);
     MessageBox(0,PChar(S), 'Customer Name', MB_ICONWARNING or MB_OK);
     sqlite3_close(nHDB)
  end;
end.

SynSQLite3.pas
  ....
type
{$ifdef DELPHI5OROLDER}
{$A+} // bcc32 default alignment is 4 bytes
{$else}
{$A4} // bcc32 default alignment is 4 bytes
{$endif}
  ....
 
function TSQLDataBase.LastInsertRowID: Int64;
begin
  ....
{$ifdef DELPHI5OROLDER}
      fLog.Log(sllDB,FormatUTF8('LastInsertRowID=%d',[result]),self);
{$else}
      fLog.Log(sllDB,'LastInsertRowID=%',result,self);
{$endif}
  ....
end;

function TSQLDataBase.LastChangeCount: integer;
begin
  ....
{$ifdef DELPHI5OROLDER}
      fLog.Log(sllDB,FormatUTF8('LastChangeCount=%d',[result]),self);
{$else}
      fLog.Log(sllDB,'LastChangeCount=%',result,self);
{$endif}
  ....
end;

procedure TSQLDataBase.GetTableNames(var Names: TRawUTF8DynArray);
begin // SQL statement taken from official SQLite3 FAQ
  SetLength(Names,Execute(SQL_GET_TABLE_NAMES,Names));
{$ifdef DELPHI5OROLDER}
     // fLog.Log(sllDebug,'TableNames',TypeInfo(TRawUTF8DynArray),Names,self);
{$else}
      fLog.Log(sllDebug,'TableNames',TypeInfo(TRawUTF8DynArray),Names,self);
{$endif}
end;

function TSQLDataBase.DBOpen: integer;
var utf8: RawUTF8;
    i: integer;
    Cyph: TSQLCypher;
begin
  ....
{$ifdef DELPHI5OROLDER}
      fLog.Log(sllDB,FormatUTF8('open(%s) failed',[utf8]),self);
{$else}
    fLog.Log(sllError,'open("%") failed',utf8,self);
{$endif}
  ....
{$ifdef DELPHI5OROLDER}
      fLog.Log(sllDB,FormatUTF8('open(%s) with handle=%d',[utf8,Cyph.Handle]),self);
{$else}
   fLog.Log(sllDB,'open("%") with handle=%',[utf8,Cyph.Handle],self);
{$endif}
  ....
{$ifdef DELPHI5OROLDER}
      fLog.Log(sllError,FormatUTF8('Handle reused for %s',[utf8]))
{$else}
      fLog.Log(sllError,'Handle reused for %',utf8)
{$endif}
  ....
end;

procedure TSQLDataBase.SetBusyTimeout(const ms: Integer);
begin
  ....
{$ifdef DELPHI5OROLDER}
      fLog.Log(sllDB,FormatUTF8('SetBusyTimeout=%d',[ms]),self);
{$else}
  fLog.Log(sllDB,'SetBusyTimeout=%',ms,self);
{$endif}
  ....
end;

procedure TSQLDataBase.RegisterSQLFunction(aFunction: TSQLDataBaseSQLFunction);
var i: integer;
begin
  ....
{$ifdef DELPHI5OROLDER}
      fLog.Log(sllDB,FormatUTF8('RegisterSQLFunction=%s',[aFunction.FunctionName]),self);
{$else}
  fLog.Log(sllDB,'RegisterSQLFunction "%"',aFunction.FunctionName,self);
{$endif}
  ....
end;

function TSQLDataBaseSQLFunction.CreateFunction(DB: TSQLite3DB): Integer;
begin
  ....
    {$ifdef WITHLOG}
    if result<>SQLITE_OK then
{$ifdef DELPHI5OROLDER}
      SynSQLite3Log.Add.Log(sllError,FormatUTF8('register SQL function %s() failed',[FunctionName]),self);
{$else}
     SynSQLite3Log.Add.Log(sllError,'register SQL function %() failed',FunctionName,self);
{$endif}
    {$endif}
  ....
end;

SynCommons.pas
{$ifdef DELPHI5OROLDER}
function FormatUTF8(const Fmt: string; const Args: array of const): RawUTF8; overload;
{$endif}

{$ifdef DELPHI5OROLDER}
function FormatUTF8(const Fmt: String; const Args: array of const): RawUTF8; overload;
begin
  Result:=StringToUTF8(Format(Fmt,Args));
end;
{$endif}

ab

Administrator

From: France

Registered: 2010-06-21

Posts: 14,620

Website

Re: SynSQLite3 and Delphi 5 compilation

You are right: Delphi 5 is buggy with array of const...

I will make this unit officially compatible with Dlphi 5.

Thanks for the feedback.

Tohang

Member

Registered: 2010-06-24

Posts: 10

Re: SynSQLite3 and Delphi 5 compilation

His writing Geogle Translare translation, sorry my english bases can not.

a.) function FormatUTF8(Format: RawUTF8; const Args: array of const): RawUTF8; overload;
     begin
      Result:=FormatUTF8(PUTF8Char(Format),Args);
    end;
   
b.) function FormatUTF8(Format: PUTF8Char; const Args: array of const): RawUTF8;
    ....

procedure TSQLDataBase.GetFieldNames(var Names: TRawUTF8DynArray; const TableName: RawUTF8);
....
      R.Prepare(fDB,FormatUTF8('PRAGMA table_info(%);',[TableName]));
....
end;

Dephi 7 does not need the function of a.)

Dephi 5 requires the function of a.), String constants are considered RawUTF8, AnsiString. If the function b.) Used parameters must PUTF8Char.
  eg ss :: PUTF8Char
   ss: = 'PRAGMA table_info (%)';
   R.Prepare (FDB, FormatUTF8 (ss, [TableName]));
   
I have a way to overcome the disadvantages of Delphi 5 problem parameters "array of const". If this trick can be easy to be added.

SynCommonsd.pas
TTextWriter = class
......   
    procedure Add(Format: PWinAnsiChar; const Values: array of const;Escape: TTextWriterKind=twNone); overload;
    .....
    property Stream: TStream read fStream write fStream;
end;
{$ifdef DELPHI5OROLDER} { array of const is buggy in Delphi 5 }
procedure TextWriterAdd(oSelf:TTextWriter;Format: PWinAnsiChar; const Values: array of const;Escape: TTextWriterKind=twNone);//TTextWriter.Add
type
{$endif DELPHI5OROLDER}

TSynLog = class(TObject, ISynLog)
.....
{$ifndef DELPHI5OROLDER}
....
    procedure Log(Level: TSynLogInfo; TextFmt: PWinAnsiChar; const TextArgs: array of const;
      aInstance: TObject=nil); overload;
{$endif}
    /// same as Log(Level,TextFmt,[]) but with one RawUTF8 parameter
    procedure Log(Level: TSynLogInfo; TextFmt: PWinAnsiChar; const TextArg: RawUTF8;
      aInstance: TObject=nil); overload;
    /// same as Log(Level,TextFmt,[]) but with one Int64 parameter
    procedure Log(Level: TSynLogInfo; TextFmt: PWinAnsiChar; const TextArg: Int64; 
      aInstance: TObject=nil); overload;
....
    property FileName: TFileName read fFileName;
  end;

TSynLogFile = class(TMemoryMapText)
....
   property LogProcCount: integer read fLogProcCurrentCount;
end;
{$ifdef DELPHI5OROLDER} { array of const is buggy in Delphi 5 } //thg
procedure SynLogLogInternal(oSelf:TSynLog;Level: TSynLogInfo; TextFmt: PWinAnsiChar;const TextArgs: array of const; Instance: TObject);//TSynLog.LogInternal
procedure SynLogLog(oSelf:TSynLog;Level: TSynLogInfo; TextFmt: PWinAnsiChar; const TextArgs: array of const;aInstance: TObject=nil);//TSynLog.Log
{$endif DELPHI5OROLDER}

{$ifndef DELPHI5OROLDER}
procedure TTextWriter.Add(Format: PWinAnsiChar; const Values: array of const;
  Escape: TTextWriterKind=twNone);
  ....
end;
{$endif}
 
{$ifdef DELPHI5OROLDER} { array of const is buggy in Delphi 5 }  //thg
procedure TextWriterAdd(oSelf:TTextWriter;Format: PWinAnsiChar; const Values: array of const;Escape: TTextWriterKind=twNone);
var ValuesIndex: integer;
begin // we put const char > #127 as #??? -> asiatic MBCS codepage OK
  if not Assigned(oSelf) then Exit;if Format=nil then exit;ValuesIndex := 0;
  repeat
    repeat
      case ord(Format^) of
      0: exit;
      13, 164: oSelf.AddCR; // CR,¤ -> add CR,LF
      167: if oSelf.B^=',' then dec(oSelf.B); // §
      ord('$'),ord('%'),163,181: break; // $,%,£,µ
      else
        if oSelf.B>=oSelf.BEnd then
          oSelf.FlushInc^ := Format^ else begin
          oSelf.B[1] := Format^;
          inc(oSelf.B);
        end;
      end;
      inc(Format);
    until false;
    // add next value as text
    if ValuesIndex<=high(Values) then // missing value will display nothing
    case ord(Format^) of
    ord('%'): with Values[ValuesIndex] do
       case Vtype of
         vtInteger:      oSelf.Add(VInteger);
         vtBoolean:      oSelf.AddU(byte(VBoolean));
         vtChar:         oSelf.Add(@VChar,1,Escape);
         vtExtended:     oSelf.Add(VExtended^);
         vtString:       oSelf.Add(@VString^[1],ord(VString^[0]),Escape);
         vtPointer:      oSelf.AddPointer(PtrUInt(VPointer));
         vtPChar:        oSelf.Add(PUTF8Char(VPChar),Escape);
         vtObject:
           if VObject<>nil then begin
             oSelf.AddShort(PShortString(PPointer(PPtrInt(VObject)^+vmtClassName)^)^);
             oSelf.Add('(');
             if VObject.InheritsFrom(Exception) then
               with Exception(VObject) do
               {$ifdef UNICODE}AddW{$else} { no longer D5} oSelf.Add{$endif}(
                 pointer(Message),length(Message),Escape) else
               oSelf.AddPointer(PtrUInt(VObject));
             oSelf.Add(')');
           end;
         vtClass:
           if VClass<>nil then
             oSelf.AddShort(PShortString(PPointer(PtrInt(VClass)+vmtClassName)^)^);
         vtWideChar:
           oSelf.AddW(@VWideChar,1,Escape);
         vtPWideChar:
           oSelf.AddW(pointer(VPWideChar),StrLenW(VPWideChar),Escape);
         vtAnsiString:
           oSelf.Add(VAnsiString,Escape); // expect RawUTF8
         vtCurrency:
           oSelf.AddCurr64(VInt64);
         vtWideString:
           if VWideString<>nil then
             oSelf.AddW(VWideString,length(WideString(VWideString)),Escape);
         vtInt64:
           oSelf.Add(VInt64^);
{$ifdef UNICODE}  //no longer D5
         vtUnicodeString:
           if VUnicodeString<>nil then // convert to UTF-8
             AddW(VUnicodeString,length(UnicodeString(VUnicodeString)),Escape);
{$endif} end;
    ord('$'): with Values[ValuesIndex] do
           if Vtype=vtInteger then oSelf.Add2(VInteger);
    163: with Values[ValuesIndex] do // £
           if Vtype=vtInteger then oSelf.Add4(VInteger);
    181: with Values[ValuesIndex] do // µ
           if Vtype=vtInteger then oSelf.Add3(VInteger);
    end;
    inc(Format);
    inc(ValuesIndex);
  until false;
end;
{$endif DELPHI5OROLDER}

procedure TSynLog.Log(Level: TSynLogInfo; TextFmt: PWinAnsiChar; const TextArg: RawUTF8;
  aInstance: TObject=nil);
begin
  if (self<>nil) and (Level in fFamily.fLevel) then
{$IFDEF DELPHI5OROLDER}  //thg
    SynLogLogInternal(self,Level,TextFmt,[TextArg],aInstance);
{$ELSE}
   LogInternal(Level,TextFmt,[TextArg],aInstance);
{$endif}
end;

procedure TSynLog.Log(Level: TSynLogInfo; TextFmt: PWinAnsiChar; const TextArg: Int64;
  aInstance: TObject=nil);
begin
  if (self<>nil) and (Level in fFamily.fLevel) then
{$IFDEF DELPHI5OROLDER}  //thg
    SynLogLogInternal(self,Level,TextFmt,[TextArg],aInstance);
{$ELSE}
   LogInternal(Level,TextFmt,[TextArg],aInstance);
{$endif}
end;

{$ifndef DELPHI5OROLDER}
procedure TSynLog.LogInternal(Level: TSynLogInfo; TextFmt: PWinAnsiChar;const TextArgs: array of const; Instance: TObject);
...
end;
{$endif}

{$ifdef DELPHI5OROLDER} { array of const is buggy in Delphi 5 }  //thg
procedure SynLogLogInternal(oSelf:TSynLog;Level: TSynLogInfo; TextFmt: PWinAnsiChar;const TextArgs: array of const; Instance: TObject);
begin
  if not Assigned(oSelf) then Exit;oSelf.LogHeaderLock(Level);
  if Instance<>nil then oSelf.fWriter.AddInstancePointer(Instance,' ');
  TextWriterAdd(oSelf.fWriter,TextFmt,TextArgs,twOnSameLine);
  oSelf.LogTrailerUnLock(Level);
end;

procedure SynLogLog(oSelf:TSynLog;Level: TSynLogInfo; TextFmt: PWinAnsiChar; const TextArgs: array of const;aInstance: TObject=nil);
begin
  if (oSelf<>nil) and (Level in oSelf.fFamily.fLevel) then
    SynLogLogInternal(oSelf,Level,TextFmt,TextArgs,aInstance);
end;
{$endif DELPHI5OROLDER}

Application in "SynSQLite3.pas" can be done as an example:
function TSQLDataBase.DBOpen: integer;
...
  ss:PWinAnsiChar;//thg
begin
  ...
     ss:='open("%") failed';//thg
     fLog.Log(sllError,ss,utf8,self);
  ...
  {$ifdef DELPHI5OROLDER} //thg
     SynLogLog(fLog,sllDB,'open("%") with handle=%',[utf8,Cyph.Handle],self); //thg
  {$else}
     fLog.Log(sllDB,'open("%") with handle=%',[utf8,Cyph.Handle],self);  //thg
  {$endif}
  ....
    ss:='Handle reused for %';//thg
    if i>=0 then fLog.Log(sllError,ss,utf8) else begin //thg
  ....
end;

Testing Program

program SQLITED5;

uses SynCommonsd5,SynSQLite3D5;

var oDB:TSQLDataBase;
begin
    with SynSQLite3Log.Family do begin
      Level := LOG_VERBOSE;AutoFlushTimeOut := 10;HighResolutionTimeStamp := true;
    end;
    oDB:=TSQLDataBase.Create('E:\SynSQLite\SQLite3\Nwind.db');
    oDB.Execute('Select * from customers');
    oDB.DBClose;
end.

Log Results Program
E:\SynSQLite\SQLite3\SQLITED5.exe 0.0.0.0 (2012-09-07 14:41:30)
Host=TOHANGP User=Owner CPU=2*0-6-3851 OS=2.3=5.1.2600 Wow64=0 Freq=2599990000
TSynLog 1.17 2012-09-07T14:41:28

00000000000002BE  +    0041A584
0000000002090AE8 DB        TSQLDatabase(00990DBC) open("E:\SynSQLite\SQLite3\Nwind.db") with handle=1968
00000000020A9700  -    0041A93B  00.013.172
00000000020AC890  +    TSQLDatabase(00990DBC).0041A3C4
00000000020AD5EB SQL       Select * from customers
0000000003235B7E  -    TSQLDatabase(00990DBC).0041A431  00.007.072
0000000003237A1D  +    0041A4A6
0000000003263892  -    0041A51E  00.000.069

ab

Administrator

From: France

Registered: 2010-06-21

Posts: 14,620

Website

Re: SynSQLite3 and Delphi 5 compilation

I've made modifications to let the unit compile with Delphi 5.
See http://synopse.info/fossil/info/7bd212de43

Even SynDBSQLite3.pas can be compiled with Delphi 5 now.
See http://synopse.info/fossil/info/3148feae44

So you can use our SynDB classes under this version of Delphi, to connect from the same interface, natively to:
- any ODBC provider;
- any OleDB provider;
- direct Oracle connection;
- direct SQlite3 connection.

I think it is better to use SynDBSQLite3 instead of SynSQLite3 unit.
So you can benefit of the SynDB abstraction classes, and even the TQuery wrapper, if you have some BDE existing code to be converted!

By the way, the SQLite3 engine has just been updated to latest version 3.7.14.
See http://synopse.info/fossil/info/c4897fe8b8

Hope it helps.

Thanks for the feedback.