Attribute VB_Name = "Id3Module"
Public Type Id3v1                 'This type is standard for
Title As String * 30            ' Id3 Tags
Artist As String * 30           ' Although later versions
Album As String * 30            ' use comments for 28 bytes
sYear  As String * 4            ' and they use the 2 remaining  bytes for "TrackNumber"!
Comments As String * 30
Genre As Byte
End Type

Public Type Id3                 'This type is standard for
Title As String           ' Id3 Tags
Artist As String          ' Although later versions
Album As String           ' use comments for 28 bytes
sYear  As String
Lyric As String      ' and they use the 2 remaining  bytes for "TrackNumber"!
track As String
Comment As String
Genre As String
End Type

Public Type Id3v2Header                 'This type is standard for
Identifier As String * 3           ' Id3 Tags
version1 As Byte                ' Although later versions
version2 As Byte                ' Although later versions
flags As Byte                ' Although later versions
Size(3) As Byte                ' Although later versions
End Type

Public Type ID3v2FrameHeader
ID As String * 4
Size(3) As Byte
flags As String * 2
End Type

Public Type ID3v2Frame
Encoding As Byte
info As String
End Type



Public id3Info As Id3           ' Declare a variable as the id3 type

Public Function GetId3v1(Filename As String)
On Error Resume Next
Dim TaG As String * 3, sTitle As String * 30, sYear As String * 4
Dim tempInfo As Id3v1                        ' We use this variable to make sure the file has an ID3TAG
Open Filename For Binary As #1      ' we open the file as binary for total control (we need it for the Genre part)
Get #1, FileLen(Filename) - 127, TaG    ' Id3 tags are at the end of the mp3 file(and as the type shows it is 128 bytes)
If TaG = "TAG" Then                     ' "TAG" is put at position filesize-127 to show that this file indeed contains an Id3
Get #1, FileLen(Filename) - 124, tempInfo ' if the file has a tag, we put it into our earlier declared variable id3info
id3Info.Title = Trim(Replace(tempInfo.Title, vbNullChar, "")) ' if the "TAG" wasnt at position filesize-127
id3Info.Album = Trim(Replace(tempInfo.Album, vbNullChar, ""))
id3Info.Artist = Trim(Replace(tempInfo.Artist, vbNullChar, ""))
id3Info.sYear = Trim(Replace(tempInfo.sYear, vbNullChar, ""))
Else
id3Info.Title = sTitle ' if the "TAG" wasnt at position filesize-127
id3Info.Album = sTitle
id3Info.Artist = sTitle
id3Info.sYear = sYear
End If
Close #1 ' close the file

'If id3Info.Title = sTitle Or Trim(id3Info.Title) = "" Then id3Info.Title = SplitTitle(Filename, "\")
If id3Info.Album = sTitle Or Trim(id3Info.Album) = "" Then id3Info.Album = "Inconnu"
If id3Info.Artist = sTitle Or Trim(id3Info.Artist) = "" Then id3Info.Artist = "Inconnu"
If id3Info.sYear = sYear Or Trim(id3Info.sYear) = "" Then id3Info.sYear = "xxxx"

End Function
Public Function GetId3(Filename As String)
On Error Resume Next
Dim TagHeader As Id3v2Header, FrameHeader As ID3v2FrameHeader
Dim frame As ID3v2Frame
Dim x As String
Dim pointer As Integer, Size As Long
Dim Framesize As Long, FrameEncode As Integer
Dim v As Long
Dim picture_data As String
Dim mimenew As MIMEEDIT.MIMEEDIT
Dim TagId As String
id3Info.Album = ""
id3Info.Artist = ""
id3Info.sYear = ""
id3Info.Title = ""
 ' We use this variable to make sure the file has an ID3TAG
