dxdatasetqbe.pas

Well known and usefull component for delphi 7

                     TDBEdit(Parent.Components[Loop]).Visible := False;
                     TDBEdit(Parent.Components[Loop]).Enabled := False;
                     PropInfo := GetPropInfo(Parent.Components[Loop], 'DataField');
                     if PropInfo = nil then begin
                        DXDataSetQBEOriginalColor.OldDataField := '';
                        fOldColors.Add(DXDataSetQBEOriginalColor);
                        Continue;
                     end;
                     TmpFieldName := GetStrProp(Parent.Components[Loop], 'DataField');
                     DXDataSetQBEOriginalColor.OldDataField := TmpFieldName;
                     SetStrProp(Parent.Components[Loop], 'DataField', '');
                     fOldColors.Add(DXDataSetQBEOriginalColor);
                  end;
               end;
            end;
            Canvas.Unlock;
            if fQueryDataSet.FieldDefs.Count > 0 then
               if not fResumeLastQuery then fQueryDataSet.Open;
            fInternalDataSource.DataSet := fQueryDataSet;
         end;
      False: begin
            Canvas.Lock;
            for Loop := 0 to Parent.ComponentCount - 1 do begin
               if Lowercase(Parent.Components[Loop].ClassType.ClassName) = 'tdxdatasetqbe' then continue;
               PropInfo := GetPropInfo(Parent.Components[Loop], 'Datasource');
               if PropInfo <> nil then begin
                  if IgnoreComponentClasses.IndexOf(Parent.Components[Loop].ClassType.ClassName) = -1 then begin
                     TmpDataSource := TDataSource(GetObjectProp(Parent.Components[Loop], 'DataSource'));
                     if TmpDataSource = nil then continue;
                     if lowercase(TmpDataSource.Name) = lowercase(fInternalDataSource.Name) then begin
                        Loop2 := 0;
                        while (Loop2 < fOldColors.Count) do begin
                           DXDataSetQBEOriginalColor := fOldColors[Loop2];
                           if DXDataSetQBEOriginalColor.Name = Parent.Components[Loop].Name then begin
                              TDBEdit(Parent.Components[Loop]).Color := DXDataSetQBEOriginalColor.Color;
                              TDBEdit(Parent.Components[Loop]).Font.Color := DXDataSetQBEOriginalColor.FontColor;
                              PropInfo := GetPropInfo(Parent.Components[Loop], 'Datasource');
                              SetObjectProp(Parent.Components[Loop], PropInfo, fDataSource);
                              Break;
                           end;
                           Inc(Loop2);
                        end;
                     end;
                  end
                  else begin // if it has a datasource, and is the one we want, but we are blocking it
                     // then flag is as enabled:=false;
                     TmpDataSource := TDataSource(GetObjectProp(Parent.Components[Loop], 'DataSource'));
                     if TmpDataSource = nil then continue;
                     Loop2 := 0;
                     while (Loop2 < fOldColors.Count) do begin
                        DXDataSetQBEOriginalColor := fOldColors[Loop2];
                        if DXDataSetQBEOriginalColor.Name = Parent.Components[Loop].Name then begin
                           TDBEdit(Parent.Components[Loop]).Enabled := DXDataSetQBEOriginalColor.WasEnabled;
                           TDBEdit(Parent.Components[Loop]).Visible := DXDataSetQBEOriginalColor.WasVisible;
                           PropInfo := GetPropInfo(Parent.Components[Loop], 'DataField');
                           if PropInfo = nil then Break;
                           SetStrProp(Parent.Components[Loop], 'DataField', DXDataSetQBEOriginalColor.OldDataField);
                           Break;
                        end;
                        Inc(Loop2);
                     end;
                  end;
               end;
            end;
            Canvas.Unlock;
            //fQueryDataSet.Close;
         end;
   end;
end;

function TDXDataSetQBE.Execute: Boolean;
Begin
Try
   Result:=ExecuteEx;
finally
   QBEMode(False);
end;
End;

function TDXDataSetQBE.ExecuteEx: Boolean;
var
   Loop: Integer;
   Ws: string;

