Plugins dans Panoramic ?

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  pdScriptAPI,      // interface required to use pdScript via the DLL
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Label1: TLabel;
    Button1: TButton;
    Label2: TLabel;
    cbPlugin: TComboBox;
    lbTrace: TListBox;
    Label3: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure cbPluginChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);

  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  Form1: TForm1;
  container: string;

implementation

{$R *.dfm}

{
Plugins
=======

Plugins are implemented by 2 collaborating routines. The interface apart is
implemented within the main program, via a callback function with predefined
yet extensible features. The real plugin is a Delphi like program written in
Pascal Script language. The implementation is done via the pdScript software.
pdScript means "Precision Delphi Script" and is provided by Precision software
& consulting. The actual implementation uses the portable freeware version:
Copyright (c) 2008-2012 Precision software & consulting. All rights reserved.

This callback function is the actual plugin implementation within the main program.
Several plugins may be implemented throughout the same callback function.

The 4 parameters of this functions are used as follows:
cCommand        character string identifying a command to be executed
cParams         parameters for the command
cBuffer         buffer pointer into which a string result is to be returned
cBuffSize       buffer size

The callback function executes a specific action for each expected command string.
In any case, the function returns an integer value, designed to be a success/failure/result
value. A predefined normally unused result value should be assigned for unrecognized
command codes, other normally unused values should be defined as standard error codes.
The remaining result value range is freely available as specific command result values.

This demo version implements 4 plugin functions:
GetCaption      returns the main form caption to the plugin script
SetCaption      sets the main form caption to a string provided by the plugin script
GetDate         returns a character string containing the formatted current date to the plugin script
Trace           adds a string provided by the plugin script to the trace list box of the main program

The plugin script must use the following template:

*****************************************************************************************
program Other_Script;

function plugin():integer;
var
  param, buff: string;
begin
  // sample call to get data from the main program
  if HostCallback('GetDate','',buff) then showmessage(buff);

  // sample call to send data to the main program
  param := 'Other_Script';
  if not HostCallback('Trace',param,buff) then showmessage('Trace returns BAD');

  result := 23;     // plugin specific numeric result

end;

begin
  exitcode := 7;
end.
*****************************************************************************************


}
function MyPDScriptCallback(cCommand:PChar; cParams:PChar; cBuffer:PChar; cBufSize:Integer):Integer; stdcall;
const
  cb_unknown    = -1;
  cb_unexpected = -2;
var
  MyText: string;
begin
  Result := cb_unknown;

  // commands readund data from the main program
  if AnsiSameText(cCommand,'GetCaption') then begin
    result := 0;
    MyText := Form1.Caption;
    if (cBuffer=nil) or (cBufSize<=0) then Result:=Length(MyText)
                                      else StrPLCopy(cBuffer,MyText,cBufSize);
  end;
  if AnsiSameText(cCommand,'GetDate') then begin
    result := 0;
    MyText := DateToStr(Date);
    if (cBuffer=nil) or (cBufSize<=0) then Result:=Length(MyText)
                                      else StrPLCopy(cBuffer,MyText,cBufSize);
  end;

  // commands modifying data in the main program
  if AnsiSameText(cCommand,'SetCaption') then begin
    result := 0;
    Form1.Caption:=cParams;
  end;
  if AnsiSameText(cCommand,'Trace') then begin
    result := 0;
    Form1.lbTrace.Items.Add(cParams);
  end;
  if AnsiSameText(cCommand,'Add_Plugin') then begin
    result := 0;
    if Form1.cbPlugin.Items.IndexOf(cParams)<0 then begin
      result := cb_unexpected;
    end else begin
      Form1.cbPlugin.Items.Add(cParams);            // add new plugin to list
      Form1.cbPlugin.Items.SaveToFile(container);   // and update the container file
    end;
  end;
end;

{
Sample main program - not relevant for the pluin mecanism itself.
This button clic procedure simulates the activation of a user written plugin.
The ames of the available plugins are placed in the combo cbPlugin. This
combo may be initally loaded by a configuration text file containing the names
of all installed plugins. Thus, new plugins can be added ad runtime, without
the need to restart the program. To achieve this, a simple command Add_Plugin
implemented within the callback function does the trick. So, a plugin adding new
plgins can easyly built.
}
procedure TForm1.Button1Click(Sender: TObject);
var
  res: integer;
  sfunction, script, dfm, param: string;
  hnd: THandle;
begin

// look if there is a plugin eslected
  if cbPlugin.Text='' then begin
    showmessage('No plugin selected.');
    exit;
  end;

// load the pdScript DLL
  sfunction := 'plugin';  // the user supplied function in the script has to be calles "plugin"
//  pdScriptLibHandle := pdScriptLoad(pdScriptDllNameCL);    // command line version
  pdScriptLibHandle := pdScriptLoad(pdScriptDllName);      // VCL version
  if not pdScriptReady then begin
    showmessage('Error - not ready');
    exit;
  end;

// compile the script and let it stay alive
// (this implementation does not use a client window for the plugin)
  script := memo1.Text;     // script source code from the memo filled by a click on the combo
  dfm := '';                // no window
// the parameters say "stay alive" and give the callback function address
  param := '/pds{keep-alive=true;host-callback='+IntToStr(Integer(@MyPDScriptCallback))+'}';
// now, execute the script unline to compile ans syntax check it
  hnd := Inline_pdScript(script,dfm,param,false);
  if hnd=1 then begin
    showmessage('Compile error: '+inttostr(hnd));
    pdScriptUnload;
    exit;
  end;

// execute the plugin function
  res := Execute_pdScriptFunction(hnd, sfunction);    // call the plugin function
  showmessage('Result: '+inttostr(res));
  pdScriptUnload;                                     // unload pdScript
end;

procedure TForm1.cbPluginChange(Sender: TObject);
begin
  memo1.Lines.LoadFromFile(cbPlugin.Text+'.pas');     // load the memo with the selectec plugin's source
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  name, path: string;
  inifile: TextFile;
begin
// try to localize the plugin container file (same folder as program)
  name := 'KlausApplication';
  path := GetCurrentDir + '\';
  container := path+name+'.plg';
  if FileExists(container) then begin
    cbPlugin.Items.LoadFromFile(container)    // load the combo from existing file
  end else begin
    AssignFile(inifile,container);            // create new empty file if missing
    Rewrite(inifile);
    CloseFile(inifile);
  end;

end;

end.

program Klaus_Script;


function plugin():integer;
var
  buff: string;
  n: integer;
  b: boolean;
  s1,s2: string;
begin
  if HostCallback('GetCaption','',buff) then showmessage(buff);
  
  s1 := 'aaaaaaaaa';  
  if not HostCallback('SetCaption',s1,s2) then showmessage('SetCaption returns BAD');
  s1 := 'Klaus_Script';
  if not HostCallback('Trace',s1,s2) then showmessage('Trace returns BAD');
  result := 17;
  
end;

begin
  exitcode := 7;
end.

program Other_Script;

function plugin():integer;
var
  param, buff: string;
begin
  // sample call to get data from the main program
  if HostCallback('GetDate','',buff) then showmessage(buff);

  // sample call to send data to the main program
  param := 'Other_Script';
  if not HostCallback('Trace',param,buff) then showmessage('Trace returns BAD');
  
  result := 23;     // plugin specific numeric result
  
end;

begin
  exitcode := 7;
end.

Klaus_Script
Other_Script

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  pdScriptAPI,      // interface required to use pdScript via the DLL
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Label1: TLabel;
    Button1: TButton;
    Label2: TLabel;
    cbPlugin: TComboBox;
    lbTrace: TListBox;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    ePar1: TEdit;
    ePar2: TEdit;
    ePar3: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure cbPluginChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);

  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  Form1: TForm1;
  container: string;

implementation

{$R *.dfm}

{
Plugins
=======

Plugins are implemented by 2 collaborating routines. The interface apart is
implemented within the main program, via a callback function with predefined
yet extensible features. The real plugin is a Delphi like program written in
Pascal Script language. The implementation is done via the pdScript software.
pdScript means "Precision Delphi Script" and is provided by Precision software
& consulting. The actual implementation uses the portable freeware version:
Copyright (c) 2008-2012 Precision software & consulting. All rights reserved.

This callback function is the actual plugin implementation within the main program.
Several plugins may be implemented throughout the same callback function.

The 4 parameters of this functions are used as follows:
cCommand        character string identifying a command to be executed
cParams        parameters for the command
cBuffer        buffer pointer into which a string result is to be returned
cBuffSize      buffer size

The callback function executes a specific action for each expected command string.
In any case, the function returns an integer value, designed to be a success/failure/result
value. A predefined normally unused result value should be assigned for unrecognized
command codes, other normally unused values should be defined as standard error codes.
The remaining result value range is freely available as specific command result values.

This demo version implements 4 plugin functions:
GetCaption      returns the main form caption to the plugin script
SetCaption      sets the main form caption to a string provided by the plugin script
GetDate        returns a character string containing the formatted current date to the plugin script
Trace          adds a string provided by the plugin script to the trace list box of the main program

The plugin script must use the following template:

*****************************************************************************************
program Other_Script;

function plugin():integer;
var
  param, buff: string;
begin
  // sample call to get data from the main program
  if HostCallback('GetDate','',buff) then showmessage(buff);

  // sample call to send data to the main program
  param := 'Other_Script';
  if not HostCallback('Trace',param,buff) then showmessage('Trace returns BAD');

  result := 23;    // plugin specific numeric result

end;

begin
  exitcode := 7;
end.
*****************************************************************************************


}
function MyPDScriptCallback(cCommand:PChar; cParams:PChar; cBuffer:PChar; cBufSize:Integer):Integer; stdcall;
const
  cb_unknown    = -1;
  cb_unexpected = -2;
var
  MyText: string;

