home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD52134262000.psc / Module1.bas < prev    next >
Encoding:
BASIC Source File  |  2000-04-25  |  2.0 KB  |  81 lines
  1. Attribute VB_Name = "Module1"
  2. Public fMainForm As frmMain
  3.  
  4.  
  5. Sub Main()
  6.     frmSplash.Show
  7.     frmSplash.Refresh
  8.     Set fMainForm = New frmMain
  9.     Load fMainForm
  10.     Unload frmSplash
  11.  
  12.  
  13.     fMainForm.Show
  14. End Sub
  15.  
  16. Public Sub Encrypt(Text As String, Output As RichTextBox)
  17.     On Error GoTo Break
  18.     Randomize
  19.     Dim Char() As String
  20.     Dim si As Long
  21.     Dim Out As String
  22.     Dim iLen As Long
  23.     Dim Rand
  24.     frmCrypt.Show
  25.     frmCrypt.lblMethod.Caption = "Encrypting"
  26.     Text = StrReverse(Text)
  27.     iLen = Len(Text)
  28.     Rand = Int(150 * Rnd) + 1
  29.     ReDim Char(1 To iLen)
  30.     Out = "°"
  31.     frmCrypt.PB.Max = iLen
  32.     frmCrypt.Refresh
  33.     For i = 1 To iLen
  34.         Char(i) = Chr(Asc(Mid(Text, i, 1)) Xor Rand)
  35.         Out = Out & Char(i)
  36.         frmCrypt.PB.Value = i
  37.     Next
  38.     Output.Text = Out & StrReverse(Rand) & Len(Rand) * 2 + 1
  39.     frmCrypt.PB.Value = 0
  40.     Unload frmCrypt
  41. Exit Sub
  42. Break:
  43. MsgBox Err.Description, vbOKOnly + vbExclamation, "Error " & Err.Number
  44. frmCrypt.PB.Value = 0
  45. Unload frmCrypt
  46. End Sub
  47.  
  48. Public Sub Decrypt(Text As String, Output As RichTextBox)
  49.     On Error GoTo Break
  50.     Dim Char() As String
  51.     Dim i As Long
  52.     Dim Out As String
  53.     Dim iLen As Long
  54.     Dim Rand As Integer
  55.     Dim RLen As Single
  56.     RLen = Right(Text, 1) - 1: RLen = RLen / 2
  57.     Rand = StrReverse(Mid(Text, Len(Text) - RLen, RLen))
  58.     Text = Mid(Text, 2, Len(Text) - RLen - 2)
  59.     Text = StrReverse(Text)
  60.     iLen = Len(Text): ReDim Char(1 To iLen)
  61.     frmCrypt.Show
  62.     frmCrypt.lblMethod.Caption = "Decrypting"
  63.     frmCrypt.PB.Max = iLen
  64.     frmCrypt.Refresh
  65.     For i = 1 To iLen
  66.         Char(i) = Chr(Asc(Mid(Text, i, 1)) Xor Rand)
  67.         Out = Out & Char(i)
  68.         frmCrypt.PB.Value = i
  69.     Next
  70.     Output.Text = Out
  71.     frmCrypt.PB.Value = 0
  72.     Unload frmCrypt
  73. Exit Sub
  74. Break:
  75. MsgBox Err.Description, vbOKOnly + vbExclamation, "Error " & Err.Number
  76. frmCrypt.PB.Value = 0
  77. Unload frmCrypt
  78. End Sub
  79.  
  80.  
  81.