Jak na tar archiv? – Visual Basic – Fórum – Programujte.com
 x   TIP: Přetáhni ikonu na hlavní panel pro připnutí webu
Reklama
Reklama

Jak na tar archiv? – Visual Basic – Fórum – Programujte.comJak na tar archiv? – Visual Basic – Fórum – Programujte.com

 

Hledá se programátor! Plat 1 800 € + bonusy (firma Boxmol.com)
radek0
Duch
8. 8. 2006   #1
-
0
-

Jak rozbalit a sbalit tar archviv. Pripadne kde sehnat tridu, ktera je free a jak ji pouzit.
Dik moc za odpovedi.

Nahlásit jako SPAM
IP: ...–
Reklama
Reklama
Jiří Chytil0
Věrný člen
9. 8. 2006   #2
-
0
-

myls?m ?e na to sp?? ne? t??du bude? pot?ebovat n?jakou knihovnu, m?m li b?t upr??mn? tak netu??m zda je tar free ale pokud ano tak by s touto knihovnou nem?l b?t probl?m. zkus?m seve voln? chv?li pod?vat.

Nahlásit jako SPAM
IP: ...–
Elektronika a microprocesory a matematika www.8bitu.cz
Jiří Chytil0
Věrný člen
9. 8. 2006   #3
-
0
-

Knihovnu tar.dll jsem našel na

http://windll.com/library-t_000.php

Nahlásit jako SPAM
IP: ...–
Elektronika a microprocesory a matematika www.8bitu.cz
Jiří Chytil0
Věrný člen
9. 8. 2006   #4
-
0
-

nějak mi to nedalo tak sem zháněl a sehnal:

jedná se o kód třídy který by neměl být problém použít. Pokud bus k tomu chtěl zbytek, celý program, tak se merkni na: http://www.planetsourcecode.com/vb/scripts/ShowCode.asp?txtCodeId=53174&lngWId=1


Option Explicit

'This class file can be used to show the contents of a TAR-file

'data for TAR files
Private Type TarHeaderType 'byte offset
FName As String * 100 ' 0
Mode As String * 8 '100
Uid As String * 8 '108
Gid As String * 8 '116
Size As String * 12 '124
Mtime As String * 12 '136
Chksum As String * 8 '148
Typeflag As String * 1 '156
Linkname As String * 100 '157
Magic As String * 6 '257
Version As String * 2 '263
Uname As String * 32 '265
Gname As String * 32 '297
Devmajor As String * 8 '329
Devminor As String * 8 '337
Prefix As String * 155 '345
Total As String * 12 '500 only to total the block size to 512
End Type '512
Private Type TarFilesType
FileName As String
FileDateUnix As Long
FDate As Integer
FTime As Integer
DataLenght As Long
DataOffSet As Long
SumHeader As Long
End Type

Private TarHead As TarHeaderType
Private TarFiles() As TarFilesType
Private Const m_Unpack_Supported As Boolean = True

Public Function Get_Contents(ZipName As String) As Integer
Dim FileNum As Long
Dim FileLenght As Long
Dim LN As Long
PackFileName = ZipName
PackComments = ""
FileNum = FreeFile
Open PackFileName For Binary Access Read As #FileNum
FileLenght = LOF(FileNum)
PackFileType = 0
PackTotFiles = 0
ReDim TarFiles(100)
Do
If PackTotFiles = UBound(TarFiles) Then ReDim Preserve TarFiles(PackTotFiles + 50)
Get #FileNum, , TarHead
TarFiles(PackTotFiles + 1).FileName = Replace(TarHead.FName, vbNullChar, "")
If TarFiles(PackTotFiles + 1).FileName = "" Then Exit Do
PackTotFiles = PackTotFiles + 1
TarFiles(PackTotFiles).FileDateUnix = OctToLng(TarHead.Mtime)
TarFiles(PackTotFiles).SumHeader = OctToLng(TarHead.Chksum)
TarFiles(PackTotFiles).FDate = GetIntegerDate(TarFiles(PackTotFiles).FileDateUnix)
TarFiles(PackTotFiles).FTime = GetIntegerTime(TarFiles(PackTotFiles).FileDateUnix)
LN = OctToLng(TarHead.Size)
TarFiles(PackTotFiles).DataLenght = LN
TarFiles(PackTotFiles).DataOffSet = Seek(FileNum)
Do While LN > 0
Seek #FileNum, Seek(FileNum) + 512
LN = LN - 512
Loop
Loop
ReDim Preserve TarFiles(PackTotFiles)
If PackTotFiles > 0 Then PackFileType = TARFileType
Close FileNum
End Function

