巧用剪切板导出包对象内的文件

ljw990485

goldowl2011 发表于 2012-4-13 14:26
Thanks a lot. But why not share your unzip file codes or give us a link to study it.

http://club.excelhome.net/thread-789037-1-1.html

御风怀韧

那我这个批量导出的包对象的问题，各位大侠看下如何处理比较好，谢谢！
http://club.excelhome.net/home.p ... =thread&view=me

shuiyinxyz

Excel2007包对象怎么才能不含图标和标签名称

usbusb

小fisher 发表于 2009-5-2 13:16
这是我的代码：
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Pri ...

都是牛人啊，佩服。

老实说，代码确实比楼主的高效，不过楼主确实对于剪贴板格式研究得更透彻一些。

效率方面，楼主的主要败在这里了，包内嵌入的文件如果很大，导出的时候就会很慢，建议不要用循环来做，一次性复制内存就完美了：
For i = 1 To FileSize
    b = GetBytes(pMem, 1)
    Put fn, , b
Next

usbusb

ljw990485 发表于 2009-2-22 12:22
具体代码：
Option Explicit
Private Declare Sub GlobalUnlock Lib "kernel32" (ByVal hMem As Long)

你好，大侠

把转存的代码部分提高了一下效率，试了一下一个10MB的包，效果很明显

Private Declare Sub GlobalUnlock Lib "kernel32" (ByVal hMem As Long)
Private Declare Sub CloseClipboard Lib "user32" ()
Private Declare Sub RtlMoveMemory Lib "kernel32" (Destination As Any, ByVal Source As Long, ByVal Length As Long)
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, ByVal Source As Long, ByVal Length As Long)
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function RegisterClipboardFormat Lib "user32" Alias "RegisterClipboardFormatA" (ByVal lpString As String) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long

Public Sub btn_Export_Click()
    GetPackagedFile ThisWorkbook.Sheets(1).OLEObjects(1), ThisWorkbook.Path & "\Package.zip"
End Sub

'其中 obj 为要导出文件的包对象，FileName 为输出文件名
Private Function GetPackagedFile(obj As OLEObject, FileName As String) As Boolean
    GetPackagedFile = False
    If obj Is Nothing Then Exit Function
    If obj.progID <> "Package" Then Exit Function
    Dim HandleC As Long, pMem As Long, FileSize As Long, fn As Long, i As Long, b As Byte
    Dim nClipsize As Long, bytData() As Byte, lHeader As Variant
    On Error Resume Next
    Kill FileName
    obj.Copy
    If OpenClipboard(0) Then
        HandleC = GetClipboardData(RegisterClipboardFormat("Native" & Chr$(0)))
        If HandleC Then
            nClipsize = GlobalSize(HandleC)
            pMem = GlobalLock(HandleC)
            If pMem Then
                ReDim bytData(0 To nClipsize) As Byte
                ' Cut the Header "02 00 00 00" After Second Execution
                CopyMemory bytData(0), ByVal pMem, nClipsize
                If (bytData(0) = 2) And (bytData(1) = 0) And (bytData(2) = 0) And (bytData(3) = 0) Then
                    pMem = pMem + 4
                    CopyMemory bytData(0), bytData(pMem), nClipsize - 4
                End If
                If GetBytes(pMem, 2) = 0 Then
                    pMem = pMem + 6
                    Do While GetBytes(pMem, 1) <> 0: Loop
                    FileSize = GetBytes(pMem, 4)
                    CopyMemory bytData(0), ByVal pMem, FileSize
                    fn = FreeFile
                    Err = 0
                    Open FileName For Binary Lock Write As fn
                    If Err = 0 Then
                        'For i = 1 To FileSize
                        '    b = GetBytes(pMem, 1)
                        '    Put fn, , b
                        'Next
                        CopyMemory bytData(0), bytData(pMem), FileSize
                        Put fn, , bytData
                        Close fn
                        GetPackagedFile = True
                    End If
                Else
                    MsgBox "包对象内不能有图标和标签名称，即左边内容应该全部为空, 而右边必须包含一个文件"
                End If
            End If

            GlobalUnlock HandleC
        End If

        EmptyClipboard    ' 清理剪贴板，解决包内文件很大的情况下退出Excel时响应慢的问题
        CloseClipboard
    End If
End Function

Private Function GetBytes(ByRef pMem As Long, ByVal n As Integer) As Long
    GetBytes = 0

    RtlMoveMemory GetBytes, ByVal pMem, n

    pMem = pMem + n
End Function

四月星空

好东西，要研究研究

liujunwei4321

小fisher 发表于 2009-5-2 12:55
http://www.officefans.net/cdb/viewthread.php?tid=58150
这里有更早的：）
Native格式前面的头其实并不 ...

我感觉这个格式正确，除了开头手误写成了00 20，应该20 00，另外当使用过obj.copy后，excel已经把这个嵌入文件释放到temp文件夹了（可以用everything搜索试试），在剪贴板Native格式的内容中包含释放后的文件完整路径，所以可以从Native内容中解析得到完整路径，然后再把释放到temp文件夹中文件复制到其它位置。只要嵌入的不是那几个通过格式或者复合文档（其它格式能不能这样用只需把文件以对象的方式插入到excel中，再手动复制这个对象，文件夹中粘贴试试即可），这种方法还是很通用的。这个可以用小fisher的剪贴板查看器或free clipboard viewer验证。

ojb.copy复制后，剪贴板Native格式为：


02 00 标签名（没改过的话默认是是短文件名） 00 文件嵌入时的原始路径（ansi) 00 00 00 03 00 释放的文件路径字节长度+1（ansi编码，相当于lenb函数，有时[至少路径无中文时会多取]会多取到一个null字符00） 00 00 00 释放的文件路径(ansi) 00 包中文件字长 00 文件内容本身内容 释放的文件路径字符个数（就是len函数取出来的长度，真要用它，得乘2，这个和前面那个长度一般不一致） 00 00 00 释放的文件路径（ 宽字节，utf16）标签名字符个数（相当于len函数） 00 00 00 标签名（宽字节，utf16）文件嵌入时的原始路径字符个数（len） 00 00 00 文件嵌入时的原始路径（ 宽字节，utf16）


没有仔细检查是不是全都这样，欢迎各位验证。另外，新版本office不知道怎么插入包，使图标和文字都消失。

lyfegf

留言学习下，感觉很厉害

liujunwei4321

既然包是以OLE的方式插入进去的，而07以后的文件其实就是个zip压缩包，考虑到OLE都存放在压缩包中的xl\embeddings\目录下，好像是以bin结尾，那能不能直接通过解决压缩包的形式拿到bin，到从bin中扣出OLE包中的文件呢？可以肯定的是，bin确实包含这个文件，而且没有压缩和加密。就是bin文件的头部的格式还没摸清楚。

liujunwei4321

再继续下去，发现object.bin其实是一结构化的文件，和压缩文件有点像，是一种容器，直接用7z可以打开，里面可以有树状结构（类似文件夹和文件），windows 原生api 相关的有IStream，IStorage, 应该可以读取出来（类似解压？），oleobject.bin除7z外，还可以用docfile viewer查看结构，也可以用Another OLE Doc Viewer（需自己编译）查看。
关于office的这种结构化文件，下面这个文件应该有详细的说明和解读。https://www.openoffice.org/sc/compdocfileformat.pdf