ATOUTFOX
COMMUNAUTÉ FRANCOPHONE DES PROFESSIONNELS FOXPRO
Visual FoxPro : le développement durable

calcul de cle rib et de cle iban   


L'auteur

eric leissler
France France
Membre Simple
# 0000002784
enregistré le 06/03/2010
http://www.aumeric.fr
68 ans
LEISSLER Eric
85290 MORTAGNE SUR SEVRE
de la société AUMERIC LOGICIELS
Fiche personnelle

Note des membres
pas de note

Contributions > 01 - PRG : Programmation > Calculs de clefs et Checksums (rib, iban, ...)

calcul de cle rib et de cle iban
# 0000000716
ajouté le 02/09/2009 10:47:38 et modifié le 24/05/2010
consulté 12758 fois
Niveau débutant

Version(s) Foxpro :
VFP 9.0
VFP 8.0
VFP 7.0
VFP 6.0

Le téléchargement des pièces jointes est limité aux membres
Veuillez vous identifier ou vous inscrire si vous n'avez pas encore de compte ...
Description

Bonjour à tous

du code pratiquement comptatible VB NET et VFP pour calculer la cle rib ou la cle iban

? calculclerib( codebanque,codeguichet,nocompte)

codebanque 5 caractères

code guichet 5 caractères

nocompte 11 caractères

ex ? calculclerib("00000","00000","00000000000")

? Calculcleiban( codepays, rib)

codepays 2 caractères

rib 23 caractères ( 5 code banque 5 code guichet 11 nocompte, 2 clerib)

ex Calculcleiban("FR","00000000000000000000000")

Bonne journée à tous

umeric

Code source :
Function lirenombre(sStr As Variant )

public sCaption As String
LOCAL in_i    As Integer
LOCAL sString As String
LOCAL sCar    As String
    sString = CStr(sStr)
    in_i = 1
     Do While in_i <= Len(sString)
        sCar = substr(sString, in_i, 1)
        If Asc(sCar) < 48 Or Asc(sCar) > 57 Then
            sString = substr(sString, 1, in_i) + substr(sString, in_i + 1, Len(sString))
            in_i = in_i - 1
        EndIf
        in_i = in_i + 1
   enddo
    lirenombre = sString
  RETURN lirenombre
EndFunc



Function lirenumerocompte(sStr As Variant)
LOCAL in_i    As Integer
LOCAL sString As String
LOCAL iNb     As Integer
LOCAL sCar    As String
LOCAL sTemp   As String
    sString = CStr(sStr)
    in_i = 1
    Do While in_i <= Len(sString)
        sTemp = substr(sString, in_i, 1)
        If Asc(sTemp) < 48 Or Asc(sTemp) > 57 Then
            If Asc(sTemp) >= 65 Or Asc(sTemp) <= 90 Then
                iNb = Asc(sTemp) - 64
                   If iNb > 9 Then
                 iNb = iNb - 9
                 endif
                If iNb > 9 Then
                iNb = iNb - 8
                endif
                sCar = CStr(iNb)
                sString = substr(sString, 1, in_i - 1) + sCar + substr(sString, in_i + 1, Len(sString))
            Else
                If Asc(sTemp) >= 97 Or Asc(sTemp) <= 122 Then
                    iNb = Asc(sTemp) - 96
                    If iNb > 9 Then
                    iNb = iNb - 9
                    endif
                    If iNb > 9 Then
                    iNb = iNb - 8
                    endif
                     sCar = CStr(iNb)
                    sString = substr(sString, 1, in_i - 1) + sCar + substr(sString, in_i + 1, Len(sString))
                Else
                    sString = substr(sString, 1, in_i) + substr(sString, in_i + 1, Len(sString))
                   in_i = in_i - 1
                EndIf
            Endif
        EndIf
       in_i = in_i + 1
    enddo
     lirenumerocompte = sString
    RETURN lirenumerocompte
EndFunc



Function lirenumeroiban(sStr As String)

LOCAL in_i       As Integer
LOCAL sString    As String
LOCAL sStringRes As String
LOCAL iNb        As Integer
LOCAL sCar       As String
LOCAL sTemp      As String

    sString = sStr
    sStringRes = ""
    in_i = 1
      Do While in_i <= Len(sString)
        sTemp = substr(sString, in_i, 1)
        If Asc(sTemp) < 48 Or Asc(sTemp) > 57 Then
            If Asc(sTemp) >= 65 Or Asc(sTemp) <= 90 Then
                iNb = Asc(sTemp) - 55
                sCar = CStr(iNb)
                sStringRes = sStringRes + sCar
            Else
                If Asc(sTemp) >= 97 Or Asc(sTemp) <= 122 Then
                    iNb = Asc(sTemp) - 87
                    sCar = CStr(iNb)
                    sStringRes = sStringRes + sCar
                Else
                EndIf
            EndIf
        Else
            sStringRes = sStringRes + substr(sString, in_i, 1)
        EndIf
        in_i = in_i + 1
    ENDDO
     lirenumeroiban = sStringRes
RETURN lirenumeroiban
EndFunc



Function calculclerib(sCodeBanque As Variant, sCodeSiege As Variant, sNoCompte As Variant)

LOCAL CodeBanque     As String
LOCAL tCodeSiege    As String
LOCAL tNoCompte       As String

