nas08-scripts/Stocks/WebService/libreoffice_macro.txt

' =========================================================================
' 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