imp_sysutils.pas

Delphi脚本控件

{$IFDEF VER140}
  {$DEFINE Delphi6_UP}
{$ENDIF}

{$IFDEF VER150}
  {$DEFINE Delphi6_UP}
{$ENDIF}

unit IMP_sysutils;
interface
uses
  Windows,
  SysConst,
  sysutils,
{$IFDEF Delphi6_UP}
  Variants,
{$ENDIF}
  BASE_EXTERN,
  PaxScripter;
procedure RegisterIMP_sysutils;
implementation

procedure _FileRead(MethodBody: TPAXMethodBody);
var
  H, Count, VT: Integer;
  V: Variant;
  S: String;
  P: Pointer;
begin
  with MethodBody do
  begin
    H := Params[0].AsVariant;
    V := Params[1].AsVariant;
    P := Pointer(Integer(@V) + 8);
    Count := Params[2].AsVariant;
    VT := VarType(V);
    case VT of
      varString:
      begin
        P := AllocMem(Count + 1);
        FillChar(P^, Count + 1, 0);
        try
          Result.AsInteger := FileRead(H, P^, Count);
        finally
          S := String(Pchar(P));
          FreeMem(P, Count + 1);
        end;
        Params[1].AsVariant := S;
      end;
      varVariant:
      begin
        Result.AsInteger := FileRead(H, V, Count);
        Params[1].AsVariant := V;
      end;
      else
      begin
        Result.AsInteger := FileRead(H, P^, Count);
        Params[1].AsVariant := V;
      end;
    end;
  end;
end;

procedure _FileWrite(MethodBody: TPAXMethodBody);
var
  H, Count, VT: Integer;
  V: Variant;
  I: Integer;
  D: Double;
  B: Boolean;
  S: String;
begin
  with MethodBody do
  begin
    H := Params[0].AsVariant;
    V := Params[1].AsVariant;
    Count := Params[2].AsVariant;
    VT := VarType(V);
    case VT of
      varInteger:
      begin
        I := V;
        Result.AsInteger := FileWrite(H, I, Count);
      end;
      varDouble:
      begin
        D := V;
        Result.AsInteger := FileWrite(H, D, Count);
      end;
      varBoolean:
      begin
        B := V;
        Result.AsInteger := FileWrite(H, B, Count);
      end;
      varString:
      begin
        S := V;
        Result.AsInteger := FileWrite(H, Pointer(S)^, Count);
      end;
      varVariant:
      begin
        V := V;
        Result.AsInteger := FileWrite(H, V, Count);
      end;
    end;
  end;
end;

function TLanguages_ReadCount:Integer;
begin
  result := TLanguages(_Self).Count;
end;
function TLanguages_ReadName(Index: Integer):String;
begin
  result := TLanguages(_Self).Name[Index];
end;
function TLanguages_ReadNameFromLocaleID(ID: LCID):String;
begin
  result := TLanguages(_Self).NameFromLocaleID[ID];
end;
function TLanguages_ReadNameFromLCID(const ID: string):String;
begin
  result := TLanguages(_Self).NameFromLCID[ID];
end;
function TLanguages_ReadID(Index: Integer):String;
begin
  result := TLanguages(_Self).ID[Index];
end;
function TLanguages_ReadLocaleID(Index: Integer):LCID;
begin
  result := TLanguages(_Self).LocaleID[Index];
end;
function TLanguages_ReadExt(Index: Integer):String;
begin
  result := TLanguages(_Self).Ext[Index];
end;
function Exception_ReadHelpContext:Integer;
begin
  result := Exception(_Self).HelpContext;
end;
procedure Exception_WriteHelpContext(const Value: Integer);
begin
  Exception(_Self).HelpContext := Value;
end;
function Exception_ReadMessage:String;
begin
  result := Exception(_Self).Message;
end;
procedure Exception_WriteMessage(const Value: String);
begin
  Exception(_Self).Message := Value;
end;
procedure _StringReplace(MethodBody: TPAXMethodBody);
var
  Flags: TReplaceFlags;
begin
  with MethodBody do
  begin
    Flags := [];
    result.AsString := StringReplace(Params[0].AsString, Params[1].AsString, Params[2].AsString, Flags);
  end;
end;

procedure RegisterIMP_sysutils;
var H: Integer;
begin
  H := RegisterNamespace('sysutils', -1);
  RegisterConstant('FmOpenRead', $0000, H);
  RegisterConstant('FmOpenWrite', $0001, H);
  RegisterConstant('FmOpenReadWrite', $0002, H);
  RegisterConstant('FmShareCompat', $0000, H);
  RegisterConstant('FmShareExclusive', $0010, H);
  RegisterConstant('FmShareDenyWrite', $0020, H);
  RegisterConstant('FmShareDenyRead', $0030, H);
  RegisterConstant('FmShareDenyNone', $0040, H);
  RegisterConstant('FaReadOnly', $00000001, H);
  RegisterConstant('FaHidden', $00000002, H);
  RegisterConstant('FaSysFile', $00000004, H);
  RegisterConstant('FaVolumeID', $00000008, H);
  RegisterConstant('FaDirectory', $00000010, H);
  RegisterConstant('FaArchive', $00000020, H);
  RegisterConstant('FaAnyFile', $0000003F, H);
  RegisterConstant('FmClosed', $D7B0, H);
  RegisterConstant('FmInput', $D7B1, H);
  RegisterConstant('FmOutput', $D7B2, H);
  RegisterConstant('FmInOut', $D7B3, H);
  RegisterConstant('DateDelta', 693594, H);
  RegisterRTTIType(TypeInfo(TFloatValue));
  RegisterRTTIType(TypeInfo(TFloatFormat));
  RegisterRTTIType(TypeInfo(TMbcsByteType));
  // Begin of class TLanguages
  RegisterClassType(TLanguages, H);
  RegisterMethod(TLanguages,
       'constructor Create;',
       @TLanguages.Create);
  RegisterMethod(TLanguages,
       'function IndexOf(ID: LCID): Integer;',
       @TLanguages.IndexOf);
  RegisterMethod(TLanguages,
       'function TLanguages_ReadCount:Integer;',
       @TLanguages_ReadCount, Fake);