Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Date add routine

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Date add routine

    Code:
    '========================================================================================
    ' AddDays - Adds a specified number of days to the Date in the SYSTEMTIME struct
    '           May also be negative to go back in time....
    '           (I needed it for a backup routine to backup after xxx days)
    '           Is a windows remake of an old DOS Function.
    '           P.Lameijn - 26-04-2000
    '========================================================================================
    Sub AddDays ( ByRef ST As SYSTEMTIME, ByVal DaysToAdd As Long)
      Dim TempA As Local Long, TempB As Local Long, TempC As Local Long, lDays As Local Long
      TempA = (ST.wMonth - 14) \ 12
      TempB = ST.wDay-32075 + (1461 *(ST.wYear + 4800 + TempA) \ 4)
      TempB = TempB + (367*(ST.wMonth - 2 - TempA*12) \ 12)
      lDays = (TempB - (3 *((ST.wYear + 4900 + TempA) \ 100) \ 4) - 1721059) + DaysToAdd
      TempA = lDays + 68569 + 1721059
      TempB = 4 * TempA \ 146097
      TempA = TempA - (146097 * TempB + 3) \ 4
      ST.wYear = 4000 * (TempA + 1) \ 1461001
      TempC = ST.wYear
      TempA = TempA - (1461 * TempC \ 4) + 31
      ST.wMonth = 80 * TempA \ 2447
      TempC = ST.wMonth
      ST.wDay = TempA - (2447 * TempC \ 80)
      TempA = ST.wMonth \ 11
      ST.wMonth = ST.wMonth + 2 - (12 * TempA)
      ST.wYear = 100 * (TempB - 49) + ST.wYear + TempA
    End Sub
    -------------
    Kind regards,
    Peter.
    Regards,
    Peter

  • #2
    Here's a method that does it in milliseconds.
    Code:
    '************************************************************************************
    'Function IncrSYSTEMTIME increments the SYSTEMTIME structure by IncrValue milliseconds
    '************************************************************************************
    Function IncrSYSTEMTIME(st As SYSTEMTIME, ByVal IncrValue As Long)Export As Long
    Dim QT          As QuadFILETIME
    'FILETIME returns 100's of NANOSECONDS so you have to adjust
    IncrValue = IncrValue * 10000
    
    'Convert to QUAD time
    SystemTimeToFileTime ST,QT
    'Now Add the delay To the Quad-element that overlay the FILETIME-struct
    QT.qdTime = QT.qdTime + IncrValue
    'Convert back To SYSTEMTIME
    FileTimeToSystemTime QT,ST
    IncrValue = IncrValue \ 10000
    End Function
    '************************************************************************************
    
    '************************************************************************************
    'Function DecrSYSTEMTIME Decrements the SYSTEMTIME structure by IncrValue milliseconds
    '************************************************************************************
    Function DecrSYSTEMTIME(st As SYSTEMTIME, ByVal IncrValue As Long)Export As Long
    Dim QT          As QuadFILETIME
    'FILETIME returns 100's of NANOSECONDS so you have to adjust
    IncrValue = IncrValue * 10000
    
    'Convert to QUAD time
    SystemTimeToFileTime ST,QT
    QT.qdTime = QT.qdTime - IncrValue
    'Convert back To SYSTEMTIME
    FileTimeToSystemTime QT,ST
    IncrValue = IncrValue \ 10000 'unnecessary step unless required for another function
    End Function
    ------------------
    Scott
    mailto:[email protected][email protected]</A>

    [This message has been edited by Scott Turchin (edited May 02, 2000).]
    Scott Turchin
    MCSE, MCP+I
    http://www.tngbbs.com
    ----------------------
    True Karate-do is this: that in daily life, one's mind and body be trained and developed in a spirit of humility; and that in critical times, one be devoted utterly to the cause of justice. -Gichin Funakoshi

    Comment


    • #3
      Code:
      '==============================================================================
      ' Updated version of the AddDays routine. Can add positive or negative number
      ' of days to a SYSTEMTIME struct.
      ' P.Lameijn 12-04-2001
      '==============================================================================
      Type QuadFILETIME
        nS    As Quad
      End Type
      
      Sub AddDays ( ByRef ST As SYSTEMTIME, ByVal DaysToAdd As Long) Export
        Local QFT As QuadFileTime
        SystemTimeToFileTime ST, QFT
        QFT.ns = QFT.ns + (DaysToAdd * 600000000 * 60 * 24)
        FileTimeToSystemTime QFT,ST
      End Sub
      
      '==============================================================================
      ------------------
      Peter.
      mailto[email protected][email protected]</A>

      [This message has been edited by Peter Lameijn (edited June 17, 2001).]
      Regards,
      Peter

      Comment

      Working...
      X