Open Filename For Binary As #1      ' we open the file as binary for total control (we need it for the Genre part)
Get #1, , TagHeader    ' Id3 tags are at the end of the mp3 file(and as the type shows it is 128 bytes)
x = TagHeader.Identifier
Size = BitsToLow(TagHeader.Size)
v = 11
If TagHeader.Identifier = "ID3" Then
Do While v < Size + 10
Get #1, v, FrameHeader ' Id3 tags are at the end of the mp3 file(and as the type shows it is 128 bytes)
v = v + 10
TagId = FrameHeader.ID
If Not isID3v2Tag(TagId) Then GoTo Sortie_mv_Tag
B = FrameHeader.flags
Framesize = BitsToLowFrame(FrameHeader.Size)
x = String(Framesize - 1, vbNullChar)
Get #1, v, frame.Encoding
Get #1, v + 1, x
frame.info = x
DD = frame.Encoding
GoSub Dispatch
v = v + Framesize
Loop
Else
Close #1
GetId3v1 Filename
End If

Sortie_mv_Tag:
Close #1
If id3Info.Artist = "" And id3Info.sYear = "" And id3Info.Album = "" And id3Info.Title = "" Then GetId3v1 Filename
'If id3Info.Title = "" Then id3Info.Title = SplitTitle(Filename, "\")
If id3Info.Album = "" Then id3Info.Album = "Inconnu"
If id3Info.Artist = "" Then id3Info.Artist = "Inconnu"
If id3Info.sYear = "" Then id3Info.sYear = "xxxx"
Exit Function

Dispatch:
Select Case TagId
    Case "TPE1"
        If DD = 1 Then
        D = Replace(frame.info, vbNullChar, "")
        D = Mid(D, 3, Len(D) - 2)
        ElseIf DD = 0 Then
        D = frame.info
        End If
        id3Info.Artist = Trim(D)
        
    Case "TYER"
        If DD = 1 Then
        D = Replace(frame.info, vbNullChar, "")
        D = Mid(D, 3, Len(D) - 2)
        ElseIf DD = 0 Then
        D = frame.info
        End If
        id3Info.sYear = Trim(D)
        
    Case "TIT2"
        If DD = 1 Then
        D = Replace(frame.info, vbNullChar, "")
        D = Mid(D, 3, Len(D) - 2)
        ElseIf DD = 0 Then
        D = frame.info
        End If
        id3Info.Title = Trim(D)
        
    Case "TALB"
        If DD = 1 Then
        D = Replace(frame.info, vbNullChar, "")
        D = Mid(D, 3, Len(D) - 2)
        ElseIf DD = 0 Then
        D = frame.info
        End If
        id3Info.Album = Trim(D)
        
    Case "USLT"
        lang = Mid(frame.info, 1, 3)
       
        If DD = 1 Then
        endshortdesc = 4
        Do While Right(shortdesc, 2) <> vbNullChar & vbNullChar
        shortdesc = Mid(frame.info, 4, endshortdesc - 3)
        endshortdesc = endshortdesc + 1
        Loop
        shortdesc = Replace(shortdesc, vbNullChar, "")
        shortdesc = Mid(shortdesc, 3, Len(shortdesc) - 2)
        D = Mid(frame.info, endshortdesc)
        D = Replace(D, vbNullChar, "")
        D = Mid(D, 3, Len(D) - 2)
        ElseIf DD = 0 Then
        endshortdesc = 4
        Do While Right(shortdesc, 1) <> vbNullChar
        shortdesc = Mid(frame.info, 4, endshortdesc - 3)
        endshortdesc = endshortdesc + 1
        Loop
        shortdesc = Replace(shortdesc, vbNullChar, "")
        shortdesc = Mid(shortdesc, 3, Len(shortdesc) - 2)
        D = Mid(frame.info, endshortdesc)
        End If
        id3Info.Lyric = D
        
    Case "TRCK"
        If DD = 1 Then
        D = Replace(frame.info, vbNullChar, "")
        D = Mid(D, 3, Len(D) - 2)
        ElseIf DD = 0 Then
        D = Replace(frame.info, vbNullChar, "")
        End If
        id3Info.track = D
    Case "COMM"
        lang = Mid(frame.info, 1, 3)
        If DD = 1 Then
        endshortdesc = 4
        Do While Right(shortdesc, 2) <> vbNullChar & vbNullChar
        shortdesc = Mid(frame.info, 4, endshortdesc - 3)
        endshortdesc = endshortdesc + 1
        Loop
        shortdesc = Replace(shortdesc, vbNullChar, "")
        shortdesc = Mid(shortdesc, 3, Len(shortdesc) - 2)
        D = Mid(frame.info, endshortdesc)
        D = Replace(D, vbNullChar, "")
        D = Mid(D, 3, Len(D) - 2)
        ElseIf DD = 0 Then
        endshortdesc = 4
        Do While Right(shortdesc, 1) <> vbNullChar
        shortdesc = Mid(frame.info, 4, endshortdesc - 3)
        endshortdesc = endshortdesc + 1
        Loop
        shortdesc = Replace(shortdesc, vbNullChar, "")
        shortdesc = Mid(shortdesc, 3, Len(shortdesc) - 2)
        D = Mid(frame.info, endshortdesc)
        End If
        id3Info.Comment = D
        
    Case "TCON"
        If DD = 1 Then
        D = Replace(frame.info, vbNullChar, "")
        D = Mid(D, 3, Len(D) - 2)
        ElseIf DD = 0 Then
        D = frame.info
        End If
        id3Info.Genre = D
    Case "APIC"
        If DD = 0 Then
        endshortdesc = 1
        Do While Right(shortdesc, 1) <> vbNullChar
        shortdesc = Mid(frame.info, 1, endshortdesc)
        endshortdesc = endshortdesc + 1
        Loop
        type_mime = Replace(shortdesc, vbNullChar, "")
        picture_type = Asc(Mid(frame.info, endshortdesc, 1))
        oldshortdesc = endshortdesc + 1
        endshortdesc = 1
        shortdesc = ""
        Do While Right(shortdesc, 1) <> vbNullChar
        shortdesc = Mid(frame.info, oldshortdesc, endshortdesc)
        endshortdesc = endshortdesc + 1
        Loop
        shortdesc = Mid(shortdesc, 1, Len(shortdesc) - 1)
        picture_data = Mid(frame.info, oldshortdesc + endshortdesc - 1)
        'Form1.Image1.Picture = picture_data
        
        D = Str(Len(picture_data))
        Open "dessin.bmp" For Binary As #2
        Put #2, , picture_data
        Close #2
        D1 = D
        Form1.Picture1.Picture = LoadPicture("dessin.bmp")
        End If
