Writing TAR (Tape ARchive) files

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
bojan.dosen
Posts: 166
Joined: May 14, 2007 12:20
Location: Zagreb, Croatia

Writing TAR (Tape ARchive) files

Postby bojan.dosen » May 06, 2012 21:56

I made this simple example for creating TAR archives. Here is include file:

tar.bi

Code: Select all

#Include Once "vbcompat.bi"
#Include Once "file.bi"

/' --------------------------------------------
   Tar archiving by: bojan.dosen
-------------------------------------------- '/

Function unixTime(y As Integer, m As Integer, d As Integer, h As Integer, min As Integer, s As Integer) As Integer
   '' I don't know why but i need subtract 2 hours from original hours
   '' Return (DateSerial(y, m, d)-25569)*86400 + h*3600 + min*60 + s
   Return (DateSerial(y, m, d)-25569)*86400 + (h-2)*3600 + min*60 + s
End Function

Function checksum(buffer As UByte Ptr) As Integer
   Dim As Integer i, chk
   
   For i=0 To 511
      If i >= 148 And i < 156 Then
         chk += 32
         
      Else
         chk += buffer[i]
         
      EndIf
   Next
   
   Return chk
End Function

Function getFname(path As String) As String
   Return Mid(path, InStrRev(path, "\")+1)
End Function

Type tarFile Field = 1
   Private:
   fname      As String
   fmode      As String
   oid      As String
   gid      As String
   fsize      As String
   ctime      As String
   csum      As String
   lid      As String
   nolf      As String
   
   fID      As Integer
   
   Public:
   Declare Sub createArchive(path As String)
   Declare Sub closeArchive()
   Declare Sub addFile(path As String, fname As String = "", lid As Integer = 0)
   Declare Sub addFolder(folderName As String)
End Type

Sub tarFile.createArchive(path As String)
   This.fID = FreeFile()
   
   Open path For Binary As #This.fID
End Sub

Sub tarFile.closeArchive()
   Dim As UByte zero
   Dim As Integer i
   
   For i=0 To 1023
      Put #This.fID,, zero
   Next
   
   Close #This.fID
End Sub

Sub tarFile.addFile(path As String, fname As String = "", lid As Integer = 0)
   Dim As UByte Ptr header
   Dim As Integer i, offs, addfid
   Dim As String tmpStr
   
   header = Allocate(512)
   For i=0 To 511
      header[i] = 0
   Next
   
   If lid = 0 Then
      addfid = FreeFile()
      Open path For Binary As #addfid
   EndIf
   
   '' Change \ to /
   For i=0 To Len(fname)-1
      If Chr(fname[i]) = "\" Then fname[i] = Asc("/")
   Next
   
   '' File name
   offs = 0
   If fname = "" Then
      This.fname = getFname(path)
   Else
      This.fname = fname
   EndIf
   
   For i=0 To Len(This.fname)-1
      header[offs+i] = This.fname[i]
   Next
   
   '' File mode
   offs = 100
   Select Case lid
      Case 0
         This.fmode = "100777 "
      Case 5
         This.fmode = " 40777 "
   End Select
   For i=0 To Len(This.fmode)-1
      header[offs+i] = This.fmode[i]
   Next
   
   '' oid
   offs = 108
   This.oid = "     0 "
   For i=0 To Len(This.oid)-1
      header[offs+i] = This.oid[i]
   Next
   
   '' gid
   offs = 116
   This.gid = "     0 "
   For i=0 To Len(This.gid)-1
      header[offs+i] = This.gid[i]
   Next
   
   '' File size
   offs = 124
   Select Case lid
      Case 0
         This.fsize = Oct(Lof(addfid))
         
      Case 5
         This.fsize = "0"
         
   End Select
   This.fsize = Space(12-Len(This.fsize)-1) & This.fsize & " "
   For i=0 To Len(This.fsize)-1
      header[offs+i] = This.fsize[i]
   Next
   
   '' Date and time
   Dim As String dt = Format(FileDateTime(path), "yyyy/mm/dd hh:mm:ss")
   
   offs = 136
   This.ctime = Oct(unixTime(Val(Mid(dt, 1, 4)), Val(Mid(dt, 6, 2)), Val(Mid(dt, 9, 2)), Val(Mid(dt, 12, 2)), Val(Mid(dt, 15, 2)), Val(Mid(dt, 18, 2))))
   This.ctime = Space(12-Len(This.ctime)-1) & This.ctime & " "
   For i=0 To Len(This.ctime)
      header[offs+i] = This.ctime[i]
   Next
   
   '' Checksum - on the end
   offs = 148
   This.csum = Space(7)
   For i=0 To Len(This.csum)-1
      header[offs+i] = This.csum[i]
   Next
   
   '' Link indicator
   offs = 156
   This.lid = Str(lid)
   header[offs] = This.lid[0]
   
   '' Do checksum
   offs = 148
   This.csum = Oct(checksum(header))
   This.csum = Space(7-Len(This.csum)-1) & This.csum & " "
   For i=0 To Len(This.csum)-1
      header[offs+i] = This.csum[i]
   Next
   
   '' Write to file
   Select Case lid
      Case 0
         Dim As UByte Ptr fbuff
         Dim As Integer fs512
         
         fs512 = Int((Lof(addfid)-1)/512+1)*512
         If fs512 < 0 Then fs512 = 0
         
         fbuff = Allocate(fs512)
         Get #addfid,, fbuff[0], Lof(addfid)
         
         Put #This.fID,, header[0], 512
         Put #This.fID,, fbuff[0], fs512
         
         DeAllocate(fbuff)
         
      Case 5
         Put #This.fID,, header[0], 512
         
   End Select
   
   If lid = 0 Then Close #addfid
   
   DeAllocate(header)
End Sub

Sub tarFile.addFolder(folderName As String)
   '' Example folderName: "documents" or "documents/music" if "documents" exists
   Dim As Integer i
   
   '' Change \ to /
   For i=0 To Len(folderName)-1
      If Chr(folderName[i]) = "\" Then folderName[i] = Asc("/")
   Next
   
   If Right(folderName, 1) <> "/" Then folderName &= "/"
   
   This.addFile("", folderName, 5)
End Sub



And here is little example of adding explorer.exe and cmd.exe in archive:

Code: Select all

#include "tar.bi"

Dim As tarFile myArchive

With myArchive
   .createArchive("Archive.tar")
   .addFile("c:\windows\explorer.exe", "Windows Explorer.exe")
   .addFolder("Empty folder")
   .addFile("c:\windows\system32\cmd.exe", "Folder with file\Command Prompt.exe")
   .closeArchive()
End With



Enjoy!
Last edited by bojan.dosen on May 07, 2012 12:42, edited 1 time in total.
counting_pine
Site Admin
Posts: 6172
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs

Re: Writing TAR (Tape ARchive) files

Postby counting_pine » May 06, 2012 22:52

Cool :)
I don't see any references to deallocate though.. Maybe arrays would be better.
bojan.dosen
Posts: 166
Joined: May 14, 2007 12:20
Location: Zagreb, Croatia

Re: Writing TAR (Tape ARchive) files

Postby bojan.dosen » May 07, 2012 12:43

Sorry, I forgot to deallocate some variables, but it's ok now, I updated the code.
counting_pine
Site Admin
Posts: 6172
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs

Re: Writing TAR (Tape ARchive) files

Postby counting_pine » May 07, 2012 16:17

Here's a version with a few efficiency tweaks (untested):
- Arrays instead of allocate/deallocate
- chr(s[i])="\" tests -> s[i]=asc("\")
- val(mid()) -> valint(mid())
- Int((n-1)/512+1)*512 -> (n+511) and -512 (also note: 'int(a/b)' is the same as but slower than 'a \ b' if a and b are positive.)
- Close the archive with a single 1024byte Put rather than 1024*1byte Puts.

Code: Select all

#Include Once "vbcompat.bi"
#Include Once "file.bi"

/' --------------------------------------------
   Tar archiving by: bojan.dosen
-------------------------------------------- '/

Function unixTime(y As Integer, m As Integer, d As Integer, h As Integer, min As Integer, s As Integer) As Integer
   '' I don't know why but i need subtract 2 hours from original hours
   '' Return (DateSerial(y, m, d)-25569)*86400 + h*3600 + min*60 + s
   Return (DateSerial(y, m, d)-25569)*86400 + (h-2)*3600 + min*60 + s
End Function

Function checksum(buffer As UByte Ptr) As Integer
   Dim As Integer i, chk
   
   For i=0 To 511
      If i >= 148 And i < 156 Then
         chk += 32
         
      Else
         chk += buffer[i]
         
      EndIf
   Next
   
   Return chk
End Function

Function getFname(path As String) As String
   Return Mid(path, InStrRev(path, "\")+1)
End Function

Type tarFile Field = 1
   Private:
   fname      As String
   fmode      As String
   oid      As String
   gid      As String
   fsize      As String
   ctime      As String
   csum      As String
   lid      As String
   nolf      As String
   
   fID      As Integer
   
   Public:
   Declare Sub createArchive(path As String)
   Declare Sub closeArchive()
   Declare Sub addFile(path As String, fname As String = "", lid As Integer = 0)
   Declare Sub addFolder(folderName As String)
End Type

Sub tarFile.createArchive(path As String)
   This.fID = FreeFile()
   
   Open path For Binary As #This.fID
End Sub

Sub tarFile.closeArchive()
   Dim As UByte zero(0 to 1023)

   Put #This.fID,, zero()
   
   Close #This.fID
End Sub

Sub tarFile.addFile(path As String, fname As String = "", lid As Integer = 0)
   Dim As UByte header(0 to 511)
   Dim As Integer i, offs, addfid
   Dim As String tmpStr
   
   'For i=0 To 511
   '   header(i) = 0
   'Next
   
   If lid = 0 Then
      addfid = FreeFile()
      Open path For Binary As #addfid
   EndIf
   
   '' Change \ to /
   For i=0 To Len(fname)-1
      If fname[i] = asc("\") Then fname[i] = Asc("/")
   Next
   
   '' File name
   offs = 0
   If fname = "" Then
      This.fname = getFname(path)
   Else
      This.fname = fname
   EndIf
   
   For i=0 To Len(This.fname)-1
      header(offs+i) = This.fname[i]
   Next
   
   '' File mode
   offs = 100
   Select Case lid
      Case 0
         This.fmode = "100777 "
      Case 5
         This.fmode = " 40777 "
   End Select
   For i=0 To Len(This.fmode)-1
      header(offs+i) = This.fmode[i]
   Next
   
   '' oid
   offs = 108
   This.oid = "     0 "
   For i=0 To Len(This.oid)-1
      header(offs+i) = This.oid[i]
   Next
   
   '' gid
   offs = 116
   This.gid = "     0 "
   For i=0 To Len(This.gid)-1
      header(offs+i) = This.gid[i]
   Next
   
   '' File size
   offs = 124
   Select Case lid
      Case 0
         This.fsize = Oct(Lof(addfid))
         
      Case 5
         This.fsize = "0"
         
   End Select
   This.fsize = Space(12-Len(This.fsize)-1) & This.fsize & " "
   For i=0 To Len(This.fsize)-1
      header(offs+i) = This.fsize[i]
   Next
   
   '' Date and time
   Dim As String dt = Format(FileDateTime(path), "yyyy/mm/dd hh:mm:ss")
   
   offs = 136
   This.ctime = Oct(unixTime(Valint(Mid(dt, 1, 4)), Valint(Mid(dt, 6, 2)), Valint(Mid(dt, 9, 2)), Valint(Mid(dt, 12, 2)), Valint(Mid(dt, 15, 2)), Valint(Mid(dt, 18, 2))))
   This.ctime = Space(12-Len(This.ctime)-1) & This.ctime & " "
   For i=0 To Len(This.ctime)
      header(offs+i) = This.ctime[i]
   Next
   
   '' Checksum - on the end
   offs = 148
   This.csum = Space(7)
   For i=0 To Len(This.csum)-1
      header(offs+i) = This.csum[i]
   Next
   
   '' Link indicator
   offs = 156
   This.lid = Str(lid)
   header(offs) = This.lid[0]
   
   '' Do checksum
   offs = 148
   This.csum = Oct(checksum(@header(0)))
   This.csum = Space(7-Len(This.csum)-1) & This.csum & " "
   For i=0 To Len(This.csum)-1
      header(offs+i) = This.csum[i]
   Next
   
   '' Write to file
   Select Case lid
      Case 0
         Dim As UByte fbuff()
         Dim As Integer fs512
         
         fs512 = (lof(addfid) + 511) and -512
         
         redim fbuff(0 to fs512-1)
         Get #addfid,, fbuff(0), Lof(addfid)
         
         Put #This.fID,, header()
         Put #This.fID,, fbuff(0), fs512
         
      Case 5
         Put #This.fID,, header()
         
   End Select
   
   If lid = 0 Then Close #addfid
   
End Sub

Sub tarFile.addFolder(folderName As String)
   '' Example folderName: "documents" or "documents/music" if "documents" exists
   Dim As Integer i
   
   '' Change \ to /
   For i=0 To Len(folderName)-1
      If folderName[i] = asc("\") Then folderName[i] = Asc("/")
   Next
   
   If Right(folderName, 1) <> "/" Then folderName &= "/"
   
   This.addFile("", folderName, 5)
End Sub


More efficiency savings could be made at the cost of readability, or perhaps by someone with more knowledge of date handling. By the way, I speculate that the 2h gap is something to do with timezones.

Why is there so much octal by the way, does Tar store numbers in octal text?
bojan.dosen
Posts: 166
Joined: May 14, 2007 12:20
Location: Zagreb, Croatia

Re: Writing TAR (Tape ARchive) files

Postby bojan.dosen » May 07, 2012 16:32

I tested your code, it works nice! Thanks for improvements.
Yes tar stores numbers as octal ASCII values, but "star format" tar file uses base-256 encoding.
marcov
Posts: 2766
Joined: Jun 16, 2005 9:45
Location: Eindhoven, NL
Contact:

Re: Writing TAR (Tape ARchive) files

Postby marcov » May 07, 2012 17:01

counting_pine wrote:
Why is there so much octal by the way, does Tar store numbers in octal text?


Many older CPU's (old Crays, and also PDP-8, an ancestor of the PDP11) had a word size that was not a multiple of 8 bits, but 6. E.g. PDP-8 had several registers 12-bits in size.

One C's predecessors B therefore introduced octal notation, which is easier for multiples of 6 bits.
creek23
Posts: 260
Joined: Sep 09, 2007 1:57
Location: Philippines
Contact:

Re: Writing TAR (Tape ARchive) files

Postby creek23 » Jul 25, 2012 11:10

It might be the headache from flu I now have or I'm just too lazy to search the forums but, has someone wrote a TAR Reader? I surely would like to add this read/write TAR feature on Quixie.

~creek23
bcohio2001
Posts: 545
Joined: Mar 10, 2007 15:44
Location: Ohio, USA
Contact:

Re: Writing TAR (Tape ARchive) files

Postby bcohio2001 » Sep 13, 2012 21:12

I have no personal use for Tar archives, so if someone wants to pick this up and run with it .....
LibTar_Source
Gonzo
Posts: 722
Joined: Dec 11, 2005 22:46

Re: Writing TAR (Tape ARchive) files

Postby Gonzo » Sep 14, 2012 0:08

very nice, i will definitely be trying this out =)

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 3 guests