Get File Date (Q-Basic)

[Matt-D]

Hello all,

I found this piece of code below which returnes the date of a file. When I try to run it, I says a sub-program wasn't defined (see my marker). This sub-program is in the file 'QB.BI'.

Here's the code:

'===========================================================================
 
' 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
  ''''''***** IT STOPS HERE in the line CALL INTERRUPTX
    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

Matt

[AndySoft]

When you run QuickBASIC, use "qb /l" or "qbx /l" not just "qb" or "qbx". If you want to specify the program file name, stick it before the "/l".

[Matt-D]

Thanks