Securitemessage,crypter,cryptographie

Description

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

Codes Sources

A voir également

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.