VB缩略图缓存thumbs.db查看提取源代码 展示 frmMain.frm源代码

1. VERSION 5.00
2. Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "ComDlg32.OCX"
3. Begin VB.Form frmMain
4.    Caption         =   "WinXP缓存缩略图查看提取工具"
5.    ClientHeight    =   5850
6.    ClientLeft      =   165
7.    ClientTop       =   555
8.    ClientWidth     =   7530
9.    Icon            =   "frmMain.frx":0000
10.    LinkTopic       =   "Form1"
11.    MaxButton       =   0   'False
12.   OLEDropMode     =   1  'Manual
13.   ScaleHeight     =   5850
14.    ScaleWidth      =   7530
15.    StartUpPosition =   2  '屏幕中心
16.   Begin MSComDlg.CommonDialog CDialog1
17.       Left            =   6720
18.       Top             =   3240
19.       _ExtentX        =   847
20.       _ExtentY        =   847
21.       _Version        =   393216
22.    End
23.    Begin VB.TextBox txtPicWH
24.       Height          =   375
25.       Left            =   5880
26.       TabIndex        =   4
27.       Top             =   4320
28.       Width           =   1335
29.    End
30.    Begin VB.PictureBox Picture1
31.       AutoSize        =   -1  'True
32.      BorderStyle     =   0  'None
33.      Height          =   1695
34.       Left            =   5520
35.       ScaleHeight     =   1695
36.       ScaleWidth      =   1500
37.       TabIndex        =   2
38.       Top             =   600
39.       Width           =   1500
40.    End
41.    Begin VB.ListBox List1
42.       Height          =   4200
43.       Left            =   120
44.       OLEDropMode     =   1  'Manual
45.      TabIndex        =   1
46.       Top             =   600
47.       Width           =   4335
48.    End
49.    Begin VB.Label lblInfo
50.       BorderStyle     =   1  'Fixed Single
51.      Height          =   735
52.       Left            =   0
53.       TabIndex        =   5
54.       Top             =   5100
55.       Width           =   7215
56.    End
57.    Begin VB.Label Label1
58.       AutoSize        =   -1  'True
59.      Caption         =   "图片宽度 高度"
60.       Height          =   180
61.       Left            =   4560
62.       TabIndex        =   3
63.       Top             =   4440
64.       Width           =   1170
65.    End
66.    Begin VB.Label lblDrag
67.       Alignment       =   2  'Center
68.      Caption         =   $"frmMain.frx":0442
69.       Height          =   375
70.       Left            =   120
71.       TabIndex        =   0
72.       Top             =   120
73.       Width           =   7335
74.    End
75.    Begin VB.Menu mnuMainMenu
76.       Caption         =   "操作"
77.       Begin VB.Menu mnuMainMenu_SaveAllPic
78.          Caption         =   "保存所有图片文件"
79.       End
80.       Begin VB.Menu mnuMainMenu_SaveOffset
81.          Caption         =   "保存偏移数据"
82.       End
83.       Begin VB.Menu mnuMainMenu_Sep1
84.          Caption         =   "-"
85.       End
86.       Begin VB.Menu mnuAbout
87.          Caption         =   "About"
88.       End
89.    End
90. End
91. Attribute VB_Name = "frmMain"
92. Attribute VB_GlobalNameSpace = False
93. Attribute VB_Creatable = False
94. Attribute VB_PredeclaredId = True
95. Attribute VB_Exposed = False
96. Option Explicit
97. 'Download by http://www.bvbsoft.com
98. Private strFilePath As String
99. Private strFileName As String
100.  
101. Private bytFileData() As Byte       '读取文件数据
102. Private bytThumbsData() As Byte     '读取缩略图文件数据，保存到文件,二维数组
103. '在用 Preserve 关键字时，只能改变多维数组中最后一维的上界；
104. '所以，第1维存放数据，范围就是0(缩略图Jpg大小最大不会超过5KB)，第2维根据项目的个数来表示的编号
105. '但是不能直接使用数组的形式来返回，必须用传址的方式返回
106.  
107. '还有一种方法，是记录每个图片文件项目的差异的偏移，及插入的非jpg数据块的大小
108. Dim lngDifferNumList() As Long     '相差的数值
109. Dim lngDifferOffsetList() As Long     '包含的非Jpg数据的偏移
110.  
111.  
112. Dim bytDelimiter() As Byte      '0C00000001000000   '分隔符
113. Dim bytJPGHeader() As Byte      'XP生成的Thumbs.db里的Jpg文件头数据，是相同的
114. '可以采用测试，看解出来显示正常的Jpg文件是否文件头部分都是完全相同的
115. Dim blnIncludeJpg As Boolean    '在Jpg的数据里包含了分隔符和其它jpg数据
116.  
117. Dim lngOffsetList() As Long     '偏移 列表
118. Dim lngFileSizeList() As Long   '大小 列表
119.  
120. 'PSC原作者使用String类型来读取，这可能是英文操作系统上可以运行，但是在中文操作系统是错误的
121. Private strFileData As String
122. Private strThumbData() As String
123. '-------------------------------------------------------------------
124. 'Private Sub DoProcess1()
125. 'Dim i As Integer
126. '    Me.Caption = "Loading"
127. '    strFileData = GetFileContents(strFilePath & "\" & strFileName)
128. '
129. '    Me.Caption = "Splitting"
130. '    strThumbData = Split(strFileData, "???")
131. '
132. '    Me.Caption = "Saving"
133. '    For i = 1 To UBound(strThumbData)
134. '        SetFileContents strFilePath & "\thumbs\", i & ".jpg", "??? & strThumbData(i)"
135. '    Next i
136. '    Me.Caption = "DONE!"
137. 'End Sub
138. '
139. 'Private Function GetFileContents1(ByVal sFile As String) As String
140. 'On Error Resume Next
141. '    Dim iFile As Integer, i As Long
142. '    iFile = FreeFile
143. '    Open sFile For Binary As iFile
144. '        GetFileContents = Space(LOF(1))
145. '        Get #1, , GetFileContents
146. '    Close iFile
147. 'End Function
148. '
149. 'Private Sub SetFileContents1(ByVal sPath As String, ByVal sFile As String, ByVal contents As String)
150. '    Dim iFile As Integer
151. '    If Dir(sPath, vbDirectory) = "" Then MkDir sPath
152. '    iFile = FreeFile
153. '    Open sPath & sFile For Output As iFile
154. '        Print #iFile, contents;
155. '    Close iFile
156. 'End Sub
157. '-------------------------------------------------------------------
158.  
159. Private Sub SetFileContents(ByVal strPathAs String, ByVal strFileAs String, ByteArray() AsByte)
160. '保存二进制文件
161. '参数：strPath - 带有\的路径名
162. '       strFile - 不带路径的文件名
163.  
164.     Dim intFileNum As Integer
165.    
166.     If Dir(strPath, vbDirectory) ="" Then MkDir strPath
167.     intFileNum = FreeFile
168.     Open strPath & strFile For Binary As intFileNum
169.     Put #intFileNum, , ByteArray
170.     Close intFileNum
171.    
172. End Sub
173. Private Function GetFileContents(ByVal strFileAs String) As Byte()
174. '获取整个二进制文件内容
175.  
176. On Error Resume Next
177.     Dim intFileNum As Integer
178.     intFileNum = FreeFile
179.     Open strFile For Binary Access ReadAs #intFileNum
180.     ReDim GetFileContents(LOF(intFileNum) - 1)
181.     Get #intFileNum, , GetFileContents
182.     Close intFileNum
183.    
184. End Function
185.  
186. Private Sub DoProcess1()
187. 'Version 1.0
188.  
189. '因为没有Thumbs.db的详细文件格式资料,无法获取文件的个数
190. '现在这个版本有一个问题，会有些文件看不到，因为查看文件内容发现，中间有些Jpg文件很短，只有几百字节，
191. '与文件数据前的文件大小不符合,这样就会跳过一个文件，导致漏掉文件
192.  
193. Dim i As Long
194. Dim j As Long
195.  
196.     Me.Caption = "装入中..."
197.     bytFileData = GetFileContents(strFilePath & "\" & strFileName)
198. '    Me.Caption = "分割中..."
199.    
200.     j = 0
201.    
202.     For i = 0 To UBound(bytFileData) - 7
203.         '一个字节一个字节的比较分隔符字节数组,如果找到,代表
204.        If ByteArraysAreEqual(CopyByteArray(bytFileData, i, 8), bytDelimiter)Then
205. '            Debug.Print "分隔符 offset : " & Hex$(i)
206.            
207.             ReDim Preserve lngFileSizeList(j)
208.             ReDim Preserve lngOffsetList(j)
209.             lngFileSizeList(j) = GetLongFromByteArray(bytFileData, i + 8)
210.             lngOffsetList(j) = i + 8 + 4
211.            
212.             '然后就需要跳过这个文件数据，修改i的值
213.            i = i + 8 + 4 + lngFileSizeList(j)
214.            
215.             j = j + 1
216.         End If
217.     Next
218.    
219.     For i = 0 To UBound(lngOffsetList)
220.         List1.AddItem "Thumb" & CStr(i + 1) & vbTab &"(" & Hex$(lngOffsetList(i)) & ")"
221.     Next
222.    
223. '    Me.Caption = "保存中..."
224.    
225.     Me.Caption = "完成!"
226.    
227. End Sub
228.  
229. Private Sub DoProcess2()
230. 'Version 2.0
231.  
232. '因为没有Thumbs.db的详细文件格式资料,无法获取文件的个数
233. '现在这个版本有一个问题，会有些文件看不到，因为查看文件内容发现，中间有些Jpg文件很短，只有几百字节，
234. '与文件数据前的文件大小不符合,这样就会跳过一个文件，导致漏掉文件
235. '----------
236. '增加一个判断，每找到一个标志，跳过文件长度时，先判断该长度的文件尾是不是Jpg的文件尾标志，如果不是
237. '则从之前的位置继续搜索
238. '一种情况：就是4位字节文件大小的值，小于实际的文件大小值，这就需要搜索修正
239.  
240. '在Thumbs.db文件里找到了全部对应文件的文件名，是用Unicode字符存储在里面的,有的是单独的一个，有的是几个连续一起
241.  
242.  
243.  
244. Dim i As Long
245. Dim j As Long       '包含的图片个数
246. Dim k As Long
247. Dim intDiffCount As Integer     '有差异的项个数
248. Dim lngDifferNum As Long     '相差的数值
249. Dim lngDifferOffset As Long     '包含的非Jpg数据的偏移
250.  
251. Dim lngAllFileSize As Long      '所有包含的Jpg文件加起来的大小
252.  
253.  
254.     Me.Caption = "装入中..."
255.     bytFileData = GetFileContents(strFilePath & "\" & strFileName)
256. '    Me.Caption = "分割中..."
257.    
258.     List1.Clear
259.    
260.     j = 0
261.     intDiffCount = 0
262.     lngAllFileSize = 0
263.    
264.     For i = 0 To UBound(bytFileData) - 7
265.         '一个字节一个字节的比较分隔符字节数组,如果找到,代表
266.        If ByteArraysAreEqual(CopyByteArray(bytFileData, i, 8), bytDelimiter)Then
267. '            Debug.Print "分隔符 offset : " & Hex$(i)
268.            
269.             ReDim Preserve lngFileSizeList(j)
270.             ReDim Preserve lngOffsetList(j)
271.             ReDim Preserve bytThumbsData(5120, j)      '默认为5K，5*1024=5120
272.            
273.             lngFileSizeList(j) = GetLongFromByteArray(bytFileData, i + 8)
274.             lngOffsetList(j) = i + 8 + 4
275.            
276.             '累加文件大小
277.            lngAllFileSize = lngAllFileSize + lngFileSizeList(j)
278.            
279.             '增加 判断
280.            If GetIntegerFromByteArray(bytFileData, (i + 8 + 4 + lngFileSizeList(j)) - 2) = &HD9FFThen
281.             '如果在正确的位置上找到Jpg的文件尾标志，则正常
282.                '不知道使用二维的字节数组可否接收返回一个数组
283.                'bytThumbsData(0, j) = CopyByteArray(bytFileData, lngOffsetList(j), lngFileSizeList(j))
284.                '需采用传址方式,1维固定为5K字节
285.                CopyByteArrayRef bytFileData, lngOffsetList(j), lngFileSizeList(j), bytThumbsData, j
286.                
287.                 '然后就需要跳过这个文件数据，修改i的值
288.                i = i + 8 + 4 + lngFileSizeList(j)
289.                
290.             Else
291.                 intDiffCount = intDiffCount + 1
292. '                Debug.Print "此位置的数据不正确 " & Hex$(lngOffsetList(j))
293.                
294.                 lngDifferNum = 0    '在后面的查找之前先清零
295.                '查看数据得到，一般是少0x200/0x400字节
296.                For k = &H200To &H400 Step &H200
297.                     If GetIntegerFromByteArray(bytFileData, (i + 8 + 4 + lngFileSizeList(j) + k) - 2) = &HD9FFThen
298.                     '如果是指定位置找到Jpg文件尾标志，则记录差值，然后修正该项的文件大小值
299.                        lngDifferNum = k
300.                         ExitFor
301.                     End If
302.                 Next
303.                
304.                 '0x34,0x74,0xF4     相差0x40,0x80
305.                '要确定该位置的数据不是Jpg里的数据,然后就可以把该块位置的数据丢开
306.                '分辨时，应该选择固定的值来判别
307.                '1.先解决Jpg文件数据里夹杂着非Jpg数据，去除之
308.                '2.再解决jpg文件数据里包含着下一个甚至两个jpg文件数据的情况
309.                
310.                
311.                 If lngDifferNum > 0Then        '修正大小后，找到正确的文件尾
312.                    '实际上这里处理不能简单的加上偏移，需要把插入的数据分离，再合成被切开的同一个文件
313.                    'lngFileSizeList(j) = lngFileSizeList(j) + lngDifferNum
314.                    
315.                     '查找固定的位置
316.                    lngDifferOffset = 0
317.                     For k = &H34To &H134 Step &H40
318.                         Debug.Print ByteArrayToStr(CopyByteArray(bytFileData, (i + 8 + 4) + k, 8))
319.                         Debug.Print ByteArrayToStr(CopyByteArray(bytJPGHeader, k, 8))
320.                        
321.                         If Not ByteArraysAreEqual(CopyByteArray(bytFileData, (i + 8 + 4) + k, 8), CopyByteArray(bytJPGHeader, k, 8))Then
322.                             lngDifferOffset = k
323.                             ExitFor
324.                         End If
325.                     Next
326.                    
327.                     If lngDifferOffset > 0Then
328.                         '如果是Jpg中间插入非Jpg数据，先复制前面一部分
329.                        '   CopyByteArrayRef bytFileData, lngOffsetList(j), lngDifferOffset - 1, bytThumbsData, j
330.                        CopyByteArrayRef bytFileData, lngOffsetList(j), lngDifferOffset, bytThumbsData, j
331.                         '再复制后面一部分
332.                        '   CopyByteArrayRef bytFileData, lngOffsetList(j) + lngDifferOffset + lngDifferNum - 1, lngFileSizeList(j) - lngDifferOffset - 1, bytThumbsData, j, lngDifferOffset
333.                        CopyByteArrayRef bytFileData, lngOffsetList(j) + lngDifferOffset + lngDifferNum, lngFileSizeList(j), bytThumbsData, j, lngDifferOffset
334.                        
335.                         i = i + 8 + 4 + lngFileSizeList(j)
336.                     Else
337.                         i = i + 8 + 4
338.                     End If
339.                    
340.                 Else
341.                 '搜索还是没有找到，可能是那种文件数据只有几十个字节的类型
342.                    '碰到这种情况有两种做法：
343.                    '1.把lngFileSizeList项置0，在保存文件时跳过此项（文件名也跳过)
344.                    '2.按原样保存，查找分隔符位置，修正文件大小，
345.                    
346.                     i = i + 8 + 4
347.                 End If
348.             End If
349.            
350.            
351.             j = j + 1
352.         End If
353.     Next
354.    
355.     For i = 0 To UBound(lngOffsetList)
356.         '添加显示项目编号名、偏移、文件大小（因为文件名的分布不太规范，所以要最后才得出，不能同步得到）
357.        
358.         List1.AddItem "Thumb" & CStr(i + 1) & vbTab &"(" & Hex$(lngOffsetList(i)) & ")" _
359.                     & vbTab & "(" & Hex$(lngFileSizeList(i)) &")"
360.     Next
361.    
362. '    Me.Caption = "保存中..."
363.    
364.     Me.Caption = "完成!"
365.     lblInfo.Caption = "有差异的个数：" & intDiffCount & vbCrLf &"所有文件的总大小：" & lngAllFileSize
366.    
367.     'MsgBox "有差异的个数：" & intDiffCount
368.    'MsgBox "所有文件的总大小：" & lngAllFileSize
369. '    Debug.Print "所有文件的总大小：" & lngAllFileSize
370.    
371. End Sub
372.  
373.  
374. Private Sub DoProcess()
375. 'Version 3.0
376.  
377. '因为没有Thumbs.db的详细文件格式资料,无法获取文件的个数
378. '现在这个版本有一个问题，会有些文件看不到，因为查看文件内容发现，中间有些Jpg文件很短，只有几百字节，
379. '与文件数据前的文件大小不符合,这样就会跳过一个文件，导致漏掉文件
380. '----------
381. '增加一个判断，每找到一个标志，跳过文件长度时，先判断该长度的文件尾是不是Jpg的文件尾标志，如果不是
382. '则从之前的位置继续搜索
383. '一种情况：就是4位字节文件大小的值，小于实际的文件大小值，这就需要搜索修正
384.  
385. '在Thumbs.db文件里找到了全部对应文件的文件名，是用Unicode字符存储在里面的,有的是单独的一个，有的是几个连续一起
386.  
387.  
388.  
389. Dim i As Long
390. Dim j As Long       '包含的图片个数
391. Dim k As Long
392. Dim l As Long
393.  
394. Dim intDiffCount As Integer     '有差异的项个数
395. Dim lngDifferNum As Long     '相差的数值
396. Dim lngDifferOffset As Long     '包含的非Jpg数据的偏移
397.  
398. Dim lngAllFileSize As Long      '所有包含的Jpg文件加起来的大小
399.  
400.  
401.     Me.Caption = "装入中..."
402.     bytFileData = GetFileContents(strFilePath & "\" & strFileName)
403. '    Me.Caption = "分割中..."
404.    
405.     List1.Clear
406.    
407.     j = 0
408.     intDiffCount = 0
409.     lngAllFileSize = 0
410.    
411.     For i = 0 To UBound(bytFileData) - 7
412.         '一个字节一个字节的比较分隔符字节数组,如果找到,代表
413.        If ByteArraysAreEqual(CopyByteArray(bytFileData, i, 8), bytDelimiter)Then
414. '            Debug.Print "分隔符 offset : " & Hex$(i)
415.            'i的值是分隔符的位置
416.            
417.             ReDim Preserve lngFileSizeList(j)
418.             ReDim Preserve lngOffsetList(j)
419.             'ReDim Preserve bytThumbsData(5120, j)      '默认为5K，5*1024=5120
420.            ReDim Preserve bytThumbsData(8192, j)      '8K，8*1024=8192
421.            
422.             lngFileSizeList(j) = GetLongFromByteArray(bytFileData, i + 8)
423.             lngOffsetList(j) = i + 8 + 4
424.            
425.             '累加文件大小
426.            lngAllFileSize = lngAllFileSize + lngFileSizeList(j)
427.            
428.             '测试，调试，捕捉
429.            If lngOffsetList(j) = &H1F8CThen
430.                 Debug.Print lngOffsetList(j), lngFileSizeList(j)
431.             End If
432.            
433.             '增加 判断
434.            If GetIntegerFromByteArray(bytFileData, (i + 8 + 4 + lngFileSizeList(j)) - 2) = &HD9FFThen
435.             '如果在正确的位置上找到Jpg的文件尾标志，则正常
436.                '不知道使用二维的字节数组可否接收返回一个数组
437.                'bytThumbsData(0, j) = CopyByteArray(bytFileData, lngOffsetList(j), lngFileSizeList(j))
438.                '需采用传址方式,1维固定为5K字节
439.                CopyByteArrayRef bytFileData, lngOffsetList(j), lngFileSizeList(j), bytThumbsData, j
440.                
441.                 '然后就需要跳过这个文件数据，修改i的值
442.                'i = i + 8 + 4 + lngFileSizeList(j)
443.                '如果在文本尾结束后面紧跟就是分隔符的话，会导致跳过一个文件
444.                i = (i + 8 + 4 + lngFileSizeList(j)) - 1
445.                
446.             Else
447.                 intDiffCount = intDiffCount + 1
448. '                Debug.Print "此位置的数据不正确 " & Hex$(lngOffsetList(j))
449.                
450.                 lngDifferNum = 0    '在后面的查找之前先清零
451.                '查看数据得到，一般是少0x200/0x400字节
452.                '   For k = &H200 To &H400 Step &H200
453.                '   For k = &H200 To &H2600 Step &H200
454.                'For k = &H200 To &H3600 Step &H200
455.                '   发现1例：有个别间隔特别大，有0x8800 (8874),中间间隔了好几个jpg文件
456.                'For k = &H200 To &H9600 Step &H200
457.                For k = &H200To 38400 Step &H200
458.                 '发现一个问题，这个查找范围增加到&H9600，但是VB没有无符号数值类型，&H9600 = -27136
459.                '这样就会导致这个循环不会执行，程序运行结果自然就有问题了，实际上无符号数值 = 38400
460.                '两个解决方法：1是最方便，不用&16进制表示，直接使用对应的10进制值。
461.                '2,写一个函数，输入十六进制数值，输入无符号表示法的对应十进制数值
462.                
463.                     If GetIntegerFromByteArray(bytFileData, (i + 8 + 4 + lngFileSizeList(j) + k) - 2) = &HD9FFThen
464.                     '如果是指定位置找到Jpg文件尾标志，则记录差值，然后修正该项的文件大小值
465.                        lngDifferNum = k
466.                         ExitFor
467.                     End If
468.                 Next
469.                
470.                 '0x34,0x74,0xF4     相差0x40,0x80
471.                '要确定该位置的数据不是Jpg里的数据,然后就可以把该块位置的数据丢开
472.                '分辨时，应该选择固定的值来判别
473.                '1.先解决Jpg文件数据里夹杂着非Jpg数据，去除之
474.                '2.再解决jpg文件数据里包含着下一个甚至两个jpg文件数据的情况
475.                
476.                
477.                 If lngDifferNum > 0Then        '修正大小后，找到正确的文件尾
478.                '放弃对这个条件的限制，因为那种jpg文件数据包含jpg文件数据的情况是不符合这个条件，但是符合
479.                '下面这个在固定位置插入了其它的数据
480.                
481.                     '实际上这里处理不能简单的加上偏移，需要把插入的数据分离，再合成被切开的同一个文件
482.                    'lngFileSizeList(j) = lngFileSizeList(j) + lngDifferNum
483.                    
484.                     '查找固定的位置
485.                    lngDifferOffset = 0
486.                     'For k = &H34 To &H134 Step &H40
487.                    For k = &H34To &H204 Step &H40
488.                         'Debug.Print ByteArrayToStr(CopyByteArray(bytFileData, (i + 8 + 4) + k, 8))
489.                        'Debug.Print ByteArrayToStr(CopyByteArray(bytJPGHeader, k, 8))
490.                        
491.                         If Not ByteArraysAreEqual(CopyByteArray(bytFileData, (i + 8 + 4) + k, 8), CopyByteArray(bytJPGHeader, k, 8))Then
492.                        
493.                             '判断这8位是否是分隔符，是的话，就是包含了其它Jpg文件在内
494.                            If ByteArraysAreEqual(CopyByteArray(bytFileData, (i + 8 + 4) + k, 8), bytDelimiter)Then
495.                                 'MsgBox "包含了其它jpg数据"
496.                                blnIncludeJpg = True
497.                             EndIf
498.                            
499.                             lngDifferOffset = k
500.                             ExitFor
501.                         Else
502.                             '如果比较到前面到&H204字节还是相同的话，后面还要继续比较，判断是以0字节的多少为依据
503.                            'For l = &H204 To &H9F4 Step &H40
504.                            '判断的长度要到达文件头前定义的FileSize
505.                            For l = &H204To lngFileSizeList(j) Step &H40
506.                                 '判断依据1：读取16字节，如果0字节达到12位以上，则判断为插入数据
507.                                If GetZeroByteCount(CopyByteArray(bytFileData, (i + 8 + 4) + l, 16)) >= 12Then
508.                                     '判断这8位是否是分隔符，是的话，就是包含了其它Jpg文件在内
509.                                    If ByteArraysAreEqual(CopyByteArray(bytFileData, (i + 8 + 4) + l, 8), bytDelimiter)Then
510.                                         'MsgBox "包含了其它jpg数据"
511.                                        blnIncludeJpg = True
512.                                     End If
513.                                     lngDifferOffset = l
514.                                     Exit For
515.                                
516.                                 EndIf
517.                             Next
518.                        
519.                         End If
520.                     Next
521.                    
522.                     '对付，在插入非jpg数据后紧跟着jpg数据，要再重新搜一遍，确保不会漏掉jpg
523.                    For k = &H34To &H474 Step &H10
524.                         If ByteArraysAreEqual(CopyByteArray(bytFileData, (i + 8 + 4) + k, 8), bytDelimiter)Then
525.                             blnIncludeJpg = True    '还包含了其它jpg数据
526.                        End If
527.                     Next
528.                    
529.                     If lngDifferOffset > 0Then
530.                         '前面确定了插入数据的大小
531.                        
532.                         '如果是Jpg中间插入非Jpg数据，先复制前面一部分
533.                        CopyByteArrayRef bytFileData, lngOffsetList(j), lngDifferOffset, bytThumbsData, j
534.                         '再复制后面一部分
535.                        CopyByteArrayRef bytFileData, lngOffsetList(j) + lngDifferOffset + lngDifferNum, lngFileSizeList(j), bytThumbsData, j, lngDifferOffset
536.                        
537.                         If Not blnIncludeJpg Then  '如果没有包含jpg数据，则跳过文件的大小
538.                            i = i + 8 + 4 + lngFileSizeList(j)
539.                         Else
540.                         '因为包含着jpg数据，所以不能跳过那么多数据，会把包含的jpg文件跳过
541.                            i = i + 8 + 4 + lngDifferOffset - 1
542.                             blnIncludeJpg = False       '使用后重置为False
543.                        End If
544.                     Else
545.                         '这种情况还没看到执行过
546.                        i = i + 8 + 4
547.                     End If
548.                    
549.                 Else
550.                 '搜索还是没有找到，可能是那种文件数据只有几十个字节的类型
551.                    '碰到这种情况有两种做法：
552.                    '1.把lngFileSizeList项置0，在保存文件时跳过此项（文件名也跳过)
553.                    '2.按原样保存，查找分隔符位置，修正文件大小，
554.                    
555.                     i = i + 8 + 4
556.                 End If
557.                
558.             End If
559.            
560.             j = j + 1
561.        
562.         End If
563.     Next
564.    
565.     For i = 0 To UBound(lngOffsetList)
566.         '添加显示项目编号名、偏移、文件大小（因为文件名的分布不太规范，所以要最后才得出，不能同步得到）
567.        
568.         List1.AddItem "Thumb" & CStr(i + 1) & vbTab &"(" & Hex$(lngOffsetList(i)) & ")" _
569.                     & vbTab & "(" & Hex$(lngFileSizeList(i)) &")"
570.     Next
571.    
572.     List1.ListIndex = 0     '自动显示第1张图片
573.    
574. '    Me.Caption = "保存中..."
575.    
576.     Me.Caption = "完成!"
577.    
578.     lblInfo.Caption = "有差异的个数：" & intDiffCount & vbCrLf &"所有文件的总大小：" & lngAllFileSize
579.    
580.     'MsgBox "有差异的个数：" & intDiffCount
581. '    MsgBox "所有文件的总大小：" & lngAllFileSize
582. '    Debug.Print "所有文件的总大小：" & lngAllFileSize
583.    
584. End Sub
585.  
586. Sub InitData()
587.     'Init data
588.    bytDelimiter = SetByteArrayFromStr("0C00000001000000")
589.     '320个字节,&H140
590.    bytJPGHeader = SetByteArrayFromStr("FFD8FFE000104A46494600010101006000600000FFDB0043000302020302020303030304030304050805050404050A070706080C0A0C0C0B0A0B0B0D0E12100D0E110E0B0B1016101113141515150C0F171816141812141514FFDB00430103040405040509050509140D0B0D1414141414141414141414141414141414141414141414141414141414141414141414141414141414141414141414141414FFC00011080060006003012200021101031101FFC4001F0000010501010101010100000000000000000102030405060708090A0BFFC400B5100002010303020403050504040000017D01020300041105122131410613516107227114328191A1082342B1C11552D1F02433627282090A161718191A25262728292A3435363738393A434445464748494A535455565758595A636465666768696A737475767778797A" & _
591.     "838485868788898A92939495969798999AA2A3A4A5A6A7A8A9AAB2B3B4B5B6B7B8B9BAC2C3C4C5C6C7C8C9CAD2D3D4D5D6D7D8D9DAE1E2E3E4E5E6E7E8E9EAF1F2F3F4F5F6F7F8F9FAFFC4001F0100030101010101010101010000000000000102030405060708090A0BFFC400B51100020102040403040705040400010277000102031104052131061241510761711322328108144291A1B1C109233352F0156272D10A162434E125F11718191A262728292A35363738393A434445464748494A535455")
592.     '&H204 bytes
593.    'bytJPGHeader = SetByteArrayFromStr("")
594.    
595. End Sub
596.  
597. Private Sub Form_Load()
598. On Error GoTo Hell
599.  
600.     Call InitData
601.    
602.     If Len(Command$) > 0 Then
603.         strFilePath = Command
604.         If FileLen(strFilePath) > 0Then
605.             FileAndPath strFilePath, strFileName
606.             DoProcess
607.         End If
608.     Else
609.         ' set file association to .db
610.    End If
611.    
612.     Exit Sub
613.  
614. Hell:
615.     'MsgBox "ERROR: Invalid argument"
616.    MsgBox Err.Description, vbCritical, Err.Number
617.    
618. End Sub
619.  
620. Private Sub Form_OLEDragDrop(Data As DataObject, EffectAs Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
621.     'VbCFFiles 15 文件列表
622.    If Data.GetFormat(vbCFFiles)Then ' text = 1, url = 13, file = 15
623.        strFilePath = Data.Files(1)
624.         FileAndPath strFilePath, strFileName
625.         strFileName = LCase$(strFileName)
626.         If strFileName = "thumbs.db" Then
627.             DoProcess
628.         Else
629.             Me.Caption = "Must be a thumbs.db file"
630.         End If
631.     End If
632. End Sub
633.  
634. Private Sub FileAndPath(ByRef sPathAs String, Optional ByRef sFile As String)
635.     Dim i As Integer
636.     i = InStrRev(sPath, "\")
637.     sFile = Mid(sPath, i + 1)
638.     sPath = Mid(sPath, 1, i - 1)
639. End Sub
640.  
641.  
642. Private Sub List1_Click()
643.     Dim bytData() As Byte
644.     '正常连着的数据用的普通方式：
645.    'bytData = CopyByteArray(bytFileData, lngOffsetList(List1.ListIndex), lngFileSizeList(List1.ListIndex))
646.    
647.     '较通用的方法,首先处理后的图片数据都有序的放在bytThumbsData二维字节数组里
648.    bytData = CopyByte2Array(bytThumbsData, List1.ListIndex, 0, lngFileSizeList(List1.ListIndex))
649.    
650.     Picture1.Picture = LoadPicture()    '先清空
651.    If UBound(bytData) < 1 Then MsgBox"没有图片数据!", vbCritical: Exit Sub
652.    
653.     Picture1.Picture = BytesToPicture(bytData)
654.     txtPicWH.Text = Picture1.Width \ 15 & "," & Picture1.Height \ 15
655.     'txtPicWH.Text = Picture1.Picture.Width \ 15 & "," & Picture1.Picture.Height \ 15
656. '    Debug.Print Picture1.Width \ 15 & "," & Picture1.Height \ 15, Picture1.Picture.Width \ 15 & "," & Picture1.Picture.Height \ 15
657.    '96,96         169,169
658.    '61,96         107,169
659.  
660. End Sub
661.  
662. Private Sub List1_OLEDragDrop(Data As DataObject, EffectAs Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
663.     Call Form_OLEDragDrop(Data, Effect, Button, Shift, X, Y)
664.    
665. End Sub
666.  
667. Private Sub mnuAbout_Click()
668.     MsgBox "This program detects the beginning of a JPEG file inside the dragged file ends the JPEG at the point another one starts."
669.    
670. End Sub
671.  
672. Private Sub mnuMainMenu_SaveAllPic_Click()
673. '保存所有图片文件
674.    Dim i As Integer, j As Integer
675.     Dim bytData() As Byte
676.     Dim strPathArray() As String
677.     Dim strPath As String
678.    
679.     strPathArray = Split(strFilePath, "\")
680.     If Dir$(App.Path & "\" & strPathArray(UBound(strPathArray)) &"Thumbs\", vbDirectory) = "" Then
681.         strPath = App.Path & "\" & strPathArray(UBound(strPathArray)) &"Thumbs\"
682.     Else
683.         MsgBox "该目录已经存在,程序将自动重命名，加后缀值。", vbExclamation
684.         j = 0
685.         Do While True
686.             j = j + 1
687.             If Dir$(App.Path &"\" & strPathArray(UBound(strPathArray)) &"Thumbs" & CStr(j) & "\", vbDirectory) = "" Then
688.                 Exit Do
689.             End If
690.         Loop
691.         strPath = App.Path & "\" & strPathArray(UBound(strPathArray)) &"Thumbs" & CStr(j) & "\"
692.     End If
693.  
694.     For i = 0 To UBound(lngOffsetList)
695.         '较通用的方法,首先处理后的图片数据都有序的放在bytThumbsData二维字节数组里
696.        bytData = CopyByte2Array(bytThumbsData, i, 0, lngFileSizeList(i))
697.  
698.         '保存到Thumbs.db所在目录下
699.        'SetFileContents strFilePath & "\Thumbs\", CStr(i + 1) & ".jpg", bytData
700.        '保存到程序目录下
701.        '获取目录名
702.        SetFileContents strPath, CStr(i + 1) & ".jpg", bytData
703.     Next
704.     MsgBox "图片文件全部保存完毕！", vbInformation
705.    
706.  
707. End Sub
708.  
709. 'Private Sub mnuMainMenu_SaveAllPic_Click()
710. ''保存所有图片文件
711. '    Dim i As Integer, j As Integer
712. '    Dim bytData() As Byte
713. '    Dim strPathArray() As String
714. '    Dim strPath As String
715. '
716. '    strPathArray = Split(strFilePath, "\")
717. '    If Dir$(App.Path & "\" & strPathArray(UBound(strPathArray)) & "Thumbs\", vbDirectory) = "" Then
718. '        'SetFileContents App.Path & "\" & strPathArray(UBound(strPathArray)) & "Thumbs\", CStr(i + 1) & ".jpg", bytData
719. '        strPath = App.Path & "\" & strPathArray(UBound(strPathArray)) & "Thumbs\"
720. '    Else
721. '        MsgBox "该目录已经存在,程序将自动重命名，加后缀值。", vbExclamation
722. '        j = 0
723. '        Do While True
724. '            j = j + 1
725. '            If Dir$(App.Path & "\" & strPathArray(UBound(strPathArray)) & "Thumbs" & CStr(j) & "\", vbDirectory) = "" Then
726. '                Exit Do
727. '            End If
728. '        Loop
729. '        'SetFileContents App.Path & "\" & strPathArray(UBound(strPathArray)) & "Thumbs" & CStr(j) & "\", CStr(i + 1) & ".jpg", bytData
730. '        strPath = App.Path & "\" & strPathArray(UBound(strPathArray)) & "Thumbs" & CStr(j) & "\"
731. '    End If
732. '
733. '    For i = 0 To UBound(lngOffsetList)
734. '        bytData = CopyByteArray(bytFileData, lngOffsetList(i), lngFileSizeList(i))
735. '        '保存到Thumbs.db所在目录下
736. '        'SetFileContents strFilePath & "\Thumbs\", CStr(i + 1) & ".jpg", bytData
737. '        '保存到程序目录下
738. '        '获取目录名
739. '        SetFileContents strPath, CStr(i + 1) & ".jpg", bytData
740. '    Next
741. '    MsgBox "图片文件全部保存完毕！", vbInformation
742. '
743. '
744. 'End Sub
745. 'Download by http://www.bvbsoft.com
746. Private Sub mnuMainMenu_SaveOffset_Click()
747.     '保存偏移数据
748.    Dim i As Integer
749.    
750.     CDialog1.Filter = "文本文件(*.txt)|*.txt"
751.     CDialog1.ShowSave
752.     If CDialog1.FileName <> "" Then
753.         Open CDialog1.FileNameFor Output As #1
754.         For i = 0 To List1.ListCount
755.             Print #1, List1.List(i)
756.         Next
757.         Close #1
758.     End If
759. End Sub