Update Stock Time Stamp to Eastern Time

Stocks/WebService/libreoffice_macro.txt

@@ -1,30 +1,46 @@
 ' =========================================================================
+'
 ' StockFunctions.bas
 ' Collabora / LibreOffice Basic
 '
-' FUNDTIME now returns Yahoo's latest market update date/time:
+' FUNDTIME returns Yahoo's latest market update date/time
+' converted from UTC to U.S. Eastern Time.
 '
+' Example:
+'
+'     stockproxy UTC:
 '         2026-07-27 19:58:00
 '
-' The date and time are obtained from the stockproxy /current endpoint.
+'     FUNDTIME:
+'         2026-07-27 15:58:00
+'
+' Eastern Time automatically observes:
+'
+'     EDT = UTC-4
+'     EST = UTC-5
+'
 ' =========================================================================
 
+
 Option Explicit
 
+
 ' ---- Config -------------------------------------------------------------
 
 Function PROXY_BASE() As String
     PROXY_BASE = "https://stocks.kingdezigns.com"
 End Function
 
+
 Function PROXY_SECRET() As String
     PROXY_SECRET = "90c2528e9b5221c110f7c2c9cd6c65dc"
 End Function
 
 
-' ---- Public spreadsheet functions ---------------------------------------
+' ---- Public spreadsheet functions --------------------------------------
 
 Function FUNDPRICE(ticker As String) As Variant
+
     Dim sUrl As String
     Dim sJson As String
     Dim vPrice As Variant
@@ -46,10 +62,12 @@ Function FUNDPRICE(ticker As String) As Variant
     Else
         FUNDPRICE = vPrice
     End If
+
 End Function
 
 
 Function FUNDPRICE_HIST(ticker As String, dateStr As String) As Variant
+
     Dim sUrl As String
     Dim sJson As String
     Dim vPrice As Variant
@@ -72,23 +90,61 @@ Function FUNDPRICE_HIST(ticker As String, dateStr As String) As Variant
     Else
         FUNDPRICE_HIST = vPrice
     End If
+
 End Function
 
 
 ' ---- Yahoo market update date/time --------------------------------------
 '
-' Returns:
+' stockproxy supplies the Yahoo timestamp in UTC.
 '
+' FUNDTIME converts that UTC timestamp to U.S. Eastern Time.
+'
+' During daylight saving time:
+'
+'     EDT = UTC - 4 hours
+'
+' During standard time:
+'
+'     EST = UTC - 5 hours
+'
+' Example:
+'
+'     UTC:
 '         2026-07-27 19:58:00
 '
-' This combines the "date" and "time" fields returned by stockproxy.
+'     Eastern:
+'         2026-07-27 15:58:00
 '
 Function FUNDTIME(ticker As String) As String
+
     Dim sUrl As String
     Dim sJson As String
     Dim sDate As String
     Dim sTime As String
 
+    Dim iYear As Integer
+    Dim iMonth As Integer
+    Dim iDay As Integer
+    Dim iHour As Integer
+    Dim iMinute As Integer
+    Dim iSecond As Integer
+
+    Dim dUTC As Date
+    Dim dMarch As Date
+    Dim dNovember As Date
+    Dim dDSTStart As Date
+    Dim dDSTEnd As Date
+
+    Dim iMarchSunday As Integer
+    Dim iNovemberSunday As Integer
+    Dim iOffset As Integer
+
+
+    ' ---------------------------------------------------------------
+    ' Get current stock data from stockproxy
+    ' ---------------------------------------------------------------
+
     sUrl = PROXY_BASE() & "/current?ticker=" & EncodeUrl(ticker) & _
            "&key=" & PROXY_SECRET()
 
@@ -99,6 +155,11 @@ Function FUNDTIME(ticker As String) As String
         Exit Function
     End If
 
+
+    ' ---------------------------------------------------------------
+    ' Get UTC date and time from JSON
+    ' ---------------------------------------------------------------
+
     sDate = JsonString(sJson, "date")
     sTime = JsonString(sJson, "time")
 
@@ -107,14 +168,116 @@ Function FUNDTIME(ticker As String) As String
         Exit Function
     End If
 