begin
   WherePart := '';
   WhereOnly := '';
   try
      if fQueryDataSet.State in [dsEdit, dsInsert] then begin
         fQueryDataSet.Post;
         for Loop := fQueryDataSet.FieldDefs.Count - 1 downto 0 do begin
            Ws := fQueryDataSet.FieldByName(fQueryDataSet.FieldDefs.Items[Loop].Name).AsString;
            if Ws <> '' then begin
               case fQueryDataSet.FieldDefs.Items[Loop].DataType of
                  ftString: begin
                        if fAssumeWildCard then begin
                           if Pos('%', Ws) + Pos('*', Ws) = 0 then Ws := Ws + '%';
                        end;
                        Ws := SQLStringQuotationChar + Ws + SQLStringQuotationChar;
                        if Pos('%', Ws) + Pos('*', Ws) > 0 then
                           Ws := ' like ' + Ws
                        else
                           Ws := ' = ' + Ws;
                        if WherePart = '' then
                           WherePart := fQueryDataSet.FieldDefs.Items[Loop].Name + Ws
                        else
                           WherePart := WherePart + ' and ' + #13#10 + fQueryDataSet.FieldDefs.Items[Loop].Name + Ws;
                     end;
                  ftDate, ftDateTime: begin
                        if fOracleSyntax then
                           Ws := 'TO_DATE(' + SQLStringQuotationChar + Ws + SQLStringQuotationChar +
                              ', ' + SQLStringQuotationChar + 'MM/DD/YYYY' + SQLStringQuotationChar + ')';
                        if fQuoteDates then
                           Ws := SQLStringQuotationChar + Ws + SQLStringQuotationChar;
                        Ws := ' = ' + Ws;
                        if WherePart = '' then
                           WherePart := fQueryDataSet.FieldDefs.Items[Loop].Name + Ws
                        else
                           WherePart := WherePart + ' and ' + #13#10 + fQueryDataSet.FieldDefs.Items[Loop].Name + Ws;
                     end;
               else begin
                     if Pos('%', Ws) + Pos('*', Ws) > 0 then
                        Ws := ' like ' + Ws
                     else
                        Ws := ' = ' + Ws;
                     if WherePart = '' then
                        WherePart := fQueryDataSet.FieldDefs.Items[Loop].Name + Ws
                     else
                        WherePart := WherePart + ' and ' + #13#10 + fQueryDataSet.FieldDefs.Items[Loop].Name + Ws;
                  end;
               end;
            end;
         end;
         WhereOnly := WherePart;
         WherePart := StringReplace(fSQLSkeleton.Text, '@QBE@', WherePart, [rfReplaceAll, rfIgnoreCase]);
      end;
      if WherePart = '' then
         Result := False
      else
         Result := True;
   finally
//      QBEMode(False);
   end;
end;

procedure TDXDataSetQBE.PreviewSQL;
var
   Loop: Integer;
   Ws: string;
   WherePart: string;
   Idx, Idx2: Integer;
   PreStr, PostStr: string;

