返回顶部

收藏

Blowfish in ASP

更多

VBScript实现Blowfish加密Download BlowfishASP.zip (20 kB) last updated 2009-05-06.Converting VB6 to VBScriptHere are some hints for converting your Visual Basic (VB6/VBA) code into VBScript:Surround your code with <% and %>Remove all type names from dimension statements, i.e. globally delete " As String", " As Integer", " As Long", etc.Remove any specific sizes for strings, e.g. remove the "* 8" from Dim strBlock As String * 8.If you've used the faster string functions that end in $ such as Asc$() or Mid$(), remove the trailing "$". Hint: globally replace "Asc$(" with "Asc(".In your For loops, remove anything after the Next keyword, e.g. If you typically write your loops asFor i = 1 To 10 ' ... Next iremove the "i" after the Next.Replace any functions that are not valid in VBScript. In the Blowfish example, we had to replace the very useful StrConv(). For a list of valid functions in VBScript see the Microsoft VBScript Features page, and also VBScript Features not in Visual Basic for Applications.Remove the keyword Private from constant definitions, as in Private Const scNAMEThis is not meant to be an exhaustive list, but we hope a helpful one.

basBlowfish.asp

<%

' Conversion of Visual Basic code to VBScript code 
' First published on <www.di-mgt.com.au/crypto.html> 2 February 2002

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

' 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 <code@di-mgt.com.au>.
' The latest version of this source code can be downloaded from
' www.di-mgt.com.au/crypto.html.
'****************** END OF COPYRIGHT NOTICE*************************

' Public 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

Private Const ncROUNDS  = 16
Private Const ncMAXKEYLEN = 56
' 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)
    Dim a, b, C, d
    Dim y

    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

Public Function blf_EncipherBlock(xL, xR)
    Dim i
    Dim temp

    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

Public Function blf_DecipherBlock(xL, xR)
    Dim i
    Dim temp

    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

Public Function blf_Initialise(aKey(), nKeyBytes)
    Dim i, j, K
    Dim wData, wDataL, wDataR

    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
        blf_P(i) = blf_P(i) Xor wData
    Next

    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

    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
    Next

End Function

Public Function blf_Key(aKey(), nKeyLen)
    blf_Key = False
    If nKeyLen < 0 Or nKeyLen > ncMAXKEYLEN Then
        Exit Function
    End If

    Call blf_Initialise(aKey, nKeyLen)

    blf_Key = True
End Function

Public Function blf_KeyInit(aKey())
' Added Version 5: Replacement for blf_Key to avoid specifying keylen
    Dim nKeyLen

    blf_KeyInit = False
    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
End Function

Public Function blf_EncryptBytes(aBytes())
' aBytes() must be 8 bytes long
' Revised Version 5: January 2002. To use faster uwJoin and uwSplit fns.
    Dim wordL, wordR

    ' 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

Public Function blf_DecryptBytes(aBytes())
' aBytes() must be 8 bytes long
' Revised Version 5:: January 2002. To use faster uwJoin and uwSplit fns.
    Dim wordL, wordR

    ' 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

' Version 5 note: These functions blf_Enc() and blf_Dec() are
' probably redundant now.
' See improved versions of blf_StringEnc and blf_StringDec

Public Function blf_Enc(awData(), nWords)
' Version 5: Changed Integer counters to Long
    Dim i

    For i = 0 To nWords - 1 Step 2
        Call blf_EncipherBlock(awData(i), awData(i + 1))
    Next

End Function

Public Function blf_Dec(awData(), nWords)
' Version 5: Changed Integer counters to Long
    Dim i

    For i = 0 To nWords - 1 Step 2
        Call blf_DecipherBlock(awData(i), awData(i + 1))
    Next

End Function

%>

basBlowfishFns.asp

<%

' Conversion of Visual Basic code to VBScript code 
' First published on <www.di-mgt.com.au/crypto.html> 2 February 2002

' basBlowfishFns: Wrapper functions to call Blowfish algorithms

' Version 5. January 2002. Completely revised blf_String fns.
' Added blf_StringRaw() fn and PadString and UnpadString fns.
' File functions moved to basBlowfishFileFns module.
' Many thanks to Robert Garofalo and Doug J Ward for suggestions
' and advice greatly appreciated.
' Version 4. 12 May 2001. Improvements as noted.
' Version 2. Published 16 November 2000
' 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 Right(s 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 <code@di-mgt.com.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_StringEnc(strData): Enciphers string strData with current key
' blf_StringDec(strData): Deciphers string strData with current key
' blf_StringRaw(strData, bEncrypt): En/Deciphers strData without padding
' PadString(strData): Pads data string to next multiple of 8 bytes
' UnpadString(strData): Removes padding after decryption

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

