wwfltdlg.pas

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

         if FieldsListBox.items.indexOf(TempLabelName)<0 then
            FieldsListBox.items.add(TempLabelname);
       end
    end;


begin
   FieldsListBox.items.clear;
   FieldsListBox.sorted:= (FieldOrder.itemIndex = 0);
   Dlg:= DlgComponent as TwwFilterDialog;

   if (DlgDataSet is TQuery) and
      (Dlg.FilterMethod=fdByQueryParams) then begin
      query:= DlgDataset as TQuery;
      for i:= 0 to query.ParamCount-1 do begin
         ParamName:= query.Params.items[i].name;
         if ShowAll or (GetFilterField(ParamName, FldInfo)) then
         begin
            FieldsListBox.items.add(ParamName);
         end
      end;
      exit;
   end;

   if Dlg.SelectedFields.count=0 then begin
      for i:= 0 to Dlg.FFldList.count-1 do begin
         if not wwValidFilterableFieldType(TwwDBFieldInfo(Dlg.FFldList[i]).FieldType) then continue;
         AddFieldToListBox(TwwDBFieldInfo(Dlg.FFldList[i]).DisplayLabel);
      end
   end
   else begin
      for i:= 0 to Dlg.SelectedFields.count-1 do begin
         curpos:= 1;
         FieldName:= strGetToken(Dlg.SelectedFields[i], ';', curpos);
         dbInfo:= Dlg.GetDBInfoForField(FieldName);
         if dbInfo=nil then continue;
//         if not wwValidFilterableFieldType(dbInfo.FieldType) then continue;

         { 9/9/97 - Check display label if SelectedFields is overriding it for multiple table queries }
         TempDisplayLabel:= strGetToken(Dlg.SelectedFields[i], ';', curpos);
         if TempDisplayLabel<>'' then
         begin
            AddFieldToListBox(TempDisplayLabel);
            dbInfo.DisplayLabel:= TempDisplayLabel;
         end
         else AddFieldToListBox(dbInfo.DisplayLabel);
      end
   end;
end;

Function GetWord(s: string; var APos: integer): string;
begin
   result:= wwGetSQLWord(s, APos);
end;

procedure TwwFilterDialog.ReplaceRemoteSQL(querySQL: TStrings);
begin
//   if wwIsClass(datasource.dataset.classType, 'TwwClientDataSet') then
     wwSetSQLProp(datasource.dataset, querysql, GetSQLPropertyName);
end;

Function TwwFilterDialog.GetCommandTextDataSet(ADataSet: TDataSet = nil): TDataSet;
begin
   if ADataSet = nil then
     result:= DataSource.DataSet
   else result:= ADataSet;

   if wwIsClass(result.classType, 'TSimpleDataSet') then
      result:= wwGetDataSet(result);
end;

Procedure TwwFilterDialog.ReplaceWhereClause(whereClause: TStrings);
var querysql: TStrings;
    PropInfo: PPropInfo;
    i,j, APos: integer;
    line: string;
    word: string;
    startline, lastpos, startPos: integer;