End Select
Return

End Function
Public Function isID3v2Tag(sTag As String) As Boolean
Select Case sTag
Case "IPLS" 'IPLS : Involved people list
isID3v2Tag = True
Case "MCDI" 'MCDI : Music CD identifier
isID3v2Tag = True
Case "PCNT" 'PCNT : Play counter
isID3v2Tag = True
Case "TALB" 'TALB : Album/Movie/Show title
isID3v2Tag = True
Case "TBPM" 'TBPM : BPM (beats per minute)
isID3v2Tag = True
Case "TCOM" 'TCOM : Composer
isID3v2Tag = True
Case "TCON" 'TCON : Content type
isID3v2Tag = True
Case "TCOP" 'TCOP : Copyright message
isID3v2Tag = True
Case "TDAT" 'TDAT : Date
isID3v2Tag = True
Case "TDLY" 'TDLY:  Playlist delay
isID3v2Tag = True
Case "TENC" 'TENC:  Encoded By
isID3v2Tag = True
Case "TEXT" 'TEXT : Lyricist/Text writer
isID3v2Tag = True
Case "TFLT" 'TFLT : File type
isID3v2Tag = True
Case "TIME" 'TIME:  TIME
isID3v2Tag = True
Case "TIT1" 'TIT1 : Content group description
isID3v2Tag = True
Case "TIT2" 'TIT2 : Title/songname/content description
isID3v2Tag = True
Case "TIT3" 'TIT3 : Subtitle/Description refinement
isID3v2Tag = True
Case "TKEY" 'TKEY:  Initial Key
isID3v2Tag = True
Case "TLAN" 'TLAN:  Language (s)
isID3v2Tag = True
Case "TLEN" 'TLEN:  Length
isID3v2Tag = True
Case "TMED" 'TMED : Media type
isID3v2Tag = True
Case "TOAL" 'TOAL : Original album/movie/show title
isID3v2Tag = True
Case "TOFN" 'TOFN:  Original Filename
isID3v2Tag = True
Case "TOLY" 'TOLY : Original lyricist(s)/text writer(s)
isID3v2Tag = True
Case "TOPE" 'TOPE:  Original Artist(s) / performer(s)
isID3v2Tag = True
Case "TORY" 'TORY : Original release year
isID3v2Tag = True
Case "TOWN" 'TOWN:  file owner / licensee
isID3v2Tag = True
Case "TPE1" 'TPE1:  Lead performer(s) / Soloist(s)
isID3v2Tag = True
Case "TPE2" 'TPE2 : Band/orchestra/accompaniment
isID3v2Tag = True
Case "TPE3" 'TPE3 : Conductor/performer refinement
isID3v2Tag = True
Case "TPE4" 'TPE4 : Interpreted, remixed, or otherwise modified by
isID3v2Tag = True
Case "TPOS" 'TPOS : Part of a set
isID3v2Tag = True
Case "TPUB" 'TPUB:  Publisher
isID3v2Tag = True
Case "TRCK" 'TRCK : Track number/Position in set
isID3v2Tag = True
Case "TRDA" 'TRDA:  Recording dates
isID3v2Tag = True
Case "TRSN" 'TRSN : Internet radio station name
isID3v2Tag = True
Case "TRSO" 'TRSO : Internet radio station owner
isID3v2Tag = True
Case "TSIZ" 'TSIZ:  Size
isID3v2Tag = True
Case "TSRC" 'TSRC : ISRC (international standard recording code)
isID3v2Tag = True
Case "TSSE" 'TSSE : Software/Hardware and settings used for encoding
isID3v2Tag = True
Case "TYER" 'TYER:  Year
isID3v2Tag = True
Case "WCOM" 'WCOM:  Commercial Information
isID3v2Tag = True
Case "WCOP" 'WCOP : Copyright/Legal information
isID3v2Tag = True
Case "WOAF" 'WOAF : Official audio file webpage
isID3v2Tag = True
Case "WOAR" 'WOAR : Official artist/performer webpage
isID3v2Tag = True
Case "WOAS" 'WOAS : Official audio source webpage
isID3v2Tag = True
Case "WORS" 'WORS : Official internet radio station homepage
isID3v2Tag = True
Case "WPAY" 'WPAY:  Payment
isID3v2Tag = True
Case "WPUB" 'WPUB : Publishers official webpage
isID3v2Tag = True
'List of Complex Frames
'Following frames are supported and return a reference to a hash.
Case "AENC" 'AENC:  Audio Encryption
isID3v2Tag = True
Case "APIC" 'APIC:  Attached Picture
isID3v2Tag = True
Case "COMM" 'COMM:  Comments
isID3v2Tag = True
Case "Keys" 'Keys:   Language , Short, TEXT
isID3v2Tag = True
Case "COMR" 'COMR:  Commercial frame
isID3v2Tag = True
Case "ENCR" 'ENCR : Encryption method registration
isID3v2Tag = True
Case "GEOB" 'GEOB : General encapsulated object
isID3v2Tag = True
Case "GRID" 'GRID : Group identification registration
isID3v2Tag = True
Case "LINK" 'LINK:  Linked Information
isID3v2Tag = True
Case "OWNE" 'OWNE:  Ownership frame
isID3v2Tag = True
Case "POPM" 'POPM:  Popularimeter
isID3v2Tag = True
Case "PRIV" 'PRIV:  Private frame
isID3v2Tag = True
Case "RBUF" 'RBUF : Recommended buffer size
isID3v2Tag = True
Case "RVRB" 'RVRB:  Reverb
isID3v2Tag = True
Case "SYTC" 'SYTC : Synchronized tempo codes
isID3v2Tag = True
Case "TXXX" 'TXXX : User defined text information frame
isID3v2Tag = True
Case "UFID" 'UFID : Unique file identifier
isID3v2Tag = True
Case "USER" 'USER : Terms of use
isID3v2Tag = True
Case "USLT" 'USLT : Unsychronized lyric/text transcription
isID3v2Tag = True
Case "WXXX" 'WXXX : User defined URL link frame
isID3v2Tag = True
'List of Other Frames
'Following frames are only supported in raw mode:
Case "EQUA" 'EQUA:  Equalization
isID3v2Tag = True
Case "ETCO" 'ETCO : Event timing codes
isID3v2Tag = True
Case "MLLT" 'MLLT : MPEG location lookup table
isID3v2Tag = True
Case "POSS" 'POSS : Position synchronisation frame
isID3v2Tag = True
Case "RVAD" 'RVAD : Relative volume adjustment
isID3v2Tag = True
Case "SYLT" 'SYLT:  Synchronized Lyric / TEXT
isID3v2Tag = True
Case Else
isID3v2Tag = False
End Select










