Calcul Cle ISMN

[Michael DELIQUE]

Code : Tout sélectionner

Function CleISMN(wISMN As String) As Integer
   
   'Déclaration variables
   Dim ISMN As String
   Dim i As Integer
   Dim nbCoef As Integer
   Dim Char As String
   
   On Error Goto ErreurHandle
   
   If Trim(wISMN) = "" Then
      CleISMN = -1
      Exit Function
   End If
   
   'le premier caractere doit être un M
   If Ucase(Left(Trim(wISMN),1)) <> "M" Then
      CleISMN = -1
      Exit Function
   End If
   
   'elemination des caracteres superflux
   'on remplace le M par un 3
   ISMN = "3"
   For i = 2 To Len(Trim(wISMN))
      Char = Mid(wISMN,i,1)
      If Char Like "[0-9]"  Then
         ISMN = ISMN+ Char
      End If
      Char = ""
   Next
   
   'sila taille = 10 c'est que la clé est ajouté
   If Len(ISMN) = 10 Then
      ISMN = Left(ISMN,9)
   End If
   
   If Len(ISMN) <> 9 Then
      CleISMN = -1
      Exit Function
   End If
   
   nbCoef = 1
   CleISMN = 0
   For i = 1 To Len(ISMN)
      Char = Mid(ISMN,i,1)
      If nbCoef = 3 Then
         nbCoef = 1
      Else
         nbCoef = 3
      End If
      CleISMN = CleISMN + (Cint(Char)*nbCoef)
      Char = ""
   Next
   ISMN = ""
   
   CleISMN = Cstr(10 - (CleISMN  Mod 10))
   
%REM
wikipedia

Pour calculer la clé de contrôle, chaque caractère de l'ISMN est multiplié par un poids, alternativement 3 et 1 de gauche à droite. La lettre M prend la valeur arbitraire 3. On additionne ensuite ces produits. La clé de contrôle est l'entier compris entre 0 et 9 qui permet à la somme d'atteindre le prochain multiple de 10.

Par exemple, pour l'ISMN commençant par M-060-11561:

3xM + 1x0 + 3x6 + 1x0 + 3x1 + 1x1 + 3x5 + 1x6 + 3x1 =
 9  +  0  +  18 +  0  +  3  +  1  +  15 +  6  +  3  =  55

55+5 = 60 est un multiple de 10, ainsi la clé de contrôle vaut 5 et l'ISMN complet est M-060-11561-5.
%END REM
   
   Exit Function
ErreurHandle:
   Msgbox "("+Cstr(Getthreadinfo (1))+" Call by "+Cstr(Getthreadinfo(10))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
   CleISMN = -1
   Exit Function
End Function