<%
'============================================================
' MODULE:   cGifText.asp
' APPL:        GifText
' AUTHOR:   © Terje Hauger
' Home:       www.u229.no/stuff/GIFText/
' CREATED: August 2005
' VERSION: 1.2
' LAST MODIFIED: September 2005
'============================================================
' COMMENT: This class writes and deletes text blocks to/from GIF files.
'                  Dependencies: cByteArray.asp and ADO 2.5 or higher.
'                  GIF Reference: http://www.w3.org/Graphics/GIF/spec-gif89a.txt
'============================================================
' ROUTINES:

' - Public Property Let FilePath(sPath)
' - Public Property Let SavePath(sPath)
' - Public Property Let Comment(sComment)
' - Public Property Let DeleteExisting(b)
' - Public Property Get ErrorMessage()

' - Private Sub Class_Initialize()
' - Private Sub Class_Terminate()
' - Public Function WriteGIFText()
' - Private Function ParseGIF(iLoopStart)
' - Private Function StringToBinary(s)
' - Private Function PrepComment()
' - Private Sub SaveNewGIF(ByteArray)
' - Private Function LoadGIF()
' - Private Function IsValidGIF()
'============================================================

%>
<!--#include file="cByteArray.asp"-->
<%

Const adTypeBinary = 1
Const adSaveCreateOverWrite = 2
Const adStateClosed = 0
Const adStateOpen = 1


'============================================================
Class cGIFText
'============================================================


'// MODULE VARIABLES
Private m_arrGIF                              '// Read GIF into byte array
Private m_sFilePath                           '// Path to GIF file
Private m_sSavePath                        '// Where to save the new GIF
Private m_sComment                       '// Comments to write to the file
Private m_bDeleteExisting                 '// Delete existing comments?
Private m_lngComStart                     '// Byte starting the comment
Private m_lngComEnd                       '// Byte ending the comment
Private m_lImageSize                       '// Size of GIF in bytes
Private m_sErrMsg                            '// Return a human readable error message
Private m_oByteClass                       '// We use the byte class to hold our GIF bytes


'// MODULE PROPERTIES
Public Property Let FilePath(sPath)
    m_sFilePath = sPath
End Property
Public Property Let SavePath(sPath)
    m_sSavePath = sPath
End Property
Public Property Let Comment(sComment)
    m_sComment = sComment
End Property
Public Property Let DeleteExisting(b)
    m_bDeleteExisting = b
End Property
Public Property Get ErrorMessage()
    ErrorMessage = m_sErrMsg
End Property

'------------------------------------------------------------------------------------------------------------
' Comment: Initialize our module variables
'------------------------------------------------------------------------------------------------------------
Private Sub Class_Initialize()
    On Error Resume Next

    m_sFilePath = ""
    m_sSavePath = ""
    m_sComment = ""
    m_bDeleteExisting = False
    m_lngComStart = 1
    m_lngComEnd = 1
    m_lImageSize = 0

    If IsEmpty(m_oByteClass) Then Set m_oByteClass = New cByteArray

End Sub

'--------------------------------------------------------------------------------------------------------
' Comment: Clean up.
'--------------------------------------------------------------------------------------------------------
Private Sub Class_Terminate()
    On Error Resume Next

    Set m_oByteClass = Nothing

End Sub

'------------------------------------------------------------------------------------------------------------
' Comment: Write text into a GIF file.
'------------------------------------------------------------------------------------------------------------
Public Function WriteGIFText()
    On Error Resume Next

    Dim iLoopStart, sGIFChunk, bSavedNew

'---------------------------- Check user input

    If Len(m_sFilePath & "") = 0 Or Len(m_sSavePath & "") = 0 Then m_sErrMsg = _
                    "Missing File Path Parameter": Exit Function

'---------------------------- Load the GIF image into a byte array with ADO Stream

    If Not LoadGIF Then m_sErrMsg = "Error opening GIF file": Exit Function

'---------------------------- Is this a valid GIF file?

    If Not IsValidGIF Then m_sErrMsg = "GIF file must be of type GIF89a": Exit Function

