Silkroad Online Proxy in Visual Basic 6

vitalka · 05/03/2011, 20:17

At the moment im trying to code a Silkroad Proxy in Visual Basic 6, but its very difficult for me to convert the Security from c#/c++ to vb6 and drews Silkroad security tutorial doesnt help me.

The Connectionpart and packethandler are already done.

If someone want to help me or have some helpful codeparts it would be very cool.

Thx

mataiproasta · 05/03/2011, 20:54

What would be the use of such program?
Is this a vpn or what? silkroad online proxy doesn't say much.
Or a tunneling app ?

bootdisk · 05/03/2011, 20:58

it's a program like SrProxy or nuConnector what he's trying to do.
I've ported the whole Silkroad Security API to pure Python (no dlls, just plain Python)... it isn't easy, I've taken parts of his C# port aswell.

I'm able to encrypt/decrypt packets with it.

I'll release it as soon as I end the 0x600D handling, perhaps it will help you in some way.

Edit: I forgot to tell you, the best way is to isolate the code (move a single function to a clean C++ project then run it, compare input values and output values and test it against your own methods til you have exactly the same).

vitalka · 05/03/2011, 22:35

Why im doing it is i want to know how the silkroad security works and for me it is a good method because so it is very difficult, yes i tried already take some single functions, but c# or c++ is not similar like vb6 and i dont have much knowledge with c++

bootdisk · 05/03/2011, 23:01

Would you mind to post the most problematic part?
This could be a good opportunity to move to C++ too

vitalka · 05/03/2011, 23:15

Code:

Module mPacket_0x5000
    Public blowfish As New BlowfishNET.BlowfishECB
    Dim dwArgs(17) As UInt32


    Function Packet_0x5000_len9(ByVal packet As cPacket) As Byte()
        Dim key As Int64
        Dim keybyte As Byte
        Dim keyArray(7) As Byte


        ' ######################################################
        ' #### -------------- Check Handshake -------------- ###
        ' ######################################################

        key = dwArgs(5)
        key = key << 32
        key += dwArgs(4)
        keyArray = BitConverter.GetBytes(key)

        keybyte = LoBYTE(LoWord(dwArgs(4))) And &H7
        Func_X_2(keyArray, dwArgs(14), keybyte)




        blowfish.EncryptRev(keyArray, 0, keyArray, 0, 8)

        packet.data.pointer = 1

        If BitConverter.ToUInt64(keyArray, 0) = packet.data.read_UInt64 Then
        Else
            Return Nothing
        End If



        ' ######################################################
        ' ### ------------- Generate Final Key ------------- ###
        ' ######################################################
        key = dwArgs(16)
        key = key << 32
        key += dwArgs(15)
        keyArray = BitConverter.GetBytes(key)

        Func_X_2(keyArray, dwArgs(6), &H3)

        Return keyArray 'final key 

    End Function

    Public Structure sRetVal
        Dim packet As cPacket
        Dim CounterSeed As UInt32
        Dim CrcSeed As UInt32
    End Structure


    Function Packet_0x5000_len37(ByVal packet As cPacket) As sRetVal
        Dim flag As Byte
        Dim bfkey(7) As Byte
        Dim seedcounter As UInt32
        Dim seedCRC As UInt32
        Dim seedSecurity(4) As UInt32

        Dim pointer As Int16 = 6

        flag = packet.data.read_Byte
        packet.data.read_UInt64()
        seedcounter = packet.data.read_UInt32
        seedCRC = packet.data.read_UInt32
        seedSecurity(0) = packet.data.read_UInt32
        seedSecurity(1) = packet.data.read_UInt32
        seedSecurity(2) = packet.data.read_UInt32
        seedSecurity(3) = packet.data.read_UInt32
        seedSecurity(4) = packet.data.read_UInt32


        Packet_0x5000_len37.CounterSeed = seedcounter
        Packet_0x5000_len37.CrcSeed = seedCRC
        'SecuretyGen = New cSecByteGen(seedcounter, seedCRC)



        'Store the seeds into the arguments
        dwArgs(10) = seedSecurity(3)
        dwArgs(11) = seedSecurity(2)
        dwArgs(12) = seedSecurity(4)
        dwArgs(15) = seedSecurity(0)
        dwArgs(16) = seedSecurity(1)


        dwArgs(0) = dwArgs(11)
        dwArgs(1) = dwArgs(10)
        dwArgs(3) = CUInt(Int((&H7FFFFFFF * Rnd()) + &H10))
        dwArgs(5) = Func_X_4(dwArgs(1), dwArgs(3), dwArgs(0))

        'For i As UInt32 = 0 To &H7FFFFFFF
        '    If Func_X_4(dwArgs(1), i, dwArgs(0)) = 148686282 Then
        '        MsgBox(i)
        '    End If
        'Next

        dwArgs(13) = dwArgs(5)
        dwArgs(4) = dwArgs(12)
        dwArgs(6) = Func_X_4(dwArgs(1), dwArgs(3), dwArgs(4))
        dwArgs(14) = dwArgs(6)

        '-------------------------------------------
        Dim keyByte As Byte
        Dim keyArray As UInt64 = 0
        Dim keyArray1(7) As Byte
        Dim keyArray2(7) As Byte
        ' Generate the private blowfish key
        keyByte = LoBYTE(dwArgs(14)) And &H3

        keyArray = dwArgs(13)
        keyArray = keyArray << 32
        keyArray += dwArgs(12)
        keyArray1 = BitConverter.GetBytes(keyArray)

        Func_X_2(keyArray1, dwArgs(14), keyByte)


        keyArray = dwArgs(4)
        keyArray = keyArray << 32
        keyArray += dwArgs(5)
        keyArray2 = BitConverter.GetBytes(keyArray)
        keyByte = LoBYTE(LoWord(dwArgs(5))) And &H7
        Func_X_2(keyArray2, dwArgs(14), keyByte)

        blowfish.Initialize(keyArray1, 0, 8)

        blowfish.EncryptRev(keyArray2, 0, keyArray2, 0, 8)

        Dim antwort As New cPacket(&H5000, False, packet.Dest)
        antwort.data.Add_UInt32(dwArgs(13))
        antwort.data.add_byte(keyArray2)

        Packet_0x5000_len37.packet = antwort

    End Function


#Region "helper functions"
    Public Function LoWord(ByVal int As Int32) As Int64
        Return int And &HFFFF
    End Function
    Public Function HiWord(ByVal int As Int32) As Int64
        Return (int And &HFFFF0000) >> 16
    End Function
    Function LoBYTE(ByVal int As Int32) As Int64
        Return int And &HFF
    End Function
    Function HiBYTE(ByVal int As Int32) As Int64
        Return (int And &HFF00) >> 8
    End Function

    Sub Func_X_2(ByRef stream() As Byte, ByVal key As Int32, ByVal keybyte As Byte)
        stream(0) = LoBYTE(stream(0) Xor (stream(0) + LoBYTE(LoWord(key)) + keybyte))
        stream(1) = LoBYTE(stream(1) Xor (stream(1) + HiBYTE(LoWord(key)) + keybyte))
        stream(2) = LoBYTE(stream(2) Xor (stream(2) + LoBYTE(HiWord(key)) + keybyte))
        stream(3) = LoBYTE(stream(3) Xor (stream(3) + HiBYTE(HiWord(key)) + keybyte))
        stream(4) = LoBYTE(stream(4) Xor (stream(4) + LoBYTE(LoWord(key)) + keybyte))
        stream(5) = LoBYTE(stream(5) Xor (stream(5) + HiBYTE(LoWord(key)) + keybyte))
        stream(6) = LoBYTE(stream(6) Xor (stream(6) + LoBYTE(HiWord(key)) + keybyte))
        stream(7) = LoBYTE(stream(7) Xor (stream(7) + HiBYTE(HiWord(key)) + keybyte))
    End Sub
    Function Func_X_4(ByVal P As UInt32, ByVal X As UInt32, ByVal G As UInt32)

        Dim result As Int64 = 1
        Dim mult As Int64 = G
        If X = 0 Then Return 1
        While X
            '(mult * result) - (p * ((mult * result) \ p)) 
            If (X And 1) Then result = (mult * result) Mod P
            X = X >> 1
            mult = (mult * mult) Mod P
        End While
        Return CUInt(result)

    End Function
#End Region
End Module

this whole part

pushedx · 05/04/2011, 00:02

I can tell by the function names and some of the variable names in the code that is really old logic. Use this:

to convert from rather than the old C++ ones.

Unless you convert the security code from edx33v6, all previous versions pretty much have bugs or flawed concepts in them.

The C# version is my latest version that provides a 'complete' API for working with all modes. The original implementation only supported client to server operations with a client patch, so that is why you should not use it as a base.

With that said...

I can't say I recommend spending time trying to convert the Security API to VB6. If you want to, you need to pretty much understand everything on this site:

.

In other words, you need to be really good with VB6 in terms of being able to write all the extra code needed in that language to handle bit shifts, binary arrays via Strings, 64-bit types, and so on. Once you have a great understanding of how to do lower level concepts in VB6, then it's just a matter of porting the code function by function and testing. It's certainly possible, but really not worth the time due to the way the language is setup.

If you want to do any modern day development, you should really upgrade to VB.Net at minimal. I mean this is old, but look at what VB.Net has had for the past 8 years:

(vs2003, click on the other versions for more updates).

The time you spend learning VB.Net as well as the new .net framework will give you significantly more skills and practical programming experience than investing more time in VB6. Being able to code in VB.Net and C# will allow you way more opportunities as well.

Being a C++ programmer for a while now, I've been using C# because it allows me to rapidly develop programs and GUIs significantly faster than if I did in C++. There's very little that I have to use C++ for, mostly loders and the core injected DLL. Other than that, I can pretty much do everything else in C#. Programming languages are just tools, and if your tool isn't allowing you to complete the job the fastest, easiest, while giving you the most enjoyment, it is time for a change.

Anyways, your best bet for learning the way the Silkroad security works is by reading my original guide for the overall concepts then studying the C# code and examples. It would be far easier to grab the latest Visual Studio express edition and step through the code as it runs for something like the server stats.

All a proxy is, is a server + a clientless rolled into one application. Don't try to write a proxy until you understand the concepts of each part first! There are a lot of other programming concepts to learn too, mostly related to network programming (TCP).

Lastly, you don't have to convert the Silkroad security to VB6 for a proxy. All you need is a working proxy in any language that takes care of the security bytes for you. That way, you can then connect any other program to it and send packets and stuff in a raw format and let the proxy take care of everything else. I talked about this concept in one of my guides. The nice part about that is you write it once, then reuse it for any language since it just requires network support, which most languages have libraries for it.

Programming is not about trying to find ways to force a square block into a triangle slot. Rather than spending time trying to find ways to do it, take the time to obtain the skills to recognize you have a square block and need to place it in a square slot. If all you know is VB6 right now, learn more languages that will allow you to be successful in the things you want to do.

The sooner your do, the more time you will have later to write bigger and better things that would not have been possible. Good luck!

