浏览代码

Merged revisions 569,602,604-605,609 via svnmerge from
/trunk

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

peter 20 年之前
父节点
当前提交
d7f23a530a

+ 2 - 0
.gitattributes

@@ -1358,6 +1358,7 @@ packages/base/mysql/Makefile svneol=native#text/plain
 packages/base/mysql/Makefile.fpc svneol=native#text/plain
 packages/base/mysql/Makefile.fpc svneol=native#text/plain
 packages/base/mysql/README -text
 packages/base/mysql/README -text
 packages/base/mysql/mkdb -text
 packages/base/mysql/mkdb -text
+packages/base/mysql/my4_sys.pp svneol=native#text/plain
 packages/base/mysql/mysql3.pp svneol=native#text/plain
 packages/base/mysql/mysql3.pp svneol=native#text/plain
 packages/base/mysql/mysql3_com.pp svneol=native#text/plain
 packages/base/mysql/mysql3_com.pp svneol=native#text/plain
 packages/base/mysql/mysql3_comdyn.pp svneol=native#text/plain
 packages/base/mysql/mysql3_comdyn.pp svneol=native#text/plain
@@ -5147,6 +5148,7 @@ tests/test/units/system/ttrunc.pp svneol=native#text/plain
 tests/test/units/sysutils/execansi.pp svneol=native#text/plain
 tests/test/units/sysutils/execansi.pp svneol=native#text/plain
 tests/test/units/sysutils/execedbya.pp svneol=native#text/plain
 tests/test/units/sysutils/execedbya.pp svneol=native#text/plain
 tests/test/units/sysutils/extractquote.pp svneol=native#text/plain
 tests/test/units/sysutils/extractquote.pp svneol=native#text/plain
+tests/test/units/sysutils/tsscanf.pp svneol=native#text/plain
 tests/test/uprocext1.pp svneol=native#text/plain
 tests/test/uprocext1.pp svneol=native#text/plain
 tests/test/uprocext2.pp svneol=native#text/plain
 tests/test/uprocext2.pp svneol=native#text/plain
 tests/test/utasout.pp svneol=native#text/plain
 tests/test/utasout.pp svneol=native#text/plain

+ 18 - 6
fcl/db/mysql/mysqldb4.pp

@@ -688,12 +688,15 @@ end;
 function TMySQLDataset.InternalStrToDate(S: string): TDateTime;
 function TMySQLDataset.InternalStrToDate(S: string): TDateTime;
 
 
 var
 var
-  EY, EM, ED: Word;
+  EY, EM, ED: Longint;
 
 
 begin
 begin
+  SScanf(S,'%d-%d-%d',[@EY,@EM,@ED]);
+  {
   EY := StrToInt(Copy(S,1,4));
   EY := StrToInt(Copy(S,1,4));
   EM := StrToInt(Copy(S,6,2));
   EM := StrToInt(Copy(S,6,2));
   ED := StrToInt(Copy(S,9,2));
   ED := StrToInt(Copy(S,9,2));
+  }
   if (EY = 0) or (EM = 0) or (ED = 0) then
   if (EY = 0) or (EM = 0) or (ED = 0) then
     Result:=0
     Result:=0
   else
   else
@@ -703,16 +706,19 @@ end;
 function TMySQLDataset.InternalStrToDateTime(S: string): TDateTime;
 function TMySQLDataset.InternalStrToDateTime(S: string): TDateTime;
 
 
 var
 var
-  EY, EM, ED: Word;
-  EH, EN, ES: Word;
+  EY, EM, ED: Longint;
+  EH, EN, ES: Longint;
 
 
 begin
 begin
+  SScanf(S,'%d-%d-%d %d:%d:%d',[@EY,@EM,@ED,@EH,@EN,@ES]);
+  {
   EY := StrToInt(Copy(S, 1, 4));
   EY := StrToInt(Copy(S, 1, 4));
   EM := StrToInt(Copy(S, 6, 2));
   EM := StrToInt(Copy(S, 6, 2));
   ED := StrToInt(Copy(S, 9, 2));
   ED := StrToInt(Copy(S, 9, 2));
   EH := StrToInt(Copy(S, 12, 2));
   EH := StrToInt(Copy(S, 12, 2));
   EN := StrToInt(Copy(S, 15, 2));
   EN := StrToInt(Copy(S, 15, 2));
   ES := StrToInt(Copy(S, 18, 2));
   ES := StrToInt(Copy(S, 18, 2));
+  }
   if (EY = 0) or (EM = 0) or (ED = 0) then
   if (EY = 0) or (EM = 0) or (ED = 0) then
     Result := 0
     Result := 0
   else
   else
@@ -723,28 +729,34 @@ end;
 function TMySQLDataset.InternalStrToTime(S: string): TDateTime;
 function TMySQLDataset.InternalStrToTime(S: string): TDateTime;
 
 
 var
 var
-  EH, EM, ES: Word;
+  EH, EM, ES: Longint;
 
 
 begin
 begin
+  SScanf(S,'%d:%d:%d',[@EH,@EM,@ES]);
+  {
   EH := StrToInt(Copy(S, 1, 2));
   EH := StrToInt(Copy(S, 1, 2));
   EM := StrToInt(Copy(S, 4, 2));
   EM := StrToInt(Copy(S, 4, 2));
   ES := StrToInt(Copy(S, 7, 2));
   ES := StrToInt(Copy(S, 7, 2));
+  }
   Result := EncodeTime(EH, EM, ES, 0);
   Result := EncodeTime(EH, EM, ES, 0);
 end;
 end;
 
 
 function TMySQLDataset.InternalStrToTimeStamp(S: string): TDateTime;
 function TMySQLDataset.InternalStrToTimeStamp(S: string): TDateTime;
 
 
 var
 var
-  EY, EM, ED: Word;
-  EH, EN, ES: Word;
+  EY, EM, ED: longint;
+  EH, EN, ES: longint;
 
 
 begin
 begin
