tar.gz Module

Share your advanced PureBasic knowledge/code with the community.
Deluxe0321
User
User
Posts: 69
Joined: Tue Sep 16, 2008 6:11 am
Location: ger

tar.gz Module

Post by Deluxe0321 »

A Module to access, read and extract tar.gz files. Only tested on Windows, let me know how it works with other OS.

Code: Select all

;only in Ascii Mode for now..
DeclareModule TarGZ
  
  #TAR_RECORDSIZE  = 512
  #TAR_NAMESIZE    = 100
  #TAR_TUNMLEN     = 32
  #TAR_TGNMLEN     = 32

  Structure tar_gz
    File.s
    Size.i
  EndStructure
  
  Structure gzFile_s
    have.i
    *Next
    pos.i
  EndStructure
  
  Structure TARHeader
    name.s {#TAR_NAMESIZE}
    mode.s {8}
    uid.s {8}
    gid.s {8}
    size.s {12}
    mtime.s {12}
    checksum.s {8}
    linkflag.b
    linkname.s {#TAR_NAMESIZE}
    magic.s {8}
    uname.s {#TAR_TUNMLEN}
    gname.s {#TAR_TGNMLEN}
    devmajor.s {8}
    devminor.s {8}
    prefix.s {155}
    clearence.s {12}
  EndStructure  
  
  Structure TarGZFile
    File.s
    Size.i
    PFrom.q
  EndStructure
  
  Structure TarGZ
    File.s
    List Files.TarGZFile()
  EndStructure
  
  Declare.i OpenTarGz(File.s)
  
  Declare.i CloseTarGz(*TarGZ.TarGZ)
  
  Declare.i ExamineTarGZ(*TarGZ.TarGZ)
  
  Declare.i NextTarGZPackFile(*TarGZ.TarGZ)  
  
  Declare.i PreviousTarGZPackFile(*TarGZ.TarGz)
  
  Declare.s GetTarGZPackFileName(*TarGZ.TarGZ)
  
  Declare.i GetTarGZPackFileSize(*TarGZ.TarGZ)
  
  Declare.i UncompressTarGZPackFile(*TarGZ.TarGZ,*TargetMemory,PackFileName.s = "")
  
  Declare.i ExtractTarGZPackFile(*TarGZ.TarGZ,File.s,PackFileName.s = "")
  
EndDeclareModule


Module TarGZ

;{-- private

  CompilerSelect #PB_Compiler_OS
    CompilerCase #PB_OS_Windows  
    ImportC "oldnames.lib" : EndImport
    EnableASM
      !extrn __imp__vsnprintf
      !public __imp__vsnprintf
    DisableASM
      
    ImportC "zlib.lib"
      gzopen.i(File.p-ascii, b.p-ascii)
      gzclose.i(*fileHandle)
      gzread.i(*fileHandle, *Mem, Size.l)
      gzseek.i(*fileHandle,offset.l,whence.i)
      gzeof.i(a.l) 
    EndImport
  CompilerDefault
    
    #SEEK_SET = 0
    #SEEK_CUR = 1
    #SEEK_END = 2
    
    ImportC "-lz"
      gzopen.i(File.p-ascii, b.p-ascii)
      gzclose.i(*fileHandle)
      gzread.i(*fileHandle, *Mem, Size.l)
      gzseek.i(*fileHandle,offset.l,whence.i)
      gzeof.i(a.l) 
    EndImport
    
  CompilerEndSelect
    ;from DoubleDutch
    ;@ http://www.purebasic.fr/english/viewtopic.php?p=178422#p178422
    Procedure.s Base(string$,base,base2=10)
       Static table$="0123456789abcdef"
       If base>1 And base<17 And base2>1 And base2<17
          If base=base2
             result$=string$
          Else
             If base>10
                string$=LCase(string$)
             EndIf
             For loop=1 To Len(string$)
                digit=FindString(table$,Mid(string$,loop,1),1)
                If digit
                   number.q*base
                   number+(digit-1)
                EndIf
             Next
             If base2=10
                result$=Str(number)
             Else
                Repeat
                   remainder=number%base2
                   number=number/base2
                   result$=Mid(table$,remainder+1,1)+result$
                Until number=0
             EndIf
          EndIf
       EndIf
       ProcedureReturn result$
     EndProcedure    
     
    Procedure ExtractTarGZ(File.s,Pos.q,Size.i,*Memory = 0)
      
      Protected *FileHandle.gzFile_s = gzopen(File.s,"r")
      Protected RSize.i
      
      If *Filehandle
        
        If Not gzseek(*FileHandle,Pos.q,#SEEK_SET) = - 1
          
          If Not *Memory
            *Memory = AllocateMemory(Size.i,#PB_Memory_NoClear)
          EndIf
          
          If *Memory
            RSize.i = gzread(*FileHandle,*Memory,Size.i)
            gzclose(*Filehandle)
            
            If RSize.i = Size.i
              ProcedureReturn *Memory   
            EndIf  
            
          EndIf
          
        EndIf
        
      EndIf
      
    EndProcedure
     
    Macro PCheck(__WHAT)
      If Not *TarGZ : ProcedureReturn __WHAT : EndIf
      If Not ListSize(*TarGZ\Files()) : ProcedureReturn __WHAT : EndIf       
    EndMacro
     
  ;}-- private
  

  Procedure OpenTarGz(File.s)
    
    If FileSize(File.s) > 0
      
      Protected *FileHandle.gzFile_s = gzopen(File.s,"r")
      Protected Tar.TarHeader
      Protected *TarGZ.TarGZ
      Protected CurrPos.q, Size.i, JumpTo.i

      If *FileHandle
        
        *TarGZ = AllocateMemory(SizeOf(TarGZ))
        InitializeStructure(*TarGZ,TarGZ)
        
        *TarGZ\File.s = File
        
        While Not gzeof(*FileHandle)
          Protected Readed.i = gzread(*Filehandle,@Tar,SizeOf(TarHeader))
          
          CurPos.q + Readed.i
          
          If Readed.i > 0
            Size.i = Val(Base(Tar\size.s,8))
            
            JumpTo.i = Round((CurPos.q + Size.i) / SizeOf(TarHeader),#PB_Round_Up) * SizeOf(TarHeader)            
            
            If Size.i > 0 And Trim(Tar\name.s)
              
              If AddElement(*TarGZ\Files())
                With *TarGZ\Files()
                  \File.s     = Tar\name.s
                  \Size.i     = Size.i
                  \PFrom      = CurPos.q
                EndWith
              EndIf            
            EndIf
            
            CurPos.q = gzseek(*FileHandle,JumpTo.i,#SEEK_SET)
            
            If CurPos.q = -1 Or Readed.i = -1
              gzclose(*FileHandle)         : ClearList(*TarGZ\Files())
              ClearStructure(*TarGZ,TarGZ) :FreeMemory(*TarGZ)
              ProcedureReturn #False
            EndIf
            
          EndIf
          
        Wend
        
        gzclose(*Filehandle)
        
        If ListSize(*TarGZ\Files())
          ProcedureReturn *TarGZ  
        EndIf
        
      EndIf
      
    EndIf
    
  EndProcedure
  
  Procedure CloseTarGz(*TarGZ.TarGZ)
    
    If Not *TarGZ : ProcedureReturn #False : EndIf
    
    ClearList(*TarGZ\Files())
    ClearStructure(*TarGZ,TarGZ)
    FreeMemory(*TarGZ)
    
    ProcedureReturn #True
  EndProcedure
  
  Procedure ExamineTarGZ(*TarGZ.TarGZ)
    PCheck(#False)
    ProcedureReturn ResetList(*TarGZ\Files())
  EndProcedure

  Procedure NextTarGZPackFile(*TarGZ.TarGZ)
    PCheck(#False)
    ProcedureReturn NextElement(*TarGZ\Files())
  EndProcedure
  
  Procedure PreviousTarGZPackFile(*TarGZ.TarGz)
    PCheck(#False)
    ProcedureReturn PreviousElement(*TarGZ\Files())
  EndProcedure
  
  Procedure.s GetTarGZPackFileName(*TarGZ.TarGZ)
    PCheck(#NULL$)
    ProcedureReturn *TarGZ\Files()\File.s
  EndProcedure
  
  Procedure.i GetTarGZPackFileSize(*TarGZ.TarGZ)
    PCheck(#False)
    ProcedureReturn *TarGZ\Files()\Size.i
  EndProcedure
  
  Procedure.i UncompressTarGZPackFile(*TarGZ.TarGZ,*TargetMemory,PackFileName.s = "")
    PCheck(#False)
    
    If Not *TargetMemory
      ProcedureReturn #False
    EndIf
    
    If PackFileName.s
      Protected *Curr = @*TarGZ\Files()
      ForEach *TarGZ\Files()
        If *TarGZ\Files()\File.s = PackFileName.s
          ExtractTarGZ(*TarGZ\File.s,*TarGZ\Files()\PFrom.q,*TarGZ\Files()\Size.i,*TargetMemory)
        EndIf
      Next
      ChangeCurrentElement(*TarGZ\Files(),*Curr)
      ProcedureReturn *TargetMemory
    Else
      *TargetMemory =  ExtractTarGZ(*TarGZ\File.s,*TarGZ\Files()\PFrom.q,*TarGZ\Files()\Size.i,*TargetMemory)
      ProcedureReturn *TargetMemory
    EndIf
    
  EndProcedure
  
  Procedure.i ExtractTarGZPackFile(*TarGZ.TarGZ,File.s,PackFileName.s = "")
    
    Protected *TargetMemory, FileID.i
    
    PCheck(#False)
    
    If File.s = "" : ProcedureReturn #False : EndIf
    
    If PackFileName.s
      Protected *Curr = @*TarGZ\Files()
      ForEach *TarGZ\Files()
        If *TarGZ\Files()\File.s = PackFileName.s
          *TargetMemory = ExtractTarGZ(*TarGZ\File.s,*TarGZ\Files()\PFrom.q,*TarGZ\Files()\Size.i)
        EndIf
      Next
      ChangeCurrentElement(*TarGZ\Files(),*Curr)
    Else
      *TargetMemory = ExtractTarGZ(*TarGZ\File.s,*TarGZ\Files()\PFrom.q,*TarGZ\Files()\Size.i,*TargetMemory)
    EndIf
    
    If *TargetMemory And MemorySize(*TargetMemory)
      
      FileID.i = CreateFile(#PB_Any,File.s)
      If FileID.i
        WriteData(FileID.i,*TargetMemory,MemorySize(*TargetMemory))
        FreeMemory(*TargetMemory)
        CloseFile(FileID.i)
        ProcedureReturn #True
      Else
        FreeMemory(*TargetMemory) 
      EndIf
      
    EndIf
    
    ProcedureReturn #False 
    
  EndProcedure
  
EndModule



CompilerIf #PB_Compiler_IsMainFile = #True
  
  InitNetwork()
  OpenConsole("")
  PrintN("Downloading http://www.libssh2.org/download/libssh2-1.4.3.tar.gz....")
  File.s = GetTemporaryDirectory() + "libssh2-1.4.3.tar.gz" 
  If ReceiveHTTPFile("http://www.libssh2.org/download/libssh2-1.4.3.tar.gz",File.s )
   Tar.i = TarGZ::OpenTarGz(File.s)
   If Tar.i
     If TarGZ::ExamineTarGZ(Tar.i)
       While TarGZ::NextTarGZPackFile(Tar.i)
         PrintN("Name: "+TarGZ::GetTarGZPackFileName(Tar.i))
         PrintN(Space(3)+"- Size: "+TarGZ::GetTarGZPackFileSize(Tar.i))
         If Random(10) % 2
           *mem = AllocateMemory(TarGZ::GetTarGZPackFileSize(Tar.i))
           *mem = TarGZ::UncompressTarGZPackFile(Tar.i,*mem)
           Debug PeekS(*mem)
           FreeMemory(*mem)
         EndIf
         Debug ""
       Wend
     EndIf
    TarGZ::CloseTarGz(Tar.i)  
   EndIf
   
   DeleteFile(File.s)
  EndIf
  
  End
 
 CompilerEndIf
(//bugfix 08/06/13)
(//added Linux and OSX support - x64 is still not supported for Windows, rest is)
Thank you!
Last edited by Deluxe0321 on Fri Oct 25, 2013 10:57 pm, edited 2 times in total.
Fred
Administrator
Administrator
Posts: 18161
Joined: Fri May 17, 2002 4:39 pm
Location: France
Contact:

Re: tar.gz Module

Post by Fred »

Nice ! You should put the structure in the Module : EndModule section as they don't mean to be publicly accessed (or I miss something).
User avatar
Bisonte
Addict
Addict
Posts: 1305
Joined: Tue Oct 09, 2007 2:15 am

Re: tar.gz Module

Post by Bisonte »

And only x86 , you forgot to say ;)

but the demo not work. Result of OpenTar is always 0. Or miss I something ?
PureBasic 6.21 (Windows x64) | Windows 11 Pro | AsRock B850 Steel Legend Wifi | R7 9800x3D | 64GB RAM | RTX 5080 | ThermaltakeView 270 TG ARGB | build by vannicom​​
English is not my native language... (I often use DeepL.)
Deluxe0321
User
User
Posts: 69
Joined: Tue Sep 16, 2008 6:11 am
Location: ger

Re: tar.gz Module

Post by Deluxe0321 »

And only x86 , you forgot to say ;)
That's true, I tried to include x64 functionality, but sadly the import throws strange errors:

Code: Select all

;x64 zlib import
ImportC "oldnames.lib" : EndImport

EnableASM
  !extrn __imp_vsnprintf
  !public __imp_vsnprintf      
DisableASM
  
ImportC "zlib.lib"
  gzopen.i(File.s, b.p-ascii) As "gzopen64"
  gzclose.i(*fileHandle) As "gzclose"
  gzread.i(*fileHandle, *Mem, Size.l) As "gzread"
  gzseek.i(*fileHandle,offset.l,whence.i) As "gzseek64"
  gzeof.i(a.l) As "gzeof"
EndImport      
not exactly sure how to handle these..
but the demo not work. Result of OpenTar is always 0. Or miss I something ?
Works fine here - are you trying to open a diffrent file than libssh?
User avatar
Bisonte
Addict
Addict
Posts: 1305
Joined: Tue Oct 09, 2007 2:15 am

Re: tar.gz Module

Post by Bisonte »

copy from forum, paste into ide... hit f5 to run...
Only download the tar.gz file to tempdir and then end.
nothing more happens ...
PureBasic 6.21 (Windows x64) | Windows 11 Pro | AsRock B850 Steel Legend Wifi | R7 9800x3D | 64GB RAM | RTX 5080 | ThermaltakeView 270 TG ARGB | build by vannicom​​
English is not my native language... (I often use DeepL.)
User avatar
ts-soft
Always Here
Always Here
Posts: 5756
Joined: Thu Jun 24, 2004 2:44 pm
Location: Berlin - Germany

Re: tar.gz Module

Post by ts-soft »

@Bisonte

You are using Unicode?
PureBasic 5.73 | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Old bugs good, new bugs bad! Updates are evil: might fix old bugs and introduce no new ones.
Image
User avatar
Bisonte
Addict
Addict
Posts: 1305
Joined: Tue Oct 09, 2007 2:15 am

Re: tar.gz Module

Post by Bisonte »

no...
PureBasic 6.21 (Windows x64) | Windows 11 Pro | AsRock B850 Steel Legend Wifi | R7 9800x3D | 64GB RAM | RTX 5080 | ThermaltakeView 270 TG ARGB | build by vannicom​​
English is not my native language... (I often use DeepL.)
Deluxe0321
User
User
Posts: 69
Joined: Tue Sep 16, 2008 6:11 am
Location: ger

Re: tar.gz Module

Post by Deluxe0321 »

Sounds like a permission issue - Run in Administrator Mode (Compilier flag) - or check if any Anti Virus is blocking it.

Thank you!
User avatar
Bisonte
Addict
Addict
Posts: 1305
Joined: Tue Oct 09, 2007 2:15 am

Re: tar.gz Module

Post by Bisonte »

aaaaaaaaaaarg.... problem solved. Avira ! grrr.

sorry.
PureBasic 6.21 (Windows x64) | Windows 11 Pro | AsRock B850 Steel Legend Wifi | R7 9800x3D | 64GB RAM | RTX 5080 | ThermaltakeView 270 TG ARGB | build by vannicom​​
English is not my native language... (I often use DeepL.)
Post Reply