nas08-scripts/Stocks/WebService/libreoffice_macro.txt

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