base_scripter.pas

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

destructor TPAXModules.Destroy;
var
  I: Integer;
begin
  for I:=0 to Count - 1 do
    Items[I].Free;
  inherited;
end;

procedure TPAXModules._SaveToStream(S: TStream);
var
  I: Integer;
begin
  SaveInteger(Count, S);
  for I:=0 to Count - 1 do
    Items[I]._SaveToStream(S);
end;

procedure TPAXModules._LoadFromStream(S: TStream);
var
  I, K: Integer;
  M: TPAXModule;
begin
  Clear;
  K := LoadInteger(S);
  for I:=1 to K do
  begin
    M := TPAXModule.Create(Scripter);
    M._LoadFromStream(S);
    AddObject(M.Name, M);
  end;
end;

function TPAXModules.GetModule(Index: Integer): TPAXModule;
begin
  if (Index < 0) or (Index >= Count) then
    result := nil
  else
    result := TPAXModule(Objects[Index]);
end;

procedure TPAXModules.Delete(Index: Integer);
begin
  if (Index < 0) or (Index >= Count) then
    Exit;
  Items[Index].Free;
  inherited;
end;

procedure TPAXModules.Clear;
var
  I: Integer;
begin
  for I:= Count - 1 downto 0 do
    Delete(I);
  inherited;
end;

function TPAXModules.GetSourceCode: String;
var
  I: Integer;
begin
  result := '';
  for I:=0 to Count - 1 do
    result := result + GetModule(I).Text;
end;

function TPAXModules.IndexOf(const Name: String): Integer;
var
  Module: TPAXModule;
  I: Integer;
begin
  result := -1;
  for I:=0 to Count - 1 do
  begin
    Module := Items[I];
    if StrEql(Name, Module.Name) then
    begin
      result := I;
      Exit;
    end;
  end;
end;

function TPAXModules.Add(const Name, LanguageName: String): Integer;
var
  Module: TPAXModule;
begin
  result := IndexOf(Name);
  if result >= 0 then
    Exit;
  Module := TPAXModule.Create(Scripter);
  Module.Name := Name;
  Module.FileName := '';
  Module.LanguageName := LanguageName;
  result := AddObject(Name, Module);
end;

procedure TPAXModules.Dump(const FileName: String);
var
  T: TextFile;
  I: Integer;
  M: TPAXModule;
begin
  if not _IsDump then
    Exit;
  AssignFile(T, FileName);
  Rewrite(T);
  try
    for I:=0 to Count - 1 do
    begin
      M := GetModule(I);
      writeln(T, M.Name);
      writeln(T, 'S1 =', M.S1);
      writeln(T, 'S2 =', M.S2);
      writeln(T, 'P1 =', M.P1);
      writeln(T, 'P2 =', M.P2);
      writeln(T, 'C1 =', M.C1);
      writeln(T, 'C2 =', M.C2);
      writeln(T, '**************************************');
      writeln(T, M.Text);
      writeln(T, '**************************************');
    end;
  finally
    CloseFile(T);
  end;
end;