Public Function blf_StringEnc(strData)
' Encrypts plaintext strData after adding RFC 2630 padding
' Returns encrypted string.
' Requires key and boxes to be already set up.
' Version 5. Completely revised.
' The speed improvement here is due to Robert Garofalo.
    Dim strIn
    Dim strOut
    Dim nLen
    Dim sPad
    Dim nPad
    Dim nBlocks
    Dim i
    Dim j
    Dim aBytes(7)
    Dim sBlock
    Dim iIndex

    ' Pad data string to multiple of 8 bytes
    nLen = Len(strData)
    nPad = ((nLen \ 8) + 1) * 8 - nLen
    sPad = String(nPad, Chr(nPad))  ' Pad with # of pads (1-8)
    strIn = strData & sPad
    ' Calc number of 8-byte blocks
    nLen = Len(strIn)
    nBlocks = nLen \ 8
    ' Allocate output string here so we can use Mid($ below
    ' strOut = String(nLen, " ")
    strOut = ""     ' Fix for VBScript

    ' Work through string in blocks of 8 bytes
    iIndex = 0
    For i = 1 To nBlocks
        sBlock = Mid(strIn, iIndex + 1, 8)
        ' Convert to bytes
        ' aBytes() = StrConv(sBlock, vbFromUnicode)
        Call bu_String2Bytes(sBlock, aBytes)
        ' Encrypt the block
        Call blf_EncryptBytes(aBytes)
        ' Convert back to a string
        ' sBlock = StrConv(aBytes(), vbUnicode)
        sBlock = bu_Bytes2String(aBytes, 8)
        ' Copy to output string
        ' Mid(strOut, iIndex + 1, 8) = sBlock
        strOut = strOut & sBlock
        iIndex = iIndex + 8
    Next

    blf_StringEnc = strOut

End Function

Public Function blf_StringDec(strData)
' Decrypts ciphertext strData and removes RFC 2630 padding
' Returns decrypted string.
' Requires key and boxes to be already set up.
' Version 5. Completely revised.
' The speed improvement here is due to Robert Garofalo.
    Dim strIn
    Dim strOut
    Dim nLen
    Dim sPad
    Dim nPad
    Dim nBlocks
    Dim i
    Dim j
    Dim aBytes(7)
    Dim sBlock
    Dim iIndex

    strIn = strData
    ' Calc number of 8-byte blocks
    nLen = Len(strIn)
    nBlocks = nLen \ 8
    ' Allocate output string here so we can use Mid($ below
    'strOut = String(nLen, " ")
    strOut = ""

    ' Work through string in blocks of 8 bytes
    iIndex = 0
    For i = 1 To nBlocks
        sBlock = Mid(strIn, iIndex + 1, 8)
        ' Convert to bytes
        ' aBytes() = StrConv(sBlock, vbFromUnicode)
        Call bu_String2Bytes(sBlock, aBytes)
        ' Encrypt the block
        Call blf_DecryptBytes(aBytes)
        ' Convert back to a string
        'sBlock = StrConv(aBytes(), vbUnicode)
        sBlock = bu_Bytes2String(aBytes, 8)
        ' Copy to output string
        ' Mid(strOut, iIndex + 1, 8) = sBlock
        strOut = strOut & sBlock
        iIndex = iIndex + 8
    Next

    ' Strip padding, if valid
    nPad = Asc(Right(strOut, 1))
    If nPad > 8 Then nPad = 0
    strOut = Left(strOut, nLen - nPad)

    blf_StringDec = strOut

End Function

