rm_jvinterpreter_sysutils.pas

这是一个功能强大

{-----------------------------------------------------------------------------
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: rm_JvInterpreter_SysUtils.PAS, released on 2002-07-04.

The Initial Developers of the Original Code are: Andrei Prygounkov <a dott prygounkov att gmx dott de>
Copyright (c) 1999, 2002 Andrei Prygounkov
All Rights Reserved.

Contributor(s):

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 rm_JvInterpreter calls to delphi calls

Known Issues:
-----------------------------------------------------------------------------}
// $Id: rm_JvInterpreter_SysUtils.pas 10259 2006-02-14 14:17:52Z ahuser $

unit rm_JvInterpreter_SysUtils;

{$I rm_jvcl.inc}
{$I rm_crossplatform.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  rm_JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  SysUtils,
  rm_JvInterpreter;

procedure RegisterJvInterpreterAdapter(JvInterpreterAdapter: TJvInterpreterAdapter);

function SearchRec2Var(const SearchRec: TSearchRec): Variant;
function Var2SearchRec(const SearchRec: Variant): TSearchRec;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile$';
    Revision: '$Revision: 10259 $';
    Date: '$Date: 2006-02-14 06:17:52 -0800 (Tue, 14 Feb 2006) $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  {$IFDEF HAS_UNIT_VARIANTS}
  Variants,
  {$ENDIF HAS_UNIT_VARIANTS}
  rm_JvJCLUtils;

{ 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;

{$IFDEF COMPILER5}

{ 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 COMPILER5}

{ 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; }

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

{ 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;

{ 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;

{ function Trim(const S: string): string; }