leoarsalan
سه شنبه 10 خرداد 1390, 21:13 عصر
سلام دوستان عزیز بنده کد زیر رو از یک بنده خدایی گرفتم اما نمدونمن چطوری باید ازش استفاده کنم طرف هم دیگه جوابم رو نمیده میشه بگین چطوری باید با این کد یک فایل رو انزلیب کنم یا زلیب کنم .
Private Declare Function compress Lib "zlib.dll" (dest As Any, destlen As Any, src As Any, ByVal srclen As Long) As Long
Private Declare Function uncompress Lib "zlib.dll" (dest As Any, destlen As Any, src As Any, ByVal srclen As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Function CompressData(Dati() As Byte)
Dim Dimensions As Long
Dimensions = UBound(Dati) + 1
Dim DimBuffer As Long
Dim BufTemp() As Byte
DimBuffer = Dimensions + (Dimensions * 0.01) + 12
ReDim BufTemp(DimBuffer)
compress BufTemp(0), DimBuffer, Dati(0), Dimensions
ReDim Preserve Dati(DimBuffer - 1)
CopyMemory Dati(0), BufTemp(0), DimBuffer
Erase BufTemp
End Function
Public Function CompressFile(Source As String, Destination As String)
Dim Dati() As Byte
Dim Dimensions As Long
ReDim Dati(FileLen(Source) - 1)
Dimensions = UBound(Dati) + 1
Open Source For Binary Access Read As #1
Get #1, , Dati()
Close #1
CompressData Dati()
Open Destination For Binary Access Write As #1
Put #1, , Dimensions
Put #1, , Dati()
Close #1
End Function
Private Function UncompressData(Dati() As Byte, OrigSize As Long)
Dim BufTemp() As Byte
ReDim BufTemp(OrigSize)
uncompress BufTemp(0), OrigSize, Dati(0), UBound(Dati) + 1
ReDim Preserve Dati(OrigSize - 1)
CopyMemory Dati(0), BufTemp(0), OrigSize
Erase BufTemp
End Function
Public Function UncompressFile(Compressed As String, Uncompressed As String)
Dim OrigSize As Long, Dati() As Byte
Dim Dimensions As Long
Dimensions = FileLen(Compressed) - Len(OrigSize)
ReDim Dati(Dimensions - 1)
Open Compressed For Binary Access Read As #1
Get #1, , OrigSize
Get #1, , Dati()
Close #1
UncompressData Dati(), OrigSize
Open Uncompressed For Binary Access Write As #1
Put #1, , Dati()
Close #1
End Function
Private Declare Function compress Lib "zlib.dll" (dest As Any, destlen As Any, src As Any, ByVal srclen As Long) As Long
Private Declare Function uncompress Lib "zlib.dll" (dest As Any, destlen As Any, src As Any, ByVal srclen As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Function CompressData(Dati() As Byte)
Dim Dimensions As Long
Dimensions = UBound(Dati) + 1
Dim DimBuffer As Long
Dim BufTemp() As Byte
DimBuffer = Dimensions + (Dimensions * 0.01) + 12
ReDim BufTemp(DimBuffer)
compress BufTemp(0), DimBuffer, Dati(0), Dimensions
ReDim Preserve Dati(DimBuffer - 1)
CopyMemory Dati(0), BufTemp(0), DimBuffer
Erase BufTemp
End Function
Public Function CompressFile(Source As String, Destination As String)
Dim Dati() As Byte
Dim Dimensions As Long
ReDim Dati(FileLen(Source) - 1)
Dimensions = UBound(Dati) + 1
Open Source For Binary Access Read As #1
Get #1, , Dati()
Close #1
CompressData Dati()
Open Destination For Binary Access Write As #1
Put #1, , Dimensions
Put #1, , Dati()
Close #1
End Function
Private Function UncompressData(Dati() As Byte, OrigSize As Long)
Dim BufTemp() As Byte
ReDim BufTemp(OrigSize)
uncompress BufTemp(0), OrigSize, Dati(0), UBound(Dati) + 1
ReDim Preserve Dati(OrigSize - 1)
CopyMemory Dati(0), BufTemp(0), OrigSize
Erase BufTemp
End Function
Public Function UncompressFile(Compressed As String, Uncompressed As String)
Dim OrigSize As Long, Dati() As Byte
Dim Dimensions As Long
Dimensions = FileLen(Compressed) - Len(OrigSize)
ReDim Dati(Dimensions - 1)
Open Compressed For Binary Access Read As #1
Get #1, , OrigSize
Get #1, , Dati()
Close #1
UncompressData Dati(), OrigSize
Open Uncompressed For Binary Access Write As #1
Put #1, , Dati()
Close #1
End Function