Writing TAR (Tape ARchive) files

bojan.dosen · Post by **bojan.dosen** » May 06, 2012 21:56

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

tar.bi

#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!

Post by **counting_pine** » May 06, 2012 22:52

Cool :)
I don't see any references to deallocate though.. Maybe arrays would be better.

bojan.dosen · Post by **bojan.dosen** » May 07, 2012 12:43

Sorry, I forgot to deallocate some variables, but it's ok now, I updated the code.

Post by **counting_pine** » May 07, 2012 16:17

Here's a version with a few efficiency tweaks (untested):
- Arrays instead of allocate/deallocate
- chr(s)="\" tests -> s=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 · Post by **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 · Post by **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 · Post by **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 · Post by **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 · Post by **Gonzo** » Sep 14, 2012 0:08

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

Writing TAR (Tape ARchive) files

Writing TAR (Tape ARchive) files

Re: Writing TAR (Tape ARchive) files

Re: Writing TAR (Tape ARchive) files

Re: Writing TAR (Tape ARchive) files

Re: Writing TAR (Tape ARchive) files

Re: Writing TAR (Tape ARchive) files

Re: Writing TAR (Tape ARchive) files

Re: Writing TAR (Tape ARchive) files

Re: Writing TAR (Tape ARchive) files