Public Function blf_StringRaw(strData, bEncrypt)
' New function added version 5.
' Encrypts or decrypts strData without padding according to current key.
' Similar to blf_StringEnc and blf_StringDec, but does not add padding
' and ignores trailing odd bytes.
    Dim strIn
    Dim strOut
    Dim nLen
    Dim nBlocks
    Dim i
    Dim j
    Dim aBytes(7)
    Dim sBlock
    Dim iIndex

    ' Calc number of 8-byte blocks (ignore odd trailing bytes)
    strIn = strData
    nLen = Len(strIn)
    nBlocks = nLen \ 8
    ' Allocate output string here so we can use Mid($ below
    ' strOut = String(nLen, " ")
    strOut = ""

    ' Work through string in blocks of 8 bytes
    iIndex = 0
    For i = 1 To nBlocks
        sBlock = Mid(strIn, iIndex + 1, 8)
        ' Convert to bytes
        ' aBytes() = StrConv(sBlock, vbFromUnicode)
        Call bu_String2Bytes(sBlock, aBytes)
        ' En/Decrypt the block according to flag
        If bEncrypt Then
            Call blf_EncryptBytes(aBytes())
        Else
            Call blf_DecryptBytes(aBytes())
        End If
        ' Convert back to a string
        ' sBlock = StrConv(aBytes(), vbUnicode)
        sBlock = bu_Bytes2String(aBytes, 8)
        ' Copy to output string
        ' Mid(strOut, iIndex + 1, 8) = sBlock
        strOut = strOut & sBlock
        iIndex = iIndex + 8
    Next

    blf_StringRaw = strOut

End Function

' PadString() and UnpadString() fns added in version 5.

Public Function PadString(strData)
' Pad data string to next multiple of 8 bytes as per RFC 2630
    Dim nLen
    Dim sPad
    Dim nPad
    nLen = Len(strData)
    nPad = ((nLen \ 8) + 1) * 8 - nLen
    sPad = String(nPad, Chr(nPad))  ' Pad with # of pads (1-8)
    PadString = strData & sPad

End Function

Public Function UnpadString(strData)
' Strip RFC 2630-style padding
    Dim nLen
    Dim nPad
    nLen = Len(strData)
    If nLen = 0 Then Exit Function
    ' Get # of padding bytes from last char
    nPad = Asc(Right(strData, 1))
    If nPad > 8 Then nPad = 0   ' In case invalid
    UnpadString = Left(strData, nLen - nPad)
End Function

%>

basByteUtils.asp

<%

' Conversion of Visual Basic code to VBScript code 
' First published on <www.di-mgt.com.au/crypto.html> 2 February 2002

' basByteUtils: Misc byte utilities

'************************* 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>."

' 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 <code@di-mgt.com.au>.
' The latest version of this source code can be downloaded from
' www.di-mgt.com.au/crypto.html.
'****************** END OF COPYRIGHT NOTICE*************************

Public Function bu_HexStr2Bytes(str, aBytes())
' Converts string <str> with hex values into array of bytes
' Returns # of bytes converted
' Assumes array is large enough
' E.g. "fedcba98" will be converted into (&HFE, &HDC, &HBA, &H98)

    nBytes = Len(str) \ 2
    For i = 0 To nBytes - 1
        aBytes(i) = CByte("&H" & Mid(str, i * 2 + 1, 2))
    Next

    bu_HexStr2Bytes = nBytes

End Function

Public Function bu_Bytes2HexStr(aBytes(), nBytes)
' Returns hex string from array of bytes
' E.g. {&HFE, &HDC, &HBA, &H98} will return "fedcba98"
    Dim strTemp

    strTemp = bu_Bytes2String(aBytes, nBytes)
    bu_Bytes2HexStr = bu_Str2Hex(strTemp)
End Function

Public Function bu_String2Bytes(str, aBytes())
' Converts string <str> directly into array of bytes
' String may contain any characters between &H00 and &HFF
' Returns # of bytes converted
' Assumes array is large enough
' E.g. "abc" will be converted to (&H61, &H62, &H63) i.e. (97, 98, 99)

    nBytes = Len(str)
    For i = 0 To nBytes - 1
        aBytes(i) = Asc(Mid(str, i + 1, 1))
    Next

    bu_String2Bytes = nBytes

End Function

Public Function bu_Bytes2String(aBytes(), nBytes)
' Converts array of bytes, nBytes long, into a string
' E.g. (&H61, &H62, &H63) will be converted to "abc"

    For i = 0 To nBytes - 1
        str = str & Chr(aBytes(i))
    Next

    bu_Bytes2String = str

End Function

Public Function bu_Str2Hex(str)
' Converts string <str> of chars to string in hex byte format
' E.g. "abc" will be converted to "616263"
    sHex = ""

    n = Len(str)
    For i = 1 To n
        byt = CByte(Asc(Mid(str, i, 1)))
        If Len(Hex(byt)) = 1 Then
            sHex = sHex & "0" & Hex(byt)
        Else
            sHex = sHex & Hex(byt)
        End If
    Next
    bu_Str2Hex = sHex

