将图片的base64 代码转换为 图片（jpg）

zhxin100

excel vba 如何将图片的base64 二进制码 转换为 图片（jpg）
Private Sub main()
   Dim strba As String
    Open ThisWorkbook.Path + "\2.txt" For Binary As #1
        Line Input #1, strba
    Close #1
    Dim bs() As Byte: bs = StrConv(strba, vbFromUnicode)
    Dim fn: fn = ThisWorkbook.Path + "\3.jpg"
    Open fn For Binary Access Write As #100
    Put #100, , bs()
    Close #100
End Sub
上面的2.txt内容为"/9j/4AAQSkZJRgABAQAAAQABAAD/2wBDAAMCAgMCAgM........"，而上面代码生成的3.jpg无法显示，用文本打开发现与2.txt的内容一样，两个文件就只是后缀名不同而已，我的目的是将2.txt的内容转为一张jpg图片，请高手赐教~~~~~

Moneky

发一个示例txt上来看看，方便调试

zhxin100

Moneky 发表于 2013-6-11 14:31
发一个示例txt上来看看，方便调试

发好了，请高手帮忙看看

Moneky

zhxin100 发表于 2013-6-11 14:44
发好了，请高手帮忙看看

要等等，晚上回去想想，刚刚看了编码规则，头绪已经有了，要回去写代码，现在要上班干活了。

Moneky

解码成功，代码还需要完善一下，完善后再发代码。

zhxin100

Moneky 发表于 2013-6-11 18:44
解码成功，代码还需要完善一下，完善后再发代码。

{:soso_e179:}
请多多指教

zhxin100

呵呵，自己解决了，贴上代码

Private Function DecodeBase64(ByVal strData As String) As Byte()

    Dim objXML As MSXML2.DOMDocument
    Dim objNode As MSXML2.IXMLDOMElement
   
    ' help from MSXML
    Set objXML = New MSXML2.DOMDocument
    Set objNode = objXML.createElement("b64")
    objNode.DataType = "bin.base64"
    objNode.Text = strData
    DecodeBase64 = objNode.nodeTypedValue
   
    ' thanks, bye
    Set objNode = Nothing
    Set objXML = Nothing

End Function
Private Sub main()
   Dim strba As String
    Open ThisWorkbook.Path + "\2.txt" For Binary As #1
        Line Input #1, strba
    Close #1
    Dim bs() As Byte: bs = DecodeBase64(strba)
    Dim fn: fn = ThisWorkbook.Path + "\3.jpg"
    Open fn For Binary Access Write As #100
    Put #100, , bs()
    Close #100
End Sub

Moneky

zhxin100 发表于 2013-6-11 19:49
请多多指教

代码添加了输入输出接口，可以方便选择输出文件存放的文件夹，也可以选择需要转换的文件（可以选择多个文件）。核心转换过程有两个参数，第一个是txt的fullname，第二个是jpg文件保存的fullname。

在这之前只知道有BASE64编码，但没有真正研究过其原理和方法，通过这个程序也研究了编码规则，对自己也是一种提升。

1. Sub Txt2Jpg(inFileFullName As String, outFileFullName As String) '转换过程
   
2.     Dim a() As Byte, b() As Byte  'a 原始文件字节数组  b 生成的jpg字节数组
   
3.     Dim i As Long, j As Long
   
4.     Dim FileNo As Long  '文件号
   
5.     FileNo = FreeFile
   
6.    
   
7.     Open inFileFullName For Binary As FileNo '打开文件
   
8.         ReDim a(LOF(FileNo) - 1)    '调整a的大小
   
9.         Get FileNo, , a             '获取文件内容
   
10.     Close FileNo
    
11.    
    
12.     ReDim b((UBound(a) + 1) * 3 / 4 - 1)    '调整b的大小,b的字节数为原始文件的 3/4    4*6=3*8
    
13.     For i = LBound(a) To UBound(a)    '根据对照表将字符ASCII转为0-64
    
14.         If a(i) >= 65 And a(i) <= 90 Then
    
15.             a(i) = a(i) - 65
    
16.         ElseIf a(i) >= 97 And a(i) <= 122 Then
    
17.             a(i) = a(i) - 71
    
