Keskustelu: Koodit: VB6: Salaus alkoritmi

Option Explicit
Dim Kirjaimet As String
Dim Kokkeli As String
Dim Valmis As String
Dim Tavaraa As String


Private Sub Command1_Click()
On Error Resume Next
Kokkeli = MuodostaPakkaus(InputBox("Anna avain", "")) 'Kysytään että millä avaimella pakataan ja kutsutaan functiota muodostapakkaus
MsgBox "Purku avain on " & Kokkeli ' ilmotetaan purku avain function jälkeen
For i = 1 To Len(Text1.Text)
Text2.Text = Text2.Text + Mid(Kokkeli, InStr(Kokkeli, Mid(Text1.Text, i, 1)) + 1, 1) ' Ja kryptataan
DoEvents
Next i
End Sub

Private Sub Command2_Click()
On Error Resume Next
Kokkeli = Text3.Text
For i = 1 To Len(Text1.Text)
Text2.Text = Text2.Text + Mid(Kokkeli, InStr(Kokkeli, Mid(Text1.Text, i, 1)) - 1, 1)
DoEvents
Next i
'yksinkertaisesti purkaminen
End Sub

Public Function MuodostaPakkaus(Avain As String) As String
Static cc As Long
Dim i As Long
Dim c As Long 'pari muuttujaa
On Error Resume Next 'käsitellään erroorit
Randomize ' alustetaan satunaisluku generaattori
Tavaraa = "ABCDEFGHIJKLMNOPQRSTUVWXYZÅÄÖabcdefghijklmnopqrstuvwxyzåäö" ' määritellään aakkoset
For i = 255 To 1 Step -1 ' mennään i 255 - 1
Kirjaimet = Kirjaimet + Chr(Int(Rnd * 255) + i) 'Arvotaan ascii koodeista purkuavaimen ensimmäinen osa
DoEvents 'Ei jää jumiin
Next i
cc = cc + 1 'Aakkosten sijoittelu vaatii
Select Case cc
Case 1
c = -1
Case 2
c = 1
cc = 0
End Select
For i = 1 To Len(Kirjaimet)
Valmis = Valmis + Mid(Kirjaimet, i, 1) & Mid(Avain, i, 1) & Mid(Tavaraa, i + c, 1) 'Sijoitetaan avain ja aakkoset
DoEvents
Next i
MuodostaPakkaus = Valmis ' Valmista kuin mikä eli siis purku avain
End Function