Option Explicit
Private Type RealTagType
HeadFlag As String * 4
Length As Long
Title As String
Author As String
End Type
Public Function GetFileInfo(ByVal FileName As String, Optional ByRef Copyrights As String, Optional ByRef Author As String) As String
On Error Resume Next
Dim FreeIO As Integer
Dim Buffer(3) As Byte
Dim HeadBuffer As String
Dim HeadSPos As Integer
Dim HeadEPos As Integer
Dim Heads() As String
Dim NewHead As RealTagType
FreeIO = FreeFile
Open FileName For Binary As #FreeIO
Buffer(0) = Asc("C")
Buffer(1) = Asc("O")
Buffer(2) = Asc("N")
Buffer(3) = Asc("T")
HeadSPos = GetEndLocation(Buffer, FreeIO, FileLen(FileName), , 1024)
Get #FreeIO, HeadSPos + 1, NewHead
Close #FreeIO
If HeadSPos <> 0 Then
Heads = Split(NewHead.Author, Chr(0))
GetFileInfo = Heads(0)
Author = Mid(Heads(1), 2)
Copyrights = Mid(Heads(2), 2)
End If
End Function
Private Function GetEndLocation(ByVal EndWith As Variant, ByVal FileIO As Integer, ByVal FileSize As Long, _
Optional ByVal SearchReserve As Boolean = False, _
Optional ByVal ExpectByteSize As Long = 0) As Long
Dim Buffer() As Byte
Dim I As Long, J As Long
Dim Match As Boolean
Dim BufferTime As Long
Dim Pos As Long
Dim SearchFinish As Boolean
If ExpectByteSize = 0 Then
BufferTime = FileSize / (UBound(EndWith) + 1) / 10 'Must finish in 10 times
ReDim Buffer(BufferTime * (UBound(EndWith) + 1) - 1)
Else
ReDim Buffer(ExpectByteSize)
End If
' Then, we will not missing any data block match EndWith byte array.
' That's better.
If SearchReserve Then Seek FileIO, FileSize 'If want to search in reserved order. We move the file cursor to the last byte.
Do Until SearchFinish
If Not SearchReserve Then
Pos = Seek(FileIO)
Else
Pos = Seek(FileIO) - UBound(Buffer)
End If
Get #FileIO, Pos, Buffer
For I = LBound(Buffer) To UBound(Buffer) - UBound(EndWith)
Match = True
For J = LBound(EndWith) To UBound(EndWith)
If Buffer(I + J) <> EndWith(J) Then
Match = False
Exit For
End If
Next
If Match Then
GetEndLocation = Seek(FileIO) - UBound(Buffer) + I - 2
Exit Function
End If
Next
If SearchReserve Then
SearchFinish = (Seek(FileIO) = 0)
Else
SearchFinish = (Seek(FileIO) >= FileSize)
End If
If ExpectByteSize <> 0 Then SearchFinish = True
Loop