-    FUNDTIME = sDate & " " & sTime
+
+    ' ---------------------------------------------------------------
+    ' Parse date
+    '
+    ' Expected:
+    '     YYYY-MM-DD
+    ' ---------------------------------------------------------------
+
+    iYear = CInt(Left(sDate, 4))
+    iMonth = CInt(Mid(sDate, 6, 2))
+    iDay = CInt(Right(sDate, 2))
+
+
+    ' ---------------------------------------------------------------
+    ' Parse time
+    '
+    ' Expected:
+    '     HH:MM:SS
+    ' ---------------------------------------------------------------
+
+    iHour = CInt(Left(sTime, 2))
+    iMinute = CInt(Mid(sTime, 4, 2))
+    iSecond = CInt(Right(sTime, 2))
+
+
+    ' ---------------------------------------------------------------
+    ' Create UTC date/time
+    ' ---------------------------------------------------------------
+
+    dUTC = DateSerial(iYear, iMonth, iDay)
+    dUTC = dUTC + TimeSerial(iHour, iMinute, iSecond)
+
+
+    ' ---------------------------------------------------------------
+    ' Find second Sunday in March
+    ' ---------------------------------------------------------------
+
+    dMarch = DateSerial(iYear, 3, 8)
+
+    iMarchSunday = 8 - WeekDay(dMarch)
+
+    If iMarchSunday < 0 Then
+        iMarchSunday = iMarchSunday + 7
+    End If
+
+    dDSTStart = dMarch + iMarchSunday
+
+    ' 2:00 AM EST = 07:00 UTC
+    dDSTStart = dDSTStart + TimeSerial(7, 0, 0)
+
+
+    ' ---------------------------------------------------------------
+    ' Find first Sunday in November
+    ' ---------------------------------------------------------------
+
+    dNovember = DateSerial(iYear, 11, 1)
+
+    iNovemberSunday = 8 - WeekDay(dNovember)
+
+    If iNovemberSunday < 0 Then
+        iNovemberSunday = iNovemberSunday + 7
+    End If
+
+    dDSTEnd = dNovember + iNovemberSunday
+
+    ' 2:00 AM EDT = 06:00 UTC
+    dDSTEnd = dDSTEnd + TimeSerial(6, 0, 0)
+
+
+    ' ---------------------------------------------------------------
+    ' Determine Eastern Time offset
+    ' ---------------------------------------------------------------
+
+    If dUTC >= dDSTStart And dUTC < dDSTEnd Then
+
+        ' Eastern Daylight Time
+        iOffset = 4
+
+    Else
+
+        ' Eastern Standard Time
+        iOffset = 5
+
+    End If
+
+
+    ' ---------------------------------------------------------------
+    ' Convert UTC to Eastern Time
+    ' ---------------------------------------------------------------
+
+    dUTC = dUTC - TimeSerial(iOffset, 0, 0)
+
+
+    ' ---------------------------------------------------------------
+    ' Return:
+    '
+    '     YYYY-MM-DD HH:MM:SS
+    ' ---------------------------------------------------------------
+
+    FUNDTIME = Format(dUTC, "YYYY-MM-DD HH:MM:SS")
+
 End Function
 
 
-' ---- Internal helpers ----------------------------------------------------
+' ---- Internal helpers ---------------------------------------------------
 
 ' Synchronous HTTP GET, returns response body as text, "" on failure.
+
 Function HttpGetText(sUrl As String) As String
+
     Dim oSFA As Object
     Dim oStream As Object
     Dim oTextStream As Object
@@ -132,21 +295,29 @@ Function HttpGetText(sUrl As String) As String
     sResult = ""
 
     Do While Not oTextStream.isEOF()
+
         sResult = sResult & oTextStream.readLine() & Chr(10)
+
     Loop
 
     oTextStream.closeInput()
 
     HttpGetText = sResult
+
     Exit Function
 
+
 ErrHandler:
+
     HttpGetText = ""
+
 End Function
 
 
 ' Pulls a numeric value out of a flat JSON string for a given key.
+
 Function JsonNumber(sJson As String, sKey As String) As Variant
+
     Dim iPos As Integer
     Dim iStart As Integer
     Dim iEnd As Integer