+  SScanf(S,'%d-%d-%d %d:%d:%d',[@EY,@EM,@ED,@EH,@EN,@ES]);
+  {
   EY := StrToInt(Copy(S, 1, 4));
   EY := StrToInt(Copy(S, 1, 4));
   EM := StrToInt(Copy(S, 5, 2));
   EM := StrToInt(Copy(S, 5, 2));
   ED := StrToInt(Copy(S, 7, 2));
   ED := StrToInt(Copy(S, 7, 2));
   EH := StrToInt(Copy(S, 9, 2));
   EH := StrToInt(Copy(S, 9, 2));
   EN := StrToInt(Copy(S, 11, 2));
   EN := StrToInt(Copy(S, 11, 2));
   ES := StrToInt(Copy(S, 13, 2));
   ES := StrToInt(Copy(S, 13, 2));
+  }
   if (EY = 0) or (EM = 0) or (ED = 0) then
   if (EY = 0) or (EM = 0) or (ED = 0) then
     Result := 0
     Result := 0
   else
   else

+ 34 - 34
packages/base/mysql/Makefile

@@ -1,5 +1,5 @@
 #
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/05/05]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/05/09]
 #
 #
 default: all
 default: all
 MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd arm-linux
 MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd arm-linux
@@ -233,103 +233,103 @@ PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/ext
 override PACKAGE_NAME=mysql
 override PACKAGE_NAME=mysql
 override PACKAGE_VERSION=2.0.0
 override PACKAGE_VERSION=2.0.0
 ifeq ($(FULL_TARGET),i386-linux)
 ifeq ($(FULL_TARGET),i386-linux)
-override TARGET_UNITS+=mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
+override TARGET_UNITS+=my4_sys mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
 endif
 endif
 ifeq ($(FULL_TARGET),i386-go32v2)
 ifeq ($(FULL_TARGET),i386-go32v2)
-override TARGET_UNITS+=mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
+override TARGET_UNITS+=my4_sys mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
 endif
 endif
 ifeq ($(FULL_TARGET),i386-win32)
 ifeq ($(FULL_TARGET),i386-win32)
-override TARGET_UNITS+=mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
+override TARGET_UNITS+=my4_sys mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
 endif
 endif
 ifeq ($(FULL_TARGET),i386-os2)
 ifeq ($(FULL_TARGET),i386-os2)
-override TARGET_UNITS+=mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
+override TARGET_UNITS+=my4_sys mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
 endif
 endif
 ifeq ($(FULL_TARGET),i386-freebsd)
 ifeq ($(FULL_TARGET),i386-freebsd)
-override TARGET_UNITS+=mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
+override TARGET_UNITS+=my4_sys mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
 endif
 endif
 ifeq ($(FULL_TARGET),i386-beos)
 ifeq ($(FULL_TARGET),i386-beos)
-override TARGET_UNITS+=mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
+override TARGET_UNITS+=my4_sys mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
 endif
 endif
 ifeq ($(FULL_TARGET),i386-netbsd)
 ifeq ($(FULL_TARGET),i386-netbsd)
-override TARGET_UNITS+=mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
+override TARGET_UNITS+=my4_sys mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
 endif
 endif
 ifeq ($(FULL_TARGET),i386-solaris)
 ifeq ($(FULL_TARGET),i386-solaris)
-override TARGET_UNITS+=mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
+override TARGET_UNITS+=my4_sys mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
 endif
 endif
 ifeq ($(FULL_TARGET),i386-qnx)
 ifeq ($(FULL_TARGET),i386-qnx)
-override TARGET_UNITS+=mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
+override TARGET_UNITS+=my4_sys mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
 endif
 endif
 ifeq ($(FULL_TARGET),i386-netware)
 ifeq ($(FULL_TARGET),i386-netware)
-override TARGET_UNITS+=mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
+override TARGET_UNITS+=my4_sys mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
 endif
 endif
 ifeq ($(FULL_TARGET),i386-openbsd)
 ifeq ($(FULL_TARGET),i386-openbsd)
-override TARGET_UNITS+=mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
+override TARGET_UNITS+=my4_sys mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
 endif
 endif
 ifeq ($(FULL_TARGET),i386-wdosx)
 ifeq ($(FULL_TARGET),i386-wdosx)
-override TARGET_UNITS+=mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
+override TARGET_UNITS+=my4_sys mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
 endif
 endif
 ifeq ($(FULL_TARGET),i386-emx)
 ifeq ($(FULL_TARGET),i386-emx)
-override TARGET_UNITS+=mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
+override TARGET_UNITS+=my4_sys mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
 endif
 endif
 ifeq ($(FULL_TARGET),i386-watcom)
 ifeq ($(FULL_TARGET),i386-watcom)
-override TARGET_UNITS+=mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
+override TARGET_UNITS+=my4_sys mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
 endif
 endif
 ifeq ($(FULL_TARGET),i386-netwlibc)
 ifeq ($(FULL_TARGET),i386-netwlibc)
-override TARGET_UNITS+=mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
+override TARGET_UNITS+=my4_sys mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
 endif
 endif
 ifeq ($(FULL_TARGET),m68k-linux)
 ifeq ($(FULL_TARGET),m68k-linux)
-override TARGET_UNITS+=mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
+override TARGET_UNITS+=my4_sys mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
 endif
 endif
 ifeq ($(FULL_TARGET),m68k-freebsd)
 ifeq ($(FULL_TARGET),m68k-freebsd)
-override TARGET_UNITS+=mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
+override TARGET_UNITS+=my4_sys mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
 endif
 endif
 ifeq ($(FULL_TARGET),m68k-netbsd)
 ifeq ($(FULL_TARGET),m68k-netbsd)
-override TARGET_UNITS+=mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
+override TARGET_UNITS+=my4_sys mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
 endif
 endif
 ifeq ($(FULL_TARGET),m68k-amiga)
 ifeq ($(FULL_TARGET),m68k-amiga)
-override TARGET_UNITS+=mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
+override TARGET_UNITS+=my4_sys mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
 endif
 endif
 ifeq ($(FULL_TARGET),m68k-atari)
 ifeq ($(FULL_TARGET),m68k-atari)
-override TARGET_UNITS+=mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
+override TARGET_UNITS+=my4_sys mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
 endif
 endif
 ifeq ($(FULL_TARGET),m68k-openbsd)
 ifeq ($(FULL_TARGET),m68k-openbsd)
