'===========================================================================
' Subject: GET/SET FILE DATE/TIME            Date: Unknown Date (00:00)   
' Author:  Matt Hart                         Code: QB, PDS                
' Keys:    GET,SET,FILE,DATE,TIME          Packet: DOS.ABC
'===========================================================================
' FILEDATE.BAS  by Matt Hart
'
' Gets or sets a file date/time
'
' GetFileDateTime returns the Date in MM-DD-YYYY format
'                     and the Time in HH:MM:SS
' SetFileDateTime expects the Date and Time in the same formats

    '$INCLUDE: 'QB.BI'    ' Use your path to QB or QBX.BI
    DEFINT A-Z
    DECLARE SUB GetFileDateTime (F$, Dat$, Tim$, Ecode%)
    DECLARE SUB SetFileDateTime (F$, Dat$, Tim$, Ecode%)

' ------------------------- Sample code
    F$ = LTRIM$(RTRIM$(COMMAND$))
    CALL GetFileDateTime(F$, Dat$, Tim$, Ecode)
    IF NOT Ecode THEN
	   PRINT F$; " date is "; Dat$
	   PRINT F$; " time is "; Tim$
    ELSE
	   PRINT "1 Error = "; Ecode
	   END
    END IF
    NewTim$ = "01:01:02"
    NewDat$ = "02-02-1980"
    CALL SetFileDateTime(F$, NewDat$, NewTim$, Ecode)
    IF Ecode THEN
	   PRINT "2 Error = "; Ecode
	   END
    END IF
    CALL GetFileDateTime(F$, Dat$, Tim$, Ecode)
    IF Ecode THEN
	   PRINT "3 Error = "; Ecode
	   END
    END IF
    PRINT F$; " new date is "; Dat$
    PRINT F$; " new time is "; Tim$
    CALL SetFileDateTime(F$, Dat$, Tim$, Ecode)
    IF Ecode THEN
	   PRINT "4 Error = "; Ecode
	   END
    END IF
    END
' ------------------------------------

SUB GetFileDateTime (F$, Dat$, Tim$, Ecode)
    Ecode = 0
    DIM InRegs AS RegTypeX
    DIM OutRegs AS RegTypeX
    InRegs.ax = &H3D00                          ' Open file function
    DIM FileName AS STRING * 128                ' Use fixed length
    FileName = F$ + CHR$(0)                     ' Must be ASCIIZ string
    InRegs.ds = VARSEG(FileName)                ' Fixed length makes these
    InRegs.dx = VARPTR(FileName)                ' come out right
    CALL INTERRUPTX(&H21, InRegs, OutRegs)      ' Open the file
    IF NOT OutRegs.flags THEN                   ' No error
	   Handle = OutRegs.ax                     ' Save DOS file handle
	   InRegs.ax = &H5700                      ' Get date/time function
	   InRegs.bx = Handle
	   CALL INTERRUPTX(&H21, InRegs, OutRegs)
	   HMS& = OutRegs.cx                       ' Use long integer for
	   IF HMS& < 0& THEN HMS& = 65536 + HMS&   ' positive numbers
	   Hours = HMS& \ 2048&                    ' Hours is first 5 bits
	   Minutes = (HMS& AND 2047&) \ 31&        ' Minutes is next 6 bits
	   Seconds = HMS& AND 31&                  ' Seconds is last 5 bits
	   H$ = LTRIM$(STR$(Hours))
	   M$ = LTRIM$(STR$(Minutes)): IF LEN(M$) = 1 THEN M$ = "0" + M$
	   S$ = LTRIM$(STR$(Seconds)): IF LEN(S$) = 1 THEN S$ = "0" + S$
	   Tim$ = H$ + ":" + M$ + ":" + S$
	   YMD& = OutRegs.dx                       ' Long int here too
	   IF YMD& < 0 THEN YMD& = 65536 + YMD&    ' Convert to + if needed
	   Year = 1980& + YMD& \ 512&              ' Year is first 7 bits
	   Month = (YMD& AND 511&) \ 31&           ' Month is next 4 bits
	   Day = YMD& AND 31&                      ' Day is last 5 bits
	   Y$ = LTRIM$(STR$(Year))
	   M$ = LTRIM$(STR$(Month))
	   D$ = LTRIM$(STR$(Day)): IF LEN(D$) = 1 THEN D$ = "0" + D$
	   Dat$ = M$ + "-" + D$ + "-" + Y$
	   InRegs.ax = &H3E00                      ' Close file function
	   InRegs.bx = Handle
	   CALL INTERRUPTX(&H21, InRegs, OutRegs)  ' Close it
    ELSE

	   Ecode = OutRegs.flags       ' Otherwise return error flags
    END IF
END SUB

SUB SetFileDateTime (F$, Dat$, Tim$, Ecode)
    Ecode = 0
    DIM InRegs AS RegTypeX
    DIM OutRegs AS RegTypeX
    InRegs.ax = &H3D00
    DIM FileName AS STRING * 128
    FileName = F$ + CHR$(0)
    InRegs.ds = VARSEG(FileName)
    InRegs.dx = VARPTR(FileName)
    CALL INTERRUPTX(&H21, InRegs, OutRegs)
    IF NOT OutRegs.flags THEN
	   Handle = OutRegs.ax
	   InRegs.ax = &H5701
	   InRegs.bx = Handle
	   Hours& = VAL(LEFT$(Tim$, 2)) * 2048&
	   Minutes& = VAL(MID$(Tim$, 4, 2)) * 32&
	   Seconds& = VAL(RIGHT$(Tim$, 2)) \ 2
	   HMS& = Hours& + Minutes& + Seconds&
	   IF HMS& > 65536 THEN
		  InRegs.cx = 65536 - HMS&
	   ELSE
		  InRegs.cx = HMS&
	   END IF
	   Year& = (VAL(RIGHT$(Dat$, 4)) - 1980&) * 512&
	   Month& = VAL(LEFT$(Dat$, 2)) * 32&
	   Day& = VAL(MID$(Dat$, 4, 2))
	   YMD& = Year& + Month& + Day&
	   IF YMD& > 65536 THEN
		  InRegs.dx = 65536 - YMD&
	   ELSE
		  InRegs.dx = YMD&
	   END IF
	   CALL INTERRUPTX(&H21, InRegs, OutRegs)
	   InRegs.ax = &H3E00
	   InRegs.bx = Handle
	   CALL INTERRUPTX(&H21, InRegs, OutRegs)
    ELSE
	   Ecode = OutRegs.flags
    END IF
END SUB