Source code in the freebasic programming language

' version 23-06-2015
' compile with: fbc -s console

#Ifndef TRUE        ' define true and false for older freebasic versions
    #Define FALSE 0
    #Define TRUE Not FALSE
#EndIf

Function leapyear(Year_ As Integer) As Integer
    ' from the leapyear entry
    If (Year_ Mod 4) <> 0 Then Return FALSE
    If (Year_ Mod 100) = 0 AndAlso (Year_ Mod 400) <> 0 Then Return FALSE
    Return TRUE

End Function

Function wd(m As Integer, d As Integer, y As Integer) As Integer
    ' Zellerish
    ' 0 = Sunday, 1 = Monday, 2 = Tuesday, 3 = Wednesday
    ' 4 = Thursday, 5 = Friday, 6 = Saturday

    If m < 3 Then        ' If m = 1 Or m = 2 Then
        m += 12
        y -= 1
    End If
    Return (y + (y \ 4) - (y \ 100) + (y \ 400) + d + ((153 * m + 8) \ 5)) Mod 7
End Function

' ------=< MAIN >=------

Type month_days
    m_name As String
    days As UByte
End Type

Dim As month_days arr(1 To 12)
Data "January",   31, "February", 28, "March",    31, "April",    30
Data "May",       31, "June",     30, "July",     31, "August",   31
Data "September", 30, "October",  31, "November", 30, "December", 31

Dim As Integer yr, d, i, x
Dim As String keypress

For i = 1 To 12
    With arr(i)
        Read .m_name
        Read .days
    End With
Next

Do

    Do
        Print "For what year do you want to find the last Friday of the month"
        Input "any number below 1800 stops program, year in YYYY format";yr
        ' empty input also stops
        If yr < 1800 Then
            End
        Else
            Exit Do
        End If
    Loop

    Print : Print
    Print "Last Friday of the month for"; yr

    For i = 1 To 12
        d = arr(i).days
        If i = 2 AndAlso leapyear(yr) = TRUE Then d = d + 1
        x = wd(i, d, yr)
        If x <> 5 Then d = d - IIf(x > 5, x - 5, x + 2)
        Print d; " "; arr(i).m_name
    Next

    ' empty key buffer
    While InKey <> "" : keypress = InKey : Wend
    Print : Print
    Print "Find last Friday for a other year [Y|y], anything else stops"
    keypress =""
    While keypress = "" : keypress = InKey : Wend
    If LCase(keypress) <> "y" Then Exit Do
    Print : Print

Loop
End