Keskustelu: Koodit: Pankkiviivakoodi (Crystal Syntax)

Function fcViivaKoodi(koodi as string) as string

    'Koodin oltava alussa 53 merkkiä pitkä, muuten jotain puuttuu
    if Len(koodi) <> 53 then
        fcViivaKoodi = ""
        exit function
    end if

    '======================='
    '===== TARKISTE 01 ====='
    '======================='
    Dim arvo, i, paino, luku As number
    dim paluu as string
    dim Tarkiste01 as string

    paino = 7
    arvo = 0

    '-- Lasketaan arvo painoarvoilla 7-3-1 lopusta lähtien
    For i = Len(koodi) To 1 Step -1
        luku = ToNumber(Mid(koodi, i, 1))
        arvo = arvo + (luku * paino)
        Select Case paino
        Case 7
            paino = 3
        Case 3
            paino = 1
        Case Else
            paino = 7
        End Select
    Next i

    '-- Tarkiste saadaan vähentämällä 10:stä yllä lasketun arvon yksittäisluku
    '-- Esim. jos arvo 123, niin tarkiste = 10 - 3 = 7
    Tarkiste01 = Left(ToText(10- Val(Mid(ToText(arvo), Len(ToText(arvo))-3,1))),1)

    '=== TARKISTE 01 END ==='

    koodi = koodi & tarkiste01

    '======================='
    '===== TARKISTE 02 ====='
    '======================='
    dim j, k as number
    dim tarkTemp02 as string
    dim tarkiste02 as string
    dim arvoTemp as string

    '-- Tarkiste saadaan laskemalla koodin luvut kertoimilla yhteen
    '-- kahden pareissa ja lopuksi jakolaskun jakojäännöksestä
    arvo = 105
    k = 1
    for i = 0 to Len(koodi) step 2
        luku = Val(Mid(koodi, i + 1, 2))
        arvo = arvo + luku * k
        k = k + 1
    next i
    arvoTemp = ToText(arvo Mod 103)

    '-- Kikkaillaan luku oikeaan muotoon poistamalla desimaalit
    tarkTemp02 = "00"
    For i = 1 To Len(arvoTemp)
        if mid(arvoTemp,i,1) = "," then
            exit for
        end if
        tarkTemp02 = tarkTemp02 & mid(arvoTemp,i,1)
    next i
    Tarkiste02 = right(tarkTemp02,2)

    '=== TARKISTE 02 END ==='

    koodi = koodi & tarkiste02

    '==================='
    '=== VIIVAKOODI ===='
    '==================='
    dim Viivakoodi as string
    dim Luvut as string

    Viivakoodi = chr(202)   'Alkumerkki

    '-- Lukuja yht. nyt 56 kpl (53+tarkiste01+tarkiste02),
    '-- käydään kahden pareissa läpi ja muodostetaan näistä viivakoodimerkit
    i = 1
    do until i > len(koodi)

        Luvut = mid(koodi,i,2)
        If Luvut = "00" then
            Viivakoodi = Viivakoodi & chr(204)
        Elseif val(luvut) > 94 then
            Viivakoodi = Viivakoodi & chr(val(Luvut)+97)
        else
            Viivakoodi = Viivakoodi & chr(val(Luvut)+32)
        End If

        i = i + 2
    loop

    Viivakoodi = Viivakoodi & chr(203)  'Lisätään vielä loppumerkki

    fcViivakoodi = Viivakoodi

end function