Home » Source Code » PMCAM2_2.50_Delphi_Source_Code » UScriptsEditor.pas

UScriptsEditor.pas ( File view )

  • By sathex 2016-03-20
  • View(s):0
  • Download(s):0
  • Point(s): 1
			unit UScriptsEditor;

interface

uses
  Windows, Messages, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Menus, SynEdit, SynEditHighlighter, SynHighlighterPas,
  UPSCompiler, UPSRuntime,UPSUtils,ComCtrls, StdCtrls, Buttons,
  IFSI_IniFiles,
//Script engine...
  uPSC_std,
  uPSC_stdCtrls,
  uPSC_classes,
  uPSC_controls, //Not needed by now...
  uPSC_forms,
  uPSR_std,
  uPSR_stdCtrls,
  uPSR_classes,
  uPSR_controls,
  uPSR_forms,
  uPSC_dll,
  uPSR_dll,
//End script engine...
  SysUtils,Clipbrd,USmartCardISO,
  UScriptFunctions, SynCompletionProposal;

function ScriptOnUses(Sender: TIFPSPascalCompiler; const Name: string): Boolean;
function ScriptOnExportCheck(Sender: TIFPSPascalCompiler; Proc: TIFPSInternalProcedure; const ProcDecl: string): Boolean;

type
  TfrmScripts = class(TForm)
    mnuScripts: TMainMenu;
    F1: TMenuItem;
    Open1: TMenuItem;
    OpenScript1: TMenuItem;
    Save1: TMenuItem;
    Saveas1: TMenuItem;
    Edit1: TMenuItem;
    SynPasSyn1: TSynPasSyn;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Cut1: TMenuItem;
    Copy1: TMenuItem;
    Paste1: TMenuItem;
    Delete1: TMenuItem;
    UnDo1: TMenuItem;
    ReDo1: TMenuItem;
    N1: TMenuItem;
    Panel2: TPanel;
    SynEditScript: TSynEdit;
    Panel1: TPanel;
    Label1: TLabel;
    imgScriptLogo: TImage;
    butCompile: TBitBtn;
    butStopScript: TBitBtn;
    StatusBar1: TStatusBar;
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure Open1Click(Sender: TObject);
    procedure OpenScript1Click(Sender: TObject);
    procedure Save1Click(Sender: TObject);
    procedure Saveas1Click(Sender: TObject);
    procedure SynEditScriptStatusChange(Sender: TObject;
      Changes: TSynStatusChanges);
    procedure butCompileClick(Sender: TObject);
    procedure butStopScriptClick(Sender: TObject);
    procedure Edit1Click(Sender: TObject);
    procedure Cut1Click(Sender: TObject);
    procedure Copy1Click(Sender: TObject);
    procedure Paste1Click(Sender: TObject);
    procedure Delete1Click(Sender: TObject);
    procedure UnDo1Click(Sender: TObject);
    procedure ReDo1Click(Sender: TObject);
    procedure imgScriptLogoClick(Sender: TObject);
  private
    {
 Private declarations 
}
    mvarDefaultDock: TWinControl;
    mvarScriptExec: TIFPSExec;
    mvarOpenedFile: string;
    mvarfrmCAM: TForm;
    mvarDefaultFolder: string;
    procedure ExecuteScript(const Script: string);
    procedure SetOpenedFile(const Value: string);
    procedure LoadFileInScriptEditor(Filename: string);
  public
    {
 Public declarations 
}
    property DefaultDock: TWinControl read mvarDefaultDock write mvarDefaultDock;
    property frmCAM: TForm read mvarfrmCAM write mvarfrmCAM;
    Property CurrentScript: string read mvarOpenedFile write SetOpenedFile;
    property DefaultFolder: string read mvarDefaultFolder write mvarDefaultFolder;
    procedure RunScript();
    procedure StopScript();
    Procedure OnChannelChange(ChannelName: string);
    procedure OnINSSent(Status: WORD; InsLen: BYTE; SentIns: PBYTEARRAY);
    procedure OnBeforeSendINS(Status: WORD; InsLen: BYTE; SendIns: PBYTEARRAY);
    procedure OnStartUp();
    procedure SetLastINSVariable(ISOObject: TCOMISO);
  end;

