home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / BBS / RA / RAOPP.ZIP / RAOPP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-07-14  |  2.9 KB  |  130 lines
  1. {$M 8192,0,0}
  2.  
  3. {  RAOPP - RemoteAccess Offline Page Player version 1.0  }
  4. {  Copyright (C) 1990 RodentWare, all rights reserved.   }
  5. {  Michael Reece/James Calvert  *  1:3801/42  }
  6. {  Based on original code by Dale Barnes  }
  7.  
  8. Program ROAPP;
  9.  
  10. Uses
  11.   GetWord,
  12.   Exist,
  13.   CRT,
  14.   DOS;
  15.  
  16. Const
  17.    Version = '1.0';
  18.  
  19. var
  20.   PageFile : Text;
  21.   PageFileName : String;
  22.  
  23.   PageLength : LongInt;
  24.  
  25.   ToneLn,
  26.   WaitLn  : integer;
  27.   ToneS   : integer;
  28.  
  29.   Tmp,
  30.   TmpS    : String;
  31.  
  32.   buffer  : char;
  33.  
  34. Function StUpCase(st:string):string;
  35.   var x : byte;
  36.   Begin
  37.     StUpCase:='';  StUpCase[0]:=#0;
  38.     StUpCase[0]:=St[0];
  39.     for x:=1 to length(st) do StUpCase[x]:=UpCase(St[x]);
  40.   end;
  41.  
  42. Function Str2Word(st:string):integer;
  43.   var x, z : integer;
  44.   begin
  45.     Val(St,X,Z);
  46.     str2word:=x;
  47.   end;
  48.  
  49. Procedure PlayIt (PlayFile : String);
  50. Begin
  51.   TmpS := '';
  52.   Writeln ('Scanning '+StUpCase(PlayFile)+'...');
  53.  
  54.   Assign (PageFile, PlayFile);
  55.   {$I-} Reset (PageFile); {$I+}
  56.  
  57.     while Not Eof (PageFile) Do
  58.     Begin
  59.       Readln (PageFile, TmpS);
  60.       If TmpS[1] = ';' then ;      { do nothing }
  61.       TmpS := StUpCase (TmpS);      { uppercase the string }
  62.       no_space(tmps);
  63.       Tmp := Get_Word(TmpS,1);
  64.       If Tmp = 'TONE' then
  65.         begin
  66.           ToneS := Str2Word (Get_Word(Tmps, 2));
  67.           ToneLn:= Str2Word (Get_Word(Tmps, 3));
  68.           ToneLn := ToneLn * 10;
  69.           PageLength:=PageLength+ToneLn;
  70.           Sound (ToneS);
  71.           Delay (ToneLn);
  72.           If KeyPressed then
  73.           Begin
  74.             NoSound;
  75.             buffer:=readkey;  if keypressed then buffer:=readkey;
  76.             {$I-} Close (PageFile); {$I+}
  77.             Writeln;
  78.             Writeln ('Aborted after ',Pagelength/1000:8:2,' seconds.');
  79.             Halt;
  80.           End;
  81.         end;
  82.       If Tmp = 'WAIT' then
  83.         Begin
  84.           WaitLn := Str2Word (Get_Word(TmpS, 2));
  85.           WaitLn := WaitLn * 10;
  86.           PageLength:=PageLength+WaitLn;
  87.           Delay (WaitLn);
  88.         End;
  89.       NoSound;
  90.     End;
  91.     NoSound;
  92.     Writeln;
  93.     Writeln(Pagelength/1000:8:2,' seconds total.');
  94.     {$I-} Reset (PageFile); {$I+}
  95.   {$I-} Close (PageFile); {$I+}
  96. End;
  97.  
  98. Procedure Stop (FileName : String);
  99. Begin
  100.   Writeln ('Error: '+StUpCase(Filename)+' does not exist!');
  101.   halt;
  102. End;
  103.  
  104. Begin
  105.   Assign (Input,'CON');
  106.   Assign (Output,'CON');
  107.   Rewrite (Input);
  108.   Rewrite (Output);
  109.   Writeln;
  110.   Writeln ('RemoteAccess Offline Page Player v'+Version);
  111.   Writeln ('Copyright (C) 1990 RodentWare, All rights reserved.');
  112.   Writeln ('Michael Reece/James Calvert * 1:3801/42');
  113.   Writeln;
  114.   If ParamCount = 0 then
  115.    Begin
  116.      Writeln ('Usage: RAOPP <filename>');
  117.      Halt;
  118.    End;
  119.  
  120.    PageFileName := ParamStr(1);
  121.  
  122.    PageLength:=0;
  123.  
  124.    If FileExist (PageFileName) then
  125.      PlayIt (PageFileName)
  126.    Else
  127.      Stop(PageFileName);
  128. end.
  129.  
  130.