Merged revisions 1137,1141-1143 via svnmerge from

/trunk

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

.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/sqlitedb.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.fpc svneol=native#text/plain
 packages/extra/amunits/Makefile svneol=native#text/plain

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';
 
 // 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_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';

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]

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.
+
+

rtl/inc/wstringh.inc

@@ -53,18 +53,18 @@ Type
     CompUTF8 : function(p1,p2:PUTF8String) : shortint;
     CompUCS2 : function(p1,p2:PUCS2Char) : shortint;
     CompUCS4 : function(p1,p2:PUC42Char) : shortint;
-}    
+}
     CompareWideStringProc : function(const s1, s2 : WideString) : PtrInt;
     CompareTextWideStringProc : function(const s1, s2 : WideString): PtrInt;
     CharLengthPCharProc : function(const Str: PChar): PtrInt;
-    
+
     UpperAnsiStringProc : function(const s : ansistring) : ansistring;
     LowerAnsiStringProc : function(const s : ansistring) : ansistring;
     CompareStrAnsiStringProc : function(const S1, S2: ansistring): PtrInt;
     CompareTextAnsiStringProc : function(const S1, S2: ansistring): 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;
     StrLowerAnsiStringProc : 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 AnsiToUtf8(const s : ansistring): UTF8String;{$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
   widestringmanager : TWideStringManager;

rtl/inc/wstrings.inc

@@ -122,8 +122,8 @@ procedure WideStringError;
   begin
     HandleErrorFrame(204,get_frame);
   end;
-  
-  
+
+
 {$ifdef WideStrDebug}
 Procedure DumpWideRec(S : Pointer);
 begin
@@ -627,7 +627,7 @@ begin
       { windows doesn't support reallocing widestrings, this code
         is anyways subject to be removed because widestrings shouldn't be
         ref. counted anymore (FK) }
-{$ifndef MSWINDOWS}       
+{$ifndef MSWINDOWS}
       else if (PWideRec(Pointer(S)-WideFirstOff)^.Ref = 1) then
         begin
           Dec(Pointer(S),WideFirstOff);
@@ -635,7 +635,7 @@ begin
               reallocmem(pointer(S), L*sizeof(WideChar)+WideRecLen);
           Inc(Pointer(S), WideFirstOff);
         end
-{$endif MSWINDOWS}        
+{$endif MSWINDOWS}
       else
         begin
           { Reallocation is needed... }
@@ -1283,6 +1283,27 @@ function Utf8ToAnsi(const s : UTF8String) : ansistring;{$ifdef SYSTEMINLINE}inli
   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;
   begin
     HandleErrorFrame(215,get_frame);

rtl/linux/fpcylix.pp

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

rtl/objpas/classes/streams.inc

@@ -756,34 +756,43 @@ end;
 {****************************************************************************}
 
 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);
-
-begin
-end;
+  begin
+    inherited create;
+    Initialize(Instance,pchar(ResName),ResType);
+  end;
 
 
 constructor TResourceStream.CreateFromID(Instance: THandle; ResID: Integer; ResType: PChar);
-
-begin
-end;
+  begin
+    inherited create;
+    Initialize(Instance,pchar(ResID),ResType);
+  end;
 
 
 destructor TResourceStream.Destroy;
-
-begin
-end;
+  begin
+    UnlockResource(Handle);
+    FreeResource(Handle);
+    inherited destroy;
+  end;
 
 
 function TResourceStream.Write(const Buffer; Count: Longint): Longint;
-
-begin
-  Write:=0;
-end;
+  begin
+    raise EStreamError.Create(SCantWriteResourceStreamError);
+  end;
 
 {****************************************************************************}
 {*                             TOwnerStream                                 *}

rtl/unix/cwstring.pp

@@ -102,6 +102,8 @@ function iconv_close(__cd:iconv_t):cint;cdecl;external libiconvname name 'libico
 {$endif}
 
 var
+  iconv_ansi2ucs4,
+  iconv_ucs42ansi,
   iconv_ansi2wide,
   iconv_wide2ansi : iconv_t;
 
@@ -219,13 +221,60 @@ function UpperWideString(const s : WideString) : WideString;
   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;
+  var
+    hs1,hs2 : UCS4String;
   begin
+    hs1:=WideStringToUCS4String(s1);
+    hs2:=WideStringToUCS4String(s2);
+    result:=wcscoll(pwchar_t(hs1),pwchar_t(hs2));
   end;
 
 
 function CompareTextWideString(const s1, s2 : WideString): PtrInt;
   begin
+    result:=CompareWideString(UpperWideString(s1),UpperWideString(s2));
   end;
 
 
@@ -247,9 +296,10 @@ begin
 
       UpperWideStringProc:=@UpperWideString;
       LowerWideStringProc:=@LowerWideString;
+
+      CompareWideStringProc:=@CompareWideString;
+      CompareTextWideStringProc:=@CompareTextWideString;
       {
-      CompareWideStringProc
-      CompareTextWideStringProc
       CharLengthPCharProc
 
       UpperAnsiStringProc
@@ -275,6 +325,8 @@ initialization
   { init conversion tables }
   iconv_wide2ansi:=iconv_open(nl_langinfo(CODESET),unicode_encoding);
   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
   iconv_close(iconv_ansi2wide);
 end.