home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 March / Chip_1999-03_cd.bin / zkuste / delphi / D234C13 / RALIB.ZIP / RALib / Lib / RAIIntf.pas < prev    next >
Pascal/Delphi Source File  |  1998-08-03  |  13KB  |  337 lines
  1. {***********************************************************
  2.                 R&A Library
  3.        Copyright (C) 1996-98 R&A
  4.  
  5.        description : R&A interpreter
  6.  
  7.        programer   : black
  8.        e-mail      : blacknbs@chat.ru
  9.        www         : www.chat.ru\~blacknbs\ralib
  10. ************************************************************}
  11.  
  12. {$INCLUDE RA.INC}
  13.  
  14. unit RAIIntf;
  15.  
  16. { RAInter interfaces }
  17.  
  18. interface
  19.  
  20. const
  21. { Inter GUIDs }
  22.   IID_IIObject      : TGUID = '{8C6BA261-08FC-11d1-BA5A-F44E9C5EF10B}';
  23.   IID_IIValue       : TGUID = '{8C6BA262-08FC-11d1-BA5A-F44E9C5EF10B}';
  24.   IID_IIVar         : TGUID = '{8C6BA263-08FC-11d1-BA5A-F44E9C5EF10B}';
  25.   IID_IIArgs        : TGUID = '{8C6BA264-08FC-11d1-BA5A-F44E9C5EF10B}';
  26.   IID_IIInterObject : TGUID = '{8C6BA265-08FC-11d1-BA5A-F44E9C5EF10B}';
  27.   IID_IIDebugObject : TGUID = '{8C6BA266-08FC-11d1-BA5A-F44E9C5EF10B}';
  28.   IID_IITranslator  : TGUID = '{8C6BA267-08FC-11d1-BA5A-F44E9C5EF10B}';
  29.   IID_IIInter       : TGUID = '{8C6BA268-08FC-11d1-BA5A-F44E9C5EF10B}';
  30.   IID_IIDebugger    : TGUID = '{8C6BA269-08FC-11d1-BA5A-F44E9C5EF10B}';
  31.   IID_IIObjectInfo  : TGUID = '{8C6BA26A-08FC-11d1-BA5A-F44E9C5EF10B}';
  32.  
  33.   IID_ISystem       : TGUID = '{8C6BA280-08FC-11d1-BA5A-F44E9C5EF10B}';
  34.   IID_ISysUtils     : TGUID = '{8C6BA281-08FC-11d1-BA5A-F44E9C5EF10B}';
  35.   IID_IOleAuto      : TGUID = '{8C6BA282-08FC-11d1-BA5A-F44E9C5EF10B}';
  36.  
  37. type
  38.  {$IFNDEF RA_D4H}
  39.   HResult = integer;
  40.  {$ENDIF RA_D4H}
  41.  
  42.   IIObject = interface;
  43.   IIValue  = interface;
  44.   IIArgs   = interface;
  45.  
  46.  {iString - string type used by RAInter}
  47.   iString = PChar; { this enables create DLL, that work with standard types only }
  48.   bufString = ShortString;
  49.  
  50.   TSGIDebugFlags = (dfAll, dfHint, dfEvaluate); {for debugger}
  51.  
  52.  {TSetGetInfo}
  53.   TSetGetInfo = record
  54.     Name : iString;
  55.     Args : IIArgs;
  56.     Res  : IIValue;
  57.     IObjOut : IIObject;
  58.     Get : boolean;
  59.     DebugFlags : TSGIDebugFlags;
  60.   end;
  61.   PSetGetInfo = ^TSetGetInfo;
  62.  
  63.   TIValueTyp = (ivEmpty, ivVariant, ivIdentifer, ivClass, ivFormula,
  64.                 ivInteger, ivReal, ivBoolean, ivString, ivObject, ivPointer,
  65.                 {internal} ivAny);
  66.  
  67.   IIObject = interface(IUnknown)
  68.     ['{8C6BA261-08FC-11d1-BA5A-F44E9C5EF10B}']
  69.     function SetGetValue(var SGI : TSetGetInfo) : boolean;
  70.   end;
  71.  
  72.   IIValue = interface(IIObject)
  73.     ['{8C6BA262-08FC-11d1-BA5A-F44E9C5EF10B}']
  74.     procedure Empty;
  75.     procedure SetStr(S : iString);
  76.     function GetStr : iString;
  77.     function GetAsString : iString;
  78.     function GetTyp : TIValueTyp;
  79.  
  80.     procedure SetvString   (vString    : iString);
  81.     procedure SetvClass    (vClass     : iString);
  82.     procedure SetvFormula  (vFormula   : iString);
  83.     procedure SetvIdentifer(vIdentifer : iString);
  84.     procedure SetvInteger(vInteger : integer );
  85.     procedure SetvReal   (vReal    : double  );
  86.     procedure SetvBoolean(vBoolean : boolean );
  87.     procedure SetvObject (vObject  : IIObject);
  88.     procedure SetvPointer(vPointer : IIValue );
  89.     function GetvString    : iString;
  90.     function GetvIdentifer : iString;
  91.     function GetvFormula   : iString;
  92.     function GetvClass     : iString;
  93.     function GetvInteger : integer ;
  94.     function GetvReal    : double  ;
  95.     function GetvBoolean : boolean ;
  96.     function GetvObject  : IIObject;
  97.     function GetvPointer : IIValue ;
  98.  
  99.     property Typ : TIValueTyp read GetTyp;
  100.     property Str      : iString read GetStr write SetStr;
  101.     property AsString : iString read GetAsString write SetStr;
  102.     property vString    : iString  read GetvString     write SetvString    ;
  103.     property vIdentifer : iString  read GetvIdentifer  write SetvIdentifer ;
  104.     property vFormula   : iString  read GetvFormula    write SetvFormula   ;
  105.     property vClass     : iString  read GetvClass      write SetvClass     ;
  106.     property vInteger : integer  read GetvInteger write SetvInteger;
  107.     property vReal    : double   read GetvReal    write SetvReal   ;
  108.     property vBoolean : boolean  read GetvBoolean write SetvBoolean;
  109.     property vObject  : IIObject read GetvObject  write SetvObject ;
  110.     property vPointer : IIValue  read GetvPointer write SetvPointer;
  111.   end;
  112.  
  113.   IIVar = interface(IIValue)
  114.     ['{8C6BA263-08FC-11d1-BA5A-F44E9C5EF10B}']
  115.     function GetName : iString;
  116.     procedure SetName(AName : iString);
  117.     property Name : iString read GetName write SetName;
  118.   end;
  119.  
  120.   IIArgs  = interface(IIObject)
  121.     ['{8C6BA264-08FC-11d1-BA5A-F44E9C5EF10B}']
  122.     function GetResTyp : TIValueTyp;
  123.     function GetItem(index : integer) : IIVar;
  124.     function Count : integer;
  125.     procedure Delete(index : integer);
  126.  
  127.     property ResTyp : TIValueTyp read GetResTyp;
  128.     property Items [index : integer] : IIVar read GetItem; default;
  129.   end;
  130.  
  131.  {********************* IIInterObject *********************}
  132.   { evaluator interface - Φφ≥σ≡⌠σΘ± Ωεφ≥≡εδΦ≡≤■∙ΦΘ Γ√≈Φ±δσφΦ }
  133.  
  134.  {Error information}
  135.   TProgError = record
  136.     ErrProcName : bufString; {Error function name}
  137.     ErrUnitName : bufString; {Error unit name}
  138.     ErrMessage  : bufString; {Error message}
  139.     ErrPos      : integer;   {Error position - index in pcProgram}
  140.     ErrCode     : integer;   {Error code}
  141.     ErrVarName  : bufString; {Additional information: Error variable name or other name}
  142.     ErrIObj     : IIObject;
  143.   end;
  144.  
  145.  {Run parameters}
  146.   TRunParams = record
  147.     UnitName    : iString; {Current unit name, can be empty} {╚∞  ≥σΩ≤∙σπε ∞εΣ≤δ  (∞εµσ≥ = '', ≥επΣα Γ Formula ∩≡Φ Γ√τεΓσ ⌠≤φΩ÷ΦΘ φαΣε ±±√δα≥ⁿ±  φα ∞εΣ≤δⁿ (φα∩≡Φ∞σ≡, σ±δΦ UnitName = '', ≥ε Formula = 'MyUnit.MyFunc'. └ σ±δΦ UnitName = 'MyUnit', ≥ε ∞εµφε ∩Φ±α≥ⁿ Formula = 'MyFunc'))}
  148.     Formula     : iString; {Program source}
  149.     ReloadAll   : boolean; {if true, all loaded units must be unload before starting program} {⌠δαπ ∩εΩατ√Γασ≥ φαΣε δΦ Γ√π≡≤τΦ≥ⁿ Γ±σ Unit'√}
  150.     RemoveUnit  : boolean; {if true and UnitName <> '', unit UnitName will be unload after program done} {σ±δΦ UnitName <> '', ≥ε ⌠δαπ ∩εΩατ√Γασ≥ φαΣε δΦ Γ√π≡≤τΦ≥ⁿ Unit (ε±ΓεßεΣΦ≥ⁿ ∩α∞ ≥ⁿ ε≥ φσπε) ∩ε±δσ Γ√∩εδφσφΦ }
  151.     CompileOnly : boolean; {if true, only synax check will be done - not implemented} {≥εδⁿΩε ε≥Ωε∞∩ΦδΦ≡εΓα≥ⁿ ∞εΣ≤δⁿ - φσ Γ√∩εδφ ≥ⁿ}
  152.     AppHandle   : longint; {Application.Handle - used by DLL version for internal error MessageBox}
  153.   end;
  154.  
  155.   IIInterObject = interface(IIObject)
  156.     ['{8C6BA265-08FC-11d1-BA5A-F44E9C5EF10B}']
  157.     function IsTerminated : boolean;
  158.     function GetUnitSource(UnitName : iString; var UnitSource, UnitFullName : iString) : boolean;
  159.     procedure Clear;
  160.     procedure Done(var Error : TProgError);
  161.     procedure GetRunParams(var RunParams : TRunParams);
  162.     function GetRes : IIValue;
  163.     property Res : IIValue read GetRes;
  164.   end;
  165.  
  166.  
  167.  {********************* IIDebugObject *********************}
  168.   {debugger interface}
  169.   IIDebugObject = interface
  170.     ['{8C6BA266-08FC-11d1-BA5A-F44E9C5EF10B}']
  171.     procedure Debug;
  172.     function GetDebugMode : boolean;
  173.    {if DebugMode is true, method Debug will be called on each step - Γ√τ√Γα≥ⁿ ∞σ≥εΣ Debug φα ΩαµΣε∞ °απσ Γ√∩εδφσφΦ }
  174.     property DebugMode : boolean read GetDebugMode;
  175.   end;
  176.  
  177.  {********************* IITranslator *********************}
  178.   {external translator interface - Φφ≥σ≡⌠σΘ± Ωεφ≥≡εδΦ≡≤■∙ΦΘ Γφσ°φ■■ ≥≡αφ±δ ÷Φ■}
  179.   TTranslateData = record
  180.     UnitName  : iString; {In}
  181.     pcProgram : PChar;   {In}
  182.     Offs      : integer; {In/Out}
  183.   end;
  184.  
  185.   IITranslator = interface(IIObject)
  186.     ['{8C6BA267-08FC-11d1-BA5A-F44E9C5EF10B}']
  187.     function Translate(var Data : TTranslateData) : boolean;
  188.   end;
  189.  
  190.  {********************* IIInter *********************}
  191.   {RA Inter - ±εß±≥Γσφφε Φφ≥σ≡∩≡σ≥α≥ε≡}
  192.   IIInter = interface(IUnknown)
  193.     ['{8C6BA268-08FC-11d1-BA5A-F44E9C5EF10B}']
  194.     procedure Run(IInterObject : IIInterObject);
  195.   end;
  196.  
  197.   { and interface to internal structures  - , Φφ≥σ≡⌠σΘ± Ω σπε Γφ≤≥≡σφφΦ∞ ±≥≡≤Ω≥≤≡α∞}
  198.   IICallStack = interface;
  199.   IIDebugger = interface(IUnknown)
  200.     ['{8C6BA269-08FC-11d1-BA5A-F44E9C5EF10B}']
  201.     procedure SetDebugMode(ADebugMode : boolean);
  202.     function EvaluateModify(Watch : iString; var Value : iString; var SGIDebugFlags : TSGIDebugFlags) : boolean;
  203.     function GetCallStack : IICallStack;
  204.  
  205.     property DebugMode : boolean write SetDebugMode; {Γ√τ√Γα≥ⁿ ∞σ≥εΣ Debug φα ΩαµΣε∞ °απσ Γ√∩εδφσφΦ }
  206.     property CallStack : IICallStack read GetCallStack;
  207.   end;
  208.  
  209.   { and its internal structures - , Φ σπε Γφ≤≥≡σφφΦσ ±≥≡≤Ω≥≤≡√}
  210.   TCallStackItem = record
  211.     UnitName : iString;
  212.     FuncName : iString;
  213.     pcProgram : PChar;        {Unit source - ≥σΩ±≥ ∞εΣ≤δ }
  214.     pcPos : PChar;            {Current parser position - ≥σΩ≤∙α  ∩ετΦ÷Φ  ∩α≡±σ≡α}
  215.     PosBeg, PosEnd : integer; {Current executed block in pcProgram - ∩ετΦ÷Φ  ε±≥αφεΓα Γ FFormula}
  216.     Args : IIArgs;
  217.   end;
  218.  
  219.   IICallStack = interface(IUnknown)
  220.     ['{8C6BA26A-08FC-11d1-BA5A-F44E9C5EF10B}']
  221.     function Count : integer;
  222.     function GetItem(index : integer) : TCallStackItem;
  223.     property Items[index : integer] : TCallStackItem read GetItem; default;
  224.   end;
  225.  
  226.  
  227.  {********************* IIObjectInfo *********************}
  228.   {φσεß τα≥σδⁿφ√Θ Φφ≥σ≡⌠σΘ± Σδ  IIInterObject - ∩ετΓεδ σ≥ Γ√Γσ±≥Φ ßεδσσ
  229.    ≥ε≈φ≤■ Φφ⌠ε≡∞α÷Φ■ ε Γφσ°φσΘ ε°ΦßΩσ Γ ≡σαδΦτα÷ΦΦ IIInterObject}
  230.  
  231.   TIObjectData = record
  232.     ClassName : bufString;
  233.   end;
  234.  
  235.   IIObjectInfo = interface(IUnknown)
  236.     ['{8C6BA26B-08FC-11d1-BA5A-F44E9C5EF10B}']
  237.     procedure GetIObjectData(var IObjectData : TIObjectData);
  238.   end;
  239.  
  240.  
  241.  
  242. type
  243.   TInterError = integer;
  244.  
  245. const
  246.  {RA Inter error codes}
  247.  {╩εΣ√ ε°ΦßεΩ Φφ≥σ≡∩≡σ≥α≥ε≡α}
  248.  
  249.   ieUnknown              = -1;
  250.   ieInternal             = 111;
  251.   ieOk                   = 0;   {²≥≤ ε°ΦßΩ≤ φσ ∩εΩατ√Γα≥ⁿ}
  252.   ieUserBreak            = 102; {²≥≤ ε°ΦßΩ≤ φσ ∩εΩατ√Γα≥ⁿ}
  253.   ieBadIInterObject      = 103;
  254.   ieCalcEventNotAssigned = 104;
  255.   ieNotImplemented       = 105; {Σαφφα  Γετ∞εµφε±≥ⁿ Γ ≥σΩ≤∙σΘ Γσ≡±ΦΦ φσ ≡σαδΦτεΓαφα}
  256.   ieFormulaEmpty         = 106; {∩σ≡σΣαφα φα Γ√≈Φ±δσφΦσ ∩≤±≥α  ⌠ε≡∞≤δα}
  257.   ieInterObject          = 107; {∩σ≡σΣαφ φα Γ√≈Φ±δσφΦσ ∩≤±≥εΘ InterObject}
  258.  
  259.   {run-time errors - Γ≡σ∞σφΦ Γ√∩εδφσφΦ }
  260.   ieDivisionByZero      = 1;
  261.   iePeriodMonth         = 2;
  262.   iePeriodDay           = 3;
  263.   iePeriodBrice         = 4;
  264.   iePeriodSeparator     = 5;
  265.   iePeriodBeg           = 6;
  266.   iePeriodBegEnd        = 7;
  267. //  ieRecursion           = 8;
  268.   ieStackOverFlow       = 9;
  269.   ieResultNotSolved     = 10;{═σε∩≡σΣσδσφφα  ε°ΦßΩα Γ Γ√≡αµσφΦΦ(φε ≥ε≈φε σ±≥ⁿ)}
  270.   ieCikl                = 11;{┬φ≤≥≡σφφ   - τα÷ΦΩδΦΓαφΦσ}
  271.   ieExternalError       = 12;{∩≡Φ Γ√τεΓσ GetVar ΦδΦ SetVar}
  272.   ieTypeMistmach        = 13;{φσ±εε≥Γσ≥±≥ΓΦσ ≥Φ∩εΓ}
  273.   ieIntegerOverflow     = 14;{±δΦ°Ωε∞ ΣδΦφφ√Θ Φφ≥σπσ≡}
  274.  
  275.   {Syntax errors - ╤Φφ≥αΩ±Φ≈σ±ΩΦσ}
  276.   ieDoNotFound          = 30;
  277.   ieEndWhileNotFound    = 31;
  278.   ieSyntax              = 40;
  279.   ieLeftBrices          = 41;
  280.   ieRightBrices         = 42;
  281.   ieLeftBricesSqr       = 43;
  282.   ieRightBricesSqr      = 44;
  283.   ieUnknownIdentifer    = 45;
  284.   ieBadRemark           = 46;
  285.   ieUnknownLexem        = ieSyntax{47};
  286.   ieTwoZnaks            = 48;
  287.   ieSeparatorExpected   = 49;{∩≡ε∩≤∙σφ ≡ατΣσδΦ≥σδⁿ(φσ τφαΩ ε∩σ≡α÷ΦΦ !!!!!)}
  288.   ieIdentiferExpected   = 50;
  289.   ieEnd                 = 51;
  290.   ieThenNotFound        = 52;
  291. //  ieEndWOBegin          = 53; {end ßστ begin}
  292.   ieEndIfNotFound       = 53;
  293.   ieElseNotFound        = 54;
  294.   ieLabelNotFound       = 55;
  295.   ieLabel               = 56;
  296.   ieVarDecl             = 57;
  297.   ieVarDeclName         = 58;
  298.   ieIdentiferRedeclared = 59;
  299.   ieVarDeclNotReal      = 60;
  300.   ieVarDeclReal         = 61;
  301.   ieVarDeclUses         = 62;{±σΩ÷Φ  Uses Σεδµφα ß√≥ⁿ Σε εß· ΓδσφΦ  ∩σ≡σ∞σφφ√⌡}
  302.   ieBegin               = 63;
  303.   ieLinks               = 64;
  304.   ieEndLineExpected     = 65;{∩≡ε∩≤∙σφα ';'}
  305.   ieIfEndIf             = 66;{EndIf ßστ If}
  306.   ieAtNotLocal          = 67;{∩ε∩√≥Ωα Γτ ≥Φ  αΣ≡σ±α φσ ≤ δεΩαδⁿφεΘ ∩σ≡σ∞σφφεΘ}
  307.   iePtrNotLocal         = 68;{∩ε∩√≥Ωα ±φ ≥Φ  ≤Ωατα≥σδ  φσ ≤ ≤Ωατα≥σδ }
  308.   ieLetNotIdentifer     = 69;{∩ε∩√≥Ωα ∩≡Φ±ΓαΦΓαφΦ  φσ Γ ΦΣσφ≥Φ⌠ΦΩα≥ε≡}
  309.   ieMainNotFound        = 70;{φσ φαΘΣσφα ⌠≤φΩ÷Φ  main}
  310.   ieFuncNotFound        = 70;{φσ φαΘΣσφα ⌠≤φΩ÷Φ  IInterObject.UnitFunc}
  311.   ieEndUnit             = 71;{φσ φαΘΣσφ Ωεφσ÷ ∞εΣ≤δ }
  312.   ieEndFunc             = 72;{φσ φαΘΣσφ Ωεφσ÷ ⌠≤φΩ÷ΦΦ}
  313.   ieBadOpCode           = 73;{φσ ∩εΣΣσ≡µΦΓασ∞√Θ τφαΩ ε∩σ≡α÷ΦΦ Σδ  Σαφφ√⌡ ε∩σ≡αφΣεΓ}
  314.   ieUnitNotFound        = 74;{φσ φαΘΣσφ ∞εΣ≤δⁿ}
  315.   ieConstantExpected    = 75;
  316.   ieTZExpected          = 76;{∩≡ε∩≤∙σφ τφαΩ ';'}
  317.   ieExpected            = 77;{≈≥ε-≥ε ∩≡ε∩≤∙σφε, α Φ∞σφφε ErrVarName}
  318.   ieIdOrConstExpected   = 78;{∩≡ε∩≤∙σφ ΦΣσφ≥Φ⌠ΦΩα≥ε≡ ΦδΦ Ωεφ≥±≥αφ≥α}
  319.  
  320.  {Function call errors - ─δ  ⌠≤φΩ÷ΦΘ}
  321.   ieParams              = 81;{φσΓσ≡φ√σ ∩α≡α∞σ≥≡√ Σδ  ⌠≤φΩ÷ΦΦ ..}
  322.   ieParamTypMistmach    = 82;{.. ßεδσσ ΩεφΩ≡σ≥φε}
  323.   ieNotEnoughParams     = 83;{.. ßεδσσ ΩεφΩ≡σ≥φε}
  324.   ieTooManyParams       = 84;{.. ßεδσσ ΩεφΩ≡σ≥φε}
  325.   ieParam               = 85;{.. φσΣε∩≤±≥Φ∞εσ τφα≈σφΦσ ∩α≡α∞σ≥≡α}
  326. //  ieLeftBraceExpected   = 86;
  327.   ieRightBraceExpected  = 87;
  328.   ieBadStringConst      = 88;
  329. (*  ieLetExpected         = 87; {∩≡ε∩≤∙σφ τφαΩ ∩≡Φ±ΓαΦΓαφΦ  ':='}
  330.   ieExpExpected         = 88; {∩≡ε∩≤∙σφε Γ√≡αµσφΦσ}
  331. *)
  332.   ieFuncInFunc          = 90;{φσδⁿτ  εß·Γδ ≥ⁿ ⌠≤φΩ÷Φ■ Γφ≤≥≡Φ ⌠≤φΩ÷ΦΦ}
  333.  
  334. implementation
  335.  {nothing to implement - this is an interface unit}
  336. end.
  337.