rm_jvinterpreter_sysutils.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 1,672 行 · 第 1/5 页

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html
Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.
The Original Code is: JvInterpreter_SysUtils.PAS, released on 2002-07-04.
The Initial Developers of the Original Code are: Andrei Prygounkov <[e-mail]>
Copyright (c) 1999, 2002 Andrei Prygounkov
All Rights Reserved.
Contributor(s):
Last Modified: 2002-07-04
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net
Description : adapter unit - converts JvInterpreter calls to delphi calls
Known Issues:
-----------------------------------------------------------------------------}
{$I rm_JVCL.INC}
{$I rm_WINDOWSONLY.INC}
unit rm_JvInterpreter_SysUtils;
interface
uses
  SysUtils,
  rm_JvInterpreter, rm_JvStrUtils;
procedure RegisterJvInterpreterAdapter(JvInterpreterAdapter: TJvInterpreterAdapter);
function SearchRec2Var(const SearchRec: TSearchRec): Variant;
function Var2SearchRec(const SearchRec: Variant): TSearchRec;
implementation
{$IFDEF LINUX}
uses
  Variants;
{$ENDIF}
{ TSearchRec }

function SearchRec2Var(const SearchRec: TSearchRec): Variant;
var
  Rec: ^TSearchRec;
begin
  New(Rec);
  Rec^ := SearchRec;
  Result := R2V('TSearchRec', Rec);
end;

function Var2SearchRec(const SearchRec: Variant): TSearchRec;
begin
  Result := TSearchRec(V2R(SearchRec)^);
end;
{ Exception }
{ constructor Create(Msg: string) }

