vernam chiffre

    • VB6

    Es gibt 2 Antworten in diesem Thema. Der letzte Beitrag () ist von wersi77.

      vernam chiffre

      Public Function vernam_chiffre(original As String, skey As String) As String
      Dim i As Long
      Dim bCode As Byte
      Dim bKey As Byte
      Dim bResult As Byte

      vernam_chiffre = ""

      If Len(original) <> Len(skey) Then
      MsgBox "Text und Key haben ungleiche Längen. " & _
      "Verfahren kann nicht angewendet werden."
      Exit Function
      End If

      For i = 1 To Len(original)
      bCode = Asc(Mid(original, i, 1))
      bKey = Asc(Mid(skey, i, 1))
      bResult = bCode Xor bKey
      vernam_chiffre = vernam_chiffre & Chr(bResult)
      Next i

      End Function


      Nachteil is', dass key und original die selbe länge haben müssen, aber dafür ist dieses verfahren doch recht sicher.

      m3rLiN
      mehr als ein LIPPER kann der Mensch kaum werden! :)

      Hier hätte ich auch noch eine Möglichkeit:
      Hier funktioniert es auch mit Nachrichtenlänge <> Schlüssellänge:

      Visual Basic-Quellcode

      1. Public Function vernam_encrypt(plainText As String, key As String)
      2. Dim i As Long
      3. Dim j As Long
      4. Dim letter As String
      5. Dim letterIndex As Integer
      6. Dim keyIndex As Integer
      7. Dim cipherText As String
      9. j = 1
      11. For i = 1 To Len(plainText)
      12. letterIndex = Asc(Mid(plainText, i, 1))
      13. If Len(key) > j Then
      14. j = 1
      15. End If
      16. keyIndex = Asc(Mid(key, j, 1))
      17. j = j + 1
      18. letterIndex = letterIndex + keyIndex
      19. cipherText = cipherText + Chr(letterIndex)
      20. letterIndex = 0
      21. Next i
      22. vernam_encrypt = cipherText
      23. End Function
      25. Public Function vernam_decrypt(cipherText As String, key As String)
      26. Dim i As Long
      27. Dim j As Long
      28. Dim letter As String
      29. Dim letterIndex As Integer
      30. Dim keyIndex As Integer
      31. Dim plainText As String
      33. j = 1
      35. For i = 1 To Len(cipherText)
      36. letterIndex = Asc(Mid(cipherText, i, 1))
      37. If Len(key) > j Then
      38. j = 1
      39. End If
      40. keyIndex = Asc(Mid(key, j, 1))
      41. j = j + 1
      42. letterIndex = letterIndex - keyIndex
      43. plainText = plainText + Chr(letterIndex)
      44. letterIndex = 0
      45. Next i
      46. vernam_decrypt = plainText
      47. End Function



      Edit by Mad Andy:
      VB-Tag eingefügt

      Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „Mad Andy“ ()

      Und hier noch der Vollständigkeit halber die Ver-/Entschlüsselungen für Caesar-Chiffre und Transposition:

      Visual Basic-Quellcode

      1. Public Function caesar_encrypt(plainText As String, key As Integer) As String
      2. Dim i As Long
      3. Dim letter As String
      4. Dim letterIndex As Integer
      5. Dim cipherText As String
      7. For i = 1 To Len(plainText)
      8. letterIndex = Asc(Mid(plainText, i, 1))
      9. letterIndex = letterIndex + key
      10. cipherText = cipherText + Chr(letterIndex)
      11. letterIndex = 0
      12. Next i
      14. caesar_encrypt = cipherText
      15. End Function
      17. Public Function caesar_decrypt(cipherText As String, key As Integer)
      18. Dim i As Long
      19. Dim letter As String
      20. Dim letterIndex As Integer
      21. Dim plainText As String
      23. For i = 1 To Len(cipherText)
      24. letterIndex = Asc(Mid(cipherText, i, 1))
      25. letterIndex = letterIndex - key
      26. plainText = plainText + Chr(letterIndex)
      27. letterIndex = 0
      28. Next i
      30. caesar_decrypt = plainText
      31. End Function
      33. Public Function trans_encrypt(plainText As String)
      34. Dim cipherText As String
      35. Dim nextSquareroot As Integer
      36. Dim plainTextIndex As Integer
      37. Dim i As Integer
      38. Dim j As Integer
      40. plainTextIndex = 1
      41. nextSquareroot = mod_main.get_next_squareroot(Len(plainText))
      42. 'MsgBox nextSquareroot
      43. ReDim square(nextSquareroot, nextSquareroot) As String
      44. If Len(plainText) / nextSquareroot <> Int(Len(plainText) / nextSquareroot) Then
      45. For i = 0 To nextSquareroot * nextSquareroot - Len(plainText)
      46. plainText = plainText + "X"
      47. Next i
      48. End If
      51. For j = 0 To nextSquareroot - 1
      52. For i = 0 To nextSquareroot - 1
      53. 'square(i, j) = "X"
      54. square(i, j) = Mid(plainText, plainTextIndex, 1)
      55. plainTextIndex = plainTextIndex + 1
      56. Next i
      57. Next j
      59. For i = 0 To nextSquareroot - 1
      60. For j = 0 To nextSquareroot - 1
      61. cipherText = cipherText + square(i, j)
      62. Next j
      63. Next i
      65. trans_encrypt = cipherText
      66. End Function
      68. Public Function trans_decrypt(cipherText As String)
      69. Dim plainText As String
      70. Dim squareroot As Integer
      71. Dim cipherTextIndex As Integer
      72. Dim i As Integer
      73. Dim j As Integer
      75. cipherTextIndex = 1
      76. squareroot = Math.Sqr(Len(cipherText))
      77. ReDim square(squareroot, squareroot) As String
      79. For j = 0 To squareroot - 1
      80. For i = 0 To squareroot - 1
      81. 'square(i, j) = "X"
      82. square(i, j) = Mid(cipherText, cipherTextIndex, 1)
      83. cipherTextIndex = cipherTextIndex + 1
      84. Next i
      85. Next j
      87. For i = 0 To squareroot - 1
      88. For j = 0 To squareroot - 1
      89. plainText = plainText + square(i, j)
      90. Next j
      91. Next i
      93. trans_decrypt = plainText
      94. End Function
      96. Public Function get_next_squareroot(number As Integer)
      97. Dim squaretest As Single
      98. Dim i As Integer
      100. For i = number To number * number
      101. squaretest = Math.Sqr(number)
      102. If squaretest = Int(squaretest) Then
      103. get_next_squareroot = squaretest
      105. Else: number = number + 1
      106. End If
      108. Next i
      109. End Function

    Facebook
    Telefonspende