home *** CD-ROM | disk | FTP | other *** search
/ ftp.wwiv.com / ftp.wwiv.com.zip / ftp.wwiv.com / pub / BBS / CEL141.ZIP / CEL141C.ZIP / SMTBAT11.ZIP / SMARTBAT.PAS < prev   
Pascal/Delphi Source File  |  1992-06-01  |  2KB  |  59 lines
  1.  
  2. { Here is the world's shortest program that actually performs a function }
  3. { Written by Rasta Mon, Sysop of Nirvana on May 28,1992 cause I'm bored  }
  4. {                                                                        }
  5. { I included the source for those non-prgmr sysops that want to learn    }
  6. { something.      TURBO PASCAL 6.0                                       }
  7.  
  8. { version 1.1 }
  9.  
  10. Program SmartBat;
  11.  
  12. Uses Dos, Crt;
  13.  
  14. Var    Year, Month, Day, DOW : word;
  15.        Daye: string[9];
  16.  
  17. { Get the DOW number and poke it into the DOS ERRORLEVEL }
  18.  
  19. PROCEDURE WaitAminute;
  20. Begin
  21. TextColor(15);
  22. Writeln;
  23. Writeln('Ctrl-C and Ctrl-Break won''t work.  It''s one TIGHT loop.');
  24. TextColor(12);
  25. Write('Waiting 60 seconds');
  26. TextColor(15);
  27. Write('...');
  28. Delay(65534);
  29. TextColor(9);
  30. Writeln('Done.');
  31. Halt;                   { outtahere }
  32. end;
  33.  
  34. Begin
  35. GetDate(Year,Month,Day,DOW);
  36. If DOW=1 then Daye:='Monday';
  37. If DOW=2 then Daye:='Tuesday';
  38. If DOW=3 then Daye:='Wednesday';
  39. If DOW=4 then Daye:='Thursday';
  40. If DOW=5 then Daye:='Friday';
  41. If DOW=6 then Daye:='Saturday';
  42. If DOW=7 then Daye:='Sunday';
  43. Writeln;
  44. Textcolor(12);
  45. Writeln('SMARTBAT.EXE v1.1 - Freeware');
  46. Textcolor(8);
  47. Writeln('Written by Rasta Mon. SysOp of Nirvana: 713-931-7778 No stinkin NUP');
  48. If (Paramstr(1) = '/W') or (Paramstr(1)='/w') then WaitaMinute;
  49. Writeln('Pokes the day number into the DOS ErrorLevel');
  50. Writeln('Use the /W switch to cause a 1 minute delay in program termination.');
  51. Textcolor(9);
  52. Writeln('Today is ',Daye);
  53. Writeln('DOS ErrorLevel set to ',DOW);
  54. Writeln;
  55. HALT(DOW);   { adios }
  56. End.
  57.  
  58.  
  59.