Browse Source

Merged revisions 1137,1141-1143 via svnmerge from
/trunk

git-svn-id: branches/fixes_2_0@1144 -

peter 20 years ago
parent
commit
b79f9c42d9

+ 2 - 0
.gitattributes

@@ -1576,6 +1576,8 @@ packages/base/sqlite/sqlite.pp svneol=native#text/plain
 packages/base/sqlite/sqlite3.pp svneol=native#text/plain
 packages/base/sqlite/sqlite3.pp svneol=native#text/plain
 packages/base/sqlite/sqlitedb.pas svneol=native#text/plain
 packages/base/sqlite/sqlitedb.pas svneol=native#text/plain
 packages/base/sqlite/test.pas svneol=native#text/plain
 packages/base/sqlite/test.pas svneol=native#text/plain
+packages/base/sqlite/testapiv3x.README -text
+packages/base/sqlite/testapiv3x.pp -text
 packages/extra/Makefile svneol=native#text/plain
 packages/extra/Makefile svneol=native#text/plain
 packages/extra/Makefile.fpc svneol=native#text/plain
 packages/extra/Makefile.fpc svneol=native#text/plain
 packages/extra/amunits/Makefile svneol=native#text/plain
 packages/extra/amunits/Makefile svneol=native#text/plain

+ 1 - 1
packages/base/sqlite/sqlite3.pp

@@ -286,7 +286,7 @@ function sqlite3_libversion:PChar;cdecl;external External_library name 'sqlite3_
 function sqlite3_version:PChar;cdecl;external External_library name 'sqlite3_libversion';
 function sqlite3_version:PChar;cdecl;external External_library name 'sqlite3_libversion';
 
 
 // Not published functions
 // Not published functions
-//function sqlite3_libversion_number:longint;cdecl;external External_library name 'sqlite3_libversion_number';
+function sqlite3_libversion_number:longint;cdecl;external External_library name 'sqlite3_libversion_number';
 //function sqlite3_key(db:Psqlite3; pKey:pointer; nKey:longint):longint;cdecl;external External_library name 'sqlite3_key';
 //function sqlite3_key(db:Psqlite3; pKey:pointer; nKey:longint):longint;cdecl;external External_library name 'sqlite3_key';
 //function sqlite3_rekey(db:Psqlite3; pKey:pointer; nKey:longint):longint;cdecl;external External_library name 'sqlite3_rekey';
 //function sqlite3_rekey(db:Psqlite3; pKey:pointer; nKey:longint):longint;cdecl;external External_library name 'sqlite3_rekey';
 //function sqlite3_sleep(_para1:longint):longint;cdecl;external External_library name 'sqlite3_sleep';
 //function sqlite3_sleep(_para1:longint):longint;cdecl;external External_library name 'sqlite3_sleep';

+ 40 - 0
packages/base/sqlite/testapiv3x.README

@@ -0,0 +1,40 @@
+Testing SQLite v3
+
+This prog is a simple direct api call
+for sqlite v3x.
+
+I.install
+1°)win32
+
+sqlite3.dll should be in default path or current dir
+can be downloaded from here : 
+ http://www.sqlite.org/
+
+
+2°)wince-arm
+
+sqlite3.dll should be in default path or current dir
+wince version can be downloaded from here :
+ http://sourceforge.net/projects/sqlite-wince
+this is a source only release evc++4
+also pre-compiled libraries for arm-wince will put
+on  ftp://ftp.freepascal.org/pub/fpc/contrib/cross/arm-wince-sqlite322.zip
+
+II.tests
+
+2005/09/19 :
+ wince-arm : 
+  testapvv3x have been tested with v3.2.2
+  compiled fpc2.1.1 today svn rep
+  command line for cross-compiling from XP:
+   ppcrossarm.exe -a -dNORMAL -Twince -XParm-wince-pe- -FDd:\binutils\win32-arm-pe -FE. -va -darm testapiv3x.pp >test-arm-wince.log
+
+ win32 :
+  testapvv3x have been tested with v3.2.4
+  compiled fpc2.1.1 today svn rep under lazarus
+
+
+
+Regards
+olivier
[email protected]

+ 83 - 0
packages/base/sqlite/testapiv3x.pp

