home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Snippets / PNL Libraries / MyODB.p < prev    next >
Encoding:
Text File  |  1996-10-15  |  6.0 KB  |  235 lines  |  [TEXT/CWIE]
  1. unit MyODB;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Types,
  7.         ODBEngine;
  8.     
  9.     const
  10.         generic_odb_error = -234;
  11.         
  12.     type
  13.         MODBRecord = record
  14.             odb: odbRef;
  15.             filern: SInt16;
  16.         end;
  17.     
  18.     function MODBError( result: odbBool ): OSStatus;
  19.     procedure AddODBBoolean( var err: OSStatus; result: odbBool );
  20.  
  21.     function MODBOpen( const spec: FSSpec; var mor: MODBRecord ): OSStatus;
  22.     function MODBCreateOpen( const spec: FSSpec; var mor: MODBRecord; fcreator, ftype: OSType ): OSStatus;
  23.     { if you want a fresh, empy database, call FSpDelete, MODBCreateOpen }
  24.     function MODBClose( var mor: MODBRecord; save: boolean ): OSStatus;
  25.     
  26.     function MODBIsType( odb: odbRef; const key: Str255; reqtype: OSType ): boolean;
  27.     function MODBNewTable( odb: odbRef; const key: Str255 ): OSStatus;
  28.  
  29.     function MODBGetValueHandle( odb: odbRef; const key: Str255; var data: Handle ): OSStatus;
  30.     function MODBSetValueHandle( odb: odbRef; const key: Str255; typ: OSType; data: Handle ): OSStatus;
  31.     function MODBGetValueLong( odb: odbRef; const key: Str255; var n: univ longint ): OSStatus;
  32.     function MODBSetValueLong( odb: odbRef; const key: Str255; typ: OSType; n: univ longint ): OSStatus;
  33.  
  34. implementation
  35.  
  36.     uses
  37.         Errors,
  38.         MyUtils, MyMemory, MyStrings;
  39.         
  40.     function MODBError( result: odbBool ): OSStatus;
  41.     begin
  42.         if result = 0 then begin
  43.             MODBError := generic_odb_error;
  44.         end else begin
  45.             MODBError := noErr;
  46.         end;
  47.     end;
  48.     
  49.     procedure AddODBBoolean( var err: OSStatus; result: odbBool );
  50.     begin
  51.         if (err = noErr) & (result = 0) then begin
  52.             err := generic_odb_error;
  53.         end;
  54.     end;
  55.     
  56.     function MODBOpen( const spec: FSSpec; var mor: MODBRecord ): OSStatus;
  57.         var
  58.             err, junk: OSErr;
  59.     begin
  60.         err := FSpOpenDF( spec, fsRdWrPerm, mor.filern );
  61.         if err = noErr then begin
  62.             if err = noErr then begin
  63.                 err := MODBError( odbOpenFile( mor.filern, mor.odb ) );
  64.             end;
  65.             if err <> noErr then begin
  66.                 junk := FSClose( mor.filern );
  67.             end;
  68.         end;
  69.         MODBOpen := err;
  70.     end;
  71.     
  72.     function MODBCreateOpen( const spec: FSSpec; var mor: MODBRecord; fcreator, ftype: OSType ): OSStatus;
  73.         var
  74.             err, junk: OSErr;
  75.             created: boolean;
  76.     begin
  77.         created := false;
  78.         err := FSpOpenDF( spec, fsRdWrPerm, mor.filern );
  79.         if (err = fnfErr) then begin
  80.             err := FSpCreate( spec, fcreator, ftype, 0 );
  81.             created := err = noErr;
  82.             err := FSpOpenDF( spec, fsRdWrPerm, mor.filern );
  83.         end;
  84.         if err = noErr then begin
  85.             if (err = noErr) & created then begin
  86.                 err := MODBError( odbNewFile( mor.filern ) );
  87.             end;
  88.             if err = noErr then begin
  89.                 err := MODBError( odbOpenFile( mor.filern, mor.odb ) );
  90.             end;
  91.             if err <> noErr then begin
  92.                 junk := FSClose( mor.filern );
  93.             end;
  94.         end;
  95.         if (err <> noErr) & created then begin
  96.             junk := FSpDelete( spec );
  97.         end;
  98.         MODBCreateOpen := err;
  99.     end;
  100.     
  101.     function MODBClose( var mor: MODBRecord; save: boolean ): OSStatus;
  102.         var
  103.             err: OSStatus;
  104.     begin
  105.         err := noErr;
  106.         if save then begin
  107.             AddODBBoolean( err, odbSaveFile( mor.odb ) );
  108.         end;
  109.         AddODBBoolean( err, odbCloseFile( mor.odb ) );
  110.         AddOSStatus( err, FSClose( mor.filern ) );
  111.         MODBClose := err;
  112.     end;
  113.     
  114.     function MODBIsType( odb: odbRef; const key: Str255; reqtype: OSType ): boolean;
  115.         var
  116.             typ: OSType;
  117.     begin
  118.         MODBIsType := false;
  119.         if (odbGetType( odb, key, typ ) <> 0) & (typ = reqtype) then begin
  120.             MODBIsType := true;
  121.         end;
  122.     end;
  123.     
  124.     function MODBNewTable( odb: odbRef; const key: Str255 ): OSStatus;
  125.         var
  126.             err: OSStatus;
  127.             left: Str255;
  128.             p: integer;
  129.             junk_result: odbBool;
  130.     begin
  131.         err := noErr;
  132.         if not MODBIsType( odb, key, tablevaluetype ) then begin
  133.             if odbNewTable( odb, key ) = 0 then begin
  134.                 left := key;
  135.                 p := 1;
  136.                 while (p <= length( key )) do begin
  137.                     if key[p] = '.' then begin
  138.                         left[0] := chr(p-1);
  139.                         junk_result := odbNewTable( odb, left );
  140.                     end;
  141.                     Inc(p);
  142.                 end;
  143.                 junk_result := odbNewTable( odb, key );
  144.                 if MODBIsType( odb, key, tablevaluetype ) then begin
  145.                     err := noErr;
  146.                 end else begin
  147.                     err := generic_odb_error;
  148.                 end;
  149.             end;
  150.         end;
  151.         MODBNewTable := err;
  152.     end;
  153.     
  154.     function MODBGetValueLong( odb: odbRef; const key: Str255; var n: univ longint ): OSStatus;
  155.         var
  156.             err: OSStatus;
  157.             value: odbValueRecord;
  158.     begin
  159.         n := 0;
  160.         if odbGetValue( odb, key, value ) <> 0 then begin
  161.             n := value.data.longvalue;
  162.             odbDisposeValue( odb, value );
  163.         end else begin
  164.             err := generic_odb_error;
  165.         end;
  166.         MODBGetValueLong := err;
  167.     end;
  168.     
  169.     function MODBSetValueLong( odb: odbRef; const key: Str255; typ: OSType; n: univ longint ): OSStatus;
  170.         var
  171.             err: OSStatus;
  172.             value: odbValueRecord;
  173.             left, right: Str255;
  174.     begin
  175.         value.valuetype := typ;
  176.         value.data.longvalue := n;
  177.         err := noErr;
  178.         if odbSetValue( odb, key, value ) = 0 then begin
  179.             err := generic_odb_error;
  180.             if SplitRightAt( key, '.', left, right ) then begin
  181.                 err := MODBNewTable( odb, left );
  182.                 err := MODBError( odbSetValue( odb, key, value ) );
  183.             end;
  184.         end;
  185.         odbDisposeValue( odb, value );
  186.         MODBSetValueLong := err;
  187.     end;
  188.     
  189.     function MODBGetValueHandle( odb: odbRef; const key: Str255; var data: Handle ): OSStatus;
  190.         var
  191.             err: OSStatus;
  192.             value: odbValueRecord;
  193.     begin
  194.         data := nil;
  195.         if odbGetValue( odb, key, value ) <> 0 then begin
  196.             data := value.data.binaryvalue;
  197.             err := HandToHand( data );
  198.             if err <> noErr then begin
  199.                 data := nil;
  200.             end;
  201.             odbDisposeValue( odb, value );
  202.         end else begin
  203.             err := generic_odb_error;
  204.         end;
  205.         if err <> noErr then begin
  206.             MDisposeHandle( data );
  207.         end;
  208.         MODBGetValueHandle := err;
  209.     end;
  210.     
  211.     function MODBSetValueHandle( odb: odbRef; const key: Str255; typ: OSType; data: Handle ): OSStatus;
  212.         var
  213.             err: OSStatus;
  214.             value: odbValueRecord;
  215.             left, right: Str255;
  216.     begin
  217.         err := HandToHand( data );
  218.         if err = noErr then begin
  219.             value.valuetype := typ;
  220.             value.data.binaryvalue := data;
  221.             err := noErr;
  222.             if odbSetValue( odb, key, value ) = 0 then begin
  223.                 err := generic_odb_error;
  224.                 if SplitRightAt( key, '.', left, right ) then begin
  225.                     err := MODBNewTable( odb, left );
  226.                     err := MODBError( odbSetValue( odb, key, value ) );
  227.                 end;
  228.             end;
  229.             odbDisposeValue( odb, value );
  230.         end;
  231.         MODBSetValueHandle := err;
  232.     end;
  233.     
  234. end.
  235.