--- In [email protected], "be_es_i_boy" <[EMAIL PROTECTED]> wrote:
>
> Tanya dong tentang proses program pembuatan enkripsi deskripsi
> dong ....klo bisa kasih contohnya ya..pleaseeeeeee!!!!!!
>
contoh program enkripsi :
(copy ke project baru : 2 textbox, 2 commandbutton)
'Encryption Module (Crypt.mod)
'
' When I wrote this encryption module I had a couple of goals:
' 1. Must be at least moderately tough to crack
' 2. All characters must be able to be displayed by Windows
' (For sending via e-mail and using copy/paste to decrypt)
'
' Usage:
' Useing these functions is as easy as you'd assume it'd be,
' simply call the function as follows...
' ReturnString = [De|En]cryptString("Text to be de/encrypted",
"Crypt Key")
'
' This will encrypt any string that you can type on the
' (English) keyboard. Extended ASCII is not supported in
' either string to be encrypted or the encryption key.
Public Function EncryptString(ByVal InString As String, ByVal
EncryptKey As String) As String
Dim TempKey, OutString As String
Dim OldChar, NewChar, CryptChar As Long
Dim i As Integer
' Initilize i and make sure the EncryptKey is long enough
i = 0
Do
TempKey = TempKey + EncryptKey
Loop While Len(TempKey) < Len(InString)
' Loop through the string to encrypt each character.
Do
i = i + 1
OldChar = Asc(Mid(InString, i, 1))
CryptChar = Asc(Mid(TempKey, i, 1))
' If it's an even character, add the ASCII value of the
' appropriate character in the Key, otherwise, subract it.
' Also, make sure the value is between 0 and 127.
Select Case i Mod 2
Case 0 'Even Character
NewChar = OldChar + CryptChar
If NewChar > 127 Then NewChar = NewChar - 127
Case Else 'Odd Character
NewChar = OldChar - CryptChar
If NewChar < 0 Then NewChar = NewChar + 127
End Select
' If the value is less than 35, add 40 to it (to make sure
' it's in the display range) and put it in an escape
' sequence (using ! [ASCII Value 33] as the escape char)
If NewChar < 35 Then
OutString = OutString + "!" + Chr(NewChar + 40)
Else
OutString = OutString + Chr(NewChar)
End If
Loop Until i = Len(InString)
EncryptString = OutString
End Function
Public Function DecryptString(ByVal InString As String, ByVal
EncryptKey As String) As String
Dim TempKey, OutString As String
Dim OldChar, NewChar, CryptChar As Long
Dim i, c As Integer
' Initialize c and i (loop variables)
c = 0 ' c is used for InString
i = 0 ' i is used for EncryptKey
' Make sure the EncryptKey is long enough
Do
TempKey = TempKey + EncryptKey
Loop While Len(TempKey) < Len(InString)
Do
' In the decrypt function, two integers are need keeping
' track of location (becuase the escape sequence it two
' chars long, but only has one placeholder in the key)
i = i + 1
c = c + 1
OldChar = Asc(Mid(InString, c, 1))
' If this is an escape sequence, get the next character and
' subtract 40 from it's value.
If OldChar = 33 Then
c = c + 1
OldChar = Asc(Mid(InString, c, 1))
OldChar = OldChar - 40
End If
CryptChar = Asc(Mid(TempKey, i, 1))
' If it's an even character, subract the appropriate key
' value... also, if it's out of range, bring it back in.
Select Case i Mod 2
Case 0 'Even Character
NewChar = OldChar - CryptChar
If NewChar < 0 Then NewChar = NewChar + 127
Case Else 'Odd Character
NewChar = OldChar + CryptChar
If NewChar > 127 Then NewChar = NewChar - 127
End Select
OutString = OutString + Chr(NewChar)
Loop Until c = Len(InString)
DecryptString = OutString
End Function
'**************************************************
' Coded by Patrick Briand.
' I wanted something real simple to encrypt a password,
' however I didn't have much time to do so. I wrote
' this to serve the purpose. It could be optimized
' greatly if I used an encryption key. That will be
' my next submission.
' Depending on whether or not the character is in an even
' or an odd position in the string, the ascii value is
' added to or subtracted from.
Public Function MixChars(ByVal Chars As String) As String
Dim Indice, OldChar, NewChar As Integer
Dim Newtext, tmptext As String
Newtext = ""
tmptext = Chars
For Indice = 1 To Len(Chars)
' The ASC() function returns the value of the first
' character in the string. Therefore I simply loop
' until all the characters have been parsed.
' Using the MID() function could reduce the amount
' of coding used in these functions.
OldChar = Asc(tmptext)
Select Case Indice Mod 2
Case 0 ' If the character is in an even position
NewChar = OldChar + 1
Case Else ' If the character is in an odd position
NewChar = OldChar - 1
End Select
Newtext = Newtext + Chr(NewChar)
tmptext = Right(Chars, Len(Chars) - Indice)
Next Indice
MixChars = Newtext
End Function
' This function decrypts the value.
Public Function UnmixChars(ByVal Chars As String) As String
Dim Indice, OldChar, NewChar As Integer
Dim Newtext, tmptext As String
Newtext = ""
tmptext = Chars
For Indice = 1 To Len(Chars)
OldChar = Asc(tmptext)
Select Case Indice Mod 2
Case 0
NewChar = OldChar - 1
Case Else
NewChar = OldChar + 1
End Select
Newtext = Newtext + Chr(NewChar)
tmptext = Right(Chars, Len(Chars) - Indice)
Next Indice
UnmixChars = Newtext
End Function
Private Sub Command1_Click()
Text2.Text = MixChars(Text1.Text)
Text2.Text = EncryptString(Text1.Text, 28)
End Sub
Private Sub Command2_Click()
Text1.Text = UnmixChars(Text2.Text)
Text1.Text = DecryptString(Text2.Text, 28)
End Sub
