FILECOPY FROM PDS

 BBS: Inland Empire Archive
Date: 07-26-92 (18:15)             Number: 100
From: MATT HART                    Refer#: NONE
  To: DEREK LYONS                   Recvd: NO  
Subj: FILECOPY FROM PDS              Conf: (2) Quik_Bas

 DL> Does anyone have a working filecopy routine for PDS that retains
 DL> the time/date stamp?  I've been fiddling with the QB version that

Set the time/date when finished:

' 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:'\BC71\QBX.BI'    ' Use your path to QB or QBX.BI
    DEFINT A-Z

' ------------------------- 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
    ENDIF
    NewTim$ = "01:01:02"
    NewDat$ = "02-02-1980"
    CALL SetFileDateTime(F$,NewDat$,NewTim$,Ecode)
    IF Ecode THEN
        PRINT "2 Error = ";Ecode
        END
    ENDIF
    CALL GetFileDateTime(F$,Dat$,Tim$,Ecode)
    IF Ecode THEN
        PRINT "3 Error = ";Ecode
        END
    ENDIF
    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
    ENDIF
    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
    ENDIF
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&
        ENDIF
        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&
        ENDIF
        CALL InterruptX(&H21, InRegs, OutRegs)
        InRegs.AX = &H3E00
        InRegs.BX = Handle
        CALL InterruptX(&H21, InRegs, OutRegs)
    ELSE
        Ecode = OutRegs.Flags
    ENDIF
END SUB

---
 * Origin: Midnight Micro!  V.32/REL  (918)451-3306 (1:170/600)