bootdisk · 05/04/2011, 01:07

Is it me or that is .net? You said you were working on VB6... unless you've compiled then decompiled and tried to run it on VB6 which "might" work if you use VB.Net as pushedx said.

@pushedx I just ported your api because I wanted to see how difficult was to write it on Python... but by seeing your 2 versions I realize how much work you put into the latest from back in those days to today. Congrats and thanks for sharing both!

vitalka · 05/04/2011, 18:45

In the mediapatcher source from nymble is a source with blowfish. i think this is helpful...

Code:

Option Explicit
Option Base 0

'Made by Tolatero & Clearscreen
'Adapted by NyMbLe

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal lpDestination As Any, ByVal lpSource As Any, ByVal Length As Long)

Private abPlain() As Byte
Private xbPlain() As Byte
Private abCipher() As Byte
Private xbCipher() As Byte
Private abDecrypt() As Byte
' The key and IV stored as an array of bytes
Private aKey() As Byte
Private abInitV() As Byte
Private eKey As String

Private eIndex As Long
Private xIndex As Long
Private Const cObjDesc = &H80
Private Const cIncrementDirs = 80

Private eFile As String ' = "F:\Program Files\Silkroad\media.pk2"
Private Type FileInfo
    DataType As Integer ' byte x 1 '01 dir, 02 file
    Name As String ' byte x 89
    Position As Long ' byte x4
    NextDir As Long
    Size As Long
    DateTime As String
End Type

Private Const OFFSET_4 = 4294967296#
Private Const MAXINT_4 = 2147483647

Private Const ncROUNDS  As Integer = 16
Private Const ncMAXKEYLEN As Integer = 56

Private blf_P(17) As Long
Private blf_S(3, 255) As Long

Private eDir() As FileInfo
Private eNumDirs As Integer
Private xNumDirs As Integer

