Güvenliğin öneminin arttıgı şu günlerde size yardımcı olabilmek için bilinen eski kodlamalardan(hatta 'sinyal bile diyebiliriz) olan morse alfabesi kullanarak metin dosyalarını şifreleme(crypt) ve deşifre etmek(decrypt) için hazırlamış oldugum bir program
'Değişken tanımlamaları Dim Source() As String Dim source2() As String Dim Temp As String Dim Temp2 As String Dim Hold As String Dim TextNum As Integer Dim FullText As String Dim n As Integer Dim i As Integer Dim FFILE Dim newline As String Dim alltext As String Private Sub Command1_Click()
On Error Resume Next txt1.Text = Replace(txt1.Text, ".", " . ") txt1.Text = Replace(txt1.Text, "-", " - ") txt2.Text = "" FullText = "" ' kelimedeki harf sayısını al TextNum = Len(txt1.Text) prg1.Max = TextNum For i = 0 To TextNum Temp = Left(txt1.Text, Len(txt1.Text) - _ Len(Right(txt1.Text, Len(txt1.Text) - (i + 1))))
Hold = Right(Temp, Len(Temp) - i)
Temp2 = ChartoMorse(Hold)
FullText = FullText & Temp2 & " " prg1.Value = i Next i txt2.Text = FullText Beep End Sub
Private Sub Command2_Click() On Error Resume Next txt1.Text = "" FullText = "" ' geçerli karakterleri al ve parçalara böl 3 karak. boşluk bırakmayı unutma) Source() = Split(txt2.Text, " ")
For n = 0 To UBound(Source()) source2() = Split(Source(n), " ") ' ilk satırdan son satıra kadar geçişi tamamla. For i = 0 To UBound(source2()) ' karakterleri al ve geçerli temp.'e kaydet Temp = source2(i) ' Morse'a ekleyelim Hold = MorsetoChar(Temp) ' Tüm texti ekleyelim FullText = FullText & Hold Next i FullText = FullText & " " Next n txt1.Text = FullText Beep End Sub
Private Function ChartoMorse(Ch As String) As String Select Case Ch Case "A", "a" ChartoMorse = ".-" Case "B", "b" ChartoMorse = "-..." Case "C", "c" ChartoMorse = "-.-." Case "D", "d" ChartoMorse = "-.." Case "E", "e" ChartoMorse = "." Case "F", "f" ChartoMorse = "..-." Case "G", "g" ChartoMorse = "--." Case "H", "h" ChartoMorse = "...." Case "I", "i" ChartoMorse = ".." Case "J", "j" ChartoMorse = ".---" Case "K", "k" ChartoMorse = "-.-" Case "L", "l" ChartoMorse = ".-.." Case "M", "m" ChartoMorse = "--" Case "N", "n" ChartoMorse = "-." Case "O", "o" ChartoMorse = "---" Case "P", "p" ChartoMorse = ".--." Case "Q", "q" ChartoMorse = "--.-" Case "R", "r" ChartoMorse = ".-." Case "S", "s" ChartoMorse = "..." Case "T", "t" ChartoMorse = "-" Case "U", "u" ChartoMorse = "..-" Case "V", "v" ChartoMorse = "...-" Case "W", "w" ChartoMorse = ".--" Case "X", "x" ChartoMorse = "-..-" Case "Y", "y" ChartoMorse = "-.--" Case "Z", "z" ChartoMorse = "--.." Case "1" ChartoMorse = ".----" Case "2" ChartoMorse = "..---" Case "3" ChartoMorse = "...--" Case "4" ChartoMorse = "....-" Case "5" ChartoMorse = "....." Case "6" ChartoMorse = "-...." Case "7" ChartoMorse = "--..." Case "8" ChartoMorse = "---.." Case "9" ChartoMorse = "----." Case "0" ChartoMorse = "-----" Case " " ChartoMorse = " " Case "." ChartoMorse = "^" Case "-" ChartoMorse = "~" Case Else ChartoMorse = Ch End Select End Function
Private Function MorsetoChar(Ch As String) As String Select Case Ch Case ".-" MorsetoChar = "a" Case "-..." MorsetoChar = "b" Case "-.-." MorsetoChar = "c" Case "-.." MorsetoChar = "d" Case "." MorsetoChar = "e" Case "..-." MorsetoChar = "f" Case "--." MorsetoChar = "g" Case "...." MorsetoChar = "h" Case ".." MorsetoChar = "i" Case ".---" MorsetoChar = "j" Case "-.-" MorsetoChar = "k" Case ".-.." MorsetoChar = "l" Case "--" MorsetoChar = "m" Case "-." MorsetoChar = "n" Case "---" MorsetoChar = "o" Case ".--." MorsetoChar = "p" Case "--.-" MorsetoChar = "q" Case ".-." MorsetoChar = "r" Case "..." MorsetoChar = "s" Case "-" MorsetoChar = "t" Case "..-" MorsetoChar = "u" Case "...-" MorsetoChar = "v" Case ".--" MorsetoChar = "w" Case "-..-" MorsetoChar = "x" Case "-.--" MorsetoChar = "y" Case "--.." MorsetoChar = "z" Case ".----" MorsetoChar = "1" Case "..---" MorsetoChar = "2" Case "...--" MorsetoChar = "3" Case "....-" MorsetoChar = "4" Case "....." MorsetoChar = "5" Case "-...." MorsetoChar = "6" Case "--..." MorsetoChar = "7" Case "---.." MorsetoChar = "8" Case "----." MorsetoChar = "9" Case "-----" MorsetoChar = "0" Case " " MorsetoChar = " " Case "^" MorsetoChar = "." Case "~" MorsetoChar = "-" Case Else MorsetoChar = Ch End Select End Function
Private Sub Command3_Click() On Error Resume Next cd1.Filter = "All Files|*.*" cd1.ShowSave If cd1.FileName <> "" Then Open cd1.FileName For Output As FFILE Print #FFILE, txt1.Text Close End If End Sub
Private Sub Command4_Click() On Error Resume Next cd1.Filter = "Morse Files|*.FTFmorse" cd1.ShowSave If cd1.FileName <> "" Then Open cd1.FileName For Output As FFILE Print #FFILE, txt2.Text Close End If End Sub
Private Sub Command5_Click() On Error Resume Next cd1.Filter = "All Files|*.*" cd1.ShowOpen If cd1.FileName <> "" Then Open cd1.FileName For Input As FFILE While Not EOF(FFILE) Line Input #FFILE, newtext alltext = alltext & newtext & vbCrLf Wend Close FFILE txt1.Text = alltext End If End Sub
Private Sub Command6_Click() On Error Resume Next cd1.Filter = "Morse Files|*.FTFmorse" cd1.ShowOpen If cd1.FileName <> "" Then Open cd1.FileName For Input As FFILE While Not EOF(FFILE) Line Input #FFILE, newtext alltext = alltext & newtext & vbCrLf Wend Close FFILE txt2.Text = alltext End If End Sub
Private Sub Command7_Click() frmSplash.Show
End Sub
Private Sub Command8_Click() txt1.Text = ""
End Sub
Private Sub Command9_Click() txt2.Text = ""
End Sub
Private Sub Form_Load() FFILE = FreeFile End Sub
Private Sub txt2_Change() On Error Resume Next txt2.SelLength = 0
If Len(txt2.Text) > 0 Then
If Right$(txt2.Text, 1) = vbCrLf Then txt2.SelStart = Len(txt2.Text) - 1 Exit Sub End If
txt2.SelStart = Len(txt2.Text) End If
End Sub Private Sub txt1_Change() On Error Resume Next txt1.SelLength = 0
If Len(txt1.Text) > 0 Then
If Right$(txt1.Text, 1) = vbCrLf Then txt1.SelStart = Len(txt1.Text) - 1 Exit Sub End If
Konu: VB'de Morse alfabesi ve şifreleme 
Çarş. Eyl. 26 2007, 00:52