home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Snippets / PNL Libraries / MyLogs.p < prev    next >
Encoding:
Text File  |  1997-03-18  |  3.5 KB  |  175 lines  |  [TEXT/CWIE]
  1. unit MyLogs;
  2.  
  3. interface
  4.  
  5.     uses
  6.         BaseLogs,Files;
  7.  
  8.     var
  9.         log_fs:FSSpec;
  10.         log_rn:integer;
  11.         
  12.     procedure InitLogs(keepopen,flush:boolean);
  13.     procedure InitLogsFS(keepopen,flush:boolean; fs:FSSpec);
  14.     procedure FinishLogs;
  15.     procedure LogRaw (s: Str255);
  16.     procedure Log (l: LogStrings);
  17.     procedure Log3 (l: LogStrings; s1, s2, s3: Str255);
  18.     procedure LogTime (l: LogStrings; s3: Str255);
  19.     procedure LogFS (l: LogStrings; fs: FSSpec; s2, s3: Str255);
  20.     function ErrorTrailer (err: OSErr): Str255;
  21.  
  22. implementation
  23.  
  24.     uses
  25.         Errors,TextUtils,Files,
  26.         MyTypes,Files,Folders,Aliases,MyStrH,MyStrings,MyUtils,MyFileSystemUtils;
  27.         
  28.     const
  29.         log_text_creator='R*ch';
  30.     
  31.     var
  32.         gKeepOpen:boolean;
  33.         gFlush:boolean;
  34.         
  35.     procedure StartLog;
  36.         var
  37.             err: OSErr;
  38.     begin
  39.         if log_rn = bad_rn then begin
  40.             err := FSpCreate(log_fs, log_text_creator, 'TEXT', -1);
  41.             err := FSpOpenDF(log_fs, fsWrPerm, log_rn);
  42.             if err <> noErr then begin
  43.                 log_rn := bad_rn;
  44.             end else begin
  45.                 err := SetFPos(log_rn, fsFromLEOF, 0);
  46.             end;
  47.         end;
  48.     end;
  49.  
  50.     procedure StopLog;
  51.         var
  52.             err: OSErr;
  53.     begin
  54.         if log_rn <> bad_rn then begin
  55.             err := FSClose(log_rn);
  56.             log_rn := bad_rn;
  57.         end;
  58.     end;
  59.  
  60.     procedure JointInit(keepopen,flush:boolean);
  61.         var
  62.             junk:OSErr;
  63.             isfolder, wasalias:boolean;
  64.     begin
  65.         log_rn:=bad_rn;
  66.         if GetIndStr(log_strh_id,ord(LS_Last))<>'<LAST>' then begin
  67.             DebugStr('MyLogs:Log LS_Last is not <LAST>');
  68.         end;
  69.         gKeepOpen:=keepopen;
  70.         gFlush:=flush;
  71.         junk := ResolveAliasFile(log_fs, true, isfolder, wasalias);
  72.         if gKeepOpen then begin
  73.             StartLog;
  74.         end;
  75.     end;
  76.     
  77.     procedure InitLogs(keepopen,flush:boolean);
  78.         var
  79.             junk:OSErr;
  80.     begin
  81.         junk :=FindFolder(kOnSystemDisk,kPreferencesFolderType,true,log_fs.vRefNum,log_fs.parID);
  82.         junk := FSMakeFSSpec(log_fs.vRefNum,log_fs.parID, GetIndStr(log_strh_id,ord(LS_Filename)), log_fs);
  83.         JointInit(keepopen,flush);
  84.     end;
  85.     
  86.     procedure InitLogsFS(keepopen,flush:boolean; fs:FSSpec);
  87.     begin
  88.         log_fs:=fs;
  89.         JointInit(keepopen,flush);
  90.     end;
  91.     
  92.     procedure FinishLogs;
  93.     begin
  94.         StopLog;
  95.     end;
  96.     
  97.     procedure LogRaw (s: Str255);
  98.         var
  99.             count: longint;
  100.             err: OSErr;
  101.             pb: paramBlockRec;
  102.     begin
  103.         StartLog;
  104.         if log_rn <> bad_rn then begin
  105.             s := concat(s, cr);
  106.             count := length(s);
  107.             err := FSWrite(log_rn, count, @s[1]);
  108.  
  109.             if not gKeepOpen then begin
  110.                 StopLog;
  111.             end else if gFlush then begin
  112.                 pb.ioRefNum := log_rn;
  113.                 err := PBFlushFileSync(@pb);
  114.             end;
  115.             if gFlush then begin
  116.                 pb.ioNamePtr := nil;
  117.                 pb.iovRefNum := log_fs.vRefnum;
  118.                 err := PBFlushVolSync(@pb);
  119.             end;
  120.         end;
  121.     end;
  122.  
  123.     function ErrorTrailer (err: OSErr): Str255;
  124.         var
  125.             s: Str255;
  126.     begin
  127.         if err = noErr then begin
  128.             s := '';
  129.         end
  130.         else begin
  131.             SPrintS3(s, GetIndStr(log_strh_id, ord(LS_ErrorTrailer)), '', '', NumToStr(err));
  132.         end;
  133.         ErrorTrailer := s;
  134.     end;
  135.  
  136.     procedure Log (l: LogStrings);
  137.     begin
  138.         LogRaw(GetIndStr(log_strh_id, ord(l)));
  139.     end;
  140.  
  141.     procedure Log3 (l: LogStrings; s1, s2, s3: Str255);
  142.         var
  143.             s: Str255;
  144.     begin
  145.         SPrintS3(s, GetIndStr(log_strh_id, ord(l)), s1, s2, s3);
  146.         LogRaw(s);
  147.     end;
  148.  
  149.     procedure LogTime (l: LogStrings; s3: Str255);
  150.         var
  151.             s1, s2: Str255;
  152.             date: UInt32;
  153.     begin
  154.         GetDateTime(date);
  155.         IUDateString(date, shortDate, s1);
  156.         IUTimeString(date, false, s2);
  157.         Log3(l, s1, s2, s3);
  158.     end;
  159.  
  160.     procedure LogFS (l: LogStrings; fs: FSSpec; s2, s3: Str255);
  161.         var
  162.             s: Str255;
  163.             err: OSErr;
  164.     begin
  165.         err := FSSpecToFullPath(fs, s);
  166.         if err = fnfErr then begin
  167.             err := noErr;
  168.         end;
  169.         if err <> noErr then begin
  170.             s := concat('???:', fs.name);
  171.         end;
  172.         Log3(l, s, s2, s3);
  173.     end;
  174.  
  175. end.