Chip 1999 March/Chip_1999-03_cd.bin/zkuste/delphi/D234C13/RALIB.ZIP/RALib/Lib/RAIExpr.pas

Pascal/Delphi Source File | 1998-08-15 | 6KB | 202 lines

{***********************************************************
                R&A Library
       Copyright (C) 1996-98 R&A

       description : R&A interpretator

       programer   : black
       e-mail      : [e-mail]
       www         : www.chat.ru\~blacknbs\ralib
************************************************************}

{$INCLUDE RA.INC}

unit RAIExpr;
{
 ╠εΣ≤δⁿ ±Γ τ√Γασ≥ Γ±σ ∞εΣ≤δΦ Φφ≥σ≡∩≡σ≥α≥ε≡α, α ≥αΩµσ
 ≡σαδΦτ≤σ≥ ≡ Σ ⌠≤φΩ÷ΦΘ Σδ  ±ετΣαφΦ  ²Ωτσ∞∩δ ≡εΓ εß·σΩ≥εΓ,
 ±εΓ∞σ±≥Φ∞√⌡ ± Φφ≥σ≡⌠σΘ±α∞Φ Γ Intf.
}

interface
{$IFNDEF DLL}
  { $DEFINE USEDLL}
{$ENDIF}

  uses Windows,
{$IFDEF USEDLL}
  RAIIntf;
{$ELSE}
  SysUtils,
  RAIClas, RAIProg, RAISystem, RAIIntf, RAIProc;
{$ENDIF}

  function InterVersion : word; export;

  {╘≤φΩ÷ΦΦ ∩εΣΣσ≡µΩΦ Φφ≥σ≡⌠σΘ±εΓ - helpers }
  procedure IIValueAssign(Dest, Source : IIValue); export;
  function IIValueIsConstant(AIValue : IIValue) : boolean; export;
  function IIValueIsReal(AIValue : IIValue) : boolean; export;
  function IIValueIsInteger(AIValue : IIValue) : boolean; export;
  procedure IIValueSetStr(AIValue : IIValue; S : iString); export;
  procedure IIValueGetStr(AIValue : IIValue; var S : string); export;
  function HasIntf(Unknown : IUnknown; const GUID : TGUID) : boolean; export;
  function GetIntf(Unknown : IUnknown; const GUID : TGUID) : IUnknown; export;

  procedure ProgRun(IInterObject : IIInterObject); export;
  procedure ProgGetBlockByPos(pcProgram : iString; const Pos : integer; var PosBeg, PosEnd : integer); export;

  function CreateInterObject(const IID : TGUID; out Obj{: IUnknown}) : HResult; export;
  function Cmp(Str1, Str2 : iString) : boolean; export;

 {$IFDEF DEBUG}
  function GlobalObjCount : integer; export;
  function GlobalRefCount : integer; export;
{$ENDIF}

  function HiddenError(const ErrCode : integer) : boolean;

implementation

const
  Version = 35; {Γσ≡±Φ  Φφ≥σ≡∩≡σ≥α≥ε≡α = 0.35}


{$IFDEF USEDLL}
const
  Inter = 'RAInter.Dll';

  function InterVersion : word; external Inter;

  procedure IIValueAssign(Dest, Source : IIValue); external Inter;
  function IIValueIsConstant(AIValue : IIValue) : boolean; external Inter;
  function IIValueIsReal(AIValue : IIValue) : boolean; external Inter;
  function IIValueIsInteger(AIValue : IIValue) : boolean; external Inter;
  procedure IIValueSetStr(AIValue : IIValue; S : iString); external Inter;
//  procedure IIValueGetStr(AIValue : IIValue; var S : string); external Inter;
  function HasIntf(Unknown : IUnknown; const GUID : TGUID) : boolean; external Inter;
  function GetIntf(Unknown : IUnknown; const GUID : TGUID) : IUnknown; external Inter;

  procedure ProgRun(IInterObject : IIInterObject); external Inter;
  procedure ProgGetBlockByPos(pcProgram : iString; const Pos : integer; var PosBeg, PosEnd : integer); external Inter;


  function CreateInterObject(const IID : TGUID; out Obj{: IUnknown}) : HResult; external Inter;
  function Cmp(Str1, Str2 : iString) : boolean; external Inter;


