VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsWarden"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Declare Function StandardSHA Lib "RSHA.dll" (sVal As String) As String
Private Position        As Long
Private RandomData()    As Byte
Private RandomSource1() As Byte
Private RandomSource2() As Byte
Private Function RShift(ByVal pnValue As Double, ByVal pnShift As Long) As Long
Dim Shft As String
  Shft = Str$(pnValue / (2 ^ pnShift))
  If InStr(Shft, ".") > 0 Then
    RShift = CLng(Left$(Shft, InStr(Shft, ".") - 1))
  Else
    RShift = CLng(Shft)
  End If
End Function
Public Sub Initialize(Seed As String)
Dim Length1 As Long
Dim Length2 As Long
Dim Seed1() As Byte
Dim Seed2() As Byte
Dim I       As Long
  Length1 = RShift(Len(Seed), 1)
  Length2 = Len(Seed) - Length1
  ReDim Seed1(Length1 - 1)
  ReDim Seed2(Length2 - 1)
  StrToByteArray Mid$(Seed, 1, Length1), Seed1
  StrToByteArray Mid$(Seed, Length1 + 1, Length2), Seed2
  ReDim RandomData(&H13) As Byte
  StrToByteArray StandardSHA(ByteArrayToStr(Seed1)), RandomSource1
  StrToByteArray StandardSHA(ByteArrayToStr(Seed2)), RandomSource2
  Update
  Position = 0
End Sub
Private Sub Update()
  StrToByteArray StandardSHA(ByteArrayToStr(RandomSource1) & ByteArrayToStr(RandomData) & ByteArrayToStr(RandomSource2)), RandomData
End Sub
Private Function GetByte() As Byte
  GetByte = RandomData(Position)
  Position = Position + 1
  If Position >= &H14 Then
    Position = 0
    Update
  End If
End Function
Public Function GetBytes(ByVal bytes As Long) As String
Dim I        As Integer
Dim Buffer() As Byte
  ReDim Buffer(bytes) As Byte
  For I = 0 To bytes
    Buffer(I) = GetByte
  Next I
  GetBytes = ByteArrayToStr(Buffer)
End Function
Public Sub StrToByteArray(ByVal sStr As String, ByRef Ary() As Byte)
Dim I As Integer
  ReDim Ary(Len(sStr) - 1) As Byte
  CopyMemory Ary(0), ByVal sStr, Len(sStr)
End Sub
Public Function ByteArrayToStr(ByRef bByt() As Byte, Optional ByVal lLoc As Long = 0) As String
Dim sStr As String
Dim I    As Integer
  sStr = String$(UBound(bByt) + 1, 0)
  CopyMemory ByVal sStr, bByt(lLoc), UBound(bByt) + 1
  ByteArrayToStr = sStr
End Function
Public Sub SimpleCrypt(ByRef bBase() As Byte, ByRef bKey() As Byte)
Dim lVal    As Long
Dim I       As Long
Dim lPos    As Long
Dim temp    As Byte
  ReDim bKey(&H101) As Byte
  For I = 0 To &HFF
    bKey(I) = I
  Next I
  For I = 1 To &H40
    lVal = lVal + bKey(I * 4 - 4) + bBase(lPos Mod (UBound(bBase) + 1))
    lPos = lPos + 1
    temp = bKey(I * 4 - 4)
    bKey(I * 4 - 4) = bKey(lVal And &HFF)
    bKey(lVal And &HFF) = temp
    lVal = lVal + bKey(I * 4 - 3) + bBase(lPos Mod (UBound(bBase) + 1))
    lPos = lPos + 1
    temp = bKey(I * 4 - 3)
    bKey(I * 4 - 3) = bKey(lVal And &HFF)
    bKey(lVal And &HFF) = temp
    lVal = lVal + bKey(I * 4 - 2) + bBase(lPos Mod (UBound(bBase) + 1))
    lPos = lPos + 1
    temp = bKey(I * 4 - 2)
    bKey(I * 4 - 2) = bKey(lVal And &HFF)
    bKey(lVal And &HFF) = temp
    lVal = lVal + bKey(I * 4 - 1) + bBase(lPos Mod (UBound(bBase) + 1))
    lPos = lPos + 1
    temp = bKey(I * 4 - 1)
    bKey(I * 4 - 1) = bKey(lVal And &HFF)
    bKey(lVal And &HFF) = temp
  Next I
End Sub
Public Sub DoCrypt(ByRef bData() As Byte, ByRef bKey() As Byte, ByRef bRet() As Byte)
Dim I      As Long
Dim temp   As Byte
Dim Y      As Long
Dim Z      As Long
  ReDim bRet(UBound(bData))
  CopyMemory bRet(0), bData(0), UBound(bData) + 1
  Y = bKey(&H100)
  Z = bKey(&H101)
  For I = 0 To UBound(bData)
    Y = (Y + 1) And &HFF
    Z = (Z + bKey(Y)) And &HFF
    temp = bKey(Y)
    bKey(Y) = bKey(Z)
    bKey(Z) = temp
    bRet(I) = bRet(I) Xor bKey((CInt(bKey(Y)) + CInt(bKey(Z))) And &HFF)
  Next I
  bKey(&H100) = Y
  bKey(&H101) = Z
End Sub