@@ -0,0 +1,83 @@
+program testapiv3x;
+
+{$APPTYPE CONSOLE}
+{$MODE DELPHI}
+
+uses windows, sqlite3, sysutils;
+
+const
+ DBFILE='dbtest.db';
+
+var
+ rc       : Integer;
+ db       : PPsqlite3;
+ sql      : string;
+ pzErrMsg : PChar;
+ 
+function MyCallback(_para1:pointer; plArgc:longint; argv:PPchar; argcol:PPchar):longint; cdecl;
+var i: Integer;
+    PVal, PName: ^PChar;
+begin
+ PVal:=argv;
+ PName:=argcol;
+ for i:=0 to plArgc-1 do begin
+  writeln(Format('%s = ''%s'''#13, [PName^, PVal^]));
+  inc(PVal);
+  inc(PName);
+ end;
+ writeln(#13);
+ Result:=0;
+end;
+
+begin
+  writeln(Format('SQLite version : %d',[sqlite3_libversion_number]));
+  rc := sqlite3_open(PChar(DBFILE), @db);
+  try
+   if rc<>SQLITE_OK then begin
+    writeln(Format('Can''t open database: %s',[DBFILE]));
+   end;
+
+   sql:= 'DROP TABLE Test;';
+   rc:=sqlite3_exec(db, PChar(sql), @MyCallback, nil, @pzErrMsg);
+   if( rc<>SQLITE_OK )
+   then writeln(Format('SQL error: %s', [pzErrMsg^]));
+
+   sql:='CREATE TABLE Test(No integer, name varchar(32),shortname varchar(32), age integer);';
+   rc:=sqlite3_exec(db, PChar(sql), @MyCallback, nil, @pzErrMsg);
+   if( rc<>SQLITE_OK )
+   then writeln(Format('SQL error: %s', [pzErrMsg^]));
+   
+   sql:='INSERT INTO Test VALUES(1,''hi'', ''by'', -1);';
+   rc:=sqlite3_exec(db, PChar(sql), @MyCallback, nil, @pzErrMsg);
+   Writeln('Inserting row');
+   if( rc<>SQLITE_OK )
+   then writeln(Format('SQL error: %s', [pzErrMsg^]));
+
+   SQL := 'INSERT INTO Test VALUES(2,''dualcore'', ''runwell'',-1);';
+   rc:=sqlite3_exec(db, PChar(sql), @MyCallback, nil, @pzErrMsg);
+   Writeln('Inserting row') ;
+   if( rc<>SQLITE_OK )
+   then writeln(Format('SQL error: %s', [pzErrMsg^]));
+
+   SQL := 'INSERT INTO Test VALUES(3,''Hello'', ''World'',NULL);';
+   rc:=sqlite3_exec(db, PChar(sql), @MyCallback, nil, @pzErrMsg);
+   Writeln('Inserting row') ;
+   if( rc<>SQLITE_OK )
+   then writeln(Format('SQL error: %s', [pzErrMsg^]));
+
+   SQL := 'INSERT INTO Test VALUES(4,''just a little'', ''test'',-1);';
+   rc:=sqlite3_exec(db, PChar(sql), @MyCallback, nil, @pzErrMsg);
+   Writeln('Inserting row') ;
+   if( rc<>SQLITE_OK )
+   then writeln(Format('SQL error: %s', [pzErrMsg^]));
+
+   SQL := 'select * from Test;';
+   rc:=sqlite3_exec(db, PChar(sql), @MyCallback, nil, @pzErrMsg);
+   if( rc<>SQLITE_OK )
+   then writeln(Format('SQL error: %s', [pzErrMsg^]));
+  finally sqlite3_close(db); end;
+
+  sleep(5000);
+end.
+
+

+ 6 - 4
rtl/inc/wstringh.inc

@@ -53,18 +53,18 @@ Type
     CompUTF8 : function(p1,p2:PUTF8String) : shortint;
     CompUTF8 : function(p1,p2:PUTF8String) : shortint;
     CompUCS2 : function(p1,p2:PUCS2Char) : shortint;
     CompUCS2 : function(p1,p2:PUCS2Char) : shortint;
     CompUCS4 : function(p1,p2:PUC42Char) : shortint;
     CompUCS4 : function(p1,p2:PUC42Char) : shortint;
-}    
+}
     CompareWideStringProc : function(const s1, s2 : WideString) : PtrInt;
     CompareWideStringProc : function(const s1, s2 : WideString) : PtrInt;
     CompareTextWideStringProc : function(const s1, s2 : WideString): PtrInt;
     CompareTextWideStringProc : function(const s1, s2 : WideString): PtrInt;
     CharLengthPCharProc : function(const Str: PChar): PtrInt;
     CharLengthPCharProc : function(const Str: PChar): PtrInt;
-    
+
     UpperAnsiStringProc : function(const s : ansistring) : ansistring;
     UpperAnsiStringProc : function(const s : ansistring) : ansistring;
     LowerAnsiStringProc : function(const s : ansistring) : ansistring;
     LowerAnsiStringProc : function(const s : ansistring) : ansistring;
     CompareStrAnsiStringProc : function(const S1, S2: ansistring): PtrInt;
     CompareStrAnsiStringProc : function(const S1, S2: ansistring): PtrInt;
     CompareTextAnsiStringProc : function(const S1, S2: ansistring): PtrInt;
     CompareTextAnsiStringProc : function(const S1, S2: ansistring): PtrInt;
     StrCompAnsiStringProc : function(S1, S2: PChar): PtrInt;
     StrCompAnsiStringProc : function(S1, S2: PChar): PtrInt;
-    StrICompAnsiStringProc : function(S1, S2: PChar): PtrInt;  
-    StrLCompAnsiStringProc : function(S1, S2: PChar; MaxLen: PtrUInt): PtrInt;  
+    StrICompAnsiStringProc : function(S1, S2: PChar): PtrInt;
+    StrLCompAnsiStringProc : function(S1, S2: PChar; MaxLen: PtrUInt): PtrInt;
     StrLICompAnsiStringProc : function(S1, S2: PChar; MaxLen: PtrUInt): PtrInt;
     StrLICompAnsiStringProc : function(S1, S2: PChar; MaxLen: PtrUInt): PtrInt;
     StrLowerAnsiStringProc : function(Str: PChar): PChar;
     StrLowerAnsiStringProc : function(Str: PChar): PChar;
     StrUpperAnsiStringProc : function(Str: PChar): PChar;
     StrUpperAnsiStringProc : function(Str: PChar): PChar;
@@ -79,6 +79,8 @@ function UTF8Encode(const s : WideString) : UTF8String;
 function UTF8Decode(const s : UTF8String): WideString;
 function UTF8Decode(const s : UTF8String): WideString;
 function AnsiToUtf8(const s : ansistring): UTF8String;{$ifdef SYSTEMINLINE}inline;{$endif}
 function AnsiToUtf8(const s : ansistring): UTF8String;{$ifdef SYSTEMINLINE}inline;{$endif}
 function Utf8ToAnsi(const s : UTF8String) : ansistring;{$ifdef SYSTEMINLINE}inline;{$endif}
 function Utf8ToAnsi(const s : UTF8String) : ansistring;{$ifdef SYSTEMINLINE}inline;{$endif}
+function WideStringToUCS4String(const s : WideString) : UCS4String;
+function UCS4StringToWideString(const s : UCS4String) : WideString;
 
 
 var
 var
   widestringmanager : TWideStringManager;
   widestringmanager : TWideStringManager;

+ 25 - 4
rtl/inc/wstrings.inc

@@ -122,8 +122,8 @@ procedure WideStringError;
   begin
   begin
     HandleErrorFrame(204,get_frame);
     HandleErrorFrame(204,get_frame);
   end;
   end;
-  
-  
+
+
 {$ifdef WideStrDebug}
 {$ifdef WideStrDebug}
 Procedure DumpWideRec(S : Pointer);
 Procedure DumpWideRec(S : Pointer);
 begin
 begin
@@ -627,7 +627,7 @@ begin
       { windows doesn't support reallocing widestrings, this code
       { windows doesn't support reallocing widestrings, this code
         is anyways subject to be removed because widestrings shouldn't be
         is anyways subject to be removed because widestrings shouldn't be
         ref. counted anymore (FK) }
         ref. counted anymore (FK) }
-{$ifndef MSWINDOWS}       
+{$ifndef MSWINDOWS}
       else if (PWideRec(Pointer(S)-WideFirstOff)^.Ref = 1) then
       else if (PWideRec(Pointer(S)-WideFirstOff)^.Ref = 1) then
         begin
         begin
           Dec(Pointer(S),WideFirstOff);
           Dec(Pointer(S),WideFirstOff);
@@ -635,7 +635,7 @@ begin
               reallocmem(pointer(S), L*sizeof(WideChar)+WideRecLen);
               reallocmem(pointer(S), L*sizeof(WideChar)+WideRecLen);
           Inc(Pointer(S), WideFirstOff);
           Inc(Pointer(S), WideFirstOff);
         end
         end
-{$endif MSWINDOWS}        
+{$endif MSWINDOWS}
       else
       else
         begin
         begin
           { Reallocation is needed... }
           { Reallocation is needed... }
@@ -1283,6 +1283,27 @@ function Utf8ToAnsi(const s : UTF8String) : ansistring;{$ifdef SYSTEMINLINE}inli
   end;
   end;
 
 
 
 
+function WideStringToUCS4String(const s : WideString) : UCS4String;
+  var
+    i : SizeInt;
+  begin
+    setlength(result,length(s)+1);
+    for i:=1 to length(s) do
+      result[i-1]:=UCS4Char(s[i]);
+    result[length(s)]:=UCS4Char(0);
+  end;
+
+
+function UCS4StringToWideString(const s : UCS4String) : WideString;
+  var
+    i : SizeInt;
+  begin
+    setlength(result,length(s)-1);
+    for i:=1 to length(s)-1 do
+      result[i]:=WideChar(s[i-1]);
+  end;
+
+
 procedure unimplementedwidestring;
 procedure unimplementedwidestring;
   begin
   begin
     HandleErrorFrame(215,get_frame);
     HandleErrorFrame(215,get_frame);

+ 1 - 1
rtl/linux/fpcylix.pp

@@ -21,7 +21,7 @@ unit fpcylix;
   interface
   interface
 
 
     uses
     uses
-      dynlibs;
+      cwstring,dynlibs;
 
 
     var
     var
       MainInstance: PtrUInt;
       MainInstance: PtrUInt;

+ 25 - 16
rtl/objpas/classes/streams.inc

@@ -756,34 +756,43 @@ end;
 {****************************************************************************}
 {****************************************************************************}
 
 
 procedure TResourceStream.Initialize(Instance: THandle; Name, ResType: PChar);
 procedure TResourceStream.Initialize(Instance: THandle; Name, ResType: PChar);
-
-begin
-end;
+  begin
+    Res:=FindResource(Instance, Name, ResType);
+    if Res=0 then 
+      raise EResNotFound.CreateFmt(SResNotFound,[Name]);
+    Handle:=LoadResource(Instance,Res);
+    if Handle=0 then
+      raise EResNotFound.CreateFmt(SResNotFound,[Name]);
+    SetPointer(LockResource(Handle),SizeOfResource(Instance,Res));    
+  end;
 
 
 
 
 constructor TResourceStream.Create(Instance: THandle; const ResName: string; ResType: PChar);
 constructor TResourceStream.Create(Instance: THandle; const ResName: string; ResType: PChar);
-
-begin
-end;
+  begin
+    inherited create;
+    Initialize(Instance,pchar(ResName),ResType);
+  end;
 
 
 
 
 constructor TResourceStream.CreateFromID(Instance: THandle; ResID: Integer; ResType: PChar);
 constructor TResourceStream.CreateFromID(Instance: THandle; ResID: Integer; ResType: PChar);
-
-begin
-end;
+  begin
+    inherited create;
+    Initialize(Instance,pchar(ResID),ResType);
+  end;
 
 
 
 
 destructor TResourceStream.Destroy;
 destructor TResourceStream.Destroy;
-
-begin
-end;
+  begin
+    UnlockResource(Handle);
+    FreeResource(Handle);
+    inherited destroy;
+  end;
 
 
 
 
 function TResourceStream.Write(const Buffer; Count: Longint): Longint;
 function TResourceStream.Write(const Buffer; Count: Longint): Longint;
-
-begin
-  Write:=0;
-end;
+  begin
+    raise EStreamError.Create(SCantWriteResourceStreamError);
+  end;
 
 
 {****************************************************************************}
 {****************************************************************************}
 {*                             TOwnerStream                                 *}
 {*                             TOwnerStream                                 *}

+ 54 - 2
rtl/unix/cwstring.pp

@@ -102,6 +102,8 @@ function iconv_close(__cd:iconv_t):cint;cdecl;external libiconvname name 'libico
 {$endif}
 {$endif}
 
 
 var
 var
+  iconv_ansi2ucs4,
+  iconv_ucs42ansi,
   iconv_ansi2wide,
   iconv_ansi2wide,
   iconv_wide2ansi : iconv_t;
   iconv_wide2ansi : iconv_t;
 
 
@@ -219,13 +221,60 @@ function UpperWideString(const s : WideString) : WideString;
   end;
   end;
 
 
 
 
+procedure Ansi2UCS4Move(source:pchar;var dest:UCS4String;len:SizeInt);
+  var
+    outlength,
+    outoffset,
+    outleft : size_t;
+    srcpos,
+    destpos: pchar;
+    mynil : pchar;
+    my0 : size_t;
+  begin
+    mynil:=nil;
+    my0:=0;
+    // extra space
+    outlength:=len+1;
+    setlength(dest,outlength);
+    outlength:=len+1;
+    srcpos:=source;
+    destpos:=pchar(dest);
+    outleft:=outlength*4;
+    while iconv(iconv_ansi2ucs4,@srcpos,@len,@destpos,@outleft)=size_t(-1) do
+      begin
+        case fpgetCerrno of
+          ESysE2BIG:
+            begin
+              outoffset:=destpos-pchar(dest);
+              { extend }
+              setlength(dest,outlength+len);
+              inc(outleft,len*4);
+              inc(outlength,len);
+              { string could have been moved }
+              destpos:=pchar(dest)+outoffset;
+            end;
+          else
+            raise EConvertError.Create('iconv error');
+        end;
+      end;
+    // truncate string
+    setlength(dest,length(dest)-outleft div 4);
+  end;
+
+
 function CompareWideString(const s1, s2 : WideString) : PtrInt;
 function CompareWideString(const s1, s2 : WideString) : PtrInt;
+  var
+    hs1,hs2 : UCS4String;
   begin
   begin
+    hs1:=WideStringToUCS4String(s1);
+    hs2:=WideStringToUCS4String(s2);
+    result:=wcscoll(pwchar_t(hs1),pwchar_t(hs2));
   end;
   end;
 
 
 
 
 function CompareTextWideString(const s1, s2 : WideString): PtrInt;
 function CompareTextWideString(const s1, s2 : WideString): PtrInt;
   begin
   begin
+    result:=CompareWideString(UpperWideString(s1),UpperWideString(s2));
   end;
   end;
 
 
 
 
@@ -247,9 +296,10 @@ begin
 
 
       UpperWideStringProc:=@UpperWideString;
       UpperWideStringProc:=@UpperWideString;
       LowerWideStringProc:=@LowerWideString;
       LowerWideStringProc:=@LowerWideString;
+
+      CompareWideStringProc:=@CompareWideString;
+      CompareTextWideStringProc:=@CompareTextWideString;
       {
       {
-      CompareWideStringProc
-      CompareTextWideStringProc
       CharLengthPCharProc
       CharLengthPCharProc
 
 
       UpperAnsiStringProc
       UpperAnsiStringProc
@@ -275,6 +325,8 @@ initialization
   { init conversion tables }
   { init conversion tables }
   iconv_wide2ansi:=iconv_open(nl_langinfo(CODESET),unicode_encoding);
   iconv_wide2ansi:=iconv_open(nl_langinfo(CODESET),unicode_encoding);
   iconv_ansi2wide:=iconv_open(unicode_encoding,nl_langinfo(CODESET));
   iconv_ansi2wide:=iconv_open(unicode_encoding,nl_langinfo(CODESET));
+  iconv_ucs42ansi:=iconv_open(nl_langinfo(CODESET),'UCS4');
+  iconv_ansi2ucs4:=iconv_open('UCS4',nl_langinfo(CODESET));
 finalization
 finalization
   iconv_close(iconv_ansi2wide);
   iconv_close(iconv_ansi2wide);
 end.
 end.