home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 December / Chip_2001-12_cd1.bin / zkuste / delphi / kompon / d23456 / CAJSCRTP.ZIP / libraries / ifpslib / ifpslib.pas < prev   
Pascal/Delphi Source File  |  2001-04-30  |  4KB  |  118 lines
  1. unit ifpslib;
  2. {
  3.   Innerfuse Pascal Script Library
  4.   For license see Innerfuse Pascal Script license file
  5.  
  6. }
  7. interface
  8. uses
  9.   ifspas, ifs_var, ifs_utl, ifs_obj;
  10.  
  11. procedure RegisterTIfStringList(p: TIfPasScript);
  12. {
  13. Type
  14.   TIfStringList = class(TObject)
  15.   public
  16.     constructor Create;
  17.     destructor Destroy; override;
  18.  
  19.     procedure Clear;
  20.     function GetItem(I: Integer): string;
  21.     procedure SetItem(I: Integer; S: string);
  22.     function Count: Integer;
  23.     function Add(s: string): Integer;
  24.     procedure Delete(I: Integer);
  25.   end;
  26. }
  27.  
  28. function GetTIFStringList(SE: TIFPasScript; P: PCreatedClass): TIfStringList;
  29.  
  30. implementation
  31.  
  32. procedure TIFStrListFree(id: Pointer; Data: Pointer);
  33. begin
  34.   TIfStringList(Data).Free;
  35. end;
  36.  
  37. const
  38.   TIfStringListT =
  39.     'class(TObject) private data: ResourcePointer;public constructor Create; destructor Destroy; override; ' +
  40.     'procedure Clear;function GetItem(I: Integer): string;procedure SetItem(I: ' +
  41.     'Integer; S: string);function Count: Integer; function Add(s: string): Integer;' +
  42.     'procedure Delete(I: Integer);end;';
  43. function GetTIFStringList(SE: TIFPasScript; P: PCreatedClass): TIfStringList;
  44. var
  45.   res: PIFVariant;
  46. begin
  47.   if not GetClassVariable2(p, p^.classType^.ext, 'DATA', res, True) then begin
  48.     GetTIFStringList := nil;
  49.     exit;
  50.   end;
  51.   if SE.IsValidResource(TIFStrListFree, res^.Cv_Int1) then
  52.     GetTIFStringList := res^.CV_Int1
  53.   else
  54.     GetTIFStringList := nil;
  55. end;
  56.  
  57. function StrListProc(Sender: TIfPasScript; ScriptID: Pointer; proc: PProcedure; Params: PVariableManager; res: PIfVariant): TIfPasScriptError;
  58. var
  59.   p, Self: PIfVariant;
  60. begin
  61.   Self := Vm_Get(Params, 0);
  62.   StrListProc := ENoError;
  63.   if not GetClassVariable2(Self^.CV_Class, proc^.ClassType^.Ext, 'DATA', p, True) then begin
  64.     StrListProc := ENotSupported;
  65.     exit;
  66.   end;
  67.   if proc^.Name = '!CREATE' then begin
  68.     p^.Cv_Int1 := TIfStringList.Create;
  69.     Sender.AddResource(TIFStrListFree, p^.Cv_Int1);
  70.   end else if proc^.Name = '!DESTROY' then begin
  71.     if Sender.IsValidResource(TIFStrListFree, p^.Cv_Int1) then begin
  72.       Sender.RemoveResource(p^.Cv_Int1);
  73.       TIfStringList(p^.Cv_Int1).Free;
  74.       p^.Cv_Int1 := nil;
  75.     end else
  76.       StrListProc := EClassNotCreated; // EInternalError
  77.   end else if proc^.Name = '!CLEAR' then begin
  78.     if Sender.IsValidResource(TIFStrListFree, p^.Cv_Int1) then begin
  79.       TIfStringList(p^.Cv_Int1).Clear;
  80.     end else
  81.       StrListProc := EClassNotCreated; // EInternalError
  82.   end else if proc^.Name = '!GETITEM' then begin
  83.     if Sender.IsValidResource(TIFStrListFree, p^.Cv_Int1) then begin
  84.       SetString(res, TIfStringList(p^.Cv_Int1).GetItem(GetInteger(GetVarLink(Vm_Get(Params, 1)))));
  85.     end else
  86.       StrListProc := EClassNotCreated; // EInternalError
  87.   end else if proc^.Name = '!SETITEM' then begin
  88.     if Sender.IsValidResource(TIFStrListFree, p^.Cv_Int1) then begin
  89.       TIfStringList(p^.Cv_Int1).SetItem(GetInteger(GetVarLink(Vm_Get(Params, 1))), GetString(GetVarLink(Vm_Get(Params, 2))));
  90.     end else
  91.       StrListProc := EClassNotCreated; // EInternalError
  92.   end else if proc^.Name = '!COUNT' then begin
  93.     if Sender.IsValidResource(TIFStrListFree, p^.Cv_Int1) then begin
  94.       SetInteger(res, TIfStringList(p^.Cv_Int1).Count);
  95.     end else
  96.       StrListProc := EClassNotCreated; // EInternalError
  97.   end else if proc^.Name = '!ADD' then begin
  98.     if Sender.IsValidResource(TIFStrListFree, p^.Cv_Int1) then begin
  99.       SetInteger(res, TIfStringList(p^.Cv_Int1).Count);
  100.       TIfStringList(p^.Cv_Int1).Add(GetString(GetVarLink(Vm_Get(Params, 1))));
  101.     end else
  102.       StrListProc := EClassNotCreated; // EInternalError
  103.   end else if proc^.Name = '!DELETE' then begin
  104.     if Sender.IsValidResource(TIFStrListFree, p^.Cv_Int1) then begin
  105.       TIfStringList(p^.Cv_Int1).Delete(GetInteger(GetVarLink(Vm_Get(Params, 1))));
  106.     end else
  107.       StrListProc := EClassNotCreated; // EInternalError
  108.   end else StrListProc := EUnknownIdentifier;
  109. end;
  110.  
  111. procedure RegisterTIfStringList(p: TIfPasScript);
  112. begin
  113.   p.AddClass('TIfStringList', TIfStringListT, @StrListProc);
  114. end;
  115.  
  116. end.
  117.  
  118.