home *** CD-ROM | disk | FTP | other *** search
/ ftp.wwiv.com / ftp.wwiv.com.zip / ftp.wwiv.com / pub / BBS / PAGER104.ZIP / PAGER.PAS < prev   
Pascal/Delphi Source File  |  1991-12-22  |  2KB  |  81 lines
  1. Program Joke; { notice: you don't need (input,output) for turbo pascal }
  2.  
  3. Uses Dos,Crt;
  4.  
  5. Type
  6.    String12 = String[12];
  7.    String60 = String[60];
  8.  
  9. Var
  10.    InFile,OutFile:Text;
  11.    Message:String60;
  12.    Cnt:Integer;
  13.  
  14. Procedure OpenFiles(S1,S2:String12);
  15. Begin
  16.    Assign(InFile,S1);
  17.    {$I-} Reset(InFile); {$I+}
  18.    If IOResult <> 0 Then
  19.    Begin
  20.       WriteLn(S2,' not found!  Aborting...');
  21.       Halt(0);
  22.    End;
  23.    Assign(OutFile,S2);
  24.    Rewrite(OutFile);
  25. End;
  26.  
  27. Function Name(Str:String):String12;
  28. Var
  29.    Tmp:String;
  30.    I:Integer;
  31. Begin
  32.    I := 1;
  33.    While UpCase(Str[I]) In ['A'..'Z','0'..'9'] Do Inc(I);
  34.    Tmp := Copy(Str,1,I-1);
  35.    For I := 1 To Length(Tmp) Do Tmp[I] := UpCase(Tmp[I]);
  36.    Name := Tmp;
  37. End;
  38.  
  39. Procedure ParseJokeFile(Msg:String60);
  40. Var OneLine:String[80];
  41. Begin
  42.    While Not Eof(InFile) Do
  43.    Begin
  44.       ReadLn(InFile,OneLine);
  45.       If UpCase(OneLine[1]) In ['A'..'Z','0'..'9'] Then  {Include 69er.. heh}
  46.       Begin
  47.          If (UpCase(OneLine[1]) In ['A'..'Z','0'..'9']) And (OneLine[0] <> #0) Then
  48.             WriteLn(OutFile,'/p '+Name(OneLine)+' '+Msg);
  49.       End;
  50.    End;
  51. End;
  52.  
  53. Procedure Title;
  54. Begin
  55.    TextColor(3);
  56.    WriteLn('Pager Plus v1.04 -- Copyright (c) 1991 Prankware');
  57.    WriteLn;
  58.    TextColor(13);
  59. End;
  60.  
  61. Begin
  62.    Title;
  63.    If (ParamCount < 2) Then
  64.    Begin
  65.       WriteLn('Usage: JOKE <infile> <outfile> [<message>]');
  66.       Halt(0);
  67.    End;
  68.    OpenFiles(ParamStr(1),ParamStr(2));
  69.    If ParamCount = 2 Then
  70.       ParseJokeFile('')
  71.      Else
  72.       Begin
  73.          Message := '';
  74.          For Cnt := 3 To ParamCount Do
  75.             Message := Message + ' ' + ParamStr(Cnt);
  76.          ParseJokeFile(Message);
  77.       End;
  78.    Close(OutFile);
  79.    WriteLn('Joke file created!  <snicker>');
  80. End.
  81.