' ========================================================================= ' ' StockFunctions.bas ' Collabora / LibreOffice Basic ' ' 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 ' ' 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 -------------------------------------- Function FUNDPRICE(ticker As String) As Variant Dim sUrl As String Dim sJson As String Dim vPrice As Variant sUrl = PROXY_BASE() & "/current?ticker=" & EncodeUrl(ticker) & _ "&key=" & PROXY_SECRET() sJson = HttpGetText(sUrl) If sJson = "" Then FUNDPRICE = "#ERROR" Exit Function End If vPrice = JsonNumber(sJson, "price") If IsNull(vPrice) Then FUNDPRICE = "#N/A" 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 sUrl = PROXY_BASE() & "/historical?ticker=" & EncodeUrl(ticker) & _ "&date=" & EncodeUrl(dateStr) & _ "&key=" & PROXY_SECRET() sJson = HttpGetText(sUrl) If sJson = "" Then FUNDPRICE_HIST = "#ERROR" Exit Function End If vPrice = JsonNumber(sJson, "price") If IsNull(vPrice) Then FUNDPRICE_HIST = "#N/A" Else FUNDPRICE_HIST = vPrice End If End Function ' ---- Yahoo market update date/time -------------------------------------- ' ' 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 ' ' 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() sJson = HttpGetText(sUrl) If sJson = "" Then FUNDTIME = "#ERROR" Exit Function End If ' --------------------------------------------------------------- ' Get UTC date and time from JSON ' --------------------------------------------------------------- sDate = JsonString(sJson, "date") sTime = JsonString(sJson, "time") If sDate = "" Or sTime = "" Then FUNDTIME = "#N/A" Exit Function End If ' --------------------------------------------------------------- ' 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 --------------------------------------------------- ' 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 Dim sResult As String On Error GoTo ErrHandler oSFA = createUnoService("com.sun.star.ucb.SimpleFileAccess") oStream = oSFA.openFileRead(sUrl) oTextStream = createUnoService("com.sun.star.io.TextInputStream") oTextStream.setInputStream(oStream) oTextStream.setEncoding("UTF-8") 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 Dim sNum As String Dim cChar As String 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) = " " 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 _ c = "-" Or c = "_" Or c = "." Or c = "~" Then sOut = sOut & c Else 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 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( _ oSheet.getCellByPosition(15, i).getValue()) oSheet.getCellByPosition(18, i).setValue( _ oSheet.getCellByPosition(16, i).getValue()) Next i MsgBox "Price snapshot refreshed." End Sub