'---------------------------- Are we asked to delete existing comment(s)?

    If m_bDeleteExisting Then

        iLoopStart = 1

        '// Loop the GIF to see if there are any comment block(s)
        Do While m_lngComStart > 0

            Call ParseGIF(iLoopStart)

            '// No more comment block(s) found so exit
            If m_lngComStart = 0 Then Exit Do
            '// Copy GIF bytes up to the comment(s)
            sGIFChunk = MidB(m_arrGIF, iLoopStart, m_lngComStart - iLoopStart)
            '// Add the bytes to the m_oByteClass
            Call m_oByteClass.AddBytes(sGIFChunk)
            '// Start the next loop from where we found the last comment
            iLoopStart = (m_lngComEnd + 1)

        Loop

        '// Add the last chunk from the last comment to the end of file
        sGIFChunk = MidB(m_arrGIF, iLoopStart, LenB(m_arrGIF))
        '// Append it to the m_oByteClass
        Call m_oByteClass.AddBytes(sGIFChunk)
        '// Save new GIF
        Call SaveNewGIF(m_oByteClass.ReturnBytes)
        '// Set a flag
        bSavedNew = True

				Set m_oByteClass = Nothing

    End If

'---------------------------- Write text into GIF image

    '// Create a new object since this class doesn't have a Clear method.
    If m_oByteClass Is Nothing Then Set m_oByteClass = New cByteArray

    If Len(m_sComment & "") = 0 Then Exit Function

    '// We need to do some work on the comment before we can use it
    m_sComment = PrepComment & Chr(59)

    '// If we already have saved a new GIF, we continue to work on the saved file.
    If bSavedNew Then
        m_sFilePath = m_sSavePath

        If Not LoadGIF Then m_sErrMsg = "Error opening GIF file": Exit Function
    End If

    '// Convert the comment to a binary string.
    m_sComment = StringToBinary(m_sComment)
    '// We place our comment rigth in front of the ; character that marks the end of GIF images.
    '// First copy everything up to that point:
    sGIFChunk = MidB(m_arrGIF, 1, LenB(m_arrGIF) - 1)
    '// Append it to the m_oByteClass
    Call m_oByteClass.AddBytes(sGIFChunk)
    '// Now add the comment block
    Call m_oByteClass.AddBytes(m_sComment)
    '// Save new GIF
    Call SaveNewGIF(m_oByteClass.ReturnBytes)

End Function

'------------------------------------------------------------------------------------------------------------
' Comment: Loop the GIF and look for comment block(s). Every loop starts where we found
'                 the last comment. Set values for the m_lngComStart and m_lngComEnd.
'------------------------------------------------------------------------------------------------------------
Private Function ParseGIF(iLoopStart)
'// From the references:
'// Comment Data - Sequence of sub-blocks, each of size at most
'// 255 bytes and at least 1 byte, with the size in a byte preceding the data.
'// The end of the sequence is marked by the Block Terminator. Ascii, not Unicode.
'// Notes: Since a GIF decoder, f. ex. an image program like IrfanView or a web browser,
'// should not render a comment block, we can store anything we want in this block.
    On Error Resume Next

    Dim i, k, lngBlockLength

    m_lngComStart = 0

'---------------------------- Start looping the GIF byte array

    For i = iLoopStart To m_lImageSize

        If AscB(MidB(m_arrGIF, i, 1)) = 33 Then
            If AscB(MidB(m_arrGIF, i + 1, 1)) = 254 Then

                '// There should be a preceding 0 before the comment block.
                If Not AscB(MidB(m_arrGIF, i - 1, 1)) = 0 Then Exit For
            
                lngBlockLength = AscB(MidB(m_arrGIF, i + 2, 1))
                m_lngComStart = i

                For k = i To m_lImageSize
                    '// All characters should be 7-bit ascii (0 - 127) but we don't check for that.
                    '// We loop until we find the trailing zero character.
                    If AscB(MidB(m_arrGIF, k, 1)) = 0 Then m_lngComEnd = k: Exit Function
                Next

            End If
        End If

    Next
    
    ParseGIF = (Err.Number = 0)

End Function

'------------------------------------------------------------------------------------------------------------
' Comment: Convert a string to a binary string.
'------------------------------------------------------------------------------------------------------------
Private Function StringToBinary(s)
    On Error Resume Next

    Dim i

    StringToBinary = ""

    For i = 1 To Len(s)
        StringToBinary = (StringToBinary & ChrB(Asc(Mid(s, i, 1))))
    Next

