From 70a1a14735370d81c7cf0979270c75ebf9b6ec33 Mon Sep 17 00:00:00 2001 From: Rufus King Date: Tue, 28 Jul 2026 17:09:50 -0400 Subject: [PATCH] Update Stock Time Stamp to Eastern Time --- Stocks/WebService/libreoffice_macro.txt | 252 ++++++++++++++++++++++-- 1 file changed, 241 insertions(+), 11 deletions(-) diff --git a/Stocks/WebService/libreoffice_macro.txt b/Stocks/WebService/libreoffice_macro.txt index 681c540..9ef4102 100644 --- a/Stocks/WebService/libreoffice_macro.txt +++ b/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. ' -' 2026-07-27 19:58:00 +' Example: +' +' stockproxy UTC: +' 2026-07-27 19:58:00 +' +' FUNDTIME: +' 2026-07-27 15:58:00 +' +' Eastern Time automatically observes: +' +' EDT = UTC-4 +' EST = UTC-5 ' -' The date and time are obtained from the stockproxy /current endpoint. ' ========================================================================= + 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. ' -' 2026-07-27 19:58:00 +' FUNDTIME converts that UTC timestamp to U.S. Eastern Time. ' -' This combines the "date" and "time" fields returned by stockproxy. +' During daylight saving time: +' +' EDT = UTC - 4 hours +' +' During standard time: +' +' EST = UTC - 5 hours +' +' Example: +' +' UTC: +' 2026-07-27 19:58:00 +' +' 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