base_event.pas

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

            SO := InstanceClassRec.CreateScriptObject;
            SO.Instance := TObject(j);
{
            SO := ClassRec.CreateScriptObject;
            SO.Instance := TObject(J);
}
          end;
        end
        else begin
          SO := TPAXScriptObject(TPAXBaseScripter(Scripter).ScriptObjectList.PaxObjects[Index]);
        end;

        Parameters[I].VType := vtObject;
        Parameters[I].VObject := SO;

        Types[I] := typeCLASS;
        Pointers[I] := @ SO.Instance;
      end
      else
      begin
        RTTITypeDefinition := DefinitionList.FindRTTITypeDefByName(S);
        if RTTITypeDefinition <> nil then
        begin
          pti := RTTITypeDefinition.pti;
          case pti^.Kind of
            tkEnumeration:
            begin
              Integers[I] := J;

              Adjust(J);
              ptd := GetTypeData(pti);
{$ifndef fp}
              if ptd^.BaseType^ = TypeInfo(Boolean) then
              begin
                Parameters[I].VType := vtBoolean;
                if J = 0 then
                  Parameters[I].VBoolean := false
                else
                  Parameters[I].VBoolean := true;

                Types[I] := typeBOOLEAN;
                Pointers[I] := @ Parameters[I].VBoolean;
              end
              else
{$endif}
              begin
