by Cyrus Lacaba aka Biohazard of Las Pi?as (6 Submissions)
Category: Encryption
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Fri 17th July 2009
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Encryption and Decryption Sample... Enjoy
VBcoders
Private Sub Command1_Click(Index As Integer)
On Error Resume Next
Dim a_cls As New clsEncryptDecrypt
Select Case Index
Case 0
txtOut = a_cls.EncDecryptData(Trim(txtInput), False)
Case 1
txtOut = a_cls.EncDecryptData(Trim(txtInput), True)
Case 2
End
End Select
End Sub
Private strEncrypted$
Public Property Get Encrypted() As String
Encrypted = strEncrypted$
End Property
Public Function EncDecryptData(ByVal strval$, ByVal blndec As Boolean, Optional lngEncDecVal& = 3) As String
Dim strOutput$, _
PWDArr(), _
inttnochar&, i&
ReDim PWDArr(Len(strval$))
If blndec = False Then
'Encrypt
For i& = 1 To Len(strval$)
PWDArr(i&) = Asc(Mid(strval$, i&, 1))
PWDArr(i&) = PWDArr(i&) Xor lngEncDecVal&
PWDArr(i&) = Chr(PWDArr(i&) + 10)
Next
strOutput$ = Join(PWDArr, vbNullString)
strEncrypted$ = strOutput$
Else
'Decrypt
For i& = 1 To Len(strval$)
PWDArr(i&) = Asc(Mid(strval$, i&, 1))
Next
strval$ = ""
For i& = LBound(PWDArr) + 1 To UBound(PWDArr)
PWDArr(i&) = Chr(PWDArr(i&) - 10)
PWDArr(i&) = Asc(PWDArr(i&)) Xor lngEncDecVal&
strval$ = strval$ + Chr(PWDArr(i&))
Next
strOutput$ = strval$
End If
EncDecryptData = strOutput$
End Function
Public Function Distribute(ByVal strval$, ByVal intDestribute%, ByVal strSeparator$) As String
Dim a, b, c, d, e, f, g, h, i, i2
Dim separator_arr(), strsptr$
Dim X As StdFont
ReDim separator_arr(Len(strSeparator$))
For i2 = 1 To Len(strSeparator$)
separator_arr(i2) = Mid$(strSeparator$, 1, 1)
strSeparator$ = Mid$(strSeparator$, 2)
Next
On Error GoTo Attached_Separator
a = Len(Trim(strval$))
If a = 0 Then Exit Function
h = Mid(CStr(Len(strval$) / intDestribute%), 1, InStr(1, CStr(Len(strval$) / intDestribute%), ".") - 1)
b = CLng(h)
c = Len(strval$) Mod intDestribute%
e = vbNullString
f = vbNullString
On Error GoTo Attached_Other
For i = 1 To b
d = Len(e) + 1
e = e + Mid(strval$, d, intDestribute%)
g = g + Mid(e, d, intDestribute%)
f = f + Mid(e, d, intDestribute%) & separator_arr(i)
Next
f = f + Mid(strval$, (Len(g) - intDestribute%) + 1)
Distribute = f
Exit Function
Attached_Other:
If Err = 9 Then
f = f + Mid(strval$, (Len(g) - intDestribute%) + 1)
End If
Distribute = f
Exit Function
Attached_Separator:
Distribute = Join(separator_arr, vbNullString)
End Function
Public Function ClassTimer(vsec%, vmin%, vhr%) As Boolean
Static tsec%, tmin%, thr%
Static tsec2%, tmin2%, thr2%
If tsec2% = vsec% And tmin2% = vmin% And thr2% = vhr% Then
ClassTimer = True
Exit Function
End If
tsec% = tsec% + 1
If tsec% = vsec% Then tsec2% = tsec%
If tsec% = 60 Then
If tmin% = vmin% Then tmin2% = tmin%
tmin% = tmin% + 1
tsec% = 0
If tmin% = 60 Then
If thr% = vhr% Then thr2% = thr%
thr% = thr% + 1
tmin% = 0
End If
End If
End Function
