home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / share / sfmconf.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-11-17  |  3.5 KB  |  130 lines
  1. (*   This is sample Turbo Pascal source code to read     *)
  2. (*   a file used by SPITFIRE BBS named SFMCONF.DAT.      *)
  3. (*   This sample source code also demonstrates file      *)
  4. (*   sharing abilities for a LAN system of multitasking. *)
  5. (*   This code will only work with Turbo Pascal 4.0      *)
  6. (*   or newer.                                           *)
  7. Program Sample_Pascal_Code_To_Read_SPITFIRES_SFMCONFDAT;
  8. Uses
  9.   BCShare,
  10.   Crt,
  11.   DOS;
  12. TYPE
  13.   MsgSystem = Record
  14.                 MSec           : Integer;
  15.                 NetMailConf    : Boolean;
  16.                 MDesc          : String[40];
  17.                 MEqual,
  18.                 PublicMsgConf,
  19.                 AllowDelete,
  20.                 BackupNeeded   : Boolean;
  21.                 DaysOld        : Word;
  22.                 Extra          : Array[1..78] Of Byte;
  23.               End;
  24.  
  25. VAR
  26.   MSysF   : File Of MsgSystem;
  27.   MSys    : MsgSystem;
  28.   Rec,
  29.   IOError : Integer;
  30.   Start   : Real;
  31.  
  32.   Function BCSTimer: Real;
  33.   VAR
  34.     Hour,Minute,Second,Sec100 : Word;
  35.     H,M,S,T : Real;
  36.     Begin
  37.       GetTime(Hour,Minute,Second,Sec100);
  38.       H:=(Hour);
  39.       M:=(Minute);
  40.       S:=(Second);
  41.       T:=(Sec100);
  42.       BCSTimer:=H*3600+M*60+S+T/100;
  43.     End;
  44.  
  45.   Function TimesUp(Start : Real; HowLong : Integer) : Boolean;
  46.   VAR
  47.     R : Real;
  48.     Begin;
  49.       If BCSTimer<Start Then Start:=Start-86400;
  50.       R:=BCSTimer-Start;
  51.       TImesUp:=Trunc(R)>=HowLong;
  52.     End;
  53.  
  54.   Procedure ShowFile;
  55.   VAR
  56.     Done : Boolean;
  57.     C    : Char;
  58.     Begin;
  59.       Done:=False;
  60.       Repeat;
  61.         Seek(MSysF,Rec);
  62.         Start:=BCSTimer;
  63.         Repeat;
  64.           {$I-}Read(MSysF,MSys);{$I+}
  65.           IOError:=IOResult;
  66.           If IOError=5 Then Delay(500);
  67.         Until (IOError<>5) Or (TimesUp(Start,10));
  68.         If IOError<>0 Then
  69.         Begin;
  70.           Writeln('An error occurred reading SFMCONF.DAT!');
  71.           Writeln('Halting!!!',^G);
  72.           {$I-}Close(MSysF);{$I+}
  73.           If IOResult<>0 Then;
  74.           Halt(1);
  75.         End;
  76.         GOTOXY(1,1);
  77.         Write('Record No. ',Rec+1,' of ',FileSize(MSysF));
  78.         Clreol;
  79.         GOTOXY(1,3);
  80.         Write('Message Conference #',Rec+1,' - "',MSys.MDesc,'"');
  81.         Clreol;
  82.         GOTOXY(1,4);
  83.         Write('Conference Security Level: ',MSys.MSec);
  84.         Clreol;
  85.         GOTOXY(1,5);
  86.         Write('Net-mail Conference: ');
  87.         If MSys.NetMailConf Then Write('Yes') Else Write('No');
  88.         Clreol;
  89.         GOTOXY(1,7);
  90.         Write('ENTER COMMAND - [+ - Q]? ');
  91.         Clreol;
  92.         Repeat;
  93.           C:=Upcase(Readkey);
  94.         Until C In ['+','-','Q',#27];
  95.         Case C Of
  96.           '+' : Begin;
  97.                   Rec:=Rec+1;
  98.                   If Rec>=FileSize(MSysF) Then Rec:=0;
  99.                 End;
  100.           '-' : Begin;
  101.                   Rec:=Rec-1;
  102.                   If Rec<0 Then Rec:=FileSize(MSysF)-1;
  103.                 End;
  104.           'Q' : Done:=True;
  105.           #27 : Done:=True;
  106.         End;
  107.       Until Done;
  108.     End;
  109.  
  110. Begin;
  111.   Clrscr;
  112.   Assign(MSysF,'SFMCONF.DAT');
  113.   SetFileMode(ReadDenyNone);
  114.   Start:=BCSTimer;
  115.   Repeat;
  116.     {$I-}Reset(MSysF);{$I+}
  117.     IOError:=IOResult;
  118.     If IOError=5 Then Delay(500);
  119.   Until (IOError<>5) Or (TimesUp(Start,10));
  120.   If (IOError<>0) And (IOError<>5) Then
  121.   Begin;
  122.     Writeln('SFMCONF.DAT not found!');
  123.     Writeln('Halting!',^G);
  124.     Halt(1);
  125.   End;
  126.   Rec:=0;
  127.   ShowFile;
  128.   {$I-}Close(MSysF);{$I+}
  129.   If IOResult<>0 Then;
  130. End.