rm_jvinterpreter_sysutils.pas

这是一个功能强大

end;

{ function StrECopy(Dest, Source: PChar): PChar; }

procedure JvInterpreter_StrECopy(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := string(StrECopy(PChar(string(Args.Values[0])), PChar(string(Args.Values[1]))));
end;

{ function StrLCopy(Dest, Source: PChar; MaxLen: Cardinal): PChar; }

procedure JvInterpreter_StrLCopy(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := string(StrLCopy(PChar(string(Args.Values[0])), PChar(string(Args.Values[1])), Args.Values[2]));
end;

{ function StrPCopy(Dest: PChar; const Source: string): PChar; }

procedure JvInterpreter_StrPCopy(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := string(StrPCopy(PChar(string(Args.Values[0])), Args.Values[1]));
end;

{ function StrPLCopy(Dest: PChar; const Source: string; MaxLen: Cardinal): PChar; }

procedure JvInterpreter_StrPLCopy(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := string(StrPLCopy(PChar(string(Args.Values[0])), Args.Values[1], Args.Values[2]));
end;

{ function StrCat(Dest, Source: PChar): PChar; }

procedure JvInterpreter_StrCat(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := string(StrCat(PChar(string(Args.Values[0])), PChar(string(Args.Values[1]))));
end;

{ function StrLCat(Dest, Source: PChar; MaxLen: Cardinal): PChar; }

procedure JvInterpreter_StrLCat(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := string(StrLCat(PChar(string(Args.Values[0])), PChar(string(Args.Values[1])), Args.Values[2]));
end;

{ function StrComp(Str1, Str2: PChar): Integer; }

procedure JvInterpreter_StrComp(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := StrComp(PChar(string(Args.Values[0])), PChar(string(Args.Values[1])));
end;

{ function StrIComp(Str1, Str2: PChar): Integer; }

procedure JvInterpreter_StrIComp(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := StrIComp(PChar(string(Args.Values[0])), PChar(string(Args.Values[1])));
end;

{ function StrLComp(Str1, Str2: PChar; MaxLen: Cardinal): Integer; }

procedure JvInterpreter_StrLComp(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := StrLComp(PChar(string(Args.Values[0])), PChar(string(Args.Values[1])), Args.Values[2]);
end;

{ function StrLIComp(Str1, Str2: PChar; MaxLen: Cardinal): Integer; }

procedure JvInterpreter_StrLIComp(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := StrLIComp(PChar(string(Args.Values[0])), PChar(string(Args.Values[1])), Args.Values[2]);
end;

{ function StrScan(Str: PChar; Chr: Char): PChar; }

procedure JvInterpreter_StrScan(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := string(StrScan(PChar(string(Args.Values[0])), string(Args.Values[1])[1]));
end;

{ function StrRScan(Str: PChar; Chr: Char): PChar; }

procedure JvInterpreter_StrRScan(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := string(StrRScan(PChar(string(Args.Values[0])), string(Args.Values[1])[1]));
end;

{ function StrPos(Str1, Str2: PChar): PChar; }

procedure JvInterpreter_StrPos(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := string(StrPos(PChar(string(Args.Values[0])), PChar(string(Args.Values[1]))));
end;

{ function StrUpper(Str: PChar): PChar; }

procedure JvInterpreter_StrUpper(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := string(StrUpper(PChar(string(Args.Values[0]))));
end;

{ function StrLower(Str: PChar): PChar; }

procedure JvInterpreter_StrLower(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := string(StrLower(PChar(string(Args.Values[0]))));
end;

{ function StrPas(Str: PChar): string; }

procedure JvInterpreter_StrPas(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := StrPas(PChar(string(Args.Values[0])));
end;

{ function StrAlloc(Size: Cardinal): PChar; }

procedure JvInterpreter_StrAlloc(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := string(StrAlloc(Args.Values[0]));
end;

{ function StrBufSize(Str: PChar): Cardinal; }

procedure JvInterpreter_StrBufSize(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := Integer(StrBufSize(PChar(string(Args.Values[0]))));
end;

{ function StrNew(Str: PChar): PChar; }

procedure JvInterpreter_StrNew(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := string(StrNew(PChar(string(Args.Values[0]))));
end;

{ procedure StrDispose(Str: PChar); }

procedure JvInterpreter_StrDispose(var Value: Variant; Args: TJvInterpreterArgs);
begin
  StrDispose(PChar(string(Args.Values[0])));
end;

{ function Format(const Format: string; const Args: array of const): string; }

procedure JvInterpreter_Format(var Value: Variant; Args: TJvInterpreterArgs);

  function FormatWorkaround(const MyFormat: string; const Args: array of const): string;
  begin
    Result := Format(MyFormat, Args);
  end;

begin
  Args.OpenArray(1);
  Value := FormatWorkaround(Args.Values[0], Slice(Args.OA^, Args.OAS));
end;

{ procedure FmtStr(var Result: string; const Format: string; const Args: array of const); }

procedure JvInterpreter_FmtStr(var Value: Variant; Args: TJvInterpreterArgs);

  procedure FmtStrWorkaround(var Result: string; const Format: string; const Args: array of const);
  begin
    FmtStr(Result, Format, Args);
  end;

begin
  Args.OpenArray(2);
  FmtStrWorkaround(string(TVarData(Args.Values[0]).vString), Args.Values[1], Slice(Args.OA^, Args.OAS));
end;

{ function StrFmt(Buffer, Format: PChar; const Args: array of const): PChar; }

procedure JvInterpreter_StrFmt(var Value: Variant; Args: TJvInterpreterArgs);

  function StrFmtWorkaround(Buffer, Format: PChar; const Args: array of const): PChar;
  begin
    Result := StrFmt(Buffer, Format, Args);
  end;

begin
  Args.OpenArray(2);
  Value := string(StrFmtWorkaround(PChar(string(Args.Values[0])), PChar(string(Args.Values[1])), Slice(Args.OA^,
    Args.OAS)));
end;

{ function StrLFmt(Buffer: PChar; MaxLen: Cardinal; Format: PChar; const Args: array of const): PChar; }

procedure JvInterpreter_StrLFmt(var Value: Variant; Args: TJvInterpreterArgs);

  function StrLFmtWorkaround(Buffer: PChar; MaxLen: Cardinal; Format: PChar; const Args: array of const): PChar;
  begin
    Result := StrLFmt(Buffer, MaxLen, Format, Args);
  end;

begin
  Args.OpenArray(3);
  Value := string(StrLFmtWorkaround(PChar(string(Args.Values[0])), Args.Values[1], PChar(string(Args.Values[2])),
    Slice(Args.OA^, Args.OAS)));
end;

{ function FormatBuf(var Buffer; BufLen: Cardinal; const Format; FmtLen: Cardinal; const Args: array of const): Cardinal; }

procedure JvInterpreter_FormatBuf(var Value: Variant; Args: TJvInterpreterArgs);

  function FormatBufWorkaround(var Buffer; BufLen: Cardinal; const Format; FmtLen: Cardinal;
    const Args: array of const): Cardinal;
  begin
    Result := FormatBuf(Buffer, BufLen, Format, FmtLen, Args);
  end;

begin
  Args.OpenArray(4);
  Value := Integer(FormatBufWorkaround(Args.Values[0], Args.Values[1], Args.Values[2], Args.Values[3], Slice(Args.OA^,
    Args.OAS)));
end;

{ function FloatToStr(Value: Extended): string; }

procedure JvInterpreter_FloatToStr(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := FloatToStr(Args.Values[0]);
end;

{ function CurrToStr(Value: Currency): string; }

procedure JvInterpreter_CurrToStr(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := CurrToStr(Args.Values[0]);
end;

{ function FloatToStrF(Value: Extended; Format: TFloatFormat; Precision, Digits: Integer): string; }

procedure JvInterpreter_FloatToStrF(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := FloatToStrF(Args.Values[0], Args.Values[1], Args.Values[2], Args.Values[3]);
end;

{ function CurrToStrF(Value: Currency; Format: TFloatFormat; Digits: Integer): string; }

procedure JvInterpreter_CurrToStrF(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := CurrToStrF(Args.Values[0], Args.Values[1], Args.Values[2]);
end;

(*
{ function FloatToText(Buffer: PChar; const Value; ValueType: TFloatValue; Format: TFloatFormat; Precision, Digits: Integer): Integer; }
procedure JvInterpreter_FloatToText(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := FloatToText(PChar(string(Args.Values[0])), PChar(string(Args.Values[1])), Args.Values[2], Args.Values[3], Args.Values[4], Args.Values[5]);
end;
*)

{ function FormatFloat(const Format: string; Value: Extended): string; }

procedure JvInterpreter_FormatFloat(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := FormatFloat(Args.Values[0], Args.Values[1]);
end;

{ function FormatCurr(const Format: string; Value: Currency): string; }

procedure JvInterpreter_FormatCurr(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := FormatCurr(Args.Values[0], Args.Values[1]);
end;

(*
{ function FloatToTextFmt(Buffer: PChar; const Value; ValueType: TFloatValue; Format: PChar): Integer; }
procedure JvInterpreter_FloatToTextFmt(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := FloatToTextFmt(PChar(string(Args.Values[0])), PChar(string(Args.Values[1])), Args.Values[2], PChar(string(Args.Values[3])));
end;
*)

{ function StrToFloat(const S: string): Extended; }

procedure JvInterpreter_StrToFloat(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := StrToFloat(Args.Values[0]);
end;

{ function StrToCurr(const S: string): Currency; }

procedure JvInterpreter_StrToCurr(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := StrToCurr(Args.Values[0]);
end;

(*
{ function TextToFloat(Buffer: PChar; var Value; ValueType: TFloatValue): Boolean; }
procedure JvInterpreter_TextToFloat(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := TextToFloat(PChar(string(Args.Values[0])), PChar(string(Args.Values[1])), Args.Values[2]);
end;
*)
(* need record
{ procedure FloatToDecimal(var Result: TFloatRec; const Value; ValueType: TFloatValue; Precision, Decimals: Integer); }
procedure JvInterpreter_FloatToDecimal(var Value: Variant; Args: TJvInterpreterArgs);
begin
  FloatToDecimal(Args.Values[0], Args.Values[1], Args.Values[2], Args.Values[3], Args.Values[4]);
end;
*)

(* need record
{ function DateTimeToTimeStamp(DateTime: TDateTime): TTimeStamp; }
procedure JvInterpreter_DateTimeToTimeStamp(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := DateTimeToTimeStamp(Args.Values[0]);
end;

{ function TimeStampToDateTime(const TimeStamp: TTimeStamp): TDateTime; }
procedure JvInterpreter_TimeStampToDateTime(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := TimeStampToDateTime(Args.Values[0]);
end;

{ function MSecsToTimeStamp(MSecs: Comp): TTimeStamp; }
procedure JvInterpreter_MSecsToTimeStamp(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := MSecsToTimeStamp(Args.Values[0]);
end;

{ function TimeStampToMSecs(const TimeStamp: TTimeStamp): Comp; }
procedure JvInterpreter_TimeStampToMSecs(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := TimeStampToMSecs(Args.Values[0]);
end;
*)

{ function EncodeDate(Year, Month, Day: Word): TDateTime; }

procedure JvInterpreter_EncodeDate(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := EncodeDate(Args.Values[0], Args.Values[1], Args.Values[2]);
end;

{ function EncodeTime(Hour, Min, Sec, MSec: Word): TDateTime; }

procedure JvInterpreter_EncodeTime(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := EncodeTime(Args.Values[0], Args.Values[1], Args.Values[2], Args.Values[3]);
end;

{ procedure DecodeDate(Date: TDateTime; var Year, Month, Day: Word); }

procedure JvInterpreter_DecodeDate(var Value: Variant; Args: TJvInterpreterArgs);
var
  Year, Month, Day: Word;
begin
  DecodeDate(Args.Values[0], Year, Month, Day);
  Args.Values[1] := Year;
  Args.Values[2] := Month;
  Args.Values[3] := Day;
end;

{ procedure DecodeTime(Time: TDateTime; var Hour, Min, Sec, MSec: Word); }

procedure JvInterpreter_DecodeTime(var Value: Variant; Args: TJvInterpreterArgs);
var
  Hour, Min, Sec, MSec: Word;
begin
  DecodeTime(Args.Values[0], Hour, Min, Sec, MSec);
  Args.Values[1] := Hour;
  Args.Values[2] := Min;
  Args.Values[3] := Sec;
  Args.Values[4] := MSec;
end;

(* need record
{ procedure DateTimeToSystemTime(DateTime: TDateTime; var SystemTime: TSystemTime); }
procedure JvInterpreter_DateTimeToSystemTime(var Value: Variant; Args: TJvInterpreterArgs);
begin
  DateTimeToSystemTime(Args.Values[0], Args.Values[1]);
end;

{ function SystemTimeToDateTime(const SystemTime: TSystemTime): TDateTime; }
procedure JvInterpreter_SystemTimeToDateTime(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := SystemTimeToDateTime(Args.Values[0]);
end;
*)

{ function DayOfWeek(Date: TDateTime): Integer; }

procedure JvInterpreter_DayOfWeek(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := DayOfWeek(Args.Values[0]);
end;

{ function Date: TDateTime; }

procedure JvInterpreter_Date(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := Date;