//    tempParamCheck: boolean;
    tempParams: Tparams;
    SQLStringType: boolean;
    querySQLString: string;
    PreText: string;
    sqlText: string;
    wideQuerySql: TWideStrings;
    //iswide: boolean;

  Function GetWordJcc(s: string; var APos: integer): string;
  var i: integer;

     Function max(x,y: integer): integer;
     begin
       if x>y then result:= x
       else result:= y;
     end;

  begin
     result:= '';
     if APos<=0 then exit;
     if APos>length(s) then exit;

     i:= APos;
     while (i<=length(s)) and ((s[i]=' ') or (s[i]=#9)) do inc(i); { skip leading whitespace}
     APos:= i; { Skip leading blanks/tabs }
     if i>length(s) then exit { 10/6/98 - Avoid range check error}
     {** begin JCC bug fix}
     else if s[i]='(' then begin
       Result := '(';
       APos:= i+1;
     end
     else if s[i]=')' then begin
       Result := ')';
       APos:= i+1;
     end
     {** end JCC bug fix}

     else if s[i]='"' then begin
        inc(i);
        while (i<=length(s)) and (s[i]<>'"') do inc(i);
        if s[i]='"' then begin
           result:= copy(s, APos, i+1-APos);
           APos:= i+1;
        end
     end
     else if s[i]='''' then begin
        inc(i);
        while (i<=length(s)) and (s[i]<>'''') do inc(i);
        if s[i]='''' then begin
           result:= copy(s, APos, i+1-APos);
           APos:= i+1;
        end
     end
     else begin     {1/18/97 - Added $ to list of valid characters for current word}
        while (i<=length(s)) and (s[i] in ['A'..'Z','0'..'9','.','_','$']) do inc(i);
        result:= copy(s, APos, max(i-APos, 1));

        if length(result)>1 then APos:= i
        else APos:= i+1;
     end;
  end;


    function GetNextQuery(sqlText: String; startPos: Integer): Integer;
    var
      currPos: Integer;
    begin
      currPos := startPos;
      repeat
        word:= GetWordJcc(UpperCase(sqlText), currPos);
      until ((word='UNION') or (word='INSERSECT') or
              (word='EXCEPT') or (word=''));
      Result := currPos;
    end;

    function ProcessQuery(sqlText: string; startPos: Integer;
        var endPos: Integer): String;
    var
      APos: Integer;
      parenDepth: Integer;
      startLen, endLen: Integer;
    begin
      startLen := Length(sqlText);
      parenDepth := 0;
      APos := startPos;
      //in case statement starts with paren, whitespace, etc
      //move to first select
      repeat
        word:= GetWordJcc(UpperCase(sqlText), APos);
      until (word = '') or (word = 'SELECT');

      //find location to put where clause
      repeat
        word:= GetWordJcc(UpperCase(sqlText), APos);
        if (word='(') then
          Inc(parenDepth)
        else if (word=')') then
          Dec(parenDepth);
        if (parenDepth = 0) then begin
          if (word='WHERE') then begin
            //find end of where clause and append
            repeat  //good candidate for recursive behavior...
              word:= GetWordJcc(UpperCase(sqlText), APos);
              if (word='(') then
                Inc(parenDepth)
              else if (word=')') then
                Dec(parenDepth);
              if (parenDepth = 0) then begin
                if (word='GROUP') or (word='ORDER') or (word='') or
                  (APos >=endPos) then begin
                  Insert('AND '+whereClause.Text+' ', sqlText, APos);
                  break;
                end;
              end;
            until (word='') or (APos >= endPos);
          end //end WHERE clause found
          //no WHERE clause found
          else if (word='GROUP') or (word='ORDER') or (word='') or
                (APos >=endPos) then begin
            Insert('WHERE '+whereClause.Text+' ', sqlText, APos-Length(Word));
            break;
          end;
        end;
      until (word='') or (APos >= endPos);
      Result := sqlText;
      //move startPos equal to what was changed in the string
      endLen := Length(sqlText);
      lastPos := lastPos + (endLen - startLen);
    end;

    Function isKeyWord(word: string): boolean;
    begin
      result:=
         (word='WHERE') or
         (word='GROUP') or (word='HAVING') or
         (word='UNION') or (word='PLAN') or
         (word='ORDER') or (word='FOR');
    end;

begin
   startpos:= 0; lastpos:= 0; startLine:= 0; { Make compiler happy}

//   PropInfo:= Typinfo.GetPropInfo(DataSource.DataSet.ClassInfo,GetSQLPropertyName);
   PropInfo:= Typinfo.GetPropInfo(GetCommandTextDataSet.ClassInfo,GetSQLPropertyName);
   SQLStringType:= False;

   if PropInfo<>Nil then
   begin
      if (PropInfo^.Proptype^.Kind in [tkString, tklstring, tkwstring]) then
      begin
         querysqlstring:=  GetStrProp(GetCommandTextDataSet(DataSource.DataSet), PropInfo);
         SQLStringType:=True;
         querysql:= TStringlist.create;
         querysql.Add(querysqlstring);
      end
      else begin
         if IsWideSql(GetCommandTextDataSet, propInfo) then
         begin
            SQLStringType:= True;
            widequerysql:= TWideStringList(GetObjectProp(GetCommandTextDataSet(DataSource.DataSet), PropInfo));
            querysql:= TStringlist.create;
            for i:= 0 to widequerysql.Count - 1 do
            begin
                querysql.Add(widequerysql[i]);
            end;
         end
         else
            querysql:= TStrings(GetOrdProp(GetCommandTextDataSet(DataSource.DataSet), PropInfo));
      end
   end
   else exit;

   if querysql.count=0 then exit;
   if whereClause.count=0 then exit;

   tempParams:= wwGetParamsProp(datasource.dataset);
   { 4/8/99 - Make sure its TParams, so virtual datasets that don't use TParams won't throw an exception }
   if (tempParams<>nil) and wwIsClass(tempParams.ClassType, 'TParams') then
   begin
      tempParams:= Tparams.create; { 10/1/98 }
      tempParams.assign(wwGetParamsProp(datasource.dataset));
   end;

//   tempParamCheck:= wwGetParamCheck(DataSource.DataSet);
//   wwSetParamCheck(Datasource.dataset, False);

   Try
      if (patch[3]=True) then
      begin
         if (whereClause.Text = '') then
           Exit;
         sqltext := querysql.text;
         startPos := 1;
         while startPos <= Length(sqltext) do begin
           lastPos := GetNextQuery(sqltext, startPos);
           sqlText := ProcessQuery(sqltext, startPos, lastPos);
           startPos := lastPos;
         end;
         querySQL.Text := sqlText;
         ReplaceRemoteSQL(querySQL);
         exit;
      end;

      for i:= 0 to querysql.count-1 do begin
         line:= uppercase(querysql[i]);
         APos:= 1;
         repeat
            word:= GetWord(line, APos);
         until (isKeyWord(word) or (word=''));
         if isKeyWord(word) then begin
            startLine:= i;
            startPos:= APos;
            break;
         end
      end;

      if word='WHERE' then
      begin
         startPos:= startPos + 5; { Skip where keyword }

         { Find end of where clause and append to where clause }
         for i:= startLine to querysql.count-1 do begin
            line:= uppercase(querysql[i]);
            APos:= startPos;
            repeat
               lastPos:= APos;
               word:= GetWord(line, APos);
            until (isKeyWord(word) or (word=''));
            if isKeyWord(word) then break;
            startPos:= 1;
         end;
         if (i>=querysql.count) then i:= i - 1;
         line := querysql[i]; // 5/1/00 - Restore original case // 7/25/00 - Move down 1 line
         if copy(line, 1, lastpos-1)<>'' then
            querysql[i]:= copy(line, 1, lastPos-1)
         else begin { 9/30/98 }
            querysql.delete(i);
            i:= i - 1;
         end;

         querysql.insert(i+1, 'And');
         if copy(line, lastPos, length(line))<>'' then { 9/30/98 - Don't add if blank}
            querysql.insert(i+2, copy(line, lastPos, length(line)));
         inc(i); { Insert after 'And'}
      end
      else begin
         if word='' then begin
            querysql.add('Where');
            for j:= 0 to whereClause.count-1 do
              querysql.add(whereClause[j]);
            ReplaceRemoteSQL(querySQL);
            exit;
         end
         else begin
            // 7/17/02 - Allow keyword to be in middle of text (such as orderby)
            PreText:= copy(querysql[startLine], 1, startPos-length(word)-2);
            strStripPreceding(PreText, [' ',#9]);
            if PreText<>'' then
            begin
              querysql.insert(startLine, PreText);
              querysql.insert(startLine+1, 'Where');
              for j:= 0 to whereClause.count-1 do
                 querysql.insert(startLine+j+2, whereClause[j]);
              querysql[startLine+whereClause.count+2]:= copy(querySQL[startLine+whereClause.count+2], startPos-length(word), length(line));
              ReplaceRemoteSQL(querySQL);
              exit;
            end