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

Comparing ibx/trunk/fbintf/client/FBSQLData.pas (file contents):
Revision 59 by tony, Mon Mar 13 09:51:56 2017 UTC vs.
Revision 263 by tony, Thu Dec 6 15:55:01 2018 UTC

# Line 76 | Line 76 | unit FBSQLData;
76    methods are needed for SQL parameters only. The string getters and setters
77    are virtual as SQLVar and Array encodings of string data is different.}
78  
79 < { $define ALLOWDIALECT3PARAMNAMES}
80 <
81 < {$ifndef ALLOWDIALECT3PARAMNAMES}
82 <
83 < { Note on SQL Dialects and SQL Parameter Names
79 > { Note on SQL Parameter Names
80    --------------------------------------------
81  
82 <  Even when dialect 3 quoted format parameter names are not supported, IBX still processes
83 <  parameter names case insensitive. This does result in some additional overhead
88 <  due to a call to "AnsiUpperCase". This can be avoided by undefining
82 >  IBX processes parameter names case insensitive. This does result in some additional
83 >  overhead due to a call to "AnsiUpperCase". This can be avoided by undefining
84    "UseCaseInSensitiveParamName" below.
85  
91  Note: do not define "UseCaseSensitiveParamName" when "ALLOWDIALECT3PARAMNAMES"
92  is defined. This will not give a useful result.
86   }
87   {$define UseCaseInSensitiveParamName}
95 {$endif}
88  
89   interface
90  
91   uses
92 <  Classes, SysUtils, IBExternals, IBHeader, IB,  FBActivityMonitor;
92 >  Classes, SysUtils, IBExternals, IBHeader, IB,  FBActivityMonitor, FBClientAPI;
93  
94   type
95  
# Line 105 | Line 97 | type
97  
98    TSQLDataItem = class(TFBInterfacedObject)
99    private
100 +     FFirebirdClientAPI: TFBClientAPI;
101       function AdjustScale(Value: Int64; aScale: Integer): Double;
102       function AdjustScaleToInt64(Value: Int64; aScale: Integer): Int64;
103       function AdjustScaleToCurrency(Value: Int64; aScale: Integer): Currency;
# Line 128 | Line 121 | type
121       property DataLength: cardinal read GetDataLength write SetDataLength;
122  
123    public
124 +     constructor Create(api: TFBClientAPI);
125       function GetSQLType: cardinal; virtual; abstract;
126       function GetSQLTypeName: AnsiString; overload;
127       class function GetSQLTypeName(SQLType: short): AnsiString; overload;
# Line 145 | Line 139 | type
139       function GetAsShort: short;
140       function GetAsString: AnsiString; virtual;
141       function GetIsNull: Boolean; virtual;
142 <     function getIsNullable: boolean; virtual;
142 >     function GetIsNullable: boolean; virtual;
143       function GetAsVariant: Variant;
144       function GetModified: boolean; virtual;
145       procedure SetAsBoolean(AValue: boolean); virtual;
# Line 456 | Line 450 | type
450  
451   implementation
452  
453 < uses FBMessages, FBClientAPI, variants, IBUtils, FBTransaction;
453 > uses FBMessages, variants, IBUtils, FBTransaction;
454 >
455 > type
456 >
457 >   { TSQLParamProcessor }
458 >
459 >   TSQLParamProcessor = class(TSQLwithNamedParamsTokeniser)
460 >   private
461 >   const
462 >     sIBXParam = 'IBXParam';  {do not localize}
463 >   private
464 >     FInString: AnsiString;
465 >     FIndex: integer;
466 >     function DoExecute(GenerateParamNames: boolean;
467 >       var slNames: TStrings): AnsiString;
468 >   protected
469 >     function GetChar: AnsiChar; override;
470 >   public
471 >     class function Execute(sSQL: AnsiString; GenerateParamNames: boolean;
472 >       var slNames: TStrings): AnsiString;
473 >   end;
474 >
475 > { TSQLParamProcessor }
476 >
477 > function TSQLParamProcessor.DoExecute(GenerateParamNames: boolean;
478 >  var slNames: TStrings): AnsiString;
479 > var token: TSQLTokens;
480 >    iParamSuffix: Integer;
481 > begin
482 >  Result := '';
483 >  iParamSuffix := 0;
484 >
485 >  while not EOF do
486 >  begin
487 >    token := GetNextToken;
488 >    case token of
489 >    sqltParam,
490 >    sqltQuotedParam:
491 >      begin
492 >        Result := Result + '?';
493 >        slNames.Add(TokenText);
494 >      end;
495 >
496 >    sqltPlaceHolder:
497 >      if GenerateParamNames then
498 >      begin
499 >        Inc(iParamSuffix);
500 >        slNames.AddObject(sIBXParam + IntToStr(iParamSuffix),self); //Note local convention
501 >                                            //add pointer to self to mark entry
502 >        Result := Result + '?';
503 >      end
504 >      else
505 >        IBError(ibxeSQLParseError, [SParamNameExpected]);
506 >
507 >    sqltQuotedString:
508 >      Result := Result + '''' + SQLSafeString(TokenText) + '''';
509 >
510 >    sqltIdentifierInDoubleQuotes:
511 >      Result := Result + '"' + StringReplace(TokenText,'"','""',[rfReplaceAll]) + '"';
512 >
513 >    sqltComment:
514 >      Result := Result + '/*' + TokenText + '*/';
515 >
516 >    sqltCommentLine:
517 >      Result := Result + '//' + TokenText + LineEnding;
518 >
519 >    sqltEOL:
520 >      Result := Result + LineEnding;
521 >
522 >    else
523 >      Result := Result + TokenText;
524 >    end;
525 >  end;
526 > end;
527 >
528 > function TSQLParamProcessor.GetChar: AnsiChar;
529 > begin
530 >  if FIndex <= Length(FInString) then
531 >  begin
532 >    Result := FInString[FIndex];
533 >    Inc(FIndex);
534 >  end
535 >  else
536 >    Result := #0;
537 > end;
538 >
539 > class function TSQLParamProcessor.Execute(sSQL: AnsiString;
540 >  GenerateParamNames: boolean; var slNames: TStrings): AnsiString;
541 > begin
542 >  with self.Create do
543 >  try
544 >    FInString := sSQL;
545 >    FIndex := 1;
546 >    Result := DoExecute(GenerateParamNames,slNames);
547 >  finally
548 >    Free;
549 >  end;
550 > end;
551  
552  
553   { TSQLDataArea }
# Line 510 | Line 601 | end;
601  
602   procedure TSQLDataArea.PreprocessSQL(sSQL: AnsiString; GenerateParamNames: boolean;
603    var sProcessedSQL: AnsiString);
513 var
514  cCurChar, cNextChar, cQuoteChar: AnsiChar;
515  sParamName: AnsiString;
516  j, i, iLenSQL, iSQLPos: Integer;
517  iCurState {$ifdef ALLOWDIALECT3PARAMNAMES}, iCurParamState {$endif}: Integer;
518  iParamSuffix: Integer;
519  slNames: TStrings;
520  StrBuffer: PByte;
521  found: boolean;
522
523 const
524  DefaultState = 0;
525  CommentState = 1;
526  QuoteState = 2;
527  ParamState = 3;
528  ArrayDimState = 4;
529 {$ifdef ALLOWDIALECT3PARAMNAMES}
530  ParamDefaultState = 0;
531  ParamQuoteState = 1;
532  {$endif}
533
534  procedure AddToProcessedSQL(cChar: AnsiChar);
535  begin
536    StrBuffer[iSQLPos] := byte(cChar);
537    Inc(iSQLPos);
538  end;
539
540 begin
541  if not IsInputDataArea then
542    IBError(ibxeNotPermitted,[nil]);
543
544  sParamName := '';
545  iLenSQL := Length(sSQL);
546  GetMem(StrBuffer,iLenSQL + 1);
547  slNames := TStringList.Create;
548  try
549    { Do some initializations of variables }
550    iParamSuffix := 0;
551    cQuoteChar := '''';
552    i := 1;
553    iSQLPos := 0;
554    iCurState := DefaultState;
555    {$ifdef ALLOWDIALECT3PARAMNAMES}
556    iCurParamState := ParamDefaultState;
557    {$endif}
558    { Now, traverse through the SQL string, character by character,
559     picking out the parameters and formatting correctly for InterBase }
560    while (i <= iLenSQL) do begin
561      { Get the current token and a look-ahead }
562      cCurChar := sSQL[i];
563      if i = iLenSQL then
564        cNextChar := #0
565      else
566        cNextChar := sSQL[i + 1];
567      { Now act based on the current state }
568      case iCurState of
569        DefaultState:
570        begin
571          case cCurChar of
572            '''', '"':
573            begin
574              cQuoteChar := cCurChar;
575              iCurState := QuoteState;
576            end;
577            '?', ':':
578            begin
579              iCurState := ParamState;
580              AddToProcessedSQL('?');
581            end;
582            '/': if (cNextChar = '*') then
583            begin
584              AddToProcessedSQL(cCurChar);
585              Inc(i);
586              iCurState := CommentState;
587            end;
588            '[':
589            begin
590              AddToProcessedSQL(cCurChar);
591              Inc(i);
592              iCurState := ArrayDimState;
593            end;
594          end;
595        end;
604  
605 <        ArrayDimState:
598 <        begin
599 <          case cCurChar of
600 <          ':',',','0'..'9',' ',#9,#10,#13:
601 <            begin
602 <              AddToProcessedSQL(cCurChar);
603 <              Inc(i);
604 <            end;
605 <          else
606 <            begin
607 <              AddToProcessedSQL(cCurChar);
608 <              Inc(i);
609 <              iCurState := DefaultState;
610 <            end;
611 <          end;
612 <        end;
605 > var slNames: TStrings;
606  
607 <        CommentState:
608 <        begin
609 <          if (cNextChar = #0) then
610 <            IBError(ibxeSQLParseError, [SEOFInComment])
611 <          else if (cCurChar = '*') then begin
619 <            if (cNextChar = '/') then
620 <              iCurState := DefaultState;
621 <          end;
622 <        end;
623 <        QuoteState: begin
624 <          if cNextChar = #0 then
625 <            IBError(ibxeSQLParseError, [SEOFInString])
626 <          else if (cCurChar = cQuoteChar) then begin
627 <            if (cNextChar = cQuoteChar) then begin
628 <              AddToProcessedSQL(cCurChar);
629 <              Inc(i);
630 <            end else
631 <              iCurState := DefaultState;
632 <          end;
633 <        end;
634 <        ParamState:
635 <        begin
636 <          { collect the name of the parameter }
637 <          {$ifdef ALLOWDIALECT3PARAMNAMES}
638 <          if iCurParamState = ParamDefaultState then
639 <          begin
640 <            if cCurChar = '"' then
641 <              iCurParamState := ParamQuoteState
642 <            else
643 <            {$endif}
644 <            if (cCurChar in ['A'..'Z', 'a'..'z', '0'..'9', '_', '$']) then
645 <                sParamName := sParamName + cCurChar
646 <            else if GenerateParamNames then
647 <            begin
648 <              sParamName := 'IBXParam' + IntToStr(iParamSuffix); {do not localize}
649 <              Inc(iParamSuffix);
650 <              iCurState := DefaultState;
651 <              slNames.AddObject(sParamName,self); //Note local convention
652 <                                                  //add pointer to self to mark entry
653 <              sParamName := '';
654 <            end
655 <            else
656 <              IBError(ibxeSQLParseError, [SParamNameExpected]);
657 <          {$ifdef ALLOWDIALECT3PARAMNAMES}
658 <          end
659 <          else begin
660 <            { determine if Quoted parameter name is finished }
661 <            if cCurChar = '"' then
662 <            begin
663 <              Inc(i);
664 <              slNames.Add(sParamName);
665 <              SParamName := '';
666 <              iCurParamState := ParamDefaultState;
667 <              iCurState := DefaultState;
668 <            end
669 <            else
670 <              sParamName := sParamName + cCurChar
671 <          end;
672 <          {$endif}
673 <          { determine if the unquoted parameter name is finished }
674 <          if {$ifdef ALLOWDIALECT3PARAMNAMES}(iCurParamState <> ParamQuoteState) and {$endif}
675 <            (iCurState <> DefaultState) then
676 <          begin
677 <            if not (cNextChar in ['A'..'Z', 'a'..'z',
678 <                                  '0'..'9', '_', '$']) then begin
679 <              Inc(i);
680 <              iCurState := DefaultState;
681 <              slNames.Add(sParamName);
682 <              sParamName := '';
683 <            end;
684 <          end;
685 <        end;
686 <      end;
687 <      if (iCurState <> ParamState) and (i <= iLenSQL) then
688 <        AddToProcessedSQL(sSQL[i]);
689 <      Inc(i);
690 <    end;
691 <    AddToProcessedSQL(#0);
692 <    sProcessedSQL := strpas(PAnsiChar(StrBuffer));
607 >  procedure SetColumnNames(slNames: TStrings);
608 >  var i, j: integer;
609 >      found: boolean;
610 >  begin
611 >    found := false;
612      SetCount(slNames.Count);
613      for i := 0 to slNames.Count - 1 do
614      begin
# Line 710 | Line 629 | begin
629          Column[i].UniqueName := not found;
630        end;
631      end;
632 +  end;
633 +
634 + begin
635 +  if not IsInputDataArea then
636 +    IBError(ibxeNotPermitted,[nil]);
637 +
638 +  slNames := TStringList.Create;
639 +  try
640 +    sProcessedSQL := TSQLParamProcessor.Execute(sSQL,GenerateParamNames,slNames);
641 +    SetColumnNames(slNames);
642    finally
643      slNames.Free;
715    FreeMem(StrBuffer);
644    end;
645   end;
646  
# Line 1046 | Line 974 | begin
974     //Do nothing by default
975   end;
976  
977 + constructor TSQLDataItem.Create(api: TFBClientAPI);
978 + begin
979 +  inherited Create;
980 +  FFirebirdClientAPI := api;
981 + end;
982 +
983   function TSQLDataItem.GetSQLTypeName: AnsiString;
984   begin
985    Result := GetSQLTypeName(GetSQLType);
# Line 1152 | Line 1086 | begin
1086    CheckActive;
1087    result := 0;
1088    if not IsNull then
1089 <    with FirebirdClientAPI do
1089 >    with FFirebirdClientAPI do
1090      case SQLType of
1091        SQL_TEXT, SQL_VARYING: begin
1092          try
# Line 1292 | Line 1226 | begin
1226    result := '';
1227    { Check null, if so return a default string }
1228    if not IsNull then
1229 <  with FirebirdClientAPI do
1229 >  with FFirebirdClientAPI do
1230      case SQLType of
1231        SQL_BOOLEAN:
1232          if AsBoolean then
# Line 1471 | Line 1405 | begin
1405  
1406    SQLType := SQL_TYPE_DATE;
1407    DataLength := SizeOf(ISC_DATE);
1408 <  with FirebirdClientAPI do
1408 >  with FFirebirdClientAPI do
1409      SQLEncodeDate(Value,SQLData);
1410    Changed;
1411   end;
# Line 1491 | Line 1425 | begin
1425  
1426    SQLType := SQL_TYPE_TIME;
1427    DataLength := SizeOf(ISC_TIME);
1428 <  with FirebirdClientAPI do
1428 >  with FFirebirdClientAPI do
1429      SQLEncodeTime(Value,SQLData);
1430    Changed;
1431   end;
# Line 1505 | Line 1439 | begin
1439    Changing;
1440    SQLType := SQL_TIMESTAMP;
1441    DataLength := SizeOf(ISC_TIME) + sizeof(ISC_DATE);
1442 <  with FirebirdClientAPI do
1442 >  with FFirebirdClientAPI do
1443      SQLEncodeDateTime(Value,SQLData);
1444    Changed;
1445   end;
# Line 1691 | Line 1625 | end;
1625  
1626   constructor TColumnMetaData.Create(aOwner: IUnknown; aIBXSQLVAR: TSQLVarData);
1627   begin
1628 <  inherited Create;
1628 >  inherited Create(aIBXSQLVAR.GetStatement.GetAttachment.getFirebirdAPI as TFBClientAPI);
1629    FIBXSQLVAR := aIBXSQLVAR;
1630    FOwner := aOwner;
1631    FPrepareSeqNo := FIBXSQLVAR.Parent.PrepareSeqNo;

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines