forward
global type nvo_fcrypttools from nvo
end type
end forward

global type nvo_fcrypttools from nvo autoinstantiate
end type

type prototypes
PROTECTED:

Function boolean                        &
lext_CryptStringToBinary (  string    pszString    ,  &
                  ulong    cchString    ,  &
                  ulong     dwFlags    ,  &
                Ref blob    pbBinary    ,  &
                Ref ulong  pcbBinary  ,  &
                Ref ulong  pdwSkip    ,  &
                Ref ulong  pdwFlags    &
) Library "SP2AddOn.dll" Alias For "CryptStringToBinaryW"
      
      
Function boolean                        &
lext_CryptBinaryToString  (   Blob pbBinary    ,     &
                  ulong cbBinary    ,     &
                  ulong dwFlags    ,     &
                Ref string pszString  ,     &
                Ref ulong pcchString      &
) Library "SP2AddOn.dll" Alias For "CryptBinaryToStringW"


end prototypes

type variables
PROTECTED:

// Artificiellement créée pour signaler l'objet où ont été déclarées les propriétés
// Non utilisée, simple séparateur pour l'IHM
Protected string is_nvo_fcryptTools = "-------- Propriétés de nvo_cryptTools ---------"

// Clé de cryptage
// Utilisé dans les fonctions of_encrypt() et of_decrypt()
Constant String i#_CryptKey = "$#@%&#%@&*"

// Constante utilisée dans les fonctions of_encoding() of_decoding()
Constant Long i#_CriptStringBase64 = 1

// Nombre de fois ou l'algorithme de codage est appelé
// Utilisé dans les fonctions of_encoding()
Long il_keyCode =1

end variables

forward prototypes
public function string of_encoding (string as_stringtoencode, ref string as_returnmessage)
protected function string of_encoding (blob ablob_data, ref string as_returnmessage)
protected function blob of_decoding (string as_encoded)
public function string of_decoding (string as_encoded, ref string as_returnmessage)
public function string of_encrypt (string as_chaine)
public function integer of_decrypt (string as_stringcrypte, ref string as_stringdecrypte)
end prototypes

public function string of_encoding (string as_stringtoencode, ref string as_returnmessage);//--------------------------------------------------------------------------------------------------------------------------------------------------
// Préalable : existence de of_decoding() version protected
//----------------------------------
// Objet : Encodage de la chaine cryptée passée en paramètre en une une chaîne non cryptée via
//      appel la fonction of_encoding() <ai_keyCode> fois de manière à éviter un décodage simple en faisant
//      appel à la dll fournit par windows
//----------------------------------
// Paramètres : as_stringtoEncode, chaîne de caractère à encoder passée en paramètre
//          as_returnMessage par référence, "OK" si le codage c'est correctement déroulé, un message d'erreur sinon
//---------------------------------
// Déclencheur : A la demande, routine de services
//--------------------------------
// Code retour : chaîne non cryptée
//-------------------------------------------------------------------------------------------------------------------------------------------------

Long  li_indice
String ls_returnMessage
String ls_null
Blob lblob_dataToEncode
String ls_stringEncoded

SetNull(ls_null)

lblob_dataToEncode = blob(as_stringtoencode)

TRY

For li_indice = 1 to il_keyCode
  ls_stringEncoded = of_encoding(lblob_dataToEncode,ls_returnMessage)
  lblob_dataToEncode = blob(ls_stringEncoded)
  If ls_returnMessage <> "OK" then
    return ls_null
  End if
Next

Return ls_stringEncoded

CATCH (runtimeerror er)
  as_returnMessage = "Erreur dans la fonction of_encoding() de la classe  " + this.className() + " (" + er.GetMessage() + ")"
  return ls_null
End Try



end function

protected function string of_encoding (blob ablob_data, ref string as_returnmessage);//----------------------------------------------------------------------------------------------------------------------
// Préalable : Existence de la fonction externe lext_CryptBinaryToString()
//-------------------------------
// Objet : Conversion du blob contenant les données cryptés en chaîne de caratère non cryptée
//------------------------------
// Déclencheur: of_encoding version publique
//-----------------------------
// Paramètres : as_encode, chaine de caractère passée en paramètre
//          ai_returnvalue, par référence  'OK' cryptage réussie,
//                              message d'erreur en cas d'échec du cryptage
//                              
//----------------------------
// Code retrour : long binary object non crypté
//---------------------------
// Précondiftions : la chaîne à cryptée doit avoir au moins une lonngueur supérieur à 2
//--------------------------------------------------------------------------------------------------------------------

String ls_null                // chaîne null retrounée en cas d'erreur
String ls_encoded              // chaîne décodée
ULong lul_len, lul_buflen          // passage par référence à la fonction lext_CryptBinaryToString()
Boolean lb_rtn                // passage par référence à la fonction lext_CryptBinaryToString()

as_returnmessage = "OK"

SetNull(ls_null)

lul_len = Len(ablob_data)

lul_buflen = lul_len * 2

If lul_len <= 2 then
  as_returnMessage = "La chaîne à crypter doit être supérieure à 2 caractères"
  return ls_null
End if


ls_encoded = Space(lul_buflen)

lb_rtn = lext_CryptBinaryToString(ablob_data        ,  &
                      lul_len          ,  & 
                      i#_CriptStringBase64  ,  &
                      ls_encoded        ,   &
                      lul_buflen)

If Not lb_rtn Then 
  as_returnMessage = "Le cryptage ne c'est pas correctement déroulé"  
  return ls_null
End if

Return ls_encoded

end function

protected function blob of_decoding (string as_encoded);//---------------------------------------------------------------------------------------------------------------------------------------
// Préalable : Existence de la fonction externe lext_CryptStringToBinary()
//-------------------------------
// Objet : Convertion de la chaine cryptée passée en paramètre en un long binary object non crypté
//------------------------------
// Paramètres : as_encode, chaine de caratère passé en paramètre
//          as_returnMessage par référence, "OK" si le décryptage c'est correctement déroulé, un message d'erreur sinon
//-----------------------------
// Déclencheur: of_decoding() version publique
//----------------------------
// Code retrour : long binary object non crypté
//--------------------------------------------------------------------------------------------------------------------------------------

Blob lblob_data            //  permet de transformer une chaine en blob
Long ll_lenString          //  permet de récupérr la lonhuer de la chaîne passé en paramètre
ULong lul_buflen          //  passage par référence à la fonction ext_CryptStringToBinary()
ULong lul_skip            //  passage par référence à la fonction ext_CryptStringToBinary()
ULong  lul_pflags          //  passage par référence à la fonction ext_CryptStringToBinary()
Boolean lb_rtn            //  passage par référence à la fonction ext_CryptStringToBinary()

ll_lenString = Len(as_encoded)

lul_buflen = ll_lenString

lblob_data = Blob(Space(ll_lenString))

lb_rtn = lext_CryptStringToBinary(  as_encoded          ,  &
                      ll_lenString          ,  &
                      i#_CriptStringBase64    ,  &
                      lblob_data          ,  &
                      lul_buflen          ,  &
                      lul_skip            ,  &
                      lul_pflags)

Return BlobMid(lblob_data, 1, lul_buflen)

end function

public function string of_decoding (string as_encoded, ref string as_returnmessage);//--------------------------------------------------------------------------------------------------------------------------------------------------------
// Préalable : existence de of_encoding() version protected
//----------------------------------
// Objet : Conversion de la chaine cryptée passée en paramètre en une chaîne non cryptée
//      appel la fonction of_encoding() <ai_keyCode> fois de manière à éviter un décodage simple en faisant
//      appel à la dll fournit par windows
//----------------------------------
// Déclencheur : A la demande, routine de services
//---------------------------------
// Paramètres : as_encode, chaîne de caractères passée en paramètre
//          as_returnMessage par référence, "OK" si le décryptage c'est correctement déroulé, un message d'erreur sinon
//--------------------------------
// Code retour : chaîne non cryptée
//--------------------------------------------------------------------------------------------------------------------------------------------------------

Long  li_indice
String ls_stringDecode
String ls_null

SetNull(ls_null)

ls_stringDecode = as_encoded

TRY

For li_indice = 1 to il_keyCode
  ls_stringDecode = String(of_decoding(ls_stringDecode))
Next

Return ls_stringDecode

CATCH (runtimeerror er)
  as_returnMessage = "Erreur dans la fonction of_decoding() de la classe  " + this.className() + " (" + er.GetMessage() + ")"
  return ls_null
End Try


end function

public function string of_encrypt (string as_chaine);//-------------------------------------------------------------------------------------------------------------------------------------
// Préalable : Existence de la clé de cryptage i#_CryptKey
//-------------------------------
// Objet : Conversion de la chaine passée en paramètre en une chaine cryptée
//------------------------------
// Paramètres : as_chaine, chaine de caractères à crypter
//-----------------------------
// Déclencheur: A la demande, routine de services
//----------------------------
// Code retour : Chaîne cryptée
//----------------------------
// Remarque : depuis PB 10.5 la chaîne cryptée est cryptée en unicode pour la cypter en ASCCI il convient de convertir
//          la chaine avec le code suivant :
//            lblob = blob(ls_chaineCrypte)
//            ls_chaineCrypte = string(blobMid(lblob,1,len(string(lblob))))
//---------------------------------------------------------------------------------------------------------------------------------------

Integer li_indice
Integer li_lenChaine          //  longueur de la chaine à crypter
String ls_chaineCrypte = ""      // Chaîne cryptée
Blob lblob

li_lenChaine = len(as_chaine)

For li_indice = 1 to li_lenChaine
  ls_chaineCrypte += mid(i#_CryptKey , mod(li_indice,10) + 1, 1)
    ls_chaineCrypte += String(Char(255 - Asc(Mid(as_chaine, li_indice, 1))))
Next

Return ls_chaineCrypte


end function

public function integer of_decrypt (string as_stringcrypte, ref string as_stringdecrypte);//---------------------------------------------------------------------------------------------------------------------------------------------
// Préalable : Existence de la clé de cryptage i#_CryptKey
//-------------------------------
// Objet : Conversion de la chaine cryptée passée en paramètre en une chaine non cryptée
//------------------------------
// Paramètres : as_stringCrypte, chaine de caractères cryptée EN UNICODE
//          as_stringDecrypte par référence contient les données de as_stringCrypte décrypté si le décryptage a réussi,
//                      chaine vide sinon
//-----------------------------
// Déclencheur: A la demande, routine de services
//----------------------------
// Code retour : 1, décryptage effectuée
//          -1, le décryptage a échoué
//-----------------------------
// Remarque : depuis PB 10.5 est passsé en unicode, le présent alogorithme ne fonctionne que la chaine à 
//          décrypter est cryptée en unicode
//------------------------------------------------------------------------------------------------------------------------------------------------

Integer  li_indice
Integer  li_lenChaineCrypte        // longueur de la chaine cryptée
String    ls_stringExtract          // chaine d'extraction 
String ls_mid                // chaine de travail interméiaire


li_lenChaineCrypte = len(as_stringCrypte)

IF not Mod(li_lenChaineCrypte, 2) = 1 then
   as_stringDecrypte = ""

   For li_indice = 2 to (li_lenChaineCrypte + 1) step 2
    ls_stringExtract  = Mid(as_stringCrypte, li_indice - 1, 1)
    ls_mid      = mid(i#_CryptKey, Mod(li_indice / 2, 10) + 1, 1)
    If ls_mid <> ls_stringExtract then
      Return -1
    End if     
        ls_stringExtract      = Mid(as_stringCrypte, li_indice, 1)
        as_stringDecrypte  += string(char(255 - asc(ls_stringExtract)))
  Next
End if


Return 1

end function

on nvo_fcrypttools.create
call super::create
end on

on nvo_fcrypttools.destroy
call super::destroy
end on