* Demo for macro support

git-svn-id: trunk@43002 -

.gitattributes

@@ -3161,6 +3161,8 @@ packages/fcl-db/examples/createsql.lpi svneol=native#text/plain
 packages/fcl-db/examples/createsql.pas svneol=native#text/plain
 packages/fcl-db/examples/dbftool.lpi svneol=native#text/plain
 packages/fcl-db/examples/dbftool.lpr svneol=native#text/plain
+packages/fcl-db/examples/demomacros.lpi svneol=native#text/plain
+packages/fcl-db/examples/demomacros.pp svneol=native#text/plain
 packages/fcl-db/examples/demotypesafeaccess.pp svneol=native#text/plain
 packages/fcl-db/examples/fbadmindemo.pp svneol=native#text/plain
 packages/fcl-db/examples/fbeventstest.pp svneol=native#text/plain

packages/fcl-db/examples/demomacros.lpi

@@ -0,0 +1,58 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+        <UseDefaultCompilerOptions Value="True"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="demomacros"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <BuildModes>
+      <Item Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+      <Modes Count="0"/>
+    </RunParams>
+    <Units>
+      <Unit>
+        <Filename Value="demomacros.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="macrotest"/>
+      </Unit>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="demomacros"/>
+    </Target>
+    <SearchPaths>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

packages/fcl-db/examples/demomacros.pp

@@ -0,0 +1,131 @@
+program macrotest;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, SysUtils, CustApp, db, sqldb, ibconnection;
+
+type
+
+  { TTestMacroApp }
+
+  TTestMacroApp = class(TCustomApplication)
+    DB : TIBConnection;
+    TR : TSQLTransaction;
+    Q : TSQLQuery;
+  protected
+    Procedure SetupDatabase;
+    procedure DoRun; override;
+  public
+    constructor Create(TheOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure WriteHelp(aMsg : String); virtual;
+  end;
+
+{ TTestMacroApp }
+
+procedure TTestMacroApp.SetupDatabase;
+
+begin
+  DB:=TIBConnection.Create(Self);
+  TR:=TSQLTransaction.Create(Self);
+  With DB do
+    begin
+    Hostname:='localhost';
+    DatabaseName:=GetOptionValue('d','database');
+    if DatabaseName='' then
+      DatabaseName:='employees'; // Alias
+    UserName:=GetOptionValue('u','username');
+    if UserName='' then
+      UserName:='SYSDBA';
+    Password:=GetOptionValue('p','password');
+    if Password='' then
+      Password:='masterkey';
+    Charset:='UTF8';
+    DB.Transaction:=TR;
+    end;
+  Q:=TSQLQuery.Create(Self);
+  Q.Database:=DB;
+  Q.Transaction:=TR;
+  Q.SQL.Text:='Select * from ('+sLineBreak+
+      '  Select 1 as id from rdb$database'+sLineBreak+
+      '  union all'+sLineBreak+
+      '  Select 2 as id from rdb$database'+sLineBreak+
+      '  )'+sLineBreak+
+      '%WHERE_CL' +sLineBreak+
+      '%ORDER_CL' +sLineBreak;
+  Q.MacroCheck:=true;
+  Q.MacroByName('WHERE_CL').AsString:='where 1=1';
+  Q.MacroByName('ORDER_CL').AsString:='order by 1';
+end;
+
+procedure TTestMacroApp.DoRun;
+var
+  ErrorMsg: String;
+
+begin
+  Terminate;
+  // quick check parameters
+  ErrorMsg:=CheckOptions('hd:u:p:', ['help','database:','user:','password:']);
+  if (ErrorMsg<>'') or HasOption('h','help') then
+    begin
+    WriteHelp(ErrorMsg);
+    Exit;
+    end;
+  SetupDatabase;
+  With Q do
+    begin
+    WriteLn( 'Execution of SQL Statement :' + LineEnding+LineEnding+SQl.Text );
+    Writeln('Initial macro values:');
+    WriteLn( '%WHERE_CL = "'+MacroByName('WHERE_CL').AsString+'"');
+    WriteLn( '%ORDER_CL = "'+MacroByName('ORDER_CL').AsString+'"');
+    Writeln;
+    Open;
+    Writeln( 'First field value (expect "1") using default macro order (with default order by clause): '+Fields[0].AsString);
+    Writeln;
+    Close;
+    MacroByName('ORDER_CL').AsString := 'Order by 1 DESC';
+    WriteLn('Set new value to %ORDER_CL = "'+MacroByName('ORDER_CL').AsString+'"');
+    Writeln;
+    Open;
+    WriteLn('First field value (expect "2") using new macro order (after new order by clause): '+Fields[0].AsString);
+    Writeln;
+    Close;
+    end;
+  // stop program loop
+  Terminate;
+end;
+
+constructor TTestMacroApp.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+  StopOnException:=True;
+end;
+
+destructor TTestMacroApp.Destroy;
+begin
+  inherited Destroy;
+end;
+
+procedure TTestMacroApp.WriteHelp(aMsg : string);
+begin
+  if AMsg<>'' then
+    Writeln('Error: ',aMsg);
+  { add your help code here }
+  writeln('Usage: ', ExeName, ' [options]');
+  Writeln('Where options is one or more of:');
+  Writeln('-h --help         this text');
+  Writeln('-d --database=DB  Name of firebird database to connect to');
+  Writeln('-u --user=Name    Name of user to connect with');
+  Writeln('-p --password=PW  Password of user to connect with');
+end;
+
+var
+  Application: TTestMacroApp;
+begin
+  Application:=TTestMacroApp.Create(nil);
+  Application.Title:='Macro test application';
+  Application.Run;
+  Application.Free;
+end.
+