-override TARGET_UNITS+=mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
+override TARGET_UNITS+=my4_sys mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
 endif
 endif
 ifeq ($(FULL_TARGET),m68k-palmos)
 ifeq ($(FULL_TARGET),m68k-palmos)
-override TARGET_UNITS+=mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
+override TARGET_UNITS+=my4_sys mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
 endif
 endif
 ifeq ($(FULL_TARGET),powerpc-linux)
 ifeq ($(FULL_TARGET),powerpc-linux)
-override TARGET_UNITS+=mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
+override TARGET_UNITS+=my4_sys mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
 endif
 endif
 ifeq ($(FULL_TARGET),powerpc-netbsd)
 ifeq ($(FULL_TARGET),powerpc-netbsd)
-override TARGET_UNITS+=mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
+override TARGET_UNITS+=my4_sys mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
 endif
 endif
 ifeq ($(FULL_TARGET),powerpc-macos)
 ifeq ($(FULL_TARGET),powerpc-macos)
-override TARGET_UNITS+=mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
+override TARGET_UNITS+=my4_sys mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
 endif
 endif
 ifeq ($(FULL_TARGET),powerpc-darwin)
 ifeq ($(FULL_TARGET),powerpc-darwin)
-override TARGET_UNITS+=mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
+override TARGET_UNITS+=my4_sys mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
 endif
 endif
 ifeq ($(FULL_TARGET),powerpc-morphos)
 ifeq ($(FULL_TARGET),powerpc-morphos)
-override TARGET_UNITS+=mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
+override TARGET_UNITS+=my4_sys mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
 endif
 endif
 ifeq ($(FULL_TARGET),sparc-linux)
 ifeq ($(FULL_TARGET),sparc-linux)
-override TARGET_UNITS+=mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
+override TARGET_UNITS+=my4_sys mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
 endif
 endif
 ifeq ($(FULL_TARGET),sparc-netbsd)
 ifeq ($(FULL_TARGET),sparc-netbsd)
-override TARGET_UNITS+=mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
+override TARGET_UNITS+=my4_sys mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
 endif
 endif
 ifeq ($(FULL_TARGET),sparc-solaris)
 ifeq ($(FULL_TARGET),sparc-solaris)
-override TARGET_UNITS+=mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
+override TARGET_UNITS+=my4_sys mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
 endif
 endif
 ifeq ($(FULL_TARGET),x86_64-linux)
 ifeq ($(FULL_TARGET),x86_64-linux)
-override TARGET_UNITS+=mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
+override TARGET_UNITS+=my4_sys mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
 endif
 endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
 ifeq ($(FULL_TARGET),x86_64-freebsd)
-override TARGET_UNITS+=mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
+override TARGET_UNITS+=my4_sys mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
 endif
 endif
 ifeq ($(FULL_TARGET),arm-linux)
 ifeq ($(FULL_TARGET),arm-linux)
-override TARGET_UNITS+=mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
+override TARGET_UNITS+=my4_sys mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
 endif
 endif
 ifeq ($(FULL_TARGET),i386-linux)
 ifeq ($(FULL_TARGET),i386-linux)
 override TARGET_EXAMPLES+=testdb4 testdb3
 override TARGET_EXAMPLES+=testdb4 testdb3

+ 1 - 1
packages/base/mysql/Makefile.fpc

@@ -7,7 +7,7 @@ name=mysql
 version=2.0.0
 version=2.0.0
 
 
 [target]
 [target]
-units=mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
+units=my4_sys mysql4_com mysql4_version mysql4 mysql4dyn mysql4_comdyn mysql3_com mysql3_version mysql3 mysql3_comdyn mysql3dyn
 examples=testdb4 testdb3
 examples=testdb4 testdb3
 
 
 [require]
 [require]

+ 22 - 0
packages/base/mysql/my4_sys.pp

@@ -0,0 +1,22 @@
+unit my4_sys;
+
+  interface
+
+    uses
+      ctypes;
+
+    type
+      st_dynamic_array = record
+        buffers : pchar;
+        elements : cuint;
+        max_elements : cuint;
+        alloc_increment : cuint;
+        size_of_element : cuint;
+      end;
+
+      tst_dynamic_array = st_dynamic_array;
+      pst_dynamic_array = ^tst_dynamic_array;
+
+  implementation
+
+end.

+ 1 - 1
packages/base/mysql/mysql4.pp

@@ -1,7 +1,7 @@
 unit mysql4;
 unit mysql4;
 interface
 interface
 
 
