h_sysut.pas

一个Delphi解释器的例子

unit h_sysut;

interface
Uses SysUtils,Delphin;
implementation
{------------------------------}
function myFormat(slf:TObject;var APropName:String;var s:array of variant):variant;
var T:Array[0..50] of tvarrec;
    maxt:Integer;
begin
VarToConsts(S[1],T,maxt);
Result:=Format(s[0],Slice(t,maxt));
DisposeConsts(T,maxt);
end;
{------------------------------}
function myupper(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
Result:=ansiuppercase(s[0]);
end;
{------------------------------}
function mylower(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
Result:=ansilowercase(s[0]);
end;
{------------------------------}
function myIntToHex(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
Result:=IntToHex(s[0],s[1]);
end;
{------------------------------}
function MyIntToStr(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
Result:=IntToStr(s[0]);
end;
{------------------------------}
function MyFloatToStr(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
Result:=FloatToStr(s[0]);
end;
{------------------------------}
function MyAnsiComparStr(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
  Result := AnsiCompareStr(s[0],s[1]);
end;
{------------------------------}
function MyAnsiCompareText(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
  Result := AnsiCompareText(s[0],s[1]);
end;
{------------------------------}
function MyTrim(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
  Result := Trim(s[0]);
end;
{------------------------------}
function MyTrimLeft(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
  Result := TrimLeft(s[0]);
end;
{------------------------------}
function MyTrimRight(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
  Result := TrimRight(s[0]);
end;
{------------------------------}
function MyVal(slf:TObject;var APropName:String;var s:array of variant):variant;
var St: string; Code: integer; V: Double;
begin
  St := s[0];
  Val(St, v, Code);
  if frac(V) = 0 then S[1] := Trunc(V)
  else S[1] := V;
  s[2] := Code;
end;
{------------------------------}
function MyDate(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
  result := Date;
end;
{------------------------------}
function MyTime(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
  result := Time;
end;
{------------------------------}
function MyNow(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
  result := Now;
end;
{------------------------------}
function MyStrToDate(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
  result := StrToDate(s[0]);
end;
{------------------------------}
function MyDateToStr(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
  if VarType(S[0]) = varString then result := DateToStr(StrToDate(s[0]))
  else result := DateToStr(s[0]);
end;
{------------------------------}
function MyDecodeDate(slf:TObject;var APropName:String;var s:array of variant):variant;
var Date: TDateTime; Year, Month, Day: Word;
begin
  if VarType(S[0]) = varString then Date := StrToDate(s[0])
  else Date := s[0];
  Year := s[1];
  Month := s[2];
  Day := s[3];
  DecodeDate(Date, Year, Month, Day);
  s[1] := Year;
  s[2] := Month;
  s[3] := Day;
end;
{------------------------------}
function MyEncodeDate(slf:TObject;var APropName:String;var s:array of variant):variant;
//var D : TDateTime;
begin
  Result :=EncodeDate(s[0],s[1],s[2]);
end;
{------------------------------}
function MyFormatDateTime(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
  if VarType(S[1]) = varString then s[1] := StrToDate(s[1]);
  Result := FormatDateTime(s[0],s[1]);
end;
{------------------------------}
function MyStrToInt(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
  result := StrToInt(s[0]);
end;
{------------------------------}
function MyStrToFloat(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
  result := StrToFloat(s[0]);
end;
{------------------------------}
function MyFormatFloat(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
  result := FormatFloat(s[0],S[1]);
end;
{------------------------------}
procedure InitSysUtils;
begin
AddFun('IntToHex'        ,MyIntToHex,[0,0]);
AddFun('IntToStr'        ,MyIntToStr,[0]);
AddFun('Format'          ,myFormat,[0,3]);
AddFun('AnsiUpperCase'   ,MyUpper,[0]);
AddFun('AnsiLowerCase'   ,MyLower,[0]);
AddFun('FloatToStr'      ,MyFloatToStr,[0]);
AddFun('AnsiCompareStr'  ,MyAnsiComparStr,[0,0]);
AddFun('AnsiCompareText' ,MyAnsiCompareText,[0,0]);
AddFun('Trim'            ,MyTrim,[0]);
AddFun('TrimLeft'        ,MyTrimLeft,[0]);
AddFun('TrimRight'       ,MyTrimRight,[0]);
AddProc('Val'            ,MyVal, [0,1,1]);
AddFun('Date'            ,MyDate, [2]);
AddFun('Time'            ,MyTime, [2]);
AddFun('Now'             ,MyNow, [2]);
AddFun('StrToDate'       ,MyStrToDate, [0]);
AddFun('DateToStr'       ,MyDateToStr, [0]);
AddProc('DecodeDate'     ,MyDecodeDate, [0,1,1,1]);
AddFun('EncodeDate'      ,MyEncodeDate, [0,0,0]);
AddFun('FormatDateTime'  ,MyFormatDateTime, [0,0]);
AddFun('StrToInt'        ,MyStrToInt, [0]);
AddFun('StrToFloat'      ,MyStrToFloat, [0]);
AddFun('FormatFloat'     ,MyFormatFloat,[0,0]);

end;

initialization InitSysUtils;

end.