ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBSQL.pas
(Generate patch)

Comparing ibx/trunk/runtime/IBSQL.pas (file contents):
Revision 33 by tony, Sat Jul 18 12:30:52 2015 UTC vs.
Revision 43 by tony, Thu Sep 22 17:10:15 2016 UTC

# Line 35 | Line 35 | unit IBSQL;
35  
36   {$Mode Delphi}
37  
38 + {$IF FPC_FULLVERSION >= 20700 }
39 + {$codepage UTF8}
40 + {$DEFINE HAS_ANSISTRING_CODEPAGE}
41 + {$ENDIF}
42 +
43   { IBSQL param names in dialect 3 quoted format (e.g. :"MyParam") are by default disabled.
44  
45   Dialect 3 quoted format parameter names represent a significant overhead and are of
# Line 92 | Line 97 | type
97      FParent: TIBXSQLDA;
98      FSQL: TIBSQL;
99      FIndex: Integer;
100 +    FCharSetID: integer;
101      FModified: Boolean;
102      FName: String;
103      FUniqueName: boolean;
# Line 155 | Line 161 | type
161      constructor Create(Parent: TIBXSQLDA; Query: TIBSQL);
162      procedure Assign(Source: TIBXSQLVAR);
163      procedure Clear;
164 +    function GetCharSetID: integer;
165 +    {$IFDEF HAS_ANSISTRING_CODEPAGE}
166 +    function GetCodePage: TSystemCodePage;
167 +    {$ENDIF}
168      procedure LoadFromFile(const FileName: String);
169      procedure LoadFromStream(Stream: TStream);
170      procedure SaveToFile(const FileName: String);
# Line 328 | Line 338 | type
338    TIBSQL = class(TComponent)
339    private
340      FIBLoaded: Boolean;
341 +    FOnSQLChanged: TNotifyEvent;
342      FUniqueParamNames: Boolean;
343      function GetFieldCount: integer;
344      procedure SetUniqueParamNames(AValue: Boolean);
# Line 366 | Line 377 | type
377      procedure SetSQL(Value: TStrings);
378      procedure SetTransaction(Value: TIBTransaction);
379      procedure SQLChanging(Sender: TObject);
380 +    procedure SQLChanged(Sender: TObject);
381      procedure BeforeTransactionEnd(Sender: TObject; Action: TTransactionAction);
382    public
383      constructor Create(AOwner: TComponent); override;
# Line 412 | Line 424 | type
424      property SQL: TStrings read FSQL write SetSQL;
425      property Transaction: TIBTransaction read GetTransaction write SetTransaction;
426      property OnSQLChanging: TNotifyEvent read FOnSQLChanging write FOnSQLChanging;
427 +    property OnSQLChanged: TNotifyEvent read FOnSQLChanged write FOnSQLChanged;
428    end;
429  
430   implementation
431  
432   uses
433 <  IBIntf, IBBlob, Variants , IBSQLMonitor;
433 >  IBIntf, IBBlob, Variants , IBSQLMonitor, IBCodePage;
434  
435   { TIBXSQLVAR }
436   constructor TIBXSQLVAR.Create(Parent: TIBXSQLDA; Query: TIBSQL);
# Line 834 | Line 847 | var
847    sz: PChar;
848    str_len: Integer;
849    ss: TStringStream;
850 +  {$IFDEF HAS_ANSISTRING_CODEPAGE}
851 +  rs: RawByteString;
852 +  {$ENDIF}
853   begin
854    result := '';
855    { Check null, if so return a default string }
# Line 845 | Line 861 | begin
861          ss := TStringStream.Create('');
862          try
863            SaveToStream(ss);
864 +          {$IFDEF HAS_ANSISTRING_CODEPAGE}
865 +          rs := ss.DataString;
866 +          SetCodePage(rs,GetCodePage,false);
867 +          result := rs;
868 +          {$ELSE}
869            result := ss.DataString;
870 +          {$ENDIF}
871          finally
872            ss.Free;
873          end;
# Line 858 | Line 880 | begin
880            str_len := isc_vax_integer(FXSQLVar^.sqldata, 2);
881            Inc(sz, 2);
882          end;
883 +        {$IFDEF HAS_ANSISTRING_CODEPAGE}
884 +        SetString(rs, sz, str_len);
885 +        SetCodePage(rs,GetCodePage,false);
886 +        result := rs;
887 +        {$ELSE}
888          SetString(result, sz, str_len);
889 +        {$ENDIF}
890          if ((FXSQLVar^.sqltype and (not 1)) = SQL_TEXT) then
891            result := TrimRight(result);
892        end;
# Line 1374 | Line 1402 | var
1402        end;
1403        FModified := True;
1404     end;
1405 <
1405 > {$IFDEF HAS_ANSISTRING_CODEPAGE}
1406 > var rs: RawByteString;
1407 >    codepage: TSystemCodePage;
1408 > {$ENDIF}
1409   begin
1410    if IsNullable then
1411      IsNull := False;
1412  
1413    stype := FXSQLVAR^.sqltype and (not 1);
1414 +
1415 +  {$IFDEF HAS_ANSISTRING_CODEPAGE}
1416 +  codepage := GetCodePage;
1417 +  if (codepage <> CP_NONE) and (StringCodePage(Value) <> codepage) then
1418 +  begin
1419 +    rs := Value;
1420 +    SetCodePage(rs,codepage,true);
1421 +    Value := rs;
1422 +  end;
1423 +  {$ENDIF}
1424 +
1425    if (stype = SQL_TEXT) or (stype = SQL_VARYING) then
1426      SetStringValue
1427    else begin
# Line 1579 | Line 1621 | begin
1621    IsNull := true;
1622   end;
1623  
1624 + function TIBXSQLVAR.GetCharSetID: integer;
1625 + var stype: Integer;
1626 + begin
1627 +  if FCharSetID = -1 then
1628 +  begin
1629 +    FCharSetID := 0;
1630 +    stype := FXSQLVAR^.sqltype and (not 1);
1631 +    case stype of
1632 +    SQL_TEXT,SQL_VARYING:
1633 +      FCharSetID := FXSQLVAR^.sqlsubtype and $FF;
1634 +
1635 +    SQL_BLOB:
1636 +      if (FXSQLVAR^.sqlsubtype = 1) and (strpas(FXSQLVAR^.relname) <> '') and
1637 +          (strpas(FXSQLVAR^.sqlname) <> '') then
1638 +        FCharSetID := GetBlobCharSetID(FParent.FSQL.Database.Handle,FParent.FSQL.Transaction.Handle,
1639 +                     @(FXSQLVAR^.relname),@(FXSQLVAR^.sqlname));
1640 +    end;
1641 +
1642 +    if (FCharSetID > 1) and (FParent.FSQL.Database.DefaultCharSetName <> '')
1643 +      and (FParent.FSQL.Database.DefaultCharSetID > 1) then
1644 +      FCharSetID := FParent.FSQL.Database.DefaultCharSetID;
1645 +  end;
1646 +  Result := FCharSetID;
1647 + end;
1648 +
1649 + {$IFDEF HAS_ANSISTRING_CODEPAGE}
1650 + function TIBXSQLVAR.GetCodePage: TSystemCodePage;
1651 + begin
1652 +  TFirebirdCharacterSets.CharSetID2CodePage(GetCharSetID,Result);
1653 + end;
1654 + {$ENDIF}
1655 +
1656  
1657   { TIBXSQLDA }
1658   constructor TIBXSQLDA.Create(Query: TIBSQL; sqldaType: TIBXSQLDAType);
# Line 1709 | Line 1783 | begin
1783    begin
1784      for i := 0 to FCount - 1 do
1785      begin
1786 +      FXSQLVARs[i].FCharSetID := -1;
1787        with FXSQLVARs[i].Data^ do
1788        begin
1789  
# Line 2137 | Line 2212 | end;
2212  
2213   { TIBSQL }
2214   constructor TIBSQL.Create(AOwner: TComponent);
2215 + var  GUID : TGUID;
2216   begin
2217    inherited Create(AOwner);
2218    FIBLoaded := False;
# Line 2153 | Line 2229 | begin
2229    FRecordCount := 0;
2230    FSQL := TStringList.Create;
2231    TStringList(FSQL).OnChanging := SQLChanging;
2232 +  TStringList(FSQL).OnChange := SQLChanged;
2233    FProcessedSQL := TStringList.Create;
2234    FHandle := nil;
2235    FSQLParams := TIBXSQLDA.Create(self,daInput);
2236    FSQLRecord := TIBXSQLDA.Create(self,daOutput);
2237    FSQLType := SQLUnknown;
2238    FParamCheck := True;
2239 <  FCursor := HexStr(self); //Name + RandomString(8);
2239 >  CreateGuid(GUID);
2240 >  FCursor := GUIDToString(GUID);
2241    if AOwner is TIBDatabase then
2242      Database := TIBDatabase(AOwner)
2243    else
# Line 2816 | Line 2894 | begin
2894    if FHandle <> nil then FreeHandle;
2895   end;
2896  
2897 + procedure TIBSQL.SQLChanged(Sender: TObject);
2898 + begin
2899 +  if assigned(OnSQLChanged) then
2900 +    OnSQLChanged(self);
2901 + end;
2902 +
2903   procedure TIBSQL.BeforeTransactionEnd(Sender: TObject;
2904    Action: TTransactionAction);
2905   begin

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines