Ce logiciel de securité permet de causer en securité tout en cryptant vos msgs grâce à une clé qui variable(elle varie par rapport à un envoi de Msg)
Source / Exemple :
Private Sub Form_Load()
If Me.WindowState = 2 Then
Command1.Caption = "<<"
ElseIf Me.WindowState = 0 Then
Command1.Caption = ">>"
End If
Me.Caption = LoadResString(101)
Me.CmdDecrypt.Caption = LoadResString(102)
Me.Text1.ToolTipText = LoadResString(103)
lbldate.Caption = lbldate.Caption & Date
Adodc1.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & App.Path & "\Cryptographie.accdb"
End Sub
Private Sub Form_Resize()
If Me.WindowState = 2 Then
Command1.Caption = "<<"
ElseIf Me.WindowState = 0 Then
Command1.Caption = ">>"
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim i As Integer
For i = 1 To lstmsg.ListCount
lstmsg.Selected(i - 1) = True
If lstmsg.ListCount > -1 Then
Text1 = Replace(Text1.Text, "A", (1000001 * 65))
Text1 = Replace(Text1.Text, "B", (1000010 * 66))
Text1 = Replace(Text1.Text, "C", (1000011 * 67))
Text1 = Replace(Text1.Text, "D", (1000100 * 68))
Text1 = Replace(Text1.Text, "E", (1000101 * 69))
Text1 = Replace(Text1.Text, "F", (1000110 * 70))
Text1 = Replace(Text1.Text, "G", (1000111 * 71))
Text1 = Replace(Text1.Text, "H", (1001000 * 72))
Text1 = Replace(Text1.Text, "I", (1001001 * 73))
Text1 = Replace(Text1.Text, "J", (1001010 * 74))
Text1 = Replace(Text1.Text, "K", (1001011 * 75))
Text1 = Replace(Text1.Text, "L", (1001100 * 76))
Text1 = Replace(Text1.Text, "M", (1001101 * 77))
Text1 = Replace(Text1.Text, "N", (1001110 * 78))
Text1 = Replace(Text1.Text, "O", (1001111 * 79))
Text1 = Replace(Text1.Text, "P", (1010000 * 80))
Text1 = Replace(Text1.Text, "Q", (1010001 * 81))
Text1 = Replace(Text1.Text, "R", (1010010 * 82))
Text1 = Replace(Text1.Text, "S", (1010011 * 83))
Text1 = Replace(Text1.Text, "T", (1010100 * 84))
Text1 = Replace(Text1.Text, "U", (1010101 * 85))
Text1 = Replace(Text1.Text, "V", (1010111 * 86))
Text1 = Replace(Text1.Text, "W", (1011000 * 87))
Text1 = Replace(Text1.Text, "X", (1011001 * 88))
Text1 = Replace(Text1.Text, "Y", (1011010 * 89))
Text1 = Replace(Text1.Text, "Z", (1011011 * 90))
'******************************************************************************************
'***********************Caractères Spéciaux***************************
Text1 = Replace(Text1.Text, "+", (101011 * 43))
Text1 = Replace(Text1.Text, "-", (111101 * 45)) 'Même codage Idem que "=" (111101)
Text1 = Replace(Text1.Text, "*", (110100 * 42))
Text1 = Replace(Text1.Text, "/", (100111 * 47)) 'AntiSlash
Text1 = Replace(Text1.Text, "\", (1011110 * 92)) 'Slash
Text1 = Replace(Text1.Text, "_", (1011111 * 95))
Text1 = Replace(Text1.Text, "[", (1011011 * 91))
Text1 = Replace(Text1.Text, "]", (1011101 * 93))
Text1 = Replace(Text1.Text, "'", (111110 * 39))
Text1 = Replace(Text1.Text, ":", (111010 * 58))
Text1 = Replace(Text1.Text, ";", (111011 * 59))
Text1 = Replace(Text1.Text, "=", (111101 * 61))
Text1 = Replace(Text1.Text, "<", (111100 * 60))
Text1 = Replace(Text1.Text, ">", (111110 * 62))
Text1 = Replace(Text1.Text, "?", (111111 * 63))
Text1 = Replace(Text1.Text, "@", (1000000 * 64))
Text1 = Replace(Text1.Text, (Chr$("32")), (100000 * 32))
Text1 = Replace(Text1.Text, (Chr$("13")), (1101 * 13))
End If
Next i
End Sub
Private Sub lstmsg_Click()
Adodc1.Recordset.MoveFirst '********************Recherche par Liste
txtexp.DataField = "NOMEXP"
txtrecep.DataField = "NOMRECEP"
Text1.DataField = "MSG"
CmdDecrypt.Enabled = True: Command2.Enabled = True
If Adodc1.Recordset.EOF = False Then
Adodc1.Recordset.Find "TRANSACTION='" & Me.lstmsg & "'"
lstmsg.ToolTipText = lstmsg.Text
End If
If lstmsg.ListIndex > -1 Then '******* Lorsqu'on deplace le curseur automatique le Msg précédent est crypté
Text1 = Replace(Text1.Text, "A", (1000001 * 65))
Text1 = Replace(Text1.Text, "B", (1000010 * 66))
Text1 = Replace(Text1.Text, "C", (1000011 * 67))
Text1 = Replace(Text1.Text, "D", (1000100 * 68))
Text1 = Replace(Text1.Text, "E", (1000101 * 69))
Text1 = Replace(Text1.Text, "F", (1000110 * 70))
Text1 = Replace(Text1.Text, "G", (1000111 * 71))
Text1 = Replace(Text1.Text, "H", (1001000 * 72))
Text1 = Replace(Text1.Text, "I", (1001001 * 73))
Text1 = Replace(Text1.Text, "J", (1001010 * 74))
Text1 = Replace(Text1.Text, "K", (1001011 * 75))
Text1 = Replace(Text1.Text, "L", (1001100 * 76))
Text1 = Replace(Text1.Text, "M", (1001101 * 77))
Text1 = Replace(Text1.Text, "N", (1001110 * 78))
Text1 = Replace(Text1.Text, "O", (1001111 * 79))
Text1 = Replace(Text1.Text, "P", (1010000 * 80))
Text1 = Replace(Text1.Text, "Q", (1010001 * 81))
Text1 = Replace(Text1.Text, "R", (1010010 * 82))
Text1 = Replace(Text1.Text, "S", (1010011 * 83))
Text1 = Replace(Text1.Text, "T", (1010100 * 84))
Text1 = Replace(Text1.Text, "U", (1010101 * 85))
Text1 = Replace(Text1.Text, "V", (1010111 * 86))
Text1 = Replace(Text1.Text, "W", (1011000 * 87))
Text1 = Replace(Text1.Text, "X", (1011001 * 88))
Text1 = Replace(Text1.Text, "Y", (1011010 * 89))
Text1 = Replace(Text1.Text, "Z", (1011011 * 90))
'******************************************************************************************
'***********************Caractères Spéciaux***************************
Text1 = Replace(Text1.Text, "+", (101011 * 43))
Text1 = Replace(Text1.Text, "-", (111101 * 45)) 'Même codage Idem que "=" (111101)
Text1 = Replace(Text1.Text, "*", (110100 * 42))
Text1 = Replace(Text1.Text, "/", (100111 * 47)) 'AntiSlash
Text1 = Replace(Text1.Text, "\", (1011110 * 92)) 'Slash
Text1 = Replace(Text1.Text, "_", (1011111 * 95))
Text1 = Replace(Text1.Text, "[", (1011011 * 91))
Text1 = Replace(Text1.Text, "]", (1011101 * 93))
Text1 = Replace(Text1.Text, "'", (111110 * 39))
Text1 = Replace(Text1.Text, ":", (111010 * 58))
Text1 = Replace(Text1.Text, ";", (111011 * 59))
Text1 = Replace(Text1.Text, "=", (111101 * 61))
Text1 = Replace(Text1.Text, "<", (111100 * 60))
Text1 = Replace(Text1.Text, ">", (111110 * 62))
Text1 = Replace(Text1.Text, "?", (111111 * 63))
Text1 = Replace(Text1.Text, "@", (1000000 * 64))
Text1 = Replace(Text1.Text, (Chr$("32")), (100000 * 32))
Text1 = Replace(Text1.Text, (Chr$("13")), (1101 * 13))
'******************************Crypter Les Charactères Miniscules en Code Binaire Multiplié par leurs valeurs en ASCII********************
Text1 = Replace(Text1.Text, "a", (1000001 * 97))
Text1 = Replace(Text1.Text, "b", (1000010 * 98))
Text1 = Replace(Text1.Text, "c", (1000011 * 99))
Text1 = Replace(Text1.Text, "d", (1000100 * 100))
Text1 = Replace(Text1.Text, "e", (1000101 * 101))
Text1 = Replace(Text1.Text, "f", (1000110 * 102))
Text1 = Replace(Text1.Text, "g", (1000111 * 103))
Text1 = Replace(Text1.Text, "h", (1001000 * 104))
Text1 = Replace(Text1.Text, "i", (1001001 * 105))
Text1 = Replace(Text1.Text, "j", (1001010 * 106))
Text1 = Replace(Text1.Text, "k", (1001011 * 107))
Text1 = Replace(Text1.Text, "l", (1001100 * 108))
Text1 = Replace(Text1.Text, "m", (1001101 * 109))
Text1 = Replace(Text1.Text, "n", (1001110 * 110))
Text1 = Replace(Text1.Text, "o", (1001111 * 111))
Text1 = Replace(Text1.Text, "p", (1011111 * 112))
Text1 = Replace(Text1.Text, "q", (1100000 * 113))
Text1 = Replace(Text1.Text, "r", (1100001 * 114))
Text1 = Replace(Text1.Text, "r", (1100010 * 115))
Text1 = Replace(Text1.Text, "s", (1100011 * 116))
Text1 = Replace(Text1.Text, "t", (1100100 * 117))
Text1 = Replace(Text1.Text, "u", (1100101 * 118))
Text1 = Replace(Text1.Text, "v", (1100110 * 119))
Text1 = Replace(Text1.Text, "w", (1100111 * 120))
Text1 = Replace(Text1.Text, "x", (1101000 * 121))
Text1 = Replace(Text1.Text, "y", (1101001 * 122))
Text1 = Replace(Text1.Text, "z", (1101010 * 123))
End If
End Sub
Private Sub Timer1_Timer()
End Sub
Conclusion :
Hornel Lama
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.