Solved

Error writing file header

Posted on 2002-07-23
11
266 Views
Last Modified: 2010-07-27
I working with creating file from data compression program where I found that the file cannot be opened by my program itself. I opened the file with notepad and discovered the first 3 bytes that store file extension are not storing properly (i.e. 1st byte "z", 2nd "i", 3rd "p" but now 1st "", 2nd "z", 3rd "p").

I've checked the AddString function using debug.print on ns (see detailed coding below) and found ns contains nothing. Here's the related coding:

Private Function AddString(ByRef Bytes() As Byte, ByVal St As String, Optional VarLen As Boolean = False) As Long
    'Add string St to the byte array
    Dim StrBytes() As Byte      
    Dim n, ns

    On Error Resume Next
    ns = UBound(Bytes)
    Debug.Print ns
    If VarLen Then St = St & vbCr
    StrBytes = StrConv(St, vbFromUnicode)  
    n = Len(St)
    If ns = 0 Then
        ReDim Bytes(n) As Byte      
    Else
        ReDim Preserve Bytes(ns + n) As Byte
    End If
    CopyMem Bytes(ns + 1), StrBytes(0), n
    Debug.Print Bytes(ns + 1)
    Debug.Print n
    AddString = UBound(Bytes)
    Debug.Print AddString

End Function

And here's the sub CompressFiles coding:

