home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Peter Lewis / PNL Libraries / FakeParameters.p < prev    next >
Encoding:
Text File  |  1990-11-27  |  1.4 KB  |  77 lines  |  [TEXT/PJMM]
  1. unit FakeParameters;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Lists, MyFileSystem;
  7.  
  8.     procedure InitAppFilesX;
  9.     procedure GetAppFilesX (index: integer; var theFile: appFile);
  10.     procedure CountAppFilesX (var message, count: integer);
  11.     procedure ClrAppFilesX (index: integer);
  12.  
  13. implementation
  14.  
  15.     type
  16.         appFilePtr = ^appFile;
  17.         appFileHandle = ^appFilePtr;
  18.  
  19.     var
  20.         lh: listHeadHandle;
  21.         cnt: integer;
  22.  
  23.     procedure InitAppFilesX;
  24.         var
  25.             typeList: SFtypeList;
  26.             reply: SFreply;
  27.             afh: appFileHandle;
  28.     begin
  29.         cnt := 0;
  30.         CreateList(lh);
  31.         GetFile(-1, typeList, reply);
  32.         while reply.good do begin
  33.             afh := appFileHandle(NewHandle(SizeOf(appFile)));
  34.             afh^^.vRefNum := reply.vRefNum;
  35.             afh^^.fType := reply.fType;
  36.             afh^^.versNum := 0;
  37.             afh^^.fName := reply.fName;
  38.             AddTail(lh, afh);
  39.             cnt := cnt + 1;
  40.             GetFile(-1, typeList, reply);
  41.         end;
  42.     end;
  43.  
  44.     procedure GetAppFilesX (index: integer; var theFile: appFile);
  45.         var
  46.             lp: listHandle;
  47.             afh: appFileHandle;
  48.     begin
  49.         if index > cnt then
  50.             with theFile do begin
  51.                 vRefNum := 32000;
  52.                 fType := OSType(0);
  53.                 versNum := $FF;
  54.                 fName := '';
  55.             end
  56.         else begin
  57.             ReturnHead(lh, lp);
  58.             while index > 1 do begin
  59.                 MoveToNext(lp);
  60.                 index := index - 1;
  61.             end;
  62.             Fetch(lp, afh);
  63.             theFile := afh^^;
  64.         end;
  65.     end;
  66.  
  67.     procedure CountAppFilesX (var message, count: integer);
  68.     begin
  69.         message := appOpen;
  70.         count := cnt;
  71.     end;
  72.  
  73.     procedure ClrAppFilesX (index: integer);
  74.     begin
  75.     end;
  76.  
  77. end.