LOCAL in_A            As Variant
LOCAL in_B            As Variant
LOCAL in_C            As Variant
LOCAL in_D            As Variant
LOCAL in_E            As Variant
LOCAL in_F            As Variant
LOCAL in_G            As Variant
LOCAL in_H            As Variant
    tCodeBanque = lirenombre(sCodeBanque)
    tCodeSiege = lirenombre(sCodeSiege)
    tNoCompte = lirenumerocompte(sNoCompte)
    If Len(tCodeBanque) <> 5 Then
        MESSAGEBOX( "Le Code Banque n'a pas 5 caractères", vbCritical, Trim(sCaption))
        calculclerib = ""
        Exit Function
    EndIf
    If Len(tCodeSiege) <> 5 Then
        MESSAGEBOX("Le Code Guichet n'a pas 5 caractères", vbCritical, Trim(sCaption))
        calculclerib = ""
        Exit Function
    EndIf
    If Len(tNoCompte) > 11 Then
        MESSAGEBOX("Le Numéro de Compte est trop long, il ne doit pas comporter plus de 11 caractères", vbCritical, Trim(sCaption))
        calculclerib = ""
        Exit Function
    EndIf
    in_A = cvar(tCodeBanque)
    in_B = cvar(tCodeSiege)
    in_C = cvar(tNoCompte)
    in_D = 8 * in_A
    in_A = calculmodulo(in_D, 97)
    in_E = 15 * in_B
    in_B = 97 - calculmodulo(in_E, 97)
    in_F = 3 * in_C
    in_C = 97 - calculmodulo(in_F, 97)
    in_G = in_A + in_B + in_C
    in_H = MOD(in_G,97)
    calculclerib = IIf(in_H = 0, 97, in_H)
  RETURN calculclerib
EndFunc


Function Calculcleiban(sCodePays As String, sRib As String)

LOCAL tCodePays   As String
LOCAL tRib        As String
LOCAL tConcat     As String
LOCAL in_i        As Integer
LOCAL sRetenue    As Variant
LOCAL sCle        As Variant
LOCAL iNbInterm   As Variant
LOCAL sStrInterm  As Variant
LOCAL iCodeNum    As Integer
LOCAL sCodeStr    As String
LOCAL tIBAN       As String

    tRib = lirenumeroiban(sRib)
    tCodePays = lirenumeroiban(sCodePays)

    If Len(sCodePays) <> 2 Then
        MESSAGEBOX("Le Code Pays n'a pas 2 lettres", vbCritical, Trim(sCaption))
        Calculcleiban = ""
        Exit Function
    EndIf

    tConcat = tRib + tCodePays + "00"

    in_i = 1
    sRetenue = ""

    Do While in_i <= Len(tConcat)
        sStrInterm = sRetenue + substr(tConcat, in_i, 9)
        iNbInterm = INT(val(sStrInterm))
        sCle = calculmodulo(iNbInterm, 97)
        sRetenue = cstr(sCle)
        in_i = in_i + 9
    enddo

    iCodeNum = 98 - calculmodulo(sCle, 97)

    If iCodeNum < 10 Then
        sCodeStr = "0" + iCodeNum
    Else
        sCodeStr = iCodeNum
    EndIf

           scodestr=cstr(sCodeStr )


    tIBAN = sCodePays + sCodeStr + " " + substr(sRib, 1, 4)
    tIBAN = tIBAN + " " + substr(sRib, 5, 4)
    tIBAN = tIBAN + " " + substr(sRib, 9, 4)
    tIBAN = tIBAN + " " + substr(sRib, 13, 4)
    tIBAN = tIBAN + " " + substr(sRib, 17, 4)
    tIBAN = tIBAN + " " + substr(sRib, 21, 3)

    Calculcleiban = tIBAN
RETURN Calculcleiban
EndFunc


Function FormatRib(sCodeBanque As String, sCodeGuichet As String, sNoCompte As String, sCleRib As String)

LOCAL tCodeBanque     As String
LOCAL tCodeGuichet    As String
LOCAL tNoCompte       As String
LOCAL tCleRib         As String
LOCAL tCodeStr        As String
LOCAL tRib            As String
LOCAL iNbCleRib       As Integer

    tCodeBanque = lirenombre(sCodeBanque)
    tCodeGuichet = lirenombre(sCodeGuichet)
    tNoCompte = lirenumerocompte(sNoCompte)
    tCleRib = lirenombre(sCleRib)

    iNbCleRib = MOD(sCleRib,100)

    If tCleRib < 10 Then
        tCodeStr = "0" + iNbCleRib
    Else
        tCodeStr = iNbCleRib
    EndIf

    tRib = sCodeBanque + sCodeGuichet + sNoCompte + tCodeStr

    FormatRib = tRib
RETURN formatrib
EndFunc


Function calculmodulo(x As Variant, y As Variant) As Variant

*!*      calculmodulo = x - (Int(x / y) * y)
   calculmodulo  =  MOD(x,y)
RETURN calculmodulo
ENDFUNC

&& fonctions à ne pas mettre sous vb

FUNCTION cstr(truc)
IF VARTYPE(truc)=="N"
RETURN ALLTRIM(STR(truc))
ELSE
RETURN truc
endif
ENDFUNC

FUNCTION cvar(toto)
IF VARTYPE(toto)=="C"
RETURN VAL(toto)
ELSE
RETURN toto
ENDIF
endfunc
Commentaires
Aucun commentaire enregistré ...
www.atoutfox.org - Site de la Communauté Francophone des Professionnels FoxPro - v3.4.0 - © 2004-2024.
Cette page est générée par un composant COM+ développé en Visual FoxPro 9.0-SP2-HF3