• Home
 · 
• Files/File Controls/Input/Output
 · 
• This code compress and uncompress file like winzip.It is slow but it work.

This code compress and uncompress file like winzip.It is slow but it work.

This code compress and uncompress file like winzip.It is slow but it work.

Rate This code compress and uncompress file like winzip.It is slow but it work.

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

VERSION 5.00
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "LH Archiver By LH-Soft"
   ClientHeight    =   1545
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5025
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   OLEDropMode     =   1  'Manual
   ScaleHeight     =   1545
   ScaleWidth      =   5025
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command2 
      Caption         =   "Uncompress file"
      Height          =   375
      Left            =   3480
      TabIndex        =   4
      Top             =   600
      Width           =   1335
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Compress file"
      Height          =   375
      Left            =   3480
      TabIndex        =   2
      Top             =   120
      Width           =   1335
   End
   Begin VB.TextBox t2 
      Height          =   285
      Left            =   1080
      TabIndex        =   1
      Top             =   600
      Width           =   2175
   End
   Begin VB.TextBox t1 
      Height          =   285
      Left            =   1080
      TabIndex        =   0
      Top             =   120
      Width           =   2175
   End
   Begin VB.Label Label2 
      Alignment       =   2  'Center
      Caption         =   "Destination file"
      Height          =   375
      Index           =   1
      Left            =   120
      TabIndex        =   6
      Top             =   600
      Width           =   855
   End
   Begin VB.Label Label2 
      Alignment       =   2  'Center
      Caption         =   "Source file"
      Height          =   255
      Index           =   0
      Left            =   120
      TabIndex        =   5
      Top             =   120
      Width           =   855
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      Height          =   255
      Left            =   0
      TabIndex        =   3
      Top             =   1080
      Width           =   5055
   End
   Begin VB.Line Line1 
      BorderWidth     =   8
      X1              =   0
      X2              =   15
      Y1              =   1440
      Y2              =   1455
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Function clm(txt, rnn)
If Len(txt) = 1 Then clm = "0" & txt Else clm = txt
End Function
Function asb(txt, nb)
If Len(txt) <> 1 Then Exit Function
For g = 1 To nb
asb = asb & txt
Next g
End Function
Private Sub Command1_Click()
Set fs = CreateObject("scripting.filesystemobject")
Set d = fs.getfile(t1)
Label1 = "Reading original file..."
DoEvents
Set g = d.openastextstream(1)
text1 = g.read(d.Size)
g.Close
Set i = fs.createtextfile(t2)
text2 = ""
For t = 1 To Len(text1)
tt = tt + 1
If tt = 10000 Then tt = 0
If tt = 0 Then DoEvents
lt = Mid(text1, t, 1)
f = t
rnn = "X"
Do
If Mid(text1, f + 1, 1) <> lt Or f - t = 9998 Then Exit Do
f = f + 1
Loop
If f - t > 8 Then rnn = "Y"
If f - t > 98 Then rnn = "Z"
If f - t > 998 Then rnn = "S"
If f = t Then i.write lt Else If f - t < 3 Then i.write asb(lt, f - t + 1) Else i.write asb(rnn, 3) & f - t + 1 & lt
t = t + f - t
Label1 = FormatNumber(t / Len(text1) * 100, 0) & " % Compressing file..."
Line1.X2 = (t / Len(text1)) * 5000
Next t
i.Close
Set d3 = fs.getfile(t2)
Label1 = "Done " & FormatNumber(d3.Size / t * 100, 1) & "% of original file writted"
End Sub

Private Sub Command2_Click()
Set fs = CreateObject("scripting.filesystemobject")
Set d = fs.getfile(t2)
Label1 = "Reading original file..."
DoEvents
Set g = d.openastextstream(1)
text2 = g.read(d.Size)
Set i = fs.createtextfile(t1)
text1 = ""
For t = 1 To Len(text2)
tt = tt + 1
If tt = 10000 Then tt = 0
If tt = 0 Then DoEvents
lt = Mid(text2, t, 1)
f = t
kkk = Mid(text2, t, 3)
If Mid(text2, t, 3) = "XXX" Then lt = asb(Mid(text2, t + 4, 1), Mid(text2, t + 3, 1)): t = t + 4
If Mid(text2, t, 3) = "YYY" Then lt = asb(Mid(text2, t + 5, 1), Mid(text2, t + 3, 2)): t = t + 5
If Mid(text2, t, 3) = "ZZZ" Then lt = asb(Mid(text2, t + 6, 1), Mid(text2, t + 3, 3)): t = t + 6
If Mid(text2, t, 3) = "SSS" Then lt = asb(Mid(text2, t + 7, 1), Mid(text2, t + 3, 4)): t = t + 7
i.write lt
h:
Label1 = FormatNumber(t / Len(text2) * 100, 0) & " % Uncompressing file..."
Line1.X2 = (t / Len(text2)) * 5000
Next t
Label1 = "Done"
End Sub

Private Sub Form_Load()
If Command$ <> "" Then t1 = Command$: t2 = t1 & ".co"
End Sub

Private Sub Form_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
t1 = Data.Files(1)
t2 = t1 & ".co"
End Sub