[RESOLVED] Replace letters in string

[dgorenc]

Hello everybody!

Beginers question:
I do not know how to make a code where VB6 would automaticaly change the entered letters.

Example:
I have my own special alphabet letters: A=KU, B=DE, C=VE, D=SI
I enter a word into textbox: ABCDE
<then I press the button TRANSFORM>
I get out the result: KUDEVESI

Can you help me?

regards,
Dejan

[Neato]

This was a multi pc language written for a friend. It shows how to add custom alphabets to your application in real-time by switching them in the 'txtOutput' when you type them in the 'txtInput'. Hope it helps

Private Sub txtInput_Change()
txtOutput.Text = Ascii_CustomAlphabet(txtInput.Text, " 97 ", " 65 ", " 98 ", " 66 ", " 99 ", " 67 ", " 100 ", " 68 ", " 101 ", " 69 ", " 102 ", " 70 ", " 103 ", " 71 ", " 104 ", " 72 ", " 105 ", " 73 ", " 106 ", " 74 ", " 107 ", " 75 ", " 108 ", " 76 ", " 109 ", " 77 ", " 110 ", " 78 ", " 111 ", " 79 ", " 112 ", " 80 ", " 113 ", " 81 ", " 114 ", " 82 ", " 115 ", " 83 ", " 116 ", " 84 ", " 117 ", " 85 ", " 118 ", " 86 ", " 119 ", " 87 ", " 120 ", " 88 ", " 121 ", " 89 ", " 122 ", " 90 ")
End Sub
 
Function Ascii_CustomAlphabet(Text As String, LcaseA As String, UcaseA As String, LcaseB As String, UcaseB As String, LcaseC As String, UcaseC As String, LcaseD As String, UcaseD As String, LcaseE As String, UcaseE As String, LcaseF As String, UcaseF As String, LcaseG As String, UcaseG As String, LcaseH As String, UcaseH As String, LcaseI As String, UcaseI As String, LcaseJ As String, UcaseJ As String, LcaseK As String, UcaseK As String, LcaseL As String, UcaseL As String, LcaseM As String, UcaseM As String, LcaseN As String, UcaseN As String, LcaseO As String, UcaseO As String, LcaseP As String, UcaseP As String, LcaseQ As String, UcaseQ As String, LcaseR As String, UcaseR As String, LcaseS As String, UcaseS As String, LcaseT As String, UcaseT As String, LcaseU As String, UcaseU As String, LcaseV As String, UcaseV As String, LcaseW As String, UcaseW As String, LcaseX As String, UcaseX As String, LcaseY As String, UcaseY As String, LcaseZ As String, UcaseZ As String) As String
 
Dim NextKey As String, InputText As String, TextLength As Integer, NextKey2 As String, NewSent As String, SpaceBar As String, Spacing As Integer, SendSpacing As Integer
Let InputText$ = Text$
Let TextLength% = Len(InputText$)
Do While Spacing% <= TextLength%
Let SpaceBar = " 32 "
Let Spacing% = Spacing% + 1
Let NextKey$ = Mid$(InputText$, Spacing%, 1)
Let NextKey2$ = Mid$(InputText$, Spacing%, 2)
If NextKey$ = "A" Then Let NextKey$ = UcaseA$
If NextKey$ = "a" Then Let NextKey$ = LcaseA$
If NextKey$ = "B" Then Let NextKey$ = UcaseB$
If NextKey$ = "b" Then Let NextKey$ = LcaseB$
If NextKey$ = "C" Then Let NextKey$ = UcaseC$
If NextKey$ = "c" Then Let NextKey$ = LcaseC$
If NextKey$ = "D" Then Let NextKey$ = UcaseD$
If NextKey$ = "d" Then Let NextKey$ = LcaseD$
If NextKey$ = "E" Then Let NextKey$ = UcaseE$
If NextKey$ = "e" Then Let NextKey$ = LcaseE$
If NextKey$ = "F" Then Let NextKey$ = UcaseF$
If NextKey$ = "f" Then Let NextKey$ = LcaseF$
If NextKey$ = "G" Then Let NextKey$ = UcaseG$
If NextKey$ = "g" Then Let NextKey$ = LcaseG$
If NextKey$ = "H" Then Let NextKey$ = UcaseH$
If NextKey$ = "h" Then Let NextKey$ = LcaseH$
If NextKey$ = "I" Then Let NextKey$ = UcaseI$
If NextKey$ = "i" Then Let NextKey$ = LcaseI$
If NextKey$ = "J" Then Let NextKey$ = UcaseJ$
If NextKey$ = "j" Then Let NextKey$ = LcaseJ$
If NextKey$ = "K" Then Let NextKey$ = UcaseK$
If NextKey$ = "k" Then Let NextKey$ = LcaseK$
If NextKey$ = "L" Then Let NextKey$ = UcaseL$
If NextKey$ = "l" Then Let NextKey$ = LcaseL$
If NextKey$ = "M" Then Let NextKey$ = UcaseM$
If NextKey$ = "m" Then Let NextKey$ = LcaseM$
If NextKey$ = "N" Then Let NextKey$ = UcaseN$
If NextKey$ = "n" Then Let NextKey$ = LcaseN$
If NextKey$ = "O" Then Let NextKey$ = UcaseO$
If NextKey$ = "o" Then Let NextKey$ = LcaseO$
If NextKey$ = "P" Then Let NextKey$ = UcaseP$
If NextKey$ = "p" Then Let NextKey$ = LcaseP$
If NextKey$ = "Q" Then Let NextKey$ = UcaseQ$
If NextKey$ = "q" Then Let NextKey$ = LcaseQ$
If NextKey$ = "R" Then Let NextKey$ = UcaseR$
If NextKey$ = "r" Then Let NextKey$ = LcaseR$
If NextKey$ = "S" Then Let NextKey$ = UcaseS$
If NextKey$ = "s" Then Let NextKey$ = LcaseS$
If NextKey$ = "T" Then Let NextKey$ = UcaseT$
If NextKey$ = "t" Then Let NextKey$ = LcaseT$
If NextKey$ = "U" Then Let NextKey$ = UcaseU$
If NextKey$ = "u" Then Let NextKey$ = LcaseU$
If NextKey$ = "V" Then Let NextKey$ = UcaseV$
If NextKey$ = "v" Then Let NextKey$ = LcaseV$
If NextKey$ = "W" Then Let NextKey$ = UcaseW$
If NextKey$ = "w" Then Let NextKey$ = LcaseW$
If NextKey$ = "X" Then Let NextKey$ = UcaseX$
If NextKey$ = "x" Then Let NextKey$ = LcaseX$
If NextKey$ = "Y" Then Let NextKey$ = UcaseY$
If NextKey$ = "y" Then Let NextKey$ = LcaseY$
If NextKey$ = "Z" Then Let NextKey$ = UcaseZ$
If NextKey$ = "z" Then Let NextKey$ = LcaseZ$
If NextKey$ = " " Then Let NextKey$ = SpaceBar
Let NewSent$ = NewSent$ + NextKey$
If SendSpacing% > 0 Then Let SendSpacing% = SendSpacing% - 1
Loop
Ascii_CustomAlphabet = NewSent$
End Function

