1

.bmp キャプチャ イメージを出力するスクリプトがあります。

イメージは 16 進数で作成され、バイナリに変換されてresponse.binaryWrite chrB(CByte(myHexImage))(イメージの MIME タイプ = bmp として)経由でブラウザーに送信されます。

私はオプションをそれから離れて（MIMEタイプの変更など）、次のように出力に送信するだけに移行したいと考えています：

data:image/jpeg;base64,/9j/4AAQSkZJRgABAQAAAQABAAD/2 ...

（私の画像がBMPであることを除いて）

その16進またはバイナリをvbscriptでbase64に変換する迅速かつ簡単な方法はありますか? これは、上記のように私が今実装したもののスニペットです。

これを変更して、有効な 16 進形式 (base64 に簡単に変換できます) または直接 base64 を画面に出力するにはどうすればよいですか?

    Dim sBmpEndLine, sBmpInfoHeader, sBmpHeader, sTmpHex

    If (m_iBmpWidth Mod 4) <> 0 Then
        sBmpEndLine = string((4 - (m_iBmpWidth Mod 4)) * 2, "0")
    Else
        sBmpEndLine = vbNullString
    End If

    sBmpInfoHeader = array("28000000", "00000000", "00000000", "0100", "0800", "00000000", "00000000", "120B0000", "120B0000", "00000000", "00000000")
    sBmpInfoHeader(1) = formatHex(hex(m_iBmpWidth), 4, 0, True)
    sBmpInfoHeader(2) = formatHex(hex(m_iBmpHeight), 4, 0, True)
    sBmpInfoHeader(6) = formatHex(hex((m_iBmpHeight * m_iBmpWidth) + (m_iBmpHeight * (len(sBmpEndLine) / 2))), 4, 0, True)
    sBmpInfoHeader(9) = formatHex(hex(len(m_sBmpColorMap) / 8), 4, 0, True)
    sBmpInfoHeader(10) = sBmpInfoHeader(9)
    sBmpHeader = array("424D", "00000000", "0000", "0000", "00000000")
    sBmpHeader(1) = formatHex(hex((len(join(sBmpHeader, "")) / 2) + (len(join(sBmpInfoHeader, "")) / 2) + (len(m_sBmpColorMap) / 2) + (m_iBmpHeight * m_iBmpWidth) + (m_iBmpHeight * (len(sBmpEndLine) / 2))), 4, 0, True)
    sBmpHeader(4) = formatHex(hex((len(join(sBmpHeader, "")) / 2) + (len(join(sBmpInfoHeader, "")) / 2) + (len(m_sBmpColorMap) / 2)), 4, 0, True)

    sendHex(join(sBmpHeader, ""))
    sendHex(join(sBmpInfoHeader, ""))
    sendHex(m_sBmpColorMap)
    For y = m_iBmpHeight To 1 Step -1
        For x = 1 To m_iBmpWidth
            sTmpHex = m_aBitmap(y, x)
            If sTmpHex = vbNullString Then
                sendHex(m_sBgColor)
            Else
                sendHex(sTmpHex)
            End If
        Next
        sendHex(sBmpEndLine)
    Next

    Response.Flush

そして、ここにsendHex()関数があります：

Private Sub sendHex(valHex)

    Dim iCntHex
    For iCntHex = 1 To len(valHex) Step 2
        'Response.BinaryWrite chrB(CByte("&H" & mid(valHex, iCntHex, 2)))
        response.Write "&H" & mid(valHex, iCntHex, 2)
    Next
End Sub
4

2 に答える 2

1

には、およびのMicrosoft.XMLDOMコンバータが組み込まれています。これを使用する方法を示す関数を作成しました。bin.base64bin.hex

Function TextToBinary(text, dataType)
  Dim dom
  Set dom = CreateObject("Microsoft.XMLDOM")
  dom.loadXML("<HELLO/>")
  dom.documentElement.nodeTypedValue = text
  dom.documentElement.dataType = dataType
  TextToBinary = dom.documentElement.nodeTypedValue
End Function

