The Windows Internet (WinINet) application programming interface (API) enables applications to interact with FTP, and HTTP protocols to access Internet resources. As standards evolve, these functions handle the changes in underlying protocols, enabling them to maintain consistent behavior.

Sample code of PostMethod.cls class  in VB6

Option Explicit
 
'*** DECLARATIONS FOUND IN WININET.H ***
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" (ByVal hInternetSession As Long, ByVal sServerName As String, ByVal nServerPort As Integer, ByVal sUserName As String, ByVal sPassword As String, ByVal lService As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Private Declare Function InternetQueryDataAvailable Lib "wininet.dll" (ByVal hHttpRequest As Long, ByRef lpdwNumberOfBytesAvailable As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Private Declare Function InternetReadFile Lib "wininet" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Private Declare Function InternetQueryOption Lib "wininet.dll" Alias "InternetQueryOptionA" (ByVal hHttpRequest As Long, ByVal dwOption As Long, lpBuffer As Any, ByRef dwBufferLength As Long) As Long
Private Declare Function InternetSetOption Lib "wininet.dll" Alias "InternetSetOptionA" (ByVal hHttpRequest As Long, ByVal dwOption As Long, lpBuffer As Any, ByVal dwBufferLength As Long) As Long
Private Declare Function HttpAddRequestHeaders Lib "wininet.dll" Alias "HttpAddRequestHeadersA" (ByVal hInternetSession As Long, ByVal lpHeaders As String, ByVal lHeadersLength As Long, ByVal lModifiers As Long) As Long
Private Declare Function HttpOpenRequest Lib "wininet.dll" Alias "HttpOpenRequestA" (ByVal hHttpSession As Long, ByVal sVerb As String, ByVal sObjectName As String, ByVal sVersion As String, ByVal sReferer As String, ByVal sAcceptTypes As String, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function HttpQueryInfo Lib "wininet.dll" Alias "HttpQueryInfoA" (ByVal hHttpRequest As Long, ByVal lInfoLevel As Long, ByRef sBuffer As Any, ByRef lBufferLength As Long, ByRef lIndex As Long) As Long
Private Declare Function HttpSendRequest Lib "wininet.dll" Alias "HttpSendRequestA" (ByVal hHttpRequest As Long, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal sOptional As String, ByVal lOptionalLength As Long) As Long
'**********************************************
' Constants for InternetOpen()
'**********************************************
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
'**********************************************
' Constants for InternetConnect()
'**********************************************
Private Const INTERNET_DEFAULT_HTTP_PORT = 80
Private Const INTERNET_DEFAULT_HTTPS_PORT = 443
Private Const INTERNET_SERVICE_HTTP = 3
'**********************************************
' Constants for HttpOpenRequest()
'**********************************************
Private Const INTERNET_FLAG_RELOAD = &H80000000
Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000
Private Const INTERNET_FLAG_PRAGMA_NOCACHE = &H100
Private Const INTERNET_FLAG_NO_COOKIES = &H80000
Private Const INTERNET_FLAG_SECURE = &H800000
'**********************************************
' Constants for InternetQueryOption() or InternetSetOption()
'**********************************************
Private Const INTERNET_OPTION_CONNECT_TIMEOUT = 2
Private Const INTERNET_OPTION_SEND_TIMEOUT = 5
Private Const INTERNET_OPTION_RECEIVE_TIMEOUT = 6
Private Const INTERNET_OPTION_SECURITY_FLAGS = 31
Private Const SECURITY_FLAG_IGNORE_UNKNOWN_CA = &H100
'**********************************************
' Constants for HttpAddRequestHeaders()
'**********************************************
Private Const HTTP_ADDREQ_FLAG_ADD_IF_NEW = &H10000000
Private Const HTTP_ADDREQ_FLAG_ADD = &H20000000
Private Const HTTP_ADDREQ_FLAG_COALESCE_WITH_COMMA = &H40000000
Private Const HTTP_ADDREQ_FLAG_COALESCE_WITH_SEMICOLON = &H1000000
Private Const HTTP_ADDREQ_FLAG_REPLACE = &H80000000
Private Const ERROR_INSUFFICIENT_BUFFER = 122
 
Public Enum enumPostHeader
    HTTP_QUERY_ACCEPT = 24
    HTTP_QUERY_ACCEPT_CHARSET = 25
    HTTP_QUERY_ACCEPT_ENCODING = 26
    HTTP_QUERY_ACCEPT_LANGUAGE = 27
    HTTP_QUERY_ACCEPT_RANGES = 42
    HTTP_QUERY_AGE = 48
    HTTP_QUERY_ALLOW = 7
    HTTP_QUERY_AUTHORIZATION = 28
    HTTP_QUERY_CACHE_CONTROL = 49
    HTTP_QUERY_CONNECTION = 23
    HTTP_QUERY_CONTENT_BASE = 50
    HTTP_QUERY_CONTENT_DESCRIPTION = 4
    HTTP_QUERY_CONTENT_DISPOSITION = 47
    HTTP_QUERY_CONTENT_ENCODING = 29
    HTTP_QUERY_CONTENT_ID = 3
    HTTP_QUERY_CONTENT_LANGUAGE = 6
    HTTP_QUERY_CONTENT_LENGTH = 5
    HTTP_QUERY_CONTENT_LOCATION = 51
    HTTP_QUERY_CONTENT_MD5 = 52
    HTTP_QUERY_CONTENT_RANGE = 53
    HTTP_QUERY_CONTENT_TRANSFER_ENCODING = 2
    HTTP_QUERY_CONTENT_TYPE = 1
    HTTP_QUERY_COOKIE = 44
    HTTP_QUERY_COST = 15
    HTTP_QUERY_CUSTOM = 65535
    HTTP_QUERY_DATE = 9
    HTTP_QUERY_DERIVED_FROM = 14
    HTTP_QUERY_ECHO_HEADERS = 73
    HTTP_QUERY_ECHO_HEADERS_CRLF = 74
    HTTP_QUERY_ECHO_REPLY = 72
    HTTP_QUERY_ECHO_REQUEST = 71
    HTTP_QUERY_ETAG = 54
    HTTP_QUERY_EXPECT = 68
    HTTP_QUERY_EXPIRES = 10
    HTTP_QUERY_FORWARDED = 30
    HTTP_QUERY_FROM = 31
    HTTP_QUERY_HOST = 55
    HTTP_QUERY_IF_MATCH = 56
    HTTP_QUERY_IF_MODIFIED_SINCE = 32
    HTTP_QUERY_IF_NONE_MATCH = 57
    HTTP_QUERY_IF_RANGE = 58
    HTTP_QUERY_IF_UNMODIFIED_SINCE = 59
    HTTP_QUERY_LAST_MODIFIED = 11
    HTTP_QUERY_LINK = 16
    HTTP_QUERY_LOCATION = 33
    HTTP_QUERY_MAX = 78
    HTTP_QUERY_MAX_FORWARDS = 60
    HTTP_QUERY_MESSAGE_ID = 12
    HTTP_QUERY_MIME_VERSION = 0
    HTTP_QUERY_ORIG_URI = 34
    HTTP_QUERY_PRAGMA = 17
    HTTP_QUERY_PROXY_AUTHENTICATE = 41
    HTTP_QUERY_PROXY_AUTHORIZATION = 61
    HTTP_QUERY_PROXY_CONNECTION = 69
    HTTP_QUERY_PUBLIC = 8
    HTTP_QUERY_RANGE = 62
    HTTP_QUERY_RAW_HEADERS = 21
    HTTP_QUERY_RAW_HEADERS_CRLF = 22
    HTTP_QUERY_REFERER = 35
    HTTP_QUERY_REFRESH = 46
    HTTP_QUERY_REQUEST_METHOD = 45
    HTTP_QUERY_RETRY_AFTER = 36
    HTTP_QUERY_SERVER = 37
    HTTP_QUERY_SET_COOKIE = 43
    HTTP_QUERY_STATUS_CODE = 19
    HTTP_QUERY_STATUS_TEXT = 20
    HTTP_QUERY_TITLE = 38
    HTTP_QUERY_TRANSFER_ENCODING = 63
    HTTP_QUERY_UNLESS_MODIFIED_SINCE = 70
    HTTP_QUERY_UPGRADE = 64
    HTTP_QUERY_URI = 13
    HTTP_QUERY_USER_AGENT = 39
    HTTP_QUERY_VARY = 65
    HTTP_QUERY_VERSION = 18
    HTTP_QUERY_VIA = 66
    HTTP_QUERY_WARNING = 67
    HTTP_QUERY_WWW_AUTHENTICATE = 40
End Enum
 
Private Const CONNECTION_TIMEOUT_MILLIS As Long = 60000
 
Private m_sURLDomain As String
Private m_sURLPort As String
Private m_sURLPath As String
Private m_bURLSSL As Boolean
Private m_sPOSTData As String
Private m_hInetSession As Long
Private m_hInetConnect As Long
Private m_hInetRequest As Long
Private m_sHttpMethod As String
 
Public Property Let PostParameters(ByVal sData As String)
    m_sPOSTData = sData
End Property
 
Public Property Get PostParameters() As String
    PostParameters = m_sPOSTData
End Property
 
Public Function OpenRequest(ByVal sURL As String, _
                            Optional ByVal sHttpMethod As String = "POST", _
                            Optional ByVal sUserName As String = vbNullString, _
                            Optional ByVal sPassword As String = vbNullString, _
                            Optional ByRef sErrorMsg As Variant) As Boolean
 
    m_sPOSTData = ""
    m_sHttpMethod = sHttpMethod
    If Not CrackURL(sURL) Then Exit Function
 
    m_hInetSession = InternetOpen("Http Client", _
                                  INTERNET_OPEN_TYPE_PRECONFIG, _
                                  vbNullString, _
                                  vbNullString, _
                                  0)
    If m_hInetSession <= 0 Then
        sErrorMsg = "InternetOpen() failed (System Error " & Err.LastDllError & ")"
        GoTo EXIT_LABEL
    End If
 
    m_hInetConnect = InternetConnect(m_hInetSession, _
                                     m_sURLDomain, _
                                     m_sURLPort, _
                                     sUserName, _
                                     sPassword, _
                                     INTERNET_SERVICE_HTTP, _
                                     0, _
                                     0)
    If m_hInetSession <= 0 Then
        sErrorMsg = "InternetConnect() failed (System Error " & Err.LastDllError & ")"
        GoTo EXIT_LABEL
    End If
 
    Dim lFlags As Long
    lFlags = (INTERNET_FLAG_NO_COOKIES Or INTERNET_FLAG_RELOAD Or INTERNET_FLAG_NO_CACHE_WRITE)
    If m_bURLSSL Then lFlags = (lFlags Or INTERNET_FLAG_SECURE)
 
    m_hInetRequest = HttpOpenRequest(m_hInetConnect, _
                                     sHttpMethod, _
                                     m_sURLPath, _
                                     "HTTP/1.0", _
                                     vbNullString, _
                                     vbNullString, _
                                     lFlags, _
                                     0)
    If m_hInetRequest <= 0 Then         sErrorMsg = "HttpOpenRequest() failed (System Error " & Err.LastDllError & ")"         GoTo EXIT_LABEL     End If          If Not CBool(InternetSetOption(m_hInetRequest, INTERNET_OPTION_CONNECT_TIMEOUT, CONNECTION_TIMEOUT_MILLIS, 4)) Then         sErrorMsg = "InternetSetOption(INTERNET_OPTION_CONNECT_TIMEOUT) failed (System Error " & Err.LastDllError & ")"         GoTo EXIT_LABEL     End If          If Not CBool(InternetSetOption(m_hInetRequest, INTERNET_OPTION_SEND_TIMEOUT, CONNECTION_TIMEOUT_MILLIS, 4)) Then         sErrorMsg = "InternetSetOption(INTERNET_OPTION_SEND_TIMEOUT) failed (System Error " & Err.LastDllError & ")"         GoTo EXIT_LABEL     End If          If Not CBool(InternetSetOption(m_hInetRequest, INTERNET_OPTION_RECEIVE_TIMEOUT, CONNECTION_TIMEOUT_MILLIS, 4)) Then         sErrorMsg = "InternetSetOption(INTERNET_OPTION_RECEIVE_TIMEOUT) failed (System Error " & Err.LastDllError & ")"         GoTo EXIT_LABEL     End If     If sHttpMethod = "POST" Then         If Not AddHeader("Content-Type", "application/x-www-form-urlencoded") Then             sErrorMsg = "AddHeader('Content-Type') failed"             GoTo EXIT_LABEL         End If     End If     If m_bURLSSL Then         Dim lBuffer As Long         Call InternetQueryOption(m_hInetRequest, INTERNET_OPTION_SECURITY_FLAGS, lFlags, lBuffer)         lFlags = lFlags Or SECURITY_FLAG_IGNORE_UNKNOWN_CA         Call InternetSetOption(m_hInetRequest, INTERNET_OPTION_SECURITY_FLAGS, lFlags, lBuffer)     End If     OpenRequest = True EXIT_LABEL: End Function Public Function AddHeader(ByVal sName As String, _                           ByVal sValue As String) As Boolean     Dim sHeaderFmt As String     sHeaderFmt = Trim(sName) & ": " & Trim(sValue) & vbCrLf     AddHeader = CBool(HttpAddRequestHeaders(m_hInetRequest, _                                             sHeaderFmt, _                                             Len(sHeaderFmt), _                                             HTTP_ADDREQ_FLAG_ADD Or HTTP_ADDREQ_FLAG_REPLACE)) End Function Public Function AddPOSTParameter(ByVal Name As String, ByVal Value As String) As Boolean     Dim sParam As String     Name = Trim(Name)     Value = Trim(Value)     If m_sHttpMethod = "POST" Then Value = UrlEncode(Value)     If Len(Name) > 0 Then
        sParam = Name & "=" & Value
    Else
        sParam = Value
    End If
 
    If Len(m_sPOSTData) = 0 Then
        m_sPOSTData = sParam
    Else
        m_sPOSTData = m_sPOSTData & "&" & sParam
    End If
    AddPOSTParameter = True
End Function
 
Public Function Execute() As Boolean
    If Len(m_sPOSTData) > 0 Then
        Call AddHeader("Content-Length", Len(m_sPOSTData))
        Execute = CBool(HttpSendRequest(m_hInetRequest, vbNullString, 0, m_sPOSTData, Len(m_sPOSTData)))
    Else
        Execute = CBool(HttpSendRequest(m_hInetRequest, vbNullString, 0, vbNullString, 0))
    End If
End Function
 
Public Function GetResponseAsString() As String
On Error GoTo ErrHandler
    Dim sBody As String
    Dim sBuffer As String
    Dim lBytesRead As Long
    Do
        sBuffer = Space$(4048)
        InternetReadFile m_hInetRequest, sBuffer, Len(sBuffer), lBytesRead
        If lBytesRead <= 0 Then Exit Do         sBody = sBody & Left$(sBuffer, lBytesRead)     Loop     GetResponseAsString = sBody     Exit Function ErrHandler:     GetResponseAsString = "" End Function Public Function GetResponseHeader(ByVal lHeaderType As enumPostHeader) As String On Error GoTo ErrHandler     Dim sValue As String     Dim lBytesRead As Long     Dim lHeaderIndex As Long     Dim bSuccess As Boolean     sValue = String(2000, Chr$(0))     lBytesRead = Len(sValue)     bSuccess = CBool(HttpQueryInfo(m_hInetRequest, lHeaderType, ByVal sValue, lBytesRead, lHeaderIndex))     If bSuccess And lBytesRead > 0 Then
        GetResponseHeader = Left$(sValue, InStr(1, sValue, Chr$(0)) - 1)
    End If
    Exit Function
 
ErrHandler:
End Function
 
Private Function CrackURL(ByVal strURL As String) As Boolean
    Dim intPos As Integer
    Dim strProtocol As String
 
    m_sURLDomain = ""
    m_sURLPort = ""
    m_sURLPath = ""
    m_bURLSSL = False
 
    ' search for double forward slash and remove protocol prefix
    intPos = InStr(1, strURL, "//")
    If intPos > 0 Then
        strProtocol = Left$(strURL, intPos - 1)
        strURL = Mid$(strURL, intPos + 2)
    End If
 
    m_bURLSSL = (InStr(LCase(strProtocol), "https") > 0)
 
    ' split the URL into domain and path using the first forward slash found
    ' If no slash is found, then the url is the domain only
    intPos = InStr(1, strURL, "/")
    If intPos > 0 Then
        m_sURLDomain = Left$(strURL, intPos - 1)
        m_sURLPath = Mid$(strURL, intPos + 1)
    Else
        m_sURLDomain = strURL
    End If
 
    ' Now see if a port is attached to the domain; split if found
    intPos = InStr(1, m_sURLDomain, ":")
    If intPos > 0 Then
        m_sURLPort = Mid$(m_sURLDomain, intPos + 1)
        m_sURLDomain = Left$(m_sURLDomain, intPos - 1)
    Else
        m_sURLPort = IIf(m_bURLSSL, INTERNET_DEFAULT_HTTPS_PORT, INTERNET_DEFAULT_HTTP_PORT)
    End If
    CrackURL = True
End Function
 
Private Function TrimString(ByVal s As String) As String
    TrimString = Left$(s, InStr(1, s, Chr$(0)) - 1)
End Function
 
Private Function UrlEncode(sText As String) As String
    Dim sResult As String
    Dim sFinal As String
    Dim sChar As String
    Dim i As Long
 
    sResult = ""
    sFinal = ""
    For i = 1 To Len(sText)
        sChar = Mid$(sText, i, 1)
        If InStr(1, "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789", sChar) <> 0 Then
            sResult = sResult & sChar
        ElseIf sChar = " " Then
            sResult = sResult & "+"
        ElseIf sChar = vbCr Or sChar = vbLf Or sChar = vbCrLf Then
        Else
            sResult = sResult & "%" & Hex(Asc(sChar))
        End If
        If Len(sResult) >= 1000 Then
            sFinal = sFinal & sResult
            sResult = ""
        End If
    Next
    UrlEncode = sFinal & sResult
End Function
 
Public Sub CloseConnection()
On Error GoTo ERROR_HANDLER
    If m_hInetRequest > 0 Then Call InternetCloseHandle(m_hInetRequest)
    If m_hInetConnect > 0 Then Call InternetCloseHandle(m_hInetConnect)
    If m_hInetSession > 0 Then Call InternetCloseHandle(m_hInetSession)
    m_hInetRequest = 0
    m_hInetConnect = 0
    m_hInetSession = 0
    m_sPOSTData = ""
    m_sURLDomain = ""
    m_sURLPort = ""
    m_sURLPath = ""
    m_bURLSSL = False
ERROR_HANDLER:
End Sub
 
Private Sub Class_Terminate()
    Call CloseConnection
End Sub

via: http://msdn.microsoft.com/en-us/library/windows/desktop/aa385483%28v=vs.85%29.aspx

http://www.holmessoft.co.uk/homepage/WininetVB.htm

 

To install this COM component on your Visual Studio .NET computer:

  1. Create a new folder named Legacy on your hard drive.
  2. Copy PhysServer.dll to the Legacy folder.
  3. Open a command prompt window and type:
regsvr32 c:\Legacy\PhysServer.dll

Use TLBIMP to Create an Assembly

 

  • To open a Visual Studio .NET command prompt window, click Start, click Programs, click Microsoft Visual Studio .NET 7.0, click Visual Studio .NET Tools, and then click Visual Studio .NET Command Prompt.
  • Change to the \Legacy directory.
  • At the command prompt, type:
tlbimp PhysServer.dll /out:NETPhysServer.dll

OR Using the COM Component Directly
http://msdn.microsoft.com/en-us/library/ms973800.aspx

2014-10-03_12-27-40What is TwoFish?

In cryptography, Twofish is a symmetric key block cipher with a block size of 128 bits and key sizes up to 256 bits. It was one of the five finalists of the Advanced Encryption Standard contest, but it was not selected for standardization. Twofish is related to the earlier block cipher Blowfish.

Twofish’s distinctive features are the use of pre-computed key-dependent S-boxes, and a relatively complex key schedule. One half of an n-bit key is used as the actual encryption key and the other half of the n-bit key is used to modify the encryption algorithm (key-dependent S-boxes). Twofish borrows some elements from other designs; for example, the pseudo-Hadamard transform (PHT) from the SAFER family of ciphers. Twofish has a Feistel structure like DES. Read more…

My “Twofish File Encryption” Demo Application written C # (sharp)

using System;
using System.Collections.Generic;
using System.ComponentModel;
using System.Data;
using System.Drawing;
using System.Linq;
using System.Text;
using System.Threading.Tasks;
using System.Windows.Forms;
using System.IO;
using TwofishVB6_Encryption;
 
namespace TwofishFileEncryption
{
    public partial class Form1 : Form
    {
        public Form1()
        {
            InitializeComponent();
        }
 
 
 
        private void Form1_DragDrop(object sender, DragEventArgs e)
        {
            string default_key = "YOUR DEFAULT KEY";    
            string key = "";
            bool result = false;
 
            if (textBoxKey.Text.ToString().Equals("(use default)"))
                key = default_key;
            else
                key = textBoxKey.Text;
 
 
            Twofish tf = new Twofish();
            if (e.Data.GetDataPresent(DataFormats.FileDrop))
            {
                string[] filePaths = (string[])(e.Data.GetData(DataFormats.FileDrop));
                foreach (string fileLoc in filePaths)
                {
                    // Code to read the contents of the text file
                    if (File.Exists(fileLoc))
                    {
                        if(checkBoxDecrypt.Checked)
                            result = tf.DecryptFile(fileLoc.ToString(), fileLoc.ToString() + ".de.txt", key);
                        else if (checkBoxEncrypt.Checked)
                            result = tf.EncryptFile(fileLoc.ToString(), fileLoc.ToString() + ".en.txt", key);                        
 
 
                        if (result)
                            pictureBoxDD.Image = Properties.Resources.index;
                        else
                            pictureBoxDD.Image = Properties.Resources.failed;
                    }
                }
            }
            tf = null;
        }
 
        private void Form1_DragEnter(object sender, DragEventArgs e)
        {
            if (e.Data.GetDataPresent(DataFormats.FileDrop))
            {
                e.Effect = DragDropEffects.Copy;
                pictureBoxDD.Image = Properties.Resources.GongSolutions_Wpf_DragDrop;
            }
            else
            {
                e.Effect = DragDropEffects.None;
            }
        }
 
        private void checkBoxDecrypt_CheckedChanged(object sender, EventArgs e)
        {
            if (checkBoxDecrypt.Checked)
                checkBoxEncrypt.Checked = false;
        }
 
        private void checkBoxEncrypt_CheckedChanged(object sender, EventArgs e)
        {
            if (checkBoxEncrypt.Checked)
                checkBoxDecrypt.Checked = false;
        }
    }
}

Twofish Encryption  in VB6

Option Explicit
 
Public LastError As Long
Public LastErrorDesc As String
 
Public Enum TWOFISHKEYLENGTH
    TWOFISH_256 = 256
    TWOFISH_196 = 196
    TWOFISH_128 = 128
    TWOFISH_64 = 64
End Enum
 
Private Type ENCRYPTCLASS
    Name As String
    Object As Object
    Homepage As String
End Type
 
Private Const BENCHMARKSIZE = 1000000
Private Const ROUNDS = 16
Private Const BLOCK_SIZE = 16
Private Const MAX_ROUNDS = 16
Private Const INPUT_WHITEN = 0
Private Const OUTPUT_WHITEN = INPUT_WHITEN + BLOCK_SIZE / 4
Private Const ROUND_SUBKEYS = OUTPUT_WHITEN + BLOCK_SIZE / 4
Private Const GF256_FDBK_2 = &H169 / 2
Private Const GF256_FDBK_4 = &H169 / 4
 
Private MDS(0 To 3, 0 To 255) As Long
Private P(0 To 1, 0 To 255) As Byte
Private m_RunningCompiled As Boolean
'Key-dependant data
Private sBox(0 To 1023) As Long
Private sKey() As Long
Private m_InitHex As Boolean
Private m_ByteToHex(0 To 255, 0 To 1) As Byte
Private m_HexToByte(48 To 70, 48 To 70) As Byte
 
Private EncryptObjects() As ENCRYPTCLASS
Private EncryptObjectsCount As Long
 
Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Sub FillMemory Lib "kernel32.dll" Alias "RtlFillMemory" (Destination As Any, ByVal Length As Long, ByVal Fill As Byte)
Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long
 
Private Sub Class_Initialize()
    Call InitializeArrays
End Sub
 
'*****************************************************************************************************************
' Title        EncryptFile
'*****************************************************************************************************************
Public Function EncryptFile(SourceFile As String, DestFile As String, Key As String) As Boolean
On Error GoTo ERROR_HANDLER
    Dim fileId As Integer
    Dim fileOpen As Boolean
    Dim ByteArray() As Byte
    Dim oFS As New FileSystemObject
 
    '*** Make sure the source file exists
    If Not oFS.FileExists(SourceFile) Then
        Call Err.Raise(-110, , "Source file (" & SourceFile & ") does not exist.")
    End If
 
    '*** Open the source file and read the content into a bytearray to pass onto encryption
    fileId = FreeFile
    Open SourceFile For Binary As #fileId
    fileOpen = True
    ReDim ByteArray(0 To LOF(fileId) - 1)
    Get #fileId, , ByteArray()
    Close #fileId
    fileOpen = False
 
    '*** Encrypt the bytearray
    Call EncryptByte(ByteArray(), Key)
 
    '*** Delete the destination file; we will overwrite its contents
    If oFS.FileExists(DestFile) Then
        Call oFS.DeleteFile(DestFile, True)
    End If
 
    '*** Store the encrypted data in the destination file
    fileId = FreeFile
    Open DestFile For Binary As #fileId
    fileOpen = True
    Put #fileId, , ByteArray()
    Close #fileId
    fileOpen = False
 
    '*** Encryption was successful
    EncryptFile = True
 
ERROR_HANDLER:
    If Err.Number <> 0 Then Call HandleClassError(Err)
    Set oFS = Nothing
    If fileOpen Then Close #fileId
End Function
 
'*****************************************************************************************************************
' Title        DecryptFile
'*****************************************************************************************************************
Public Function DecryptFile(SourceFile As String, DestFile As String, Key As String) As Boolean
On Error GoTo ERROR_HANDLER
    Dim fileId As Integer
    Dim fileOpen As Boolean
    Dim ByteArray() As Byte
    Dim oFS As New FileSystemObject
 
    '*** Make sure the source file exists
    If Not oFS.FileExists(SourceFile) Then
        Call Err.Raise(-110, , "Source file (" & SourceFile & ") does not exist.")
    End If
 
    '*** Open the source file and read the content into a bytearray to pass onto encryption
    fileId = FreeFile
    Open SourceFile For Binary As #fileId
    fileOpen = True
    ReDim ByteArray(0 To LOF(fileId) - 1)
    Get #fileId, , ByteArray()
    Close #fileId
    fileOpen = False
 
    '*** Decrypt the bytearray
    Call DecryptByte(ByteArray(), Key)
 
    '*** Delete the destination file; we will overwrite its contents
    If oFS.FileExists(DestFile) Then
        Call oFS.DeleteFile(DestFile, True)
    End If
 
    '*** Store the encrypted data in the destination file
    fileId = FreeFile
    Open DestFile For Binary As #fileId
    fileOpen = True
    Put #fileId, , ByteArray()
    Close #fileId
    fileOpen = False
 
    '*** Decryption was successful
    DecryptFile = True
 
ERROR_HANDLER:
    If Err.Number <> 0 Then Call HandleClassError(Err)
    Set oFS = Nothing
    If fileOpen Then Close #fileId
End Function
 
 
'*****************************************************************************************************************
' Title        EncryptString
'*****************************************************************************************************************
Public Function EncryptString(Text As String, Key As String) As Boolean
On Error GoTo ERROR_HANDLER
    Dim ByteArray() As Byte
 
    '*** Convert the string to a bytearray
    ByteArray() = StrConv(Text, vbFromUnicode)
 
    '*** Encrypt the array
    Call EncryptByte(ByteArray(), Key)
 
    '*** Return the encrypted data as a string
    Text = StrConv(ByteArray(), vbUnicode)
    EncryptString = True
 
ERROR_HANDLER:
    If Err.Number <> 0 Then Call HandleClassError(Err)
End Function
 
 
'*****************************************************************************************************************
' Title        DecryptString
'*****************************************************************************************************************
Public Function DecryptString(Text As String, Key As String) As Boolean
On Error GoTo ERROR_HANDLER
    Dim ByteArray() As Byte
 
    '*** Convert the string to a bytearray
    ByteArray() = StrConv(Text, vbFromUnicode)
 
    '*** Decrypt the array
    Call DecryptByte(ByteArray(), Key)
 
    '*** Return the encrypted data as a string
    Text = StrConv(ByteArray(), vbUnicode)
    DecryptString = True
 
ERROR_HANDLER:
    If Err.Number <> 0 Then Call HandleClassError(Err)
End Function
 
Private Static Function LFSR1(ByRef x As Long) As Long
    LFSR1 = lBSR(x, 1) Xor ((x And 1) * GF256_FDBK_2)
End Function
 
Private Static Function LFSR2(ByRef x As Long) As Long
    LFSR2 = lBSR(x, 2) Xor ((x And &H2) / &H2 * GF256_FDBK_2) Xor ((x And &H1) * GF256_FDBK_4)
End Function
 
Private Static Function RS_Rem(x As Long) As Long
    Dim b As Long
    Dim g2 As Long
    Dim g3 As Long
 
    b = (lBSRU(x, 24) And &HFF)
    g2 = ((lBSL(b, 1) Xor (b And &H80) / &H80 * &H14D) And &HFF)
    g3 = (lBSRU(b, 1) Xor ((b And &H1) * lBSRU(&H14D, 1)) Xor g2)
    RS_Rem = lBSL(x, 8) Xor lBSL(g3, 24) Xor lBSL(g2, 16) Xor lBSL(g3, 8) Xor b
End Function
 
Private Static Function F32(k64Cnt As Long, x As Long, k32() As Long) As Long
    Dim xb(0 To 3) As Byte
    Dim Key(0 To 3, 0 To 3) As Byte
 
    Call CopyMem(xb(0), x, 4)
    Call CopyMem(Key(0, 0), k32(0), 16)
 
    If ((k64Cnt And 3) = 1) Then
        F32 = MDS(0, P(0, xb(0)) Xor Key(0, 0)) Xor _
        MDS(1, P(0, xb(1)) Xor Key(1, 0)) Xor _
        MDS(2, P(1, xb(2)) Xor Key(2, 0)) Xor _
        MDS(3, P(1, xb(3)) Xor Key(3, 0))
    Else
        If ((k64Cnt And 3) = 0) Then
            xb(0) = P(1, xb(0)) Xor Key(0, 3)
            xb(1) = P(0, xb(1)) Xor Key(1, 3)
            xb(2) = P(0, xb(2)) Xor Key(2, 3)
            xb(3) = P(1, xb(3)) Xor Key(3, 3)
        End If
        If ((k64Cnt And 3) = 3) Or ((k64Cnt And 3) = 0) Then
            xb(0) = P(1, xb(0)) Xor Key(0, 2)
            xb(1) = P(1, xb(1)) Xor Key(1, 2)
            xb(2) = P(0, xb(2)) Xor Key(2, 2)
            xb(3) = P(0, xb(3)) Xor Key(3, 2)
        End If
        F32 = MDS(0, P(0, P(0, xb(0)) Xor Key(0, 1)) Xor Key(0, 0)) Xor _
        MDS(1, P(0, P(1, xb(1)) Xor Key(1, 1)) Xor Key(1, 0)) Xor _
        MDS(2, P(1, P(0, xb(2)) Xor Key(2, 1)) Xor Key(2, 0)) Xor _
        MDS(3, P(1, P(1, xb(3)) Xor Key(3, 1)) Xor Key(3, 0))
    End If
End Function
 
Private Static Function Fe32(x As Long, R As Long) As Long
    Dim xb(0 To 3) As Byte
 
    '*** Extract the byte sequence
    Call CopyMem(xb(0), x, 4)
 
    '*** Calculate the FE32 function
    Fe32 = sBox(2 * xb(R Mod 4)) Xor _
    sBox(2 * xb((R + 1) Mod 4) + 1) Xor _
    sBox(&H200 + 2 * xb((R + 2) Mod 4)) Xor _
    sBox(&H200 + 2 * xb((R + 3) Mod 4) + 1)
End Function
 
Private Static Sub KeyCreate(K() As Byte, KeyLength As Long)
    Dim i As Long
    Dim lA As Long
    Dim lB As Long
    Dim b(3) As Byte
    Dim k64Cnt As Long
    Dim k32e(3) As Long
    Dim k32o(3) As Long
    Dim subkeyCnt As Long
    Dim sBoxKey(3) As Long
    Dim Key(0 To 3, 0 To 3) As Byte
 
    Const SK_STEP = &H2020202
    Const SK_BUMP = &H1010101
    Const SK_ROTL = 9
 
    k64Cnt = KeyLength \ 8
    subkeyCnt = ROUND_SUBKEYS + 2 * ROUNDS
 
    For i = 0 To IIf(KeyLength < 32, KeyLength \ 8 - 1, 3)
        Call CopyMem(k32e(i), K(i * 8), 4)
        Call CopyMem(k32o(i), K(i * 8 + 4), 4)
        sBoxKey(KeyLength \ 8 - 1 - i) = RS_Rem(RS_Rem(RS_Rem(RS_Rem(RS_Rem(RS_Rem(RS_Rem(RS_Rem(k32o(i))))) Xor k32e(i)))))
    Next
 
    ReDim sKey(subkeyCnt)
    For i = 0 To ((subkeyCnt / 2) - 1)
        lA = F32(k64Cnt, i * SK_STEP, k32e)
        lB = F32(k64Cnt, i * SK_STEP + SK_BUMP, k32o)
        lB = lBSL(lB, 8) Or lBSRU(lB, 24)
        If (m_RunningCompiled) Then
            lA = lA + lB
        Else
            lA = UnsignedAdd(lA, lB)
        End If
 
        sKey(2 * i) = lA
        If (m_RunningCompiled) Then
            lA = lA + lB
        Else
            lA = UnsignedAdd(lA, lB)
        End If
        sKey(2 * i + 1) = lBSL(lA, SK_ROTL) Or lBSRU(lA, 32 - SK_ROTL)
    Next
 
    Call CopyMem(Key(0, 0), sBoxKey(0), 16)
 
    For i = 0 To 255
        If ((k64Cnt And 3) = 1) Then
            sBox(2 * i) = MDS(0, P(0, i) Xor Key(0, 0))
            sBox(2 * i + 1) = MDS(1, P(0, i) Xor Key(1, 0))
            sBox(&H200 + 2 * i) = MDS(2, P(1, i) Xor Key(2, 0))
            sBox(&H200 + 2 * i + 1) = MDS(3, P(1, i) Xor Key(3, 0))
        Else
            b(0) = i
            b(1) = i
            b(2) = i
            b(3) = i
            If ((k64Cnt And 3) = 0) Then
                b(0) = P(1, b(0)) Xor Key(0, 3)
                b(1) = P(0, b(1)) Xor Key(1, 3)
                b(2) = P(0, b(2)) Xor Key(2, 3)
                b(3) = P(1, b(3)) Xor Key(3, 3)
            End If
            If ((k64Cnt And 3) = 3) Or ((k64Cnt And 3) = 0) Then '(exception = True) Then
                b(0) = P(1, b(0)) Xor Key(0, 2)
                b(1) = P(1, b(1)) Xor Key(1, 2)
                b(2) = P(0, b(2)) Xor Key(2, 2)
                b(3) = P(0, b(3)) Xor Key(3, 2)
            End If
            sBox(2 * i) = MDS(0, P(0, P(0, b(0)) Xor Key(0, 1)) Xor Key(0, 0))
            sBox(2 * i + 1) = MDS(1, P(0, P(1, b(1)) Xor Key(1, 1)) Xor Key(1, 0))
            sBox(&H200 + 2 * i) = MDS(2, P(1, P(0, b(2)) Xor Key(2, 1)) Xor Key(2, 0))
            sBox(&H200 + 2 * i + 1) = MDS(3, P(1, P(1, b(3)) Xor Key(3, 1)) Xor Key(3, 0))
        End If
    Next
End Sub
 
Private Function lBSL(ByRef lInput As Long, ByRef bShiftBits As Byte) As Long
    lBSL = (lInput And (2 ^ (31 - bShiftBits) - 1)) * 2 ^ bShiftBits
    If (lInput And 2 ^ (31 - bShiftBits)) = 2 ^ (31 - bShiftBits) Then lBSL = (lBSL Or &H80000000)
End Function
 
Private Function lBSR(ByRef lInput As Long, ByRef bShiftBits As Byte) As Long
    If (bShiftBits = 31) Then
        If (lInput < 0) Then lBSR = &HFFFFFFFF Else lBSR = 0
    Else
        lBSR = (lInput And Not (2 ^ bShiftBits - 1)) \ 2 ^ bShiftBits
    End If
End Function
 
Private Function lBSRU(lInput As Long, bShiftBits As Byte) As Long
    If (bShiftBits = 31) Then
        lBSRU = -(lInput < 0)
    Else
        lBSRU = (((lInput And Not (2 ^ bShiftBits - 1)) \ 2 ^ bShiftBits) And Not (&H80000000 + (2 ^ bShiftBits - 2) * 2 ^ (31 - bShiftBits)))
    End If
End Function
 
Private Static Sub EncryptBlock(DWord() As Long)
    Dim t0 As Long
    Dim t1 As Long
    Dim K As Long
    Dim R As Long
 
    DWord(0) = DWord(0) Xor sKey(INPUT_WHITEN)
    DWord(1) = DWord(1) Xor sKey(INPUT_WHITEN + 1)
    DWord(2) = DWord(2) Xor sKey(INPUT_WHITEN + 2)
    DWord(3) = DWord(3) Xor sKey(INPUT_WHITEN + 3)
 
    K = ROUND_SUBKEYS
    For R = 0 To (ROUNDS - 1) Step 2
        If (m_RunningCompiled) Then
            'This is the algorithm when run in compiled
            'mode, where VB won't raise overflow errors
            t0 = Fe32(DWord(0), 0)
            t1 = Fe32(DWord(1), 3)
            t0 = t0 + t1
            DWord(2) = Rot1(DWord(2) Xor (t0 + sKey(K)))
            K = K + 1
            DWord(3) = Rot31(DWord(3)) Xor (t0 + t1 + sKey(K))
            K = K + 1
            t0 = Fe32(DWord(2), 0)
            t1 = Fe32(DWord(3), 3)
            t0 = t0 + t1
            DWord(0) = Rot1(DWord(0) Xor (t0 + sKey(K)))
            K = K + 1
            DWord(1) = Rot31(DWord(1)) Xor (t0 + t1 + sKey(K))
            K = K + 1
        Else
            'This is the algorithm when running in the IDE,
            'although it's slower it makes the code able
            'to run in the IDE without overflow errors
            t0 = Fe32(DWord(0), 0)
            t1 = Fe32(DWord(1), 3)
            t0 = UnsignedAdd(t0, t1)
            DWord(2) = Rot1(DWord(2) Xor (UnsignedAdd(t0, sKey(K))))
            K = K + 1
            DWord(3) = Rot31(DWord(3)) Xor (UnsignedAdd(UnsignedAdd(t0, t1), sKey(K)))
            K = K + 1
            t0 = Fe32(DWord(2), 0)
            t1 = Fe32(DWord(3), 3)
            t0 = UnsignedAdd(t0, t1)
            DWord(0) = Rot1(DWord(0) Xor (UnsignedAdd(t0, sKey(K))))
            K = K + 1
            DWord(1) = Rot31(DWord(1)) Xor (UnsignedAdd(UnsignedAdd(t0, t1), sKey(K)))
            K = K + 1
        End If
    Next
 
    DWord(2) = DWord(2) Xor sKey(OUTPUT_WHITEN)
    DWord(3) = DWord(3) Xor sKey(OUTPUT_WHITEN + 1)
    DWord(4) = DWord(0) Xor sKey(OUTPUT_WHITEN + 2)
    DWord(5) = DWord(1) Xor sKey(OUTPUT_WHITEN + 3)
    Call CopyMem(DWord(0), DWord(2), 16)
End Sub
 
Private Sub DecryptBlock(DWord() As Long)
    Dim K As Long
    Dim R As Long
    Dim t0 As Long
    Dim t1 As Long
 
    DWord(2) = DWord(2) Xor sKey(OUTPUT_WHITEN)
    DWord(3) = DWord(3) Xor sKey(OUTPUT_WHITEN + 1)
    DWord(0) = DWord(4) Xor sKey(OUTPUT_WHITEN + 2)
    DWord(1) = DWord(5) Xor sKey(OUTPUT_WHITEN + 3)
 
    K = ROUND_SUBKEYS + 2 * ROUNDS - 1
    For R = 0 To ROUNDS - 1 Step 2
        If (m_RunningCompiled) Then
            t0 = Fe32(DWord(2), 0)
            t1 = Fe32(DWord(3), 3)
            t0 = t0 + t1
            DWord(1) = Rot1(DWord(1) Xor (t0 + t1 + sKey(K)))
            K = K - 1
            DWord(0) = Rot31(DWord(0)) Xor (t0 + sKey(K))
            K = K - 1
            t0 = Fe32(DWord(0), 0)
            t1 = Fe32(DWord(1), 3)
            t0 = t0 + t1
            DWord(3) = Rot1(DWord(3) Xor (t0 + t1 + sKey(K)))
            K = K - 1
            DWord(2) = Rot31(DWord(2)) Xor (t0 + sKey(K))
            K = K - 1
        Else
            t0 = Fe32(DWord(2), 0)
            t1 = Fe32(DWord(3), 3)
            t0 = UnsignedAdd(t0, t1)
            DWord(1) = Rot1(DWord(1) Xor (UnsignedAdd(UnsignedAdd(t0, t1), sKey(K))))
            K = K - 1
            DWord(0) = Rot31(DWord(0)) Xor (UnsignedAdd(t0, sKey(K)))
            K = K - 1
            t0 = Fe32(DWord(0), 0)
            t1 = Fe32(DWord(1), 3)
            t0 = UnsignedAdd(t0, t1)
            DWord(3) = Rot1(DWord(3) Xor (UnsignedAdd(UnsignedAdd(t0, t1), sKey(K))))
            K = K - 1
            DWord(2) = Rot31(DWord(2)) Xor (UnsignedAdd(t0, sKey(K)))
            K = K - 1
        End If
    Next
 
    DWord(0) = DWord(0) Xor sKey(INPUT_WHITEN)
    DWord(1) = DWord(1) Xor sKey(INPUT_WHITEN + 1)
    DWord(2) = DWord(2) Xor sKey(INPUT_WHITEN + 2)
    DWord(3) = DWord(3) Xor sKey(INPUT_WHITEN + 3)
End Sub
 
Private Static Function Rot1(Value As Long) As Long
    Dim Temp As Byte
    Dim x(0 To 3) As Byte
 
    Call CopyMem(x(0), Value, 4)
 
    Temp = x(0)
    x(0) = (x(0) \ 2) Or ((x(1) And 1) * 128)
    x(1) = (x(1) \ 2) Or ((x(2) And 1) * 128)
    x(2) = (x(2) \ 2) Or ((x(3) And 1) * 128)
    x(3) = (x(3) \ 2) Or ((Temp And 1) * 128)
 
    Call CopyMem(Rot1, x(0), 4)
End Function
 
Private Static Function Rot31(Value As Long) As Long
    Dim Temp As Byte
    Dim x(0 To 3) As Byte
 
    Call CopyMem(x(0), Value, 4)
 
    Temp = x(3)
    x(3) = ((x(3) And 127) * 2) Or -CBool(x(2) And 128)
    x(2) = ((x(2) And 127) * 2) Or -CBool(x(1) And 128)
    x(1) = ((x(1) And 127) * 2) Or -CBool(x(0) And 128)
    x(0) = ((x(0) And 127) * 2) Or -CBool(Temp And 128)
 
    Call CopyMem(Rot31, x(0), 4)
End Function
 
Private Sub InitializeArrays()
    Dim i As Long
    Dim j As Long
    Dim m1(0 To 1) As Long
    Dim mX(0 To 1) As Long
    Dim mY(0 To 1) As Long
 
    'We need to check if we are running in compiled
    '(EXE) mode or in the IDE, this will allow us to
    'use optimized code with unsigned integers in
    'compiled mode without any overflow errors when
    'running the code in the IDE
    On Local Error Resume Next
    m_RunningCompiled = ((2147483647 + 1) < 0)
 
    'Initialize P(0,..) array
    P(0, 0) = &HA9
    P(0, 1) = &H67
    P(0, 2) = &HB3
    P(0, 3) = &HE8
    P(0, 4) = &H4
    P(0, 5) = &HFD
    P(0, 6) = &HA3
    P(0, 7) = &H76
    P(0, 8) = &H9A
    P(0, 9) = &H92
    P(0, 10) = &H80
    P(0, 11) = &H78
    P(0, 12) = &HE4
    P(0, 13) = &HDD
    P(0, 14) = &HD1
    P(0, 15) = &H38
    P(0, 16) = &HD
    P(0, 17) = &HC6
    P(0, 18) = &H35
    P(0, 19) = &H98
    P(0, 20) = &H18
    P(0, 21) = &HF7
    P(0, 22) = &HEC
    P(0, 23) = &H6C
    P(0, 24) = &H43
    P(0, 25) = &H75
    P(0, 26) = &H37
    P(0, 27) = &H26
    P(0, 28) = &HFA
    P(0, 29) = &H13
    P(0, 30) = &H94
    P(0, 31) = &H48
    P(0, 32) = &HF2
    P(0, 33) = &HD0
    P(0, 34) = &H8B
    P(0, 35) = &H30
    P(0, 36) = &H84
    P(0, 37) = &H54
    P(0, 38) = &HDF
    P(0, 39) = &H23
    P(0, 40) = &H19
    P(0, 41) = &H5B
    P(0, 42) = &H3D
    P(0, 43) = &H59
    P(0, 44) = &HF3
    P(0, 45) = &HAE
    P(0, 46) = &HA2
    P(0, 47) = &H82
    P(0, 48) = &H63
    P(0, 49) = &H1
    P(0, 50) = &H83
    P(0, 51) = &H2E
    P(0, 52) = &HD9
    P(0, 53) = &H51
    P(0, 54) = &H9B
    P(0, 55) = &H7C
    P(0, 56) = &HA6
    P(0, 57) = &HEB
    P(0, 58) = &HA5
    P(0, 59) = &HBE
    P(0, 60) = &H16
    P(0, 61) = &HC
    P(0, 62) = &HE3
    P(0, 63) = &H61
    P(0, 64) = &HC0
    P(0, 65) = &H8C
    P(0, 66) = &H3A
    P(0, 67) = &HF5
    P(0, 68) = &H73
    P(0, 69) = &H2C
    P(0, 70) = &H25
    P(0, 71) = &HB
    P(0, 72) = &HBB
    P(0, 73) = &H4E
    P(0, 74) = &H89
    P(0, 75) = &H6B
    P(0, 76) = &H53
    P(0, 77) = &H6A
    P(0, 78) = &HB4
    P(0, 79) = &HF1
    P(0, 80) = &HE1
    P(0, 81) = &HE6
    P(0, 82) = &HBD
    P(0, 83) = &H45
    P(0, 84) = &HE2
    P(0, 85) = &HF4
    P(0, 86) = &HB6
    P(0, 87) = &H66
    P(0, 88) = &HCC
    P(0, 89) = &H95
    P(0, 90) = &H3
    P(0, 91) = &H56
    P(0, 92) = &HD4
    P(0, 93) = &H1C
    P(0, 94) = &H1E
    P(0, 95) = &HD7
    P(0, 96) = &HFB
    P(0, 97) = &HC3
    P(0, 98) = &H8E
    P(0, 99) = &HB5
    P(0, 100) = &HE9
    P(0, 101) = &HCF
    P(0, 102) = &HBF
    P(0, 103) = &HBA
    P(0, 104) = &HEA
    P(0, 105) = &H77
    P(0, 106) = &H39
    P(0, 107) = &HAF
    P(0, 108) = &H33
    P(0, 109) = &HC9
    P(0, 110) = &H62
    P(0, 111) = &H71
    P(0, 112) = &H81
    P(0, 113) = &H79
    P(0, 114) = &H9
    P(0, 115) = &HAD
    P(0, 116) = &H24
    P(0, 117) = &HCD
    P(0, 118) = &HF9
    P(0, 119) = &HD8
    P(0, 120) = &HE5
    P(0, 121) = &HC5
    P(0, 122) = &HB9
    P(0, 123) = &H4D
    P(0, 124) = &H44
    P(0, 125) = &H8
    P(0, 126) = &H86
    P(0, 127) = &HE7
    P(0, 128) = &HA1
    P(0, 129) = &H1D
    P(0, 130) = &HAA
    P(0, 131) = &HED
    P(0, 132) = &H6
    P(0, 133) = &H70
    P(0, 134) = &HB2
    P(0, 135) = &HD2
    P(0, 136) = &H41
    P(0, 137) = &H7B
    P(0, 138) = &HA0
    P(0, 139) = &H11
    P(0, 140) = &H31
    P(0, 141) = &HC2
    P(0, 142) = &H27
    P(0, 143) = &H90
    P(0, 144) = &H20
    P(0, 145) = &HF6
    P(0, 146) = &H60
    P(0, 147) = &HFF
    P(0, 148) = &H96
    P(0, 149) = &H5C
    P(0, 150) = &HB1
    P(0, 151) = &HAB
    P(0, 152) = &H9E
    P(0, 153) = &H9C
    P(0, 154) = &H52
    P(0, 155) = &H1B
    P(0, 156) = &H5F
    P(0, 157) = &H93
    P(0, 158) = &HA
    P(0, 159) = &HEF
    P(0, 160) = &H91
    P(0, 161) = &H85
    P(0, 162) = &H49
    P(0, 163) = &HEE
    P(0, 164) = &H2D
    P(0, 165) = &H4F
    P(0, 166) = &H8F
    P(0, 167) = &H3B
    P(0, 168) = &H47
    P(0, 169) = &H87
    P(0, 170) = &H6D
    P(0, 171) = &H46
    P(0, 172) = &HD6
    P(0, 173) = &H3E
    P(0, 174) = &H69
    P(0, 175) = &H64
    P(0, 176) = &H2A
    P(0, 177) = &HCE
    P(0, 178) = &HCB
    P(0, 179) = &H2F
    P(0, 180) = &HFC
    P(0, 181) = &H97
    P(0, 182) = &H5
    P(0, 183) = &H7A
    P(0, 184) = &HAC
    P(0, 185) = &H7F
    P(0, 186) = &HD5
    P(0, 187) = &H1A
    P(0, 188) = &H4B
    P(0, 189) = &HE
    P(0, 190) = &HA7
    P(0, 191) = &H5A
    P(0, 192) = &H28
    P(0, 193) = &H14
    P(0, 194) = &H3F
    P(0, 195) = &H29
    P(0, 196) = &H88
    P(0, 197) = &H3C
    P(0, 198) = &H4C
    P(0, 199) = &H2
    P(0, 200) = &HB8
    P(0, 201) = &HDA
    P(0, 202) = &HB0
    P(0, 203) = &H17
    P(0, 204) = &H55
    P(0, 205) = &H1F
    P(0, 206) = &H8A
    P(0, 207) = &H7D
    P(0, 208) = &H57
    P(0, 209) = &HC7
    P(0, 210) = &H8D
    P(0, 211) = &H74
    P(0, 212) = &HB7
    P(0, 213) = &HC4
    P(0, 214) = &H9F
    P(0, 215) = &H72
    P(0, 216) = &H7E
    P(0, 217) = &H15
    P(0, 218) = &H22
    P(0, 219) = &H12
    P(0, 220) = &H58
    P(0, 221) = &H7
    P(0, 222) = &H99
    P(0, 223) = &H34
    P(0, 224) = &H6E
    P(0, 225) = &H50
    P(0, 226) = &HDE
    P(0, 227) = &H68
    P(0, 228) = &H65
    P(0, 229) = &HBC
    P(0, 230) = &HDB
    P(0, 231) = &HF8
    P(0, 232) = &HC8
    P(0, 233) = &HA8
    P(0, 234) = &H2B
    P(0, 235) = &H40
    P(0, 236) = &HDC
    P(0, 237) = &HFE
    P(0, 238) = &H32
    P(0, 239) = &HA4
    P(0, 240) = &HCA
    P(0, 241) = &H10
    P(0, 242) = &H21
    P(0, 243) = &HF0
    P(0, 244) = &HD3
    P(0, 245) = &H5D
    P(0, 246) = &HF
    P(0, 247) = &H0
    P(0, 248) = &H6F
    P(0, 249) = &H9D
    P(0, 250) = &H36
    P(0, 251) = &H42
    P(0, 252) = &H4A
    P(0, 253) = &H5E
    P(0, 254) = &HC1
    P(0, 255) = &HE0
 
    'Initialize P(1,..) array
    P(1, 0) = &H75
    P(1, 1) = &HF3
    P(1, 2) = &HC6
    P(1, 3) = &HF4
    P(1, 4) = &HDB
    P(1, 5) = &H7B
    P(1, 6) = &HFB
    P(1, 7) = &HC8
    P(1, 8) = &H4A
    P(1, 9) = &HD3
    P(1, 10) = &HE6
    P(1, 11) = &H6B
    P(1, 12) = &H45
    P(1, 13) = &H7D
    P(1, 14) = &HE8
    P(1, 15) = &H4B
    P(1, 16) = &HD6
    P(1, 17) = &H32
    P(1, 18) = &HD8
    P(1, 19) = &HFD
    P(1, 20) = &H37
    P(1, 21) = &H71
    P(1, 22) = &HF1
    P(1, 23) = &HE1
    P(1, 24) = &H30
    P(1, 25) = &HF
    P(1, 26) = &HF8
    P(1, 27) = &H1B
    P(1, 28) = &H87
    P(1, 29) = &HFA
    P(1, 30) = &H6
    P(1, 31) = &H3F
    P(1, 32) = &H5E
    P(1, 33) = &HBA
    P(1, 34) = &HAE
    P(1, 35) = &H5B
    P(1, 36) = &H8A
    P(1, 37) = &H0
    P(1, 38) = &HBC
    P(1, 39) = &H9D
    P(1, 40) = &H6D
    P(1, 41) = &HC1
    P(1, 42) = &HB1
    P(1, 43) = &HE
    P(1, 44) = &H80
    P(1, 45) = &H5D
    P(1, 46) = &HD2
    P(1, 47) = &HD5
    P(1, 48) = &HA0
    P(1, 49) = &H84
    P(1, 50) = &H7
    P(1, 51) = &H14
    P(1, 52) = &HB5
    P(1, 53) = &H90
    P(1, 54) = &H2C
    P(1, 55) = &HA3
    P(1, 56) = &HB2
    P(1, 57) = &H73
    P(1, 58) = &H4C
    P(1, 59) = &H54
    P(1, 60) = &H92
    P(1, 61) = &H74
    P(1, 62) = &H36
    P(1, 63) = &H51
    P(1, 64) = &H38
    P(1, 65) = &HB0
    P(1, 66) = &HBD
    P(1, 67) = &H5A
    P(1, 68) = &HFC
    P(1, 69) = &H60
    P(1, 70) = &H62
    P(1, 71) = &H96
    P(1, 72) = &H6C
    P(1, 73) = &H42
    P(1, 74) = &HF7
    P(1, 75) = &H10
    P(1, 76) = &H7C
    P(1, 77) = &H28
    P(1, 78) = &H27
    P(1, 79) = &H8C
    P(1, 80) = &H13
    P(1, 81) = &H95
    P(1, 82) = &H9C
    P(1, 83) = &HC7
    P(1, 84) = &H24
    P(1, 85) = &H46
    P(1, 86) = &H3B
    P(1, 87) = &H70
    P(1, 88) = &HCA
    P(1, 89) = &HE3
    P(1, 90) = &H85
    P(1, 91) = &HCB
    P(1, 92) = &H11
    P(1, 93) = &HD0
    P(1, 94) = &H93
    P(1, 95) = &HB8
    P(1, 96) = &HA6
    P(1, 97) = &H83
    P(1, 98) = &H20
    P(1, 99) = &HFF
    P(1, 100) = &H9F
    P(1, 101) = &H77
    P(1, 102) = &HC3
    P(1, 103) = &HCC
    P(1, 104) = &H3
    P(1, 105) = &H6F
    P(1, 106) = &H8
    P(1, 107) = &HBF
    P(1, 108) = &H40
    P(1, 109) = &HE7
    P(1, 110) = &H2B
    P(1, 111) = &HE2
    P(1, 112) = &H79
    P(1, 113) = &HC
    P(1, 114) = &HAA
    P(1, 115) = &H82
    P(1, 116) = &H41
    P(1, 117) = &H3A
    P(1, 118) = &HEA
    P(1, 119) = &HB9
    P(1, 120) = &HE4
    P(1, 121) = &H9A
    P(1, 122) = &HA4
    P(1, 123) = &H97
    P(1, 124) = &H7E
    P(1, 125) = &HDA
    P(1, 126) = &H7A
    P(1, 127) = &H17
    P(1, 128) = &H66
    P(1, 129) = &H94
    P(1, 130) = &HA1
    P(1, 131) = &H1D
    P(1, 132) = &H3D
    P(1, 133) = &HF0
    P(1, 134) = &HDE
    P(1, 135) = &HB3
    P(1, 136) = &HB
    P(1, 137) = &H72
    P(1, 138) = &HA7
    P(1, 139) = &H1C
    P(1, 140) = &HEF
    P(1, 141) = &HD1
    P(1, 142) = &H53
    P(1, 143) = &H3E
    P(1, 144) = &H8F
    P(1, 145) = &H33
    P(1, 146) = &H26
    P(1, 147) = &H5F
    P(1, 148) = &HEC
    P(1, 149) = &H76
    P(1, 150) = &H2A
    P(1, 151) = &H49
    P(1, 152) = &H81
    P(1, 153) = &H88
    P(1, 154) = &HEE
    P(1, 155) = &H21
    P(1, 156) = &HC4
    P(1, 157) = &H1A
    P(1, 158) = &HEB
    P(1, 159) = &HD9
    P(1, 160) = &HC5
    P(1, 161) = &H39
    P(1, 162) = &H99
    P(1, 163) = &HCD
    P(1, 164) = &HAD
    P(1, 165) = &H31
    P(1, 166) = &H8B
    P(1, 167) = &H1
    P(1, 168) = &H18
    P(1, 169) = &H23
    P(1, 170) = &HDD
    P(1, 171) = &H1F
    P(1, 172) = &H4E
    P(1, 173) = &H2D
    P(1, 174) = &HF9
    P(1, 175) = &H48
    P(1, 176) = &H4F
    P(1, 177) = &HF2
    P(1, 178) = &H65
    P(1, 179) = &H8E
    P(1, 180) = &H78
    P(1, 181) = &H5C
    P(1, 182) = &H58
    P(1, 183) = &H19
    P(1, 184) = &H8D
    P(1, 185) = &HE5
    P(1, 186) = &H98
    P(1, 187) = &H57
    P(1, 188) = &H67
    P(1, 189) = &H7F
    P(1, 190) = &H5
    P(1, 191) = &H64
    P(1, 192) = &HAF
    P(1, 193) = &H63
    P(1, 194) = &HB6
    P(1, 195) = &HFE
    P(1, 196) = &HF5
    P(1, 197) = &HB7
    P(1, 198) = &H3C
    P(1, 199) = &HA5
    P(1, 200) = &HCE
    P(1, 201) = &HE9
    P(1, 202) = &H68
    P(1, 203) = &H44
    P(1, 204) = &HE0
    P(1, 205) = &H4D
    P(1, 206) = &H43
    P(1, 207) = &H69
    P(1, 208) = &H29
    P(1, 209) = &H2E
    P(1, 210) = &HAC
    P(1, 211) = &H15
    P(1, 212) = &H59
    P(1, 213) = &HA8
    P(1, 214) = &HA
    P(1, 215) = &H9E
    P(1, 216) = &H6E
    P(1, 217) = &H47
    P(1, 218) = &HDF
    P(1, 219) = &H34
    P(1, 220) = &H35
    P(1, 221) = &H6A
    P(1, 222) = &HCF
    P(1, 223) = &HDC
    P(1, 224) = &H22
    P(1, 225) = &HC9
    P(1, 226) = &HC0
    P(1, 227) = &H9B
    P(1, 228) = &H89
    P(1, 229) = &HD4
    P(1, 230) = &HED
    P(1, 231) = &HAB
    P(1, 232) = &H12
    P(1, 233) = &HA2
    P(1, 234) = &HD
    P(1, 235) = &H52
    P(1, 236) = &HBB
    P(1, 237) = &H2
    P(1, 238) = &H2F
    P(1, 239) = &HA9
    P(1, 240) = &HD7
    P(1, 241) = &H61
    P(1, 242) = &H1E
    P(1, 243) = &HB4
    P(1, 244) = &H50
    P(1, 245) = &H4
    P(1, 246) = &HF6
    P(1, 247) = &HC2
    P(1, 248) = &H16
    P(1, 249) = &H25
    P(1, 250) = &H86
    P(1, 251) = &H56
    P(1, 252) = &H55
    P(1, 253) = &H9
    P(1, 254) = &HBE
    P(1, 255) = &H91
 
    'Initialize the MDS array
    For i = 0 To 255
        j = P(0, i)
        m1(0) = j
        mX(0) = j Xor LFSR2(j)
        mY(0) = j Xor LFSR1(j) Xor LFSR2(j)
 
        j = P(1, i)
        m1(1) = j
        mX(1) = j Xor LFSR2(j)
        mY(1) = j Xor LFSR1(j) Xor LFSR2(j)
 
        MDS(0, i) = (m1(1) Or lBSL(mX(1), 8) Or lBSL(mY(1), 16) Or lBSL(mY(1), 24))
        MDS(1, i) = (mY(0) Or lBSL(mY(0), 8) Or lBSL(mX(0), 16) Or lBSL(m1(0), 24))
        MDS(2, i) = (mX(1) Or lBSL(mY(1), 8) Or lBSL(m1(1), 16) Or lBSL(mY(1), 24))
        MDS(3, i) = (mX(0) Or lBSL(m1(0), 8) Or lBSL(mY(0), 16) Or lBSL(mX(0), 24))
    Next
End Sub
 
Public Property Let Key(Optional ByVal MinKeyLength As TWOFISHKEYLENGTH, New_Value As String)
    Dim KeyLength As Long
    Dim Key() As Byte
 
    'Convert the key into a bytearray
    KeyLength = Len(New_Value) * 8
    Key() = StrConv(New_Value, vbFromUnicode)
 
    'Resize the key array if it is too small
    If (KeyLength < MinKeyLength) Then         ReDim Preserve Key(MinKeyLength \ 8 - 1)         KeyLength = MinKeyLength     End If     'The key array can only be of certain sizes,     'if the size is invalid resize to the closes     'size (preferably by making it larger)     If (KeyLength > 192) Then
        ReDim Preserve Key(31)
        KeyLength = 256
    ElseIf (KeyLength > 128) Then
        ReDim Preserve Key(23)
        KeyLength = 192
    ElseIf (KeyLength > 64) Then
        ReDim Preserve Key(15)
        KeyLength = 128
    ElseIf (KeyLength > 32) Then
        ReDim Preserve Key(7)
        KeyLength = 64
    Else
        ReDim Preserve Key(3)
        KeyLength = 32
    End If
 
    'Create the key-dependant sboxes
    Call KeyCreate(Key, KeyLength \ 8)
End Property
 
Private Sub EncryptByte(ByteArray() As Byte, Optional Key As String)
    Dim Offset As Long
    Dim OrigLen As Long
    Dim CipherLen As Long
    Dim CurrPercent As Long
    Dim NextPercent As Long
    Dim DWord(0 To 5) As Long
    Dim CipherWord(0 To 3) As Long
 
    'Set the new key if any was provided
    If (Len(Key) > 0) Then Me.Key = Key
 
    'Get the length of the plaintext
    OrigLen = UBound(ByteArray) + 1
 
    'First we add 12 bytes (4 bytes for the
    'length and 8 bytes for the seed values
    'for the CBC routine), and the ciphertext
    'must be a multiple of 16 bytes

    '*** PaulC ***
    'CipherLen = OrigLen + 12
    'CipherLen = OrigLen + 4
    CipherLen = OrigLen
    '*** ***

    If (CipherLen Mod 16 <> 0) Then
        CipherLen = CipherLen + (16 - (CipherLen Mod 16))
    End If
    ReDim Preserve ByteArray(CipherLen - 1)
 
    For Offset = OrigLen To UBound(ByteArray) Step 1
        ByteArray(Offset) = CByte(Asc(" "))
    Next
 
    'PaulC
    'Call CopyMem(ByteArray(12), ByteArray(0), OrigLen)
    'Call CopyMem(ByteArray(4), ByteArray(0), OrigLen)
    '*** ***

    '*** PaulC ***
    'Store the length descriptor in bytes [9-12]
    'Call CopyMem(ByteArray(8), OrigLen, 4)
    'Store the length descriptor in bytes [0-3]
    'Call CopyMem(ByteArray(0), OrigLen, 4)
    '*** ***

    'Store a block of random data in bytes [1-8],
    'these work as seed values for the CBC routine
    'and is used to produce different ciphertext
    'even when encrypting the same data with the
    'same key)
    'Call Randomize
    'Call CopyMem(ByteArray(0), CLng(2147483647 * Rnd), 4)
    'Call CopyMem(ByteArray(4), CLng(2147483647 * Rnd), 4)

    'Encrypt the data in 128-bits blocks
    For Offset = 0 To (CipherLen - 1) Step 16
        'Get the next block
        Call CopyMem(DWord(0), ByteArray(Offset), 16)
        'XOR the plaintext with the previous
        'ciphertext (CBC, Cipher-Block Chaining)
        'DWord(0) = DWord(0) Xor CipherWord(0)
        'DWord(1) = DWord(1) Xor CipherWord(1)
        'DWord(2) = DWord(2) Xor CipherWord(2)
        'DWord(3) = DWord(3) Xor CipherWord(3)

        'Encrypt the block
        Call EncryptBlock(DWord())
 
        'Store the new block
        Call CopyMem(ByteArray(Offset), DWord(0), 16)
 
        'Store the cipherblock (for CBC)
        'Call CopyMem(CipherWord(0), DWord(0), 16)

        'Update the progress if neccessary
        'If (Offset >= NextPercent) Then
        '    CurrPercent = Int((Offset / CipherLen) * 100)
        '    NextPercent = (CipherLen * ((CurrPercent + 1) / 100)) + 1
        '    RaiseEvent Progress(CurrPercent)
        'End If
    Next
 
    'Make sure we return a 100% progress
    'If (CurrPercent <> 100) Then RaiseEvent Progress(100)
End Sub
 
Private Sub DecryptByte(ByteArray() As Byte, Optional Key As String)
    Dim Offset As Long
    Dim OrigLen As Long
    Dim CipherLen As Long
    Dim CurrPercent As Long
    Dim NextPercent As Long
    Dim DWord(0 To 5) As Long
    Dim CipherWord(0 To 3) As Long
 
    'Set the new key if any was provided
    If (Len(Key) > 0) Then Me.Key = Key
 
    'Get the length of the ciphertext
    CipherLen = UBound(ByteArray) + 1
 
    'Decrypt the data in 128-bits blocks
    For Offset = 0 To (CipherLen - 1) Step 16
        'Get the next block
        Call CopyMem(DWord(2), ByteArray(Offset), 16)
 
        'Decrypt the block
        Call DecryptBlock(DWord())
 
        'XOR with the previous cipherblock
        'DWord(0) = DWord(0) Xor CipherWord(0)
        'DWord(1) = DWord(1) Xor CipherWord(1)
        'DWord(2) = DWord(2) Xor CipherWord(2)
        'DWord(3) = DWord(3) Xor CipherWord(3)

        'Store the current ciphertext to use
        'XOR with the next block plaintext
        Call CopyMem(CipherWord(0), ByteArray(Offset), 16)
 
        'Store the block
        Call CopyMem(ByteArray(Offset), DWord(0), 16)
 
        'Update the progress if neccessary
        'If (Offset >= NextPercent) Then
        '    CurrPercent = Int((Offset / CipherLen) * 100)
        '    NextPercent = (CipherLen * ((CurrPercent + 1) / 100)) + 1
        '    RaiseEvent Progress(CurrPercent)
        'End If
    Next
 
    'Get the size of the original array
    'Call CopyMem(OrigLen, ByteArray(8), 4)
    'Call CopyMem(OrigLen, ByteArray(0), 4)

    'Make sure OrigLen is a reasonable value,
    'if we used the wrong key the next couple
    'of statements could be dangerous (GPF)
    'If (CipherLen - OrigLen > 27) Or (CipherLen - OrigLen < 12) Then
    '  Call Err.Raise(vbObjectError, , "Incorrect size descriptor in Twofish decryption")
    'End If

    'Resize the bytearray to hold only the plaintext
    'and not the extra information added by the
    'encryption routine
    'Call CopyMem(ByteArray(0), ByteArray(12), OrigLen)
    'Call CopyMem(ByteArray(0), ByteArray(4), OrigLen)
    'ReDim Preserve ByteArray(OrigLen - 1)

    'Make sure we return a 100% progress
    'If (CurrPercent <> 100) Then RaiseEvent Progress(100)
End Sub
 
Private Static Sub GetWord(LongValue As Long, CryptBuffer() As Byte, Offset As Long)
    '  Call CopyMem(LongValue, CryptBuffer(Offset), 4)
    Dim bb(0 To 3) As Byte
 
    bb(3) = CryptBuffer(Offset)
    bb(2) = CryptBuffer(Offset + 1)
    bb(1) = CryptBuffer(Offset + 2)
    bb(0) = CryptBuffer(Offset + 3)
    Call CopyMem(LongValue, bb(0), 4)
End Sub
 
Private Static Sub PutWord(LongValue As Long, CryptBuffer() As Byte, Offset As Long)
    '  Call CopyMem(CryptBuffer(Offset), LongValue, 4)
    Dim bb(0 To 3) As Byte
 
    Call CopyMem(bb(0), LongValue, 4)
    CryptBuffer(Offset) = bb(3)
    CryptBuffer(Offset + 1) = bb(2)
    CryptBuffer(Offset + 2) = bb(1)
    CryptBuffer(Offset + 3) = bb(0)
End Sub
 
Private Static Function UnsignedAdd(ByVal Data1 As Long, Data2 As Long) As Long
    Dim x1(0 To 3) As Byte
    Dim x2(0 To 3) As Byte
    Dim xx(0 To 3) As Byte
    Dim Rest As Long
    Dim Value As Long
    Dim a As Long
 
    Call CopyMem(x1(0), Data1, 4)
    Call CopyMem(x2(0), Data2, 4)
 
    Rest = 0
    For a = 0 To 3
        Value = CLng(x1(a)) + CLng(x2(a)) + Rest
        xx(a) = Value And 255
        Rest = Value \ 256
    Next
 
    Call CopyMem(UnsignedAdd, xx(0), 4)
End Function
 
Private Function UnsignedDel(Data1 As Long, Data2 As Long) As Long
    Dim x1(0 To 3) As Byte
    Dim x2(0 To 3) As Byte
    Dim xx(0 To 3) As Byte
    Dim Rest As Long
    Dim Value As Long
    Dim a As Long
 
    Call CopyMem(x1(0), Data1, 4)
    Call CopyMem(x2(0), Data2, 4)
    Call CopyMem(xx(0), UnsignedDel, 4)
 
    For a = 0 To 3
        Value = CLng(x1(a)) - CLng(x2(a)) - Rest
        If (Value < 0) Then
            Value = Value + 256
            Rest = 1
        Else
            Rest = 0
        End If
        xx(a) = Value
    Next
 
    Call CopyMem(UnsignedDel, xx(0), 4)
End Function
 
Private Function HexToStr(HexText As String, Optional ByVal Separators As Long = 1) As String
    Dim a As Long
    Dim Pos As Long
    Dim PosAdd As Long
    Dim ByteSize As Long
    Dim HexByte() As Byte
    Dim ByteArray() As Byte
 
    'Initialize the hex routine
    If (Not m_InitHex) Then Call InitHex
 
    'The destination string is half
    'the size of the source string
    'when the separators are removed
    If (Len(HexText) = 2) Then
        ByteSize = 1
    Else
        ByteSize = ((Len(HexText) + 1) \ (2 + Separators))
    End If
    ReDim ByteArray(0 To ByteSize - 1)
 
    'Convert every HEX code to the
    'equivalent ASCII character
    PosAdd = 2 + Separators
    HexByte() = StrConv(HexText, vbFromUnicode)
    For a = 0 To (ByteSize - 1)
        ByteArray(a) = m_HexToByte(HexByte(Pos), HexByte(Pos + 1))
        Pos = Pos + PosAdd
    Next
 
    'Now finally convert the byte
    'array to the return string
    HexToStr = StrConv(ByteArray, vbUnicode)
End Function
 
Private Sub InitHex()
    Dim a As Long
    Dim b As Long
    Dim HexBytes() As Byte
    Dim HexString As String
 
    'The routine is initialized
    m_InitHex = True
 
    'Create a string with all hex values
    HexString = String$(512, "0")
    For a = 1 To 255
        Mid$(HexString, 1 + a * 2 + -(a < 16)) = Hex(a)     Next     HexBytes = StrConv(HexString, vbFromUnicode)     'Create the Str->Hex array
    For a = 0 To 255
        m_ByteToHex(a, 0) = HexBytes(a * 2)
        m_ByteToHex(a, 1) = HexBytes(a * 2 + 1)
    Next
 
    'Create the Str->Hex array
    For a = 0 To 255
        m_HexToByte(m_ByteToHex(a, 0), m_ByteToHex(a, 1)) = a
    Next
End Sub
 
Private Function StrToHex(Text As String, Optional Separator As String = " ") As String
    Dim a As Long
    Dim Pos As Long
    Dim Char As Byte
    Dim PosAdd As Long
    Dim ByteSize As Long
    Dim ByteArray() As Byte
    Dim ByteReturn() As Byte
    Dim SeparatorLen As Long
    Dim SeparatorChar As Byte
 
    'Initialize the hex routine
    If (Not m_InitHex) Then Call InitHex
 
    'Initialize variables
    SeparatorLen = Len(Separator)
 
    'Create the destination bytearray, this
    'will be converted to a string later
    ByteSize = (Len(Text) * 2 + (Len(Text) - 1) * SeparatorLen)
    ReDim ByteReturn(ByteSize - 1)
    Call FillMemory(ByteReturn(0), ByteSize, Asc(Separator))
 
    'We convert the source string into a
    'byte array to speed this up a tad
    ByteArray() = StrConv(Text, vbFromUnicode)
 
    'Now convert every character to
    'it's equivalent HEX code
    PosAdd = 2 + SeparatorLen
    For a = 0 To (Len(Text) - 1)
        ByteReturn(Pos) = m_ByteToHex(ByteArray(a), 0)
        ByteReturn(Pos + 1) = m_ByteToHex(ByteArray(a), 1)
        Pos = Pos + PosAdd
    Next
 
    'Convert the bytearray to a string
    StrToHex = StrConv(ByteReturn(), vbUnicode)
End Function
 
Private Function LastDllErrorMessage(dllErrNum As Long) As String
    Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
    Dim sError As String
    Dim lErrNum As Long
    Dim rtn As Long
 
    sError = String(500, 0)
    rtn = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0&, dllErrNum, 0, sError, Len(sError), 0)
    LastDllErrorMessage = Trim(sError)
End Function
 
Private Sub HandleClassError(oError As ErrObject)
    LastError = IIf(oError.LastDllError > 0, oError.LastDllError, oError.Number)
    LastErrorDesc = IIf(oError.LastDllError > 0, LastDllErrorMessage(oError.LastDllError), oError.Description)
End Sub

 

2014-10-02_11-53-18KineticJS is an HTML5 Canvas JavaScript framework that enables high performance animations, transitions, node nesting, layering, filtering, caching, event handling for desktop and mobile applications, and much more.

You can draw things onto the stage, add event listeners to them, move them, scale them, and rotate them independently from other shapes to support high performance animations, even if your application uses thousands of shapes. Served hot with a side of awesomeness. Learn more: http://kineticjs.com

Demo: http://www.html5canvastutorials.com/labs/html5-canvas-shape-tango-with-kineticjs/

Other libraries: http://medleyweb.com/web-dev/top-7-javascript-canvas-libraries-and-tutorials

and http://www.awwwards.com/web-animation-infographics-a-map-of-the-best-animation-libraries-for-javascript-and-css3-plus-performance-tips.html

Others:

Snap.svg: http://snapsvg.io/about/

Agile: http://a-jie.github.io/Agile/