'Unzip as file and return 0 for good decompression or others for error
Public Function UnPack(ZippedFile() As Boolean, ToPath As String) As Integer
' Dim ZipHead As Local_Header_Type 'Local Zip Header
Dim Header As Long
Dim X As Long
Dim FileNum As Long
Dim Y As Long
Dim TotDir As String 'Used for new pathnames
If PackTotFiles = 0 Then UnPack = -10: Exit Function 'nothing to UnPack
If PackTotFiles <> UBound(ZippedFile) Then
UnPack = -10 'need same amount as files in zipfile
Exit Function
End If
Erase PackData
FileNum = FreeFile
Open PackFileName For Binary Access Read As #FileNum
For X = 1 To PackTotFiles
If ZippedFile(X) = True Then
If Not IsDir(X) Then 'extract data if no dir
ReDim PackData(TarFiles(X).DataLenght - 1)
Seek #FileNum, TarFiles(X).DataOffSet
If TarFiles(X).DataLenght = 0 Then
Erase PackData
Else
ReDim PackData(TarFiles(X).DataLenght - 1)
Get #FileNum, , PackData() 'Read the compressed file
End If
Call Write_Uncompressed_Data(X, ToPath)
Else
TotDir = ToPath
If Right(TotDir, 1) <> "" And Right(TotDir, 1) <> "/" Then TotDir = TotDir & ""
TotDir = TotDir & TarFiles(X).FileName
If CreatePath(TotDir) = False Then
MsgBox ("error creating directory " & TotDir)
End If
End If
End If
Next
Close FileNum
Erase PackData
End Function

Public Function Pack(ZipName As String, Files() As String, CompType As Integer, CompLevel As Integer, Optional IncludeDir As String = "") As Integer

End Function

Public Property Get CanUnpack() As Boolean
CanUnpack = m_Unpack_Supported
End Property

Public Property Get FileName(FileNum As Long) As String
If NotGood(FileNum) Then Exit Property
FileName = TarFiles(FileNum).FileName
End Property

Public Property Get CommentsFile(FileNum As Long) As String
If NotGood(FileNum) Then Exit Property
CommentsFile = "Not Supported"
End Property

Public Property Get CommentsPack() As String
CommentsPack = ""
End Property

Public Property Get IsDir(FileNum As Long) As Boolean
If NotGood(FileNum) Then Exit Property
If TarFiles(FileNum).DataLenght = 0 Then
If Right(TarFiles(FileNum).FileName, 1) = "/" Then IsDir = True
End If
End Property

Public Property Get Method(FileNum As Long) As String
If NotGood(FileNum) Then Exit Property
Method = "Stored"
End Property

Public Property Get CRC32(FileNum As Long) As Long
CRC32 = 0
End Property

Public Property Get Compressed_Size(FileNum As Long) As Long
If NotGood(FileNum) Then Exit Property
Compressed_Size = TarFiles(FileNum).DataLenght
End Property

Public Property Get UnCompressed_Size(FileNum As Long) As Long
If NotGood(FileNum) Then Exit Property
UnCompressed_Size = TarFiles(FileNum).DataLenght
End Property

Public Property Get Encrypted(FileNum As Long) As Boolean
If NotGood(FileNum) Then Exit Property
Encrypted = False
End Property

Public Property Get FileDateTime(FileNum As Long) As Date
If NotGood(FileNum) Then Exit Property
FileDateTime = GetZipDate(TarFiles(FileNum).FDate, TarFiles(FileNum).FTime)
End Property

Public Property Get SystemMadeBy(FileNum As Long) As String
SystemMadeBy = "UnKnown"
End Property

Public Property Get VersionMadeBy(FileNum As Long) As String
VersionMadeBy = "UnKnown"
End Property

Public Property Get SystemNeeded(FileNum As Long) As String
SystemNeeded = "UnKnown"
End Property

Public Property Get VersionNeeded(FileNum As Long) As String
VersionNeeded = "UnKnown"
End Property