[MartinLiss]

dgorenc, the problem is complicated by the fact that, for example, your translation of B gives a D which is translated to something else. The following handles that.

    Const PLAIN_TEXT = "ABCD"
    Dim strCrypt As String
    Dim strText() As String
    Dim lngIndex As Long
    
    ' Split the text into it's individual letters
    ReDim strText(0)
    For lngIndex = 1 To Len(PLAIN_TEXT)
        strText(lngIndex - 1) = Mid$(PLAIN_TEXT, lngIndex, 1)
        ReDim Preserve strText(UBound(strText) + 1)
    Next
    ' Remove the last entry because it's blank
    ReDim Preserve strText(UBound(strText) - 1)
    
    ' Translate the individual letters
    For lngIndex = 0 To UBound(strText)
        Select Case strText(lngIndex)
            Case "A"
                strText(lngIndex) = "KU"
            Case "B"
                strText(lngIndex) = "DE"
            Case "C"
                strText(lngIndex) = "VE"
            Case "D"
                strText(lngIndex) = "SI"
            Case "E" ' etc
        End Select
    Next
    
    ' Put the string back together
    For lngIndex = 0 To UBound(strText)
        strCrypt = strCrypt & strText(lngIndex)
    Next

    MsgBox strCrypt

[MartinLiss]

BTW

[anhn]

Hope this will help.

Option Explicit

Dim myAlphabet() As String
Dim InitDone As Boolean

Sub InitAlphabet()
   '-- make sure sCode contains 26 items separated by comma
   Const sCode = "SN,PH,HU,AT,VS,BK,WU,JZ,WB,YJ,NT,BP,MH,QQ,GH,VV,PZ,XF,SZ,GN,CZ,RA,OC,CU,HB,HJ"
   myAlphabet = Split(sCode, ",")
   InitDone = True
End Sub

Function Encrypt(sInText As String) As String
   Dim i As Integer
   Dim sOutText As String
   Dim Ch As String
   
   If InitDone = False Then InitAlphabet
   
   For i = 1 To Len(sInText)
      Ch = UCase(Mid(sInText, i, 1))
      If Ch >= "A" And Ch <= "Z" Then
         Ch = myAlphabet(Asc(Ch) - 65) '-- Asc("A") = 65
      Else
         Ch = "--"
      End If
      sOutText = sOutText & Ch
   Next
   Encrypt = sOutText
End Function

Sub CommandButton1_Click()
   MsgBox Encrypt(Text1.Text)
End Sub

Sub Test()
   MsgBox Encrypt("Bill Gates")
   MsgBox Encrypt("HELLO")
End Sub

[dgorenc]

I am impressed with the responce and the quality of it.
PROBLEM SOLVED IN 5 MIN! for me

Thank you all!

Dejan

[MartinLiss]

Now that we've helped you, you can help us by pulling down the Thread Tools menu and clicking the Mark Thread Resolved button which will let everyone know that you have your answer.

[dgorenc]

done.