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

本文深入解读一款用于解析WinXP缓存缩略图的工具，包括其界面布局、工作流程和核心功能，如如何加载、分割、保存缓存中的缩略图数据，以及处理文件大小差异和非JPEG数据的问题。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "ComDlg32.OCX"
Begin VB.Form frmMain
Caption = "WinXP缓存缩略图查看提取工具"
ClientHeight = 5850
ClientLeft = 165
ClientTop = 555
ClientWidth = 7530
Icon = "frmMain.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
OLEDropMode = 1 'Manual
ScaleHeight = 5850
ScaleWidth = 7530
StartUpPosition = 2 '屏幕中心
Begin MSComDlg.CommonDialog CDialog1
Left = 6720
Top = 3240
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.TextBox txtPicWH
Height = 375
Left = 5880
TabIndex = 4
Top = 4320
Width = 1335
End
Begin VB.PictureBox Picture1
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 1695
Left = 5520
ScaleHeight = 1695
ScaleWidth = 1500
TabIndex = 2
Top = 600
Width = 1500
End
Begin VB.ListBox List1
Height = 4200
Left = 120
OLEDropMode = 1 'Manual
TabIndex = 1
Top = 600
Width = 4335
End
Begin VB.Label lblInfo
BorderStyle = 1 'Fixed Single
Height = 735
Left = 0
TabIndex = 5
Top = 5100
Width = 7215
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "图片宽度高度"
Height = 180
Left = 4560
TabIndex = 3
Top = 4440
Width = 1170
End
Begin VB.Label lblDrag
Alignment = 2 'Center
Caption = $"frmMain.frx":0442
Height = 375
Left = 120
TabIndex = 0
Top = 120
Width = 7335
End
Begin VB.Menu mnuMainMenu
Caption = "操作"
Begin VB.Menu mnuMainMenu_SaveAllPic
Caption = "保存所有图片文件"
End
Begin VB.Menu mnuMainMenu_SaveOffset
Caption = "保存偏移数据"
End
Begin VB.Menu mnuMainMenu_Sep1
Caption = "-"
End
Begin VB.Menu mnuAbout
Caption = "About"
End
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'Download by http://www.bvbsoft.com
Private strFilePath As String
Private strFileName As String
Private bytFileData() As Byte '读取文件数据
Private bytThumbsData() As Byte '读取缩略图文件数据，保存到文件,二维数组
'在用 Preserve 关键字时，只能改变多维数组中最后一维的上界；
'所以，第1维存放数据，范围就是0(缩略图Jpg大小最大不会超过5KB)，第2维根据项目的个数来表示的编号
'但是不能直接使用数组的形式来返回，必须用传址的方式返回
'还有一种方法，是记录每个图片文件项目的差异的偏移，及插入的非jpg数据块的大小
Dim lngDifferNumList() As Long '相差的数值
Dim lngDifferOffsetList() As Long '包含的非Jpg数据的偏移
Dim bytDelimiter() As Byte '0C00000001000000 '分隔符
Dim bytJPGHeader() As Byte 'XP生成的Thumbs.db里的Jpg文件头数据，是相同的
'可以采用测试，看解出来显示正常的Jpg文件是否文件头部分都是完全相同的
Dim blnIncludeJpg As Boolean '在Jpg的数据里包含了分隔符和其它jpg数据
Dim lngOffsetList() As Long '偏移列表
Dim lngFileSizeList() As Long '大小列表
'PSC原作者使用String类型来读取，这可能是英文操作系统上可以运行，但是在中文操作系统是错误的
Private strFileData As String
Private strThumbData() As String
'-------------------------------------------------------------------
'Private Sub DoProcess1()
'Dim i As Integer
' Me.Caption = "Loading"
' strFileData = GetFileContents(strFilePath & "\" & strFileName)
'
' Me.Caption = "Splitting"
' strThumbData = Split(strFileData, "???")
'
' Me.Caption = "Saving"
' For i = 1 To UBound(strThumbData)
' SetFileContents strFilePath & "\thumbs\", i & ".jpg", "??? & strThumbData(i)"
' Next i
' Me.Caption = "DONE!"
'End Sub
'
'Private Function GetFileContents1(ByVal sFile As String) As String
'On Error Resume Next
' Dim iFile As Integer, i As Long
' iFile = FreeFile
' Open sFile For Binary As iFile
' GetFileContents = Space(LOF(1))
' Get #1, , GetFileContents
' Close iFile
'End Function
'
'Private Sub SetFileContents1(ByVal sPath As String, ByVal sFile As String, ByVal contents As String)
' Dim iFile As Integer
' If Dir(sPath, vbDirectory) = "" Then MkDir sPath
' iFile = FreeFile
' Open sPath & sFile For Output As iFile
' Print #iFile, contents;
' Close iFile
'End Sub
'-------------------------------------------------------------------
Private Sub SetFileContents(ByVal strPath As String, ByVal strFile As String, ByteArray() As Byte)
'保存二进制文件
'参数：strPath - 带有\的路径名
' strFile - 不带路径的文件名
Dim intFileNum As Integer
If Dir(strPath, vbDirectory) = "" Then MkDir strPath
intFileNum = FreeFile
Open strPath & strFile For Binary As intFileNum
Put #intFileNum, , ByteArray
Close intFileNum
End Sub
Private Function GetFileContents(ByVal strFile As String) As Byte()
'获取整个二进制文件内容
On Error Resume Next
Dim intFileNum As Integer
intFileNum = FreeFile
Open strFile For Binary Access Read As #intFileNum
ReDim GetFileContents(LOF(intFileNum) - 1)
Get #intFileNum, , GetFileContents
Close intFileNum
End Function
Private Sub DoProcess1()
'Version 1.0
'因为没有Thumbs.db的详细文件格式资料,无法获取文件的个数
'现在这个版本有一个问题，会有些文件看不到，因为查看文件内容发现，中间有些Jpg文件很短，只有几百字节，
'与文件数据前的文件大小不符合,这样就会跳过一个文件，导致漏掉文件
Dim i As Long
Dim j As Long
Me.Caption = "装入中..."
bytFileData = GetFileContents(strFilePath & "\" & strFileName)
' Me.Caption = "分割中..."
j = 0
For i = 0 To UBound(bytFileData) - 7
'一个字节一个字节的比较分隔符字节数组,如果找到,代表
If ByteArraysAreEqual(CopyByteArray(bytFileData, i, 8), bytDelimiter) Then
' Debug.Print "分隔符 offset : " & Hex$(i)
ReDim Preserve lngFileSizeList(j)
ReDim Preserve lngOffsetList(j)
lngFileSizeList(j) = GetLongFromByteArray(bytFileData, i + 8)
lngOffsetList(j) = i + 8 + 4
'然后就需要跳过这个文件数据，修改i的值
i = i + 8 + 4 + lngFileSizeList(j)
j = j + 1
End If
Next
For i = 0 To UBound(lngOffsetList)
List1.AddItem "Thumb" & CStr(i + 1) & vbTab & "(" & Hex$(lngOffsetList(i)) & ")"
Next
' Me.Caption = "保存中..."
Me.Caption = "完成!"
End Sub
Private Sub DoProcess2()
'Version 2.0
'因为没有Thumbs.db的详细文件格式资料,无法获取文件的个数
'现在这个版本有一个问题，会有些文件看不到，因为查看文件内容发现，中间有些Jpg文件很短，只有几百字节，
'与文件数据前的文件大小不符合,这样就会跳过一个文件，导致漏掉文件
'----------
'增加一个判断，每找到一个标志，跳过文件长度时，先判断该长度的文件尾是不是Jpg的文件尾标志，如果不是
'则从之前的位置继续搜索
'一种情况：就是4位字节文件大小的值，小于实际的文件大小值，这就需要搜索修正
'在Thumbs.db文件里找到了全部对应文件的文件名，是用Unicode字符存储在里面的,有的是单独的一个，有的是几个连续一起
Dim i As Long
Dim j As Long '包含的图片个数
Dim k As Long
Dim intDiffCount As Integer '有差异的项个数
Dim lngDifferNum As Long '相差的数值
Dim lngDifferOffset As Long '包含的非Jpg数据的偏移
Dim lngAllFileSize As Long '所有包含的Jpg文件加起来的大小
Me.Caption = "装入中..."
bytFileData = GetFileContents(strFilePath & "\" & strFileName)
' Me.Caption = "分割中..."
List1.Clear
j = 0
intDiffCount = 0
lngAllFileSize = 0
For i = 0 To UBound(bytFileData) - 7
'一个字节一个字节的比较分隔符字节数组,如果找到,代表
If ByteArraysAreEqual(CopyByteArray(bytFileData, i, 8), bytDelimiter) Then
' Debug.Print "分隔符 offset : " & Hex$(i)
ReDim Preserve lngFileSizeList(j)
ReDim Preserve lngOffsetList(j)
ReDim Preserve bytThumbsData(5120, j) '默认为5K，5*1024=5120
lngFileSizeList(j) = GetLongFromByteArray(bytFileData, i + 8)
lngOffsetList(j) = i + 8 + 4
'累加文件大小
lngAllFileSize = lngAllFileSize + lngFileSizeList(j)
'增加判断
If GetIntegerFromByteArray(bytFileData, (i + 8 + 4 + lngFileSizeList(j)) - 2) = &HD9FF Then
'如果在正确的位置上找到Jpg的文件尾标志，则正常
'不知道使用二维的字节数组可否接收返回一个数组
'bytThumbsData(0, j) = CopyByteArray(bytFileData, lngOffsetList(j), lngFileSizeList(j))
'需采用传址方式,1维固定为5K字节
CopyByteArrayRef bytFileData, lngOffsetList(j), lngFileSizeList(j), bytThumbsData, j
'然后就需要跳过这个文件数据，修改i的值
i = i + 8 + 4 + lngFileSizeList(j)
Else
intDiffCount = intDiffCount + 1
' Debug.Print "此位置的数据不正确 " & Hex$(lngOffsetList(j))
lngDifferNum = 0 '在后面的查找之前先清零
'查看数据得到，一般是少0x200/0x400字节
For k = &H200 To &H400 Step &H200
If GetIntegerFromByteArray(bytFileData, (i + 8 + 4 + lngFileSizeList(j) + k) - 2) = &HD9FF Then
'如果是指定位置找到Jpg文件尾标志，则记录差值，然后修正该项的文件大小值
lngDifferNum = k
Exit For
End If
Next
'0x34,0x74,0xF4 相差0x40,0x80
'要确定该位置的数据不是Jpg里的数据,然后就可以把该块位置的数据丢开
'分辨时，应该选择固定的值来判别
'1.先解决Jpg文件数据里夹杂着非Jpg数据，去除之
'2.再解决jpg文件数据里包含着下一个甚至两个jpg文件数据的情况
If lngDifferNum > 0 Then '修正大小后，找到正确的文件尾
'实际上这里处理不能简单的加上偏移，需要把插入的数据分离，再合成被切开的同一个文件
'lngFileSizeList(j) = lngFileSizeList(j) + lngDifferNum
'查找固定的位置
lngDifferOffset = 0
For k = &H34 To &H134 Step &H40
Debug.Print ByteArrayToStr(CopyByteArray(bytFileData, (i + 8 + 4) + k, 8))
Debug.Print ByteArrayToStr(CopyByteArray(bytJPGHeader, k, 8))
If Not ByteArraysAreEqual(CopyByteArray(bytFileData, (i + 8 + 4) + k, 8), CopyByteArray(bytJPGHeader, k, 8)) Then
lngDifferOffset = k
Exit For
End If
Next
If lngDifferOffset > 0 Then
'如果是Jpg中间插入非Jpg数据，先复制前面一部分
' CopyByteArrayRef bytFileData, lngOffsetList(j), lngDifferOffset - 1, bytThumbsData, j
CopyByteArrayRef bytFileData, lngOffsetList(j), lngDifferOffset, bytThumbsData, j
'再复制后面一部分
' CopyByteArrayRef bytFileData, lngOffsetList(j) + lngDifferOffset + lngDifferNum - 1, lngFileSizeList(j) - lngDifferOffset - 1, bytThumbsData, j, lngDifferOffset
CopyByteArrayRef bytFileData, lngOffsetList(j) + lngDifferOffset + lngDifferNum, lngFileSizeList(j), bytThumbsData, j, lngDifferOffset
i = i + 8 + 4 + lngFileSizeList(j)
Else
i = i + 8 + 4
End If
Else
'搜索还是没有找到，可能是那种文件数据只有几十个字节的类型
'碰到这种情况有两种做法：
'1.把lngFileSizeList项置0，在保存文件时跳过此项（文件名也跳过)
'2.按原样保存，查找分隔符位置，修正文件大小，
i = i + 8 + 4
End If
End If
j = j + 1
End If
Next
For i = 0 To UBound(lngOffsetList)
'添加显示项目编号名、偏移、文件大小（因为文件名的分布不太规范，所以要最后才得出，不能同步得到）
List1.AddItem "Thumb" & CStr(i + 1) & vbTab & "(" & Hex$(lngOffsetList(i)) & ")" _
& vbTab & "(" & Hex$(lngFileSizeList(i)) & ")"
Next
' Me.Caption = "保存中..."
Me.Caption = "完成!"
lblInfo.Caption = "有差异的个数：" & intDiffCount & vbCrLf & "所有文件的总大小：" & lngAllFileSize
'MsgBox "有差异的个数：" & intDiffCount
'MsgBox "所有文件的总大小：" & lngAllFileSize
' Debug.Print "所有文件的总大小：" & lngAllFileSize
End Sub
Private Sub DoProcess()
'Version 3.0
'因为没有Thumbs.db的详细文件格式资料,无法获取文件的个数
'现在这个版本有一个问题，会有些文件看不到，因为查看文件内容发现，中间有些Jpg文件很短，只有几百字节，
'与文件数据前的文件大小不符合,这样就会跳过一个文件，导致漏掉文件
'----------
'增加一个判断，每找到一个标志，跳过文件长度时，先判断该长度的文件尾是不是Jpg的文件尾标志，如果不是
'则从之前的位置继续搜索
'一种情况：就是4位字节文件大小的值，小于实际的文件大小值，这就需要搜索修正
'在Thumbs.db文件里找到了全部对应文件的文件名，是用Unicode字符存储在里面的,有的是单独的一个，有的是几个连续一起
Dim i As Long
Dim j As Long '包含的图片个数
Dim k As Long
Dim l As Long
Dim intDiffCount As Integer '有差异的项个数
Dim lngDifferNum As Long '相差的数值
Dim lngDifferOffset As Long '包含的非Jpg数据的偏移
Dim lngAllFileSize As Long '所有包含的Jpg文件加起来的大小
Me.Caption = "装入中..."
bytFileData = GetFileContents(strFilePath & "\" & strFileName)
' Me.Caption = "分割中..."
List1.Clear
j = 0
intDiffCount = 0
lngAllFileSize = 0
For i = 0 To UBound(bytFileData) - 7
'一个字节一个字节的比较分隔符字节数组,如果找到,代表
If ByteArraysAreEqual(CopyByteArray(bytFileData, i, 8), bytDelimiter) Then
' Debug.Print "分隔符 offset : " & Hex$(i)
'i的值是分隔符的位置
ReDim Preserve lngFileSizeList(j)
ReDim Preserve lngOffsetList(j)
'ReDim Preserve bytThumbsData(5120, j) '默认为5K，5*1024=5120
ReDim Preserve bytThumbsData(8192, j) '8K，8*1024=8192
lngFileSizeList(j) = GetLongFromByteArray(bytFileData, i + 8)
lngOffsetList(j) = i + 8 + 4
'累加文件大小
lngAllFileSize = lngAllFileSize + lngFileSizeList(j)
'测试，调试，捕捉
If lngOffsetList(j) = &H1F8C Then
Debug.Print lngOffsetList(j), lngFileSizeList(j)
End If
'增加判断
If GetIntegerFromByteArray(bytFileData, (i + 8 + 4 + lngFileSizeList(j)) - 2) = &HD9FF Then
'如果在正确的位置上找到Jpg的文件尾标志，则正常
'不知道使用二维的字节数组可否接收返回一个数组
'bytThumbsData(0, j) = CopyByteArray(bytFileData, lngOffsetList(j), lngFileSizeList(j))
'需采用传址方式,1维固定为5K字节
CopyByteArrayRef bytFileData, lngOffsetList(j), lngFileSizeList(j), bytThumbsData, j
'然后就需要跳过这个文件数据，修改i的值
'i = i + 8 + 4 + lngFileSizeList(j)
'如果在文本尾结束后面紧跟就是分隔符的话，会导致跳过一个文件
i = (i + 8 + 4 + lngFileSizeList(j)) - 1
Else
intDiffCount = intDiffCount + 1
' Debug.Print "此位置的数据不正确 " & Hex$(lngOffsetList(j))
lngDifferNum = 0 '在后面的查找之前先清零
'查看数据得到，一般是少0x200/0x400字节
' For k = &H200 To &H400 Step &H200
' For k = &H200 To &H2600 Step &H200
'For k = &H200 To &H3600 Step &H200
' 发现1例：有个别间隔特别大，有0x8800 (8874),中间间隔了好几个jpg文件
'For k = &H200 To &H9600 Step &H200
For k = &H200 To 38400 Step &H200
'发现一个问题，这个查找范围增加到&H9600，但是VB没有无符号数值类型，&H9600 = -27136
'这样就会导致这个循环不会执行，程序运行结果自然就有问题了，实际上无符号数值 = 38400
'两个解决方法：1是最方便，不用&16进制表示，直接使用对应的10进制值。
'2,写一个函数，输入十六进制数值，输入无符号表示法的对应十进制数值
If GetIntegerFromByteArray(bytFileData, (i + 8 + 4 + lngFileSizeList(j) + k) - 2) = &HD9FF Then
'如果是指定位置找到Jpg文件尾标志，则记录差值，然后修正该项的文件大小值
lngDifferNum = k
Exit For
End If
Next
'0x34,0x74,0xF4 相差0x40,0x80
'要确定该位置的数据不是Jpg里的数据,然后就可以把该块位置的数据丢开
'分辨时，应该选择固定的值来判别
'1.先解决Jpg文件数据里夹杂着非Jpg数据，去除之
'2.再解决jpg文件数据里包含着下一个甚至两个jpg文件数据的情况
If lngDifferNum > 0 Then '修正大小后，找到正确的文件尾
'放弃对这个条件的限制，因为那种jpg文件数据包含jpg文件数据的情况是不符合这个条件，但是符合
'下面这个在固定位置插入了其它的数据
'实际上这里处理不能简单的加上偏移，需要把插入的数据分离，再合成被切开的同一个文件
'lngFileSizeList(j) = lngFileSizeList(j) + lngDifferNum
'查找固定的位置
lngDifferOffset = 0
'For k = &H34 To &H134 Step &H40
For k = &H34 To &H204 Step &H40
'Debug.Print ByteArrayToStr(CopyByteArray(bytFileData, (i + 8 + 4) + k, 8))
'Debug.Print ByteArrayToStr(CopyByteArray(bytJPGHeader, k, 8))
If Not ByteArraysAreEqual(CopyByteArray(bytFileData, (i + 8 + 4) + k, 8), CopyByteArray(bytJPGHeader, k, 8)) Then
'判断这8位是否是分隔符，是的话，就是包含了其它Jpg文件在内
If ByteArraysAreEqual(CopyByteArray(bytFileData, (i + 8 + 4) + k, 8), bytDelimiter) Then
'MsgBox "包含了其它jpg数据"
blnIncludeJpg = True
End If
lngDifferOffset = k
Exit For
Else
'如果比较到前面到&H204字节还是相同的话，后面还要继续比较，判断是以0字节的多少为依据
'For l = &H204 To &H9F4 Step &H40
'判断的长度要到达文件头前定义的FileSize
For l = &H204 To lngFileSizeList(j) Step &H40
'判断依据1：读取16字节，如果0字节达到12位以上，则判断为插入数据
If GetZeroByteCount(CopyByteArray(bytFileData, (i + 8 + 4) + l, 16)) >= 12 Then
'判断这8位是否是分隔符，是的话，就是包含了其它Jpg文件在内
If ByteArraysAreEqual(CopyByteArray(bytFileData, (i + 8 + 4) + l, 8), bytDelimiter) Then
'MsgBox "包含了其它jpg数据"
blnIncludeJpg = True
End If
lngDifferOffset = l
Exit For
End If
Next
End If
Next
'对付，在插入非jpg数据后紧跟着jpg数据，要再重新搜一遍，确保不会漏掉jpg
For k = &H34 To &H474 Step &H10
If ByteArraysAreEqual(CopyByteArray(bytFileData, (i + 8 + 4) + k, 8), bytDelimiter) Then
blnIncludeJpg = True '还包含了其它jpg数据
End If
Next
If lngDifferOffset > 0 Then
'前面确定了插入数据的大小
'如果是Jpg中间插入非Jpg数据，先复制前面一部分
CopyByteArrayRef bytFileData, lngOffsetList(j), lngDifferOffset, bytThumbsData, j
'再复制后面一部分
CopyByteArrayRef bytFileData, lngOffsetList(j) + lngDifferOffset + lngDifferNum, lngFileSizeList(j), bytThumbsData, j, lngDifferOffset
If Not blnIncludeJpg Then '如果没有包含jpg数据，则跳过文件的大小
i = i + 8 + 4 + lngFileSizeList(j)
Else
'因为包含着jpg数据，所以不能跳过那么多数据，会把包含的jpg文件跳过
i = i + 8 + 4 + lngDifferOffset - 1
blnIncludeJpg = False '使用后重置为False
End If
Else
'这种情况还没看到执行过
i = i + 8 + 4
End If
Else
'搜索还是没有找到，可能是那种文件数据只有几十个字节的类型
'碰到这种情况有两种做法：
'1.把lngFileSizeList项置0，在保存文件时跳过此项（文件名也跳过)
'2.按原样保存，查找分隔符位置，修正文件大小，
i = i + 8 + 4
End If
End If
j = j + 1
End If
Next
For i = 0 To UBound(lngOffsetList)
'添加显示项目编号名、偏移、文件大小（因为文件名的分布不太规范，所以要最后才得出，不能同步得到）
List1.AddItem "Thumb" & CStr(i + 1) & vbTab & "(" & Hex$(lngOffsetList(i)) & ")" _
& vbTab & "(" & Hex$(lngFileSizeList(i)) & ")"
Next
List1.ListIndex = 0 '自动显示第1张图片
' Me.Caption = "保存中..."
Me.Caption = "完成!"
lblInfo.Caption = "有差异的个数：" & intDiffCount & vbCrLf & "所有文件的总大小：" & lngAllFileSize
'MsgBox "有差异的个数：" & intDiffCount
' MsgBox "所有文件的总大小：" & lngAllFileSize
' Debug.Print "所有文件的总大小：" & lngAllFileSize
End Sub
Sub InitData()
'Init data
bytDelimiter = SetByteArrayFromStr("0C00000001000000")
'320个字节,&H140
bytJPGHeader = SetByteArrayFromStr("FFD8FFE000104A46494600010101006000600000FFDB0043000302020302020303030304030304050805050404050A070706080C0A0C0C0B0A0B0B0D0E12100D0E110E0B0B1016101113141515150C0F171816141812141514FFDB00430103040405040509050509140D0B0D1414141414141414141414141414141414141414141414141414141414141414141414141414141414141414141414141414FFC00011080060006003012200021101031101FFC4001F0000010501010101010100000000000000000102030405060708090A0BFFC400B5100002010303020403050504040000017D01020300041105122131410613516107227114328191A1082342B1C11552D1F02433627282090A161718191A25262728292A3435363738393A434445464748494A535455565758595A636465666768696A737475767778797A" & _
"838485868788898A92939495969798999AA2A3A4A5A6A7A8A9AAB2B3B4B5B6B7B8B9BAC2C3C4C5C6C7C8C9CAD2D3D4D5D6D7D8D9DAE1E2E3E4E5E6E7E8E9EAF1F2F3F4F5F6F7F8F9FAFFC4001F0100030101010101010101010000000000000102030405060708090A0BFFC400B51100020102040403040705040400010277000102031104052131061241510761711322328108144291A1B1C109233352F0156272D10A162434E125F11718191A262728292A35363738393A434445464748494A535455")
'&H204 bytes
'bytJPGHeader = SetByteArrayFromStr("")
End Sub
Private Sub Form_Load()
On Error GoTo Hell
Call InitData
If Len(Command$) > 0 Then
strFilePath = Command
If FileLen(strFilePath) > 0 Then
FileAndPath strFilePath, strFileName
DoProcess
End If
Else
' set file association to .db
End If
Exit Sub
Hell:
'MsgBox "ERROR: Invalid argument"
MsgBox Err.Description, vbCritical, Err.Number
End Sub
Private Sub Form_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
'VbCFFiles 15 文件列表
If Data.GetFormat(vbCFFiles) Then ' text = 1, url = 13, file = 15
strFilePath = Data.Files(1)
FileAndPath strFilePath, strFileName
strFileName = LCase$(strFileName)
If strFileName = "thumbs.db" Then
DoProcess
Else
Me.Caption = "Must be a thumbs.db file"
End If
End If
End Sub
Private Sub FileAndPath(ByRef sPath As String, Optional ByRef sFile As String)
Dim i As Integer
i = InStrRev(sPath, "\")
sFile = Mid(sPath, i + 1)
sPath = Mid(sPath, 1, i - 1)
End Sub
Private Sub List1_Click()
Dim bytData() As Byte
'正常连着的数据用的普通方式：
'bytData = CopyByteArray(bytFileData, lngOffsetList(List1.ListIndex), lngFileSizeList(List1.ListIndex))
'较通用的方法,首先处理后的图片数据都有序的放在bytThumbsData二维字节数组里
bytData = CopyByte2Array(bytThumbsData, List1.ListIndex, 0, lngFileSizeList(List1.ListIndex))
Picture1.Picture = LoadPicture() '先清空
If UBound(bytData) < 1 Then MsgBox "没有图片数据!", vbCritical: Exit Sub
Picture1.Picture = BytesToPicture(bytData)
txtPicWH.Text = Picture1.Width \ 15 & "," & Picture1.Height \ 15
'txtPicWH.Text = Picture1.Picture.Width \ 15 & "," & Picture1.Picture.Height \ 15
' Debug.Print Picture1.Width \ 15 & "," & Picture1.Height \ 15, Picture1.Picture.Width \ 15 & "," & Picture1.Picture.Height \ 15
'96,96 169,169
'61,96 107,169
End Sub
Private Sub List1_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
Call Form_OLEDragDrop(Data, Effect, Button, Shift, X, Y)
End Sub
Private Sub mnuAbout_Click()
MsgBox "This program detects the beginning of a JPEG file inside the dragged file ends the JPEG at the point another one starts."
End Sub
Private Sub mnuMainMenu_SaveAllPic_Click()
'保存所有图片文件
Dim i As Integer, j As Integer
Dim bytData() As Byte
Dim strPathArray() As String
Dim strPath As String
strPathArray = Split(strFilePath, "\")
If Dir$(App.Path & "\" & strPathArray(UBound(strPathArray)) & "Thumbs\", vbDirectory) = "" Then
strPath = App.Path & "\" & strPathArray(UBound(strPathArray)) & "Thumbs\"
Else
MsgBox "该目录已经存在,程序将自动重命名，加后缀值。", vbExclamation
j = 0
Do While True
j = j + 1
If Dir$(App.Path & "\" & strPathArray(UBound(strPathArray)) & "Thumbs" & CStr(j) & "\", vbDirectory) = "" Then
Exit Do
End If
Loop
strPath = App.Path & "\" & strPathArray(UBound(strPathArray)) & "Thumbs" & CStr(j) & "\"
End If
For i = 0 To UBound(lngOffsetList)
'较通用的方法,首先处理后的图片数据都有序的放在bytThumbsData二维字节数组里
bytData = CopyByte2Array(bytThumbsData, i, 0, lngFileSizeList(i))
'保存到Thumbs.db所在目录下
'SetFileContents strFilePath & "\Thumbs\", CStr(i + 1) & ".jpg", bytData
'保存到程序目录下
'获取目录名
SetFileContents strPath, CStr(i + 1) & ".jpg", bytData
Next
MsgBox "图片文件全部保存完毕！", vbInformation
End Sub
'Private Sub mnuMainMenu_SaveAllPic_Click()
''保存所有图片文件
' Dim i As Integer, j As Integer
' Dim bytData() As Byte
' Dim strPathArray() As String
' Dim strPath As String
'
' strPathArray = Split(strFilePath, "\")
' If Dir$(App.Path & "\" & strPathArray(UBound(strPathArray)) & "Thumbs\", vbDirectory) = "" Then
' 'SetFileContents App.Path & "\" & strPathArray(UBound(strPathArray)) & "Thumbs\", CStr(i + 1) & ".jpg", bytData
' strPath = App.Path & "\" & strPathArray(UBound(strPathArray)) & "Thumbs\"
' Else
' MsgBox "该目录已经存在,程序将自动重命名，加后缀值。", vbExclamation
' j = 0
' Do While True
' j = j + 1
' If Dir$(App.Path & "\" & strPathArray(UBound(strPathArray)) & "Thumbs" & CStr(j) & "\", vbDirectory) = "" Then
' Exit Do
' End If
' Loop
' 'SetFileContents App.Path & "\" & strPathArray(UBound(strPathArray)) & "Thumbs" & CStr(j) & "\", CStr(i + 1) & ".jpg", bytData
' strPath = App.Path & "\" & strPathArray(UBound(strPathArray)) & "Thumbs" & CStr(j) & "\"
' End If
'
' For i = 0 To UBound(lngOffsetList)
' bytData = CopyByteArray(bytFileData, lngOffsetList(i), lngFileSizeList(i))
' '保存到Thumbs.db所在目录下
' 'SetFileContents strFilePath & "\Thumbs\", CStr(i + 1) & ".jpg", bytData
' '保存到程序目录下
' '获取目录名
' SetFileContents strPath, CStr(i + 1) & ".jpg", bytData
' Next
' MsgBox "图片文件全部保存完毕！", vbInformation
'
'
'End Sub
'Download by http://www.bvbsoft.com
Private Sub mnuMainMenu_SaveOffset_Click()
'保存偏移数据
Dim i As Integer
CDialog1.Filter = "文本文件(*.txt)|*.txt"
CDialog1.ShowSave
If CDialog1.FileName <> "" Then
Open CDialog1.FileName For Output As #1
For i = 0 To List1.ListCount
Print #1, List1.List(i)
Next
Close #1
End If
End Sub