constructor TPAXBaseScripter.Create(Owner: TObject);
begin
  CurrScripter := Self;

  _ObjCount := 0;

  IgnoreBreakpoints := false;
  try
    _BeginWrite;
    ScripterList.Add(Self);
  finally
    _EndWrite;
  end;
  NameList := TPAXNameList.Create;
  LocalDefinitions := TPaxDefinitionList.Create(false);

  Visited := TList.Create;
  ExtraModuleList := TStringList.Create;
  DefList := TStringList.Create;
  RunList := TPaxStack.Create;
  fSearchPathes := TStringList.Create;
  DefaultParameterList := TDefaultParameterList.Create;
  UnknownTypes := TPaxIDRecList.Create;
  CallRecList := TPaxCallRecList.Create;
  TypeAliasList := TPaxAssociativeList.Create(false);

  CancelMessage := '';

  AllowedEvents := true;

  ArrayClassRec := nil;

  LastResultID := 0;

  Self.Owner := Owner;

  Modules := TPAXModules.Create(Self);

  VariantStack := TPAXVariantStack.Create;
  NegVarList := TPAXVarList.Create;

  ParamList := TPAXParamList.Create;

  PrototypeNameIndex := NameList.Add('prototype');
  ConstructorNameIndex := NameList.Add('constructor');

  fStackSize := DefaultStackSize;

  SymbolTable := TPAXSymbolTable.Create(Self);

  ClassList := TPAXClassList.Create(Self);
  Code := TPAXCode.Create(Self);
  ClassList.AddClass(SymbolTable.RootNamespaceID, RootNamespaceName, '', '', [modSTATIC], ckClass, true);

  SignDefs := false;
  fLongStrLiterals := true;

  MethodBody := TPAXMethodBody.Create(Self);
  EventHandlerList := TPAXEventHandlerList.Create;
  ScriptObjectList := TPAXScriptObjectList.Create(Self);
  ActiveXObjectList:= TPaxObjectList.Create;

  CompileTimeHeap := TPAXCompileTimeHeap.Create;

  ErrorInstance := TPAXError.Create;

  LocalDefinitions.AddObject('ErrorObject', ErrorInstance, nil, Self);

  RegisteredFieldList := TPAXFieldList.Create;
  ParserList := TPaxParserList.Create;

  DiscardError;

  ExtraCodeList := TPAXCodeList.Create;
  DoNotDestroyList := TPAXIds.Create(false);
  TempObjectList := TPAXAssocList.Create;
  ForbiddenPublishedProperties := TList.Create;
  ForbiddenPublishedPropertiesEx := TStringList.Create;

  EvalCount := 0;

  fTotalLineCount := 0;

  State := _ssInit;

end;

destructor TPAXBaseScripter.Destroy;
var
  I: Integer;
begin
  _BeginWrite;
  try
    I := ScripterList.IndexOf(Self);
    if I <> -1 then
      ScripterList.Delete(I);
  finally
    _EndWrite;
  end;

  ScriptObjectList.Free;
  CompileTimeHeap.Free;
  ActiveXObjectList.Free;

  SymbolTable.Free;
  Code.Free;
  VariantStack.Free;
  NegVarList.Free;
  ClassList.Free;
  MethodBody.Free;
  EventHandlerList.Free;

  RegisteredFieldList.Free;
  ParserList.Free;

  ExtraCodeList.Free;
  DoNotDestroyList.Free;
  TempObjectList.Free;
  ForbiddenPublishedProperties.Free;
  ForbiddenPublishedPropertiesEx.Free;

  Modules.Free;

  ParamList.Free;
  Visited.Free;
  ExtraModuleList.Free;
  DefList.Free;
  RunList.Free;
  fSearchPathes.Free;
  DefaultParameterList.Free;
  UnknownTypes.Free;
  CallRecList.Free;
  TypeAliasList.Free;

  NameList.Free;
  LocalDefinitions.Free;

  ErrorInstance.Free;
  
  inherited;
end;

procedure TPAXBaseScripter.SetState(Value: TPAXScripterState);
begin
  if Assigned(OnChangeState) then
    if fState <> Value then
      OnChangeState(Owner, fState, Value);

  fState := Value;
  case fState of
    _ssReadyToCompile:
    begin
      SymbolTable.Card := FirstSymbolCard;
      SymbolTable.MemBoundVar := SymbolTable.CreateMemBoundVar;
    end;
  end;
end;

procedure TPAXBaseScripter.ResetCompileStage;
begin
  CancelMessage := '';

  EventHandlerList.ClearHandlers;

  ScriptObjectList.ResetCompileStage;
  CompileTimeHeap.ResetCompileStage;
  ActiveXObjectList.Clear;

  SymbolTable.ResetCompileStage;
  ClassList.ResetCompileStage;
  VariantStack.Clear;
  Code.ResetCompileStage;
  State := _ssReadyToCompile;

  ExtraCodeList.Clear;
  DoNotDestroyList.Clear;
  TempObjectList.Clear;
  ExtraModuleList.Clear;

  LastResultID := 0;

  AllowedEvents := true;

  DefList.Clear;
  DefaultParameterList.Clear;
  UnknownTypes.Clear;
  CallRecList.Clear;
  TypeAliasList.Clear;

  ScriptObjectList.ResetRunStage;

  Dump();
end;