begin
  Result := cb_unknown;

  // commands read data from the main program
  if AnsiSameText(cCommand,'GetCaption') then begin
    result := 0;
    MyText := Form1.Caption;
    if (cBuffer=nil) or (cBufSize<=0) then Result:=Length(MyText)
                                      else StrPLCopy(cBuffer,MyText,cBufSize);
  end;
  if AnsiSameText(cCommand,'GetDate') then begin
    result := 0;
    MyText := DateToStr(Date);
    if (cBuffer=nil) or (cBufSize<=0) then Result:=Length(MyText)
                                      else StrPLCopy(cBuffer,MyText,cBufSize);
  end;
  if AnsiSameText(cCommand,'GetParams') then begin
    result := 0;
    // just as a sample. In real situation, concatenate here all passed parameter values !
    MyText := '"'+Form1.ePar1.Text+'","'+Form1.ePar2.Text+'","'+Form1.ePar3.Text+'"';
    if (cBuffer=nil) or (cBufSize<=0) then Result:=Length(MyText)
                                      else StrPLCopy(cBuffer,MyText,cBufSize);
  end;

  // commands modifying data in the main program
  if AnsiSameText(cCommand,'SetCaption') then begin
    result := 0;
    Form1.Caption:=cParams;
  end;
  if AnsiSameText(cCommand,'Trace') then begin
    result := 0;
    Form1.lbTrace.Items.Add(cParams);
  end;
  if AnsiSameText(cCommand,'Add_Plugin') then begin
    result := 0;
    if Form1.cbPlugin.Items.IndexOf(cParams)<0 then begin
      result := cb_unexpected;
    end else begin
      Form1.cbPlugin.Items.Add(cParams);            // add new plugin to list
      Form1.cbPlugin.Items.SaveToFile(container);  // and update the container file
    end;
  end;
end;

{
Sample main program - not relevant for the pluin mecanism itself.
This button clic procedure simulates the activation of a user written plugin.
The ames of the available plugins are placed in the combo cbPlugin. This
combo may be initally loaded by a configuration text file containing the names
of all installed plugins. Thus, new plugins can be added ad runtime, without
the need to restart the program. To achieve this, a simple command Add_Plugin
implemented within the callback function does the trick. So, a plugin adding new
plgins can easyly built.
}
procedure TForm1.Button1Click(Sender: TObject);
var
  res: integer;
  sfunction, script, dfm, param: string;
  hnd: THandle;
begin

// look if there is a plugin eslected
  if cbPlugin.Text='' then begin
    showmessage('No plugin selected.');
    exit;
  end;

// load the pdScript DLL
  sfunction := 'plugin';  // the user supplied function in the script has to be calles "plugin"
//  pdScriptLibHandle := pdScriptLoad(pdScriptDllNameCL);    // command line version
  pdScriptLibHandle := pdScriptLoad(pdScriptDllName);      // VCL version
  if not pdScriptReady then begin
    showmessage('Error - not ready');
    exit;
  end;

// compile the script and let it stay alive
// (this implementation does not use a client window for the plugin)
  script := memo1.Text;    // script source code from the memo filled by a click on the combo
  dfm := '';                // no window
// the parameters say "stay alive" and give the callback function address
  param := '/pds{keep-alive=true;host-callback='+IntToStr(Integer(@MyPDScriptCallback))+'}';
// now, execute the script unline to compile ans syntax check it
  hnd := Inline_pdScript(script,dfm,param,false);
  if hnd=1 then begin
    showmessage('Compile error: '+inttostr(hnd));
    pdScriptUnload;
    exit;
  end;

// execute the plugin function
  res := Execute_pdScriptFunction(hnd, sfunction);    // call the plugin function
  showmessage('Result: '+inttostr(res));
  pdScriptUnload;                                    // unload pdScript
end;

procedure TForm1.cbPluginChange(Sender: TObject);
begin
  memo1.Lines.LoadFromFile(cbPlugin.Text+'.pas');    // load the memo with the selectec plugin's source
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  name, path: string;
  inifile: TextFile;
begin
// try to localize the plugin container file (same folder as program)
  name := 'KlausApplication';
  path := GetCurrentDir + '\';
  container := path+name+'.plg';
  if FileExists(container) then begin
    cbPlugin.Items.LoadFromFile(container)    // load the combo from existing file
  end else begin
    AssignFile(inifile,container);            // create new empty file if missing
    Rewrite(inifile);
    CloseFile(inifile);
  end;

end;

end.

program Other_Script;

function plugin():integer;
var
  param, buff: string;
  pars: TStringList;
begin
  // sample call to get data from the main program
  if HostCallback('GetDate','',buff) then showmessage('Date: '+buff);

  // recover here the application parameters as a delimited string 
  if HostCallback('GetParams','',buff) then showmessage('Parameters: '+buff);
  pars := TStringList.Create;
  pars.Delimiter := ';';
  pars.Sorted := false;
  pars.DelimitedText := buff;
  // here, we can work with the parameters.
  // pars.count is the number of actual parameters
  //  pars.Strings[n] is the n-th parameter (n=0,1,...)
  pars.Clear;
  pars.Free;
 
  // sample call to send data to the main program
  param := 'Other_Script';
  if not HostCallback('Trace',param,buff) then showmessage('Trace returns BAD');
 
  result := 23;    // plugin specific numeric result
 
end;

begin
  exitcode := 7;
end.