ورود

View Full Version : سوال: یک سوال دارم خیلی مهم هست بیا تو ببین و جوابم رو بده مرسی



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

kuh_nur
پنج شنبه 12 خرداد 1390, 19:14 عصر
مثلا شما دو تا دکمه روی فرمتون دارین که یکی کارش زیپ کردنه و دیگری انزیپ کردن

private sub Command1_click()
CompressFile("c:\a.txt","c:\a.zip")
end sub
private sub Command2_click()
UncompressFile("c:\a.zip","c:\a.txt")
end sub




البته من کد شما رو تست نکردم و صحت عملکردش مطمئن نیستم