procedure TPAXBaseScripter.ResetScripterEx;
begin
  CancelMessage := '';

  EventHandlerList.ClearHandlers;

  ScriptObjectList.ResetCompileStage(true);
  CompileTimeHeap.ResetCompileStage;
  ActiveXObjectList.Clear;

  SymbolTable.ResetCompileStage;
  ClassList.ResetCompileStage;
  VariantStack.Clear;
  Code.ResetCompileStage;
  State := _ssReadyToCompile;

  ExtraCodeList.Clear;
  DoNotDestroyList.Clear;
  TempObjectList.Clear;
  ExtraModuleList.Clear;

  LastResultID := 0;

  AllowedEvents := true;

  DefList.Clear;
  DefaultParameterList.Clear;
  UnknownTypes.Clear;
  CallRecList.Clear;
  TypeAliasList.Clear;

  ScriptObjectList.ResetRunStage(true);

  Dump();
end;


procedure TPAXBaseScripter.InitRunStage;
begin
  ClassList.InitRunStage;
  SymbolTable.InitRunStage;
  Code.InitRunStage;

  CreateRunList;
end;

procedure TPAXBaseScripter.ResetRunStage;
begin
  CancelMessage := '';

  ClassList.ResetRunStage;
  SymbolTable.ResetRunStage;
  Code.ResetRunStage;
  ScriptObjectList.ResetRunStage;
  ActiveXObjectList.Clear;
  TempObjectList.Clear;

  VariantStack.Clear;

  AllowedEvents := true;

  RunList.Clear;
end;

procedure TPAXBaseScripter.AddLocalDefs;
var
  I: Integer;
  SO: TPaxScriptObject;
  ID: Integer;
  ClassRec: TPaxClassRec;
begin
  for I:=0 to LocalDefinitions.Count - 1 do
    if LocalDefinitions.Records[I] is TPaxObjectDefinition then
    with LocalDefinitions.Records[I] as TPaxObjectDefinition do
    begin
      SO := DelphiInstanceToScriptObject(Instance, Self);
      Value := ScriptObjectToVariant(SO);

      if Owner <> nil then
        ClassRec := ClassList.FindClassByName(Owner.Name)
      else
        ClassRec := ClassList[0];

      ID := ClassRec.MemberList.GetMemberID(Name);
      if ID > 0 then
         ClassRec.DeleteMember(ID);

      AddToScripter(Self);
    end
    else if LocalDefinitions.Records[I] is TPaxVirtualObjectDefinition then
    with LocalDefinitions.Records[I] as TPaxVirtualObjectDefinition do
    begin
      if Owner <> nil then
        ClassRec := ClassList.FindClassByName(Owner.Name)
      else
        ClassRec := ClassList[0];

      ID := ClassRec.MemberList.GetMemberID(Name);
      if ID > 0 then
         ClassRec.DeleteMember(ID);

      AddToScripter(Self);
    end
    else if LocalDefinitions.Records[I] is TPaxInterfaceVarDefinition then
    with LocalDefinitions.Records[I] as TPaxInterfaceVarDefinition do
    begin
      if Owner <> nil then
        ClassRec := ClassList.FindClassByName(Owner.Name)
      else
        ClassRec := ClassList[0];

      ID := ClassRec.MemberList.GetMemberID(Name);
      if ID > 0 then
         ClassRec.DeleteMember(ID);

      AddToScripter(Self);
    end
    else if LocalDefinitions.Records[I] is TPAXConstantDefinition then
    with LocalDefinitions.Records[I] as TPaxConstantDefinition do
    begin
      if Owner <> nil then
        ClassRec := ClassList.FindClassByName(Owner.Name)
      else
        ClassRec := ClassList[0];

      ID := ClassRec.MemberList.GetMemberID(Name);
      if ID > 0 then
          ClassRec.DeleteMember(ID);
      AddToScripter(Self);
    end
    else if LocalDefinitions.Records[I] is TPAXVariableDefinition then
    with LocalDefinitions.Records[I] as TPaxVariableDefinition do
    begin
      if Owner <> nil then
        ClassRec := ClassList.FindClassByName(Owner.Name)
      else
        ClassRec := ClassList[0];

      ID := ClassRec.MemberList.GetMemberID(Name);
      if ID > 0 then
          ClassRec.DeleteMember(ID);
      AddToScripter(Self);
    end;
end;

procedure TPAXBaseScripter.AddDefs;
var
  I, N: Integer;
  SO: TPaxScriptObject;
  ID: Integer;