Warden bypass code in VB by Andy.

[Archangel]

I didnt wrote this, is from a post of Andy at vl forums.

Make a clsWarden file, with the following (trimmed and updated) code:
Code:

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
  RtlMoveMemory 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)
  RtlMoveMemory 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))
  RtlMoveMemory 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


In your BNCS connection code, add the following private declarations:
Code:

Private cWarden         As New clsWarden
Private wKeyOut()       As Byte
Private wKeyIn()        As Byte


In SID_AUTH_CHECK, somewhere after hashing your CDKey, add:
Code:

    cWarden.Initialize Left$(KeyHash, 4)
    cWarden.StrToByteArray cWarden.GetBytes(&HF), bRet()
    cWarden.SimpleCrypt bRet(), wKeyOut()
    cWarden.StrToByteArray cWarden.GetBytes(&HF), bRet()
    cWarden.SimpleCrypt bRet(), wKeyIn()


To handle SID_Warden (5E):
Code:

Private Sub SID_Recv_Warden()
Dim bData()       As Byte
Dim bRet()        As Byte
Dim sData         As String
Dim lPos          As Long
Dim nFile         As Integer
Dim EventNo       As Byte
Dim I             As Long
Dim Loops         As Long
Dim Vals()        As String
Dim addr()        As Long
Dim readlen       As Byte
Dim ToSend        As String
Dim Checksum      As Long
Const Req1        As Long = &H497FB0
Const Req2        As Long = &H49C33D
Const Req3        As Long = &H4A2FF7
  sData = Packet.GetNull
  cWarden.StrToByteArray sData, bData()
  cWarden.DoCrypt bData(), wKeyIn(), bRet()
  Select Case bRet(0)
    Case &H0
      Packet.ClearOutbound
      ReDim bData(0)
      bData(0) = &H1
      cWarden.DoCrypt bData(), wKeyOut(), bRet()
      Packet.InsertString cWarden.ByteArrayToStr(bRet())
      AddQueue Packet.SendBNCSPacket(SID_WARDEN)
    Case &H2
      If LenB(Dir$(CFm_HashPath & "\StarCraft.exe")) > 0 Then
        EventNo = bRet(1)
        Loops = (Len(sData) - 3) / 7
        ReDim Vals(Loops - 1) As String
        ReDim addr(Loops - 1) As Long
        nFile = FreeFile
        Open CFm_HashPath & "\StarCraft.exe" For Binary Access Read As #nFile
        lPos = 2
        For I = 0 To Loops - 1
          lPos = lPos + 2
          RtlMoveMemory addr(I), bRet(lPos), 4
          lPos = lPos + 4
          readlen = bRet(lPos)
          lPos = lPos + 1
          Vals(I) = String$(readlen, 0)
          Get #nFile, addr(I) - &H400000 + 1, Vals(I)
        Next I
        Close #nFile
        If addr(0) = Req1 And addr(1) = Req2 And addr(2) = Req3 Then
          Checksum = &H193E73E8
        ElseIf addr(0) = Req2 And addr(1) = Req1 And addr(2) = Req3 Then
          Checksum = &HD6557DEF
        ElseIf addr(0) = Req1 And addr(1) = Req3 And addr(2) = Req2 Then
          Checksum = &H2183172A
        ElseIf addr(0) = Req2 And addr(1) = Req3 And addr(2) = Req1 Then
          Checksum = &HCA841860
        ElseIf addr(0) = Req3 And addr(1) = Req2 And addr(2) = Req1 Then
          Checksum = &H9F2AD2C3
        ElseIf addr(0) = Req3 And addr(1) = Req1 And addr(2) = Req2 Then
          Checksum = &HC04CF757
        Else
          RaiseEvent BNetError("Unknown Warden Request! You will be disconnected in two minutes.")
          Exit Sub
        End If
        Packet.ClearOutbound
        For I = 0 To Loops - 1
            Packet.InsertByte &H0
            Packet.InsertString Vals(I)
        Next I
        ToSend = Packet.GetOutbound
        ToSend = Chr$(&H2) & Packet.CreateWORD(Len(ToSend)) & Packet.CreateDWORD(Checksum) & ToSend
        cWarden.StrToByteArray ToSend, bData()
        Packet.ClearOutbound
        cWarden.DoCrypt bData(), wKeyOut(), bRet()
        Packet.InsertString cWarden.ByteArrayToStr(bRet())
        AddQueue Packet.SendBNCSPacket(SID_WARDEN)
      Else
        RaiseEvent BNetError("Can't respond to Warden without StarCraft.exe!")
      End If
    Case Else
      RaiseEvent BNetError("Unknown Warden Packet: " & StH(sData))
  End Select
End Sub


That may make things a bit easier to understand.

FAQ:
Can i get banned if i use this bypass?
A=Yes you can.

This will work always?
A=No it wont, if blizzard updates the warden module this code wont work.

Can you help me?
A=No, is not my code.

Why you post it then?
A=Because it might be usefull for some people.