' ========================================================================= ' StockFunctions.bas ' Collabora / LibreOffice Basic ' ' FUNDTIME now returns Yahoo's latest market update date/time: ' ' 2026-07-27 19:58:00 ' ' 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 --------------------------------------- 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 -------------------------------------- ' ' Returns: ' ' 2026-07-27 19:58:00 ' ' This combines the "date" and "time" fields returned by stockproxy. ' Function FUNDTIME(ticker As String) As String Dim sUrl As String Dim sJson As String Dim sDate As String Dim sTime As String sUrl = PROXY_BASE() & "/current?ticker=" & EncodeUrl(ticker) & _ "&key=" & PROXY_SECRET() sJson = HttpGetText(sUrl) If sJson = "" Then FUNDTIME = "#ERROR" Exit Function End If sDate = JsonString(sJson, "date") sTime = JsonString(sJson, "time") If sDate = "" Or sTime = "" Then FUNDTIME = "#N/A" Exit Function End If FUNDTIME = sDate & " " & sTime 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