home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / Compressed47536192002.psc / ComprFileViewer2 / Form1.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  2002-01-10  |  8.6 KB  |  233 lines
  1. VERSION 5.00
  2. Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
  3. Begin VB.Form Form1 
  4.    BorderStyle     =   1  'Fixed Single
  5.    Caption         =   "Compressed File Viewer 2"
  6.    ClientHeight    =   8235
  7.    ClientLeft      =   45
  8.    ClientTop       =   330
  9.    ClientWidth     =   8175
  10.    Icon            =   "Form1.frx":0000
  11.    LinkTopic       =   "Form1"
  12.    MaxButton       =   0   'False
  13.    MinButton       =   0   'False
  14.    ScaleHeight     =   8235
  15.    ScaleWidth      =   8175
  16.    StartUpPosition =   1  'CenterOwner
  17.    Begin VB.CommandButton Command4 
  18.       Caption         =   "Dump to Text File"
  19.       Height          =   375
  20.       Left            =   120
  21.       TabIndex        =   5
  22.       Top             =   7800
  23.       Width           =   1695
  24.    End
  25.    Begin VB.CommandButton Command3 
  26.       Caption         =   "Exit"
  27.       Height          =   375
  28.       Left            =   6960
  29.       TabIndex        =   4
  30.       Top             =   7800
  31.       Width           =   1095
  32.    End
  33.    Begin MSComDlg.CommonDialog cdg1 
  34.       Left            =   6000
  35.       Top             =   0
  36.       _ExtentX        =   847
  37.       _ExtentY        =   847
  38.       _Version        =   393216
  39.    End
  40.    Begin VB.ListBox List1 
  41.       Height          =   7080
  42.       ItemData        =   "Form1.frx":1CFA
  43.       Left            =   120
  44.       List            =   "Form1.frx":1CFC
  45.       TabIndex        =   3
  46.       Top             =   600
  47.       Width           =   7935
  48.    End
  49.    Begin VB.CommandButton Command2 
  50.       Caption         =   "Go"
  51.       Height          =   375
  52.       Left            =   7440
  53.       TabIndex        =   2
  54.       Top             =   120
  55.       Width           =   615
  56.    End
  57.    Begin VB.TextBox Text1 
  58.       Height          =   375
  59.       Left            =   120
  60.       TabIndex        =   1
  61.       Text            =   "Input your full file path or browse for it."
  62.       Top             =   120
  63.       Width           =   6375
  64.    End
  65.    Begin VB.CommandButton Command1 
  66.       Caption         =   "..."
  67.       Height          =   375
  68.       Left            =   6720
  69.       TabIndex        =   0
  70.       Top             =   120
  71.       Width           =   615
  72.    End
  73. Attribute VB_Name = "Form1"
  74. Attribute VB_GlobalNameSpace = False
  75. Attribute VB_Creatable = False
  76. Attribute VB_PredeclaredId = True
  77. Attribute VB_Exposed = False
  78. Option Explicit
  79. Public WithEvents Archive As cArchive
  80. Attribute Archive.VB_VarHelpID = -1
  81. 'I stripped Dana Seaman's FolderView code so that the result was only the code that
  82. 'enumerated compressed files. Although her FolderView code is excellent, the code that I
  83. 'needed was only to see the contents of compressed files (zip, cab, rar, and ace). Note
  84. 'that this code does not compress or uncompress files, it simply enumerates the contents
  85. 'of the compressed files.
  86. 'Dana 's original code is at:
  87. 'http://www.planet-source-code.com/xq/ASP/txtCodeId.23292/lngWId.1/qx/vb/scripts/ShowCode.htm
  88. 'All of the code here is Dana's except for the minor stuff like the "Dump to Text File"
  89. 'subroutine and the browsing function. You will notice that there are alot of variables that
  90. 'have been commented out. Those are just the byproducts of the original and bigger project.
  91. 'They were not needed for the compressed file enumeration but i left them in the code. Also,
  92. 'as a request from me, Dana tweaked the code to work with shared files over a network.
  93. 'I want to personally thank Dana for such good work.
  94. '~El Mariachi
  95. 'ps The enumeration of zip and cab files is done all through the code in this project.
  96. '   The enumeration of ace and rar files is done via the two attached DLL's. I had to
  97. '   rename them as .dl_ but just rename them to .dll and it should work. I forget if these
  98. '   DLL's are Dana's or from a third party. You might want to contact her for further
  99. '   inquiries about this code and the DLL's.
  100. Public Sub Archive_FileFound(ByVal Index As Long, ByVal Total As Long, ByVal FileName As String, _
  101.                               ByVal ArchiveExt As String, ByVal Modified As Date, ByVal Size As Long, _
  102.                               ByVal CompSize As Long, ByVal Method As Long, ByVal Attr As Long, _
  103.                               ByVal Path As String, ByVal flags As Long, ByVal Crc As Long, _
  104.                               ByVal Comments As String)
  105.     Dim sMethod As String
  106.     ', sExt As String, FakePath As String
  107.     'Dim fType As String Long
  108.     'Dim FakeFile
  109.     'Dim MyIcon AsAs Integer
  110.     Dim Ratio As Single
  111.     Dim Encrypt As Boolean
  112.     'Dim Item As ListItem
  113.     On Error GoTo ProcedureError
  114.     'Trap division by zero
  115.     If Size Then
  116.        Ratio = 1 - CompSize / Size
  117.        'Don't allow negative values (per PkZip/WinZip)
  118.        'Occurs on stored+encrypted files
  119.        If Ratio < 0 Then Ratio = 0
  120.     Else
  121.        Ratio = 0
  122.     End If
  123.     'Ratio is single. Format as desired
  124.     Select Case ArchiveExt
  125.        Case ace_
  126.           sMethod = MethodVerboseAce(Method, flags)
  127.           Encrypt = (flags And 4) * -1
  128.        Case cab_
  129.           Select Case Method
  130.              Case 0: sMethod = "None"
  131.              Case 1: sMethod = "MsZip"
  132.              Case 2: sMethod = "Lzx"
  133.           End Select
  134.           Encrypt = False
  135.        Case rar_
  136.           sMethod = MethodVerboseRar(Method, flags)
  137.           'Flag bit 2 is Encryption True/False
  138.           Encrypt = (flags And 4) * -1
  139.        Case zip_
  140.           sMethod = MethodVerboseZip(Method, flags)
  141.           Encrypt = (flags And 1) * -1
  142.     End Select
  143.     Me.List1.AddItem "Total=" & Total
  144.     Me.List1.AddItem "Index=" & Index
  145.     Me.List1.AddItem "Path=" & Path
  146.     Me.List1.AddItem "FileName=" & FileName
  147.     Me.List1.AddItem "ArchiveExt=" & ArchiveExt
  148.     Me.List1.AddItem "Modified=" & Modified
  149.     Me.List1.AddItem "Size=" & Size
  150.     Me.List1.AddItem "CompSize=" & CompSize
  151.     Me.List1.AddItem "Ratio=" & Format$(Ratio, "00.0%")
  152.     Me.List1.AddItem "Method=" & Method
  153.     Me.List1.AddItem "sMethod=" & sMethod
  154.     Me.List1.AddItem "Encrypt=" & Encrypt
  155.     Me.List1.AddItem "flags=" & flags
  156.     Me.List1.AddItem "Attr=" & Attr
  157.     Me.List1.AddItem "..Attr=" & GetAttrString(Attr)
  158.     Me.List1.AddItem "Crc=" & Crc
  159.     Me.List1.AddItem "hexCrc=" & Hex$(Crc)
  160.     Me.List1.AddItem "Comments=" & Comments
  161.     Me.List1.AddItem "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
  162.     Me.List1.AddItem ""
  163. ProcedureExit:
  164.     Exit Sub
  165. ProcedureError:
  166.     If ErrMsgBox(Me.Name & "Archive_FileFound") = vbRetry Then Resume Next
  167. End Sub
  168. Private Sub Command1_Click()
  169.     'Open an archive
  170.     On Error Resume Next
  171.     Me.List1.Clear
  172.     cdg1.DialogTitle = "Browse to the Compressed File..."
  173.     cdg1.FileName = ""
  174.     cdg1.InitDir = App.Path
  175.     cdg1.Filter = "Zip Files (*.zip)|*.zip|Cab Files (*.cab)|*.cab|RAR Files (*.rar)|*.rar|Ace Files (*.ace)|*.ace|All compressed files|*.zip;*.cab;*.rar;*.ace|All Files (*.*)|*.*"
  176.     cdg1.ShowOpen
  177.     'Check if cancel was pressed
  178.     If Err = cdlCancel Then Exit Sub
  179.     Me.Text1.Text = cdg1.FileName
  180. End Sub
  181. Private Sub Command2_Click()
  182.     Dim Path As String, sExt As String
  183.     Dim tmi As Variant
  184.     Me.List1.Clear
  185.     Path = Trim$(Me.Text1.Text) 'the full path and file name
  186.     If LenB(Dir(Path)) = 0 Then
  187.         MsgBox "File does not exist!", vbCritical, "Error reading file"
  188.         Exit Sub
  189.     End If
  190.     Me.MousePointer = vbHourglass
  191.     Command1.Enabled = False
  192.     Command2.Enabled = False
  193.     sExt = GetExt(Path) 'the extension
  194.     tmi = Now
  195.     Select Case sExt
  196.         Case ace_, cab_, rar_, zip_
  197.             'InZip = True
  198.             'LoadStart
  199.             Set Archive = New cArchive
  200.             Archive.ArchiveName = Path
  201.             Archive.ArchiveExt = sExt
  202.             Archive.GetInfo
  203.             'LoadCleanup 1
  204.             'ShowProgress Start, Archive.FileCount, Path
  205.         Case Else
  206.             'do nothing
  207.     End Select
  208.     Me.Caption = "Done in " & DateDiff("s", tmi, Now) & " seconds"
  209.     Command1.Enabled = True
  210.     Command2.Enabled = True
  211.     Me.MousePointer = vbNormal
  212. End Sub
  213. Private Sub Command3_Click()
  214.     Unload Me
  215. End Sub
  216. Private Sub Command4_Click()
  217.     Dim i As Long
  218.     Me.MousePointer = vbHourglass
  219.     Command1.Enabled = False
  220.     Command2.Enabled = False
  221.     Open App.Path & "\" & "cfv2.dat" For Output As #23
  222.     For i = 0 To List1.ListCount - 1
  223.         Print #23, List1.List(i)
  224.     Next i
  225.     Close #23
  226.     Command1.Enabled = True
  227.     Command2.Enabled = True
  228.     Me.MousePointer = vbNormal
  229.     If MsgBox("Do you want to view the file?", vbYesNo + vbQuestion, "View It?") = vbYes Then
  230.         fHandleFile App.Path & "\" & "cfv2.dat", WIN_NORMAL
  231.     End If
  232. End Sub
  233.