'Codificatore 1.05 by Piero Tofy © 2003 Revisione da Codificatore creato nel 2002 |
'Creato in Visual Basic 6.0 |
'Sito: Http://www.pierotofy.too.it |
'-----------------------------------------------------------------------------------|
Dim lunghezzatesto As Single
Dim livellox As Single
Private Sub cmdabout_Click()
MsgBox "Codificatore 1.05 Copyright © by Piero Tofy 2003", , "About"
End Sub
Private Sub cmdalto_Click()
livellox = 2
cmdnormale.Checked = False
cmdalto.Checked = True
cmdestremo.Checked = False
End Sub
Private Sub cmdestremo_Click()
livellox = 3
cmdnormale.Checked = False
cmdalto.Checked = False
cmdestremo.Checked = True
End Sub
Private Sub cmdnormale_Click()
livellox = 1
cmdnormale.Checked = True
cmdalto.Checked = False
cmdestremo.Checked = False
End Sub
Private Sub cmdok_Click()
On Error GoTo 1
'Assegna ad una variabile il contenuto del testo
Dim original As String
original = LCase(normal.Text)
'Ripete il ciclo a seconda del livello di codificazione
Dim count As Single
For count = 1 To livellox
lunghezzatesto = Len(normal.Text)
Dim numeroper As Single
numeroper = lunghezzatesto / 100
code.Text = ""
normal.Text = LCase(normal.Text)
Dim lunghezza As Single
lunghezza = Len(normal.Text)
Dim x
For x = 1 To lunghezza
DoEvents
'Mostra la percentuale rimanente sulla barra del titolo
Dim difflen As Single
difflen = lunghezzatesto - x
Dim percentuale As Single
percentuale = 100 - (difflen / numeroper)
cod.Caption = "Codificatore | " & "Livello: " & count & " | " & percentuale & "%"
'Codifica il testo...
Dim testo As String
testo = Mid(normal.Text, x, 1)
Dim find As String
Select Case testo
Case "a"
find = "17-"
Case "b"
find = "9-"
Case "c"
find = "21-"
Case "d"
find = "26-"
Case "e"
find = "14-"
Case "f"
find = "1-"
Case "g"
find = "16-"
Case "h"
find = "22-"
Case "i"
find = "24-"
Case "l"
find = "11-"
Case "m"
find = "8-"
Case "n"
find = "25-"
Case "o"
find = "4-"
Case "p"
find = "2-"
Case "q"
find = "20-"
Case "r"
find = "6-"
Case "s"
find = "13-"
Case "t"
find = "19-"
Case "u"
find = "3-"
Case "v"
find = "23-"
Case "z"
find = "7-"
Case "j"
find = "18-"
Case "w"
find = "12-"
Case "y"
find = "5-"
Case "k"
find = "10-"
Case "x"
find = "15-"
'Spazio
Case " "
find = "27-"
'Punto esclamativo
Case "!"
find = "28-"
'Punto interrogativo
Case "?"
find = "29-"
'Accentate
Case "è"
find = "30-"
Case "ò"
find = "31-"
Case "à"
find = "32-"
Case "ù"
find = "33-"
Case "ì"
find = "34-"
'Se è un numero
Case "0"
find = "44-"
Case "1"
find = "45-"
Case "2"
find = "36-"
Case "3"
find = "41-"
Case "4"
find = "46-"
Case "5"
find = "37-"
Case "6"
find = "43-"
Case "7"
find = "39-"
Case "8"
find = "47-"
Case "9"
find = "40-"
'Se è un punto una virgola doppio punto o linetta
Case ","
find = "38-"
Case "."
find = "42-"
Case ":"
find = "35-"
Case "-"
find = "48-"
'Se è un'altra lettera...
Case Else
find = ""
End Select
code.Text = code.Text & find
Next x
normal.Text = code.Text
Next count
normal.Text = original
'Scrive all'inizio del codice generato il livello di codificazione
code.Text = CStr(livellox) & "-" & code.Text
'Scrive complete 100%!
cod.Caption = "Codificatore | 100% Complete!"
Exit Sub
1
MsgBox "Errore nel processo di codificazione. Molto probabilmente è colpa del testo che hai inserito! Controlla il testo che hai inserito e riprova. Se il problema non si risolve contatta il produttore!", , "Errore"
cod.Caption = "Codificatore |"
Exit Sub
End Sub
Private Sub cmdok2_Click()
On Error GoTo 1
'Assegna ad una variabile il contenuto del testo
Dim original As String
original = LCase(code.Text)
'Guarda il livello di codificazione e tronca la stringa inutile...
livellox = CSng(Mid(code.Text, 1, 1))
code.Text = Right(code.Text, Len(code.Text) - 2)
'Ripete il ciclo a seconda del livello di codificazione
Dim count As Single
For count = 1 To livellox
lunghezzatesto = Len(code.Text)
Dim numeroper As Single
numeroper = lunghezzatesto / 100
normal.Text = ""
'Operazione Inversa
Dim testotot As String
testotot = code.Text
Dim ciclocount As Double
Dim lunghezzatemp As Double
lunghezzatemp = 0
Do
DoEvents
ciclocount = lunghezzatemp
'Mostra la percentuale rimanente sulla barra del titolo
Dim difflen As Single
difflen = lunghezzatesto - ciclocount
Dim percentuale As Single
percentuale = 100 - (difflen / numeroper)
cod.Caption = "Codificatore | " & "Livello: " & count & " | " & percentuale & "%"
Dim posizione As Single
posizione = InStr(testotot, "-")
Dim testook As String
testook = Left(testotot, posizione - 1)
'Riconosce i caratteri estratti
Dim find As String
Select Case testook
Case "17"
find = "a"
Case "9"
find = "b"
Case "21"
find = "c"
Case "26"
find = "d"
Case "14"
find = "e"
Case "1"
find = "f"
Case "16"
find = "g"
Case "22"
find = "h"
Case "24"
find = "i"
Case "11"
find = "l"
Case "8"
find = "m"
Case "25"
find = "n"
Case "4"
find = "o"
Case "2"
find = "p"
Case "20"
find = "q"
Case "6"
find = "r"
Case "13"
find = "s"
Case "19"
find = "t"
Case "3"
find = "u"
Case "23"
find = "v"
Case "7"
find = "z"
Case "18"
find = "j"
Case "12"
find = "w"
Case "5"
find = "y"
Case "10"
find = "k"
Case "15"
find = "x"
'Spazio
Case "27"
find = " "
'Punto esclamativo
Case "28"
find = "!"
'Punto interrogativo
Case "29"
find = "?"
'Accentate
Case "30"
find = "è"
Case "31"
find = "ò"
Case "32"
find = "à"
Case "33"
find = "ù"
Case "34"
find = "ì"
'Se è un numero
Case "44"
find = "0"
Case "45"
find = "1"
Case "36"
find = "2"
Case "41"
find = "3"
Case "46"
find = "4"
Case "37"
find = "5"
Case "43"
find = "6"
Case "39"
find = "7"
Case "47"
find = "8"
Case "40"
find = "9"
'Se è un punto una virgola doppio punto o linetta
Case "38"
find = ","
Case "42"
find = "."
Case "35"
find = ":"
Case "48"
find = "-"
'Se è un'altra lettera...
Case Else
find = ""
End Select
'Determina la lunghezza di testotot è Tronca testotot
Dim lunghezza As Single
lunghezza = Len(testotot)
testotot = Right(testotot, (lunghezza - posizione))
'Variabile per la percentuale...
lunghezzatemp = lunghezzatesto - lunghezza
normal.Text = normal.Text & find
Loop Until testotot = ""
code.Text = normal.Text
Next count
count = count - 1
code.Text = original
'Scrive complete 100%!
cod.Caption = "Codificatore | 100% Complete!"
Exit Sub
1
MsgBox "Errore nel processo di codificazione. Molto probabilmente è colpa del testo che hai inserito! Controlla il testo che hai inserito e riprova. Se il problema non si risolve contatta il produttore!", , "Errore"
cod.Caption = "Codificatore |"
Exit Sub
End Sub
Private Sub esci_Click()
MsgBox "Http://www.pierotofy.too.it", , "Exit"
End
End Sub
Private Sub Form_Load()
livellox = 1
End Sub