Public Function LoadFile(sFile As String, sExtract As String) As Long
    Dim lData As FileInfo
    Dim lStr As String
    Dim ltmp As String
    Dim lFileOut As String
    Dim i As Integer
    Dim lLastDir As Boolean
    Dim lStream As String
    Dim sRoute() As String
    Dim k As Integer
    Dim j As Long
    On Error GoTo err_trap
    eFile = sFile
    eIndex = &H100 + 1 'set to root
    aKey() = cv_BytesFromHex(eKey)
    blf_Initialise aKey, 6
    
    If FileSystem.Dir(eFile) = "" Then
        MsgBox "Select a valid file please"
        Exit Function
    End If
    sRoute = Split(LCase(sExtract), "\")
    eNumDirs = 0
    j = 0
    lLastDir = False
    If sRoute(0) = "" Then k = 1
    Do While Not lLastDir
        lLastDir = True
        'eNumDirs = eNumDirs + cIncrementDirs
        'ReDim Preserve eDir(eNumDirs)
        For i = 1 To cIncrementDirs
            abPlain = ReadBytes(eIndex)
            abCipher = blf_BytesRaw1(abPlain, bEncrypt:=False)
            lData = ReadStructure(abCipher())
            j = j + 1
            'lData = lData
            
            If LCase(lData.Name) = sRoute(k) Then
                k = k + 1
                'Debug.Print "Seleccionado " & i
                If lData.DataType = 1 Then
                    eIndex = lData.Position + 1
                    i = 1
                ElseIf lData.DataType = 2 Then
                    'eIndex = lData.Position + 1
                    'Debug.Print "Extraer file:" & Hex(lData.Position + 1) & " " & Hex(lData.Size)
                    'lFileOut = sOutput
                    LoadFile = lData.Position + 1
                    'SaveData lFileOut, lStream
                    Exit Function
                End If
                
            Else
                eIndex = eIndex + &H80
                If lData.NextDir <> 0 Then
                    lLastDir = False
                    eIndex = lData.NextDir + 1
                End If
            End If
        Next i
    Loop
    LoadFile = ""
    Exit Function
err_trap:
    Err.Clear
End Function

Private Sub SaveData(pFileName As String, pData As String, Optional pPreserve As Boolean = False)
    Dim lFile As Long
    lFile = FreeFile()
    
    If FileSystem.Dir(pFileName) <> "" Then 'check file exist
        If Not pPreserve Then
            FileSystem.Kill (pFileName)
        End If
    End If
    
    Open pFileName For Binary As #lFile
'    Print #lFile, "Recording Initialization..."
        Put #lFile, , pData
    Close #lFile
End Sub

Private Function LoadData(pFileName As String, pPos As Long, pLenght As Long) As String
    Dim lFile As Long
    Dim lLargo As Long
    Dim lData As String
    
    lFile = FreeFile()
    lData = Space(pLenght) 'setup the stream
    Open pFileName For Binary As #lFile
        Get #lFile, pPos, lData
    Close #lFile
    
    LoadData = lData
End Function

Private Function ReadBytes(pIndex As Long) As Variant
    Dim aBytes(cObjDesc) As Byte
    Dim lFile As Long
        
    If pIndex < &H101 Then
        pIndex = &H101
    End If
    
    lFile = FreeFile()
    
    Open eFile For Binary As #lFile
    Get #lFile, pIndex, aBytes
    Close lFile
    
    
    ReadBytes = aBytes
End Function

Private Function ReadStructure(abCipher() As Byte) As FileInfo
    Dim lData As FileInfo
    Dim lWord(4) As Byte
    Dim lStr As String
    Dim ltmp As String
    
    lData.DataType = abCipher(0)
    lStr = cv_HexFromBytes(abCipher)
    lData.Name = Mid(StrConv(abCipher, vbUnicode), 2, 89)
    lData.Name = Left(lData.Name, InStr(1, lData.Name, Chr(0)) - 1)
    ltmp = Mid(lStr, 106 * 2 + 1, 8)
    lWord(1) = cv_GetHexByte(ltmp, 1)
    lWord(2) = cv_GetHexByte(ltmp, 2)
    lWord(3) = cv_GetHexByte(ltmp, 3)
    lWord(4) = cv_GetHexByte(ltmp, 4)
    lData.Position = uwJoin(lWord(4), lWord(3), lWord(2), lWord(1))
    If lData.DataType = 1 Then
        lData.Size = &HA00
    Else
        ltmp = Mid(lStr, 114 * 2 + 1, 8)
        lWord(1) = cv_GetHexByte(ltmp, 1)
        lWord(2) = cv_GetHexByte(ltmp, 2)
        lWord(3) = cv_GetHexByte(ltmp, 3)
        lWord(4) = cv_GetHexByte(ltmp, 4)
        lData.Size = uwJoin(lWord(4), lWord(3), lWord(2), lWord(1))
    End If
    
    
    ltmp = Mid(lStr, 118 * 2 + 1, 8)
    lWord(1) = cv_GetHexByte(ltmp, 1)
    lWord(2) = cv_GetHexByte(ltmp, 2)
    lWord(3) = cv_GetHexByte(ltmp, 3)
    lWord(4) = cv_GetHexByte(ltmp, 4)
    lData.NextDir = uwJoin(lWord(4), lWord(3), lWord(2), lWord(1))
'    Debug.Print Mid(lData.Name, 20) & " - " & lData.Position & " - " & lData.Size & " - " & lData.NextDir
    ReadStructure = lData
End Function


' basBlowfishByteFns: Wrapper functions to call Blowfish algorithms

' Version 6. November 2003. Added this module with new Byte functions
' Blowfish in Visual Basic first published October 2000.
'************************* COPYRIGHT NOTICE*************************
' This code was originally written in Visual Basic by David Ireland
' and is copyright (c) 2000-3 D.I. Management Services Pty Limited,
' all rights reserved.

' You are free to use this code as part of your own applications
' provided you keep this copyright notice intact and acknowledge
' its authorship with the words:

'   "Contains cryptography software by David Ireland of
'   DI Management Services Pty Ltd <www.di-mgt.com.au>."

' If you use it as part of a web site, please include a link
' to our site in the form
' <A HREF="http://www.di-mgt.com.au/crypto.html">Cryptography
' Software Code</a>

' This code may only be used as part of an application. It may
' not be reproduced or distributed separately by any means without
' the express written permission of the author.

' David Ireland and DI Management Services Pty Limited make no
' representations concerning either the merchantability of this
' software or the suitability of this software for any particular
' purpose. It is provided "as is" without express or implied
' warranty of any kind.

' Please forward comments or bug reports to <.au>.
' The latest version of this source code can be downloaded from
' www.di-mgt.com.au/crypto.html.
'****************** END OF COPYRIGHT NOTICE*************************

' The functions in this module are:
' blf_BytesRaw(abData, bEncrypt): En/Deciphers bytes abData without padding
' blf_BytesEnc(abData): Pads and enciphers byte array abData with current key
' blf_BytesDec(abData): Deciphers byte array abData with current key and unpads
' PadBytes(abData): Pads byte array to next multiple of 8 bytes
' UnpadBytes(abData): Removes padding after decryption
' blf_BytesEncRawCBC(abData, abInitV): Encrypts abData in CBC mode
' blf_BytesEncCBC(abData, abInitV): Pads and encrypts abData in CBC mode
' blf_BytesDecRawCBC(abData, abInitV): Decrypts abData in CBC mode
' blf_BytesDecCBC(abData, abInitV): Decrypts abData in CBC mode and unpads

' To set current key, call blf_KeyInit(aKey())
'   where aKey() is the key as an array of Bytes

' NB The functions in this module deal with data of any length, but
' if you only want to deal with an 8-byte block, use
' blf_EncryptBytes() and blf_DecryptBytes() in module basBlowfish

' Use faster API call to copy bytes

Private Function blf_BytesRaw(abData() As Byte, bEncrypt As Boolean) As Variant
' New function added version 6.
' Encrypts or decrypts byte array abData without padding using to current key.
' Similar to blf_BytesEnc and blf_BytesDec, but does not add padding
' and ignores trailing odd bytes.
' ECB mode - each block is en/decrypted independently
    Dim nLen As Long
    Dim nBlocks As Long
    Dim iBlock As Long
    Dim j As Long
    Dim abOutput() As Byte
    Dim abBlock(7) As Byte
    Dim iIndex As Long
    
    ' Calc number of 8-byte blocks (ignore odd trailing bytes)
    nLen = UBound(abData) - LBound(abData) + 1
    nBlocks = nLen \ 8
    
    ReDim abOutput(nBlocks * 8 - 1)
    
    ' Work through in blocks of 8 bytes
    iIndex = 0
    For iBlock = 1 To nBlocks
        ' Get the next block of 8 bytes
        CopyMemory VarPtr(abBlock(0)), VarPtr(abData(iIndex)), 8&

        ' En/Decrypt the block according to flag
        If bEncrypt Then
            Call blf_EncryptBytes(abBlock())
        Else
            Call blf_DecryptBytes(abBlock())
        End If
        
        ' Copy to output string
        CopyMemory VarPtr(abOutput(iIndex)), VarPtr(abBlock(0)), 8&
        
        iIndex = iIndex + 8
    Next
    
    blf_BytesRaw = abOutput
    
End Function

Private Function blf_BytesEnc(abData() As Byte) As Variant
' Encrypts byte array abData after adding PKCS#5/RFC2630/RFC3370 padding
' NB always adds padding - use blf_BytesRaw() if you don't want padding
' ECB mode
' Returns encrypted byte array as a variant.
' Requires key and boxes to be already set up.
' New in Version 6.

    Dim abOutput() As Byte
    
    abOutput = PadBytes(abData)
    abOutput = blf_BytesRaw(abOutput, True)
    
    blf_BytesEnc = abOutput
End Function

Private Function blf_BytesDec(abData() As Byte) As Variant
' Decrypts byte array abData assuming PKCS#5/RFC2630/RFC3370 padding and ECB mode
' NB always removes valid padding - use blf_BytesRaw() if you don't want padding
' Returns encrypted byte array as a variant.
' Requires key and boxes to be already set up.
' New in Version 6.

    Dim abOutput() As Byte
    
    abOutput = blf_BytesRaw(abData, False)
    abOutput = UnpadBytes(abOutput)
    
    blf_BytesDec = abOutput
End Function

Private Function PadBytes(abData() As Byte) As Variant
' Pad data bytes to next multiple of 8 bytes as per PKCS#5/RFC2630/RFC3370
    Dim nLen As Long
    Dim nPad As Integer
    Dim abPadded() As Byte
    Dim i As Long
    
    'Set up error handler for empty array
    On Error GoTo ArrayIsEmpty

    nLen = UBound(abData) - LBound(abData) + 1
    nPad = ((nLen \ 8) + 1) * 8 - nLen
    
    ReDim abPadded(nLen + nPad - 1)  ' Pad with # of pads (1-8)
    If nLen > 0 Then
        CopyMemory VarPtr(abPadded(0)), VarPtr(abData(0)), nLen
    End If
    For i = nLen To nLen + nPad - 1
        abPadded(i) = CByte(nPad)
    Next
    
ArrayIsEmpty:
    PadBytes = abPadded

End Function

Private Function UnpadBytes(abData() As Byte) As Variant
' Strip PKCS#5/RFC2630/RFC3370-style padding
    Dim nLen As Long
    Dim nPad As Long
    Dim abUnpadded() As Byte
    Dim i As Long
    
    'Set up error handler for empty array
    On Error GoTo ArrayIsEmpty
    
    nLen = UBound(abData) - LBound(abData) + 1
    If nLen = 0 Then GoTo ArrayIsEmpty
    ' Get # of padding bytes from last char
    nPad = abData(nLen - 1)
    If nPad > 8 Then nPad = 0   ' In case invalid
    If nLen - nPad > 0 Then
        ReDim abUnpadded(nLen - nPad - 1)
        CopyMemory VarPtr(abUnpadded(0)), VarPtr(abData(0)), nLen - nPad
    End If

ArrayIsEmpty:
    UnpadBytes = abUnpadded
    
End Function

Private Function TestPadBytes()
    Dim abData() As Byte
    
    abData = StrConv("abc", vbFromUnicode)
    abData = PadBytes(abData)
    Stop
    abData = UnpadBytes(abData)
    Stop
    
End Function

Private Sub bXorBytes(aByt1() As Byte, aByt2() As Byte, nBytes As Long)
' XOR's bytes in array aByt1 with array aByt2
' Returns results in aByt1
' i.e. aByt1() = aByt1() XOR aByt2()
    Dim i As Long
    For i = 0 To nBytes - 1
        aByt1(i) = aByt1(i) Xor aByt2(i)
    Next
End Sub

Private Function blf_BytesEncRawCBC(abData() As Byte, abInitV() As Byte) As Variant
' Encrypts byte array <abData> in CBC mode
' using byte array <abInitV> as initialisation vector.
' Returns ciphertext as variant array of bytes.
' Requires key and boxes to be already set up.
' New in Version 6.
    Dim nLen As Long
    Dim nBlocks As Long
    Dim iBlock As Long
    Dim abBlock(7) As Byte
    Dim iIndex As Long
    Dim abReg(7) As Byte    ' Feedback register
    Dim abOutput() As Byte
    
    ' Initialisation vector should be a 8-byte array
    ' so ReDim just to make sure
    ' This will add zero bytes if too short or chop off any extra
    ReDim Preserve abInitV(7)
    
    ' Calc number of 8-byte blocks
    nLen = UBound(abData) - LBound(abData) + 1
    nBlocks = nLen \ 8
    
    ' Dimension output
    ReDim abOutput(nBlocks * 8 - 1)
    
    ' C_0 = IV
    CopyMemory VarPtr(abReg(0)), VarPtr(abInitV(0)), 8&
    
    ' Work through string in blocks of 8 bytes
    iIndex = 0
    For iBlock = 1 To nBlocks
        ' Fetch next block from input
        CopyMemory VarPtr(abBlock(0)), VarPtr(abData(iIndex)), 8&
        
        ' XOR with feedback register = Pi XOR C_i-1
        Call bXorBytes(abBlock, abReg, 8)
        
        ' Encrypt the block Ci = Ek(Pi XOR C_i-1)
        Call blf_EncryptBytes(abBlock())
        
        ' Store in feedback register Reg = Ci
        CopyMemory VarPtr(abReg(0)), VarPtr(abBlock(0)), 8&
        
        ' Copy to output string
        CopyMemory VarPtr(abOutput(iIndex)), VarPtr(abBlock(0)), 8&

        iIndex = iIndex + 8
    Next
    
    blf_BytesEncRawCBC = abOutput
    
End Function

Private Function blf_BytesDecRawCBC(abData() As Byte, abInitV() As Byte) As Variant
' Decrypts byte array <abData> in CBC mode
' using byte array <abInitV> as initialisation vector.
' Returns plaintext as variant array of bytes.
' Requires key and boxes to be already set up.
' New in Version 6.
    Dim strIn As String
    Dim strOut As String
    Dim nLen As Long
    Dim nBlocks As Long
    Dim iBlock As Long
    Dim abBlock(7) As Byte
    Dim iIndex As Long
    Dim abReg(7) As Byte    ' Feedback register
    Dim abStore(7) As Byte
    Dim abOutput() As Byte
    
    ' Initialisation vector should be a 8-byte array
    ' so ReDim just to make sure
    ' This will add zero bytes if too short or chop off any extra
    ReDim Preserve abInitV(7)
    
    ' Calc number of 8-byte blocks
    nLen = UBound(abData) - LBound(abData) + 1
    nBlocks = nLen \ 8
    
    ' Dimension output
    ReDim abOutput(nBlocks * 8 - 1)
    
    ' C_0 = IV
    CopyMemory VarPtr(abReg(0)), VarPtr(abInitV(0)), 8&
    
    ' Work through string in blocks of 8 bytes
    iIndex = 0
    For iBlock = 1 To nBlocks
        ' Fetch next block from input
        CopyMemory VarPtr(abBlock(0)), VarPtr(abData(iIndex)), 8&
        
        ' Save C_i-1
        CopyMemory VarPtr(abStore(0)), VarPtr(abBlock(0)), 8&
        
        ' Decrypt the block Dk(Ci)
        Call blf_DecryptBytes(abBlock())
        
        ' XOR with feedback register = C_i-1 XOR Dk(Ci)
        Call bXorBytes(abBlock, abReg, 8)
        
        ' Store in feedback register Reg = C_i-1
        CopyMemory VarPtr(abReg(0)), VarPtr(abStore(0)), 8&
        
        ' Copy to output string
        CopyMemory VarPtr(abOutput(iIndex)), VarPtr(abBlock(0)), 8&

        iIndex = iIndex + 8
    Next
    
    blf_BytesDecRawCBC = abOutput
    
End Function

Private Function blf_BytesEncCBC(abData() As Byte, abInitV() As Byte) As Variant
' Encrypts byte array abData after adding PKCS#5/RFC2630/RFC3370 padding
' NB always adds padding - use blf_BytesEncRawCBC() if you don't want padding
' CBC mode
' Returns encrypted byte array as a variant.
' Requires key and boxes to be already set up.
' New in Version 6.

    Dim abOutput() As Byte
    
    abOutput = PadBytes(abData)
    abOutput = blf_BytesEncRawCBC(abOutput, abInitV)
    
    blf_BytesEncCBC = abOutput
End Function

Private Function blf_BytesDecCBC(abData() As Byte, abInitV() As Byte) As Variant
' Decrypts byte array abData assuming PKCS#5/RFC2630/RFC3370 padding and CBC mode
' NB always removes valid padding - use blf_BytesDecRawCBC() if you don't want padding
' Returns encrypted byte array as a variant.
' Requires key and boxes to be already set up.
' New in Version 6.

    Dim abOutput() As Byte
    
    abOutput = blf_BytesDecRawCBC(abData, abInitV)
    abOutput = UnpadBytes(abOutput)
    
    blf_BytesDecCBC = abOutput
End Function





Private Function blf_BytesRaw1(abData() As Byte, bEncrypt As Boolean) As Variant
    Dim nLen As Long
    Dim nBlocks As Long
    Dim iBlock As Long
    Dim j As Long
    Dim abOutput() As Byte
    Dim abBlock(7) As Byte
    Dim iIndex As Long
    
    ' Calc number of 8-byte blocks (ignore odd trailing bytes)
    nLen = UBound(abData) - LBound(abData) + 1
    nBlocks = nLen \ 8
    
    ReDim abOutput(nBlocks * 8 - 1)
    
    ' Work through in blocks of 8 bytes
    iIndex = 0
    For iBlock = 1 To nBlocks
        ' Get the next block of 8 bytes
        CopyMemory VarPtr(abBlock(0)), VarPtr(abData(iIndex)), 8&

        ' En/Decrypt the block according to flag
        If bEncrypt Then
            Call blf_EncryptBytes1(abBlock())
        Else
            Call blf_DecryptBytes1(abBlock())
        End If
        
        ' Copy to output string
        CopyMemory VarPtr(abOutput(iIndex)), VarPtr(abBlock(0)), 8&
        
        iIndex = iIndex + 8
    Next
    
    blf_BytesRaw1 = abOutput
    
End Function

' basUnsignedWord: Utilities for unsigned word arithmetic

' Version 6. November 2003. Unchanged from Version 5.
' Version 5. January 2002. Replaced uw_WordSplit and uw_WordJoin
' with more efficient uwSplit and uwJoin.
' Version 4. 12 May 2001. Mods to speed up.
' Thanks to Doug J Ward for advice and suggestions.
'************************* COPYRIGHT NOTICE*************************
' This code was originally written in Visual Basic by David Ireland
' and is copyright (c) 2000-2 D.I. Management Services Pty Limited,
' all rights reserved.

' You are free to use this code as part of your own applications
' provided you keep this copyright notice intact and acknowledge
' its authorship with the words:

'   "Contains cryptography software by David Ireland of
'   DI Management Services Pty Ltd <www.di-mgt.com.au>."

' If you use it as part of a web site, please include a link
' to our site in the form
' <A HREF="http://www.di-mgt.com.au/crypto.html">Cryptography
' Software Code</a>

' This code may only be used as part of an application. It may
' not be reproduced or distributed separately by any means without
' the express written permission of the author.

' David Ireland and DI Management Services Pty Limited make no
' representations concerning either the merchantability of this
' software or the suitability of this software for any particular
' purpose. It is provided "as is" without express or implied
' warranty of any kind.

' Please forward comments or bug reports to <.au>.
' The latest version of this source code can be downloaded from
' www.di-mgt.com.au/crypto.html.
'****************** END OF COPYRIGHT NOTICE*************************

Private Function uwJoin(a As Byte, b As Byte, C As Byte, d As Byte) As Long
' Added Version 5: replacement for uw_WordJoin
' Join 4 x 8-bit bytes into one 32-bit word a.b.c.d
    uwJoin = ((a And &H7F) * &H1000000) Or (b * &H10000) Or (CLng(C) * &H100) Or d
    If a And &H80 Then
        uwJoin = uwJoin Or &H80000000
    End If
End Function

Private Sub uwSplit(ByVal w As Long, a As Byte, b As Byte, C As Byte, d As Byte)
' Added Version 5: replacement for uw_WordSplit
' Split 32-bit word w into 4 x 8-bit bytes
    a = CByte(((w And &HFF000000) \ &H1000000) And &HFF)
    b = CByte(((w And &HFF0000) \ &H10000) And &HFF)
    C = CByte(((w And &HFF00) \ &H100) And &HFF)
    d = CByte((w And &HFF) And &HFF)
End Sub

' Function re-written 11 May 2001.
Private Function uw_ShiftLeftBy8(wordX As Long) As Long
    ' Shift 32-bit long value to left by 8 bits
    ' i.e. VB equivalent of "wordX << 8" in C
    ' Avoiding problem with sign bit
    uw_ShiftLeftBy8 = (wordX And &H7FFFFF) * &H100
    If (wordX And &H800000) <> 0 Then
        uw_ShiftLeftBy8 = uw_ShiftLeftBy8 Or &H80000000
    End If
End Function

Private Function uw_WordAdd(wordA As Long, wordB As Long) As Long
' Adds words A and B avoiding overflow
    Dim myUnsigned As Double
    
    myUnsigned = LongToUnsigned(wordA) + LongToUnsigned(wordB)
    ' Cope with overflow
    If myUnsigned > OFFSET_4 Then
        myUnsigned = myUnsigned - OFFSET_4
    End If
    uw_WordAdd = UnsignedToLong(myUnsigned)
    
End Function

Private Function uw_WordSub(wordA As Long, wordB As Long) As Long
' Subtract words A and B avoiding underflow
    Dim myUnsigned As Double
    
    myUnsigned = LongToUnsigned(wordA) - LongToUnsigned(wordB)
    ' Cope with underflow
    If myUnsigned < 0 Then
        myUnsigned = myUnsigned + OFFSET_4
    End If
    uw_WordSub = UnsignedToLong(myUnsigned)
End Function

'****************************************************
' These two functions from Microsoft Article Q189323
' "HOWTO: convert between Signed and Unsigned Numbers"

Private Function UnsignedToLong(value As Double) As Long
    If value < 0 Or value >= OFFSET_4 Then Error 6 ' Overflow
    If value <= MAXINT_4 Then
        UnsignedToLong = value
    Else
        UnsignedToLong = value - OFFSET_4
    End If
End Function

Private Function LongToUnsigned(value As Long) As Double
    If value < 0 Then
        LongToUnsigned = value + OFFSET_4
    Else
        LongToUnsigned = value
    End If
End Function

' End of Microsoft-article functions
'****************************************************

' basConvert: Utilities to convert between byte arrays, hex strings,
' strings containing binary values, and 32-bit word arrays.

' NB: On 32-bit Unicode/CJK systems you may need to do a global
' replace of Asc() and Chr() with AscW() and ChrW() respectively.

' Version 2. November 2003: removed cv_BytesFromString which can be
' done with abBytes = StrConv(strInput, vbFromUnicode).
' - Added error handling to catch empty arrays.
' - Made HexFromByte private.
' Version 1. First published January 2002
'************************* COPYRIGHT NOTICE*************************
' This code was originally written in Visual Basic by David Ireland
' and is copyright (c) 2000-2 D.I. Management Services Pty Limited,
' all rights reserved.

' You are free to use this code as part of your own applications
' provided you keep this copyright notice intact.

' This code may only be used as part of an application. It may
' not be reproduced or distributed separately by any means without
' the express written permission of the author.

' David Ireland and DI Management Services Pty Limited make no
' representations concerning either the merchantability of this
' software or the suitability of this software for any particular
' purpose. It is provided "as is" without express or implied
' warranty of any kind.

' Please forward comments or bug reports to <.au>.
' The latest version of this source code can be downloaded from
' www.di-mgt.com.au/crypto.html.
'****************** END OF COPYRIGHT NOTICE*************************

' The private Functions in this module are:
' cv_BytesFromHex(sInputHex): Returns array of bytes
' cv_WordsFromHex(sHex): Returns array of words (Longs)
' cv_HexFromWords(aWords): Returns hex string
' cv_HexFromBytes(aBytes()): Returns hex string
' cv_HexFromString(str): Returns hex string
' cv_StringFromHex(strHex): Returns string of ascii characters
' cv_GetHexByte(sInputHex, iIndex): Extracts iIndex'th byte from hex string
' RandHexByte(): Returns random byte as a 2-digit hex string
' HexFromByte(x): Returns 2-digit hex string representing byte x

Private Function cv_BytesFromHex(ByVal sInputHex As String) As Variant
' Returns array of bytes from hex string in big-endian order
' E.g. sHex="FEDC80" will return array {&HFE, &HDC, &H80}
    Dim i As Long
    Dim M As Long
    Dim aBytes() As Byte
    If Len(sInputHex) Mod 2 <> 0 Then
        sInputHex = "0" & sInputHex
    End If
    
    M = Len(sInputHex) \ 2
    If M <= 0 Then
        ' Version 2: Returns empty array
        cv_BytesFromHex = aBytes
        Exit Function
    End If
    
    ReDim aBytes(M - 1)
    
    For i = 0 To M - 1
        aBytes(i) = Val("&H" & Mid$(sInputHex, i * 2 + 1, 2))
    Next
    
    cv_BytesFromHex = aBytes

End Function

Private Function cv_WordsFromHex(ByVal sHex As String) As Variant
' Converts string <sHex> with hex values into array of words (long ints)
' E.g. "fedcba9876543210" will be converted into {&HFEDCBA98, &H76543210}
    Const ncLEN As Integer = 8
    Dim i As Long
    Dim nWords As Long
    Dim aWords() As Long
    
    nWords = Len(sHex) \ ncLEN
    If nWords <= 0 Then
        ' Version 2: Returns empty array
        cv_WordsFromHex = aWords
        Exit Function
    End If
    
    ReDim aWords(nWords - 1)
    For i = 0 To nWords - 1
        aWords(i) = Val("&H" & Mid(sHex, i * ncLEN + 1, ncLEN))
    Next
    
    cv_WordsFromHex = aWords
    
End Function

Private Function cv_HexFromWords(aWords) As String
' Converts array of words (Longs) into a hex string
' E.g. {&HFEDCBA98, &H76543210} will be converted to "FEDCBA9876543210"
    Const ncLEN As Integer = 8
    Dim i As Long
    Dim nWords As Long
    Dim sHex As String * ncLEN
    Dim iIndex As Long
    
    'Set up error handler to catch empty array
    On Error GoTo ArrayIsEmpty
    If Not IsArray(aWords) Then
        Exit Function
    End If
    
    nWords = UBound(aWords) - LBound(aWords) + 1
    cv_HexFromWords = String(nWords * ncLEN, " ")
    iIndex = 0
    For i = 0 To nWords - 1
        sHex = Hex(aWords(i))
        sHex = String(ncLEN - Len(sHex), "0") & sHex
        Mid$(cv_HexFromWords, iIndex + 1, ncLEN) = sHex
        iIndex = iIndex + ncLEN
    Next
    
ArrayIsEmpty:

End Function

Private Function cv_HexFromBytes(aBytes() As Byte) As String
' Returns hex string from array of bytes
' E.g. aBytes() = {&HFE, &HDC, &H80} will return "FEDC80"
    Dim i As Long
    Dim iIndex As Long
    Dim nLen As Long
    
    'Set up error handler to catch empty array
    On Error GoTo ArrayIsEmpty

    nLen = UBound(aBytes) - LBound(aBytes) + 1

    cv_HexFromBytes = String(nLen * 2, " ")
    iIndex = 0
    For i = LBound(aBytes) To UBound(aBytes)
        Mid$(cv_HexFromBytes, iIndex + 1, 2) = HexFromByte(aBytes(i))
        iIndex = iIndex + 2
    Next
    
ArrayIsEmpty:
    
End Function

Private Function cv_HexFromString(str As String) As String
' Converts string <str> of ascii chars to string in hex format
' str may contain chars of any value between 0 and 255.
' E.g. "abc." will be converted to "6162632E"
    Dim byt As Byte
    Dim i As Long
    Dim n As Long
    Dim iIndex As Long
    Dim sHex As String
    
    n = Len(str)
    sHex = String(n * 2, " ")
    iIndex = 0
    For i = 1 To n
        byt = CByte(Asc(Mid$(str, i, 1)) And &HFF)
        Mid$(sHex, iIndex + 1, 2) = HexFromByte(byt)
        iIndex = iIndex + 2
    Next
    cv_HexFromString = sHex
    
End Function

Private Function cv_StringFromHex(strHex As String) As String
' Converts string <strHex> in hex format to string of ascii chars
' with value between 0 and 255.
' E.g. "6162632E" will be converted to "abc."
    Dim i As Integer
    Dim nBytes As Integer
    
    nBytes = Len(strHex) \ 2
    cv_StringFromHex = String(nBytes, " ")
    For i = 0 To nBytes - 1
        Mid$(cv_StringFromHex, i + 1, 1) = Chr$(Val("&H" & Mid$(strHex, i * 2 + 1, 2)))
    Next
    
End Function

Private Function cv_GetHexByte(ByVal sInputHex As String, iIndex As Long) As Byte
' Extracts iIndex'th byte from hex string (starting at 1)
' E.g. cv_GetHexByte("fecdba98", 3) will return &HBA
    Dim i As Long
    i = 2 * iIndex
    If i > Len(sInputHex) Or i <= 0 Then
        cv_GetHexByte = 0
    Else
        cv_GetHexByte = Val("&H" & Mid$(sInputHex, i - 1, 2))
    End If
    
End Function

Private Function RandHexByte() As String
'   Returns a random byte as a 2-digit hex string
    Static stbInit As Boolean
    If Not stbInit Then
        Randomize
        stbInit = True
    End If
    
    RandHexByte = HexFromByte(CByte((Rnd * 256) And &HFF))
End Function

Private Function HexFromByte(ByVal x) As String
' Returns a 2-digit hex string for byte x
    x = x And &HFF
    If x < 16 Then
        HexFromByte = "0" & Hex(x)
    Else
        HexFromByte = Hex(x)
    End If
End Function


Private Function testWordsHex()
    Dim aWords
    
    aWords = cv_WordsFromHex("FEDCBA9876543210")
    Debug.Print cv_HexFromWords(aWords)
    
End Function




' basBlowfish: Bruce Schneier's Blowfish algorithm in VB
' Core routines.

' Version 6. November 2003. Removed redundant functions blf_Enc()
' and blf_Dec().
' Version 5: January 2002. Speed improvements.
' Version 4: 12 May 2001. Fixed maxkeylen size from bits to bytes.
' First published October 2000.
'************************* COPYRIGHT NOTICE*************************
' This code was originally written in Visual Basic by David Ireland
' and is copyright (c) 2000-2 D.I. Management Services Pty Limited,
' all rights reserved.

' You are free to use this code as part of your own applications
' provided you keep this copyright notice intact and acknowledge
' its authorship with the words:

'   "Contains cryptography software by David Ireland of
'   DI Management Services Pty Ltd <www.di-mgt.com.au>."

' If you use it as part of a web site, please include a link
' to our site in the form
' <A HREF="http://www.di-mgt.com.au/crypto.html">Cryptography
' Software Code</a>

' This code may only be used as part of an application. It may
' not be reproduced or distributed separately by any means without
' the express written permission of the author.

' David Ireland and DI Management Services Pty Limited make no
' representations concerning either the merchantability of this
' software or the suitability of this software for any particular
' purpose. It is provided "as is" without express or implied
' warranty of any kind.

' Please forward comments or bug reports to <.au>.
' The latest version of this source code can be downloaded from
' www.di-mgt.com.au/crypto.html.
'****************** END OF COPYRIGHT NOTICE*************************

' private Functions in this module:
' blf_EncipherBlock: Encrypts two words
' blf_DecipherBlock: Decrypts two words
' blf_Initialise: Initialise P & S arrays using key
' blf_KeyInit: Initialise using byte-array key
' blf_EncryptBytes: Encrypts an block of 8 bytes
' blf_DecryptBytes: Decrypts an block of 8 bytes
'
' Superseded functions:
' blf_Key: Initialise using byte-array and its length
' blf_Enc: Encrypts an array of words
' blf_Dec: Decrypts an array of words

' Version 4: ncMAXKEYLEN was previously incorrectly set as 448
' (bits vs bytes)
' Thanks to Robert Garofalo for pointing this out.

Private Function blf_F(x As Long) As Long
    Dim a As Byte, b As Byte, C As Byte, d As Byte
    Dim y As Long
    
    Call uwSplit(x, a, b, C, d)
    
    y = uw_WordAdd(blf_S(0, a), blf_S(1, b))
    y = y Xor blf_S(2, C)
    y = uw_WordAdd(y, blf_S(3, d))
    blf_F = y
    
End Function

Private Function blf_EncipherBlock(xL As Long, xR As Long)
    Dim i As Integer
    Dim Temp As Long
    
    For i = 0 To ncROUNDS - 1
        xL = xL Xor blf_P(i)
        xR = blf_F(xL) Xor xR
        Temp = xL
        xL = xR
        xR = Temp
    Next
    
    Temp = xL
    xL = xR
    xR = Temp
    
    xR = xR Xor blf_P(ncROUNDS)
    xL = xL Xor blf_P(ncROUNDS + 1)
        
End Function

Private Function blf_DecipherBlock(xL As Long, xR As Long)
    Dim i As Integer
    Dim Temp As Long
    
    For i = ncROUNDS + 1 To 2 Step -1
        xL = xL Xor blf_P(i)
        xR = blf_F(xL) Xor xR
        Temp = xL
        xL = xR
        xR = Temp
    Next
    
    Temp = xL
    xL = xR
    xR = Temp
    
    xR = xR Xor blf_P(1)
    xL = xL Xor blf_P(0)
        
End Function

Private Function blf_Initialise(aKey() As Byte, nKeyBytes As Integer)
    Dim i As Integer, j As Integer, k As Integer
    Dim wData As Long, wDataL As Long, wDataR As Long
    
    Call blf_LoadArrays     ' Initialise P and S arrays

    j = 0
    For i = 0 To (ncROUNDS + 2 - 1)
        wData = &H0
        For k = 0 To 3
            wData = uw_ShiftLeftBy8(wData) Or aKey(j)
            j = j + 1
            If j >= nKeyBytes Then j = 0
        Next k
        blf_P(i) = blf_P(i) Xor wData
    Next i
    
    Special_Table

    wDataL = &H0
    wDataR = &H0
    
    For i = 0 To (ncROUNDS + 2 - 1) Step 2
        Call blf_EncipherBlock(wDataL, wDataR)
        
        blf_P(i) = wDataL
        blf_P(i + 1) = wDataR
    Next i
    
    For i = 0 To 3
        For j = 0 To 255 Step 2
            Call blf_EncipherBlock(wDataL, wDataR)
    
            blf_S(i, j) = wDataL
            blf_S(i, j + 1) = wDataR
        Next j
    Next i

End Function

Private Function blf_Key(aKey() As Byte, nKeyLen As Integer) As Boolean
    blf_Key = False
    If nKeyLen < 0 Or nKeyLen > ncMAXKEYLEN Then
        Exit Function
    End If
    
    Call blf_Initialise(aKey, nKeyLen)
    
    blf_Key = True
End Function

Private Function blf_KeyInit(aKey() As Byte) As Boolean
' Added Version 5: Replacement for blf_Key to avoid specifying keylen
' Version 6: Added error checking for input
    Dim nKeyLen As Integer
    
    blf_KeyInit = False
    
    'Set up error handler to catch empty array
    On Error GoTo ArrayIsEmpty

    nKeyLen = UBound(aKey) - LBound(aKey) + 1
    If nKeyLen < 0 Or nKeyLen > ncMAXKEYLEN Then
        Exit Function
    End If
    
    Call blf_Initialise(aKey, nKeyLen)
    
    blf_KeyInit = True
    
ArrayIsEmpty:

End Function

Private Function blf_EncryptBytes(aBytes() As Byte)
' aBytes() must be 8 bytes long
' Revised Version 5: January 2002. To use faster uwJoin and uwSplit fns.
    Dim wordL As Long, wordR As Long
    
    ' Convert to 2 x words
    wordL = uwJoin(aBytes(0), aBytes(1), aBytes(2), aBytes(3))
    wordR = uwJoin(aBytes(4), aBytes(5), aBytes(6), aBytes(7))
    ' Encrypt it
    Call blf_EncipherBlock(wordL, wordR)
    ' Put back into bytes
    Call uwSplit(wordL, aBytes(0), aBytes(1), aBytes(2), aBytes(3))
    Call uwSplit(wordR, aBytes(4), aBytes(5), aBytes(6), aBytes(7))

End Function

Private Function blf_DecryptBytes(aBytes() As Byte)
' aBytes() must be 8 bytes long
' Revised Version 5:: January 2002. To use faster uwJoin and uwSplit fns.
    Dim wordL As Long, wordR As Long
    
    ' Convert to 2 x words
    wordL = uwJoin(aBytes(0), aBytes(1), aBytes(2), aBytes(3))
    wordR = uwJoin(aBytes(4), aBytes(5), aBytes(6), aBytes(7))
    ' Decrypt it
    Call blf_DecipherBlock(wordL, wordR)
    ' Put back into bytes
    Call uwSplit(wordL, aBytes(0), aBytes(1), aBytes(2), aBytes(3))
    Call uwSplit(wordR, aBytes(4), aBytes(5), aBytes(6), aBytes(7))

End Function

Private Function blf_EncryptBytes1(aBytes() As Byte)
' aBytes() must be 8 bytes long
' Revised Version 5: January 2002. To use faster uwJoin and uwSplit fns.
    Dim wordL As Long, wordR As Long
    
    ' Convert to 2 x words
    wordL = uwJoin(aBytes(3), aBytes(2), aBytes(1), aBytes(0))
    wordR = uwJoin(aBytes(7), aBytes(6), aBytes(5), aBytes(4))
    ' Encrypt it
    Call blf_EncipherBlock(wordL, wordR)
    ' Put back into bytes
    Call uwSplit(wordL, aBytes(3), aBytes(2), aBytes(1), aBytes(0))
    Call uwSplit(wordR, aBytes(7), aBytes(6), aBytes(5), aBytes(4))

End Function

Private Function blf_DecryptBytes1(aBytes() As Byte)
' aBytes() must be 8 bytes long
' Revised Version 5:: January 2002. To use faster uwJoin and uwSplit fns.
    Dim wordL As Long, wordR As Long
    
    ' Convert to 2 x words
    wordL = uwJoin(aBytes(3), aBytes(2), aBytes(1), aBytes(0))
    wordR = uwJoin(aBytes(7), aBytes(6), aBytes(5), aBytes(4))
    ' Decrypt it
    Call blf_DecipherBlock(wordL, wordR)
    ' Put back into bytes
    Call uwSplit(wordL, aBytes(3), aBytes(2), aBytes(1), aBytes(0))
    Call uwSplit(wordR, aBytes(7), aBytes(6), aBytes(5), aBytes(4))

End Function


' basBlfArrays: Initialises P-array and S-boxes for Blowfish algorithm

' First published October 2000.
'************************* COPYRIGHT NOTICE*************************
' This code was originally written in Visual Basic by David Ireland
' and is copyright (c) 2000-2 D.I. Management Services Pty Limited,
' all rights reserved.

' You are free to use this code as part of your own applications
' provided you keep this copyright notice intact and acknowledge
' its authorship with the words:

'   "Contains cryptography software by David Ireland of
'   DI Management Services Pty Ltd <www.di-mgt.com.au>."

' If you use it as part of a web site, please include a link
' to our site in the form
' <A HREF="http://www.di-mgt.com.au/crypto.html">Cryptography
' Software Code</a>

' This code may only be used as part of an application. It may
' not be reproduced or distributed separately by any means without
' the express written permission of the author.

' David Ireland and DI Management Services Pty Limited make no
' representations concerning either the merchantability of this
' software or the suitability of this software for any particular
' purpose. It is provided "as is" without express or implied
' warranty of any kind.

' Please forward comments or bug reports to <.au>.
' The latest version of this source code can be downloaded from
' www.di-mgt.com.au/crypto.html.
'****************** END OF COPYRIGHT NOTICE*************************

Private Function blf_LoadArrays()
' Use Array fn and a temp variant array to load data into arrays
    Dim vntA As Variant
    Dim i As Integer

    ' P-array
    vntA = Array( _
        &H243F6A88, &H85A308D3, &H13198A2E, &H3707344, _
        &HA4093822, &H299F31D0, &H82EFA98, &HEC4E6C89, _
        &H452821E6, &H38D01377, &HBE5466CF, &H34E90C6C, _
        &HC0AC29B7, &HC97C50DD, &H3F84D5B5, &HB5470917, _
        &H9216D5D9, &H8979FB1B)
    
    For i = 0 To 17
        blf_P(i) = vntA(i)
    Next
    
    ' Load S-boxes - 16 x 4 at a time
    
    ' S-box[0]
    vntA = Array( _
        &HD1310BA6, &H98DFB5AC, &H2FFD72DB, &HD01ADFB7, _
        &HB8E1AFED, &H6A267E96, &HBA7C9045, &HF12C7F99, _
        &H24A19947, &HB3916CF7, &H801F2E2, &H858EFC16, _
        &H636920D8, &H71574E69, &HA458FEA3, &HF4933D7E, _
        &HD95748F, &H728EB658, &H718BCD58, &H82154AEE, _
        &H7B54A41D, &HC25A59B5, &H9C30D539, &H2AF26013, _
        &HC5D1B023, &H286085F0, &HCA417918, &HB8DB38EF, _
        &H8E79DCB0, &H603A180E, &H6C9E0E8B, &HB01E8A3E, _
        &HD71577C1, &HBD314B27, &H78AF2FDA, &H55605C60, _
        &HE65525F3, &HAA55AB94, &H57489862, &H63E81440, _
        &H55CA396A, &H2AAB10B6, &HB4CC5C34, &H1141E8CE, _
        &HA15486AF, &H7C72E993, &HB3EE1411, &H636FBC2A, _
        &H2BA9C55D, &H741831F6, &HCE5C3E16, &H9B87931E, _
        &HAFD6BA33, &H6C24CF5C, &H7A325381, &H28958677, _
        &H3B8F4898, &H6B4BB9AF, &HC4BFE81B, &H66282193, _
        &H61D809CC, &HFB21A991, &H487CAC60, &H5DEC8032)
        
    For i = 0 To 63
        blf_S(0, i) = vntA(i)
    Next
    
    vntA = Array( _
        &HEF845D5D, &HE98575B1, &HDC262302, &HEB651B88, _
        &H23893E81, &HD396ACC5, &HF6D6FF3, &H83F44239, _
        &H2E0B4482, &HA4842004, &H69C8F04A, &H9E1F9B5E, _
        &H21C66842, &HF6E96C9A, &H670C9C61, &HABD388F0, _
        &H6A51A0D2, &HD8542F68, &H960FA728, &HAB5133A3, _
        &H6EEF0B6C, &H137A3BE4, &HBA3BF050, &H7EFB2A98, _
        &HA1F1651D, &H39AF0176, &H66CA593E, &H82430E88, _
        &H8CEE8619, &H456F9FB4, &H7D84A5C3, &H3B8B5EBE, _
        &HE06F75D8, &H85C12073, &H401A449F, &H56C16AA6, _
        &H4ED3AA62, &H363F7706, &H1BFEDF72, &H429B023D, _
        &H37D0D724, &HD00A1248, &HDB0FEAD3, &H49F1C09B, _
        &H75372C9, &H80991B7B, &H25D479D8, &HF6E8DEF7, _
        &HE3FE501A, &HB6794C3B, &H976CE0BD, &H4C006BA, _
        &HC1A94FB6, &H409F60C4, &H5E5C9EC2, &H196A2463, _
        &H68FB6FAF, &H3E6C53B5, &H1339B2EB, &H3B52EC6F, _
        &H6DFC511F, &H9B30952C, &HCC814544, &HAF5EBD09)
        
    For i = 0 To 63     '64 To 127
        blf_S(0, i + 64) = vntA(i)
    Next
        
    vntA = Array( _
        &HBEE3D004, &HDE334AFD, &H660F2807, &H192E4BB3, _
        &HC0CBA857, &H45C8740F, &HD20B5F39, &HB9D3FBDB, _
        &H5579C0BD, &H1A60320A, &HD6A100C6, &H402C7279, _
        &H679F25FE, &HFB1FA3CC, &H8EA5E9F8, &HDB3222F8, _
        &H3C7516DF, &HFD616B15, &H2F501EC8, &HAD0552AB, _
        &H323DB5FA, &HFD238760, &H53317B48, &H3E00DF82, _
        &H9E5C57BB, &HCA6F8CA0, &H1A87562E, &HDF1769DB, _
        &HD542A8F6, &H287EFFC3, &HAC6732C6, &H8C4F5573, _
        &H695B27B0, &HBBCA58C8, &HE1FFA35D, &HB8F011A0, _
        &H10FA3D98, &HFD2183B8, &H4AFCB56C, &H2DD1D35B, _
        &H9A53E479, &HB6F84565, &HD28E49BC, &H4BFB9790, _
        &HE1DDF2DA, &HA4CB7E33, &H62FB1341, &HCEE4C6E8, _
        &HEF20CADA, &H36774C01, &HD07E9EFE, &H2BF11FB4, _
        &H95DBDA4D, &HAE909198, &HEAAD8E71, &H6B93D5A0, _
        &HD08ED1D0, &HAFC725E0, &H8E3C5B2F, &H8E7594B7, _
        &H8FF6E2FB, &HF2122B64, &H8888B812, &H900DF01C)
        
    For i = 0 To 63     ' 128 To 191
        blf_S(0, i + 128) = vntA(i)
    Next
        
    vntA = Array( _
        &H4FAD5EA0, &H688FC31C, &HD1CFF191, &HB3A8C1AD, _
        &H2F2F2218, &HBE0E1777, &HEA752DFE, &H8B021FA1, _
        &HE5A0CC0F, &HB56F74E8, &H18ACF3D6, &HCE89E299, _
        &HB4A84FE0, &HFD13E0B7, &H7CC43B81, &HD2ADA8D9, _
        &H165FA266, &H80957705, &H93CC7314, &H211A1477, _
        &HE6AD2065, &H77B5FA86, &HC75442F5, &HFB9D35CF, _
        &HEBCDAF0C, &H7B3E89A0, &HD6411BD3, &HAE1E7E49, _
        &H250E2D, &H2071B35E, &H226800BB, &H57B8E0AF, _
        &H2464369B, &HF009B91E, &H5563911D, &H59DFA6AA, _
        &H78C14389, &HD95A537F, &H207D5BA2, &H2E5B9C5, _
        &H83260376, &H6295CFA9, &H11C81968, &H4E734A41, _
        &HB3472DCA, &H7B14A94A, &H1B510052, &H9A532915, _
        &HD60F573F, &HBC9BC6E4, &H2B60A476, &H81E67400, _
        &H8BA6FB5, &H571BE91F, &HF296EC6B, &H2A0DD915, _
        &HB6636521, &HE7B9F9B6, &HFF34052E, &HC5855664, _
        &H53B02D5D, &HA99F8FA1, &H8BA4799, &H6E85076A)

    For i = 0 To 63     ' 192 To 255
        blf_S(0, i + 192) = vntA(i)
    Next
   
    ' S-box[1]
    vntA = Array( _
        &H4B7A70E9, &HB5B32944, &HDB75092E, &HC4192623, _
        &HAD6EA6B0, &H49A7DF7D, &H9CEE60B8, &H8FEDB266, _
        &HECAA8C71, &H699A17FF, &H5664526C, &HC2B19EE1, _
        &H193602A5, &H75094C29, &HA0591340, &HE4183A3E, _
        &H3F54989A, &H5B429D65, &H6B8FE4D6, &H99F73FD6, _
        &HA1D29C07, &HEFE830F5, &H4D2D38E6, &HF0255DC1, _
        &H4CDD2086, &H8470EB26, &H6382E9C6, &H21ECC5E, _
        &H9686B3F, &H3EBAEFC9, &H3C971814, &H6B6A70A1, _
        &H687F3584, &H52A0E286, &HB79C5305, &HAA500737, _
        &H3E07841C, &H7FDEAE5C, &H8E7D44EC, &H5716F2B8, _
        &HB03ADA37, &HF0500C0D, &HF01C1F04, &H200B3FF, _
        &HAE0CF51A, &H3CB574B2, &H25837A58, &HDC0921BD, _
        &HD19113F9, &H7CA92FF6, &H94324773, &H22F54701, _
        &H3AE5E581, &H37C2DADC, &HC8B57634, &H9AF3DDA7, _
        &HA9446146, &HFD0030E, &HECC8C73E, &HA4751E41, _
        &HE238CD99, &H3BEA0E2F, &H3280BBA1, &H183EB331)
        
    For i = 0 To 63
        blf_S(1, i) = vntA(i)
    Next
        
    vntA = Array( _
        &H4E548B38, &H4F6DB908, &H6F420D03, &HF60A04BF, _
        &H2CB81290, &H24977C79, &H5679B072, &HBCAF89AF, _
        &HDE9A771F, &HD9930810, &HB38BAE12, &HDCCF3F2E, _
        &H5512721F, &H2E6B7124, &H501ADDE6, &H9F84CD87, _
        &H7A584718, &H7408DA17, &HBC9F9ABC, &HE94B7D8C, _
        &HEC7AEC3A, &HDB851DFA, &H63094366, &HC464C3D2, _
        &HEF1C1847, &H3215D908, &HDD433B37, &H24C2BA16, _
        &H12A14D43, &H2A65C451, &H50940002, &H133AE4DD, _
        &H71DFF89E, &H10314E55, &H81AC77D6, &H5F11199B, _
        &H43556F1, &HD7A3C76B, &H3C11183B, &H5924A509, _
        &HF28FE6ED, &H97F1FBFA, &H9EBABF2C, &H1E153C6E, _
        &H86E34570, &HEAE96FB1, &H860E5E0A, &H5A3E2AB3, _
        &H771FE71C, &H4E3D06FA, &H2965DCB9, &H99E71D0F, _
        &H803E89D6, &H5266C825, &H2E4CC978, &H9C10B36A, _
        &HC6150EBA, &H94E2EA78, &HA5FC3C53, &H1E0A2DF4, _
        &HF2F74EA7, &H361D2B3D, &H1939260F, &H19C27960)
        
    For i = 0 To 63     '64 To 127
        blf_S(1, i + 64) = vntA(i)
    Next
        
    vntA = Array( _
        &H5223A708, &HF71312B6, &HEBADFE6E, &HEAC31F66, _
        &HE3BC4595, &HA67BC883, &HB17F37D1, &H18CFF28, _
        &HC332DDEF, &HBE6C5AA5, &H65582185, &H68AB9802, _
        &HEECEA50F, &HDB2F953B, &H2AEF7DAD, &H5B6E2F84, _
        &H1521B628, &H29076170, &HECDD4775, &H619F1510, _
        &H13CCA830, &HEB61BD96, &H334FE1E, &HAA0363CF, _
        &HB5735C90, &H4C70A239, &HD59E9E0B, &HCBAADE14, _
        &HEECC86BC, &H60622CA7, &H9CAB5CAB, &HB2F3846E, _
        &H648B1EAF, &H19BDF0CA, &HA02369B9, &H655ABB50, _
        &H40685A32, &H3C2AB4B3, &H319EE9D5, &HC021B8F7, _
        &H9B540B19, &H875FA099, &H95F7997E, &H623D7DA8, _
        &HF837889A, &H97E32D77, &H11ED935F, &H16681281, _
        &HE358829, &HC7E61FD6, &H96DEDFA1, &H7858BA99, _
        &H57F584A5, &H1B227263, &H9B83C3FF, &H1AC24696, _
        &HCDB30AEB, &H532E3054, &H8FD948E4, &H6DBC3128, _
        &H58EBF2EF, &H34C6FFEA, &HFE28ED61, &HEE7C3C73)
        
    For i = 0 To 63     ' 128 To 191
        blf_S(1, i + 128) = vntA(i)
    Next
        
    vntA = Array( _
        &H5D4A14D9, &HE864B7E3, &H42105D14, &H203E13E0, _
        &H45EEE2B6, &HA3AAABEA, &HDB6C4F15, &HFACB4FD0, _
        &HC742F442, &HEF6ABBB5, &H654F3B1D, &H41CD2105, _
        &HD81E799E, &H86854DC7, &HE44B476A, &H3D816250, _
        &HCF62A1F2, &H5B8D2646, &HFC8883A0, &HC1C7B6A3, _
        &H7F1524C3, &H69CB7492, &H47848A0B, &H5692B285, _
        &H95BBF00, &HAD19489D, &H1462B174, &H23820E00, _
        &H58428D2A, &HC55F5EA, &H1DADF43E, &H233F7061, _
        &H3372F092, &H8D937E41, &HD65FECF1, &H6C223BDB, _
        &H7CDE3759, &HCBEE7460, &H4085F2A7, &HCE77326E, _
        &HA6078084, &H19F8509E, &HE8EFD855, &H61D99735, _
        &HA969A7AA, &HC50C06C2, &H5A04ABFC, &H800BCADC, _
        &H9E447A2E, &HC3453484, &HFDD56705, &HE1E9EC9, _
        &HDB73DBD3, &H105588CD, &H675FDA79, &HE3674340, _
        &HC5C43465, &H713E38D8, &H3D28F89E, &HF16DFF20, _
        &H153E21E7, &H8FB03D4A, &HE6E39F2B, &HDB83ADF7)
        
    For i = 0 To 63     ' 192 To 255
        blf_S(1, i + 192) = vntA(i)
    Next
    
    ' S-box[2]
    vntA = Array( _
        &HE93D5A68, &H948140F7, &HF64C261C, &H94692934, _
        &H411520F7, &H7602D4F7, &HBCF46B2E, &HD4A20068, _
        &HD4082471, &H3320F46A, &H43B7D4B7, &H500061AF, _
        &H1E39F62E, &H97244546, &H14214F74, &HBF8B8840, _
        &H4D95FC1D, &H96B591AF, &H70F4DDD3, &H66A02F45, _
        &HBFBC09EC, &H3BD9785, &H7FAC6DD0, &H31CB8504, _
        &H96EB27B3, &H55FD3941, &HDA2547E6, &HABCA0A9A, _
        &H28507825, &H530429F4, &HA2C86DA, &HE9B66DFB, _
        &H68DC1462, &HD7486900, &H680EC0A4, &H27A18DEE, _
        &H4F3FFEA2, &HE887AD8C, &HB58CE006, &H7AF4D6B6, _
        &HAACE1E7C, &HD3375FEC, &HCE78A399, &H406B2A42, _
        &H20FE9E35, &HD9F385B9, &HEE39D7AB, &H3B124E8B, _
        &H1DC9FAF7, &H4B6D1856, &H26A36631, &HEAE397B2, _
        &H3A6EFA74, &HDD5B4332, &H6841E7F7, &HCA7820FB, _
        &HFB0AF54E, &HD8FEB397, &H454056AC, &HBA489527, _
        &H55533A3A, &H20838D87, &HFE6BA9B7, &HD096954B)
        
    For i = 0 To 63
        blf_S(2, i) = vntA(i)
    Next
        
    vntA = Array( _
        &H55A867BC, &HA1159A58, &HCCA92963, &H99E1DB33, _
        &HA62A4A56, &H3F3125F9, &H5EF47E1C, &H9029317C, _
        &HFDF8E802, &H4272F70, &H80BB155C, &H5282CE3, _
        &H95C11548, &HE4C66D22, &H48C1133F, &HC70F86DC, _
        &H7F9C9EE, &H41041F0F, &H404779A4, &H5D886E17, _
        &H325F51EB, &HD59BC0D1, &HF2BCC18F, &H41113564, _
        &H257B7834, &H602A9C60, &HDFF8E8A3, &H1F636C1B, _
        &HE12B4C2, &H2E1329E, &HAF664FD1, &HCAD18115, _
        &H6B2395E0, &H333E92E1, &H3B240B62, &HEEBEB922, _
        &H85B2A20E, &HE6BA0D99, &HDE720C8C, &H2DA2F728, _
        &HD0127845, &H95B794FD, &H647D0862, &HE7CCF5F0, _
        &H5449A36F, &H877D48FA, &HC39DFD27, &HF33E8D1E, _
        &HA476341, &H992EFF74, &H3A6F6EAB, &HF4F8FD37, _
        &HA812DC60, &HA1EBDDF8, &H991BE14C, &HDB6E6B0D, _
        &HC67B5510, &H6D672C37, &H2765D43B, &HDCD0E804, _
        &HF1290DC7, &HCC00FFA3, &HB5390F92, &H690FED0B)
        
    For i = 0 To 63     '64 To 127
        blf_S(2, i + 64) = vntA(i)
    Next
        
    vntA = Array( _
        &H667B9FFB, &HCEDB7D9C, &HA091CF0B, &HD9155EA3, _
        &HBB132F88, &H515BAD24, &H7B9479BF, &H763BD6EB, _
        &H37392EB3, &HCC115979, &H8026E297, &HF42E312D, _
        &H6842ADA7, &HC66A2B3B, &H12754CCC, &H782EF11C, _
        &H6A124237, &HB79251E7, &H6A1BBE6, &H4BFB6350, _
        &H1A6B1018, &H11CAEDFA, &H3D25BDD8, &HE2E1C3C9, _
        &H44421659, &HA121386, &HD90CEC6E, &HD5ABEA2A, _
        &H64AF674E, &HDA86A85F, &HBEBFE988, &H64E4C3FE, _
        &H9DBC8057, &HF0F7C086, &H60787BF8, &H6003604D, _
        &HD1FD8346, &HF6381FB0, &H7745AE04, &HD736FCCC, _
        &H83426B33, &HF01EAB71, &HB0804187, &H3C005E5F, _
        &H77A057BE, &HBDE8AE24, &H55464299, &HBF582E61, _
        &H4E58F48F, &HF2DDFDA2, &HF474EF38, &H8789BDC2, _
        &H5366F9C3, &HC8B38E74, &HB475F255, &H46FCD9B9, _
        &H7AEB2661, &H8B1DDF84, &H846A0E79, &H915F95E2, _
        &H466E598E, &H20B45770, &H8CD55591, &HC902DE4C)
        
    For i = 0 To 63     ' 128 To 191
        blf_S(2, i + 128) = vntA(i)
    Next
        
    vntA = Array( _
        &HB90BACE1, &HBB8205D0, &H11A86248, &H7574A99E, _
        &HB77F19B6, &HE0A9DC09, &H662D09A1, &HC4324633, _
        &HE85A1F02, &H9F0BE8C, &H4A99A025, &H1D6EFE10, _
        &H1AB93D1D, &HBA5A4DF, &HA186F20F, &H2868F169, _
        &HDCB7DA83, &H573906FE, &HA1E2CE9B, &H4FCD7F52, _
        &H50115E01, &HA70683FA, &HA002B5C4, &HDE6D027, _
        &H9AF88C27, &H773F8641, &HC3604C06, &H61A806B5, _
        &HF0177A28, &HC0F586E0, &H6058AA, &H30DC7D62, _
        &H11E69ED7, &H2338EA63, &H53C2DD94, &HC2C21634, _
        &HBBCBEE56, &H90BCB6DE, &HEBFC7DA1, &HCE591D76, _
        &H6F05E409, &H4B7C0188, &H39720A3D, &H7C927C24, _
        &H86E3725F, &H724D9DB9, &H1AC15BB4, &HD39EB8FC, _
        &HED545578, &H8FCA5B5, &HD83D7CD3, &H4DAD0FC4, _
        &H1E50EF5E, &HB161E6F8, &HA28514D9, &H6C51133C, _
        &H6FD5C7E7, &H56E14EC4, &H362ABFCE, &HDDC6C837, _
        &HD79A3234, &H92638212, &H670EFA8E, &H406000E0)
        
    For i = 0 To 63     ' 192 To 255
        blf_S(2, i + 192) = vntA(i)
    Next
    
    ' S-box[3]
    vntA = Array( _
        &H3A39CE37, &HD3FAF5CF, &HABC27737, &H5AC52D1B, _
        &H5CB0679E, &H4FA33742, &HD3822740, &H99BC9BBE, _
        &HD5118E9D, &HBF0F7315, &HD62D1C7E, &HC700C47B, _
        &HB78C1B6B, &H21A19045, &HB26EB1BE, &H6A366EB4, _
        &H5748AB2F, &HBC946E79, &HC6A376D2, &H6549C2C8, _
        &H530FF8EE, &H468DDE7D, &HD5730A1D, &H4CD04DC6, _
        &H2939BBDB, &HA9BA4650, &HAC9526E8, &HBE5EE304, _
        &HA1FAD5F0, &H6A2D519A, &H63EF8CE2, &H9A86EE22, _
        &HC089C2B8, &H43242EF6, &HA51E03AA, &H9CF2D0A4, _
        &H83C061BA, &H9BE96A4D, &H8FE51550, &HBA645BD6, _
        &H2826A2F9, &HA73A3AE1, &H4BA99586, &HEF5562E9, _
        &HC72FEFD3, &HF752F7DA, &H3F046F69, &H77FA0A59, _
        &H80E4A915, &H87B08601, &H9B09E6AD, &H3B3EE593, _
        &HE990FD5A, &H9E34D797, &H2CF0B7D9, &H22B8B51, _
        &H96D5AC3A, &H17DA67D, &HD1CF3ED6, &H7C7D2D28, _
        &H1F9F25CF, &HADF2B89B, &H5AD6B472, &H5A88F54C)
        
    For i = 0 To 63
        blf_S(3, i) = vntA(i)
    Next
        
    vntA = Array( _
        &HE029AC71, &HE019A5E6, &H47B0ACFD, &HED93FA9B, _
        &HE8D3C48D, &H283B57CC, &HF8D56629, &H79132E28, _
        &H785F0191, &HED756055, &HF7960E44, &HE3D35E8C, _
        &H15056DD4, &H88F46DBA, &H3A16125, &H564F0BD, _
        &HC3EB9E15, &H3C9057A2, &H97271AEC, &HA93A072A, _
        &H1B3F6D9B, &H1E6321F5, &HF59C66FB, &H26DCF319, _
        &H7533D928, &HB155FDF5, &H3563482, &H8ABA3CBB, _
        &H28517711, &HC20AD9F8, &HABCC5167, &HCCAD925F, _
        &H4DE81751, &H3830DC8E, &H379D5862, &H9320F991, _
        &HEA7A90C2, &HFB3E7BCE, &H5121CE64, &H774FBE32, _
        &HA8B6E37E, &HC3293D46, &H48DE5369, &H6413E680, _
        &HA2AE0810, &HDD6DB224, &H69852DFD, &H9072166, _
        &HB39A460A, &H6445C0DD, &H586CDECF, &H1C20C8AE, _
        &H5BBEF7DD, &H1B588D40, &HCCD2017F, &H6BB4E3BB, _
        &HDDA26A7E, &H3A59FF45, &H3E350A44, &HBCB4CDD5, _
        &H72EACEA8, &HFA6484BB, &H8D6612AE, &HBF3C6F47)
        
    For i = 0 To 63     '64 To 127
        blf_S(3, i + 64) = vntA(i)
    Next
        
    vntA = Array( _
        &HD29BE463, &H542F5D9E, &HAEC2771B, &HF64E6370, _
        &H740E0D8D, &HE75B1357, &HF8721671, &HAF537D5D, _
        &H4040CB08, &H4EB4E2CC, &H34D2466A, &H115AF84, _
        &HE1B00428, &H95983A1D, &H6B89FB4, &HCE6EA048, _
        &H6F3F3B82, &H3520AB82, &H11A1D4B, &H277227F8, _
        &H611560B1, &HE7933FDC, &HBB3A792B, &H344525BD, _
        &HA08839E1, &H51CE794B, &H2F32C9B7, &HA01FBAC9, _
        &HE01CC87E, &HBCC7D1F6, &HCF0111C3, &HA1E8AAC7, _
        &H1A908749, &HD44FBD9A, &HD0DADECB, &HD50ADA38, _
        &H339C32A, &HC6913667, &H8DF9317C, &HE0B12B4F, _
        &HF79E59B7, &H43F5BB3A, &HF2D519FF, &H27D9459C, _
        &HBF97222C, &H15E6FC2A, &HF91FC71, &H9B941525, _
        &HFAE59361, &HCEB69CEB, &HC2A86459, &H12BAA8D1, _
        &HB6C1075E, &HE3056A0C, &H10D25065, &HCB03A442, _
        &HE0EC6E0E, &H1698DB3B, &H4C98A0BE, &H3278E964, _
        &H9F1F9532, &HE0D392DF, &HD3A0342B, &H8971F21E)
        
    For i = 0 To 63     ' 128 To 191
        blf_S(3, i + 128) = vntA(i)
    Next
        
    vntA = Array( _
        &H1B0A7441, &H4BA3348C, &HC5BE7120, &HC37632D8, _
        &HDF359F8D, &H9B992F2E, &HE60B6F47, &HFE3F11D, _
        &HE54CDA54, &H1EDAD891, &HCE6279CF, &HCD3E7E6F, _
        &H1618B166, &HFD2C1D05, &H848FD2C5, &HF6FB2299, _
        &HF523F357, &HA6327623, &H93A83531, &H56CCCD02, _
        &HACF08162, &H5A75EBB5, &H6E163697, &H88D273CC, _
        &HDE966292, &H81B949D0, &H4C50901B, &H71C65614, _
        &HE6C6C7BD, &H327A140A, &H45E1D006, &HC3F27B9A, _
        &HC9AA53FD, &H62A80F00, &HBB25BFE2, &H35BDD2F6, _
        &H71126905, &HB2040222, &HB6CBCF7C, &HCD769C2B, _
        &H53113EC0, &H1640E3D3, &H38ABBD60, &H2547ADF0, _
        &HBA38209C, &HF746CE76, &H77AFA1C5, &H20756060, _
        &H85CBFE4E, &H8AE88DD8, &H7AAAF9B0, &H4CF9AA7E, _
        &H1948C25C, &H2FB8A8C, &H1C36AE4, &HD6EBE1F9, _
        &H90D4F869, &HA65CDEA0, &H3F09252D, &HC208E69F, _
        &HB74E6132, &HCE77E25B, &H578FDFE3, &H3AC372E6)

    For i = 0 To 63     ' 192 To 255
        blf_S(3, i + 192) = vntA(i)
    Next
    
    ' DEBUG: Check for zeroes
    Dim j As Integer
    For i = 0 To 3
        For j = 0 To 255
            If blf_S(i, j) = 0 Then
                MsgBox "Zero value in S" & i & "," & j & ")"
            End If
        Next
    Next
    
End Function


Private Function Special_Table()

'01452FF8  F4 B7 F1 16  1D 3A 0B 39  86 36 65 CE  38 AE BE 31  ô·ñ:9†6eÎ8®¾1
'01453008  EC 0A A1 18  78 8D E3 F4  E4 27 E0 3A  47 5E E6 50  ì.¡xãôä'à:G^æP
'01453018  4E 9D 54 98  0B CE 1E 0A  01 54 FC 02  C4 B0 95 E9  NT˜Î.TüÄ°•é
'01453028  CB F4 62 F2  13 62 D4 75  1D 69 F8 E2  6B D4 89 87  ËôbòbÔuiøâkÔ‰‡
'01453038  17 E7 BE 2E  B3 47 05 54                          ç¾.³GT

'16f1b7f4 390b3a1d ce653686 31beae38
'18a10aec f4e38d78 3ae027e4 50e65e47
'98549d4e 0a1ece0b 02fc5401 e995b0c4
'f262f4cb 75d46213 e2f8691d 8789d46b
'2ebee717 540547b3


    Dim vntA As Variant
    Dim i As Integer

    ' P-array
    vntA = Array( _
        &H16F1B7F4, &H390B3A1D, &HCE653686, &H31BEAE38, _
        &H18A10AEC, &HF4E38D78, &H3AE027E4, &H50E65E47, _
        &H98549D4E, &HA1ECE0B, &H2FC5401, &HE995B0C4, _
        &HF262F4CB, &H75D46213, &HE2F8691D, &H8789D46B, _
        &H2EBEE717, &H540547B3)
    For i = 0 To 17
        blf_P(i) = vntA(i)
    Next

End Function


Private Sub Class_Initialize()
'Made by Tolatero & Clearscreen
'Adapted by NyMbLe
    eKey = "313634383931"
End Sub

bootdisk · 05/05/2011, 02:30

yes, it might be for the blowfish class but what about Func_X_4, Func_X_2?
also the GenerateValue/GenerateCheckByte function might be confusing for you to port it to VB6.
It would be for me and I ain't good at all.

Consider moving to VB.Net as pushedx said, at least you can ask the C# devs and they might help better.

vitalka · 05/07/2011, 22:18

This is my part for Func_2_x :

Code:

Public Function LoByte(ByVal intInput As Integer) As Byte
  LoByte = intInput And &HFF
End Function

Public Function HiByte(ByVal intInput As Integer) As Byte
  HiByte = (intInput And &HFF00&) \ 256
End Function
Public Function LoWord(ByVal lngInput As Long) As Integer
  If (lngInput And &H8000&) <> 0 Then
    LoWord = lngInput Or &HFFFF0000
  Else
    LoWord = lngInput And &HFFFF&
  End If
End Function

Public Function HiWord(ByVal lngInput As Long) As Integer
  HiWord = (lngInput And &HFFFF0000) \ &H10000
End Function
Public Sub Func_X_2(ByRef stream() As Byte, ByVal key As Integer, ByVal keybyte As Byte)
        stream(0) = LoByte(stream(0) Xor (stream(0) + LoByte(LoWord(key)) + keybyte))
        stream(1) = LoByte(stream(1) Xor (stream(1) + HiByte(LoWord(key)) + keybyte))
        stream(2) = LoByte(stream(2) Xor (stream(2) + LoByte(HiWord(key)) + keybyte))
        stream(3) = LoByte(stream(3) Xor (stream(3) + HiByte(HiWord(key)) + keybyte))
        stream(4) = LoByte(stream(4) Xor (stream(4) + LoByte(LoWord(key)) + keybyte))
        stream(5) = LoByte(stream(5) Xor (stream(5) + HiByte(LoWord(key)) + keybyte))
        stream(6) = LoByte(stream(6) Xor (stream(6) + LoByte(HiWord(key)) + keybyte))
        stream(7) = LoByte(stream(7) Xor (stream(7) + HiByte(HiWord(key)) + keybyte))
End Sub

im unsure for this part:

Code:

Public Function Func_X_4(ByVal arg1 As Integer, ByVal arg2 As Integer, ByVal arg3 As Integer)
Dim result As Long
result = 1
Dim mult As Long
mult = arg3

If arg2 = 0 Then

While arg2
If (arg2 And 1) Then result = (mult * result) Mod arg1
RShift x, x, 1
mult = (mult * mult) Mod P
Wend
result = 1
End Function
Function RShift(Wert, Stellen, BitAnzahl)
Temp = Wert
For i = 1 To Stellen
    Temp = Int(Temp / 2) + 2 ^ (BitAnzahl - 1) * (Temp Mod 2)
Next
RShift = Temp
End Function

Function LShift(Wert, Stellen, BitAnzahl)
Temp = Wert
For i = 1 To Stellen
    Temp = Temp * 2 + Int(Temp / 2 ^ (BitAnzahl - 1))
    If Temp >= 2 ^ BitAnzahl Then Temp = Temp - 2 ^ BitAnzahl
Next
LShift = Temp
End Function

vitalka · 05/10/2011, 23:14

Can someone help me with the GetValue Code:

Code:

        Private Function GenerateValue(ByRef val As Integer) As Integer
        Dim i As Integer
            For i = 0 To 31
                val = (((((((((((val >> 2) Xor val) >> 2) Xor val) >> 1) Xor val) >> 1) Xor val) >> 1) Xor val) And 1) Or ((((val And 1) << 31) Or (val >> 1)) And &HFFFFFFFE)
            Next
            Return val
        End Function


Function RShift(Wert, Stellen, BitAnzahl)
Temp = Wert
For i = 1 To Stellen
    Temp = Int(Temp / 2) + 2 ^ (BitAnzahl - 1) * (Temp Mod 2)
Next
RShift = Temp
End Function

Function LShift(Wert, Stellen, BitAnzahl)
Temp = Wert
For i = 1 To Stellen
    Temp = Temp * 2 + Int(Temp / 2 ^ (BitAnzahl - 1))
    If Temp >= 2 ^ BitAnzahl Then Temp = Temp - 2 ^ BitAnzahl
Next
LShift = Temp
End Function

bootdisk · 05/11/2011, 00:48

you didn't tell me if it was vb6 or .net... so I assume it's vb6.
Do you know what "<<" and ">>" means?
Those symbols are part of the bitwise operations, they are *used* to do bit shifting (Wikipedia link).

I don't get why you have LShift and RShift and you don't use them at the GenerateValue function.

... seriously, don't continue it, it will drive you crazy.

Edit: btw, when you're porting something you should respect data types (LShift and RShift are not).