-uses mysql4_com;
+uses ctypes,my4_sys,mysql4_com;
 
 
 {
 {
   Automatically converted by H2Pas 0.99.15 from mysql.ph
   Automatically converted by H2Pas 0.99.15 from mysql.ph

+ 5 - 12
packages/base/mysql/mysql4_com.pp

@@ -1,19 +1,12 @@
-unit mysql4_com;
-interface
-
-{
-  Automatically converted by H2Pas 0.99.15 from mysql_com.ph
-  The following command line parameters were used:
-    -p
-    -D
-    -l
-    mysqlclient
-    mysql_com.ph
-}
 {$mode objfpc}{$H+}
 {$mode objfpc}{$H+}
 {$MACRO on}
 {$MACRO on}
 
 
 {$PACKRECORDS C}
 {$PACKRECORDS C}
+unit mysql4_com;
+interface
+
+uses
+  ctypes;
 
 
 {$IFDEF Unix}
 {$IFDEF Unix}
   {$DEFINE extdecl:=cdecl}
   {$DEFINE extdecl:=cdecl}

+ 1 - 1
packages/base/mysql/mysql4_comdyn.pp

@@ -11,7 +11,7 @@ unit mysql4_comdyn;
 
 
 interface
 interface
 
 
-uses dynlibs, sysutils;
+uses ctypes,my4_sys,dynlibs, sysutils;
 
 
 {$IFDEF Unix}
 {$IFDEF Unix}
   {$DEFINE extdecl:=cdecl}
   {$DEFINE extdecl:=cdecl}

+ 23 - 20
packages/base/mysql/mysql4_comtypes.inc

@@ -80,10 +80,11 @@ const
    CLIENT_TRANSACTIONS = 8192;
    CLIENT_TRANSACTIONS = 8192;
    SERVER_STATUS_IN_TRANS = 1;
    SERVER_STATUS_IN_TRANS = 1;
    SERVER_STATUS_AUTOCOMMIT = 2;
    SERVER_STATUS_AUTOCOMMIT = 2;
-   MYSQL_ERRMSG_SIZE = 200;
+   MYSQL_ERRMSG_SIZE = 512;
    NET_READ_TIMEOUT = 30;
    NET_READ_TIMEOUT = 30;
    NET_WRITE_TIMEOUT = 60;
    NET_WRITE_TIMEOUT = 60;
    MAX_BLOB_WIDTH = 8192;
    MAX_BLOB_WIDTH = 8192;
+   SQLSTATE_LENGTH = 5;
 {
 {
 #define NET_WAIT_TIMEOUT      (8 60 60)
 #define NET_WAIT_TIMEOUT      (8 60 60)
  }
  }
@@ -101,28 +102,30 @@ type
     write_pos : Pbyte;
     write_pos : Pbyte;
     read_pos : Pbyte;
     read_pos : Pbyte;
     fd : my_socket;
     fd : my_socket;
-    max_packet : dword;
-    max_packet_size : dword;
-    last_errno : dword;
-    pkt_nr : dword;
-    compress_pkt_nr : dword;
-    write_timeout : dword;
-    read_timeout : dword;
-    retry_count : dword;
-    fcntl : longint;
-    last_error : array[0..(MYSQL_ERRMSG_SIZE)-1] of char;
-    error : byte;
-    return_errno : my_bool;
+    max_packet,
+    max_packet_size : culong;
+    pkt_nr,
+    compress_pkt_nr : culong;
+    write_timeout,
+    read_timeout,
+    retry_count : cuint;
+    fcntl : cint;
     compress : my_bool;
     compress : my_bool;
-    remain_in_buf : dword;
-    length : dword;
-    buf_length : dword;
-    where_b : dword;
-    return_status : Pdword;
-    reading_or_writing : byte;
-    save_char : char;
+    remain_in_bufm,
+    length,
+    buf_length,
+    where_b : culong;
+    return_status : pcuint;
+    reading_or_writing : cuint;
+    save_char : cchar;
     no_send_ok : my_bool;
     no_send_ok : my_bool;
+    last_error : array[0..(MYSQL_ERRMSG_SIZE)-1] of char;
+    sqlstate : array[0..SQLSTATE_LENGTH] of char;
+    last_errno : cuint;
+    error : cuchar;
     query_cache_query : gptr;
     query_cache_query : gptr;
+    report_error,
+    return_errno : my_bool;
   end;
   end;
   NET = st_net;
   NET = st_net;
   TNET = NET;
   TNET = NET;

+ 1 - 1
packages/base/mysql/mysql4_version.pp

@@ -31,7 +31,7 @@ interface
 
 
   const
   const
      PROTOCOL_VERSION = 10;
      PROTOCOL_VERSION = 10;
-     MYSQL_SERVER_VERSION = '4.0.1-alpha';
+     MYSQL_SERVER_VERSION = '4.1.10a';
      MYSQL_SERVER_SUFFIX = '-max';
      MYSQL_SERVER_SUFFIX = '-max';
      FRM_VER = 6;
      FRM_VER = 6;
      MYSQL_VERSION_ID = 40001;
      MYSQL_VERSION_ID = 40001;

+ 1 - 1
packages/base/mysql/mysql4dyn.pp

@@ -11,7 +11,7 @@ unit mysql4dyn;
 
 
 interface
 interface
 
 
-uses dynlibs, classes, sysutils, mysql4_comdyn;
+uses ctypes,dynlibs, classes, sysutils, my4_sys, mysql4_comdyn;
 
 
 
 
 {
 {

+ 64 - 33
packages/base/mysql/mysql4types.inc

@@ -21,14 +21,24 @@ type
   Pst_mysql_field = ^st_mysql_field;
   Pst_mysql_field = ^st_mysql_field;
   st_mysql_field = record
   st_mysql_field = record
        name : Pchar;
        name : Pchar;
+       org_name : pchar;
        table : Pchar;
        table : Pchar;
        org_table : Pchar;
        org_table : Pchar;
        db : Pchar;
        db : Pchar;
+       catalog : pchar;
        def : Pchar;
        def : Pchar;
-       length : dword;
-       max_length : dword;
-       flags : dword;
-       decimals : dword;
+       length : culong;
+       max_length : culong;
+       name_length : cuint;
+       org_name_length : cuint;
+       table_length : cuint;
+       org_table_length : cuint;
+       db_length : cuint;
+       catalog_length : cuint;
+       def_length : cuint;
+       flags : cuint;
+       decimals : cuint;
+       charsetnr : cuint;
        ftype : enum_field_types;
        ftype : enum_field_types;
     end;
     end;
   MYSQL_FIELD = st_mysql_field;
   MYSQL_FIELD = st_mysql_field;
@@ -51,6 +61,7 @@ type
   st_mysql_rows = record
   st_mysql_rows = record
      next : Pst_mysql_rows;
      next : Pst_mysql_rows;
      data : MYSQL_ROW;
      data : MYSQL_ROW;
+     length : culong;
   end;
   end;
   MYSQL_ROWS = st_mysql_rows;
   MYSQL_ROWS = st_mysql_rows;
   TMYSQL_ROWS = MYSQL_ROWS;
   TMYSQL_ROWS = MYSQL_ROWS;
@@ -88,25 +99,34 @@ type
   Pst_mysql_data = ^st_mysql_data;
   Pst_mysql_data = ^st_mysql_data;
   st_mysql_data = record
   st_mysql_data = record
        rows : my_ulonglong;
        rows : my_ulonglong;
-       fields : dword;
+       fields : cuint;
        data : PMYSQL_ROWS;
        data : PMYSQL_ROWS;
        alloc : MEM_ROOT;
        alloc : MEM_ROOT;
+       prev_ptr : ^MYSQL_ROWS;
     end;
     end;
   MYSQL_DATA = st_mysql_data;
   MYSQL_DATA = st_mysql_data;
   TMYSQL_DATA = MYSQL_DATA;
   TMYSQL_DATA = MYSQL_DATA;
   PMYSQL_DATA = ^MYSQL_DATA;
   PMYSQL_DATA = ^MYSQL_DATA;
 
 
+  mysql_option = (MYSQL_OPT_CONNECT_TIMEOUT,MYSQL_OPT_COMPRESS,
+    MYSQL_OPT_NAMED_PIPE,MYSQL_INIT_COMMAND,
+    MYSQL_READ_DEFAULT_FILE,MYSQL_READ_DEFAULT_GROUP,
+    MYSQL_SET_CHARSET_DIR,MYSQL_SET_CHARSET_NAME
+    );
+
   Pst_mysql_options = ^st_mysql_options;
   Pst_mysql_options = ^st_mysql_options;
   st_mysql_options = record
   st_mysql_options = record
-       connect_timeout : dword;
-       client_flag : dword;
-       port : dword;
-       host : Pchar;
-       init_command : Pchar;
-       user : Pchar;
-       password : Pchar;
-       unix_socket : Pchar;
-       db : Pchar;
+       connect_timeout,
+       read_timeout,
+       write_timeout: cuint;
+       port,protocol : cuint;
+       client_flag : culong;
+       host,
+       user,
+       password,
+       unix_socket,
+       db : pchar;
+       init_commands : pst_dynamic_array;
        my_cnf_file : Pchar;
        my_cnf_file : Pchar;
        my_cnf_group : Pchar;
        my_cnf_group : Pchar;
        charset_dir : Pchar;
        charset_dir : Pchar;
@@ -116,23 +136,26 @@ type
        ssl_ca : Pchar;
        ssl_ca : Pchar;
        ssl_capath : Pchar;
        ssl_capath : Pchar;
        ssl_cipher : Pchar;
        ssl_cipher : Pchar;
-       max_allowed_packet : Cardinal;
+       shared_memory_base_name : pchar;
+       max_allowed_packet : culong;
        use_ssl : my_bool;
        use_ssl : my_bool;
        compress : my_bool;
        compress : my_bool;
        named_pipe : my_bool;
        named_pipe : my_bool;
        rpl_probe : my_bool;
        rpl_probe : my_bool;
        rpl_parse : my_bool;
        rpl_parse : my_bool;
        no_master_reads : my_bool;
        no_master_reads : my_bool;
+       methods_to_use : mysql_option;
+       client_ip : pchar;
+       secure_auth : my_bool;
+       local_infile_init : pointer;
+       local_infile_read : pointer;
+       local_infile_end : pointer;
+       local_infile_error : pointer;
+       local_infile_userdata : pointer;
     end;
     end;
   TMYSQL_OPTIONS = st_mysql_options;
   TMYSQL_OPTIONS = st_mysql_options;
   PTMYSQL_OPTIONS = ^TMYSQL_OPTIONS;
   PTMYSQL_OPTIONS = ^TMYSQL_OPTIONS;
 
 
-  mysql_option = (MYSQL_OPT_CONNECT_TIMEOUT,MYSQL_OPT_COMPRESS,
-    MYSQL_OPT_NAMED_PIPE,MYSQL_INIT_COMMAND,
-    MYSQL_READ_DEFAULT_FILE,MYSQL_READ_DEFAULT_GROUP,
-    MYSQL_SET_CHARSET_DIR,MYSQL_SET_CHARSET_NAME
-    );
-
   mysql_status = (MYSQL_STATUS_READY,MYSQL_STATUS_GET_RESULT,
   mysql_status = (MYSQL_STATUS_READY,MYSQL_STATUS_GET_RESULT,
     MYSQL_STATUS_USE_RESULT);
     MYSQL_STATUS_USE_RESULT);
 
 
@@ -156,25 +179,31 @@ type
        affected_rows : my_ulonglong;
        affected_rows : my_ulonglong;
        insert_id : my_ulonglong;
        insert_id : my_ulonglong;
        extra_info : my_ulonglong;
        extra_info : my_ulonglong;
-       thread_id : dword;
-       packet_length : dword;
-       port : dword;
-       client_flag : dword;
-       server_capabilities : dword;
-       protocol_version : dword;
-       field_count : dword;
-       server_status : dword;
-       server_language : dword;
+       thread_id : culong;
+       packet_length : culong;
+       port : cuint;
+       client_flag : culong;
+       server_capabilities : culong;
+       protocol_version : cuint;
+       field_count : cuint;
+       server_status : cuint;
+       server_language : cuint;
+       warning_count : cuint;
        options : st_mysql_options;
        options : st_mysql_options;
        status : mysql_status;
        status : mysql_status;
        free_me : my_bool;
        free_me : my_bool;
        reconnect : my_bool;
        reconnect : my_bool;
-       scramble_buff : array[0..8] of char;
+       scramble_buff : array[0..20] of char;
        rpl_pivot : my_bool;
        rpl_pivot : my_bool;
        master : Pst_mysql;
        master : Pst_mysql;
        next_slave : Pst_mysql;
        next_slave : Pst_mysql;
        last_used_slave : Pst_mysql;
        last_used_slave : Pst_mysql;
        last_used_con : Pst_mysql;
        last_used_con : Pst_mysql;
+
+       stmts : pointer; // LIST
+       methods : pointer; // Pst_mysql_methods
+       thd : pointer;
+       unbuffered_fetch_owner : pmy_bool;
     end;
     end;
   TMYSQL = st_mysql;
   TMYSQL = st_mysql;
   PMYSQL = ^TMYSQL;
   PMYSQL = ^TMYSQL;
@@ -185,14 +214,16 @@ type
        fields : PMYSQL_FIELD;
        fields : PMYSQL_FIELD;
        data : PMYSQL_DATA;
        data : PMYSQL_DATA;
        data_cursor : PMYSQL_ROWS;
        data_cursor : PMYSQL_ROWS;
-       lengths : Pdword;
+       lengths : pculong;
        handle : PMYSQL;
        handle : PMYSQL;
        field_alloc : MEM_ROOT;
        field_alloc : MEM_ROOT;
        field_count : dword;
        field_count : dword;
-       current_field : dword;
+       current_field : cuint;
        row : MYSQL_ROW;
        row : MYSQL_ROW;
        current_row : MYSQL_ROW;
        current_row : MYSQL_ROW;
        eof : my_bool;
        eof : my_bool;
+       unbuffered_fetch_cancelled : my_bool;
+       methods : pointer; { was ^my_sql_methods }
     end;
     end;
   MYSQL_RES = st_mysql_res;
   MYSQL_RES = st_mysql_res;
   TMYSQL_RES = MYSQL_RES;
   TMYSQL_RES = MYSQL_RES;

+ 2 - 2
packages/base/mysql/mysqls.pp

@@ -1,6 +1,6 @@
 program mysqls;
 program mysqls;
 
 
-uses mysql,mysql_com;
+uses mysql4,mysql4_com;
 
 
 
 
 begin
 begin
@@ -13,6 +13,6 @@ begin
   writeln ('MYSQL_RES : ',sizeof(TMYSQL_RES));
   writeln ('MYSQL_RES : ',sizeof(TMYSQL_RES));
   writeln ('MEM_ROOT : ',sizeof(TMEM_ROOT));
   writeln ('MEM_ROOT : ',sizeof(TMEM_ROOT));
   writeln ('my_bool : ',sizeof(my_bool));
   writeln ('my_bool : ',sizeof(my_bool));
-  writeln ('TNET : ',sizeof(TNET),' TNET.nettype : ',SizeOf(net_type));
+  // writeln ('TNET : ',sizeof(TNET),' TNET.nettype : ',SizeOf(net_type));
   writeln ('USED_MEM : ',sizeof(TUSED_MEM));
   writeln ('USED_MEM : ',sizeof(TUSED_MEM));
 end.
 end.

+ 204 - 28
rtl/objpas/sysutils/sysstr.inc

@@ -69,7 +69,7 @@ Function UpperCase(Const S : String) : String;
 Var
 Var
   i : Integer;
   i : Integer;
   P : PChar;
   P : PChar;
-    
+
 begin
 begin
   Result := S;
   Result := S;
   UniqueString(Result);
   UniqueString(Result);
@@ -80,7 +80,7 @@ begin
       Inc(P);
       Inc(P);
     end;
     end;
 end;
 end;
-                            
+
 {   LowerCase returns a copy of S where all uppercase characters ( from A to Z )
 {   LowerCase returns a copy of S where all uppercase characters ( from A to Z )
     have been converted to lowercase  }
     have been converted to lowercase  }
 
 
@@ -89,7 +89,7 @@ Function Lowercase(Const S : String) : String;
 Var
 Var
   i : Integer;
   i : Integer;
   P : PChar;
   P : PChar;
-    
+
 begin
 begin
   Result := S;
   Result := S;
   UniqueString(Result);
   UniqueString(Result);
@@ -100,7 +100,7 @@ begin
       Inc(P);
       Inc(P);
     end;
     end;
 end;
 end;
-                            
+
 
 
 {   CompareStr compares S1 and S2, the result is the based on
 {   CompareStr compares S1 and S2, the result is the based on
     substraction of the ascii values of the characters in S1 and S2
     substraction of the ascii values of the characters in S1 and S2
@@ -212,7 +212,7 @@ end;
 {==============================================================================}
 {==============================================================================}
 
 
 function GenericAnsiUpperCase(const s: string): string;
 function GenericAnsiUpperCase(const s: string): string;
-  var 
+  var
     len, i: integer;
     len, i: integer;
 begin
 begin
   len := length(s);
   len := length(s);
@@ -223,7 +223,7 @@ end;
 
 
 
 
 function GenericAnsiLowerCase(const s: string): string;
 function GenericAnsiLowerCase(const s: string): string;
-  var 
+  var
     len, i: integer;
     len, i: integer;
 begin
 begin
   len := length(s);
   len := length(s);
@@ -234,7 +234,7 @@ end;
 
 
 
 
 function GenericAnsiCompareStr(const S1, S2: string): PtrInt;
 function GenericAnsiCompareStr(const S1, S2: string): PtrInt;
-  Var 
+  Var
     I,L1,L2 : SizeInt;
     I,L1,L2 : SizeInt;
 begin
 begin
   Result:=0;
   Result:=0;
@@ -251,7 +251,7 @@ begin
 end;
 end;
 
 
 function GenericAnsiCompareText(const S1, S2: string): PtrInt;
 function GenericAnsiCompareText(const S1, S2: string): PtrInt;
-  Var 
+  Var
     I,L1,L2 : SizeInt;
     I,L1,L2 : SizeInt;
 begin
 begin
   Result:=0;
   Result:=0;
@@ -424,56 +424,56 @@ function AnsiUpperCase(const s: string): string;{$ifdef SYSUTILSINLINE}inline;{$
   begin
   begin
     result:=widestringmanager.UpperAnsiStringProc(s);
     result:=widestringmanager.UpperAnsiStringProc(s);
   end;
   end;
-  
-  
+
+
 function AnsiLowerCase(const s: string): string;{$ifdef SYSUTILSINLINE}inline;{$endif}
 function AnsiLowerCase(const s: string): string;{$ifdef SYSUTILSINLINE}inline;{$endif}
   begin
   begin
     result:=widestringmanager.LowerAnsiStringProc(s);
     result:=widestringmanager.LowerAnsiStringProc(s);
   end;
   end;
-  
-  
+
+
 function AnsiCompareStr(const S1, S2: string): integer;{$ifdef SYSUTILSINLINE}inline;{$endif}
 function AnsiCompareStr(const S1, S2: string): integer;{$ifdef SYSUTILSINLINE}inline;{$endif}
   begin
   begin
     result:=widestringmanager.CompareStrAnsiStringProc(s1,s2);
     result:=widestringmanager.CompareStrAnsiStringProc(s1,s2);
   end;
   end;
-  
-  
+
+
 function AnsiCompareText(const S1, S2: string): integer;{$ifdef SYSUTILSINLINE}inline;{$endif}
 function AnsiCompareText(const S1, S2: string): integer;{$ifdef SYSUTILSINLINE}inline;{$endif}
   begin
   begin
     result:=widestringmanager.CompareTextAnsiStringProc(s1,s2);
     result:=widestringmanager.CompareTextAnsiStringProc(s1,s2);
   end;
   end;
-  
-  
+
+
 function AnsiStrComp(S1, S2: PChar): integer;{$ifdef SYSUTILSINLINE}inline;{$endif}
 function AnsiStrComp(S1, S2: PChar): integer;{$ifdef SYSUTILSINLINE}inline;{$endif}
   begin
   begin
     result:=widestringmanager.StrCompAnsiStringProc(s1,s2);
     result:=widestringmanager.StrCompAnsiStringProc(s1,s2);
   end;
   end;
 
 
-  
+
 function AnsiStrIComp(S1, S2: PChar): integer;{$ifdef SYSUTILSINLINE}inline;{$endif}
 function AnsiStrIComp(S1, S2: PChar): integer;{$ifdef SYSUTILSINLINE}inline;{$endif}
   begin
   begin
-    result:=widestringmanager.StrICompAnsiStringProc(s1,s2); 
+    result:=widestringmanager.StrICompAnsiStringProc(s1,s2);
   end;
   end;
 
 
-  
+
 function AnsiStrLComp(S1, S2: PChar; MaxLen: cardinal): integer;{$ifdef SYSUTILSINLINE}inline;{$endif}
 function AnsiStrLComp(S1, S2: PChar; MaxLen: cardinal): integer;{$ifdef SYSUTILSINLINE}inline;{$endif}
   begin
   begin
     result:=widestringmanager.StrLCompAnsiStringProc(s1,s2,maxlen);
     result:=widestringmanager.StrLCompAnsiStringProc(s1,s2,maxlen);
   end;
   end;
 
 
-  
+
 function AnsiStrLIComp(S1, S2: PChar; MaxLen: cardinal): integer;{$ifdef SYSUTILSINLINE}inline;{$endif}
 function AnsiStrLIComp(S1, S2: PChar; MaxLen: cardinal): integer;{$ifdef SYSUTILSINLINE}inline;{$endif}
   begin
   begin
     result:=widestringmanager.StrLICompAnsiStringProc(s1,s2,maxlen);
     result:=widestringmanager.StrLICompAnsiStringProc(s1,s2,maxlen);
   end;
   end;
 
 
-  
+
 function AnsiStrLower(Str: PChar): PChar;{$ifdef SYSUTILSINLINE}inline;{$endif}
 function AnsiStrLower(Str: PChar): PChar;{$ifdef SYSUTILSINLINE}inline;{$endif}
   begin
   begin
     result:=widestringmanager.StrLowerAnsiStringProc(Str);
     result:=widestringmanager.StrLowerAnsiStringProc(Str);
   end;
   end;
-  
-  
+
+
 function AnsiStrUpper(Str: PChar): PChar;{$ifdef SYSUTILSINLINE}inline;{$endif}
 function AnsiStrUpper(Str: PChar): PChar;{$ifdef SYSUTILSINLINE}inline;{$endif}
   begin
   begin
     result:=widestringmanager.StrUpperAnsiStringProc(Str);
     result:=widestringmanager.StrUpperAnsiStringProc(Str);
@@ -757,7 +757,7 @@ function StrToInt(const S: string): integer;
 var Error: word;
 var Error: word;
 begin
 begin
   Val(S, result, Error);
   Val(S, result, Error);
-  if Error <> 0 then raise EConvertError.createfmt(SInValidInteger,[S]);
+  if Error <> 0 then raise EConvertError.createfmt(SInvalidInteger,[S]);
 end ;
 end ;
 
 
 
 
@@ -766,7 +766,7 @@ var Error: word;
 
 
 begin
 begin
   Val(S, result, Error);
   Val(S, result, Error);
-  if Error <> 0 then raise EConvertError.createfmt(SInValidInteger,[S]);
+  if Error <> 0 then raise EConvertError.createfmt(SInvalidInteger,[S]);
 end;
 end;
 
 
 
 
@@ -1028,9 +1028,9 @@ Begin
         else if (P<>0) then // we have a decimalseparator
         else if (P<>0) then // we have a decimalseparator
           begin
           begin
           P := Length(Result);
           P := Length(Result);
-          While (P>0) and (Result[P] = '0') Do 
+          While (P>0) and (Result[P] = '0') Do
             Dec(P);
             Dec(P);
-          If (P>0) and (Result[P]=DecimalSeparator) Then 
+          If (P>0) and (Result[P]=DecimalSeparator) Then
             Dec(P);
             Dec(P);
           SetLength(Result, P);
           SetLength(Result, P);
           end;
           end;
@@ -1769,7 +1769,7 @@ function FormatCurr(const Format: string; Value: Currency): string;
 begin
 begin
   Result := FormatFloat(Format, Value);
   Result := FormatFloat(Format, Value);
 end;
 end;
-  
+
 
 
 {==============================================================================}
 {==============================================================================}
 {   extra functions                                                            }
 {   extra functions                                                            }
@@ -2068,3 +2068,179 @@ const
      #240, #241, #242, #243, #244, #245, #246, #247,
      #240, #241, #242, #243, #244, #245, #246, #247,
      #248, #249, #250, #251, #252, #253, #254, #255 );
      #248, #249, #250, #251, #252, #253, #254, #255 );
 
 
+
+function sscanf(const s: string; const fmt : string;const Pointers : array of Pointer) : Integer;
+  var
+    i,j,n,m : SizeInt;
+    s1      : string;
+
+  function GetInt(unsigned : boolean=false) : Integer;
+    begin
+      s1 := '';
+      while (s[n] = ' ')  and (Length(s) > n) do
+        inc(n);
+      { read sign }
+      if (Length(s)>= n) and (s[n] in ['+', '-']) then
+        begin
+          { don't accept - when reading unsigned }
+          if unsigned and (s[n]='-') then
+            begin
+              result:=length(s1);
+              exit;
+            end
+          else
+            begin
+              s1:=s1+s[n];
+              inc(n);
+            end;
+        end;
+      { read numbers }
+      while (s[n] in ['0'..'9'])
+        and (Length(s) >= n) do
+        begin
+          s1 := s1+s[n];
+          inc(n);
+        end;
+      Result := Length(s1);
+    end;
+
+
+  function GetFloat : Integer;
+    begin
+      s1 := '';
+      while (s[n] = ' ')  and (Length(s) > n) do
+        inc(n);
+      while (s[n] in ['0'..'9', '+', '-', '.', 'e', 'E'])
+        and (Length(s) >= n) do
+        begin
+          s1 := s1+s[n];
+          inc(n);
+        end;
+      Result := Length(s1);
+    end;
+
+
+  function GetString : Integer;
+    begin
+      s1 := '';
+      while (s[n] = ' ')  and (Length(s) > n) do
+        inc(n);
+      while (s[n] <> ' ') and (Length(s) >= n) do
+        begin
+          s1 := s1+s[n];
+          inc(n);
+        end;
+      Result := Length(s1);
+    end;
+
+
+  function ScanStr(c : Char) : Boolean;
+    begin
+      while (s[n] <> c) and (Length(s) > n) do
+        inc(n);
+      inc(n);
+      If (n <= Length(s)) then
+        Result := True
+      else
+        Result := False;
+    end;
+
+
+  function GetFmt : Integer;
+    begin
+      Result := -1;
+      while true do
+        begin
+
+          while (fmt[m] = ' ') and (Length(fmt) > m) do
+            inc(m);
+
+          if (m >= Length(fmt)) then
+            break;
+
+          if (fmt[m] = '%') then
+            begin
+              inc(m);
+              case fmt[m] of
+                'd':
+                  Result:=vtInteger;
+                'f':
+                  Result:=vtExtended;
+                's':
+                  Result:=vtString;
+                'c':
+                  Result:=vtChar;
+                else
+                  raise EFormatError.CreateFmt(SInvalidFormat,[fmt]);
+              end;
+              inc(m);
+              break;
+            end;
+
+          if not(ScanStr(fmt[m])) then
+            break;
+          inc(m);
+        end;
+    end;
+
+
+  begin
+    n := 1;
+    m := 1;
+    Result := 0;
+
+    for i:=0 to High(Pointers) do
+      begin
+        j := GetFmt;
+        case j of
+          vtInteger :
+            begin
+              if GetInt>0 then
+                begin
+                  plongint(Pointers[i])^:=StrToInt(s1);
+                  inc(Result);
+                end
+              else
+                break;
+
+            end;
+
+          vtchar :
+            begin
+              if Length(s)>n then
+                begin
+                  pchar(Pointers[i])^:=s[n];
+                  inc(n);
+                  inc(Result);
+                end
+              else
+                break;
+
+            end;
+
+          vtExtended :
+            begin
+              if GetFloat>0 then
+                begin
+                  pextended(Pointers[i])^:=StrToFloat(s1);
+                  inc(Result);
+                end
+              else
+                break;
+            end;
+
+          vtString :
+            begin
+              if GetString > 0 then
+                begin
+                  pansistring(Pointers[i])^:=s1;
+                  inc(Result);
+                end
+              else
+                break;
+            end;
+          else
+            break;
+        end;
+      end;
+   end;

+ 2 - 0
rtl/objpas/sysutils/sysstrh.inc

@@ -142,6 +142,8 @@ Function FormatFloat(Const Format : String; Value : Extended) : String;
 Function IsDelimiter(const Delimiters, S: string; Index: Integer): Boolean;
 Function IsDelimiter(const Delimiters, S: string; Index: Integer): Boolean;
 function FormatCurr(const Format: string; Value: Currency): string;
 function FormatCurr(const Format: string; Value: Currency): string;
 
 
+function SScanf(const s: string; const fmt : string;const Pointers : array of Pointer) : Integer;
+
 {// MBCS Functions. No MBCS yet, so mostly these are calls to the regular counterparts.}
 {// MBCS Functions. No MBCS yet, so mostly these are calls to the regular counterparts.}
 Type
 Type
   TMbcsByteType = (mbSingleByte, mbLeadByte, mbTrailByte);
   TMbcsByteType = (mbSingleByte, mbLeadByte, mbTrailByte);

+ 1 - 0
rtl/objpas/sysutils/sysutilh.inc

@@ -129,6 +129,7 @@ type
 
 
    { String conversion errors }
    { String conversion errors }
    EConvertError = class(Exception);
    EConvertError = class(Exception);
+   EFormatError = class(Exception);
 
 
    { Other errors }
    { Other errors }
    EAbort           = Class(Exception);
    EAbort           = Class(Exception);

+ 0 - 35
rtl/objpas/sysutils/sysutils.inc

@@ -536,38 +536,3 @@ begin
     end;
     end;
 end;
 end;
 
 
-{
-  Revision 1.1  2003/10/06 21:01:06  peter
-    * moved classes unit to rtl
-
-  Revision 1.17  2003/09/06 20:46:07  marco
-   * 3 small VP fixes from Noah Silva. One (OutOfMemory error) failed.
-
-  Revision 1.16  2003/04/06 11:06:39  michael
-  + Added exception classname to output of unhandled exception for better identification
-
-  Revision 1.15  2003/03/18 08:28:23  michael
-  Patch from peter for Abort routine
-
-  Revision 1.14  2003/03/17 15:11:51  armin
-  + someone AssertErrorHandler, BackTraceFunc and Dump_Stack so that pointer instead of longint is needed
-
-  Revision 1.13  2003/01/01 20:58:07  florian
-    + added invalid instruction exception
-
-  Revision 1.12  2002/10/07 19:43:24  florian
-    + empty prototypes for the AnsiStr* multi byte functions added
-
-  Revision 1.11  2002/09/07 16:01:22  peter
-    * old logs removed and tabs fixed
-
-  Revision 1.10  2002/07/16 13:57:39  florian
-    * raise takes now a void pointer as at and frame address
-      instead of a longint, fixed
-
-  Revision 1.9  2002/01/25 17:42:03  peter
-    * interface helpers
-
-  Revision 1.8  2002/01/25 16:23:03  peter
-    * merged filesearch() fix
-}

+ 18 - 0
tests/test/units/sysutils/tsscanf.pp

@@ -0,0 +1,18 @@
+{$mode objfpc}
+{$h+}
+uses
+  sysutils;
+var
+  e : extended;
+  s : string;
+  l : longint;
+begin
+  sscanf('asdf 1.2345 1234','%s %f %d',[@s,@e,@l]);
+  if (e<>1.2345) or
+    (l<>1234) or
+    (s<>'asdf') then
+    halt(1);
+  // writeln(s,' ',e,' ',l);
+  writeln('ok');
+end.
+