pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity
Files
053b9c89c76cdb2fd23e7a77ad0bf52b51f8da6a
lazarus-ccr/components/flashfiler/sourcelaz/ffsrfltr.pas
wp_xxyyzz 27aea1d1ad flashfiler: Initial commit (ported by A.Soner). Not working yet (server error). 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5438 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2016-12-07 13:31:59 +00:00

635 lines
20 KiB
ObjectPascal
Raw Blame History

{*********************************************************}
{* FlashFiler: Server-side filter evaluation *}
{*********************************************************}
(* ***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1
*
* The contents of this file are subject to the Mozilla Public License Version
* 1.1 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is TurboPower FlashFiler
*
* The Initial Developer of the Original Code is
* TurboPower Software
*
* Portions created by the Initial Developer are Copyright (C) 1996-2002
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
*
* ***** END LICENSE BLOCK ***** *)
{$I ffdefine.inc}
unit ffsrfltr;
interface
uses
Windows,
SysUtils,
Classes,
Forms,
Messages,
ffllbase,
fflldict,
ffstdate,
fftbdict,
ffsrbase,
ffsrbde;
type
PffFilterNode = ^TffFilterNode;
TffFilterNode = packed record
Case Integer of
1:(fnHdr : CANHdr);
2:(fnUnary : CANUnary);
3:(fnBinary : CANBinary);
4:(fnField : CANField);
5:(fnConst : CANConst);
7:(fnContinue : CANContinue);
8:(fnCompare : CANCompare);
end;
PffNodeValue = ^TffNodeValue;
TffNodeValue = packed record
nvType : TffWord16;
nvSize : TffWord16;
nvValue : Pointer;
nvIsNull : Boolean;
nvIsConst : Boolean;
end;
TffSrFilter = class(TffObject)
protected {private}
sfDataDict : TffServerDataDict;
sfTimeout : TffWord32;
sfExpression : pCANExpr;
sfExprSize : TffWord16;
sfFilterUntil : TffWord32;
protected
protected
function sfGetLiteralPtr(aOffset : TffWord16) : Pointer;
function sfGetNodePtr(aOffset : TffWord16) : PffFilterNode;
function sfEvaluateBinaryNode(aNode : PffFilterNode;
aRecBuf : Pointer;
aNoCase : Boolean;
aPartial: TffWord16) : Boolean;
function sfEvaluateConstNode(aNode : PffFilterNode;
aValue : PffNodeValue;
aRecBuf : Pointer) : Boolean;
function sfEvaluateFieldNode(aNode : PffFilterNode;
aValue : PffNodeValue;
aRecBuf : Pointer) : Boolean;
function sfEvaluateLogicalNode(aNode : PffFilterNode;
aRecBuf : Pointer) : Boolean;
function sfEvaluateNode(aNode : PffFilterNode;
aValue : PffNodeValue;
aRecBuf : Pointer) : Boolean;
function sfEvaluateUnaryNode(aNode : PffFilterNode;
aRecBuf : Pointer) : Boolean;
function sfCompareValues(var aCompareResult : Integer;
var aFirst : TffNodeValue;
var aSecond : TffNodeValue;
aIgnoreCase : Boolean;
aPartLen : Integer) : Boolean;
function sfCompareValue(var aFirst : TffNodeValue;
var aSecond : TffNodeValue;
aIgnoreCase : Boolean;
aPartLen : Integer) : Integer; virtual; {!!.11}
public
constructor Create(aCursor : TObject; {!!.11}
aDataDict : TffServerDataDict;
aExpression : pCANExpr;
aTimeout : TffWord32); virtual; {!!.11}
destructor Destroy; override;
function MatchesRecord(aRecBuf : Pointer) : Boolean; virtual; {!!.11}
procedure BeginTimeout;
function CheckTimeout(var Res: TffResult) : Boolean;
property Expression: pCANExpr
read sfExpression;
property Timeout: TffWord32
read sfTimeout;
end;
{Begin !!.11}
type
TffSrFilterClass = class of TffSrFilter;
const
ffsrFilterClass : TffSrFilterClass = TffSrFilter;
{End !!.11}
implementation
uses
ffconst;
{===TffSrFilter==================================================}
constructor TffSrFilter.Create(aCursor : TObject; {!!.11}
aDataDict : TffServerDataDict;
aExpression : pCANExpr;
aTimeout : TffWord32);
begin
inherited Create;
sfDataDict := aDataDict;
sfTimeout := aTimeout;
// if sfTimeout > 5000 then sfTimeout := 5000; {Deleted !!.07}
// if sfTimeout < 50 then sfTimeout := 50; {Deleted !!.07}
if Assigned(aExpression) then begin
sfExprSize := aExpression^.iTotalSize;
if (sfExprSize > 0) then begin
FFGetMem(sfExpression, sfExprSize);
Move(aExpression^, sfExpression^, sfExprSize);
end;
end;
end;
{--------}
destructor TffSrFilter.Destroy;
begin
if (sfExprSize > 0) and Assigned(sfExpression) then begin
FFFreeMem(sfExpression, sfExprSize);
sfExpression := nil;
end;
inherited Destroy;
end;
{--------}
function TffSrFilter.sfGetLiteralPtr(aOffset : TffWord16) : Pointer;
var
i : TffWord16;
begin
i := sfExpression^.iLiteralStart + aOffset;
Result := @PByteArray(sfExpression)^[i];
end;
{--------}
function TffSrFilter.sfGetNodePtr(aOffset : TffWord16) : PffFilterNode;
var
i : TffWord16;
begin
i := sfExpression^.iNodeStart + aOffset;
Result := PffFilterNode(@PByteArray(sfExpression)^[i]);
end;
{--------}
function TffSrFilter.MatchesRecord(aRecBuf : Pointer) : Boolean;
var
Root : PffFilterNode;
begin
Result := true;
if Assigned(sfExpression) then begin
Root := sfGetNodePtr(0);
Result := sfEvaluateNode(Root, nil, aRecBuf);
end;
end;
{--------}
procedure TffSrFilter.BeginTimeout;
begin
sfFilterUntil := GetTickCount + sfTimeout;
end;
{--------}
function TffSrFilter.CheckTimeout(var Res: TffResult) : Boolean;
begin
Result := False;
if GetTickCount > sfFilterUntil then begin
Res := DBIERR_FF_FilterTimeout;
Result := True;
end;
end;
{--------}
function TffSrFilter.sfEvaluateNode(aNode : PffFilterNode;
aValue : PffNodeValue;
aRecBuf : Pointer) : Boolean;
begin
if (aValue <> nil) then
FillChar(aValue^, sizeof(aValue^), 0);
case aNode^.fnHdr.NodeClass of
nodeUNARY:
Result := sfEvaluateUnaryNode(aNode, aRecBuf);
nodeBINARY:
if (aNode^.fnHdr.CANOp in [canAND, canOR]) then
Result := sfEvaluateLogicalNode(aNode, aRecBuf)
else
Result := sfEvaluateBinaryNode(aNode, aRecBuf, false, 0);
nodeCOMPARE:
Result := sfEvaluateBinaryNode(aNode, aRecBuf,
aNode^.fnCompare.bCaseInsensitive,
aNode^.fnCompare.iPartialLen);
nodeFIELD:
Result := sfEvaluateFieldNode(aNode, aValue, aRecBuf);
nodeCONST:
Result := sfEvaluateConstNode(aNode, aValue, aRecBuf);
nodeCONTINUE:
Result := aNode^.fnContinue.iContOperand <> 0;
else
{all other node classes cause the node match to fail}
Result := false;
end;{case}
end;
{--------}
function TffSrFilter.sfEvaluateUnaryNode(aNode : PffFilterNode;
aRecBuf : Pointer) : Boolean;
var
OperandNode : PffFilterNode;
NodeValue : TffNodeValue;
begin
OperandNode := sfGetNodePtr(aNode^.fnUnary.iOperand1);
if sfEvaluateNode(OperandNode, @NodeValue, aRecBuf) then begin
case aNode^.fnHdr.CANOp of
canISBLANK:
Result := NodeValue.nvIsNull;
canNOTBLANK:
Result := not NodeValue.nvIsNull;
else
Result := false;
end;{case}
end
else { the node didn't match }
Result := aNode^.fnHdr.CANOp = canNOT;
end;
{--------}
function TffSrFilter.sfEvaluateLogicalNode(aNode : PffFilterNode;
aRecBuf : Pointer) : Boolean;
var
LeftNode : PffFilterNode;
RightNode : PffFilterNode;
begin
LeftNode := sfGetNodePtr(aNode^.fnBINARY.iOperand1);
RightNode := sfGetNodePtr(aNode^.fnBINARY.iOperand2);
case aNode^.fnHdr.CANOp of
canAND : Result := sfEvaluateNode(LeftNode, nil, aRecBuf) and
sfEvaluateNode(RightNode, nil, aRecBuf);
canOR : Result := sfEvaluateNode(LeftNode, nil, aRecBuf) or
sfEvaluateNode(RightNode, nil, aRecBuf);
else
{anything else fails}
Result := false;
end;{case}
end;
{--------}
function TffSrFilter.sfEvaluateBinaryNode(aNode : PffFilterNode;
aRecBuf : Pointer;
aNoCase : Boolean;
aPartial : TffWord16) : Boolean;
var
LeftNode : PffFilterNode;
RightNode : PffFilterNode;
LeftValue : TffNodeValue;
RightValue : TffNodeValue;
CompareResult : Integer;
begin
Result := false;
if (aNode^.fnHdr.NodeClass = nodeCOMPARE) then begin
LeftNode := sfGetNodePtr(aNode^.fnCompare.iOperand1);
RightNode := sfGetNodePtr(aNode^.fnCompare.iOperand2);
end
else begin
LeftNode := sfGetNodePtr(aNode^.fnBINARY.iOperand1);
RightNode := sfGetNodePtr(aNode^.fnBINARY.iOperand2);
end;
if not sfEvaluateNode(LeftNode, @LeftValue, aRecBuf) then
Exit;
if not sfEvaluateNode(RightNode, @RightValue, aRecBuf) then
Exit;
if not sfCompareValues(CompareResult, LeftValue, RightValue,
aNoCase, aPartial) then
Exit;
case aNode^.fnHdr.CANOp of
canLike : Result := CompareResult = 0; {!!.11}
canEQ : Result := CompareResult = 0;
canNE : Result := CompareResult <> 0;
canGT : Result := CompareResult > 0;
canLT : Result := CompareResult < 0;
canGE : Result := CompareResult >= 0;
canLE : Result := CompareResult <= 0;
else
{anything else fails}
Result := false;
end;{case}
end;
{--------}
function TffSrFilter.sfEvaluateConstNode(aNode : PffFilterNode;
aValue : PffNodeValue;
aRecBuf : Pointer) : Boolean;
begin
with aValue^, aNode^.fnCONST do begin
nvType := iType;
nvSize := iSize;
nvValue := sfGetLiteralPtr(iOffset);
nvIsNull := false;
nvIsConst := true;
end;
Result := true;
end;
{--------}
function TffSrFilter.sfEvaluateFieldNode(aNode : PffFilterNode;
aValue : PffNodeValue;
aRecBuf : Pointer) : Boolean;
var
FieldDesc : PffFieldDescriptor;
begin
with aNode^.fnFIELD do
if (0 < iFieldNum) and (iFieldNum <= sfDataDict.FieldCount) then
FieldDesc := sfDataDict.FieldDescriptor[Pred(iFieldNum)]
else
FieldDesc := nil;
{Begin !!.11}
if aValue <> nil then begin
with aValue^, FieldDesc^ do begin
nvType := Ord(fdType);
nvSize := Ord(fdLength);
nvValue := @PffByteArray(aRecBuf)^[fdOffset];
sfDataDict.GetRecordField(Pred(aNode^.fnFIELD.iFieldNum),
PffByteArray(aRecBuf), nvIsNull, nil);
nvIsConst := false;
end;
Result := true;
end
else
Result := False;
{End !!.11}
end;
{--------}
function TffSrFilter.sfCompareValues(var aCompareResult : Integer;
var aFirst : TffNodeValue;
var aSecond : TffNodeValue;
aIgnoreCase : Boolean;
aPartLen : Integer) : Boolean;
begin
Result := true;
{Deal with nulls first, we don't have to ask the table to do it
since null < any value, except null}
if aFirst.nvIsNull then
if aSecond.nvIsNull then begin
aCompareResult := 0;
Exit;
end
else begin
aCompareResult := -1;
Exit;
end
else {aFirst is not null} if aSecond.nvIsNull then begin
aCompareResult := 1;
Exit;
end;
{Otherwise let the table deal with it since some translation may be
required}
aCompareResult := sfCompareValue(aFirst, aSecond, aIgnoreCase, aPartLen);
end;
{--------}
function TffSrFilter.sfCompareValue(var aFirst : TffNodeValue;
var aSecond : TffNodeValue;
aIgnoreCase : Boolean;
aPartLen : Integer) : Integer;
{------}
function ConvertIntValue(var aNode : TffNodeValue; var C : comp) : boolean;
begin
Result := true;
with aNode do begin
if nvIsConst then begin
case nvType of
fldINT16 : C := smallint(nvValue^);
fldINT32 : C := longint(nvValue^);
fldUINT16 : C := word(nvValue^);
fldUINT32 : begin
C := longint(nvValue^);
if (C < 0) then
C := C + $80000000;
end;
else
Result := false;
end;{case}
end
else begin
case TffFieldType(nvType) of
fftByte : C := byte(nvValue^);
fftWord16 : C := word(nvValue^);
fftWord32 : begin
C := longint(nvValue^);
if (C < 0) then
C := C + $80000000;
end;
fftInt8 : C := shortint(nvValue^);
fftInt16 : C := smallint(nvValue^);
fftInt32 : C := longint(nvValue^);
fftAutoInc: begin
C := longint(nvValue^);
if (C < 0) then
C := C + $80000000;
end;
fftComp : C := comp(nvValue^);
else
Result := false;
end;{case}
end;
end;
end;
{------}
function ConvertDateTimeValue(var aNode : TffNodeValue; var DT : TDateTime) : boolean;
begin
Result := true;
with aNode do begin
if nvIsConst then begin
case nvType of
fldDATE : DT := DbiDate(nvValue^);
fldTIME : DT := DbiTime(nvValue^) / 86400000.0;
fldTIMESTAMP : DT := TimeStamp(nvValue^) / 86400000.0;
else
Result := false;
end;{case}
end
else begin
case TffFieldType(nvType) of
fftStDate : DT := StDateToDateTime(TStDate(nvValue^))
+ 693594;
fftStTime : DT := StTimeToDateTime(TStTime(nvValue^));
fftDateTime : DT := TDateTime(nvValue^);
else
Result := false;
end;{case}
end;
end;
end;
{------}
function ConvertFloatValue(var aNode : TffNodeValue; var F : extended) : boolean;
begin
Result := true;
with aNode do begin
if nvIsConst then begin
case nvType of
fldFLOAT : F := double(nvValue^);
fldFLOATIEEE : F := extended(nvValue^);
else
Result := false;
end;{case}
end
else begin
case TffFieldType(nvType) of
fftSingle : F := single(nvValue^);
fftDouble : F := double(nvValue^);
fftExtended : F := extended(nvValue^);
fftCurrency : F := currency(nvValue^);
else
Result := false;
end;{case}
end;
end;
end;
{------}
function ConvertBooleanValue(var aNode : TffNodeValue; var B : boolean) : boolean;
begin
Result := true;
with aNode do begin
if nvIsConst then begin
case nvType of
fldBOOL : B := WordBool(nvValue^);
else
Result := false;
end;{case}
end
else begin
case TffFieldType(nvType) of
fftBoolean : B := boolean(nvValue^);
else
Result := false;
end;{case}
end;
end;
end;
{------}
function ConvertStringValue(var aNode : TffNodeValue; var P : PChar) : boolean;
var
StrZ : TffStringZ;
begin
Result := true;
with aNode do begin
if nvIsConst then begin
case nvType of
fldZSTRING : P := nvValue;
else
Result := false;
end;{case}
end
else begin
case TffFieldType(nvType) of
fftChar :
begin
P := StrAlloc(2);
P[0] := char(nvValue^);
P[1] := #0;
end;
fftShortString,
fftShortAnsiStr :
begin
P := StrNew(StrPCopy(StrZ, TffShStr(nvValue^)));
end;
fftNullString,
fftNullAnsiStr :
begin
P := StrNew(nvValue);
end;
else
Result := false;
end;{case}
end;
end;
end;
{------}
var
Bool1, Bool2 : boolean;
Comp1, Comp2 : comp;
PChar1, PChar2 : PAnsiChar;
DT1, DT2 : TDateTime;
Ext1, Ext2 : extended;
begin
{Note: there are two types of things to compare: constants and
fields. In neither case will this routine be called with null
values - the caller takes care of this}
{Note: this routine doesn't have to worry about comparing dissimilar
types (eg dates and strings); this is illegal and will have
been already excluded by the filter parser; similarly with
fields that can't be compared (eg, BLOBs)}
{Note: constant values are stored as logical types, field values as
physical types}
{Deal with integer types first}
if ConvertIntValue(aFirst, Comp1) then begin
ConvertIntValue(aSecond, Comp2);
if (Comp1 < Comp2) then Result := -1
else if (Comp1 = Comp2) then Result := 0
else Result := 1;
Exit;
end;
{Deal with floating point types next}
if ConvertFloatValue(aFirst, Ext1) then begin
ConvertFloatValue(aSecond, Ext2);
if (Ext1 < Ext2) then Result := -1
else if (Ext1 = Ext2) then Result := 0
else Result := 1;
Exit;
end;
{Deal with date/time types next}
if ConvertDateTimeValue(aFirst, DT1) then begin
ConvertDateTimeValue(aSecond, DT2);
if (DT1 < DT2) then Result := -1
else if (DT1 = DT2) then Result := 0
else Result := 1;
Exit;
end;
{Deal with boolean types next; false < true}
if ConvertBooleanValue(aFirst, Bool1) then begin
ConvertBooleanValue(aSecond, Bool2);
if Bool1 then
if Bool2 then Result := 0
else Result := 1
else {Bool1 is false}
if Bool2 then Result := -1
else Result := 0;
Exit;
end;
{Deal with strings next}
if ConvertStringValue(aFirst, PChar1) then begin
ConvertStringValue(aSecond, PChar2);
if aIgnoreCase then
if (aPartLen = 0) then
Result := FFAnsiStrIComp(PChar1, PChar2) {!!.06}{!!.07}
else
Result := FFAnsiStrLIComp(PChar1, PChar2, aPartLen) {!!.06}{!!.07}
else
if (aPartLen = 0) then
Result := AnsiStrComp(PChar1, PChar2) {!!.06}
else
Result := AnsiStrLComp(PChar1, PChar2, aPartLen); {!!.06}
if not aFirst.nvIsConst then
StrDispose(PChar1);
if not aSecond.nvIsConst then
StrDispose(PChar2);
Exit;
end;
{otherwise just compare the bytes}
Result := FFCmpBytes(Pointer(aFirst.nvValue),
Pointer(aSecond.nvValue),
FFMinI(aFirst.nvSize, aSecond.nvSize));
end;
end.
Reference in New Issue View Git Blame Copy Permalink