Function BinaryToText(binary, dataType)
  Dim dom
  Set dom = CreateObject("Microsoft.XMLDOM")
  dom.loadXML("<HELLO/>")
  dom.documentElement.dataType = dataType
  dom.documentElement.nodeTypedValue = binary
  dom.documentElement.removeAttribute("dt:dt")
  BinaryToText = dom.documentElement.nodeTypedValue
End Function

Function HexToBase64(strHex)
  HexToBase64 = BinaryToText(TextToBinary(strHex, "bin.hex"), "bin.base64")
End Function

Function Base64ToHex(strBase64)
  Base64ToHex = BinaryToText(TextToBinary(strBase64, "bin.base64"), "bin.hex")
End Function

使用例を次に示します。

MsgBox HexToBase64("41")
MsgBox Base64ToHex("QQ==")

またADODB.Stream、バイナリ ファイルを操作する手段として を参照してください。これらのルーチンで動作します。

于 2013-03-17T05:49:03.503 に答える
0

これを機能させることができました。方法は次のとおりです。

sendHex では、その&H部分を削除し、文字列を hex() でラップしました。

Private Sub sendHex(valHex)
    Dim iCntHex
    For iCntHex = 1 To len(valHex) Step 2
    If len( mid(valHex, iCntHex, 2)) = 1 Then 
        response.write "0"
    end if 
    response.write mid(valHex, iCntHex, 2)
    Next
End Sub

これにより、次のような文字列出力が得られます (2 つの 16 進数文字のバイト文字列)。

424d1e050000000000003e00000028000000340000001800000001000

HEX次に、その適切な 16 進文字列をto関数に次のようにダンプできbase64ます (私が書いたのではなく、Richard Mueller が書いたものです - http://www.rlmueller.net/Base64.htm ) 。

Function HexToBase64(strHex)
    ' Function to convert a hex string into a base64 encoded string.
    ' Constant B64 has global scope.
    Dim lngValue, lngTemp, lngChar, intLen, k, j, strWord, str64, intTerm

    intLen = Len(strHex)

    ' Pad with zeros to multiple of 3 bytes.
    intTerm = intLen Mod 6
    If (intTerm = 4) Then
        strHex = strHex & "00"
        intLen = intLen + 2
    End If
    If (intTerm = 2) Then
        strHex = strHex & "0000"
        intLen = intLen + 4
    End If

    ' Parse into groups of 3 hex bytes.
    j = 0
    strWord = ""
    HexToBase64 = ""
    For k = 1 To intLen Step 2
        j = j + 1
        strWord = strWord & Mid(strHex, k, 2)
        If (j = 3) Then
            ' Convert 3 8-bit bytes into 4 6-bit characters.
            lngValue = CCur("&H" & strWord)

            lngTemp = Fix(lngValue / 64)
            lngChar = lngValue - (64 * lngTemp)
            str64 = Mid(B64, lngChar + 1, 1)
            lngValue = lngTemp

            lngTemp = Fix(lngValue / 64)
            lngChar = lngValue - (64 * lngTemp)
            str64 = Mid(B64, lngChar + 1, 1) & str64
            lngValue = lngTemp

            lngTemp = Fix(lngValue / 64)
            lngChar = lngValue - (64 * lngTemp)
            str64 = Mid(B64, lngChar + 1, 1) & str64

            str64 = Mid(B64, lngTemp + 1, 1) & str64

            HexToBase64 = HexToBase64 & str64
            j = 0
            strWord = ""
        End If
    Next
    ' Account for padding.
    If (intTerm = 4) Then
        HexToBase64 = Left(HexToBase64, Len(HexToBase64) - 1) & "="
    End If
    If (intTerm = 2) Then
        HexToBase64 = Left(HexToBase64, Len(HexToBase64) - 2) & "=="
    End If

End Function

これにより、上記が base64 に変換され、出力を次のように (ブラウザーの URL バーなどで) 使用して、画像として表示できます。

data:image/bmp;base64,Qk0eBQAAAAAAAD4AAAAo...

于 2013-01-24T18:24:14.230 に答える