📄 rm_jvinterpreter.pas.~1~
字号:
GetFunc: TJvInterpreterAdapterGetValue; ParamCount: Integer;
ParamTypes: array of Word; ResTyp: Word); dynamic;
procedure AddIGetEx(AClassType: TClass; const Identifier: string;
GetFunc: TJvInterpreterAdapterGetValue; ParamCount: Integer;
ParamTypes: array of Word; ResTyp: Word; Data: Pointer); dynamic;
procedure AddISet(AClassType: TClass; const Identifier: string;
SetFunc: TJvInterpreterAdapterSetValue; ParamCount: Integer;
ParamTypes: array of Word); dynamic;
procedure AddISetEx(AClassType: TClass; const Identifier: string;
SetFunc: TJvInterpreterAdapterSetValue; ParamCount: Integer;
ParamTypes: array of Word; Data: Pointer); dynamic;
procedure AddIDGet(AClassType: TClass;
GetFunc: TJvInterpreterAdapterGetValue; ParamCount: Integer;
ParamTypes: array of Word; ResTyp: Word); dynamic;
procedure AddIDGetEx(AClassType: TClass;
GetFunc: TJvInterpreterAdapterGetValue; ParamCount: Integer;
ParamTypes: array of Word; ResTyp: Word; Data: Pointer); dynamic;
procedure AddIDSet(AClassType: TClass;
SetFunc: TJvInterpreterAdapterSetValue; ParamCount: Integer;
ParamTypes: array of Word); dynamic;
procedure AddIDSetEx(AClassType: TClass;
SetFunc: TJvInterpreterAdapterSetValue; ParamCount: Integer;
ParamTypes: array of Word; Data: Pointer); dynamic;
procedure AddFunction(const UnitName, Identifier: string;
GetFunc: TJvInterpreterAdapterGetValue; ParamCount: Integer;
ParamTypes: array of Word; ResTyp: Word); dynamic;
procedure AddFunctionEx(const UnitName, Identifier: string;
GetFunc: TJvInterpreterAdapterGetValue; ParamCount: Integer;
ParamTypes: array of Word; ResTyp: Word; Data: Pointer); dynamic;
{ function AddDGet under construction - don't use it }
procedure AddDGet(AClassType: TClass; const Identifier: string;
GetFunc: Pointer; ParamCount: Integer; ParamTypes: array of Word;
ResTyp: Word; CallConvention: TCallConvention); dynamic;
procedure AddDGetEx(AClassType: TClass; const Identifier: string;
GetFunc: Pointer; ParamCount: Integer; ParamTypes: array of Word;
ResTyp: Word; CallConvention: TCallConvention; Data: Pointer); dynamic;
procedure AddRec(const UnitName, Identifier: string; RecordSize: Integer;
Fields: array of TJvInterpreterRecField; CreateFunc: TJvInterpreterAdapterNewRecord;
DestroyFunc: TJvInterpreterAdapterDisposeRecord;
CopyFunc: TJvInterpreterAdapterCopyRecord); dynamic;
procedure AddRecEx(const UnitName, Identifier: string; RecordSize: Integer;
Fields: array of TJvInterpreterRecField; CreateFunc: TJvInterpreterAdapterNewRecord;
DestroyFunc: TJvInterpreterAdapterDisposeRecord; CopyFunc: TJvInterpreterAdapterCopyRecord;
Data: Pointer); dynamic;
procedure AddRecGet(const UnitName, RecordType, Identifier: string;
GetFunc: TJvInterpreterAdapterGetValue; ParamCount: Integer;
ParamTypes: array of Word; ResTyp: Word); dynamic;
procedure AddRecGetEx(const UnitName, RecordType, Identifier: string;
GetFunc: TJvInterpreterAdapterGetValue; ParamCount: Integer;
ParamTypes: array of Word; ResTyp: Word; Data: Pointer); dynamic;
procedure AddRecSet(const UnitName, RecordType, Identifier: string;
SetFunc: TJvInterpreterAdapterSetValue; ParamCount: Integer;
ParamTypes: array of Word); dynamic;
procedure AddRecSetEx(const UnitName, RecordType, Identifier: string;
SetFunc: TJvInterpreterAdapterSetValue; ParamCount: Integer;
ParamTypes: array of Word; Data: Pointer); dynamic;
procedure AddConst(const UnitName, Identifier: string; Value: Variant); dynamic;
procedure AddConstEx(const AUnitName, AIdentifier: string; AValue: Variant;
AData: Pointer); dynamic;
procedure AddExtFun(const UnitName, Identifier: string; DllInstance: HINST;
const DllName, FunctionName: string; FunctionIndex: Integer; ParamCount: Integer;
ParamTypes: array of Word; ResTyp: Word); dynamic;
procedure AddExtFunEx(const AUnitName, AIdentifier: string; ADllInstance: HINST;
const ADllName, AFunctionName: string; AFunIndex: Integer; AParamCount: Integer;
AParamTypes: array of Word; AResTyp: Word; AData: Pointer); dynamic;
procedure AddSrcFun(const UnitName, Identifier: string;
ClassIdentifier: string;
PosBeg, PosEnd: Integer; ParamCount: Integer; ParamTypes: array of Word;
ParamTypeNames: array of string;
ParamNames: array of string; ResTyp: Word; const AResTypName: string;
AResDataType: IJvInterpreterDataType; Data: Pointer); dynamic;
procedure AddSrcFunEx(const AUnitName, AIdentifier: string;
AClassIdentifier: string;
APosBeg, APosEnd: Integer; AParamCount: Integer; AParamTypes: array of Word;
AParamTypeNames: array of string;
AParamNames: array of string; AResTyp: Word; const AResTypName: string;
AResDataType: IJvInterpreterDataType; AData: Pointer); dynamic;
procedure AddHandler(const UnitName, Identifier: string;
EventClass: TJvInterpreterEventClass; Code: Pointer); dynamic;
procedure AddHandlerEx(const AUnitName, AIdentifier: string;
AEventClass: TJvInterpreterEventClass; ACode: Pointer; AData: Pointer); dynamic;
procedure AddEvent(const UnitName: string; AClassType: TClass;
const Identifier: string); dynamic;
procedure AddEventEx(const AUnitName: string; AClassType: TClass;
const AIdentifier: string; AData: Pointer); dynamic;
procedure AddSrcVar(const UnitName, Identifier, Typ: string; VTyp: Word;
const Value: Variant; DataType: IJvInterpreterDataType); dynamic;
procedure AddOnGet(Method: TJvInterpreterGetValue); dynamic;
procedure AddOnSet(Method: TJvInterpreterSetValue); dynamic;
public
property DisableExternalFunctions: Boolean read FDisableExternalFunctions write FDisableExternalFunctions;
property SrcUnitList: TJvInterpreterIdentifierList read FSrcUnitList;
property ExtUnitList: TJvInterpreterIdentifierList read FExtUnitList;
property GetList: TJvInterpreterIdentifierList read FGetList;
property SetList: TJvInterpreterIdentifierList read FSetList;
property IGetList: TJvInterpreterIdentifierList read FIGetList;
property ISetList: TJvInterpreterIdentifierList read FISetList;
property IDGetList: TJvInterpreterIdentifierList read FIDGetList;
property IDSetList: TJvInterpreterIdentifierList read FIDSetList;
property IntfGetList: TJvInterpreterIdentifierList read FIntfGetList;
property DirectGetList: TJvInterpreterIdentifierList read FDirectGetList;
property ClassList: TJvInterpreterIdentifierList read FClassList;
property ConstList: TJvInterpreterIdentifierList read FConstList;
property FunctionList: TJvInterpreterIdentifierList read FFunctionList;
property RecordList: TJvInterpreterIdentifierList read FRecordList;
property RecordGetList: TJvInterpreterIdentifierList read FRecordGetList;
property RecordSetList: TJvInterpreterIdentifierList read FRecordSetList;
property OnGetList: TJvInterpreterIdentifierList read FOnGetList;
property OnSetList: TJvInterpreterIdentifierList read FOnSetList;
property SrcFunctionList: TJvInterpreterIdentifierList read FSrcFunctionList;
property ExtFunctionList: TJvInterpreterIdentifierList read FExtFunctionList;
property EventHandlerList: TJvInterpreterIdentifierList read FEventHandlerList;
property EventList: TJvInterpreterIdentifierList read FEventList;
property SrcVarList: TJvInterpreterVarList read FSrcVarList;
property SrcClassList: TJvInterpreterIdentifierList read FSrcClassList;
end;
TStackPtr = -1..cJvInterpreterStackMax;
{ Expression evaluator }
TJvInterpreterExpression = class(TJvComponent)
private
FParser: TJvInterpreterParser;
FVResult: Variant;
FExpStack: array [0..cJvInterpreterStackMax] of Variant;
FExpStackPtr: TStackPtr;
FToken: Variant;
FBacked: Boolean;
FTTyp: TTokenKind;
FTokenStr: string;
FPrevTTyp: TTokenKind;
FAllowAssignment: Boolean;
FArgs: TJvInterpreterArgs; { data }
FCurrArgs: TJvInterpreterArgs; { pointer to current }
FPStream: TStream; { parsed source }
FParsed: Boolean;
FAdapter: TJvInterpreterAdapter;
FSharedAdapter: TJvInterpreterAdapter;
FCompiled: Boolean;
FBaseErrLine: Integer;
FOnGetValue: TJvInterpreterGetValue;
FOnSetValue: TJvInterpreterSetValue;
FLastError: EJvInterpreterError;
FDisableExternalFunctions: Boolean;
function GetSource: string;
procedure SetSource(const Value: string);
procedure SetCurPos(Value: Integer);
function GetCurPos: Integer;
function GetTokenStr: string;
procedure ReadArgs;
procedure InternalGetValue(Obj: Pointer; ObjTyp: Word; var Result: Variant);
function CallFunction(const FunctionName: string;
Args: TJvInterpreterArgs; Params: array of Variant): Variant; virtual; abstract;
function CallFunctionEx(Instance: TObject; const UnitName: string;
const FunctionName: string; Args: TJvInterpreterArgs; Params: array of Variant): Variant; virtual; abstract;
procedure SetDisableExternalFunctions(const Value: Boolean);
protected
procedure UpdateExceptionPos(E: Exception; const UnitName: string);
procedure Init; dynamic;
procedure ErrorExpected(const Exp: string);
procedure ErrorNotImplemented(const Msg: string);
function PosBeg: Integer;
function PosEnd: Integer;
procedure Back;
procedure SafeBack; {? please don't use ?}
function CreateAdapter: TJvInterpreterAdapter; dynamic;
procedure ParseToken;
procedure ReadToken;
procedure WriteToken;
procedure Parse;
function Expression1: Variant;
function Expression2(const ExpType: Word): Variant;
function SetExpression1: Variant;
procedure NextToken;
function GetValue(const Identifier: string; var Value: Variant;
var Args: TJvInterpreterArgs): Boolean; virtual;
function SetValue(const Identifier: string; const Value: Variant;
var Args: TJvInterpreterArgs): Boolean; virtual;
function GetElement(const Variable: Variant; var Value: Variant;
var Args: TJvInterpreterArgs): Boolean; virtual;
function SetElement(var Variable: Variant; const Value: Variant;
var Args: TJvInterpreterArgs): Boolean; virtual;
procedure SourceChanged; dynamic;
procedure SetAdapter(Adapter: TJvInterpreterAdapter);
property Token: Variant read FToken;
property TTyp: TTokenKind read FTTyp;
property PrevTTyp: TTokenKind read FPrevTTyp;
property TokenStr: string read GetTokenStr;
property CurPos: Integer read GetCurPos write SetCurPos;
property Compiled: Boolean read FCompiled;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Run; dynamic;
property Source: string read GetSource write SetSource;
property VResult: Variant read FVResult;
property OnGetValue: TJvInterpreterGetValue read FOnGetValue write FOnGetValue;
property OnSetValue: TJvInterpreterSetValue read FOnSetValue write FOnSetValue;
property Adapter: TJvInterpreterAdapter read FAdapter;
property SharedAdapter: TJvInterpreterAdapter read FSharedAdapter;
property BaseErrLine: Integer read FBaseErrLine write FBaseErrLine;
property LastError: EJvInterpreterError read FLastError;
property DisableExternalFunctions: Boolean read FDisableExternalFunctions write SetDisableExternalFunctions;
end;
TParserState = record
CurPos: Integer;
Token: Variant;
TTyp: TTokenKind;
PrevTTyp: TTokenKind;
Backed: Boolean;
AllowAssignment: Boolean;
end;
TJvInterpreterAddVarFunc = procedure(const UnitName,
Identifier, Typ: string; VTyp: Word; const Value: Variant;
ADataType: IJvInterpreterDataType) of object;
{ Function executor }
TJvInterpreterFunction = class(TJvInterpreterExpression)
private
FCurUnitName: string;
FCurInstance: TObject;
FBreak: Boolean;
FContinue: Boolean;
FExit: Boolean;
FFunctionStack: TList;
FFunctionContext: Pointer; { PFunctionContext }
FSS: TStringList;
FStateStack: array [0..cJvInterpreterStackMax] of TParserState;
FStateStackPtr: TStackPtr;
FEventList: TList;
function GetLocalVars: TJvInterpreterVarList;
function GetFunStackCount: Integer;
function GetDebugPointerToGlobalVars: TJvInterpreterVarList;
function GetDebugPointerToFunStack: Pointer;
protected
procedure Init; override;
procedure PushState;
procedure PopState;
procedure RemoveState;
procedure DoOnStatement; virtual;
procedure InFunction(FunctionDesc: TJvInterpreterFunctionDesc);
procedure InterpretStatement;
procedure SkipStatement;
procedure SkipToEnd;
procedure SkipToUntil;
procedure SkipIdentifier;
procedure FindToken(ATTyp: TTokenKind);
procedure InterpretVar(AddVarFunc: TJvInterpreterAddVarFunc);
procedure InterpretConst(AddVarFunc: TJvInterpreterAddVarFunc);
procedure InterpretIdentifier;
procedure InterpretBegin;
procedure InterpretIf;
procedure InterpretWhile;
procedure InterpretRepeat;
procedure InterpretFor;
procedure InterpretCase;
procedure InterpretTry;
procedure InterpretRaise;
function ParseDataType: IJvInterpreterDataType;
function NewEvent(const UnitName, FunctionName, EventType: string;
Instance: TObject; const APropName: string): TSimpleEvent;
function FindEvent(const UnitName: string; Instance: TObject;
const PropName: string): TJvInterpreterEvent;
procedure InternalSetValue(const Identifier: string);
function GetValue(const Identifier: string; var Value: Variant;
var Args: TJvInterpreterArgs): Boolean; override;
function SetValue(const Identifier: string; const Value: Variant;
var Args: TJvInterpreterArgs): Boolean; override;
property LocalVars: TJvInterpreterVarList read GetLocalVars;
property EventList: TList read FEventList;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Run; override;
property CurUnitName: string read FCurUnitName;
property CurInstance: TObject read FCurInstance;
property FunStackCount: Integer read GetFunStackCount;
property DebugPointerToFunStack: Pointer read GetDebugPointerToFunStack;
property DebugPointerToGlobalVars: TJvInterpreterVarList read GetDebugPointerToGlobalVars;
end;
TUnitSection =
(usUnknown, usInterface, usImplementation, usInitialization, usFinalization);
{ Unit executor }
TJvInterpreterUnit = class(TJvInterpreterFunction)
private
FClearUnits: Boolean;
FEventHandlerList: TList;
FOnGetUnitSource: TJvInterpreterGetUnitSource;
FUnitSection: TUnitSection;
protected
procedure Init; override;
procedure ReadFunctionHeader(FunctionDesc: TJvInterpreterFunctionDesc);
procedure InterpretUses(var UsesList: string);
procedure ReadUnit(const UnitName: string);
procedure InterpretFunction;
procedure InterpretUnit;
procedure InterpretType;
procedure InterpretClass(const Identifier: string);
function GetValue(const Identifier: string; var Value: Variant;
var Args: TJvInterpreterArgs): Boolean; override;
function SetValue(const Identifier: string; const Value: Variant;
var Args: TJvInterpreterArgs): Boolean; override;
function GetUnitSource(const UnitName: string; var Source: string): Boolean; dynamic;
procedure ExecFunction(Fun: TJvInterpreterFunctionDesc);
procedure SourceChanged; override;
procedure InterpretRecord(const Identifier: string);
property EventHandlerList: TList read FEventHandlerList;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Run; override;
procedure DeclareExternalFunction(const Declaration: string);
procedure Compile;
function CallFunction(const FunctionName: string; Args: TJvInterpreterArgs;
Params: array of Variant): Variant; override;
function CallFunctionEx(Instance: TObject; const UnitName: string;
const FunctionName: string; Args: TJvInterpreterArgs;
Params: array of Variant): Variant; override;
function FunctionExists(const UnitName: string;
const FunctionName: string): Boolean;
property OnGetUnitSource: TJvInterpreterGetUnitSource read FOnGetUnitSource
write FOnGetUnitSource;
property UnitSection: TUnitSection read FUnitSection;
end;
{ main rm_JvInterpreter component }
TJvInterpreterProgram = class(TJvInterpreterUnit)
private
FPas: TStringList;
FOnStatement: TNotifyEvent;
function GetPas: TStrings;
procedure SetPas(Value: TStrings);
protected
procedure DoOnStatement; override;
public
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -