Celebrate National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

Error writing file header

Posted on 2002-07-23
11
Medium Priority
?
280 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
11 Comments
 
LVL 38

Expert Comment

by:PaulHews
ID: 7171812
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
ID: 7171822
probably an out of bounds error on Bytes meaning it is uninitialized.
0
 
LVL 38

Expert Comment

by:PaulHews
ID: 7171826
Put a Redim Bytes(0 to 0) in the CompFiles routine before you call addstring the first time.
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 

Author Comment

by:program_viewer
ID: 7173758
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
ID: 7174230
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
 
LVL 38

Expert Comment

by:PaulHews
ID: 7174231
> 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
ID: 7174661
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
ID: 7174667
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
ID: 7174696
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
ID: 8040402
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
ID: 8095726
per recommendation

SpideyMod
Community Support Moderator @Experts Exchange
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction In a recent article (http://www.experts-exchange.com/A_7811-A-Better-Concatenate-Function.html) for the Excel community, I showed an improved version of the Excel Concatenate() function.  While writing that article I realized that no o…
Enums (shorthand for ‘enumerations’) are not often used by programmers but they can be quite valuable when they are.  What are they? An Enum is just a type of variable like a string or an Integer, but in this case one that you create that contains…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
Suggested Courses

730 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