procedure Exception_Create(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := O2V(Exception.Create(Args.Values[0]));
end;
{ constructor CreateFmt(Msg: string; Args: array) }

procedure Exception_CreateFmt(var Value: Variant; Args: TJvInterpreterArgs);
begin
//  Value := O2V(Exception.CreateFmt(Args.Values[0], Args.Values[1]));
  NotImplemented('Exception.CreateFmt');
end;
{ constructor CreateRes(Ident: Integer) }

procedure Exception_CreateRes(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := O2V(Exception.CreateRes(Args.Values[0]));
end;
{ constructor CreateResFmt(Ident: Integer; Args: array) }

procedure Exception_CreateResFmt(var Value: Variant; Args: TJvInterpreterArgs);
begin
//  Value := O2V(Exception.CreateResFmt(Args.Values[0], Args.Values[1]));
  NotImplemented('Exception.CreateResFmt');
end;
{ constructor CreateHelp(Msg: string; AHelpContext: Integer) }

procedure Exception_CreateHelp(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := O2V(Exception.CreateHelp(Args.Values[0], Args.Values[1]));
end;
{ constructor CreateFmtHelp(Msg: string; Args: array; AHelpContext: Integer) }

procedure Exception_CreateFmtHelp(var Value: Variant; Args: TJvInterpreterArgs);
begin
//  Value := O2V(Exception.CreateFmtHelp(Args.Values[0], Args.Values[1], Args.Values[2]));
  NotImplemented('Exception.CreateFmtHelp');
end;
{ constructor CreateResHelp(Ident: Integer; AHelpContext: Integer) }

procedure Exception_CreateResHelp(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := O2V(Exception.CreateResHelp(Args.Values[0], Args.Values[1]));
end;
{ constructor CreateResFmtHelp(Ident: Integer; Args: array; AHelpContext: Integer) }

procedure Exception_CreateResFmtHelp(var Value: Variant; Args: TJvInterpreterArgs);
begin
//  Value := O2V(Exception.CreateResFmtHelp(Args.Values[0], Args.Values[1], Args.Values[2]));
  NotImplemented('Exception.CreateResFmtHelp');
end;
{ property Read HelpContext: Integer }

procedure Exception_Read_HelpContext(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := Exception(Args.Obj).HelpContext;
end;
{ property Write HelpContext(Value: Integer) }

procedure Exception_Write_HelpContext(const Value: Variant; Args: TJvInterpreterArgs);
begin
  Exception(Args.Obj).HelpContext := Value;
end;
{ property Read Message: string }

procedure Exception_Read_Message(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := Exception(Args.Obj).Message;
end;
{ property Write Message(Value: string) }

procedure Exception_Write_Message(const Value: Variant; Args: TJvInterpreterArgs);
begin
  Exception(Args.Obj).Message := Value;
end;
{ EAbort }
{ EOutOfMemory }
{ EInOutError }
{ EIntError }
{ EDivByZero }
{ ERangeError }
{ EIntOverflow }
{ EMathError }
{ EInvalidOp }
{ EZeroDivide }
{ EOverflow }
{ EUnderflow }
{ EInvalidPointer }
{ EInvalidCast }
{ EConvertError }
{ EAccessViolation }
{ EPrivilege }
{ EStackOverflow }
{ EControlC }
{ EVariantError }
{ EPropReadOnly }
{ EPropWriteOnly }
{ EExternalException }
{ EAssertionFailed }
{ EAbstractError }
{ EIntfCastError }
{ EInvalidContainer }
{ EInvalidInsert }
{ EPackageError }
{ EWin32Error }
{ function AllocMem(Size: Cardinal): Pointer; }

procedure JvInterpreter_AllocMem(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := P2V(AllocMem(Args.Values[0]));
end;
{$IFNDEF COMPILER6_UP}
{ function NewStr(const S: string): PString; }

procedure JvInterpreter_NewStr(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := P2V(NewStr(Args.Values[0]));
end;
{ procedure DisposeStr(P: PString); }

procedure JvInterpreter_DisposeStr(var Value: Variant; Args: TJvInterpreterArgs);
begin
  DisposeStr(V2P(Args.Values[0]));
end;
{ procedure AssignStr(var P: PString; const S: string); }

procedure JvInterpreter_AssignStr(var Value: Variant; Args: TJvInterpreterArgs);
begin
  AssignStr(PString(TVarData(Args.Values[0]).vPointer), Args.Values[1]);
end;
{ procedure AppendStr(var Dest: string; const S: string); }

procedure JvInterpreter_AppendStr(var Value: Variant; Args: TJvInterpreterArgs);
begin
  AppendStr(string(TVarData(Args.Values[0]).vString), Args.Values[1]);
end;
{$ENDIF COMPILER6_UP}
{ function UpperCase(const S: string): string; }

procedure JvInterpreter_UpperCase(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := UpperCase(Args.Values[0]);
end;
{ function LowerCase(const S: string): string; }

procedure JvInterpreter_LowerCase(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := LowerCase(Args.Values[0]);
end;
{ function CompareStr(const S1, S2: string): Integer; }

procedure JvInterpreter_CompareStr(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := CompareStr(Args.Values[0], Args.Values[1]);
end;
{ function CompareMem(P1, P2: Pointer; Length: Integer): Boolean; }
{$IFDEF COMPILER3_UP}

procedure JvInterpreter_CompareMem(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := CompareMem(V2P(Args.Values[0]), V2P(Args.Values[1]), Args.Values[2]);
end;
{$ENDIF COMPILER3_UP}
{ function CompareText(const S1, S2: string): Integer; }

procedure JvInterpreter_CompareText(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := CompareText(Args.Values[0], Args.Values[1]);
end;
{ function ExtractQuotedString(s: string; Quote: Char): string; }

procedure JvInterpreter_ExtractQuotedString(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := ExtractQuotedString(Args.Values[0], string(Args.Values[1])[1]);
end;
{ function AnsiUpperCase(const S: string): string; }

procedure JvInterpreter_AnsiUpperCase(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := AnsiUpperCase(Args.Values[0]);
end;
{ function AnsiLowerCase(const S: string): string; }

procedure JvInterpreter_AnsiLowerCase(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := AnsiLowerCase(Args.Values[0]);
end;
{ function AnsiCompareStr(const S1, S2: string): Integer; }

procedure JvInterpreter_AnsiCompareStr(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := AnsiCompareStr(Args.Values[0], Args.Values[1]);
end;
{ function AnsiCompareText(const S1, S2: string): Integer; }

procedure JvInterpreter_AnsiCompareText(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := AnsiCompareText(Args.Values[0], Args.Values[1]);
end;
{$IFDEF COMPILER3_UP}
{ function AnsiStrComp(S1, S2: PChar): Integer; }

procedure JvInterpreter_AnsiStrComp(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := AnsiStrComp(PChar(string(Args.Values[0])), PChar(string(Args.Values[1])));
end;
{ function AnsiStrIComp(S1, S2: PChar): Integer; }

procedure JvInterpreter_AnsiStrIComp(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := AnsiStrIComp(PChar(string(Args.Values[0])), PChar(string(Args.Values[1])));
end;
{ function AnsiStrLComp(S1, S2: PChar; MaxLen: Cardinal): Integer; }

procedure JvInterpreter_AnsiStrLComp(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := AnsiStrLComp(PChar(string(Args.Values[0])), PChar(string(Args.Values[1])), Args.Values[2]);
end;
{ function AnsiStrLIComp(S1, S2: PChar; MaxLen: Cardinal): Integer; }

procedure JvInterpreter_AnsiStrLIComp(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := AnsiStrLIComp(PChar(string(Args.Values[0])), PChar(string(Args.Values[1])), Args.Values[2]);
end;
{ function AnsiStrLower(Str: PChar): PChar; }

procedure JvInterpreter_AnsiStrLower(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := string(AnsiStrLower(PChar(string(Args.Values[0]))));
end;
{ function AnsiStrUpper(Str: PChar): PChar; }

procedure JvInterpreter_AnsiStrUpper(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := string(AnsiStrUpper(PChar(string(Args.Values[0]))));
end;
{ function AnsiLastChar(const S: string): PChar; }

procedure JvInterpreter_AnsiLastChar(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := string(AnsiLastChar(Args.Values[0]));
end;
{ function AnsiStrLastChar(P: PChar): PChar; }

procedure JvInterpreter_AnsiStrLastChar(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := string(AnsiStrLastChar(PChar(string(Args.Values[0]))));
end;
{$ENDIF COMPILER3_UP}
{ function Trim(const S: string): string; }

procedure JvInterpreter_Trim(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := Trim(Args.Values[0]);
end;
{ function TrimLeft(const S: string): string; }

procedure JvInterpreter_TrimLeft(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := TrimLeft(Args.Values[0]);
end;
{ function TrimRight(const S: string): string; }

procedure JvInterpreter_TrimRight(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := TrimRight(Args.Values[0]);
end;
{ function QuotedStr(const S: string): string; }

procedure JvInterpreter_QuotedStr(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := QuotedStr(Args.Values[0]);
end;
{$IFDEF COMPILER3_UP}
{ function AnsiQuotedStr(const S: string; Quote: Char): string; }

procedure JvInterpreter_AnsiQuotedStr(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := AnsiQuotedStr(Args.Values[0], string(Args.Values[1])[1]);
end;
{ function AnsiExtractQuotedStr(var Src: PChar; Quote: Char): string; }

procedure JvInterpreter_AnsiExtractQuotedStr(var Value: Variant; Args: TJvInterpreterArgs);
begin