home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kompon / d23456 / CAJSCRPT.ZIP / ifpasscript / ifs_var.pas < prev    next >
Pascal/Delphi Source File  |  2001-06-07  |  33KB  |  1,157 lines
  1. //  Filename: ifs_var.pas
  2. //  Author: Carlo Kok (ckok.1@hccnet.nl)
  3. //
  4. // Innerfuse Pascal Script Variable management, Procedure management and Type Management
  5.  
  6. unit ifs_var;
  7. {$I ifs_def.inc}
  8.  
  9. interface
  10.  
  11. uses
  12.   ifs_utl;
  13.  
  14. type
  15.   TIfPasScriptError = Word;
  16.   TCS2Error = TIfPasScriptError;
  17.  
  18. const
  19.   ERuntimeError = 32768;
  20.   ECompileError = 1;
  21.  
  22.   ENoError = 0;
  23.   ECanNotReadProperty = 1;
  24.   ECanNotWriteProperty = 2;
  25.   EUnknownIdentifier = 3;
  26.   EIdentifierExpected = 4;
  27.   ESemicolonExpected = 5;
  28.   EBeginExpected = 6;
  29.   EDuplicateIdentifier = 7;
  30.   EUnexpectedEndOfFile = 8;
  31.   EColonExpected = 9;
  32.   ESyntaxError = 10;
  33.   EStringError = 11;
  34.   EErrorInStatement = 12;
  35.   EAssignmentExpected = 13;
  36.   ETypeMismatch = 14;
  37.   EErrorInExpression = 15;
  38.   ERoundOpenExpected = 16;
  39.   ERoundCloseExpected = 17;
  40.   EVariableExpected = 18;
  41.   ECommaExpected = 19;
  42.   EThenExpected = 20;
  43.   EPeriodExpected = 21;
  44.   EParameterError = 22;
  45.   EToExpected = 23;
  46.   EDoExpected = 24;
  47.   EOfExpected = 25;
  48.   EEndExpected = 26;
  49.   EOpenBlockExpected = 27;
  50.   ECloseBlockExpected = 28;
  51.   EConstantExpected = 29;
  52.   EIsExpected = 30;
  53.   EIntegerExpected = 31;
  54.   ECloseRoundExpected = 32;
  55.   EUntilExpected = 33;
  56.   {$IFNDEF NOCLASSES}
  57.   EClassNotAllowedHere = 34;
  58.   EClassTypeExpected = 35;
  59.   ECanNotOverride = 36;
  60.   EUnsatisfiedForward = 37;
  61.   EConstructorExpected = 38;
  62.   ENoInheritedAllowedHere = 39;
  63.   ECanNotReadOrWriteProperty = 40;
  64.   EObjectExpected = 41;
  65.   {$ENDIF}
  66.   ECommentError = 42;
  67.   ECharError = 43;
  68.   EExceptExpected = 44;
  69.   EStringExpected = 45;
  70.  
  71.   EUnitNotFound = ERuntimeError + 0;
  72.   EClassNotCreated = ERuntimeError + 1;
  73.   EOutOfRange = ERuntimeError + 2;
  74.   EDivideByZero = ERuntimeError + 3;
  75.   ENotSupported = ERuntimeError + 4;
  76.   EExitCommand = ERuntimeError + 5;
  77.   EClassAlreadyFreed = ERuntimeError + 6;
  78.   EClassReferenceNotAssigned = ERuntimeError + 7;
  79. {$IFNDEF NOVARIANTS}
  80.   EVariantIsNil = ERuntimeError + 8;
  81. {$ENDIF}
  82.   ECustomError = ERuntimeError + 9;
  83.   EOutOfMemoryError = ERuntimeError + 10;
  84.  
  85. const
  86.   CSV_NONE = 0; { Void/ERROR }
  87.   CSV_UByte = 1; { Byte }
  88.   CSV_SByte = 2; { ShortInt }
  89.   CSV_UInt16 = 3; { Word }
  90.   CSV_SInt16 = 4; { Integer (Delphi : SmallInt) }
  91.   CSV_UInt32 = 5; { Longint (Delphi : Cardinal) }
  92.   CSV_SInt32 = 6; { Longint }
  93.   CSV_Char = 7; { Char }
  94.   CSV_String = 8; { String }
  95.   CSV_Real = 9; { Real }
  96.   CSV_Single = 10; { Single }
  97.   CSV_Double = 11; { Double }
  98.   CSV_Extended = 12; { Extended }
  99.   CSV_Comp = 13; { Comp }
  100.   CSV_Bool = 14; { Boolean }
  101.   CSV_Var = 15; { Variable in function call }
  102.   CSV_Array = 16; { Array }
  103.   CSV_Record = 17; { Record }
  104.   CSV_Internal = 19; { Internal }
  105.   {$IFNDEF NOCLASSES}
  106.   CSV_Class = 18; { Class }
  107.   CSV_ClassRef = 20; { Class of Class }
  108.   CSV_Property = 21; { Property }
  109.   {$ENDIF}
  110.   CSV_TypeCopy = 22;
  111.   CSV_ProcVariable = 23;
  112.   CSV_Special = 24;
  113.   {$IFNDEF NOCLASSES}
  114.   CSV_ExternalObject = 25;
  115.   CSV_ExternalObjectProperty = 26;
  116.   {$ENDIF}
  117. {$IFNDEF NOVARIANTS}
  118.   CSV_Variant = 27;
  119. {$ENDIF}
  120.  
  121. type
  122.   PTypeManager = ^TTypeManager;
  123.   TTypeManager = packed record
  124.     List: TIfList;
  125.   end;
  126.   PTypeRec = ^TTypeRec;
  127.   TTypeRec = record
  128.     Ident: string;
  129.     atypeid: Word;
  130.     ext: Pointer;
  131.     { When using records, this will be a pointer to a TIFSRecordType type,
  132.      using string, it is used for the dll call library: 0 = normal string and 1 = pchar
  133.      using arrays it will be a Pointer to TTypeRec
  134.      using classes it will be a pointer to TIfsClassType
  135.      using classreferences it will be a pointer to an TTypeRec
  136.      using property it will be a pointer to the type of the property
  137.      using TypeCopy it will be a pointer an other PTyperec
  138.      using ProcVariable it will be a pointer to an TIfsProcType
  139.      using ExternalObject it will be of type TIFsCustomObjectType
  140.     }
  141.   end;
  142.  
  143.   PIFSProcType = ^TIfsProcType;
  144.   TIfsProcType = packed record
  145.     Decl: string;
  146.     Method: Boolean;
  147.   end;
  148.  
  149.   PIFSRecordType = ^TIFSRecordType;
  150.   TIFSRecordType = packed record
  151.     u: string; // stored like 'Name1 Type1 Name2 Type2' Types as pointers casted to longints.
  152.   end;
  153.  
  154.  
  155.   {$IFNDEF NOCLASSES}
  156.   PIFSClassType = ^TIFSClassType;
  157.   TIFSClassType = packed record
  158.     InheritsFrom: PTypeRec; {until it's nil}
  159.     PropStart, VarNoStart, VarCount: Cardinal; { Used in the variable manager; It's for finding the fields of the class}
  160.     Variables: TIFsRecordType;
  161.     {
  162.       Things before name:                    
  163.       1 Private
  164.       2 Public
  165.       3 Protected
  166.     }
  167.     Properties: TIFList; { of PPropertyDef }
  168.     Procedures: TIfList; { of PProcedure }
  169.     { Flags:
  170.        $1    = Private
  171.        $2    = Public
  172.        $1+$2 = Protected
  173.        $10   = Virtual begin
  174.        $20   = Virtual override
  175.        $40   = Constructor
  176.        $80   = Destructor
  177.     }
  178.   end;
  179.   PCreatedClass = ^TCreatedClass;
  180.   TCreatedClass = packed record
  181.     Variables: Pointer;{TVariableManager}
  182.     ClassType: PTypeRec;
  183.     AlreadyFreed: Boolean;
  184.   end;
  185.  
  186.   PPropertyDef = ^TPropertyDef;
  187.   TPropertyDef = packed record
  188.     Name: string;
  189.     CV_Type: PTypeRec;
  190.     Cv_PropRead,
  191.     CV_PropWrite: Pointer;
  192.     CV_PropFlags: Word;
  193.       { CSV_Property flags:
  194.          $1 = Readable
  195.          $2 = Writeable
  196.          $4 = CV_Read = Procedure (if not CV_Read = Longint(no) absolute number in TCreatedClass.Variables )
  197.          $8 = CV_Write = Procedure (if not CV_Write = Longint(no) absolute number in TCreatedClass.Variables )
  198.          $10 = Private
  199.          $20 = Public
  200.          $30 = Protected
  201.       }
  202.    end;
  203.   {$ENDIF}
  204.  
  205.   TCSV_UByte = Byte;
  206.   TCSV_SByte = ShortInt;
  207.   TCSV_Char = Char;
  208.   TCSV_UInt16 = Word;
  209.   TCSV_SInt16 = SmallInt;
  210.   TCSV_UInt32 = Cardinal;
  211.   TCSV_SInt32 = Longint;
  212.   PIfVariant = ^TCajVariant;
  213.   PCajVariant = PIfVariant;
  214.   TIfVariant = packed record
  215.     VType: PTypeRec;
  216.     Flags: Byte;
  217.     {
  218.       Readonly(Const) = 1
  219.       Only for classes:
  220.       $2    Private
  221.       $4    Public
  222.       $2+$4 Protected
  223.  
  224.     }
  225.     CV_Str: string;
  226.     case Word of
  227.       CSV_UByte: (CV_UByte: TCSV_UByte);
  228.       CSV_SByte: (CV_SByte: TCSV_SByte);
  229.       CSV_Char: (CV_Char: TCSV_Char);
  230.       CSV_UInt16: (CV_UInt16: TCSV_UInt16);
  231.       CSV_SInt16: (CV_SInt16: TCSV_SInt16);
  232.       CSV_UInt32: (CV_UInt32: TCSV_UInt32);
  233.       CSV_SInt32: (CV_SInt32: TCSV_SInt32);
  234.       CSV_String: ();
  235.       CSV_Real: (CV_Real: Real);
  236.       CSV_Single: (CV_Single: Single);
  237.       CSV_Double: (CV_Double: Double);
  238.       CSV_Extended: (CV_Extended: Extended);
  239.       CSV_Comp: (CV_Comp: Comp);
  240.       CSV_Bool: (CV_Bool: Boolean);
  241.       CSV_Var: (CV_Var: Pointer); {Pointer to a CajVariant}
  242.       CSV_Array: (CV_ArrItems: TifList); {of PIfVariant}
  243.       CSV_Record: (CV_RecItems: TIfList); {of PIfVariant}
  244.   {$IFNDEF NOCLASSES}
  245.       CSV_Class: (CV_Class: PCreatedClass);
  246.       CSV_ClassRef: (Cv_ClassRef: PTypeRec);
  247.       CSV_Property: (CV_Self, Cv_PropRead, CV_PropWrite: Pointer; CV_PropFlags: Word);
  248.   {$ENDIF}
  249.       CSV_Internal: (Cv_Int1,CV_Int2: Pointer);
  250.       CSV_ProcVariable: (Cv_Proc: pointer{$IFNDEF NOCLASSES};Cv_ProcSelf: PCreatedClass{$ENDIF});
  251.       CSV_Special: (CV_Spec: Byte { 0 = nil pointer });
  252.   {$IFNDEF NOCLASSES}
  253.       CSV_ExternalObject: (CV_ExternalObject: Pointer {PCreatedCustomObject});
  254.       CSV_ExternalObjectProperty: (CV_ExtObj: Pointer; CV_PropertyNo: Longint);
  255.   {$ENDIF}
  256.   {$IFNDEF NOVARIANTS}
  257.       CSV_Variant: (CV_Variant: PIfVariant); // always created!
  258.   {$ENDIF}
  259.   end;
  260.   TCajVariant = TIfVariant;
  261. { Array:
  262.   SubType(s): IntToStr(TypeNo);
  263. }
  264. function CreateCajVariant(PType: PTypeRec): PIfVariant;
  265. procedure DestroyCajVariant(p: PIfVariant);
  266. function ChangeType(p: PIfVariant; newtype: PTypeRec): PIfVariant;
  267. {Changetype changes the type of p but also returns P}
  268.  
  269. type
  270.   PVariableManager = ^TVariableManager;
  271.   TVariableManager = packed record
  272.     Names: TifStringList;
  273.     Ptr: TifList;
  274.   end;
  275.  
  276. function VM_Create(InheritFrom: PVariableManager): PVariableManager;
  277. procedure VM_Destroy(p: PVariableManager);
  278. function VM_Add(P: PVariableManager; D: PIfVariant; const Name: string): PIfVariant;
  279. procedure VM_Delete(p: PVariableManager; Idx: LongInt);
  280. function VM_Get(p: PVariableManager; Idx: LongInt): PIfVariant;
  281. function VM_GetName(p: PVariableManager; Idx: LongInt): String;
  282. procedure VM_SetName(p: PVariableManager; Idx: LongInt; S: string);
  283. procedure VM_Set(p: PVariableManager; Idx: LongInt; N: PIfVariant);
  284. function VM_Count(p: PVariableManager): LongInt;
  285. function VM_Find(p: PVariableManager; const Name: string): LongInt;
  286. procedure VM_Clear(p: PVariableManager);
  287.  
  288.  
  289.  
  290. type
  291.   PProcedure = ^TProcedure;
  292.   TRegisteredProc = function(Sender, ScriptID: Pointer; Proc: PProcedure; Params: PVariableManager; res: PIfVariant): TIfPasScriptError;
  293.   TRegisteredProcObject = function(Sender, ScriptID: Pointer; Proc: PProcedure; Params: PVariableManager; res: PIfVariant): TIfPasScriptError of object;
  294.   TProcedure = packed record
  295.     FScriptEngine: Pointer;
  296.     Mode: Byte; { 0 = Internal; 1 = RegisteredProc; 2 = RegisteredProc of Object }
  297.     Flags: Word;
  298.     Name,
  299.     Decl: string;
  300.  {  Spec: RESTYPE PARAM1NAME PARAM1TYPE PARAM2NAME PARAM2TYPE
  301.     an ! before the paramname means is VARIABLE
  302.  
  303.     an ! before the name means that it's a method (class)
  304.     }
  305.     {$IFNDEF NOCLASSES}ClassType: PTypeRec;{$ENDIF}
  306.     _Ext: Pointer; 
  307.     case Byte of
  308.     0: (Offset: Longint);
  309.     1: (Proc1: TRegisteredProc; _Ext2: Pointer); // _Ext2 can not be used with Proc2, because Proc2 is already 8 bytes.
  310.     2: (Proc2: TRegisteredProcObject);
  311.   end;
  312.  
  313.   TProcedureManager = TIfList;
  314.   PProcedureManager = TProcedureManager;
  315.  
  316. function PM_Create: PProcedureManager;
  317. procedure PM_Destroy(p: PProcedureManager);
  318. procedure PM_Clear(p: PProcedureManager);
  319.  
  320. function PM_AddExtOfObject(p: PProcedureManager; ScriptEngine: Pointer; const Name, Decl: string; {$IFNDEF NOCLASSES}ClassType: PTypeRec;{$ENDIF} Ext: Pointer; Addr: TRegisteredProcObject): PProcedure;
  321. function PM_AddExt(p: PProcedureManager; ScriptEngine: Pointer; const Name, Decl: string; {$IFNDEF NOCLASSES}ClassType: PTypeRec;{$ENDIF} Ext, Addr: Pointer): PProcedure;
  322. function PM_AddInt(p: PProcedureManager; ScriptEngine: Pointer; const Name, Decl: string; {$IFNDEF NOCLASSES}ClassType: PTypeRec;{$ENDIF} Ext: Pointer; Offset: Longint): PProcedure;
  323.  
  324. function PM_Find(p: PProcedureManager; const Name: string): Integer;
  325. function PM_Get(p: PProcedureManager; i: LongInt): PProcedure;
  326.  
  327. function DoMinus(p: PIfVariant): Boolean;
  328. function DoNot(p: PIfVariant): Boolean;
  329.  
  330.  
  331. procedure SetInteger(p: PIfVariant; I: LongInt);
  332. procedure SetReal(p: PIfVariant; i: Extended);
  333. procedure SetString(p: PIfVariant; const I: string);
  334. procedure SetBoolean(p: PIfVariant; i: Boolean);
  335.  
  336. function IsStringType(v: PIfVariant): Boolean;
  337. function IsIntRealType(v: PIfVariant): Boolean;
  338. function IsIntegerType(v: PIfVariant): Boolean;
  339. function IsBooleanType(v: PIfVariant): Boolean;
  340. function IsRealType(v: PIfVariant): Boolean;
  341.  
  342. function GetString(v: PIfVariant): string;
  343. function GetReal(v: PIfVariant): Extended;
  344. function GetInteger(v: PIfVariant): LongInt;
  345. function GetBoolean(v: PIfVariant): Boolean;
  346.  
  347. function ErrorToString(e: TIfPasScriptError; const ErrorString: string): string;
  348.  
  349. function TM_Create: PTypeManager;
  350. function TM_Add(P: PTypeManager; const Name: string; FType: Word; ex: Pointer): Pointer;
  351. function TM_Get(P: PTypeManager; const Name: string): PTypeRec;
  352. procedure TM_Destroy(p: PTypeManager);
  353. {s format of S is: IntToHex(Longint(FType1),8)+IntToHex(Longint(FType2), 8)+etc;}
  354.  
  355. function GetVarLink(p: PIfVariant): PIfVariant;
  356. function GetTypeLink(p: PTypeRec): PTypeRec;
  357.  
  358.  
  359. implementation
  360.  
  361.  
  362. //
  363. //  Function: ErrorToString
  364. //   Purpose: Convert an error code to a string description
  365. //-----------------------------------------------------------
  366.  
  367. function ErrorToString(e: TIfPasScriptError; const ErrorString: string): string;
  368. begin
  369.   case e of
  370.     ENoError: ErrorToString := 'no error';
  371.     ECanNotReadProperty: ErrorToString := 'can not read property';
  372.     ECanNotWriteProperty: ErrorToString := 'can not write property';
  373.     EUnknownIdentifier:
  374.       begin
  375.         if ErrorString <> '' then
  376.           ErrorToString := 'unknown identifier: '+ErrorString
  377.         else
  378.           ErrorToString := 'unknown identifier';
  379.       end;
  380.     EIdentifierExpected: ErrorToString := 'identifier expected';
  381.     ESemicolonExpected: ErrorToString := 'semicolon expected';
  382.     EBeginExpected: ErrorToString := 'begin expected';
  383.     EDuplicateIdentifier: ErrorToString := 'duplicate identifier';
  384.     EUnexpectedEndOfFile: ErrorToString := 'unexpected end of file';
  385.     EColonExpected: ErrorToString := 'colon expected';
  386.     ESyntaxError: ErrorToString := 'syntax error';
  387.     EStringError: ErrorToString := 'string error';
  388.     EErrorInStatement: ErrorToString := 'error in statement';
  389.     EAssignmentExpected: ErrorToString := 'assignment expected';
  390.     ETypeMismatch: ErrorToString := 'type mismatch';
  391.     EErrorInExpression: ErrorToString := 'error in expression';
  392.     ERoundOpenExpected: ErrorToString := 'round open expected';
  393.     ERoundCloseExpected: ErrorToString := 'round close expected';
  394.     EVariableExpected: ErrorToString := 'variable expected';
  395.     ECommaExpected: ErrorToString := 'comma expected';
  396.     EThenExpected: ErrorToString := 'then expected';
  397.     EPeriodExpected: ErrorToString := 'period expected';
  398.     EParameterError: ErrorToString := 'parameter error';
  399.     EToExpected: ErrorToString := 'to expected';
  400.     EDoExpected: ErrorToString := 'do expected';
  401.     EOfExpected: ErrorToString := 'of expected';
  402.     EEndExpected: ErrorToString := 'end expected';
  403.     EOutOfRange: ErrorToString := 'out of range';
  404.     EOpenBlockExpected: ErrorToString := 'open block expected';
  405.     ECloseBlockExpected: ErrorToString := 'close block expected';
  406.     EConstantExpected: ErrorToString := 'constant expected';
  407.     EIsExpected: ErrorToString := 'is expected';
  408.     EUnitNotFound: ErrorToString := 'unit is not found';
  409.     EIntegerExpected: ErrorToString := 'integer variable expected';
  410.     ENotSupported: ErrorToString := 'command is not supported';
  411.     ECloseRoundExpected: ErrorToString := 'close round expected';
  412.     EUntilExpected: ErrorToString := 'until expected';
  413.     EDivideByZero: ErrorToString := 'divide by zero';
  414.     {$IFNDEF NOCLASSES}
  415.     EClassNotCreated: ErrorToString := 'class is not created';
  416.     EClassNotAllowedHere: ErrorToString := 'class not allowed here';
  417.     EClassTypeExpected: ErrorToString := 'class type expected';
  418.     ECanNotOverride: ErrorToString := 'can not override';
  419.     EUnsatisfiedForward: ErrortoString := 'unsatisfied forward: '+ErrorString;
  420.     EConstructorExpected: ErrorToString := 'constructor expected';
  421.     ENoInheritedAllowedHere: errorToString := 'no inherited allowed here';
  422.     EClassAlreadyFreed: ErrorToString := 'class already freed';
  423.     EClassReferenceNotAssigned: ErrorToString := 'class reference not assigned';
  424.     ECanNotReadOrWriteProperty: ErrorToString := 'can not read or write property';
  425.     EObjectExpected: ErrorToString := 'object expected';
  426.     {$ENDIF}
  427. {$IFNDEF NOVARIANTS}
  428.     EVariantIsNil: ErrorToString := 'variant is nil';
  429. {$ENDIF}
  430.     ECustomError: ErrorToString := ErrorString;
  431.     ECommentError: ErrorToString := 'comment error';
  432.     ECharError: ErrorToString := 'char error';
  433.     EOutOfMemoryError: ErrorToString := 'out of memory';
  434.     EExceptExpected: ErrorToString := 'except expected';
  435.     EStringExpected: ErrorToString := 'string expected'
  436.  
  437.   else
  438.     ErrorToString := 'unknown error';
  439.   end;
  440. end;
  441.  
  442. function GetTypeLink(p: PTypeRec): PTypeRec;
  443. begin
  444.   while (p<>nil) and (p^.atypeid = CSV_TypeCopy) do
  445.   begin
  446.     p := p^.ext;
  447.   end;
  448.   GetTypeLink := p;
  449. end;
  450.  
  451.  
  452. function CreateCajVariant(PType: PTypeRec): PIfVariant;
  453. {
  454.   Creates an instance of a CajVariant.
  455. }
  456. var
  457.   p: PIfVariant;
  458.   n: PTypeRec;
  459.   s: string;
  460. begin
  461.   PType := GetTypeLink(PType);
  462.   New(p);
  463.   FillChar(p^, Sizeof(P^), 0);
  464.   p^.VType := PType;
  465.   p^.Flags := 0;
  466.   {$IFNDEF NOVARIANTS}
  467.   if PType^.ATypeID = CSV_Variant then
  468.   begin
  469.     p^.CV_Variant := nil;
  470.   end else
  471.   {$ENDIF}
  472.   {$IFNDEF NOCLASSES}
  473.   if PType^.ATypeId = CSV_ExternalObject then
  474.   begin
  475.     p^.CV_ExternalObject := nil;
  476.   end else
  477.   if PType^.AtypeID = CSV_ClassRef then
  478.   begin
  479.     p^.Cv_ClassRef := nil;
  480.   end else {$ENDIF}
  481.   if Ptype^.AtypeID = CSV_Internal then
  482.   begin
  483.     p^.Cv_Int1 := nil;
  484.     p^.Cv_Int2 := nil;
  485.   end else{$IFNDEF NOCLASSES}
  486.   if pType^.Atypeid = CSV_Class then
  487.   begin
  488.     p^.CV_Class := nil;
  489.   end else
  490.   if PType^.ATypeid = CSV_Property then
  491.   begin
  492.     p^.CV_PropFlags := 0;
  493.   end else{$ENDIF}
  494.   if PType^.atypeid = CSV_Var then
  495.     p^.CV_Var := nil
  496.   else if PType^.atypeid = CSV_Array then
  497.   begin
  498.     p^.CV_ArrItems := TIfList.Create;
  499.   end else if PType^.Atypeid = CSV_Record then
  500.   begin
  501.     p^.CV_RecItems := TIfList.Create;
  502.     s := PIFsRecordType(Ptype^.ext)^.u;
  503.     while length(s) > 0 do
  504.     begin
  505.       rfw(S); {remove name}
  506.       n := Pointer(longint(StrToIntDef(Fw(s), 0)));
  507.       if n = nil then break;
  508.       p^.Cv_RecItems.Add(CreateCajVariant(n));
  509.       rfw(s); {remove type}
  510.     end;
  511.   end else if PType^.AtypeID = CSV_String then
  512.   begin
  513.     p^.CV_Str := ''
  514.   end else if PType^.ATypeId = CSV_ProcVariable then
  515.   begin
  516.     P^.Cv_Proc := nil;
  517.     {$IFNDEF NOCLASSES}
  518.     p^.CV_ProcSelf := nil;
  519.     {$ENDIF}
  520.   end;
  521.   CreateCajVariant := p;
  522. end;
  523.  
  524.  
  525. function ChangeType(p: PIfVariant; newtype: PTypeRec): PIfVariant;
  526. { Changes the type of a variant }
  527. var
  528.   n: PTypeRec;
  529.   s: string;
  530.   i: Integer;
  531. begin
  532.   if NewType = nil then begin ChangeType := nil; exit;end;
  533.   newtype := GetTypeLink(newtype);
  534.   {$IFNDEF NOVARIANTS}
  535.   if p^.VType^.ATypeID = CSV_variant then
  536.   begin
  537.     if assigned(p^.CV_Variant) then
  538.       DestroyCajVariant(P^.CV_Variant);
  539.   end else {$ENDIF}
  540.   if P^.Vtype^.atypeid = CSV_Array then
  541.   begin
  542.     for i := 0 to p^.CV_ArrItems.count - 1 do
  543.     begin
  544.       DestroyCajVariant(p^.CV_ArrItems.GetItem(i));
  545.     end;
  546.     p^.CV_ArrItems.Free;
  547.   end else if p^.Vtype^.atypeid = CSV_Record then
  548.   begin
  549.     for i := 0 to p^.CV_RecItems.count - 1 do
  550.     begin
  551.       DestroyCajVariant(p^.CV_RecItems.GetItem(i));
  552.     end;
  553.     p^.CV_RecItems.Free;
  554.   end;
  555.   FillChar(p^, Sizeof(P), 0);
  556.   p^.VType := newtype;
  557.   {$IFNDEF NOVARIANTS}
  558.   if newtype^.ATypeID = CSV_Variant then
  559.   begin
  560.     p^.CV_Variant := nil;
  561.   end else
  562.   {$ENDIF}
  563.   if NewType.AtypeID = CSV_Internal then
  564.   begin
  565.     p^.Cv_Int1 := nil;
  566.     p^.Cv_Int2 := nil;
  567.   end else{$IFNDEF NOCLASSES}
  568.   if newtype^.ATypeId = CSV_ExternalObject then
  569.   begin
  570.     p^.CV_ExternalObject := nil;
  571.   end else
  572.   if NewType.ATypeid = CSV_Class then
  573.   begin
  574.     P^.CV_Class := nil;
  575.   end else {$ENDIF}
  576.   if newtype.atypeid = CSV_Var then
  577.     p^.CV_Var := nil
  578.   else if newtype.atypeid = CSV_Array then
  579.   begin
  580.     p^.CV_ArrItems := TIfList.Create;
  581.   end else if newtype.Atypeid = CSV_Record then
  582.   begin
  583.     p^.CV_RecItems := TIfList.Create;
  584.     s := PIFsRecordType(newtype^.ext)^.u;
  585.     while length(s) > 0 do
  586.     begin
  587.       rfw(S); {remove name}
  588.       n := Pointer(longint(StrToIntDef(Fw(s), 0)));
  589.       if n = nil then break;
  590.       p^.Cv_RecItems.Add(CreateCajVariant(n));
  591.       rfw(s); {remove type}
  592.     end;
  593.   end else if newtype^.ATypeId = CSV_String then
  594.     p^.CV_Str := ''
  595.   else if newtype^.ATypeId = CSV_ProcVariable then
  596.   begin
  597.     P^.Cv_Proc := nil;
  598.     {$IFNDEF NOCLASSES}
  599.     P^.Cv_ProcSelf := nil;
  600.     {$ENDIF}
  601.   end;
  602.   changeType := P;
  603. end;
  604.  
  605. procedure DestroyCajVariant(p: PIfVariant);
  606. { Destroys an instance of a CajVariant.}
  607. var
  608.   i: Longint;
  609. begin
  610.   if Assigned(p) then
  611.   begin
  612.     {$IFNDEF NOVARIANTS}
  613.     if p^.VType^.ATypeID = CSV_variant then
  614.     begin
  615.       if assigned(p^.CV_Variant) then
  616.         DestroyCajVariant(P^.CV_Variant);
  617.     end else {$ENDIF}
  618.     if P^.Vtype^.atypeid = CSV_Array then
  619.     begin
  620.       for i := 0 to p^.CV_ArrItems.count - 1 do
  621.       begin
  622.         DestroyCajVariant(p^.CV_ArrItems.GetItem(i));
  623.       end;
  624.       p^.CV_ArrItems.Free;
  625.     end else if p^.Vtype^.atypeid = CSV_Record then
  626.     begin
  627.       for i := 0 to p^.CV_RecItems.count - 1 do
  628.       begin
  629.         DestroyCajVariant(p^.CV_RecItems.GetItem(i));
  630.       end;
  631.       p^.CV_RecItems.Free;
  632.     end;
  633.     Dispose(p);
  634.   end;
  635. end;
  636.  
  637. function VM_Create(InheritFrom: PVariableManager): PVariableManager;
  638. {Creates an instance of a VariableManger}
  639. var
  640.   p: PVariableManager;
  641.   i: Integer;
  642. begin
  643.   New(p);
  644.   p^.names := TIfStringList.Create;
  645.   p^.Ptr := TIfList.Create;
  646.   if Assigned(InheritFrom) then
  647.   begin
  648.     for i := 0 to InheritFrom^.names.count - 1 do
  649.     begin
  650.       p^.names.Add(InheritFrom^.names.GetItem(i));
  651.       p^.Ptr.Add(InheritFrom^.Ptr.GetItem(i));
  652.     end;
  653.   end;
  654.   VM_Create := p;
  655. end;
  656.  
  657. procedure VM_Destroy(p: PVariableManager);
  658. {Destroys an instance of a VariableManager}
  659. var
  660.   i: Integer;
  661. begin
  662.   if p = nil then exit;
  663.  
  664.   for i := 0 to p^.Ptr.count - 1 do
  665.   begin
  666.     DestroyCajVariant(p^.Ptr.GetItem(i));
  667.   end;
  668.   p^.names.Free;
  669.   p^.Ptr.Free;
  670.   Dispose(p);
  671. end;
  672.  
  673. function VM_Add(P: PVariableManager; D: PIfVariant; const Name: string):
  674. PIfVariant;
  675. begin
  676.   p^.Names.Add(Name);
  677.   p^.Ptr.Add(D);
  678.   VM_Add := D;
  679. end;
  680.  
  681. procedure VM_Clear(p: PVariableManager);
  682. var
  683.   i: Integer;
  684. begin
  685.   for i := 0 to p^.Ptr.count - 1 do
  686.   begin
  687.     DestroyCajVariant(p^.Ptr.GetItem(i));
  688.   end;
  689.   p^.names.Clear;
  690.   p^.Ptr.Clear;
  691. end;
  692.  
  693. procedure VM_Delete(p: PVariableManager; Idx: LongInt);
  694. begin
  695.   p^.Names.Delete(idx);
  696.   p^.Ptr.Delete(Idx);
  697. end;
  698.  
  699. function VM_Find(p: PVariableManager; const Name: string): LongInt;
  700. var
  701.   i: Integer;
  702. begin
  703.   for i := 0 to p^.Names.Count - 1 do
  704.   begin
  705.     if p^.names.GetItem(i) = Name then
  706.     begin
  707.       VM_Find := I;
  708.       Exit;
  709.     end;
  710.   end;
  711.   VM_Find := -1;
  712. end;
  713.  
  714. function VM_Count(p: PVariableManager): LongInt;
  715. begin
  716.   VM_Count := P^.Ptr.Count;
  717. end;
  718.  
  719. function VM_Get(p: PVariableManager; Idx: LongInt): PIfVariant;
  720. begin
  721.   VM_Get := P^.Ptr.GetItem(idx);
  722. end;
  723. function VM_GetName(p: PVariableManager; Idx: LongInt): String;
  724. begin
  725.   VM_GetName := p^.Names.GetItem(idx);
  726. end;
  727.  
  728. procedure VM_Set(p: PVariableManager; Idx: LongInt; N: PIfVariant);
  729. begin
  730.   p^.Ptr.SetItem(Idx, n);
  731. end;
  732.  
  733. procedure VM_SetName(p: PVariableManager; Idx: LongInt; S: string);
  734. begin
  735.   P^.Names.SetItem(idx, s);
  736. end;
  737.  
  738.  
  739. function PM_Create: PProcedureManager;
  740. {Creates an instance of a Procedure Manager}
  741. begin
  742.   PM_Create := TIFList.Create;
  743. end;
  744.  
  745. procedure PM_Clear(p: PProcedureManager);
  746. var
  747.   n: PProcedure;
  748.   i: Integer;
  749. begin
  750.   for i := 0 to p.Count -1 do
  751.   begin
  752.     n := p.GetItem(I);
  753.     Dispose(n);
  754.   end;
  755.   p.Clear;
  756. end;
  757.  
  758. procedure PM_Destroy(p: PProcedureManager);
  759. begin
  760.   PM_Clear(p);
  761.   p.Free;
  762. end;
  763.  
  764. function PM_AddExtOfObject(p: PProcedureManager; ScriptEngine: Pointer; const Name, Decl: string; {$IFNDEF NOCLASSES}ClassType: PTypeRec;{$ENDIF} Ext: Pointer; Addr: TRegisteredProcObject): PProcedure;
  765. var
  766.   n: PProcedure;
  767. begin
  768.   new(n);
  769.   n^.FScriptEngine := ScriptEngine;
  770.   N^.Flags := 0;
  771.   n^.Mode := 2;
  772.   n^.Name := Name;
  773.   N^.Decl := Decl;
  774.   N^._Ext := Ext;
  775.   n^.Proc2 := Addr;
  776.   {$IFNDEF NOCLASSES}
  777.   n^.ClassType := ClassType;
  778.   {$ENDIF}
  779.   P.Add(n);
  780.   PM_AddExtOfObject:= N;
  781. end;
  782. function PM_AddExt(p: PProcedureManager; ScriptEngine: Pointer; const Name, Decl: string; {$IFNDEF NOCLASSES}ClassType: PTypeRec;{$ENDIF} Ext, Addr: Pointer): PProcedure;
  783. var
  784.   n: PProcedure;
  785. begin
  786.   new(n);
  787.   n^.FScriptEngine := ScriptEngine;
  788.   N^.Flags := 0;
  789.   n^.Mode := 1;
  790.   n^.Name := Name;
  791.   N^.Decl := Decl;
  792.   N^._Ext := Ext;
  793.   n^.Proc1 := Addr;
  794.   {$IFNDEF NOCLASSES}
  795.   n^.ClassType := ClassType;
  796.   {$ENDIF}
  797.   P.Add(n);
  798.   PM_AddExt:= N;
  799. end;
  800.  
  801. function PM_AddInt(p: PProcedureManager; ScriptEngine: Pointer; const Name, Decl: string; {$IFNDEF NOCLASSES}ClassType: PTypeRec;{$ENDIF} Ext: Pointer; Offset: Longint): PProcedure;
  802. var
  803.   n: PProcedure;
  804. begin
  805.   new(n);
  806.   N^.FScriptEngine := ScriptEngine;
  807.   N^.Flags := 0;
  808.   n^.Mode := 0;
  809.   n^.Name := Name;
  810.   N^.Decl := Decl;
  811.   N^._Ext := Ext;
  812.   {$IFNDEF NOCLASSES}
  813.   N^.ClassType := ClassType;
  814.   {$ENDIF}
  815.   n^.Offset := Offset;
  816.   P.Add(n);
  817.   PM_AddInt:= N;
  818. end;
  819.  
  820.  
  821. function PM_Find(p: PProcedureManager; const Name: string): Integer;
  822. var
  823.   i: Integer;
  824. begin
  825.   for i := 0 to p.Count - 1 do
  826.   begin
  827.     if PProcedure(p.GetItem(i))^.Name = Name then
  828.     begin
  829.       PM_Find:= I;
  830.       exit;
  831.     end;
  832.   end;
  833.   PM_Find := -1;
  834. end;
  835.  
  836. function PM_Get(p: PProcedureManager; i: LongInt): PProcedure;
  837. begin
  838.   PM_Get := p.GetItem(i);
  839. end;
  840.  
  841. function GetVarLink(p: PIfVariant): PIfVariant;
  842. begin
  843.   if assigned(p) then
  844.   begin
  845.     while p.VType.atypeid = CSV_VAR do
  846.     begin
  847.       if assigned(p^.CV_Var) then
  848.         p := p^.CV_Var
  849.       else
  850.         break;
  851.     end;
  852.   end;
  853.   GetVarLink := p;
  854. end;
  855.  
  856. function DoMinus(p: PIfVariant): Boolean;
  857. begin
  858.   p := GetVarLink(p);
  859.   DoMinus := True;
  860.   case P^.VType^.atypeid of
  861.     CSV_UByte: p^.Cv_UByte := -p^.Cv_UByte;
  862.     CSV_SByte: p^.Cv_SByte := -p^.Cv_SByte;
  863.     CSV_UInt16: p^.Cv_UInt16 := -p^.Cv_UInt16;
  864.     CSV_SInt16: p^.Cv_SInt16 := -p^.Cv_SInt16;
  865.     CSV_UInt32: p^.Cv_UInt32 := -p^.Cv_UInt32;
  866.     CSV_SInt32: p^.Cv_SInt32 := -p^.Cv_SInt32;
  867.     CSV_Real: p^.Cv_Real := -p^.Cv_Real;
  868.     CSV_Single: p^.Cv_Single := -p^.cv_Single;
  869.     CSV_Double: p^.Cv_Double := -p^.Cv_Double;
  870.     CSV_Extended: p^.Cv_Extended := -p^.Cv_Extended;
  871.     CSV_Comp: p^.Cv_Comp := -p^.Cv_Comp;
  872.   else
  873.     DoMinus := False;
  874.   end;
  875. end;
  876.  
  877. function DoNot(p: PIfVariant): Boolean;
  878. begin
  879.   p := GetVarLink(p);
  880.   DoNot := True;
  881.   case P^.VType^.atypeid of
  882.     CSV_UByte: p^.Cv_UByte := not p^.Cv_UByte;
  883.     CSV_SByte: p^.Cv_SByte := not p^.Cv_SByte;
  884.     CSV_UInt16: p^.Cv_UInt16 := not p^.Cv_UInt16;
  885.     CSV_SInt16: p^.Cv_SInt16 := not p^.Cv_SInt16;
  886.     CSV_UInt32: p^.Cv_UInt32 := not p^.Cv_UInt32;
  887.     CSV_SInt32: p^.Cv_SInt32 := not p^.Cv_SInt32;
  888.     CSV_Bool: p^.CV_Bool := not p^.CV_Bool;
  889.   else
  890.     DoNot := False;
  891.   end;
  892. end;
  893.  
  894. procedure SetInteger(p: PIfVariant; I: LongInt);
  895. begin
  896.   p := GetVarLink(p);
  897.   case P^.VType^.atypeid of
  898.     CSV_UByte: p^.Cv_UByte := i;
  899.     CSV_SByte: p^.Cv_SByte := i;
  900.     CSV_UInt16: p^.Cv_UInt16 := i;
  901.     CSV_SInt16: p^.Cv_SInt16 := i;
  902.     CSV_UInt32: p^.Cv_UInt32 := i;
  903.     CSV_SInt32: p^.Cv_SInt32 := i;
  904.   end;
  905. end;
  906.  
  907. procedure SetReal(p: PIfVariant; i: Extended);
  908. begin
  909.   p := GetVarLink(p);
  910.   case P^.VType^.atypeid of
  911.     CSV_Real: P^.CV_Real := i;
  912.     CSV_Single: P^.CV_Single := i;
  913.     CSV_Double: P^.CV_Double := i;
  914.     CSV_Extended: P^.CV_Extended := i;
  915.     CSV_Comp: P^.CV_Comp := i;
  916.   end;
  917. end;
  918.  
  919. procedure SetBoolean(p: PIfVariant; i: Boolean);
  920. begin
  921.   p := GetVarLink(p);
  922.   case P^.VType^.atypeid of
  923.     CSV_Bool: P^.CV_Bool := i;
  924.   end;
  925. end;
  926.  
  927. procedure SetString(p: PIfVariant; const I: string);
  928. begin
  929.   p := GetVarLink(p);
  930.   case P^.VType^.atypeid of
  931.     CSV_String: P^.Cv_Str := i;
  932.   end;
  933. end;
  934.  
  935. function IsRealType(v: PIfVariant): Boolean;
  936. begin
  937.   v := GetVarLink(v);
  938.   IsRealType := (V^.VType^.atypeid = CSV_Real) or
  939.     (v^.Vtype^.atypeid = CSV_Single) or
  940.     (v^.Vtype^.atypeid = CSV_Double) or
  941.     (v^.Vtype^.atypeid = CSV_Extended) or
  942.     (v^.Vtype^.atypeid = CSV_Comp);
  943. end;
  944.  
  945. function IsIntegerType(v: PIfVariant): Boolean;
  946. begin
  947.   v := GetVarLink(v);
  948.   IsIntegerType := (v^.VType^.atypeid = CSV_UByte) or
  949.     (v^.Vtype^.atypeid = CSV_SByte) or
  950.     (v^.VType^.atypeid = CSV_UInt16) or
  951.     (v^.VType^.atypeid = CSV_SInt16) or
  952.     (v^.VType^.atypeid = CSV_UInt32) or
  953.     (v^.VType^.atypeid = CSV_SInt32);
  954. end;
  955.  
  956. function IsBooleanType(v: PIfVariant): Boolean;
  957. begin
  958.   v := GetVarLink(v);
  959.   IsBooleanType := (v^.VType^.atypeid = CSV_Bool);
  960. end;
  961.  
  962. function IsIntRealType(v: PIfVariant): Boolean;
  963. begin
  964.   v := GetVarLink(v);
  965.   IsIntRealType := (v^.VType^.atypeid = CSV_UByte) or
  966.     (v^.VType^.atypeid = CSV_SByte) or
  967.     (v^.VType^.atypeid = CSV_UInt16) or
  968.     (v^.VType^.atypeid = CSV_SInt16) or
  969.     (v^.VType^.atypeid = CSV_UInt32) or
  970.     (v^.VType^.atypeid = CSV_SInt32) or
  971.     (V^.VType^.atypeid = CSV_Real) or
  972.     (v^.VType^.atypeid = CSV_Single) or
  973.     (v^.VType^.atypeid = CSV_Double) or
  974.     (v^.VType^.atypeid = CSV_Extended) or
  975.     (v^.VType^.atypeid = CSV_Comp);
  976. end;
  977.  
  978. function IsStringType(v: PIfVariant): Boolean;
  979. begin
  980.   v := GetVarLink(v);
  981.   IsStringType := (v^.VType^.atypeid = CSV_Char) or
  982.     (v^.VType^.atypeid = CSV_String);
  983. end;
  984.  
  985. function GetInteger(v: PIfVariant): LongInt;
  986. begin
  987.   v := GetVarLink(v);
  988.   case v^.VType^.aTypeid of
  989.     CSV_UByte: GetInteger := V^.CV_UByte;
  990.     CSV_SByte: GetInteger := V^.CV_SByte;
  991.     CSV_UInt16: GetInteger := V^.CV_UInt16;
  992.     CSV_SInt16: GetInteger := V^.CV_SInt16;
  993.     CSV_UInt32: GetInteger := V^.CV_UInt32;
  994.     CSV_SInt32: GetInteger := V^.CV_SInt32;
  995.   else GetInteger := 0;
  996.   end;
  997. end;
  998.  
  999. function GetReal(v: PIfVariant): Extended;
  1000. begin
  1001.   v := GetVarLink(v);
  1002.   case v^.VType^.aTypeid of
  1003.     CSV_Real: GetReal := V^.CV_Real;
  1004.     CSV_Single: GetReal := V^.CV_single;
  1005.     CSV_Double: GetReal := V^.CV_double;
  1006.     CSV_Extended: GetReal := V^.CV_Extended;
  1007.     CSV_Comp: GetReal := V^.CV_Comp;
  1008.     CSV_UByte: GetReal := V^.CV_UByte;
  1009.     CSV_SByte: GetReal := V^.CV_SByte;
  1010.     CSV_UInt16: GetReal := V^.CV_UInt16;
  1011.     CSV_SInt16: GetReal := V^.CV_SInt16;
  1012.     CSV_UInt32: GetReal := V^.CV_UInt32;
  1013.     CSV_SInt32: GetReal := V^.CV_SInt32;
  1014.   else
  1015.     GetReal := 0;
  1016.   end;
  1017. end;
  1018.  
  1019. function GetString(v: PIfVariant): string;
  1020. begin
  1021.   v := GetVarLink(v);
  1022.   case v^.VType^.aTypeid of
  1023.     CSV_String: GetString := V^.CV_Str;
  1024.     CSV_Char: GetString := V^.CV_Char;
  1025.   end;
  1026. end;
  1027.  
  1028. function GetBoolean(v: PIfVariant): Boolean;
  1029. begin
  1030.   v := GetVarLink(v);
  1031.   case v^.VType^.aTypeid of
  1032.     CSV_Bool: GetBoolean := V^.CV_Bool;
  1033.   else
  1034.     GetBoolean := False;
  1035.   end;
  1036. end;
  1037.  
  1038.  
  1039. function TM_Create: PTypeManager;
  1040. var
  1041.   x: PTypeManager;
  1042. begin
  1043.   new(X);
  1044.   X^.List := TIFList.Create;
  1045.   TM_Create := x;
  1046. end;
  1047.  
  1048. function TM_Add(P: PTypeManager; const Name: string; FType: Word; ex: Pointer): Pointer;
  1049. var
  1050.   n: PTypeRec;
  1051.   i: Integer;
  1052. begin
  1053.   if (Name = '') then
  1054.   begin
  1055.     {$IFNDEF NOCLASSES}if FType <> CSV_Class then
  1056.     begin{$ENDIF}
  1057.       for i := 0 to p.List.Count - 1 do
  1058.       begin
  1059.         if (PTypeRec(p.List.GetItem(i))^.atypeid = FType) and (PTypeRec(p.List.GetItem(i))^.ext = Ex) then
  1060.         begin
  1061.           TM_Add := p.List.GetItem(i);
  1062.           Exit;
  1063.         end;
  1064.       end;
  1065.     {$IFNDEF NOCLASSES}end;{$ENDIF}
  1066.     new(n);
  1067.     N^.Ident := Name;
  1068.     N^.atypeid := FType;
  1069.     N^.ext := ex;
  1070.     p^.List.Add(n);
  1071.     TM_Add := N;
  1072.   end else
  1073.     if (TM_GET(p, Name) = nil) then
  1074.     begin
  1075.       new(n);
  1076.       N^.Ident := Name;
  1077.       N^.atypeid := FType;
  1078.       N^.ext := ex;
  1079.       p^.List.Add(n);
  1080.       TM_ADD := n;
  1081.     end else
  1082.       TM_Add := nil;
  1083. end;
  1084.  
  1085. procedure DisposeTypeRec(p: PTypeRec);
  1086.   procedure DestroyRecord(p: PIFSRecordType);
  1087.   begin
  1088.     Dispose(p);
  1089.   end;
  1090.   procedure DestroyProc(p: PIFSProcType);
  1091.   begin
  1092.     Dispose(p);
  1093.   end;
  1094.   {$IFNDEF NOCLASSES}
  1095.   procedure DestroyClass(c: PIFSClassType);
  1096.   var
  1097.     i: Longint;
  1098.     p: PPropertyDef;
  1099.   begin
  1100.     for i := 0 to c^.Properties.Count -1 do
  1101.     begin
  1102.       p := c^.Properties.GetItem(i);
  1103.       Dispose(p);
  1104.     end;
  1105.     c^.Properties.Free;
  1106.     c^.Procedures.Free;
  1107.     Dispose(c);
  1108.   end;
  1109.   {$ENDIF}
  1110.  
  1111. begin
  1112.   if (p^.atypeid = CSV_Record) and (assigned(p^.ext)) then
  1113.   begin
  1114.     DestroyRecord(p^.ext);
  1115.   end else
  1116.   if (P^.ATypeID = CSV_ProcVariable) and (Assigned(P^.Ext)) then
  1117.   begin
  1118.     DestroyProc(p^.Ext);
  1119.   end {$IFNDEF NOCLASSES} else
  1120.   if (p^.AtypeId = CSV_Class) and assigned(p^.Ext) then
  1121.   begin
  1122.     DestroyClass(p^.ext);
  1123.   end{$ENDIF};
  1124.   Dispose(p);
  1125. end;
  1126.  
  1127. function TM_Get(P: PTypeManager; const Name: string): PTypeRec;
  1128. var
  1129.   i: Integer;
  1130. begin
  1131.   for i := 0 to p^.List.Count - 1 do
  1132.   begin
  1133.     if name = PTypeRec(p^.List.GetItem(i))^.ident then
  1134.     begin
  1135.       TM_Get := p^.List.GetItem(i);
  1136.       exit;
  1137.     end;
  1138.   end;
  1139.   TM_Get := nil;
  1140. end;
  1141.  
  1142. procedure TM_Destroy(p: PTypeManager);
  1143. var
  1144.   I: Integer;
  1145. begin
  1146.   for i := 0 to p^.List.Count - 1 do
  1147.   begin
  1148.     DisposeTypeRec(p^.List.GetItem(i));
  1149.   end;
  1150.   p.List.Free;
  1151.   Dispose(p);
  1152. end;
  1153.  
  1154.  
  1155. end.
  1156.  
  1157.