Extracting SQL from Delphi code and DFMs

[Markus Kinzler 174]

Quote

If you use FireDAC, you can also use the FireDAC Monitor to capture everything that goes on, databasewise.

Also possible when using other libraries like UniDAC.

[Guest]

And https://www.peganza.com/PALHelp/index.html?property_value_report.htm seems to do the same.

[Guest]

@David Schwartz, @Bill Meyer and others interested!

 

I have replaced the *wonderful* RTC JSON classes with the *insert adjective* JSON reader that comes with Delphi.

 

To compile the project, you need to download Mason Wheelers "DFMJSON" and Eric Granges DWScript. You should only have to point the compiler to the source dirs of these two libraries ... see above.

I used Delphi Tokyo (it is not tested with anything else).

 

The project still uses the DevExpress grid and LayoutControl. Forms.MainForm will not compile w/o DevExpress. However, anyone* should be able to replace the whole "Forms.MainForm" unit with a form using the controls of choice.

 

In the "Data.ObjectCollector" there is an array with class names for collecting. Then you probably have to change the if ... else clauses below (in the reader loop) as the properties will be differently named.

 

HTH,

 

/Dany

 

* Who can create a MainForm and fill a non-DB aware grid (or view or whatnot) with strings.

DelphiPraxisSQLCollector.zip

Edited November 26, 2018 by Guest
Current Delphi version added.

[David Schwartz 427]

Thanks. I actually got something working that uses the old TRegExpr component and a few simple re's to extract the Object and SQL.String data from my DFMs. Then I wrote a simple parser routine to take the DFM's representation of the SQL.String and restore it as a "clean" SQL expression.

 

function postincr( var i : integer ) : integer;
begin
  Result := i;
  i := i+1;
end;
. . .
  procedure GetDatasetInfo( aMatchNum : integer );
  var
    p : integer;
    s0, s1, s2 : string;
    dataset_nm, dataset_type : string;
    re2 : TRegExpr;
    naked_query : string;

  begin
    s0 := WholeObject_re.Match[0];  // this is the whole object definition
    if (Pos('SQL.Strings',s0) < 1) then   // If there's no SQL.Strings property, we aren't interested
      Exit();

    s1 := WholeObject_re.Match[1];  // just [name: type]
    p := Pos( ':', s1 );
    dataset_nm := Copy( s1, 1, p-1 );
    dataset_type := Trim(Copy( s1, p+1, 99 ));

    if (s0 <> '') and (s1 <> '') then
    begin
      re2 := TRegExpr.Create( 'SQL.Strings = \(.*\)$', 'ims-xg' );
      try
        s2  := '';
        if re2.Exec(s0) then
          s2 := re2.Match[0]; // matches the whole SQL.Strings expression

        naked_query := ExtractSQL( s2 );
        query_sl.Text := naked_query;
        . . .
        // do something with the above data
        . . .
      finally
        re2.Free();
      end;
    end;
  end;
//***********************************************************************
  // this RE finds object definitions in the DFM that contain 'dataset' in the type name.
  // subexpression #1 is the object's definition; eg: "qry: TAstaClientDataset"
  WholeObject_re := TRegExpr.Create( 'object *(\S*: *\S*dataset)\s*$.*?end\s*$', 'ims-xgr' );

    if WholeObject_re.Exec(ss.DataString) then
    begin // NOTE: there's only ONE SQL.Strings property per dataset / WholeObject
      GetDatasetInfo(postincr(n));
      while WholeObject_re.ExecNext() do
        GetDatasetInfo(postincr(n));
    end;

 

Here's the one for extracting SQL.Strings from a string consisting of just an Object:

 

    with TRegExpr.Create( 'SQL.Strings = \(.*\)$', 'ims-xg' ) do
    begin
      if Exec(dm1.Datasets_tblWholeObject.AsString) then
        aMemo.Lines.Text := Match[0];
      Free();
    end;

 

And here's the ExtractSQL parser:

 

// This function extracts raw SQL from a SQL.Strings property
function Tdm1.ExtractSQL( aSQL_String : string ) : string;
  //-----------------------------------------
  function incr( var n : integer ) : integer;
  begin
    n := n+1;
    Result := n;
  end;
  //-----------------------------------------
var
  ln, n : integer;
  trimln, t2 : string;
  add_next_line : Boolean;
  rslt : TStringList;
  SQL_String : TStringList;

begin
  rslt := TStringList.Create();
  SQL_String := TStringList.Create();
  try
    SQL_String.Text := aSQL_String;
    add_next_line := False;
    t2 := '';
    ln := 0;
    repeat
      trimln := Trim(SQL_String[ln]);
      if (ln = 0) and (CompareText( trimln, 'SQL.Strings = (' ) = 0) then
        Continue;
      if (trimln = '''''') then  // it's just a blank line
      begin
        rslt.Add('');
        Continue;
      end;

      if (trimln = '') then
        Continue;

      if (trimln[1] = '''') then  // a single leading quote
      begin
        Delete( trimln, 1, 1 );
        //trimln := Trim(trimln);
      end;

      n := Length(trimln);

      repeat
        if (trimln = '') then
          Break;
        case trimln[n] of
          '''': begin
                  //       ' Where bill_order in (1,2,3)'
                  //       '       and pti.pi_id = rfl.pi_id(+) '

                  if (trimln[n-1] = ')') then // ....)'
                  begin
                    Delete( trimln, n, 1 );
                    Break;
                  end;
                  Delete( trimln, n, 1 );
                  trimln := TrimRight(trimln);
                  n := Length(trimln);
                end;
          ')':  begin
                  //       '   and en_id = :pENID')
                  if (trimln[n-1] = '''') then // ....')
                  begin
                    Delete( trimln, n-1, 2 ); // remove ')
                    Break;
                  end;
                  //       '       and pti.pi_id = rfl.pi_id(+) '  with [_'] at end removed
                  if ((trimln[n-2] = '(') and (trimln[n-1] = '+')) then
                    Break; // nothing needs to be done here
                  Delete( trimln, n, 1 );
                  trimln := TrimRight(trimln);
                  n := Length(trimln);
                end;
          '+':  begin
                  // this is the most common pattern that's used for line-splitting:
                  // the ' is typically in col 74 and + in col 76
                  // ...' +
                  if (trimln[n-2] = '''') and (trimln[n-1] = ' ') then
                  begin
                    Delete( trimln, n-2, 3 );
                    add_next_line := True;
                  end
                  //       ' Where udf.active = '#39'T'#39
                  //      '   AND udf.ud_type = '#39'E'#39)
                  else if (Copy(trimln, n-4, 3) = '#39') then
                  begin
                    Delete( trimln, n-1, 2 ); // we don't want to delete the #39
                    add_next_line := True;
                  end
                end;
        else
          break;
        end;
      until (1 = 2);

      if add_next_line then
      begin
        t2 := t2 + trimln;
        add_next_line := False;
      end
      else
      begin
        if (t2 <> '') then
          trimln := t2+trimln;
        rslt.Add( trimln );
        t2 := '';
      end;

    until (incr(ln) >= SQL_String.Count);

  finally
    Result := rslt.Text;
    rslt.Free();
    SQL_String.Free();
  end;
end;

If the program ever hangs while parsing this stuff, it's probably because I missed something in the handling of a trailing single-quote or '+' that deals with undoing the word-wrapping. (This code could probably be simplified. There may even be better code hiding somewhere in the VCL source.)

Edited November 27, 2018 by David Schwartz