MS Access VBA Cifrario a Sostituzione Crittografare/Decrittografare

Qualcuno potrebbe suggerire, per favore, come posso realizzare un cifrario a sostituzione di uno stile di crittografare e decrittografare funzione in VBA. Apprezzo l’hashing è considerato il modo migliore, ma ho bisogno di crittografia reversibile. Molte Grazie.

  • Non si dispone già di uno che hai provato a postare?
  • Jean mi ha detto di postare prima, ma ignorato le regole di overflow dello stack mi dispiace dire che, in questo modo è meglio come le persone stanno offrendo risposte e altri possono essere in grado di trovare, in futuro, attraverso una ricerca su google ecc

 

3 Replies
  1. 2

    C’è un semplice esempio qui o è possibile utilizzare anche il più semplice ROT13 di crittografia.

    Questi sono utili per nascondere un po ‘ di testo, ma preferirei non usarli per qualcosa che in realtà ha bisogno di essere conservati in modo sicuro.

  2. 2

    Molte grazie per tutte le risposte fornite in riferimento alla mia domanda, è bello vedere che ci sono diversi approcci, questo è quello che ho codificato ieri mattina. Permette un algoritmo diverso parola/frase-chiave per essere utilizzato sia Superiore & lettere Minuscole, ho usato ‘Zebre’ in questo esempio, viene eseguito anche un secondo passaggio con il ROT13 di crittografia. Metodo di crittografia:

    Public Function Encrypt(strvalue As String) As String
    
    Const LowerAlpha    As String = "abcdefghijklmnopqrstuvwxyz"
    Const LowerSub      As String = "zebrascdfghijklmnopqtuvwxy" 'zebras
    Const UpperAlpha    As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    Const UpperSub      As String = "ZEBRASCDFGHIJKLMNOPQTUVWXY" 'ZEBRAS
    
    Dim lngi            As Long
    Dim lngE            As Long
    Dim strEncrypt      As String
    Dim strLetter       As String
    
    If strvalue & "" = "" Then Exit Function
    
    For lngi = 1 To Len(strvalue)
    
        strLetter = Mid(strvalue, lngi, 1)
    
        Select Case Asc(strLetter)
    
            Case 65 To 90 'Uppercase
                'Find position in alpha string
                For lngE = 1 To Len(UpperAlpha)
                    If Mid(UpperAlpha, lngE, 1) = strLetter Then GoTo USub
                Next
    USub:
                strEncrypt = strEncrypt & Mid(UpperSub, lngE, 1)
    
            Case 97 To 122 'Lowercase
                'Find position in alpha string
                For lngE = 1 To Len(LowerAlpha)
                    If Mid(LowerAlpha, lngE, 1) = strLetter Then GoTo LSub
                Next
    LSub:
                strEncrypt = strEncrypt & Mid(LowerSub, lngE, 1)
    
            Case Else 'Do not substitute
    
                strEncrypt = strEncrypt & strLetter
    
        End Select
    
    Next
    
    'Now pass this string through ROT13 for another tier of security
    
    For lngi = 1 To Len(strEncrypt)
        Encrypt = Encrypt & Chr(Asc(Mid(strEncrypt, lngi, 1)) + 13)
    Next
    
    End Function

    E questo è il tentativo che va con esso:

    Public Function Decrypt(strvalue As String) As String
    
    Const LowerAlpha    As String = "abcdefghijklmnopqrstuvwxyz"
    Const LowerSub      As String = "zebrascdfghijklmnopqtuvwxy" 'zebras
    Const UpperAlpha    As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    Const UpperSub      As String = "ZEBRASCDFGHIJKLMNOPQTUVWXY" 'ZEBRAS
    
    Dim lngi            As Long
    Dim lngE            As Long
    Dim strDecrypt      As String
    Dim strLetter       As String
    
    If strvalue & "" = "" Then Exit Function
    
    'Reverse the ROT13 cipher
    
    For lngi = 1 To Len(strvalue)
        strDecrypt = strDecrypt & Chr(Asc(Mid(strvalue, lngi, 1)) - 13)
    Next
    
    'Now reverse the encryption
    
    For lngi = 1 To Len(strDecrypt)
    
        strLetter = Mid(strDecrypt, lngi, 1)
    
        Select Case Asc(strLetter)
    
            Case 65 To 90 'Uppercase
                'Find position in sub string
                For lngE = 1 To Len(UpperSub)
                    If Mid(UpperSub, lngE, 1) = strLetter Then GoTo USub
                Next
    USub:
                Decrypt = Decrypt & Mid(UpperAlpha, lngE, 1)
    
            Case 97 To 122 'Lowercase
                'Find position in sub string
                For lngE = 1 To Len(LowerSub)
                    If Mid(LowerSub, lngE, 1) = strLetter Then GoTo LSub
                Next
    LSub:
                Decrypt = Decrypt & Mid(LowerAlpha, lngE, 1)
    
            Case Else 'Do not substitute
    
                Decrypt = Decrypt & strLetter
    
        End Select
    
    Next
    
    End Function

    Spero che la codifica è molto semplice da seguire per coloro che non hanno una vasta esperienza con VBA di codifica e può essere sollevata direttamente dalla pagina; ma, di nuovo grazie per tutte le altre risposte.

    • Questo è molto debole (scusa) di una crittografia di confine del ridicolo. Provare qualcosa di più forte come RC4 che può essere implementato in meno di linee di codice. Vedi qui: stackoverflow.com/questions/7025644/…
    • Apprezzo Sub Cifre sono abbastanza vecchio ormai e non è considerata la migliore, ma ho solo bisogno di qualcosa di semplice in questo caso, devo ammettere però che questa stringa crittografata sembra piuttosto fresco “S€4-XY^-x’~-zRrur€r|-€pz€-“px-px-“|-~|zVV†-z~|9-r€-r-=’~-p=>|” Se qualcuno ha tempo per poi dare la decrittografia è una favola, mi piacerebbe vedere quanto sia facile in realtà. : )

Lascia un commento