begin
   WherePart := '';
   if fQueryDataSet.State in [dsEdit, dsInsert] then begin
      fQueryDataSet.Post;
      for Loop := fQueryDataSet.FieldDefs.Count - 1 downto 0 do begin
         Ws := fQueryDataSet.FieldByName(fQueryDataSet.FieldDefs.Items[Loop].Name).AsString;
         if Ws <> '' then begin
            case fQueryDataSet.FieldDefs.Items[Loop].DataType of
               ftString: begin
                     if fAssumeWildCard then begin
                        if Pos('%', Ws) + Pos('*', Ws) = 0 then Ws := Ws + '%';
                     end;
                     Ws := SQLStringQuotationChar + Ws + SQLStringQuotationChar;
                     if Pos('%', Ws) + Pos('*', Ws) > 0 then
                        Ws := ' like ' + Ws
                     else
                        Ws := ' = ' + Ws;
                     if WherePart = '' then
                        WherePart := fQueryDataSet.FieldDefs.Items[Loop].Name + Ws
                     else
                        WherePart := WherePart + ' and ' + #13#10 + fQueryDataSet.FieldDefs.Items[Loop].Name + Ws;
                  end;
               ftDate, ftDateTime: begin
                     if fQuoteDates then
                        Ws := SQLStringQuotationChar + Ws + SQLStringQuotationChar;
                     Ws := ' = ' + Ws;
                     if WherePart = '' then
                        WherePart := fQueryDataSet.FieldDefs.Items[Loop].Name + Ws
                     else
                        WherePart := WherePart + ' and ' + #13#10 + fQueryDataSet.FieldDefs.Items[Loop].Name + Ws;
                  end;
            else begin
                  if Pos('%', Ws) + Pos('*', Ws) > 0 then
                     Ws := ' like ' + Ws
                  else
                     Ws := ' = ' + Ws;
                  if WherePart = '' then
                     WherePart := fQueryDataSet.FieldDefs.Items[Loop].Name + Ws
                  else
                     WherePart := WherePart + ' and ' + #13#10 + fQueryDataSet.FieldDefs.Items[Loop].Name + Ws;
               end;
            end;
         end;
      end;
      WhereOnly := Wherepart;
      WherePart := StringReplace(fSQLSkeleton.Text, '@QBE@', WherePart, [rfReplaceAll, rfIgnoreCase]);
      fQueryDataSet.Edit;
   end;
   if WherePart <> '' then begin
      if fReturnOnlyWhere then
{$IFDEF LINUX}
         DXString.ShowMessageWindow(PChar(WhereOnly), 'The following SQL would have executed')
{$ELSE}
         MessageBox(0, PChar(WhereOnly), 'The following SQL would have executed', MB_ICONINFORMATION or MB_OK)
{$ENDIF}
      else begin
         Idx := QuickPOS('from', DXString.lowercase(WherePart));
         if (idx > 0) and (fTablePrefix + fTableSuffix <> '') then begin
            PreStr := Copy(WherePart, 1, Idx + 4);
            Ws := Copy(WherePart, Idx + 4, Length(WherePart));
            PostStr := trim(Ws);
            Idx2 := CharPos(#13, PostStr);
            if (CharPos(#32, PostStr) > 0) and
               (CharPos(#32, PostStr) < Idx2) then begin
               Ws := FetchByChar(PostStr, #32, False);
               WherePart := PreStr + fTablePrefix + Ws + fTableSuffix + PostStr;
            end
            else begin
               Ws := FetchByChar(PostStr, #13, False);
               WherePart := PreStr + fTablePrefix + Ws + fTableSuffix + #13 + PostStr;
            end;
         end;
{$IFDEF LINUX}
         DXString.ShowMessageWindow(PChar(WherePart), 'The following SQL would have executed');
{$ELSE}
         MessageBox(0, PChar(WherePart), 'The following SQL would have executed', MB_ICONINFORMATION or MB_OK);
{$ENDIF}
      end;
   end;
end;

function TDXDataSetQBE.BuiltSQL: string;
var
   Idx, Idx2: Integer;
   PreStr, Ws, PostStr: string;

begin
   Result := WherePart;
   if fReturnOnlyWhere then begin
      Result := WhereOnly;
      exit;
   end else begin
      Idx := QuickPOS('from', DXString.lowercase(Result));
      if (idx > 0) and (fTablePrefix + fTableSuffix <> '') then begin
         PreStr := Copy(Result, 1, Idx + 4);
         Ws := Copy(Result, Idx + 4, Length(Result));
         PostStr := trim(Ws);
         Idx2 := CharPos(#13, PostStr);
         if (CharPos(#32, PostStr) > 0) and
            (CharPos(#32, PostStr) < Idx2) then begin
            Ws := FetchByChar(PostStr, #32, False);
            Result := PreStr + fTablePrefix + Ws + fTableSuffix + PostStr;
         end
         else begin
            Ws := FetchByChar(PostStr, #13, False);
            Result := PreStr + fTablePrefix + Ws + fTableSuffix + #13 + PostStr;
         end;
      end;
   end;
end;

procedure TDXDataSetQBE.SetfSQLSkeleton(Value: TStringList);
begin
   fSQLSkeleton.Assign(Value);
end;

procedure TDXDataSetQBE.SetfIgnoreComponentClasses(Value: TStringList);
begin
   fIgnoreComponentClasses.Assign(Value);
end;

procedure TDXDataSetQBE.OverrideParent(tParent:TComponent);
Begin
   fParent:=TForm(tParent);
End;

end.