{$IFDEF DEBUG}
  function GlobalObjCount : integer; external Inter;
  function GlobalRefCount : integer; external Inter;
{$ENDIF}

{$ELSE}

procedure ProgRun(IInterObject : IIInterObject);
var
  Programa : TInter;
begin
  Programa := TInter.Create;
  try
    Programa.Run(IInterObject);
  finally
    IUnknown(Programa)._Release;
  end;
end;

{************************ ╘≤φΩ÷ΦΦ ∩εΣΣσ≡µΩΦ IIValue ************************}
procedure IIValueAssign(Dest, Source : IIValue);
begin
  RAIClas.IIValueAssign(Dest, Source);
end;

function IIValueIsConstant(AIValue : IIValue) : boolean;
begin
  Result := RAIClas.IIValueIsConstant(AIValue);
end;

function IIValueIsReal(AIValue : IIValue) : boolean;
begin
  Result := RAIClas.IIValueIsReal(AIValue);
end;

function IIValueIsInteger(AIValue : IIValue) : boolean;
begin
  Result := RAIClas.IIValueIsInteger(AIValue);
end;

procedure IIValueSetStr(AIValue : IIValue; S : iString);
begin
  RAIClas.IIValueSetStr(AIValue, S);
end;

procedure IIValueGetStr(AIValue : IIValue; var S : string);
begin
  RAIClas.IIValueGetStr(AIValue, S);
end;
{######################## ╘≤φΩ÷ΦΦ ∩εΣΣσ≡µΩΦ IIValue ########################}

function HasIntf(Unknown : IUnknown; const GUID : TGUID) : boolean;
begin
  Result := RAIClas.HasIntf(Unknown, GUID);
end;

function GetIntf(Unknown : IUnknown; const GUID : TGUID) : IUnknown;
begin
  Result := RAIClas.GetIntf(Unknown, GUID);
end;

function CreateInterObject(const IID : TGUID; out Obj) : HResult;
  function G{GuidIs}(const GUID : TGUID) : boolean;
  begin
    Result := CompareMem(@IID, @GUID, sizeof(TGUID));{IsEqualGUID(IID, GUID)}
  end;
begin
  Result := S_OK;
  if G(IID_IIValue)        then IUnknown(Obj) := IIValue(TIValue.Create0)
  else if G(IID_IIInter)   then IUnknown(Obj) := IIInter(TInter.Create)
  else if G(IID_ISystem)   then IUnknown(Obj) := IIObject(TISystem.Create)
  else if G(IID_ISysUtils) then IUnknown(Obj) := IIObject(TISysUtils.Create)
 {$IFDEF RAINTER_OLEAUTO}
  else if G(IID_IOleAuto)  then IUnknown(Obj) := IIObject(TIOleAuto.Create)
 {$ENDIF RAINTER_OLEAUTO}
  else Result := E_INVALIDARG;

  if Result = S_OK then IUnknown(Obj)._Release;
end;

function Cmp(Str1, Str2 : iString) : boolean;
begin
  Result := ANSICompareText(Str1, Str2) = 0;
end;

{$IFDEF DEBUG}
function GlobalObjCount : integer;
begin
  Result := RAIClas.GlobalObjCount;
end;

function GlobalRefCount : integer;
begin
  Result := RAIClas.GlobalRefCount;
end;
{$ENDIF}

function InterVersion : word;
begin
  Result := Version;
end;

procedure ProgGetBlockByPos(pcProgram : iString; const Pos : integer; var PosBeg, PosEnd : integer);
begin
  RAIProc.GetBlockByPos(pcProgram, Pos, PosBeg, PosEnd);
end;
{$ENDIF}

function HiddenError(const ErrCode : integer) : boolean;
begin
  Result := RAIClas.HiddenError(ErrCode);
end;

end.