End Function

%>

basRadix64.asp

<%

' Conversion of Visual Basic code to VBScript code 
' VBScript code
' First published on <www.di-mgt.com.au/crypto.html> 2 February 2002
' Revised 13 August 2002: Fixed Mid() error in DecodeStr64

' basRadix64: Radix 64 en/decoding functions
' Version 3. Published January 2002 with even faster SHR/SHL functions
'            and using Mid$ function instead of appending to strings.
' Version 2. Published 12 May 2001
' Version 1. Published 28 December 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>."

' 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 <code@di-mgt.com.au>.
' The latest version of this source code can be downloaded from
' www.di-mgt.com.au/crypto.html.

' Credit where credit is due:
' Some parts of this VB code are based on original C code
' by Carl M. Ellison. See "cod64.c" published 1995.
'****************** END OF COPYRIGHT NOTICE*************************

Private aDecTab(255)
Private Const sEncTab = _
    "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"

Public Function EncodeStr64(sInput)
' Return radix64 encoding of string of binary values
' Does not insert CRLFs. Just returns one long string,
' so it's up to the user to add line breaks or other formatting.
' Version 3: Use Mid() function instead of appending
' VBScript: Doesn't work. Go back to appending
    Dim sOutput, sLast
    Dim b(2)
    Dim j
    Dim i, nLen, nQuants
    Dim iIndex

    nLen = Len(sInput)
    nQuants = nLen \ 3
    ' sOutput = String(nQuants * 4, " ")
    sOutput = ""
    iIndex = 0
    ' Now start reading in 3 bytes at a time
    For i = 0 To nQuants - 1
        For j = 0 To 2
           b(j) = Asc(Mid(sInput, (i * 3) + j + 1, 1))
        Next
        ' Mid(sOutput, iIndex + 1, 4) = EncodeQuantum(b)
        sOutput = sOutput & EncodeQuantum(b)
        iIndex = iIndex + 4
    Next

    ' Cope with odd bytes
    Select Case nLen Mod 3
    Case 0
        sLast = ""
    Case 1
        b(0) = Asc(Mid(sInput, nLen, 1))
        b(1) = 0
        b(2) = 0
        sLast = EncodeQuantum(b)
        ' Replace last 2 with =
        sLast = Left(sLast, 2) & "=="
    Case 2
        b(0) = Asc(Mid(sInput, nLen - 1, 1))
        b(1) = Asc(Mid(sInput, nLen, 1))
        b(2) = 0
        sLast = EncodeQuantum(b)
        ' Replace last with =
        sLast = Left(sLast, 3) & "="
    End Select

    EncodeStr64 = sOutput & sLast
End Function

Public Function DecodeStr64(sEncoded)
' Return string of decoded binary values given radix64 string
' Ignores any chars not in the 64-char subset
' Version 3: Use Mid) function instead of appending
' VBScript Revised 13 Aug 2002: Use appending instead of Mid()
' (VBScript doesn't seem to like Mid(str, i, 1) = "A")
    Dim sDecoded
    Dim d(3)
    Dim C
    Dim di
    Dim i
    Dim nLen
    Dim iIndex

    nLen = Len(sEncoded)
    'sDecoded = String((nLen \ 4) * 3, " ")
    sDecoded = ""
    iIndex = 0
    di = 0
    Call MakeDecTab
    ' Read in each char in trun
    For i = 1 To Len(sEncoded)
        C = CByte(Asc(Mid(sEncoded, i, 1)))
        C = aDecTab(C)
        If C >= 0 Then
            d(di) = C
            di = di + 1
            If di = 4 Then
                'Mid(sDecoded, iIndex + 1, 3) = DecodeQuantum(d)
                sDecoded = sDecoded & DecodeQuantum(d)
                iIndex = iIndex + 3
                If d(3) = 64 Then
                    sDecoded = Left(sDecoded, Len(sDecoded) - 1)
                    iIndex = iIndex - 1
                End If
                If d(2) = 64 Then
                    sDecoded = Left(sDecoded, Len(sDecoded) - 1)
                    iIndex = iIndex - 1
                End If
                di = 0
            End If
        End If
    Next

    DecodeStr64 = sDecoded
End Function