End Function

Public Function SaveId3(Filename As String, info As Id3)
On Error Resume Next
Dim x() As Byte
Dim TagHeader As Id3v2Header, Size As Long
Dim NewSize As Long
Dim NewTagHeader As Id3v2Header
Dim NewTitleHeader As ID3v2FrameHeader, NewTitle As ID3v2Frame
Dim NewAlbumHeader As ID3v2FrameHeader, NewAlbum As ID3v2Frame
Dim NewArtistHeader As ID3v2FrameHeader, NewArtist As ID3v2Frame
Dim NewYearHeader As ID3v2FrameHeader, NewYear As ID3v2Frame
Dim newApicHeader As ID3v2FrameHeader, newApic As ID3v2Frame
Dim nouvelle_image As String
Dim NewTag As String
Dim audioData As String

 ' We use this variable to make sure the file has an ID3TAG
Open Filename For Binary As #1      ' we open the file as binary for total control (we need it for the Genre part)
Get #1, , TagHeader
Close #1                ' Id3 tags are at the end of the mp3 file(and as the type shows it is 128 bytes)
x = TagHeader.Identifier
Size = BitsToLow(TagHeader.Size)

If info.Title <> "" Then
With NewTitleHeader
    .ID = "TIT2"
    .flags = vbNullChar & vbNullChar
    x = BitsToHighFrame(Len(info.Title) + 1)
    ReDim Preserve x(3)
    .Size(0) = x(0)
    .Size(1) = x(1)
    .Size(2) = x(2)
    .Size(3) = x(3)