18.         ElseIf a(i) >= 48 And a(i) <= 57 Then
    
19.             a(i) = a(i) + 4
    
20.         ElseIf a(i) = 43 Then
    
21.             a(i) = 62
    
22.         ElseIf a(i) = 47 Then
    
23.             a(i) = 63
    
24.         End If
    
25.     Next
    
26.    
    
27.     For i = LBound(a) To UBound(a) Step 4   '核心转换代码,每4个原始字节转换为3个jpg字节  4个字节每个字节去掉前面两位0,剩下4个6位共24位,按每8位划分为一个新的jpg字节
    
28.                                             '原理图示如工作表
    
29.         j = (i \ 4) * 3                     'b下标转换
    
30.         b(j) = a(i) * 4 + a(i + 1) \ 16     '位移处理生成新的jpg字节
    
31.         b(j + 1) = (a(i + 1) Mod 16) * 16 + a(i + 2) \ 4
    
32.         b(j + 2) = (a(i + 2) Mod 4) * 64 + a(i + 3)
    
33.     Next
    
34.   
    
35.     FileNo = FreeFile
    
36.     Open outFileFullName For Binary As FileNo   '将jpg字节写入文件
    
37.         Put FileNo, , b
    
38.     Close FileNo
    
39. End Sub
    
40. Sub Main() '适用于VBA的输入输出设定过程，可以批处理文件（一次选取多个需要处理的文件）
    
41.     Dim vFileDLG As FileDialog
    
42.     Dim vSeled As Variant
    
43.     Dim strPath As String
    
44.     Set vFileDLG = Application.FileDialog(msoFileDialogFolderPicker)
    
45.     With vFileDLG
    
46.         .Title = "Eersoft-选择输出文件保存的文件夹"
    
47. getpath:         If .Show = -1 Then
    
48.             strPath = .SelectedItems.Item(1)
    
49.             strPath = strPath & IIf(Right$(strPath, 1) = "", "", "")
    
50.         Else
    
51.             If MsgBox("没有选择输出文件存放的文件夹，需要重新选取吗？如果不重新选取程序将退出。", vbQuestion + vbYesNo, "Eersoft-选取输出文件存放文件夹") = vbYes Then
    
52.                 GoTo getpath
    
53.             Else
    
54.                 Exit Sub
    
55.             End If
    
56.         End If
    
57.     End With
    
58. 
    
59.     Set vFileDLG = Application.FileDialog(msoFileDialogFilePicker)
    
60.     With vFileDLG
    
61.         .Title = "Eersoft-选择需要转换的文件"
    
62.         .Filters.Add "文本文件", "*.txt"
    
63. getfile:         If .Show = -1 Then
    
64.             For Each vSeled In .SelectedItems
    
65.                 Call Txt2Jpg(CStr(vSeled), strPath & getNameForFullName(CStr(vSeled)) & ".jpg")
    
66.             Next vSeled
    
67.             MsgBox "所有文件已经转换完成。", vbInformation + vbOKOnly, "Eersoft-转换完成"
    
68.         Else
    
69.                       If MsgBox("没有选择需要转换的文件，需要重新选取吗？如果不重新选取程序将退出。", vbQuestion + vbYesNo, "Eersoft-选取需要转换的文件") = vbYes Then
    
70.                 GoTo getfile
    
71.             Else
    
72.                 Exit Sub
    
73.             End If
    
74.   
    
75.         End If
    
76.     End With
    
77.     Set vFileDLG = Nothing
    
78. End Sub
    
79. Function getNameForFullName(strPath As String) As String '根据带路径的全名获取文件短名称（不带扩展名)
    
80.     Dim srr
    
81.     srr = Split(strPath, "")
    
82.     getNameForFullName = Split(srr(UBound(srr)), ".")(0)
    
83. End Function
    

复制代码

zhxin100

Moneky 发表于 2013-6-11 22:48
代码添加了输入输出接口，可以方便选择输出文件存放的文件夹，也可以选择需要转换的文件（可以选择多个文 ...

仔细看过代码，写的很好，自己手动编码转换，写的很详细，受教了!{:soso_e142:}

Moneky

///////////////////////////////测试删除