End Function

'------------------------------------------------------------------------------------------------------------
' Comment: Prepare the comment by adding header and, if needed, split it into sub blocks.
'------------------------------------------------------------------------------------------------------------
Private Function PrepComment()
    On Error Resume Next

    Dim l, k, lCommentLength, lChunk, iLoops, sComment

'---------------------------- If we only need to write 1 Comment Block

    If Len(m_sComment) <= 255 Then
        PrepComment = Chr(33) & Chr(254) & Chr("&H" & Hex(CLng(Len(m_sComment)))) & m_sComment & Chr(0)
        Exit Function
    End If
    
'---------------------------- We need to write several Sub Blocks if max length > 255
        
    '// Get length of comment
    lCommentLength = Len(m_sComment)
    '// Allowed length of sub blocks are 255 characters according to the GIF reference
    lChunk = 255
    '// Find number of sub blocks required
    iLoops = Int(lCommentLength / lChunk)

    '// If needed, add one more sub block
    If (lChunk * iLoops) < lCommentLength Then iLoops = iLoops + 1
    '// We need to know what byte to start copying from
    k = 1

    '// Add the identifier for the comment block
    sComment = (sComment & Chr(33) & Chr(254))
    
    For l = 1 To iLoops
        
        If (l < iLoops) Then
            '// Build the string with the Sub Blocks
            sComment = (sComment & Chr("&H" & Hex(lChunk)) & Mid(m_sComment, k, lChunk))
        Else
            '// Get the last chunk and correct for the starting k = 1 by adding one to k.
            sComment = (sComment & Chr("&H" & Hex((lCommentLength - k) + 1)) & _
						    Mid(m_sComment, k, (lCommentLength - k) + 1))
            Exit For
        End If
            
        k = (k + lChunk)
            
    Next
    
    '// Add a trailing zero character to finish off the comment block
    PrepComment = (sComment & Chr(0))
    
End Function

'------------------------------------------------------------------------------------------------------------
' Comment: Save our new GIF image
'------------------------------------------------------------------------------------------------------------
Private Sub SaveNewGIF(ByteArray)
    On Error Resume Next

    Dim oStream

    If LenB(ByteArray) = 0 Then Exit Sub

    If IsEmpty(oStream) Then Set oStream = Server.CreateObject("ADODB.Stream")

    With oStream

        If .State = adStateOpen Then .State = adStateClosed
        .Type = adTypeBinary
        Call .Open
        Call .Write(ByteArray)
        Call .SaveToFile(m_sSavePath, adSaveCreateOverWrite)
        Call .Close
    End With
        
    Set oStream = Nothing

    If Err Then m_sErrMsg = Err.Description
    
End Sub

'------------------------------------------------------------------------------------------------------------
' Comment: Read image into byte array.
'------------------------------------------------------------------------------------------------------------
Private Function LoadGIF()
    On Error Resume Next

    Dim oStream

    If IsEmpty(oStream) Then Set oStream = Server.CreateObject("ADODB.Stream")

    With oStream

        If .State = adStateOpen Then .State = adStateClosed
        .Type = adTypeBinary
        .Open
        .LoadFromFile m_sFilePath
        m_arrGIF = .Read
    End With

    oStream.Close
    Set oStream = Nothing

    m_lImageSize = LenB(m_arrGIF)

    LoadGIF = (LenB(m_arrGIF) > 0 And Err.Number = 0)

End Function

'------------------------------------------------------------------------------------------------------------
' Comment: Features like Comment Blocks are only supported by GIF89a files.
'------------------------------------------------------------------------------------------------------------
Private Function IsValidGIF()
    On Error Resume Next

    If AscB(MidB(m_arrGIF, 1, 1)) = 71 And AscB(MidB(m_arrGIF, 2, 1)) = 73 And _
		    AscB(MidB(m_arrGIF, 3, 1)) = 70 Then

        If AscB(MidB(m_arrGIF, 5, 1)) = 57 Then IsValidGIF = True
    End If

End Function

'============================================================
End Class
'============================================================
%>