Public Sub CompFiles(ByVal sNewZipFile As String, ByVal iCompressLevel As Integer, ByVal bSplitting As Boolean, ByVal lSplitOption As Long)
    'Compress the files to the NewZipFile using Byte Arrays
    Dim drv As Drive          
    Dim DrvSpec As String    
    Dim IsFDD As Boolean      
    Dim nfd, nfs              
    Dim nb                    
    Dim SourceFile As String  
    Dim DestFile As String    
    Dim DestBase As String    
    Dim DestFolder As String  
    Dim Bytes() As Byte      
    Dim Buffer() As Byte      
    Dim Hdr As LempHeader    
    Dim AddFileRec As LempFileRec  
    Dim imgObj As ListImage
    Dim Result As ZLibErr    
    Dim Sum As Long          
    Dim Total As Long        
    Dim TmrStart As Single
    Dim i As Long
    Dim n, Ok
    Dim Ans

    On Error GoTo CompFilesErr
    Screen.MousePointer = vbArrowHourglass

    'Set entry properties
    xCompFileNew = sNewZipFile
    xCompressLevel = iCompressLevel
    xSplitting = bSplitting
    xSplitOption = lSplitOption

    If xExist Then
        If xSplit Then
            UnsplitZipfile
        End If
        backup
    End If
   
    'Determine type of drive to write to
    DrvSpec = xFso.GetDriveName(xFso.GetAbsolutePathName(xCompFileNew))
    Set drv = xFso.GetDrive(DrvSpec)
    IsFDD = (drv.DriveType = Removable)

    'Initialise other variables
    Sum = 0                   'Total bytes processed
    Total = 0                 'Total bytes to process
    'Populate header
    Hdr.Major = App.Major
    Hdr.Minor = App.Minor
    Hdr.Vol_No = 1
    Hdr.Next_Vol = 0
    Hdr.CompSize = 0
    Hdr.NumFiles = nFiles
    Hdr.Offset = 0
   
    'Determine destination folder & file name
    DestBase = xFso.GetBaseName(xCompFileNew)
    If IsFDD Then
        xSplitting = True
    End If
    If xSplitting Then
        DestFolder = xTempFolder
        DestFile = CheckPath(DestFolder) & DestBase & ".rlz"
        xTempFile = DestFile
    Else
        DestFolder = xFso.GetParentFolderName(xCompFileNew)
        DestFile = CheckPath(DestFolder) & DestBase & ".rlz"
        xTempFile = ""
    End If
   
    'Open the destination file
    On Error Resume Next
    Kill DestFile
    On Error GoTo CompFilesErr
    nfd = FreeFile
    Open DestFile For Binary As #nfd
   
    'Header
    SetProgress 0, 1, "Adding header..."
    nb = AddHeader(Bytes, Hdr)                 'Add header
    nb = AddString(Bytes, xRootFolder, True)  
   
    'File List (Numeric portion)
    nb = AddString(Bytes, "[Files]")    
    Hdr.Offset = nb
    'Make space for a file header for each file
    nb = AddBlankFileRecords(Bytes)
   
    'File Names (String portion)
    Call AddString(Bytes, "[Names]")
    For i = 1 To nFiles
        'Make space for Name, Rel Path, Path & Icon Key
        nb = AddFileName(Bytes, i)
    Next
   
    'icons
    Call AddString(Bytes, "[Icons]")
    For Each imgObj In xIml.ListImages
        nfs = FreeFile
        SourceFile = CheckPath(xTempFolder) & imgObj.Key & ".bmp"
        Open SourceFile For Binary As #nfs
        n = LOF(nfs)
        ReDim Buffer(n) As Byte
        'Read the bitmap
        Get #nfs, , Buffer
        Close #nfs
        'Add the bitmap and icon key to Bytes()
        nb = AddIconRec(Bytes, Buffer, imgObj.Key)
    Next
   
    'Files
    Total = Me.TotalSize
    Sum = 0
    For i = 1 To nFiles
       
        If aFiles(i).Compressed Then
            Ok = ExtractFile(i, Buffer)              'Decompress also
            If Ok Then
                n = UBound(Buffer)                     'No of bytes in Buffer
            Else
                n = 0
            End If
        Else
            nfs = FreeFile
            SourceFile = CheckPath(aFiles(i).Path) & aFiles(i).FName
            Open SourceFile For Binary As #nfs
            n = LOF(nfs)                              
            If n > 0 Then                            
                'Read the file into Buffer()
                ReDim Buffer(n) As Byte                 '1-based
                Get #nfs, , Buffer()
                Close #nfs
            End If
        End If
   
        If n > 0 Then
            aFiles(i).ChkSum = CheckSum(Buffer)
            'Compress the byte array using zlib.dll call
            Result = CompressBytes(Buffer, xCompressLevel)
            If Result <> 0 Then
                Err.Raise Result, "clsLemp.ZipFiles()", "Error compressing byte array"
            End If
            'Calculate crude XOR check sum of zipped file
            aFiles(i).ChkSumComp = CheckSum(Buffer)
            'Collect file info
            aFiles(i).Offset = Loc(nfd) + nb                    'Offset in dest file, from start
            aFiles(i).FSize = n                                 'Original size (bytes)
            aFiles(i).CompSize = UBound(Buffer)                 'Compress size
            aFiles(i).Ratio = aFiles(i).CompSize / aFiles(i).FSize 'Compress ratio
            aFiles(i).Compressed = True
            'Add compressed data to buffer
            nb = AddBytes(Bytes, Buffer)
        Else
            'Collect file info
            aFiles(i).Offset = Loc(nfd) + nb                    
            aFiles(i).FSize = 0                                  
            aFiles(i).CompSize = 0                                
            aFiles(i).Ratio = 1                                
            aFiles(i).ChkSum = 0
            aFiles(i).ChkSumComp = 0
            aFiles(i).Compressed = True
            'No need to add empty bytes to Bytes() array
        End If
        'Write Bytes() to destination if chunk size exceeded
        If nb >= CHUNK_SIZE Then
            Put #nfd, , Bytes()             'Write Bytes() to disk
            ReDim Bytes(0 To 0) As Byte     'To indicate 0 bytes in buffer
            nb = 0                          'Reset buffer offset
        End If
        Sum = Sum + n
        SetProgress Sum, Total, "Adding file " & aFiles(i).FName
    Next

    'Write remaining Bytes() to Destination (Zip) file
    Put #nfd, , Bytes()                 'Loc(nfd) + 1
    'Update Header & File Headers
    'Header
    Hdr.CompSize = Loc(nfd)
    Put #nfd, 4, Hdr                    'Right after "rls" or "rlz" Id

    'File Headers
    n = Hdr.Offset
    For i = 1 To nFiles
        AddFileRec.Offset = aFiles(i).Offset
        AddFileRec.ORSize = aFiles(i).FSize
        AddFileRec.CompSize = aFiles(i).CompSize
        AddFileRec.Changed = aFiles(i).Changed
        AddFileRec.ChkSum = aFiles(i).ChkSum
        AddFileRec.ChkSumComp = aFiles(i).ChkSumComp
        Put #nfd, n + 1, AddFileRec
        n = n + Len(AddFileRec)
    Next

    'Close destination file
    Close #nfd
    xTotalCompSize = FileLen(DestFile)   'Must correspond with Hdr.Zipsize
    xExist = True                       'Update the zip file exists flag
    xCompFile = DestFile
    SetProgress Total, Total, ""
    xElapsedTime = Timer - TmrStart

    Exit Sub

    'Disksplitting
    If xSplitting Then
        SplitZipFile
    End If
    Screen.MousePointer = vbNormal
    Exit Sub

CompFilesErr:
    Ans = errReportAbort("CompFiles()", modname, Err, Error)
        Select Case Ans
            Case vbCancel, vbAbort
                Reset       'Closes all files
                Exit Sub
            Case vbRetry
                Resume
            Case vbOK, vbIgnore
                Resume Next
        End Select

End Sub

