home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / AAKXREF.ZIP / FDATNUMS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-04-25  |  2.3 KB  |  49 lines
  1. (********************************************************************)
  2. (* THIS PROCEDURE WILL RETURN THE DATE AND TIME OF LAST WRITE TO    *)
  3. (* THE INPUT FILE OR RETURN OK = FALSE                              *)
  4. (* INPUT        : THE FILE                                          *)
  5. (* INPUT/OUTPUT : NONE                                              *)
  6. (* OUTPUT       : MONTH,DAY,YEAR,HOUR,MINUTE,SEC,OK                 *)
  7. (* USES         : NO SIDE EFFECTS                                   *)
  8. (* CALLS        : MSDOS $57                                         *)
  9. (* ERRORS       : INVALID COMMAND, BAD HANDLE                       *)
  10. (* GLOBAL VARS  : NONE                                              *)
  11. (* SUBJECT      : FILE, DATE TIME, READ                             *)
  12. (* DOMAIN       : ARNO A. KARNER\PUBLIC               LEVEL : 001   *)
  13. (********************************************************************)
  14.  
  15. PROCEDURE  File_Date_Time_Num         ( VAR The_File : text ;
  16.                                         VAR Month    : Month_Number ;
  17.                                         VAR Day      : Day_Number ;
  18.                                         VAR Year     : Year_Number ;
  19.                                         VAR Hour     : Hour_Number ;
  20.                                         VAR Minute   : Minute_Number ;
  21.                                         VAR Second   : Second_Number ;
  22.                                         VAR OK       : BOOLEAN ) ;
  23.  
  24. VAR
  25.    Packed_Digits,
  26.    Handle      : INTEGER ;
  27.    Regs : reg ;
  28.  
  29. BEGIN (* PROC *)
  30.    OK := TRUE ;
  31.    Handle := MEMW [ SEG ( The_File ) : OFS ( The_File ) ] ;
  32.    Regs.al := 0;
  33.    Regs.AH := $57;
  34.    Regs.BX := Handle;
  35.    MSDOS ( Regs ) ;
  36.    IF ( Regs.Flags AND 1 <> 0 )
  37.    THEN OK := FALSE
  38.    ELSE BEGIN (* OK *)
  39.            Packed_Digits := Regs.dx;
  40.            Year          := ( Packed_Digits SHR 9 ) + 1980 ;
  41.            Month         := ( ( Packed_Digits SHR 5 ) and $000F ) ;
  42.            Day           := ( Packed_Digits and $001F ) ;
  43.            Packed_Digits := Regs.CX ;
  44.            Second        := ( Packed_Digits AND $1F ) * 2 ;
  45.            Minute        := ( Packed_Digits SHR 5 ) AND $3F ;
  46.            Hour          := Packed_Digits SHR 11 ;
  47.         END ; (* OK *)
  48. END ; (* PROC *)
  49.