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 42 by tony, Tue May 17 08:14:52 2016 UTC vs.
Revision 43 by tony, Thu Sep 22 17:10:15 2016 UTC

# Line 37 | Line 37 | unit IBSQL;
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.
# Line 96 | 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 159 | 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 424 | Line 430 | type
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 841 | 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 852 | 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 865 | 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 1381 | 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 1586 | 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 1716 | 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  

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines