paxscripter.pas

来自「Delphi脚本控件」· PAS 代码 · 共 1,898 行 · 第 1/5 页

    function GetFullName(ID: Integer): String;
    function GetPosition(ID: Integer): Integer;
    function GetStartPosition(ID: Integer): Integer;
    function GetModule(ID: Integer): Integer;
    function GetAddress(ID: Integer): Pointer;
    function GetUserData(ID: Integer): Integer;
    function IsLocalVariable(ID: Integer): Boolean;
    function GetOwnerID(ID: Integer): Integer;
    function GetKind(ID: Integer): TPAXMemberKind;
    function GetCurrentProcID: Integer;
    function IsStatic(ID: Integer): Boolean;
    function IsConstructor(ID: Integer): Boolean;
    function IsDestructor(ID: Integer): Boolean;
    function IsVarParameter(ID: Integer): Boolean;
    function IsConstParameter(ID: Integer): Boolean;
    function IDCount: Integer;
    function IsMethod(ID: Integer): Boolean;

    function GetOnShowError: TPaxScripterEvent;
    procedure SetOnShowError(Value: TPaxScripterEvent);

    property ErrorClassType: TClass read GetErrorClassType;
    property ErrorDescription: String read GetErrorDescription;
    property ErrorModuleName: String read GetErrorModuleName;
    property ErrorTextPos: Integer read GetErrorTextPos;
    property ErrorPos: Integer read GetErrorPos;
    property ErrorLine: Integer read GetErrorLine;
    property ErrorMethodId: Integer read GetErrorMethodId;
    function GetSourceLine(const ModuleName: String; LineNumber: Integer): String;
    function IsExecutableSourceLine(const ModuleName: String; L: Integer): Boolean;

    function LanguageCount: Integer;
    function FindLanguage(const LanguageName: String): TPaxLanguage;
    function FileExtToLanguageName(const FileExt: String): String;
    procedure RegisterLanguage(L: TPaxLanguage);
    procedure UnregisterLanguage(const LanguageName: String);

    function GetRootID: Integer;
    procedure EnumMembers(ID: Integer;
                          Module: Integer;
                          CallBack: TPaxMemberCallback;
                          Data: Pointer);

    function GetValueByID(ID: Integer): Variant;
    procedure SetValueByID(ID: Integer; const Value: Variant);

    procedure SaveToStream(S: TStream);
    procedure LoadFromStream(S: TStream);

    procedure SaveToFile(const FileName: String);
    procedure LoadFromFile(const FileName: String);
    procedure SaveModuleToStream(const ModuleName: String;
                                 S: TStream);
    procedure SaveModuleToFile(const ModuleName, FileName: String);
    procedure LoadModuleFromStream(const ModuleName: String;
                                   S: TStream);
    procedure LoadModuleFromFile(const ModuleName, FileName: String);


    procedure AssignEventHandlerRunner(MethodAddress: Pointer;
                                       Instance: TObject);

    function GetPaxModule(I: Integer): TPaxModule;
    procedure DeleteModule(I: Integer);
    function FindFullFileName(const FileName: String): String;
    function FindNamespaceHandle(const Name: String): Integer;
    function AssignEventHandler(Instance: TObject; EventPropName: String; EventHandlerName: String): Boolean;

    function ToScriptObject(DelphiInstance: TObject): Variant;
    procedure Rename(ID: Integer; const NewName: String);

    procedure GetClassInfo(const FullName: String; mk: TPaxMemberKind; L: TStrings);
    function GetHostClass(const FullName: String): TClass;

{   procedure GetValueAsTreeNode(ID: Integer;
              const Separator: String;
              N: TTreeNode);    // not finished yet
    procedure SetValueAsTreeNode(N: TTreeNode); // not finished yet }
    procedure ScanProperties(const ObjectName: String);

    property ScripterState: TScripterState read GetScripterState write SetScripterState;
    property CallStack: TCallStack read fCallStack;
    property SourceCode[const ModuleName: String]: String read GetSourceCode write SetSourceCode;
    property Modules: TStringList read GetModules;
    property TotalLineCount: Integer read GetTotalLineCount;
    property CurrentSourceLine: Integer read GetCurrentSourceLine;
    property CurrentModuleName: String read GetCurrentModuleName;
    property Params[const ParamName: String]: Variant read GetParam write SetParam;
    property Values[const VarName: String]: Variant read GetValue write SetValue;
    property Languages[I: Integer]: TPaxLanguage read GetLanguage;
  published
    property OverrideHandlerMode: TPaxOverrideHandlerMode read GetOverrideHandlerMode write SetOverrideHandlerMode;
    property SearchPathes: TStrings read fSearchPathes write SetSearchPathes;
    property StackSize: Integer read GetStackSize write SetStackSize;
    property Optimization: Boolean read GetOptimization write SetOptimization;
    property OnAfterCompileStage: TPaxScripterEvent read fOnAfterCompileStage write fOnAfterCompileStage;
    property OnAfterRunStage: TPaxScripterEvent read fOnAfterRunStage write fOnAfterRunStage;
    property OnAssignScript: TPaxScripterEvent read fOnAssignScript write fOnAssignScript;
    property OnBeforeCompileStage: TPaxScripterEvent read fOnBeforeCompileStage write fOnBeforeCompileStage;
    property OnBeforeRunStage: TPaxScripterEvent read fOnBeforeRunStage write fOnBeforeRunStage;
    property OnCompilerProgress: TPaxCompilerProgressEvent read GetOnCompilerProgress write SetOnCompilerProgress;
    property OnPrint: TPaxScripterPrintEvent read GetOnPrint write SetOnPrint;
    property OnDefine: TPaxScripterDefineEvent read GetOnDefine write SetOnDefine;
    property OnRunning: TPaxCodeEvent read GetOnRunning write SetOnRunning;
{$IFDEF ONRUNNING}
    // See BASE_SCRIPTER.pas for details.
    property OnRunningUpdate: TPaxScripterEvent read GetOnRunningUpdate write SetOnRunningUpdate;
    property OnRunningUpdateActive: Boolean read GetOnRunningUpdateActive write SetOnRunningUpdateActive;
    property OnRunningSync: TPaxScripterEvent read GetOnRunningSync write SetOnRunningSync;
{$ENDIF}
    property OnShowError: TPaxScripterEvent read GetOnShowError write SetOnShowError;

{$IFDEF UNDECLARED_EX}
    property OnUndeclaredIdentifier: TPaxScripterVarEventEx read GetOnUndeclaredIdentifier write SetOnUndeclaredIdentifier;
{$ELSE}
    property OnUndeclaredIdentifier: TPaxScripterVarEvent read GetOnUndeclaredIdentifier write SetOnUndeclaredIdentifier;
{$ENDIF}

    property OnChangedVariable: TPaxScripterVarEvent
                read GetOnChangedVariable write SetOnChangedVariable;
    property OnReadExtraData: TPaxScripterStreamEvent read GetOnReadExtraData write SetOnReadExtraData;
    property OnWriteExtraData: TPaxScripterStreamEvent
                read GetOnWriteExtraData write SetOnWriteExtraData;
    property OnUsedModule: TPaxUsedModuleEvent
                read GetOnUsedModule write SetOnUsedModule;
    property OnLoadSourceCode: TPaxLoadSourceCodeEvent
                read GetOnLoadSourceCode write SetOnLoadSourceCode;
    property OnChangeState: TPaxScripterChangeStateEvent
                read GetOnChangeState write SetOnChangeState;
    property OnInclude: TPaxIncludeEvent
                read GetOnInclude write SetOnInclude;
    property OnHalt: TPaxScripterEvent read GetOnHalt write SetOnHalt;
    property OnDelphiInstanceCreate: TPaxScripterInstanceEvent read GetOnDelphiInstanceCreate write SetOnDelphiInstanceCreate;
    property OnDelphiInstanceDestroy: TPaxScripterInstanceEvent read GetOnDelphiInstanceDestroy write SetOnDelphiInstanceDestroy;
    property OnLoadDll: TPaxLoadDllEvent read GetOnLoadDll write SetOnLoadDll;
    property OnVirtualObjectMethodCallEvent: TPaxVirtualObjectMethodCallEvent read GetOnVirtualObjectMethodCallEvent write SetOnVirtualObjectMethodCallEvent;
    property OnVirtualObjectPutPropertyEvent: TPaxVirtualObjectPutPropertyEvent read GetOnVirtualObjectPutPropertyEvent write SetOnVirtualObjectPutPropertyEvent;
    property OnScanProperties: TPaxScanPropertiesEvent read fOnScanProperties write fOnScanProperties;
  end;

  TPaxLanguage = class(TPaxBaseLanguage)
  private
    fContainer: TComponent;
    fInformalName: String;
    fScripters: TList;
    fLongStrLiterals: Boolean;
    fNamespaceAsModule: Boolean;
    fCallConv: TPAXCallConv;
    fCompilerDirectives: TStrings;
    fIncludeFileExt: String;
    fJavaScriptOperators: Boolean;
    fDeclareVariables: Boolean;
    fZeroBasedStrings: Boolean;
    fBackslash: Boolean;
    procedure RegisterScripter(S: TPaxScripter);
    procedure UnRegisterScripter(S: TPaxScripter);
    function GetKeywords: TStringList;
    function GetCaseSensitive: Boolean;
    procedure SetCompilerDirectives(const Value: TStrings);
  protected
    fInitArrays: boolean;
    fVBArrays: Boolean;
    procedure SetFileExt(const Value: String); virtual;
    function GetPaxParserClass: TPaxParserClass; virtual;
    procedure SetLanguageName(const Value: String); virtual;
    function GetLanguageName: String; virtual;
    function GetFileExt: String; virtual;
    function GetLongStrLiterals: Boolean; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property LanguageName: String read GetLanguageName write SetLanguageName;
    property FileExt: String read GetFileExt write SetFileExt;
    property Keywords: TStringList read GetKeywords;
    property CaseSensitive: Boolean read GetCaseSensitive;
  published
    property CompilerDirectives: TStrings read fCompilerDirectives write SetCompilerDirectives;
    property InformalName: String read fInformalName write fInformalName;
    property Container: TComponent read fContainer write fContainer;
    property LongStrLiterals: Boolean read fLongStrLiterals write fLongStrLiterals;
    property CallConvention: TPAXCallConv read fCallConv write fCallConv;
    property NamespaceAsModule: Boolean read fNamespaceAsModule write fNamespaceAsModule;
    property IncludeFileExt: String read fIncludeFileExt write fIncludeFileExt;
    property JavaScriptOperators: Boolean read fJavaScriptOperators write fJavaScriptOperators;
    property DeclareVariables: Boolean read fDEclareVariables write fDeclareVariables;
    property ZeroBasedStrings: Boolean read fZeroBasedStrings write fZeroBasedStrings;
    property Backslash: Boolean read fBackslash write fBackslash;
  end;

function RegisterNamespace(const Name: String; OwnerIndex: Integer = -1;
                           UserData: Integer = 0): Integer;
function RegisterClassType(PClass: TClass; OwnerIndex: Integer = -1;
                           UserData: Integer = 0): Integer;
function RegisterInterfaceType(const Name: String; const Guid: TGuid;
                               const ParentName: String; const ParentGuid: TGUID;
                               OwnerIndex: Integer = -1;
                               UserData: Integer = 0): Integer;
procedure RegisterTypeAlias(const TypeName1, TypeName2: String);
function RegisterClassTypeEx(PClass: TClass; ReadProp, WriteProp: TPaxMethodImpl;
                             OwnerIndex: Integer = -1;
                             UserData: Integer = 0): Integer;
function RegisterRTTItype(pti: PTypeInfo; UserData: Integer = 0): Integer;
function RegisterEnumTypeByDef(const TypeName: PChar; UserData: Integer = 0): Integer;

procedure RegisterMethod(PClass: TClass; const Header: String; Address: Pointer;
                        Fake: Boolean = false;
                        UserData: Integer = 0);
procedure RegisterInterfaceMethod(pti: PTypeInfo; const Header: String;
                                  MethodIndex: Integer = -1;
                                  UserData: Integer = 0); overload;
procedure RegisterInterfaceMethod(const Guid: TGUID; const Header: String;
                                  MethodIndex: Integer = -1;
                                  UserData: Integer = 0); overload;
procedure RegisterBCBMethod(PClass: TClass; const Header: String; Address: Pointer;
                        Fake: Boolean = false;
                        UserData: Integer = 0);
procedure RegisterStdMethod(PClass: TClass;
                            const Name: String;
                            Proc: TPAXMethodImpl;
                            NP: Integer;
                            UserData: Integer = 0);
procedure RegisterStdMethodEx(PClass: TClass;
                              const Name: String;
                              Proc: TPAXMethodImpl;
                              NP: Integer;
                              const Types: array of Integer;
                              UserData: Integer = 0);
procedure RegisterField(PClass: TClass; const FieldName, FieldType: String;
                        Offset: Integer; UserData: Integer = 0);
procedure RegisterProperty(PClass: TClass; const PropDef: String;
                           UserData: Integer = 0);
procedure RegisterInterfaceProperty(const guid: TGUID; const PropDef: String;
                           UserData: Integer = 0);
procedure RegisterRoutine(const Header: String; Address: Pointer;
                          OwnerIndex: Integer = -1;
                          UserData: Integer = 0);
procedure RegisterStdRoutine(const Name: String;
                             Proc: TPAXMethodImpl;
                             NP: Integer;
                             OwnerIndex: Integer = -1;
                             UserData: Integer = 0);
procedure RegisterStdRoutineEx(const Name: String;
                               Proc: TPAXMethodImpl;
                               NP: Integer;
                               const Types: array of Integer;
                               OwnerIndex: Integer = -1;
                               UserData: Integer = 0);
procedure RegisterStdRoutineEx2(const Name: String;
                                Proc: TPAXMethodImpl;
                                NP: Integer;
                                const Types: array of Integer;
                                const ByRefs: array of boolean;
                                OwnerIndex: Integer = -1;
                                UserData: Integer = 0);

{$IFDEF VARIANTS}
procedure RegisterConstant(const Name: String; const Value: Double;
                           OwnerIndex: Integer = -1;
                           UserData: Integer = 0); overload;
procedure RegisterConstant(const Name: String; const Value: Integer;
                           OwnerIndex: Integer = -1;
                           UserData: Integer = 0); overload;
procedure RegisterConstant(const Name: String; const Value: Extended;
                           OwnerIndex: Integer = -1;
                           UserData: Integer = 0); overload;
{$ENDIF}

procedure RegisterConstant(const Name: String; const Value: Variant;
                           OwnerIndex: Integer = -1;
                           UserData: Integer = 0); overload;
procedure RegisterInt64Constant(const Name: String; const Value: Int64;
                                OwnerIndex: Integer = -1;
                                UserData: Integer = 0);
procedure RegisterVariable(const Name, TypeName: String; Address: Pointer;
                           OwnerIndex: Integer = -1;
                           UserData: Integer = 0);
procedure RegisterDynamicArrayType(const TypeName, ElementTypeName: String;
                                   OwnerIndex: Integer = -1;
                                   UserData: Integer = 0);
procedure RegisterStaticArrayType(const TypeName, ElementTypeName: String;
                                   OwnerIndex: Integer = -1;
                                   UserData: Integer = 0);
function RegisterRecordType(const TypeName: String;
                            Size: Integer;
                            OwnerIndex: Integer = -1;
                            UserData: Integer = 0): Integer;
procedure RegisterRecordField(OwnerIndex: Integer; const FieldName, FieldType: String;
                              Offset: Integer; UserData: Integer = 0);

function _Self: TObject;
function _Scripter: TPAXScripter;

function RunFile(const FileName: String; PaxScripter: TPaxScripter): Boolean;
function RunString(const Script, LanguageName: String; PaxScripter: TPaxScripter): Boolean;

const
  Fake = true;

var
  _OP_CALL,
  _OP_PRINT,
  _OP_GET_PUBLISHED_PROPERTY,
  _OP_PUT_PUBLISHED_PROPERTY,
  _OP_PUT_PROPERTY,
  _OP_NOP,
  _OP_ASSIGN: Integer;

{$ifdef obsolete}
{obsolete routines to provide backward compatibility}
function paxLanguageCount: Integer; // Use TPaxScripter.LanguageCount instead of it
function paxLanguageName(I: Integer): String; // Use TPaxScripter.Languages property

function GetPaxFileExt(const LanguageName: String): String; // Use TPaxScripter.Languages property
function GetPaxLanguageName(const FileName: String): String; // Use TPaxScripter.FileExtToLanguageName
{$endif}

function LoadImportLibrary(const DllName: String): Cardinal;
function FreeImportLibrary(H: Cardinal): LongBool;

function GetExtraDataPos(S: TStream): Integer;
function GetCompiledModuleVersion(S: TStream): Integer;

implementation

uses
  PAX_RTTI, PASCAL_PARSER, BASE_DFM;
var
  _Count: Integer = 3;

function GetCompiledModuleVersion(S: TStream): Integer;
begin
  if not S.Position = 0 then
    raise Exception.Create(errStream_position_must_be_equal_0);
  LoadInteger(S); // modules count
  LoadInteger(S); // module size
  result := LoadInteger(S);
  S.Position := 0;
end;

function GetExtraDataPos(S: TStream): Integer;
var
  Version: Integer;
begin
  if not S.Position = 0 then
    raise Exception.Create(errStream_position_must_be_equal_0);
  LoadInteger(S); // modules count
  LoadInteger(S); // module size
  Version := LoadInteger(S);
  if Version <> _CompiledModuleVersion then
    raise TPaxScriptFailure.Create(Format(errIncorrectCompiledModuleVersion,
        [Version, _CompiledModuleVersion]));

  result := LoadInteger(S); // extra data pos
  S.Position := 0;
end;

{$ifdef obsolete}
function FindPaxLanguages: TList;
var
  I: Integer;
  C: TComponent;
begin
  result := TList.Create;
  for I:=0 to Screen.FormCount - 1 do
  begin
    C := Screen.Forms[I];
    if C.InheritsFrom(TPaxLanguage) then
      result.Add(C);
  end;
  for I:=0 to Screen.DataModuleCount - 1 do
  begin
    C := Screen.DataModules[I];
    if C.InheritsFrom(TPaxLanguage) then
      result.Add(C);
  end;
end;

function paxLanguageCount: Integer;
var
  L: TList;