End With
With NewTitle
    .Encoding = CByte(0)
    .info = info.Title
End With
NewTag = NewTitleHeader.ID & Chr(NewTitleHeader.Size(0)) & Chr(NewTitleHeader.Size(1)) & Chr(NewTitleHeader.Size(2)) & Chr(NewTitleHeader.Size(3)) _
        & NewTitleHeader.flags & Chr(NewTitle.Encoding) & NewTitle.info
NewSize = 11 + Len(info.Title)
End If

If info.Album <> "" Then
With NewAlbumHeader
    .ID = "TALB"
    .flags = vbNullChar & vbNullChar
    x = BitsToHighFrame(Len(info.Album) + 1)
    ReDim Preserve x(3)
    .Size(0) = x(0)
    .Size(1) = x(1)
    .Size(2) = x(2)
    .Size(3) = x(3)
End With
With NewAlbum
    .Encoding = CByte(0)
    .info = info.Album
End With
NewTag = NewTag & NewAlbumHeader.ID & Chr(NewAlbumHeader.Size(0)) & Chr(NewAlbumHeader.Size(1)) & Chr(NewAlbumHeader.Size(2)) & Chr(NewAlbumHeader.Size(3)) _
                & NewAlbumHeader.flags & Chr(NewAlbum.Encoding) & NewAlbum.info