Private Function OctToLng(OctVal As String) As Long
Dim OctNum As String
Dim X As Integer
OctNum = Trim(Replace(OctVal, vbNullChar, ""))
Do While Left(OctNum, 1) = "0"
OctNum = Mid(OctNum, 2)
Loop
For X = 1 To Len(OctNum)
OctToLng = OctToLng + CLng(Val(Mid(OctNum, X, 1))) * 8 ^ (Len(OctNum) - X)
Next
End Function

Private Function NotGood(FileNum As Long) As Boolean
If FileNum = 0 Then NotGood = True: Exit Function
If FileNum > PackTotFiles Then NotGood = True: Exit Function
If PackFileType = 0 Then NotGood = True: Exit Function
End Function

Private Function StampToData(Stamp) As Date
StampToData = CDate(CDbl(DateSerial(1970, 1, 1)) + CDbl((CLng(Stamp) / 86400)))
End Function

Private Function GetIntegerDate(Stamp As Long) As Integer
Dim Dat As String
Dim FD As Long
Dat = StampToData(Stamp)
FD = (Year(Dat) - 1980) * 2 ^ 9
FD = FD + (Month(Dat) * 2 ^ 5)
FD = FD + Day(Dat)
If FD > 32767 Then GetIntegerDate = FD - &HFFFF& - 1 Else GetIntegerDate = FD
End Function

Private Function GetIntegerTime(Stamp As Long) As Integer
Dim Dat As String
Dim FT As Long
Dat = StampToData(Stamp)
FT = Hour(Dat) * 2 ^ 11
FT = FT + (Minute(Dat) * 2 ^ 5)
FT = FT + Second(Dat)
If FT > 32767 Then GetIntegerTime = FT - &HFFFF& - 1 Else GetIntegerTime = FT
End Function

Private Sub Write_Uncompressed_Data(FileNum As Long, ToPath As String)
Dim DSize As Long
DSize = DataSize
If TarFiles(FileNum).DataLenght <> DSize Then
MsgBox "Error in decompressed size"
End If
If Write_File(TarFiles(FileNum).FileName, ToPath, PackData(), TarFiles(FileNum).FDate, TarFiles(FileNum).FTime) <> 0 Then
MsgBox "error writing file"
End If
End Sub

Private Function DataSize() As Long
On Error Resume Next
DataSize = UBound(PackData) + 1
If Err.Number <> 0 Then
Err.Clear
DataSize = 0
End If
End Function

Nahlásit jako SPAM
IP: ...–
Elektronika a microprocesory a matematika www.8bitu.cz
radek0
Duch
10. 8. 2006   #5
-
0
-

Super, dik moc za rady, jdu to vyzkouset,
mej te se

Nahlásit jako SPAM
IP: ...–
Jiří Chytil0
Věrný člen
10. 8. 2006   #6
-
0
-

není zač přeju at se to povede

Nahlásit jako SPAM
IP: ...–
Elektronika a microprocesory a matematika www.8bitu.cz
Zjistit počet nových příspěvků

Přidej příspěvek

Toto téma je starší jak čtvrt roku – přidej svůj příspěvek jen tehdy, máš-li k tématu opravdu co říct!

Ano, opravdu chci reagovat → zobrazí formulář pro přidání příspěvku

×Vložení zdrojáku

×Vložení obrázku

Vložit URL obrázku Vybrat obrázek na disku
Vlož URL adresu obrázku:
Klikni a vyber obrázek z počítače:

×Vložení videa

Aktuálně jsou podporována videa ze serverů YouTube, Vimeo a Dailymotion.
×
 
Podporujeme Gravatara.
Zadej URL adresu Avatara (40 x 40 px) nebo emailovou adresu pro použití Gravatara.
Email nikam neukládáme, po získání Gravatara je zahozen.
-
Pravidla pro psaní příspěvků, používej diakritiku. ENTER pro nový odstavec, SHIFT + ENTER pro nový řádek.
Sledovat nové příspěvky (pouze pro přihlášené)
Sleduj vlákno a v případě přidání nového příspěvku o tom budeš vědět mezi prvními.
Reaguješ na příspěvek:

Uživatelé prohlížející si toto vlákno

Uživatelé on-line: 0 registrovaných, 26 hostů

Moderátoři diskuze

 

Hostujeme u Českého hostingu       ISSN 1801-1586       ⇡ Nahoru Webtea.cz logo © 20032016 Programujte.com
Zasadilo a pěstuje Webtea.cz, šéfredaktor Lukáš Churý