home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / TURBOPAS / TP-UTIL.ARK / GETDATE.SRC < prev    next >
Text File  |  1986-01-06  |  3KB  |  72 lines
  1. {->>>>GetDate<<<<----------------------------------------------}
  2. {                                                              }
  3. { Filename: GETDATE.SRC -- Last Modified 10/25/85              }
  4. {                                                              }
  5. { This routine returns the current system date through DOS     }
  6. { call $2A.  It requires a prior definition of types DateRec   }
  7. { and String80.  DateString is formatted this way:             }
  8. {                                                              }
  9. {     Wednesday, July 17, 1986                                 }
  10. {                                                              }
  11. {     DateRec = RECORD                                         }
  12. {                 DateComp       : Integer;                    }
  13. {                 DateString     : String80;                   }
  14. {                 Year,Month,Day : Integer;                    }
  15. {                 DayOfWeek      : Integer                     }
  16. {               END;                                           }
  17. {                                                              }
  18. { DayOfWeek is a code from 0-6, with 0 = Sunday.               }
  19. { DateComp is an integer generated by the formula:             }
  20. {     DateComp = (Year-1980)*512 + (Month*64) + Day            }
  21. { It is used for comparing two dates to determine which is     }
  22. { earlier.                                                     }
  23. {--------------------------------------------------------------}
  24.  
  25. PROCEDURE GetDate(VAR Today : DateRec);
  26.  
  27. TYPE
  28.   String9 = String[9];
  29.   Reg     = RECORD
  30.               CASE Boolean OF
  31.                 False : (Word : Integer);
  32.                 True  : (LoByte,HiByte : Byte)
  33.             END;
  34.  
  35.   Regpack = RECORD
  36.               AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : Reg
  37.             END;
  38.  
  39.  
  40. CONST
  41.   MonthTags : ARRAY [1..12] of String9 =
  42.     ('January','February','March','April','May','June','July',
  43.      'August','September','October','November','December');
  44.   DayTags   : ARRAY [0..6] OF String9 =
  45.     ('Sunday','Monday','Tuesday','Wednesday',
  46.      'Thursday','Friday','Saturday');
  47.  
  48. VAR
  49.   Regs  : RegPack;
  50.   Temp1 : String80;
  51.  
  52. BEGIN
  53.   Regs.AX.HiByte := $2A; MSDOS(Regs);
  54.   WITH Today DO
  55.     BEGIN
  56.       Year := Regs.CX.Word;
  57.       Month := Regs.DX.HiByte;
  58.       Day := Regs.DX.LoByte;
  59.       DayOfWeek := Regs.AX.LoByte;
  60.       DateString := DayTags[DayOfWeek] + ', ';
  61.       Str(Day,Temp1);
  62.       DateString := DateString +
  63.         MonthTags[Month] + ' ' + Temp1 + ', ';
  64.       Str(Year,Temp1);
  65.       DateString := DateString + Temp1;
  66.       DateComp := (Year - 1980) * 512 + (Month * 64) + Day
  67.     END
  68. END;
  69. RD(CH) OF
  70.        8,127 : IF LENGTH(WORKER) <= 0 THEN BEEP ELSE
  71.                   BEGIN
  72.                     DELETE(WO