Browse Source

* Merging revisions 1104,1110,1114,1115,1116,1117 from trunk:
------------------------------------------------------------------------
r1104 | michael | 2021-03-14 10:02:51 +0100 (Sun, 14 Mar 2021) | 1 line

* (try)StrToUint(def)
------------------------------------------------------------------------
r1110 | michael | 2021-03-22 13:59:37 +0100 (Mon, 22 Mar 2021) | 1 line

* Fixed demorouter example
------------------------------------------------------------------------
r1114 | michael | 2021-03-22 21:09:55 +0100 (Mon, 22 Mar 2021) | 1 line

* Add ExtractStrings
------------------------------------------------------------------------
r1115 | michael | 2021-03-23 11:47:23 +0100 (Tue, 23 Mar 2021) | 1 line

* Some logging
------------------------------------------------------------------------
r1116 | michael | 2021-03-23 11:50:31 +0100 (Tue, 23 Mar 2021) | 1 line

* Preventdefault
------------------------------------------------------------------------
r1117 | michael | 2021-03-23 12:55:23 +0100 (Tue, 23 Mar 2021) | 1 line

* Patch from Henrique Werlang to ignore some missing properties from stream
------------------------------------------------------------------------

michael 4 years ago
parent
commit
e679aaa7ce
5 changed files with 161 additions and 13 deletions
  1. 10 5
      demo/router/demorouter.lpi
  2. 14 4
      demo/router/frmdemo.pp
  3. 35 4
      packages/fcl-db/db.pas
  4. 68 0
      packages/rtl/classes.pas
  5. 34 0
      packages/rtl/sysutils.pas

+ 10 - 5
demo/router/demorouter.lpi

@@ -1,11 +1,12 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
-  <ProjectOptions BuildModesCount="1">
+  <ProjectOptions>
     <Version Value="12"/>
     <General>
       <Flags>
         <MainUnitHasCreateFormStatements Value="False"/>
         <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
         <CompatibilityMode Value="True"/>
       </Flags>
       <SessionStorage Value="InProjectDir"/>
@@ -13,8 +14,8 @@
       <UseAppBundle Value="False"/>
       <ResourceType Value="res"/>
     </General>
-    <BuildModes>
-      <Item1 Name="Default" Default="True"/>
+    <BuildModes Count="1">
+      <Item1 Name="default" Default="True"/>
     </BuildModes>
     <PublishOptions>
       <Version Value="2"/>
@@ -25,7 +26,7 @@
         <Mode0 Name="default"/>
       </Modes>
     </RunParams>
-    <Units Count="2">
+    <Units Count="3">
       <Unit0>
         <Filename Value="demorouter.pas"/>
         <IsPartOfProject Value="True"/>
@@ -34,12 +35,16 @@
         <Filename Value="frmdemo.pp"/>
         <IsPartOfProject Value="True"/>
       </Unit1>
+      <Unit2>
+        <Filename Value="demorouter.html"/>
+        <IsPartOfProject Value="True"/>
+      </Unit2>
     </Units>
   </ProjectOptions>
   <CompilerOptions>
     <Version Value="11"/>
     <Target>
-      <Filename Value="demorouter"/>
+      <Filename Value="demorouter.js" ApplyConventions="False"/>
     </Target>
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>

+ 14 - 4
demo/router/frmdemo.pp

@@ -34,7 +34,7 @@ end;
 
 function TDemoForm.ButtonClick(Event: TJSMouseEvent): boolean;
 begin
-  Router.Push(Event.target['data']);
+  Router.Push(String(TJSHTMLElement(Event.target).Dataset['link']));
 end;
 
 constructor TDemoForm.Create(aFormNo: Integer; UseSlash: Boolean);
@@ -74,7 +74,7 @@ begin
       Link:=TJSHTMLElement(document.createElement('a'));
       link['href']:=MakeLink(i,True);
       link.innerHTML:='Go to form <span class="badge">'+IntToStr(i)+'</span>';
-      if (Router.HistoryKind=hkHTML5) then
+      if (Router.HistoryKind<>hkHTML5) then
         Link.onclick:=@DoLinkClick;
       adiv.appendChild(link);
       end;
@@ -85,7 +85,7 @@ begin
       Button:=TJSHTMLElement(document.createElement('button'));
       Button['class']:='btn btn-default';
       Button.InnerHTML:='Go to form '+IntToStr(i);
