paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-15 10:09:15 +02:00
Code Issues Packages Projects Releases Wiki Activity

Merged revisions 1137,1141-1143 via svnmerge from

Browse Source 
/trunk

git-svn-id: branches/fixes_2_0@1144 -
This commit is contained in:
peter 2005-09-20 06:27:41 +00:00
parent 860472f073
commit b79f9c42d9
9 changed files with 238 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -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

2
packages/base/sqlite/sqlite3.pp
View File

@ -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';

40
packages/base/sqlite/testapiv3x.README Normal file
View File

@ -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
orinaudo@gmail.com

83
packages/base/sqlite/testapiv3x.pp Normal file
View File

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

10
rtl/inc/wstringh.inc
View File

@ -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;

29
rtl/inc/wstrings.inc
View File

@ -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);

2
rtl/linux/fpcylix.pp
View File

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

41
rtl/objpas/classes/streams.inc
View File

@ -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 *}

58
rtl/unix/cwstring.pp
View File

@ -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;
function CompareWideString(const s1, s2 : WideString) : PtrInt;
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.