home *** CD-ROM | disk | FTP | other *** search
/ Black Box 4 / BlackBox.cdr / sndblst / greetv10.arj / GREETING.PAS < prev   
Pascal/Delphi Source File  |  1992-01-25  |  2KB  |  68 lines
  1. PROGRAM Greeting;
  2.   {$M $8000,0,0 }
  3.   USES Dos;
  4.   CONST
  5.     Days : Array [0..6] of String[9] = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday');
  6.     Month : Array [1..6] of String[9] = ('January','February','March','April','May','June');
  7.     Months : Array [7..12] of String[9] = ('July','August','September','October','November','December');
  8.  
  9.   VAR
  10.     D, Mn, Y, Dow, H, M, S : Word;
  11.     Time                   : String [9];
  12.     DateTime               : String [50];
  13.     Day, Hour, Minute      : String [2];
  14.     AmPm                   : String [3];
  15.     Year                   : String [4];
  16.     InitPath               : String [40];
  17.  
  18. PROCEDURE HourAMPM;
  19.   Begin
  20.     If H > 11 Then
  21.       Begin
  22.       AMPM := ' PM';
  23.       H := H - 12;
  24.       End else
  25.       AMPM := ' AM';
  26.     If H = 0 Then
  27.       H := 12;
  28.   End;
  29.  
  30. PROCEDURE TimeOfDay;
  31.   Begin
  32.     If AMPM = ' AM' Then
  33.       Time := 'Morning' else
  34.       Begin
  35.         If H < 6 Then Time := 'afternoon' else
  36.         Time := 'evening';
  37.         If H = 12 Then Time := 'afternoon';
  38.       End;
  39.   End;
  40.  
  41. FUNCTION LeadingZero(w : Word) : String;
  42.   VAR
  43.     S : String;
  44.   Begin
  45.     Str(w:0,s);
  46.     if Length(s) = 1 then
  47.       s := '0' + s;
  48.     LeadingZero := s;
  49.   End;
  50.  
  51. BEGIN
  52.   GetDate(Y,Mn,D,Dow);
  53.   GetTime(H,M,S,S);
  54.   GetDir(3,InitPath);
  55.   HourAMPM;
  56.   TimeOfDay;
  57.   Str (D,Day);
  58.   Str (Y,Year);
  59.   Str (H,Hour);
  60.   DateTime := Hour + ':' + LeadingZero(M) + AMPM + ' on ' + Days[Dow] + ', ' + Month[Mn] +  ' ' + Day + ', ' + Year + '.';
  61.   SwapVectors;
  62.   ChDir('C:\SB\SBTALKER');
  63.   Exec('C:\SB\SBTALKER\SBTALKER.EXE','/dBLASTER');
  64.   Exec('C:\SB\SBTALKER\SAY.EXE', '"Good ' + Time + ', it is ' + DateTime + '  What can I do for you?"');
  65.   Exec('C:\SB\SBTALKER\REMOVE.EXE','');
  66.   ChDir(InitPath);
  67.   SwapVectors;
  68. END.