カスタム コマンドの開発（FireDAC）

説明

スクリプト制御実行コマンド セットをカスタム コマンドで拡張することができます。uADCompScriptCommands ユニットで既存コマンドのソースを見つけ、それらを独自のコマンドのテンプレートとして使用することができます。コマンド クラスは、コマンド レジストリに登録する必要があります。たとえば、以下の SPOOL コマンドのコードを使用できます。

 type
   TADSpoolScriptCommand = class(TFDScriptCommand)
   private
     FMode: Integer;
     FFileName: String;
     FAppend: Boolean;
   public
     class function Help(): String; override;
     class procedure Keywords(AKwds: TStrings); override;
     function Parse(const AKwd: String): Boolean; override;
     procedure Execute(); override;
     // -1 - off, 0 - show, 1 - file
     property Mode: Integer read FMode;
     property Append: Boolean read FAppend;
     property FileName: String read FFileName;
   end;
 
 {-------------------------------------------------------------------------------}
 class function TADSpoolScriptCommand.Help(): String;
 begin
   Result := '(SPOol | OUTput) [OFF|[APPend] <spool name>] - turns spooling off, print it status'#13#10 +
             '                                               or redirect it to the name';
 end;
 
 {-------------------------------------------------------------------------------}
 class procedure TADSpoolScriptCommand.Keywords(AKwds: TStrings);
 begin
   AKwds.Add('SPOol');
   AKwds.Add('OUTput');
 end;
 
 {-------------------------------------------------------------------------------}
 function TADSpoolScriptCommand.Parse(const AKwd: String): Boolean;
 var
   iLastBmk: Integer;
   ucS: string;
 begin
   iLastBmk := Parser.GetBookmark;
   ucS := Parser.GetUCWord;
   if ucS = 'OFF' then
     FMode := -1
   else if ucS = '' then
     FMode := 0
   else begin
     FMode := 1;
     FAppend := ADKeyWordMatch(ucS, 'APPEND', 3);
     if not FAppend then
       Parser.SetBookmark(iLastBmk);
     FFileName := Parser.GetLine();
     if FFileName = '' then
       FMode := -1;
   end;
   Result := True;
 end;
 
 {-------------------------------------------------------------------------------}
 procedure TADSpoolScriptCommand.Execute();
 begin
   case FMode of
   -1:
     begin
       Engine.ScriptOptions.SpoolOutput := smNone;
       EngineIntf.UpdateSpool;
     end;
    0:
     if Engine.ScriptOptions.SpoolOutput <> smNone then
       EngineIntf.ConPut('currently spooling to ' + Engine.ScriptOptions.SpoolFileName, soInfo)
     else
       EngineIntf.ConPut('not spooling currently', soInfo);
    1:
     begin
       if FAppend then
         Engine.ScriptOptions.SpoolOutput := smOnAppend
       else
         Engine.ScriptOptions.SpoolOutput := smOnReset;
       Engine.ScriptOptions.SpoolFileName := EngineIntf.ExpandString(FileName);
       EngineIntf.UpdateSpool;
     end;
   end;
 end;
 
 initialization
   ADScriptCommandRegistry().AddCommand(TADSpoolScriptCommand);