//                Parameters[I].VType := vtAnsiString;
//                Parameters[I].VAnsiString := Pointer(AnsiString(GetEnumName(pti, J)));

                Parameters[I].VType := vtInteger;
                Parameters[I].VInteger := J;

                Types[I] := typeENUM;
                Pointers[I] := @ Integers[I];
              end;
            end;
            tkSet:
            begin
              Integers[I] := J;

              Adjust(J);
              Variants[I] := SetToVariantArray(J, pti);
              Parameters[I].VType := vtVariant;
              Parameters[I].VVariant := @Variants[I];

              Types[I] := typeSET;
              Pointers[I] := @ Integers[I];
            end;

            //--jgv 20061012
            tkChar:
            begin
              Adjust(J);
              Parameters[I].VType := vtInteger;
              Parameters[I].VType := vtChar;
              Parameters[I].VInteger := J;

              Types[I] := typeCHAR;
              Pointers[I] := @ Parameters[I].VInteger;
            end;

            else
            begin
              Parameters[I].VType := vtInteger;
              Parameters[I].VInteger := J;

              Types[I] := typeINTEGER;
              Pointers[I] := @ Parameters[I].VInteger;
            end;
          end;
        end
        else
        begin
          if StrEql(ParamTypes[I], 'String') then
          begin
            Parameters[I].VType := vtAnsiString;
            Parameters[I].VAnsiString := Pointer(J);

            Types[I] := typeSTRING;
            Pointers[I] := Parameters[I].VAnsiString;
          end
          else if StrEql(ParamTypes[I], 'WideString') then
          begin
            Parameters[I].VType := vtWideString;
            Parameters[I].VWideString := Pointer(J);

            Types[I] := typeWIDESTRING;
            Pointers[I] := Parameters[I].VWideString;
          end
          else if StrEql(ParamTypes[I], 'Boolean') then
          begin
            Parameters[I].VType := vtBoolean;
            Parameters[I].VBoolean := Boolean(Byte(J));

            Types[I] := typeBOOLEAN;
            Pointers[I] := @ Parameters[I].VBoolean;
          end
          else if StrEql(ParamTypes[I], 'Word') then
          begin
            Parameters[I].VType := vtInteger;
            Parameters[I].VInteger := J;

            Types[I] := typeWORD;
            Pointers[I] := @ Parameters[I].VInteger;
          end
          else if StrEql(ParamTypes[I], 'Char') then
          begin
            Adjust(J);
            Parameters[I].VType := vtInteger;
            Parameters[I].VInteger := J;

            Types[I] := typeCHAR;
            Pointers[I] := @ Parameters[I].VInteger;
          end
          else if StrEql(ParamTypes[I], 'Variant') then
          begin
            Parameters[I].VType := vtVariant;
            if ByRef then
              PVariant(Parameters[I].VVariant) := PVariant(Ptrs[I + 1])
            else
              PVariant(Parameters[I].VVariant) := PVariant(J);

            Types[I] := typeVARIANT;
            Pointers[I] := Parameters[I].VVariant;
          end
          else
          begin
            Parameters[I].VType := vtInteger;
            Parameters[I].VInteger := J;

            Types[I] := typeINTEGER;
            Pointers[I] := @ Parameters[I].VInteger;
          end;
        end;
      end;
    end;

    if OverrideHandlerMode = 1 then
      if HostHandler.Code <> nil then
        BASE_CALL.Call(HostHandler.Code,
                       nil,
                       HostHandler.Data,
                       false,
                       _ccRegister,
                       Pointers,
                       Types,
                       ExtraTypes,
                       ByRefs,
                       Sizes,
                       false);

    PThis := @ This;

    R := TPAXBaseScripter(Scripter).CallMethod(SubID, This, Parameters, true);

    with TPAXBaseScripter(Scripter) do
    begin
      for I:=1 to SymbolTable.Count[SubID] do
      begin
        ParamID := SymbolTable.GetParamID(SubID, I);
        TypeID := SymbolTable.PType[ParamID];
        if SymbolTable.ByRef[ParamID] = 1 then
        begin
          V := SymbolTable.VariantValue[ParamID];
          if TypeID = typeBOOLEAN then
            PBoolean(Ptrs[I])^ := V
          else if TypeID = typeINTEGER then
          begin
            PInteger(Ptrs[I])^ := V;
          end
          else if TypeID = typeWORD then
            PWord(Ptrs[I])^ := V
          else if TypeID = typeSHORTINT then
            PShortInt(Ptrs[I])^ := V
          else if TypeID = typeSMALLINT then
            PSmallInt(Ptrs[I])^ := V
          else if TypeID = typeBYTE then
            PByte(Ptrs[I])^ := V
          //-- jgv
          else if TypeID = typeCHAR then begin // jgv
            s := v;
            PByte(Ptrs[i])^ := Byte(char(s[1]));
          end
          else if TypeID = typeDOUBLE then
          begin
            PDouble(Ptrs[I])^ := V;
          end
          else if TypeID = typeEXTENDED then
            PExtended(Ptrs[I])^ := V
          else if TypeID = typeSTRING then
          begin
            PString(Ptrs[I])^ := V;
          end
          else if TypeID = typeWIDESTRING then
          begin
            PWideString(Ptrs[I])^ := V;
          end
          else if TypeID = typeVARIANT then
          begin
            PVariant(Ptrs[I])^ := V;
          end
          else if (TypeID < 0) then
          begin
             if isObject(V) then
             begin
               PInteger(Ptrs[I])^ := Integer(VariantToScriptObject(V).Instance);
               VariantToScriptObject(V).RefCount := -1;

               continue;
             end;

            // It's a structure - we're already directly modifying it.  Don't write anything, but we do need to
            // clean up after ourselves..
            ClassRec := ClassList.FindClass(TypeID);
            if ClassRec <> nil then
            begin
              if ClassRec.ck = ckEnum then
                PByte(Ptrs[I])^ := V;
            end;
          end
          else
          begin
            if isObject(V) then
            begin
              PInteger(Ptrs[I])^ := Integer(VariantToScriptObject(V).Instance);
            end
            else
              PByte(Ptrs[I])^ := V;
          end;
        end;
      end;
    end;

    if OverrideHandlerMode = 2 then
      if HostHandler.Code <> nil then
        BASE_CALL.Call(HostHandler.Code,
                       nil,
                       HostHandler.Data,
                       false,
                       _ccRegister,
                       Pointers,
                       Types,
                       ExtraTypes,
                       ByRefs,
                       Sizes,
                       false);

  finally
    for I:=0 to CreatedRecords.Count - 1 do
    begin
      SO := TPaxScriptObject(CreatedRecords[I]);
      TPAXBaseScripter(SO.Scripter).ScriptObjectList.RemoveObject(SO);
    end;
    // We need to clean up after ourselves!!!
    CreatedRecords.Free;
  end;

  if Assigned(TPAXBaseScripter(Scripter).OnHalt) then
  if TPAXBaseScripter(Scripter).Code.SignHaltGlobal then
  begin
    TPAXBaseScripter(Scripter).OnHalt(TPAXBaseScripter(Scripter).Owner);
  end;
end;

procedure TPAXEventHandler.HandleEvent;
const
  LocalFrameSize = 28;
asm
  mov dword ptr Self._EAX, eax
  mov dword ptr Self._EDX, edx
  mov dword ptr Self._ECX, ecx
  mov dword ptr Self._P, esp

  push ebp
  mov ebp, esp

  sub esp, LocalFrameSize

  mov [ebp-12], ecx
  mov [ebp- 8], edx
  mov [ebp- 4], eax

  push eax
  call Invoke
  pop eax

  mov ecx, Self.RetSize

  mov esp, ebp
  pop ebp

  cmp ecx, 0

  jnz @@Ret4
  ret

@@Ret4:
  cmp ecx, 4
  jnz @@Ret8
  ret 4

@@Ret8:
  cmp ecx, 8
  jnz @@Ret12
  ret 8

@@Ret12:
  cmp ecx, $0c
  jnz @@Ret16
  ret $0c

@@Ret16:
  cmp ecx, $10
  jnz @@Ret20
  ret $10

@@Ret20:
  cmp ecx, $14
  jnz @@Ret24
  ret $14

@@Ret24:
  cmp ecx, $18
  jnz @@Ret28
  ret $18

@@Ret28:
  ret $1C
end;

end.