home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Snippets / PNL Libraries / MyServerControl.p < prev    next >
Encoding:
Text File  |  1996-05-29  |  3.0 KB  |  114 lines  |  [TEXT/CWIE]
  1. unit MyServerControl;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Files, ServerControlIntf;
  7.         
  8.     function MySCServerVersion (var ServerType: integer; var ServerVersion: integer):OSErr;
  9.     function MySCGetSetupInfo (var MaxVolumes: integer; var MaxExpFolders: integer): OSErr;
  10.     function MySCGetIndexedSharePoint(index: integer; var vrn: integer; var dirID: longint): OSErr;
  11.         { index should range be between -MaxVolumes and MaxExpFolders }
  12.  
  13. implementation
  14.  
  15.     uses
  16.         Errors,
  17.         MyUtils;
  18.         
  19.     function MySCServerVersion (var ServerType: integer; var ServerVersion: integer):OSErr;
  20.         var
  21.             err: OSErr;
  22.             scPB: SCParamBlockRec;
  23.     begin
  24.         err := unimpErr;
  25.         if MyTrapAvailable(ServerDispatch) then begin
  26.             scPB.versionPB.scCode := SCServerVersion;
  27.             scPB.versionPB.scExtNamePtr := nil;
  28.             err := SyncServerDispatch(@scPB);
  29.             ServerType := scPB.versionPB.scServerType;
  30.             ServerVersion := scPB.versionPB.scServerVersion;
  31.         end;
  32.         MySCServerVersion := err;
  33.     end;
  34.  
  35.     function MySCGetSetupInfo (var MaxVolumes: integer; var MaxExpFolders: integer): OSErr;
  36.         var
  37.             err: OSErr;
  38.             scPB: SCParamBlockRec;
  39.             sir: SetupInfoRec;
  40.             ServerType: integer;
  41.             ServerVersion: integer;
  42.     begin
  43.         err := MySCServerVersion(ServerType, ServerVersion);
  44.         if err = noErr then begin
  45.             if ServerType = MFSType then begin
  46.                 MaxVolumes := 10;
  47.                 MaxExpFolders := 10;
  48.             end else begin
  49.                 scPB.setupPB.scCode := SCGetSetupInfo;
  50.                 scPB.setupPB.scSetupPtr := @sir;
  51.                 err := SyncServerDispatch(@scPB);
  52.                 MaxVolumes := scPB.setupPB.scMaxVolumes;
  53.                 MaxExpFolders := scPB.setupPB.scMaxExpFolders;
  54.             end;
  55.         end;
  56.         MySCGetSetupInfo := err;
  57.     end;
  58.  
  59.     function MySCGetIndexedSharePoint(index: integer; var vrn: integer; var dirID: longint): OSErr;
  60.         var
  61.             err: OSErr;
  62.             scPB: SCParamBlockRec;
  63.             ServerType: integer;
  64.             ServerVersion: integer;
  65.     begin
  66.         if index = 0 then begin
  67.             err := fnfErr;
  68.         end else begin
  69.             err := MySCServerVersion(ServerType, ServerVersion);
  70.             if err = noErr then begin
  71.                 scPB.standardPB.scCode := SCGetExpFldr;
  72.                 scPB.standardPB.scVRefNum := 0;
  73.                 scPB.standardPB.scNamePtr := nil;
  74.                 scPB.standardPB.scIndex := index;
  75.                 err := SyncServerDispatch(@scPB);
  76.                 if (err = noErr) & (ServerType = MFSType) & (scPB.standardPB.scVRefNum = 0) then begin
  77.                     err := fnfErr;
  78.                 end;
  79.                 vrn := scPB.standardPB.scVRefNum;
  80.                 dirID := scPB.standardPB.scDirID;
  81.             end;
  82.         end;
  83.         MySCGetIndexedSharePoint := err;
  84.     end;
  85.  
  86. end.
  87.  
  88.     procedure EnumerateSharedFolders;
  89.         var
  90.             err: OSErr;
  91.             index: integer;
  92.             spec: FSSpec;
  93.             MaxVolumes: integer;
  94.             MaxExpFolders: integer;
  95.     begin
  96.         err := MySCGetSetupInfo (MaxVolumes, MaxExpFolders);
  97.         writeln(err);
  98.         if err = noErr then begin
  99.             for index := -MaxVolumes to MaxExpFolders do begin
  100.                 if index <> 0 then begin
  101.                     err := MySCGetIndexedSharePoint(index, spec.vrefnum, spec.parID);
  102.                     writeln(index, ' ', err);
  103.                     if err = noErr then begin 
  104.                         writeln(spec.vRefNum, ' ', spec.parID);
  105.                         spec.name := 'xxx';
  106.                         err:=FSMakeFSSpec(spec.vRefNum,spec.parID,'',spec);
  107.                         writeln(err, ' ', spec.name);
  108.                     end;
  109.                 end;
  110.             end;
  111.         end;
  112.     end;
  113.     
  114.