var
  frmScripts: TfrmScripts;

implementation

uses UfrmCAM;

const WindowTitle='PMCAM Scripting engine';
{
$R *.dfm
}


procedure TfrmScripts.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
    if Assigned(mvarDefaultDock) Then begin
        CanClose:=false;
        Self.ManualDock(mvarDefaultDock,mvarDefaultDock,alClient);
    end;
end;

procedure TfrmScripts.FormCreate(Sender: TObject);
begin
    Self.Caption:=WindowTitle;
    mvarDefaultDock:=nil;
end;

//Script controller...

procedure TfrmScripts.ExecuteScript(const Script: string);
var
  Compiler: TIFPSPascalCompiler;
  CI: TIFPSRuntimeClassImporter;
  Data: string;
  n: PPSVariant;
begin
    Compiler := TIFPSPascalCompiler.Create; // create an instance of the compiler.
    Compiler.AllowNoEnd:=true;
    Compiler.AllowNoBegin:=true;
    Compiler.OnUses := ScriptOnUses; // assign the OnUses event.
    Compiler.OnExportCheck := ScriptOnExportCheck; // Assign the onExportCheck event.
    Compiler.OnExternalProc:=DllExternalProc;
    if not Compiler.Compile(Script) then  // Compile the Pascal script into bytecode.
    begin
        Beep();
        if Compiler.MsgCount>0 Then begin
            StatusBar1.Panels[1].Text:=Compiler.Msg[0].MessageToString;
        end else begin
            StatusBar1.Panels[1].Text:='Unknown compile error. Uses not supported';
        end;
        Compiler.Free;
        Exit;
    end;

    Compiler.GetOutput(Data); // Save the output of the compiler in the string Data.
    Compiler.Free; // After compiling the script, there is no need for the compiler anymore.

    if Assigned(mvarScriptExec) then begin
        mvarScriptExec.Free;
    end;

    CI:=TIFPSRuntimeClassImporter.Create;
    RIRegister_Std(CI);
    RIRegister_Controls(CI);
    RIRegister_Forms(CI);
    RIRegister_StdCtrls(CI);
    RIRegister_Classes(CI,true);
    RIRegister_IniFiles(CI);

    mvarScriptExec := TIFPSExec.Create;  // Create an instance of the executer.
    mvarScriptExec.RegisterDelphiFunction(@ScriptDisplayStatus, 'DISPLAYSTATUS', cdRegister);
    mvarScriptExec.RegisterDelphiFunction(@ScriptByteToHex, 'BYTETOHEX', cdRegister);
    mvarScriptExec.RegisterDelphiFunction(@ScriptIntToHex, 'INTTOHEX', cdRegister);
    mvarScriptExec.RegisterDelphiFunction(@ScriptSECASendInsHex, 'SENDINSHEX', cdRegister);
    mvarScriptExec.RegisterDelphiFunction(@ScriptSECAResetCard, 'RESETCARD', cdRegister);
    mvarScriptExec.RegisterDelphiFunction(@ScriptSECASendLastINSAgain, 'SENDLASTINSAGAIN', cdRegister);
    mvarScriptExec.RegisterDelphiFunction(@ScriptSECAGetLastStatus, 'GETLASTSTATUS', cdRegister);
    mvarScriptExec.RegisterDelphiFunction(@ScriptSECASetLastStatus, 'SETLASTSTATUS', cdRegister);
    mvarScriptExec.RegisterDelphiFunction(@ScriptSECARestartECMProcessor, 'RestartECMProcessor', cdRegister);
    mvarScriptExec.RegisterDelphiFunction(@ScriptSendDCW, 'SendDCW', cdRegister);
    {
 This will register the function to the executer. The first parameter is the executer. The second parameter is a
      pointer to the function. The third parameter is the name of the function (in uppercase). And the last parameter is the
      calling convention (usually Register). 
}

    RegisterClassLibraryRuntime(mvarScriptExec,CI);
    RegisterDLLRuntime(mvarScriptExec);

    if not  mvarScriptExec.LoadData(Data) then // Load the data from the Data string.
    begin
        {
 For some reason the script could not be loaded. This is usually the case when a
          library that has been used at compile time isn't registered at runtime. 
}
        mvarScriptExec.Free;
        mvarScriptExec:=nil;
         // You could raise an exception here.
        Exit;
    end;

    SetVariantToClass(mvarScriptExec.GetVarNo(mvarScriptExec.GetVar('APPLICATION')), Application);

    n:=mvarScriptExec.GetVar2('LASTINS');
    PSDynArraySetLength(PPSVariantDynamicArray(n).Data, PPSVariantDynamicArray(n).VI.FType, 255);
    n:=mvarScriptExec.GetVar2('LASTINSLEN');
    VSetInt(n,0);
    n:=mvarScriptExec.GetVar2('EVENT');
    VSetInt(n,0);

    mvarScriptExec.RunScript; // Run the script.
    StatusBar1.Panels[1].Text:='Script engine running.';
end;

function ScriptOnUses(Sender: TIFPSPascalCompiler; const Name: string): Boolean;
begin
  if Name = 'SYSTEM' then
  begin
    Sender.OnExternalProc:=DllExternalProc;
    Sender.AddTypeS('TBYTEARRAY', 'array of BYTE').ExportName := True;
    Sender.AddDelphiFunction('procedure DisplayStatus(const Msg: string)');
    Sender.AddDelphiFunction('procedure SendINSHex(const INS: string)');
    Sender.AddDelphiFunction('function ByteToHex(const Value: BYTE): string');
    Sender.AddDelphiFunction('function IntToHex(const Value: integer;Digits: integer): string');
    Sender.AddDelphiFunction('function ResetCard(): Boolean');
    Sender.AddDelphiFunction('procedure SendLastINSAgain()');
    Sender.AddDelphiFunction('function GetLastStatus(): WORD');
    Sender.AddDelphiFunction('procedure SetLastStatus(Status: WORD)');
    Sender.AddDelphiFunction('procedure RestartECMProcessor()');
    Sender.AddDelphiFunction('procedure SendDCW(Index: BYTE;DCW: TBYTEARRAY)');
    Sender.AddUsedVariableN('LASTINS','TBYTEARRAY');
    Sender.AddUsedVariableN('LASTINSLEN','BYTE');
    Sender.AddUsedVariableN('EVENT','WORD');
    SIRegister_Std(Sender);
    SIRegister_Controls(Sender); //Not needed by now...
    SIRegister_Forms(Sender);
    SIRegister_StdCtrls(Sender);
    SIRegister_Classes(Sender,true);
    SIRegister_IniFiles(Sender);
    AddImportedClassVariable(Sender, 'Application', 'TApplication');
    Result := True;
  end else
    Result := False;
end;

function ScriptOnExportCheck(Sender: TIFPSPascalCompiler; Proc: TIFPSInternalProcedure; const ProcDecl: string): Boolean;
{

  The OnExportCheck callback function is called for each function in the script
  (Also for the main proc, with '!MAIN' as a Proc^.Name). ProcDecl contains the
  result type and parameter types of a function using this format:
  ProcDecl: ResultType + ' ' + Parameter1 + ' ' + Parameter2 + ' '+Parameter3 + .....
  Parameter: ParameterType+TypeName
  ParameterType is @ for a normal parameter and ! for a var parameter.
  A result type of 0 means no result.

}
begin
  if Proc.Name = 'ON_CHANNEL_CHANGED' then // Check if the proc is the Test proc we want.
  begin
      if not ExportCheck(Sender, Proc, [0, btString], [pmIn]) then // Check if the proc has the correct params.
      begin
          {
 Something is wrong, so cause an error at the declaration position of the proc. 
}
          Sender.MakeError('', ecTypeMismatch, '');
          Result := False;
          Exit;
      end;
//      Proc.aExport := etExportName;
      {
 Export the proc; Th
...
...
(Not finished, please download and read the complete file)
			
...
Expand> <Close

Want complete source code? Download it here

Point(s): 1

Download
0 lines left, continue to read
Sponsored links

File list

Tips: You can preview the content of files by clicking file names^_^
Name Size Date
About.rtf20.49 kB2005-03-15|17:16
changelog.txt4.26 kB2005-03-15|17:16
clean.bat92.00 B2005-01-05|02:35
DVBCore.pas31.98 kB2004-12-17|23:45
frmPPVInfo.dfm15.69 kB2004-12-19|19:54
frmPPVInfo.pas6.17 kB2005-03-03|01:02
01.96 kB
About.bmp3.05 kB2004-12-17|23:52
About.ico2.40 kB2004-12-17|23:52
Add.bmp1.30 kB2004-12-17|23:52
bluenote.ico7.23 kB2004-12-17|23:52
bug.jpg6.04 kB2005-01-05|02:35
CAM.ico2.40 kB2004-12-17|23:52
Close.bmp3.05 kB2004-12-17|23:52
EPG.bmp1.05 kB2005-01-05|21:10
EPG.ico1.37 kB2004-12-17|23:52
EPGOFF.bmp1.62 kB2004-12-17|23:52
EPGON.bmp1.62 kB2004-12-17|23:52
EPG_Gliph.bmp3.43 kB2004-12-17|23:52
Event.ico1.37 kB2004-12-17|23:52
jetons.ico1.37 kB2004-12-17|23:52
leftLogo.bmp9.96 kB2004-12-17|23:52
logger.ico1.68 kB2004-12-17|23:52
MagicWand.bmp1.30 kB2004-12-17|23:52
MagicWand.ico1.37 kB2004-12-17|23:52
MAS.ico1.37 kB2004-12-17|23:52
MENOS.ico1.37 kB2004-12-17|23:52
nemesis.ico4.19 kB2004-12-17|23:52
Phoenix.ico1.72 kB2004-12-17|23:52
Provider.ico1.37 kB2004-12-17|23:52
Remove.bmp1.30 kB2004-12-17|23:52
Reset.bmp3.05 kB2004-12-17|23:52
Restart.bmp1.30 kB2004-12-17|23:52
Save.bmp2.05 kB2004-12-17|23:52
scriptengine.ico7.23 kB2004-12-17|23:52
ScriptsEngine.bmp6.80 kB2004-12-17|23:52
Tools.bmp246.00 B2004-12-17|23:52
tuxprogramming.jpg4.15 kB2005-01-13|19:01
V9Card.jpg11.00 kB2005-03-03|01:02
IFSI_IniFiles.pas10.45 kB2004-12-19|19:54
MpgLib.DLL141.50 kB2004-12-24|17:03
PMCAM0.00 B2005-03-15|17:18
PMCAM4.67 kB2005-01-05|17:24
PMCAM4.69 kB2005-01-05|17:24
PMCAM4.52 kB2005-01-05|17:24
PMCAM.rc3.60 kB2004-12-17|23:47
PMCAM2.dpr6.30 kB2005-03-11|20:15
PMCAM2.res1.70 kB2005-03-15|17:16
PMCAM2StandAlone.dpr1.19 kB2005-03-03|01:02
PMCAM2StandAlone.res4.95 kB2005-03-11|20:15
PMCAMMenu.rc259.00 B2004-12-26|20:10
PMCAMMenu.RES162.25 kB2005-03-15|17:16
rUPClickSplitter.res740.00 B2004-12-19|19:54
santa_rock.jpg5.65 kB2004-12-24|17:59
UBitManager.pas4.18 kB2004-12-17|23:45
uDecode123.pas4.01 kB2004-12-29|01:33
UDVBConditionalAccessSystemNames.pas1.49 kB2004-12-17|23:45
UDVBCoreToMD.pas4.59 kB2004-12-17|23:45
UDVBPIDNames.pas1.23 kB2004-12-17|23:45
UDVBTablesHolder.pas2.68 kB2004-12-28|02:17
UEPGEntry.pas3.29 kB2004-12-17|23:45
UEPGMHW.dfm7.72 kB2005-01-11|02:38
UEPGMHW.pas40.85 kB2005-01-11|02:38
UfrmAddFilter.dfm6.86 kB2004-12-17|23:46
UfrmAddFilter.pas3.68 kB2004-12-17|23:45
UfrmCAM.dfm217.00 kB2005-03-15|03:22
UfrmCAM.pas159.37 kB2005-03-15|17:16
ufrmDLLForm.dfm420.00 B2004-12-19|19:54
ufrmDLLForm.pas1.87 kB2004-12-26|20:10
UfrmEMM.dfm1.28 kB2004-12-17|23:46
UfrmEMM.pas1.47 kB2004-12-17|23:45
UfrmEPGAdvanced.dfm7.01 kB2005-01-05|21:10
UfrmEPGAdvanced.pas2.56 kB2005-01-05|21:10
UfrmMHWEPGEntries.dfm3.81 kB2004-12-17|23:46
UfrmMHWEPGEntries.pas4.33 kB2004-12-17|23:45
ufrmMHWRadio.dfm35.85 kB2005-01-21|18:53
ufrmMHWRadio.pas37.84 kB2005-01-21|18:53
UfrmPMTDetails.dfm2.31 kB2005-01-21|18:53
UfrmPMTDetails.pas2.74 kB2005-01-21|18:53
UfrmWarningOnExit.dfm15.64 kB2005-01-05|21:10
UfrmWarningOnExit.pas1.44 kB2005-01-05|21:10
ULogEngine.pas15.89 kB2005-03-12|17:11
UMDDefs.pas4.07 kB2005-03-03|01:02
UMD_Impl.pas11.26 kB2005-03-03|01:02
United32.pas14.20 kB2004-12-17|23:45
UnitISO639_3.pas10.04 kB2005-03-03|01:02
UnitMDInterface.pas28.92 kB2005-03-15|03:22
UnitTimer.pas1.39 kB2004-12-17|23:45
Unit_CRC32.pas3.62 kB2004-12-17|23:45
uPESToTS.pas6.11 kB2005-03-03|01:02
UScriptFunctions.pas2.97 kB2005-01-03|16:45
UScriptsEditor.dfm58.10 kB2005-01-21|18:53
UScriptsEditor.pas22.02 kB2005-03-03|01:02
USECAManager.pas18.26 kB2005-03-03|01:02
USECATableStore.pas12.92 kB2004-12-17|23:45
USECA_EMM.pas7.74 kB2005-03-12|03:36
USmartCardISO.pas14.45 kB2004-12-17|23:45
UTfrmMultiDec.dfm407.00 B2005-01-21|18:53
UTfrmMultiDec.pas4.38 kB2005-01-21|18:53
UTranslate.pas6.49 kB2004-12-24|17:03
UTS184ToBitFilter.pas36.28 kB2005-03-11|20:15
uUPClickSplitter.dcr488.00 B2004-12-19|19:54
uUPClickSplitter.dcu18.09 kB2005-03-03|01:02
uUPClickSplitter.pas20.43 kB2004-12-26|20:10
PMCAM2_2.50.zip870.87 kB2016-03-19|22:08
...
Sponsored links

UScriptsEditor.pas (1.30 MB)

Need 1 point
Your Point(s)

Your Point isn't enough.

Get point immediately by PayPal

More(Debit card / Credit card / PayPal Credit / Online Banking)

Submit your source codes. Get more point

LOGIN

Don't have an account? Register now
Need any help?
Mail to: support@codeforge.com

切换到中文版?

CodeForge Chinese Version
CodeForge English Version

Where are you going?

^_^"Oops ...

Sorry!This guy is mysterious, its blog hasn't been opened, try another, please!
OK

Warm tip!

CodeForge to FavoriteFavorite by Ctrl+D