NewSize = NewSize + 11 + Len(info.Album)
End If

If info.Artist <> "" Then
With NewArtistHeader
    .ID = "TPE1"
    .flags = vbNullChar & vbNullChar
    x = BitsToHighFrame(Len(info.Artist) + 1)
    ReDim Preserve x(3)
    .Size(0) = x(0)
    .Size(1) = x(1)
    .Size(2) = x(2)
    .Size(3) = x(3)
End With
With NewArtist
    .Encoding = CByte(0)
    .info = info.Artist
End With
NewTag = NewTag & NewArtistHeader.ID & Chr(NewArtistHeader.Size(0)) & Chr(NewArtistHeader.Size(1)) & Chr(NewArtistHeader.Size(2)) & Chr(NewArtistHeader.Size(3)) _
        & NewArtistHeader.flags & Chr(NewArtist.Encoding) & NewArtist.info
NewSize = NewSize + 11 + Len(info.Artist)
End If

If info.sYear <> "" Then
With NewYearHeader
    .ID = "TYER"
    .flags = vbNullChar & vbNullChar
    x = BitsToHighFrame(Len(info.sYear) + 1)
    ReDim Preserve x(3)
    .Size(0) = x(0)
    .Size(1) = x(1)
    .Size(2) = x(2)
    .Size(3) = x(3)
End With
With NewYear
    .Encoding = CByte(0)
    .info = info.sYear
End With
NewTag = NewTag & NewYearHeader.ID & Chr(NewYearHeader.Size(0)) & Chr(NewYearHeader.Size(1)) & Chr(NewYearHeader.Size(2)) & Chr(NewYearHeader.Size(3)) _
        & NewYearHeader.flags & Chr(NewYear.Encoding) & NewYear.info
NewSize = NewSize + 11 + Len(info.sYear)
End If

'If info.Picture <> "" Then
nouvelle_image = String(FileLen("essai.jpg"), 0)
Open "essai.jpg" For Binary As #2
Get #2, , nouvelle_image
Close #2
With newApic
    .Encoding = CByte(0)
    .info = "image/jpeg" & vbNullChar & vbNullChar & vbNullChar & nouvelle_image
End With
With newApicHeader
    .ID = "APIC"
    .flags = vbNullChar & vbNullChar
    x = BitsToHighFrame(Len(newApic.info) + 1)
    ReDim Preserve x(3)
    .Size(0) = x(0)
    .Size(1) = x(1)
    .Size(2) = x(2)
    .Size(3) = x(3)
    
End With

NewTag = NewTag & newApicHeader.ID & Chr(newApicHeader.Size(0)) & Chr(newApicHeader.Size(1)) & Chr(newApicHeader.Size(2)) & Chr(newApicHeader.Size(3)) _
        & newApicHeader.flags & Chr(newApic.Encoding) & newApic.info
NewSize = NewSize + 11 + Len(newApic.info)
'End If


With NewTagHeader
    .Identifier = "ID3"
    .version1 = CByte(3)
    .version2 = CByte(0)
    .flags = CByte(0)
    x = BitsToHigh(NewSize)
    ReDim Preserve x(3)
    .Size(0) = x(0)
    .Size(1) = x(1)
    .Size(2) = x(2)
    .Size(3) = x(3)
End With

'NewTagHeader & NewTitleHeader & NewTitle & NewAlbumHeader & NewAlbum & NewArtistHeader & NewArtist & NewYearHeader & NewYear
NewTag = NewTagHeader.Identifier & Chr(NewTagHeader.version1) & Chr(NewTagHeader.version2) & Chr(NewTagHeader.flags) & Chr(NewTagHeader.Size(0)) _
        & Chr(NewTagHeader.Size(1)) & Chr(NewTagHeader.Size(2)) & Chr(NewTagHeader.Size(3)) _
        & NewTag