@@ -156,97 +327,147 @@ Function JsonNumber(sJson As String, sKey As String) As Variant
     iPos = InStr(sJson, Chr(34) & sKey & Chr(34))
 
     If iPos = 0 Then
+
         JsonNumber = Null
         Exit Function
+
     End If
 
+
     iPos = InStr(iPos, sJson, ":")
 
     If iPos = 0 Then
+
         JsonNumber = Null
         Exit Function
+
     End If
 
+
     iStart = iPos + 1
 
-    Do While iStart <= Len(sJson) And Mid(sJson, iStart, 1) = " "
+
+    Do While iStart <= Len(sJson) And _
+             Mid(sJson, iStart, 1) = " "
+
         iStart = iStart + 1
+
     Loop
 
+
     iEnd = iStart
 
+
     Do While iEnd <= Len(sJson)
+
         cChar = Mid(sJson, iEnd, 1)
 
         If (cChar >= "0" And cChar <= "9") Or _
            cChar = "." Or cChar = "-" Then
+
             iEnd = iEnd + 1
+
         Else
+
             Exit Do
+
         End If
+
     Loop
 
+
     sNum = Mid(sJson, iStart, iEnd - iStart)
 
+
     If Len(sNum) = 0 Then
+
         JsonNumber = Null
+
     Else
+
         JsonNumber = CDbl(sNum)
+
     End If
+
 End Function
 
 
 ' Pulls a quoted string value out of a flat JSON string.
+
 Function JsonString(sJson As String, sKey As String) As String
+
     Dim iPos As Integer
     Dim iColon As Integer
     Dim iQuoteStart As Integer
     Dim iQuoteEnd As Integer
 
+
     iPos = InStr(sJson, Chr(34) & sKey & Chr(34))
 
+
     If iPos = 0 Then
+
         JsonString = ""
         Exit Function
+
     End If
 
+
     iColon = InStr(iPos, sJson, ":")
 
+
     If iColon = 0 Then
+
         JsonString = ""
         Exit Function
+
     End If
 
+
     iQuoteStart = InStr(iColon, sJson, Chr(34))
 
+
     If iQuoteStart = 0 Then
+
         JsonString = ""
         Exit Function
+
     End If
 
+
     iQuoteEnd = InStr(iQuoteStart + 1, sJson, Chr(34))
 
+
     If iQuoteEnd = 0 Then
+
         JsonString = ""
         Exit Function
+
     End If
 
+
     JsonString = Mid(sJson, iQuoteStart + 1, _
                      iQuoteEnd - iQuoteStart - 1)
+
 End Function
 
 
 ' Minimal percent-encoder.
+
 Function EncodeUrl(s As String) As String
+
     Dim i As Integer
     Dim c As String
     Dim sOut As String
 
     sOut = ""
 
+
     For i = 1 To Len(s)
+
         c = Mid(s, i, 1)
 
+
         If (c >= "A" And c <= "Z") Or _
            (c >= "a" And c <= "z") Or _
            (c >= "0" And c <= "9") Or _
@@ -256,18 +477,23 @@ Function EncodeUrl(s As String) As String
 
         Else
 
-            sOut = sOut & "%" & Right("0" & Hex(Asc(c)), 2)
+            sOut = sOut & "%" & _
+                   Right("0" & Hex(Asc(c)), 2)
 
         End If
+
     Next i
 
+
     EncodeUrl = sOut
+
 End Function
 
 
 ' ---- Snapshot ------------------------------------------------------------
 
 Sub RefreshPriceSnapshot
+
     Dim oDoc As Object
     Dim oSheet As Object
     Dim i As Integer
@@ -275,7 +501,9 @@ Sub RefreshPriceSnapshot
     oDoc = ThisComponent
     oSheet = oDoc.Sheets.getByIndex(0)
 
+
     ' Copy P3:Q53 -> R3:S53 as values only
+
     For i = 2 To 4
 
         oSheet.getCellByPosition(17, i).setValue( _
@@ -286,5 +514,7 @@ Sub RefreshPriceSnapshot
 
     Next i
 
+
     MsgBox "Price snapshot refreshed."
+
 End Sub