wwfilter.pas

胜天进销存源码,国产优秀的进销存

      end
   end
end;


Function Next: string;
var
   match: string;
   upperLine: string;
   tempResult: string;

   procedure stripLeading(var s: string);
   var i: integer;
   begin
      i:= 1;
      while (i<=length(s)) and (s[i] in [#9, #32]) do i:= i+1;
      if (i>1) then delete(s, 1, i-1);
   end;

   { remove trailing blanks }
   procedure stripTrailing(var name: string);
   begin
      while (length(Name)>0) and (Name[length(name)]=' ') do
         delete(Name, length(Name), 1);
   end;


begin
        result:= '';
        if length(line)=0 then exit;
        stripLeading(line);
        upperLine:= uppercase(line);

	if (OtherOp(match)) then tempResult:= match
	else if (RelOp(match)) then tempResult:= match
	else if (ArithOp(match)) then tempResult:= match
	else if (ParseState = expectingLogical) and (pos('AND', upperLine)=1) then
           tempResult:= copy(line, 1, 3)
	else if (ParseState = expectingLogical) and (pos('OR', upperLine)=1) then
           tempResult:= copy(line, 1, 2)
	else if (isVarName(match)) then tempResult:= match
	else if (isConstantFloatName(match)) then tempResult:= match
	else if (isConstantIntegerName(match)) then tempResult:= match
	else if (isLiteralName(match)) then tempResult:= match
	else begin
{		cout << "Unknown next " << line;}
           tempResult:= '';
	end;

        stripTrailing(tempResult);
        result:= tempResult;

end;

Function ParseP: boolean;
var operand : SmallString;
begin
   result:= False;

   if (Next='(') then begin
      if (not Shift('(')) then exit;
      if (not ParseL) then exit;
      if (not Shift(')')) then exit;
      if (not Reduce(3, 'P')) then exit;
      result:= True;
   end
   else begin
      operand:= Next;
      if (not shift(operand)) then exit;
      if (not Reduce(1, 'P')) then exit;
      result:= BuildNode(Variable, operand);
   end
end;

Function ParseL: boolean;
var logOperator: SmallString;
begin
   result:= False;
   if (not ParseR) then exit;
   if (not Reduce(1, 'L')) then exit;

   parseState:= expectingLogical;
   logOperator:= Next;
   parseState:= None;

   while ((uppercase(logOperator)='AND') or (uppercase(logOperator)='OR') ) do
   begin
      if (not Shift(logOperator)) then exit;
      if (not ParseR) then exit;
{      if (not ParseL) then exit;}
      if (not Reduce(3, 'L')) then exit;
      if (not BuildNode(Logical, logOperator)) then exit;
      parseState:= expectingLogical;
      logOperator:=Next;
      parseState:= None;
   end;
   result:= True;
end;

Function ParseR: boolean;
var relOperator: SmallString;
begin
   result:= False;

   if (not ParseE) then exit;
   if (not Reduce(1, 'R')) then exit;

   relOperator:=Next;

   if (isRelOp(relOperator)) then
   begin
      if (not Shift(Next)) then exit;
      if (not ParseE) then exit;
      if (not Reduce(3, 'R')) then exit;
      if (not BuildNode(Relational, relOperator)) then exit;
      relOperator:=Next;
   end;
   result:= True;
end;


Function ParseE: boolean;
var arithOperator: SmallString;
begin
   result:= False;
   if (not ParseT) then exit;
   if (not Reduce(1, 'E')) then exit;

   arithOperator:=Next;

   while ((arithOperator='+') or (arithOperator='-') ) do
   begin
       if (not Shift(Next)) then exit;
       if (not ParseT) then exit;
       if (not Reduce(3, 'E')) then exit;
       if (not BuildNode(Arithmetic, arithOperator)) then exit;
       arithOperator:=Next;
   end;
   result:= True;
end;


function ParseT: boolean;
var arithOperator: SmallString;
begin
   result:= False;
   if (not ParseP) then exit;
   if (not Reduce(1, 'T')) then exit;

   arithOperator:=Next;

   while ((arithOperator='*') or (arithOperator='/') ) do
   begin
      if (not Shift(Next)) then exit;
      if (not ParseT) then exit;
      if (not Reduce(3, 'T')) then exit;
      if (not BuildNode(Arithmetic, arithOperator)) then exit;
      arithOperator:=Next;
   end;
   result:= True;
end;

Function doFilter(a_line: string;
                  a_fieldNames: string;
                  a_fieldType: string): Pointer;
var
   topNode: TNode;
   numNodes: integer;
begin
   result:= Nil;
   stack:= Nil;
   stackNodes:= Nil;
   try
      stack:= TStackStr.create;
      stackNodes:= TStackPtr.create;

      line := a_line;
      if (not ParseL) then exit;

      topNode := stackNodes.Pop;

      { Reset counters}
      traverseStr := '';
      numNodes := topNode.nodeCount;

      curBinaryNodeCount := numNodes;
      literalOffset := 0;
      fieldCount := 0;

      MakeEnginePtr;
      topNode.traverse;

      PTFilterHeaderClass(filterHeaderPtr)^.iVersion := 1;
      PTFilterHeaderClass(filterHeaderPtr)^.iTotalSize :=
                TFilterHeaderClassSize + numNodes*TFilterNodeClassSize + literalOffset;
      PTFilterHeaderClass(filterHeaderPtr)^.iNodes := numNodes;
      PTFilterHeaderClass(filterHeaderPtr)^.iNodeStart := TFilterHeaderClassSize;
      PTFilterHeaderClass(filterHeaderPtr)^.iLiteralStart :=
                TFilterHeaderClassSize + numNodes*TFilterNodeClassSize;

      topNode.free;;
      result:= filterHeaderPtr;

   finally
      stack.free;
      stackNodes.free;
   end
end;

Function wwSetFilter(a_line: string; table: TTable;
    var fh: hDBIFilter; InOpen: boolean): boolean;
var
   s: pCanExpr;
   dbResult :DBIResult;

   {Added for Rocket compatibility }
   fpSxQuery  : Function ( cpExpression : PChar) : Longint;
   fpSxSelect : Function ( iWorkArea : Word) : Word;
   hRocket    : THandle;
   iWA : word;
   cExpr : array [0..256] of Char;

begin
   result:= False;

   if (not Table.Active) and (not InOpen) then begin  { Don't apply filters if active is false }
      result:= True;
      fh:= Nil;
      exit;
   end;

   {Added for Rocket compatibility }
   if (Table.TableType > ttASCII) then begin

      if a_line='' then begin  { Drop filter}
         result:= True;
         if table.active then begin
            dbiDropFilter(Table.handle, Nil);
            table.refresh;
         end;
         exit;
      end;

      FillChar(cExpr, sizeof(cExpr), 0);
      {$ifdef win32}
      hRocket := GetModuleHandle('SDE32');
      if hRocket=0 then hRocket := GetModuleHandle('SDE3032');
      if hRocket=0 then hRocket := GetModuleHandle('SDE2532');
      {$else}
      hRocket := GetModuleHandle('SDE16');
      if hRocket=0 then hRocket := GetModuleHandle('SDE3016');
      if hRocket=0 then hRocket := GetModuleHandle('SDE2016');
      if hRocket=0 then hRocket := GetModuleHandle('ROCKET');
      {$endif}
      @fpSxSelect:=GetProcAddress(hRocket, 'SX_SELECT');

      {Select the workarea associated with this table}
      iWA := fpSxSelect(word(Table.Handle));

      @fpSxQuery:=GetProcAddress(hRocket, 'SX_QUERY');

      StrPCopy(cExpr, a_line);
      fpSxQuery(cExpr);

      if (iWA <> word(Table.Handle)) then
         fpSxSelect(word(Table.Handle));

      if table.active then table.refresh;

      Result := TRUE;
      exit;
   end;

   if (a_line='') then begin
      result:= True;
      wwRemoveFilter(Table, fh);
      if table.active then table.refresh;
      exit;
   end;

   dbTable:= table;

   s:= doFilter(a_line, '', '');
   if s=Nil then begin
      fh:= Nil;
      exit;
   end;

   wwRemoveFilter(Table, fh);

   dbResult :=
      DbiAddFilter(Table.handle, LongInt(0), 1, False,
      s, Nil, fh);

   FreeEnginePtr;

   if (dbResult=0) then begin
      dbiActivateFilter(Table.handle, fh);
      if table.active then table.refresh;
      result:= True;
   end
   else fh:= Nil
end;

Procedure wwRemoveFilter(table: TDBDataSet; var fh: hDBIFilter);
begin
   if fh=Nil then exit;
   dbiDeactivateFilter(Table.handle, fh);
   DbiDropFilter(Table.handle, fh);
   fh:=Nil;
end;

Function wwAddFilter(a_line: string; table: TTable;
    var fh: hDBIFilter): boolean;
var
   s: pCanExpr;
   dbResult :DBIResult;
begin
   result:= False;

   dbTable:= table;

   s:= doFilter(a_line, '', '');
   if s=Nil then exit;

   dbResult :=
      DbiAddFilter(Table.handle, LongInt(0), 1, False,
      s, Nil, fh);

   FreeEnginePtr;

   if (dbResult=0) then begin
      dbiActivateFilter(Table.handle, fh);
      Table.disableControls;
      Table.first;
      Table.enableControls;
      if table.active then table.refresh;
      result:= True;
   end
end;

{ Filter by callback function }
Function wwSetFilterFunction(func: Pointer; table: TDBDataSet;
      var fh: hDBIFilter): boolean;
var
   dbResult :DBIResult;
   szErrMsg: DBIMSG;
begin
   result:= False;

   wwRemoveFilter(Table, fh);

   if func=Nil then begin
      if table.active then begin
         { 4/25/97 - Don't call refresh if no indexes }
         if (table is TTable) and ((table as TTable).indexFieldCount>0) then table.refresh
         else begin
            table.updateCursorPos;
            table.resync([]);
         end
      end;
      result:= True;
      exit;
   end;
   if Table.Handle=Nil then exit;

   dbResult :=
      DbiAddFilter(Table.handle, LongInt(table), 1, False,
      Nil, pfGenFilter(func), fh);

   dbiGetErrorString(dbResult, szErrMsg);

   if (dbResult=0) then begin
      dbiActivateFilter(Table.handle, fh);
      if table.active then
      begin
         { 4/25/97 - Don't call refresh if no indexes }
         if (table is TTable) and ((table as TTable).indexFieldCount>0) then table.refresh
         else begin
            table.updateCursorPos;
            table.resync([]);
         end
      end;
      result:= True;
   end
   else fh:= Nil {Fail to set filter}
end;

end.