-      Button['data']:=MakeLink(i,false);
+      Button.Dataset['link']:=MakeLink(i,false);
       Button.onclick:=@ButtonClick;
       PanelContent.appendChild(Button);
       end;
@@ -94,8 +94,18 @@ begin
 end;
 
 function TDemoForm.DoLinkClick(aEvent: TJSMouseEvent): boolean;
+
+Var
+  URL : String;
+  p: Integer;
+
 begin
-  Router.Push(aEvent.target['href']);
+  URL:=String(aEvent.target['href']);
+  P:=Pos('#',URL);
+  URL:=Copy(URL,P+1,Length(URL)-P);
+  Writeln('URL :',URL);
+  Router.Push(URL);
+  aEvent.preventDefault;
 end;
 
 end.

+ 35 - 4
packages/fcl-db/db.pas

@@ -334,6 +334,7 @@ type
     procedure SetText(const AValue: string); virtual;
     procedure SetVarValue(const AValue{%H-}: JSValue); virtual;
     procedure SetAsBytes(const AValue{%H-}: TBytes); virtual;
+    procedure DefineProperties(Filer: TFiler); 
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
@@ -663,15 +664,15 @@ type
 
 { TBlobField }
   TBlobStreamMode = (bmRead, bmWrite, bmReadWrite);
-//  TBlobType = ftBlob..ftMemo;
+  TBlobType = ftBlob..ftMemo;
 
   TBlobField = class(TBinaryField)
   private
     FModified : Boolean;
     // Wrapper that retrieves FDataType as a TBlobType
-    //   function GetBlobType: TBlobType;
+    function GetBlobType: TBlobType;
     // Wrapper that calls SetFieldType
-    //   procedure SetBlobType(AValue: TBlobType);
+    procedure SetBlobType(AValue: TBlobType);
   protected
     class procedure CheckTypeSize(AValue: Longint); override;
     function GetBlobSize: Longint; virtual;
@@ -686,7 +687,7 @@ type
     property Modified: Boolean read FModified write FModified;
     property Value: string read GetAsString write SetAsString;
   published
-   // property BlobType: TBlobType read GetBlobType write SetBlobType; // default ftBlob;
+    property BlobType: TBlobType read GetBlobType write SetBlobType; // default ftBlob;
     property Size default 0;
   end;
 
@@ -5394,6 +5395,27 @@ begin
   Result:=EDatabaseError.CreateFmt(SinvalidTypeConversion,[TypeName,FFieldName]);
 end;
 
+procedure TField.DefineProperties(Filer: TFiler); 
+  procedure IgnoreReadString(Reader: TReader);
+  begin
+    Reader.ReadString;
+  end;
+  
+  procedure IgnoreReadBoolean(Reader: TReader);
+  begin
+    Reader.ReadBoolean;
+  end;
+
+  procedure IgnoreWrite(Writer: TWriter);
+  begin
+  end;
+
+begin
+  Filer.DefineProperty('AttributeSet', @IgnoreReadString, @IgnoreWrite, False);
+  Filer.DefineProperty('Calculated', @IgnoreReadBoolean, @IgnoreWrite, False);
+  Filer.DefineProperty('Lookup', @IgnoreReadBoolean, @IgnoreWrite, False);
+end;
+
 procedure TField.Assign(Source: TPersistent);
 
 begin
@@ -7189,6 +7211,15 @@ end;
 *)
 
 
+function TBlobField.GetBlobType: TBlobType;
+begin
+  Result:=ftBlob;
+end;
+
+procedure TBlobField.SetBlobType(AValue: TBlobType);
+begin
+
+end;
 
 class procedure TBlobField.CheckTypeSize(AValue: Longint);
 begin

+ 68 - 0
packages/rtl/classes.pas