Private Function EncodeQuantum(b())
    Dim sOutput
    Dim C

    sOutput = ""
    C = SHR2(b(0)) And &H3F
    sOutput = sOutput & Mid(sEncTab, C + 1, 1)
    C = SHL4(b(0) And &H3) Or (SHR4(b(1)) And &HF)
    sOutput = sOutput & Mid(sEncTab, C + 1, 1)
    C = SHL2(b(1) And &HF) Or (SHR6(b(2)) And &H3)
    sOutput = sOutput & Mid(sEncTab, C + 1, 1)
    C = b(2) And &H3F
    sOutput = sOutput & Mid(sEncTab, C + 1, 1)

    EncodeQuantum = sOutput

End Function

Private Function DecodeQuantum(d())
    Dim sOutput
    Dim C

    sOutput = ""
    C = SHL2(d(0)) Or (SHR4(d(1)) And &H3)
    sOutput = sOutput & Chr(C)
    C = SHL4(d(1) And &HF) Or (SHR2(d(2)) And &HF)
    sOutput = sOutput & Chr(C)
    C = SHL6(d(2) And &H3) Or d(3)
    sOutput = sOutput & Chr(C)

    DecodeQuantum = sOutput

End Function

Private Function MakeDecTab()
' Set up Radix 64 decoding table
    Dim t
    Dim C

    For C = 0 To 255
        aDecTab(C) = -1
    Next

    t = 0
    For C = Asc("A") To Asc("Z")
        aDecTab(C) = t
        t = t + 1
    Next

    For C = Asc("a") To Asc("z")
        aDecTab(C) = t
        t = t + 1
    Next

    For C = Asc("0") To Asc("9")
        aDecTab(C) = t
        t = t + 1
    Next

    C = Asc("+")
    aDecTab(C) = t
    t = t + 1

    C = Asc("/")
    aDecTab(C) = t
    t = t + 1

    C = Asc("=")    ' flag for the byte-deleting char
    aDecTab(C) = t  ' should be 64

End Function

' Version 3: ShiftLeft and ShiftRight functions improved.
Public Function SHL2(ByVal bytValue)
' Shift 8-bit value to left by 2 bits
' i.e. VB equivalent of "bytValue << 2" in C
    SHL2 = (bytValue * &H4) And &HFF
End Function

Public Function SHL4(ByVal bytValue)
' Shift 8-bit value to left by 4 bits
' i.e. VB equivalent of "bytValue << 4" in C
    SHL4 = (bytValue * &H10) And &HFF
End Function

Public Function SHL6(ByVal bytValue)
' Shift 8-bit value to left by 6 bits
' i.e. VB equivalent of "bytValue << 6" in C
    SHL6 = (bytValue * &H40) And &HFF
End Function

Public Function SHR2(ByVal bytValue)
' Shift 8-bit value to right by 2 bits
' i.e. VB equivalent of "bytValue >> 2" in C
    SHR2 = bytValue \ &H4
End Function

Public Function SHR4(ByVal bytValue)
' Shift 8-bit value to right by 4 bits
' i.e. VB equivalent of "bytValue >> 4" in C
    SHR4 = bytValue \ &H10
End Function

Public Function SHR6(ByVal bytValue)
' Shift 8-bit value to right by 6 bits
' i.e. VB equivalent of "bytValue >> 6" in C
    SHR6 = bytValue \ &H40
End Function
%>

basUnsignedWord.asp

<%

' Conversion of Visual Basic code to VBScript code 
' First published on <www.di-mgt.com.au/crypto.html> 2 February 2002

' basUnsignedWord: Utilities for unsigned word arithmetic

' [2009-06-05] Updated >= error in uw_WordAdd.
' 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 <code@di-mgt.com.au>.
' The latest version of this source code can be downloaded from
' www.di-mgt.com.au/crypto.html.
'****************** END OF COPYRIGHT NOTICE*************************

Const OFFSET_4 = 4294967296
Const MAXINT_4 = 2147483647

Public Function uwJoin(a, b, C, d)
' 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

Public Sub uwSplit(ByVal w, a, b, C, d)
' 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.
Public Function uw_ShiftLeftBy8(wordX)
    ' 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

Public Function uw_WordAdd(wordA, wordB)
' Adds words A and B avoiding overflow
    Dim myUnsigned

    myUnsigned = LongToUnsigned(wordA) + LongToUnsigned(wordB)
    ' Cope with overflow
    ' [2009-06-06] Changed > to >=.
    If myUnsigned >= OFFSET_4 Then
        myUnsigned = myUnsigned - OFFSET_4
    End If
    uw_WordAdd = UnsignedToLong(myUnsigned)

