RosettaCodeData/Task/SEDOLs/FreeBASIC/sedols.basic

94 lines
2.8 KiB
Plaintext

' version 05-07-2015
' compile with: fbc -s console
Function check_sedol(input_nr As String) As Integer
input_nr = Trim(input_nr)
Dim As Integer i, j, x, nr_begin, sum
Dim As String ch, legal = "AEIOU0123456789BCDFGHJKLMNPQRSTVWXYZ"
Dim As Integer weight(0 To ...) = { 1, 3, 1, 7, 3, 9, 1}
x = Len(input_nr)
If x < 6 Or x > 7 Then
Return -99 ' to long or to short
End If
For i = 0 To 5
ch = Chr(input_nr[i])
j = InStr(legal,ch)
If j < 6 Then
Return -90+j ' not a legal char. or a vowel
End If
j = ch[0] - Asc("0")
If j > 9 Then j = j + (Asc("0") + 10- Asc("A"))
If i = 0 AndAlso j < 10 Then nr_begin = 1
If nr_begin = 1 AndAlso i > 0 Then
If j > 9 Then Return -97 ' first is number then all be numbers
End If
sum = sum + j * weight(i)
Next
sum= ((10 - (sum Mod 10)) Mod 10)
If x = 7 Then
j=input_nr[6] - Asc("0") ' checksum digit is only number
If j = sum Then
Return 100+sum ' correct
Else
Return -98 ' wrong
End If
End If
Return sum ' checksum digit
End Function
Sub sedol(in As String)
Dim As Integer checksum = check_sedol(in)
Print(in);
Select Case checksum
Case -99
Print " Illegal SEDOL: wrong length"
Case -98
Print " Illegal SEDOL: checksum digits do not match"
Case -97
Print " Illegal SEDOL: starts with number, may only contain numbers"
Case -90
Print " Illegal SEDOL: illegal character"
Case -89 To -85
Print " Illegal SEDOL: No vowels allowed"
Case Is > 99
Print " Valid SEDOL: checksums match"
Case Else
Print " checksum calculated : ";in;Str(checksum)
End Select
End Sub
' ------=< MAIN >=------
Dim As Integer k,checksum
Dim As String in(1 To ...) = {"710889", "B0YBKJ", "406566", "B0YBLH",_
"228276", "B0YBKL", "557910", "B0YBKR",_
"585284", "B0YBKT", "B00030"}
Print "Calculated checksum"
For k = 1 To UBound(in) : sedol(in(k)) : Next
Print : Print "Check checksum"
Dim As String in1(1 To ...) = {"7108899", "B0YBKJ7", "4065663", "B0YBLH2",_
"2282765", "B0YBKL9","5579107", "B0YBKR5",_
"5852842", "B0YBKT7", "B000300"}
For k = 1 To UBound(in1) : sedol(in1(k)) : Next
Print : Print "Error test"
Dim As String errors(1 To ...) = {"12", "1234567890", "1B0000", "123 45",_
"A00000", "B000301"}
For k = 1 To UBound(errors) : sedol(errors(k)) : Next
' empty keyboard buffer
While Inkey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End