audioData = String(FileLen(Filename), 0)
Open Filename For Binary As #1
Get #1, , audioData
Close #1

If TagHeader.Identifier = "ID3" Then
audioData = Mid(audioData, Size + 11)
Open Filename For Output As #1
Print #1, NewTag & audioData
Close #1

Else

Open Filename For Output As #1
Print #1, NewTag & audioData
Close #1
End If

End Function

Public Function BitsToLow(Size() As Byte) As Long
Dim Ret As Long
'622447
Ret = Size(3)
If Size(2) <> 0 Then
If Size(2) And 1 Then Ret = Ret + 128
If Size(2) And 2 Then Ret = Ret + 256
If Size(2) And 4 Then Ret = Ret + 512
If Size(2) And 8 Then Ret = Ret + 1024
If Size(2) And 16 Then Ret = Ret + 2048
If Size(2) And 32 Then Ret = Ret + 4096
If Size(2) And 64 Then Ret = Ret + 8192
End If
If Size(1) <> 0 Then
If Size(1) And 1 Then Ret = Ret + 16384
If Size(1) And 2 Then Ret = Ret + 32768
If Size(1) And 4 Then Ret = Ret + 65536
If Size(1) And 8 Then Ret = Ret + 131072
If Size(1) And 16 Then Ret = Ret + 262144
If Size(1) And 32 Then Ret = Ret + 524288
If Size(1) And 64 Then Ret = Ret + 1048576
End If
If Size(0) <> 0 Then
If Size(0) And 1 Then Ret = Ret + 2097152
If Size(0) And 2 Then Ret = Ret + 4194304
If Size(0) And 4 Then Ret = Ret + 8388608
If Size(0) And 8 Then Ret = Ret + 16777216
If Size(0) And 16 Then Ret = Ret + 33554432
If Size(0) And 32 Then Ret = Ret + 67108864
If Size(0) And 64 Then Ret = Ret + 134217728
End If
BitsToLow = Ret
End Function
Public Function BitsToLowFrame(Size() As Byte) As Long
Dim Ret As Long
'622447
Ret = Size(3)
If Size(2) <> 0 Then
If Size(2) And 1 Then Ret = Ret + 256
If Size(2) And 2 Then Ret = Ret + 512
If Size(2) And 4 Then Ret = Ret + 1024
If Size(2) And 8 Then Ret = Ret + 2048
If Size(2) And 16 Then Ret = Ret + 4096
If Size(2) And 32 Then Ret = Ret + 8192
If Size(2) And 64 Then Ret = Ret + 16384
If Size(2) And 128 Then Ret = Ret + 32768
End If
If Size(1) <> 0 Then
If Size(1) And 1 Then Ret = Ret + 65536
If Size(1) And 2 Then Ret = Ret + 131072
If Size(1) And 4 Then Ret = Ret + 262144
If Size(1) And 8 Then Ret = Ret + 524288
If Size(1) And 16 Then Ret = Ret + 1048576
If Size(1) And 32 Then Ret = Ret + 2097152
If Size(1) And 64 Then Ret = Ret + 4194304
If Size(1) And 128 Then Ret = Ret + 8388608
End If
If Size(0) <> 0 Then
If Size(0) And 1 Then Ret = Ret + 16777216
If Size(0) And 2 Then Ret = Ret + 33554432
If Size(0) And 4 Then Ret = Ret + 67108864
If Size(0) And 8 Then Ret = Ret + 134217728
If Size(0) And 16 Then Ret = Ret + 268435456
If Size(0) And 32 Then Ret = Ret + 536870912
If Size(0) And 64 Then Ret = Ret + 1073741824
'If Size(0) And 128 Then Ret = Ret + 2147483648#
End If
BitsToLowFrame = Ret
End Function
Public Function BitsToHighFrame(Size As Long) As Byte()
Dim Ret(3) As Byte
If Size And 1 Then Ret(3) = 1
If Size And 2 Then Ret(3) = Ret(3) + 2
If Size And 4 Then Ret(3) = Ret(3) + 4
If Size And 8 Then Ret(3) = Ret(3) + 8
If Size And 16 Then Ret(3) = Ret(3) + 16
If Size And 32 Then Ret(3) = Ret(3) + 32
If Size And 64 Then Ret(3) = Ret(3) + 64
If Size And 128 Then Ret(3) = Ret(3) + 128
If Size And 256 Then Ret(2) = 1
If Size And 512 Then Ret(2) = Ret(2) + 2
If Size And 1024 Then Ret(2) = Ret(2) + 4
If Size And 2048 Then Ret(2) = Ret(2) + 8
If Size And 4096 Then Ret(2) = Ret(2) + 16
If Size And 8192 Then Ret(2) = Ret(2) + 32
If Size And 16384 Then Ret(2) = Ret(2) + 64
If Size And 32768 Then Ret(2) = Ret(2) + 128
If Size And 65536 Then Ret(1) = 1
If Size And 131072 Then Ret(1) = Ret(1) + 2
If Size And 262144 Then Ret(1) = Ret(1) + 4
If Size And 524288 Then Ret(1) = Ret(1) + 8
If Size And 1048576 Then Ret(1) = Ret(1) + 16
If Size And 2097152 Then Ret(1) = Ret(1) + 32
If Size And 4194304 Then Ret(1) = Ret(1) + 64
If Size And 8388608 Then Ret(1) = Ret(1) + 128
If Size And 16777216 Then Ret(0) = 1
If Size And 33554432 Then Ret(0) = Ret(0) + 2
If Size And 67108864 Then Ret(0) = Ret(0) + 4
If Size And 134217728 Then Ret(0) = Ret(0) + 8
If Size And 268435456 Then Ret(0) = Ret(0) + 16
If Size And 536870912 Then Ret(0) = Ret(0) + 32
If Size And 1073741824 Then Ret(0) = Ret(0) + 64
'If Size And 2147483648# Then Ret(0) = Ret(0) + 128
BitsToHighFrame = Ret
End Function
Public Function BitsToHigh(Size As Long) As Byte()
Dim Ret(3) As Byte
If Size And 1 Then Ret(3) = 1
If Size And 2 Then Ret(3) = Ret(3) + 2
If Size And 4 Then Ret(3) = Ret(3) + 4
If Size And 8 Then Ret(3) = Ret(3) + 8
If Size And 16 Then Ret(3) = Ret(3) + 16
If Size And 32 Then Ret(3) = Ret(3) + 32
If Size And 64 Then Ret(3) = Ret(3) + 64
If Size And 128 Then Ret(2) = 1
If Size And 256 Then Ret(2) = Ret(2) + 2
If Size And 512 Then Ret(2) = Ret(2) + 4
If Size And 1024 Then Ret(2) = Ret(2) + 8
If Size And 2048 Then Ret(2) = Ret(2) + 16
If Size And 4096 Then Ret(2) = Ret(2) + 32
If Size And 8192 Then Ret(2) = Ret(2) + 64
If Size And 16384 Then Ret(1) = 1
If Size And 32768 Then Ret(1) = Ret(1) + 2
If Size And 65536 Then Ret(1) = Ret(1) + 4
If Size And 131072 Then Ret(1) = Ret(1) + 8
If Size And 262144 Then Ret(1) = Ret(1) + 16
If Size And 524288 Then Ret(1) = Ret(1) + 32
If Size And 1048576 Then Ret(1) = Ret(1) + 64
If Size And 2097152 Then Ret(0) = 1
If Size And 4194304 Then Ret(0) = Ret(0) + 2
If Size And 8388608 Then Ret(0) = Ret(0) + 4
If Size And 16777216 Then Ret(0) = Ret(0) + 8
If Size And 33554432 Then Ret(0) = Ret(0) + 16
If Size And 67108864 Then Ret(0) = Ret(0) + 32
If Size And 134217728 Then Ret(0) = Ret(0) + 64
BitsToHigh = Ret
End Function