End Function

Public Function uw_WordSub(wordA, wordB)
' Subtract words A and B avoiding underflow
    Dim myUnsigned

    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"

Function UnsignedToLong(value)
    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

Public Function LongToUnsigned(value)
    If value < 0 Then
        LongToUnsigned = value + OFFSET_4
    Else
        LongToUnsigned = value
    End If
End Function

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

%>

BlowfishDemo.asp

<!-- #INCLUDE FILE="basBlowfish.asp" -->
<!-- #INCLUDE FILE="basBlfArrays.asp" -->
<!-- #INCLUDE FILE="basBlowfishFns.asp" -->
<!-- #INCLUDE FILE="basUnsignedWord.asp" -->
<!-- #INCLUDE FILE="basByteUtils.asp" -->
<!-- #INCLUDE FILE="basRadix64.asp" -->

<html>
<head>
<title>Blowfish ASP Demo</title>
<!-- This demo of an ASP in VBScript uses a conversion
of David Ireland's Visual Basic code
for Bruce Schneier's
Blowfish algorithm.
Many, many thanks are due to Hart Penn for showing me how to do
the conversion, even though it's taken me over a year to publish it.
-->
</head>

<body>
<h3>Blowfish ASP Demo</h3>

<p>Demo of Blowfish in VBScript.
Original Visual Basic code by David Ireland copyright
(C) 2000-2 DI Management Services Pty Limited, all rights reserved.
Much appreciated advice on VBScript conversion by Hart Penn.
</p>
<%
  Dim aKey()
  Dim nKeyLen

  szTxtKey = Trim(Request ("txtKey"))
  szTxtPlain = Trim(Request ("txtPlain"))
  szSubmit = Request ("submit")

  ' Set key, if set
  If szTxtKey <> "" Then
    ReDim aKey((Len(szTxtKey) \ 2) - 1)
    nKeyLen = bu_HexStr2Bytes(szTxtKey, aKey)
    Call blf_Key(aKey, nKeyLen)
    szTxtKeyAsString = bu_Bytes2HexStr(aKey, nKeyLen)
    End If

  If szTxtPlain <> "" Then
    szTxtCipher = blf_StringEnc(szTxtPlain)
    szTxtCipherHex = bu_Str2Hex(szTxtCipher)
    szTxtCipher64 = EncodeStr64(szTxtCipher)
    szTxtDecrypt = blf_StringDec(szTxtCipher)
  End If

%>
<form method="post" action="BlowfishDemo.asp">
  <table>
    <tr>
      <td align="right">Key (in hex): </td>
      <td align="left">
        <input type="text" name="txtKey" size="32" value="<%=szTxtKey%>">
      </td>
      <td>
        <input type="submit" name="submit" value="Set Key"><br>
      </td>
    </tr>
    <tr>
      <td align="right">Active Key: </td>
      <td align="left">
        <b><%=szTxtKeyAsString%></b><br>
      </td>
      <td>
      </td>
    </tr>
    <tr>
      <td align="right">Plain Text: </td>
      <td align="left">
        <input type="text" name="txtPlain" size="32"  value="<%=szTxtPlain%>">
      </td>
      <td>
        <input type="submit" name="submit" value="Encrypt it">
      </td>
    </tr>
    <tr>
      <td align="right">Cipher Text: </td>
      <td align="left">
        <input type="text" name="txtCipher" size="32" value="<%=szTxtCipher%>">
      </td>
      <td>
        Len: <%=Len(szTxtCipher)%>
      </td>
    </tr>
    <tr>
      <td align="right">(in hex): </td>
      <td align="left">
        <input type="text" name="txtCipherHex" size="40" value="<%=szTxtCipherHex%>">
      </td>
      <td>
      </td>
    </tr>
    <tr>
      <td align="right">(Radix64): </td>
      <td align="left">
        <input type="text" name="txtCipher64" size="32" value="<%=szTxtCipher64%>">
      </td>
      <td>
      </td>
    </tr>
    <tr>
      <td align="right">Deciphered: </td>
      <td align="left">
        <input type="text" name="txtDecrypt" size="32" value="<%=szTxtDecrypt%>">
      </td>
      <td>
      </td>
    </tr>
  </table>
</form>

</body>
</html>

标签:asp.net/basic

收藏

0人收藏

支持

0

反对

0

发表评论