Furthermore bytes() is an array I cannot assign value insie. Therefore, how to find out bytes() contain the value 0 after ns =Ubound(Bytes)?

I hope to receive comments ASAP. Thanks

Viewer
0
Comment
Question by:program_viewer
11 Comments
 
LVL 38

Expert Comment

by:PaulHews
Comment Utility
If you take out the On Error Resume Next from the AddString routine, you will see the error causing that to happen.
0
 
LVL 38

Expert Comment

by:PaulHews
Comment Utility
probably an out of bounds error on Bytes meaning it is uninitialized.
0
 
LVL 38

Expert Comment

by:PaulHews
Comment Utility
Put a Redim Bytes(0 to 0) in the CompFiles routine before you call addstring the first time.
0
 

Author Comment

by:program_viewer
Comment Utility
Regarding with putting Redim Bytes(0 to 0), where it should be put? Because if I put inside CompFile, there is another one inside if statement checks for nb is greater than CHUNK_SIZE must be removed.

However, just what you suggested on removing On Error Resume Next in AddString routine, there was no error displayed.

So is it the bytes(0 to 0) put as declaring variable or just before the nb = AddHeader(Bytes, Hdr) in which the AddString is called?
0
 
LVL 38

Expert Comment

by:PaulHews
Comment Utility
Well for all I know, you could be redimensioning the Bytes() array in AddHeader.  But if debug.print ns shows *nothing* in the AddString sub, the only way I can see that that can happen is if the array is uninitialized and Ubound is failing with an error that is being masked by On Error Resume Next.  Can you post the AddHeader code?
0
Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

 
LVL 38

Expert Comment

by:PaulHews
Comment Utility
> just before the nb = AddHeader(Bytes, Hdr) in which the AddString is called? <

That would be the place to put it.
0
 

Author Comment

by:program_viewer
Comment Utility
Here's the AddHeader coding:

Private Function AddHeader(ByRef Bytes() As Byte, Hdr As LempHeader) As Long
    'Add the file header to the byte array
    Dim ns

    On Error Resume Next
    ns = AddString(Bytes, "rlz")          
    ns = AddInt(Bytes, Hdr.Major)
    ns = AddInt(Bytes, Hdr.Minor)
    ns = AddByte(Bytes, Hdr.Vol_No)
    ns = AddByte(Bytes, Hdr.Next_Vol)
    ns = AddLong(Bytes, Hdr.CompSize)
    ns = AddLong(Bytes, Hdr.NumFiles)
    ns = AddLong(Bytes, Hdr.NumIcons)
    ns = AddLong(Bytes, Hdr.Offset)

    AddHeader = UBound(Bytes)
   
End Function
0
 

Author Comment

by:program_viewer
Comment Utility
Here's the AddHeader coding:

Private Function AddHeader(ByRef Bytes() As Byte, Hdr As LempHeader) As Long
    'Add the file header to the byte array
    Dim ns

    On Error Resume Next
    ns = AddString(Bytes, "rlz")          
    ns = AddInt(Bytes, Hdr.Major)
    ns = AddInt(Bytes, Hdr.Minor)
    ns = AddByte(Bytes, Hdr.Vol_No)
    ns = AddByte(Bytes, Hdr.Next_Vol)
    ns = AddLong(Bytes, Hdr.CompSize)
    ns = AddLong(Bytes, Hdr.NumFiles)
    ns = AddLong(Bytes, Hdr.NumIcons)
    ns = AddLong(Bytes, Hdr.Offset)

    AddHeader = UBound(Bytes)
   
End Function
0
 

Author Comment

by:program_viewer
Comment Utility
I just tested the coding, still the program write the data to file incorrectly although the location of the file extension is assigned properly but when I opened with notepad, the result remains the same.
0
 
LVL 49

Expert Comment

by:DanRollins
Comment Utility
Hi program_viewer,
It appears that you have forgotten this question. I will ask Community Support to close it unless you finalize it within 7 days. I will ask a Community Support Moderator to:

    Refund points and save as a 0-pt PAQ.

program_viewer, Please DO NOT accept this comment as an answer.
EXPERTS: Post a comment if you are certain that an expert deserves credit.  Explain why.
==========
DanRollins -- EE database cleanup volunteer
0
 

Accepted Solution

by:
SpideyMod earned 0 total points
Comment Utility
per recommendation

SpideyMod
Community Support Moderator @Experts Exchange
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Introduction While answering a recent question about filtering a custom class collection, I realized that this could be accomplished with very little code by using the ScriptControl (SC) library.  This article will introduce you to the SC library a…
If you have ever used Microsoft Word then you know that it has a good spell checker and it may have occurred to you that the ability to check spelling might be a nice piece of functionality to add to certain applications of yours. Well the code that…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

743 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now