@@ -1424,6 +1424,7 @@ Function FindNestedComponent(Root : TComponent; APath : String; CStyle : Boolean
 procedure RedirectFixupReferences(Root: TComponent; const OldRootName, NewRootName: string);
 procedure RemoveFixupReferences(Root: TComponent; const RootName: string);
 procedure RegisterIntegerConsts(IntegerType: Pointer; IdentToIntFn: TIdentToInt;  IntToIdentFn: TIntToIdent);
+function ExtractStrings(Separators, WhiteSpace: TSysCharSet; Content: String; Strings: TStrings; AddEmptyStrings : Boolean = False): Integer;
 function IdentToInt(const Ident: string; out Int: Longint; const Map: array of TIdentMapEntry): Boolean;
 function IntToIdent(Int: Longint; var Ident: string; const Map: array of TIdentMapEntry): Boolean;
 function FindIntToIdent(AIntegerType: Pointer): TIntToIdent;
@@ -1587,6 +1588,73 @@ begin
   IntConstList.Add(TIntConst.Create(IntegerType, IdentToIntFn, IntToIdentFn));
 end;
 
+function ExtractStrings(Separators, WhiteSpace: TSysCharSet; Content: String; Strings: TStrings; AddEmptyStrings : Boolean = False): Integer;
+var
+  b,c : integer;
+
+  procedure SkipWhitespace;
+    begin
+      while (Content[c] in Whitespace) do
+        inc (C);
+    end;
+
+  procedure AddString;
+    var
+      l : integer;
+
+    begin
+      l := c-b;
+      if (l > 0) or AddEmptyStrings then
+        begin
+          if assigned(Strings) then
+            begin
+            if l>0 then
+              Strings.Add (Copy(Content,B,L))
+            else
+              Strings.Add('');
+            end;
+          inc (result);
+        end;
+    end;
+
+var
+  cc,quoted : char;
+  i,aLen : Integer;
+begin
+  result := 0;
+  c := 1;
+  Quoted := #0;
+  Separators := Separators + [#13, #10] - ['''','"'];
+  SkipWhitespace;
+  b := c;
+  aLen:=Length(Content);
+  while C<=aLen do
+    begin
+      CC:=Content[c];
+      if (CC = Quoted) then
+        begin
+          if (C<aLen) and (Content[C+1] = Quoted) then
+            inc (c)
+          else
+            Quoted := #0
+        end
+      else if (Quoted = #0) and (CC in ['''','"']) then
+        Quoted := CC;
+      if (Quoted = #0) and (CC in Separators) then
+        begin
+          AddString;
+          inc (c);
+          SkipWhitespace;
+          b := c;
+        end
+      else
+        inc (c);
+    end;
+  if (c <> b) then
+    AddString;
+end;
+
+
 function FindIntToIdent(AIntegerType: Pointer): TIntToIdent;
 
 var

+ 34 - 0
packages/rtl/sysutils.pas

@@ -291,6 +291,10 @@ Function StrToIntDef(const S : String; Const aDef : Integer) : Integer;
 Function StrToIntDef(const S : String; Const aDef : NativeInt) : NativeInt;
 Function StrToInt(const S : String) : Integer;
 Function StrToNativeInt(const S : String) : NativeInt;
+function StrToUInt(const s: string): Cardinal;
+function StrToUIntDef(const s: string; aDef : Cardinal): Cardinal;
+function UIntToStr(Value: Cardinal): string; 
+function TryStrToUInt(const s: string; out C: Cardinal): Boolean;
 // For compatibility
 Function StrToInt64(const S : String) : NativeLargeInt;
 Function StrToInt64Def(const S : String; ADefault : NativeLargeInt) : NativeLargeInt;
@@ -4741,6 +4745,36 @@ begin
     Raise EConvertError.CreateFmt(SErrInvalidInteger,[S]);
 end;
 
+function StrToUInt(const s: string): Cardinal;
+
+begin
+  If not TryStrToUint(S,Result) then
+    Raise EConvertError.CreateFmt(SErrInvalidInteger,[S])
+end;
+
+function StrToUIntDef(const s: string; aDef : Cardinal): Cardinal;
+
+begin
+  If not TryStrToUint(S,Result) then
+    Result:=aDef;
+end;
+
+function UIntToStr(Value: Cardinal): string; 
+
+begin
+  Result:=IntToStr(Value);
+end;
+
+function TryStrToUInt(const s: string; out C: Cardinal): Boolean;
+Var
+  N : NativeInt;
+begin
+  Result:=TryStrToInt(S,N);
+  Result:=(N>=0) and (N<=4294967295);
+  If Result then 
+    C:=N;
+end;
+
 function StrToInt64(const S: String): NativeLargeInt;
 
 Var