home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Snippets / PNL Libraries / MyAssocStrings.p < prev    next >
Encoding:
Text File  |  1996-12-06  |  3.5 KB  |  169 lines  |  [TEXT/CWIE]
  1. unit MyAssocStrings;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Memory;
  7.  
  8.     type
  9.         AssocStringsObject = object
  10.             { private }
  11.             data: Handle
  12.             
  13.             { public }
  14.             function Create: OSStatus;
  15.             function CreateFromHandle (d: Handle): OSStatus;
  16.             procedure Destroy;
  17.             procedure SetDataHandle (d: Handle);
  18.             function GetDataHandle: Handle;
  19.             function Count: longint;
  20.             procedure GetIndexedKey( index: longint; var key, value: Str255 );
  21.             procedure GetData( const key: Str255; var value: Str255 );
  22.             procedure SetData( const key, value: Str255 );
  23.             procedure DeleteData( const key: Str255 );
  24.         end;
  25.  
  26. implementation
  27.  
  28.     uses
  29.         Packages,ToolUtils,
  30.         MyLowLevel, MyMemory, MyAssertions;
  31.  
  32.     procedure Next ( data: Handle; var pos: longint );
  33.     begin
  34.         pos := pos + GetUnsignedByte( data^, pos ) + 1;
  35.     end;
  36.  
  37.     procedure CopyString ( data: Handle; pos: longint; var s: Str255 );
  38.     begin
  39.         BlockMove(AddPtrLong(data^, pos), @s, GetUnsignedByte(data^, pos) + 1);
  40.     end;
  41.  
  42.     function GetPos ( data: Handle; const key: Str255; var pos: longint ): boolean;
  43.         var
  44.             size: longint;
  45.             thiskey: Str255;
  46.     begin
  47.         Assert( data <> nil );
  48.         GetPos := false;
  49.         size := GetHandleSize(data);
  50.         pos := 0;
  51.         while pos < size do begin
  52.             CopyString(data, pos, thiskey);
  53.             if IUEqualString(thiskey, key) = 0 then begin
  54.                 GetPos := true;
  55.                 leave;
  56.             end;
  57.             Next(data, pos);
  58.             Next(data, pos);
  59.         end;
  60.     end;
  61.  
  62.     function AssocStringsObject.Create: OSStatus;
  63.     begin
  64.         Create := MNewHandle( data, 0 );
  65.     end;
  66.     
  67.     function AssocStringsObject.CreateFromHandle (d: Handle): OSStatus;
  68.     begin
  69.         Assert( d <> nil );
  70.         data := d;
  71.         CreateFromHandle := noErr;
  72.     end;
  73.     
  74.     procedure AssocStringsObject.Destroy;
  75.     begin
  76.         MDisposeHandle( data );
  77.         dispose(self);
  78.     end;
  79.     
  80.     procedure AssocStringsObject.SetDataHandle (d: Handle);
  81.     begin
  82.         Assert( d <> nil );
  83.         MDisposeHandle( data );
  84.         data := d;
  85.     end;
  86.     
  87.     function AssocStringsObject.GetDataHandle: Handle;
  88.     begin
  89.         GetDataHandle := data;
  90.     end;
  91.  
  92.     function AssocStringsObject.Count: longint;
  93.         var
  94.             pos, size: longint;
  95.             c: longint;
  96.     begin
  97.         Assert( data <> nil );
  98.         c := 0;
  99.         size := GetHandleSize(data);
  100.         pos := 0;
  101.         while pos < size do begin
  102.             Next(data, pos);
  103.             Next(data, pos);
  104.             Inc(c);
  105.         end;
  106.         Count := c;
  107.     end;
  108.  
  109.     procedure AssocStringsObject.GetIndexedKey( index: longint; var key, value: Str255 );
  110.         var
  111.             pos, size: longint;
  112.     begin
  113.         Assert( data <> nil );
  114.         size := GetHandleSize(data);
  115.         pos := 0;
  116.         while (pos < size) & (index > 1) do begin
  117.             Next(data, pos);
  118.             Next(data, pos);
  119.             Dec(index);
  120.         end;
  121.         if (pos < size) & (index = 1) then begin
  122.             CopyString(data, pos, key);
  123.             Next(data, pos);
  124.             CopyString(data, pos, value);
  125.         end else begin
  126.             key := '';
  127.             value := '';
  128.         end;
  129.     end;
  130.  
  131.     procedure AssocStringsObject.GetData( const key: Str255; var value: Str255 );
  132.         var
  133.             pos: longint;
  134.     begin
  135.         value := '';
  136.         if GetPos(data, key, pos) then begin
  137.             Next(data, pos);
  138.             CopyString(data, pos, value);
  139.         end;
  140.     end;
  141.  
  142.     procedure AssocStringsObject.SetData( const key, value: Str255 );
  143.         var
  144.             err: OSErr;
  145.             pos: longint;
  146.     begin
  147.         if GetPos(data, key, pos) then begin
  148.             Next(data, pos);
  149.             pos := Munger(data, pos, nil, GetUnsignedByte(data^, pos) + 1, @value, length(value) + 1);
  150.         end
  151.         else begin
  152.             err := PtrAndHand(@key, data, length(key) + 1);
  153.             err := PtrAndHand(@value, data, length(value) + 1);
  154.         end;
  155.     end;
  156.  
  157.     procedure AssocStringsObject.DeleteData( const key: Str255 );
  158.         var
  159.             pos, posn: longint;
  160.     begin
  161.         if GetPos(data, key, pos) then begin
  162.             posn := pos;
  163.             Next(data, posn);
  164.             Next(data, posn);
  165.             pos := Munger(data, pos, nil, posn - pos, @pos, 0);
  166.         end;
  167.     end;
  168.  
  169. end.