home *** CD-ROM | disk | FTP | other *** search
/ BUG 6 / BUGCD1997_09.BIN / UTIL / ADDZIP / ADDZIP.EXE / VB / QUICKZIP / QUICKZIP.BAS < prev    next >
Encoding:
BASIC Source File  |  1997-06-01  |  4.3 KB  |  143 lines
  1. Option Explicit
  2.  
  3. Type POINTAPI
  4.     x As Integer
  5.     y As Integer
  6. End Type
  7.  
  8. Type MSG
  9.     hWnd As Integer
  10.     message As Integer
  11.     wParam As Integer
  12.     lParam As Long
  13.     time As Long
  14.     pt As POINTAPI
  15. End Type
  16.  
  17. Type SIZE
  18.     cx As Integer
  19.     cy As Integer
  20. End Type
  21.  
  22. Declare Sub DragAcceptFiles Lib "Shell" (ByVal hWnd As Integer, ByVal x As Integer)
  23. Declare Sub DragFinish Lib "shell.dll" (ByVal hDrop%)
  24. Declare Function DragQueryFile% Lib "shell.dll" (ByVal hDrop%, ByVal iFile%, ByVal lpszFile$, ByVal cb%)
  25. Declare Function DragQueryPoint% Lib "shell.dll" (ByVal hDrop%, lppt As POINTAPI)
  26. Declare Function PeekMessage Lib "User" (lpMsg As MSG, ByVal hWnd As Integer, ByVal wMsgFilterMin As Integer, ByVal wMsgFilterMax As Integer, ByVal wRemoveMsg As Integer) As Integer
  27. Declare Function SetWindowPos Lib "user" (ByVal h%, ByVal hb%, ByVal x%, ByVal y%, ByVal cx%, ByVal cy%, ByVal f%) As Integer
  28.  
  29. Global Const WM_DROPFILES = &H233
  30. Global Const PM_NOREMOVE = &H0
  31. Global Const PM_REMOVE = &H1
  32. Global Const PM_NOYIELD = &H2
  33.  
  34. Global Const SWP_NOMOVE = 2
  35. Global Const SWP_NOSIZE = 1
  36. Global Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
  37. Global Const HWND_TOPMOST = -1
  38. Global Const HWND_NOTOPMOST = -2
  39.  
  40. Global g_cArchiveName As String
  41. Global g_cExtract As String
  42. Global g_cTemp As String
  43. Global g_iCount As Integer ' the total number of files in the archive
  44. Global g_lSize As Long ' the total size (uncompressed) of the files in the archive
  45.  
  46. Sub AddFileToArchive (cFile As String)
  47.     Dim i As Integer
  48.     
  49.     If (frmQuickZIP.mnuOptionsCompressionLevel(0).Checked = True) Then
  50.     i = addZIP_SetCompressionLevel(azCOMPRESSION_NONE)
  51.     ElseIf (frmQuickZIP.mnuOptionsCompressionLevel(1).Checked = True) Then
  52.     i = addZIP_SetCompressionLevel(azCOMPRESSION_MINIMUM)
  53.     ElseIf (frmQuickZIP.mnuOptionsCompressionLevel(2).Checked = True) Then
  54.     i = addZIP_SetCompressionLevel(azCOMPRESSION_NORMAL)
  55.     Else
  56.     i = addZIP_SetCompressionLevel(azCOMPRESSION_MAXIMUM)
  57.     End If
  58.     
  59.     If (frmQuickZIP.mnuOptionsStoreFull.Checked = False) Then
  60.     i = addZIP_SaveStructure(False)
  61.     End If
  62.     
  63.     i = addZIP_Include(cFile)
  64.     i = addZIP_ArchiveName(g_cArchiveName)
  65.     i = addZIP()
  66.     Call ListArchiveContents(g_cArchiveName)
  67. End Sub
  68.  
  69. Sub ListArchiveContents (cArchive As String)
  70.     Dim i As Integer
  71.     
  72.     g_cArchiveName = cArchive
  73.     frmQuickZIP.Caption = "QuickZIP - " & g_cArchiveName
  74.     g_iCount = 0
  75.     g_lSize = 0
  76.     frmQuickZIP.colArchive.Clear
  77.     i = addZIP_SetWindowHandle(frmQuickZIP.txtZIP.hWnd)
  78.     i = addZIP_ArchiveName(g_cArchiveName)
  79.     i = addZIP_View(True)
  80.     i = addZIP()
  81.     UpdateStatusBar
  82. End Sub
  83.  
  84. Sub SpyMessages ()
  85.     Const ATTR_DIRECTORY = 16
  86.     Dim DropMessage As MSG
  87.     Dim i As Integer, j As Integer
  88.     Dim iDot As Integer
  89.     Dim gotone%
  90.     Dim hDrop%
  91.     Dim cFilename As String
  92.     Dim cExtension As String
  93.     Dim iNumber As Integer
  94.     Dim thisfile%
  95.     Dim di%
  96.     
  97.     ' Go into an infinite loop looking for the WM_DROPFILES messages
  98.     Call DragAcceptFiles(frmQuickZIP.hWnd, True)
  99.     Do
  100.     gotone% = PeekMessage(DropMessage, 0, WM_DROPFILES, WM_DROPFILES, PM_REMOVE Or PM_NOYIELD)
  101.  
  102.     If gotone Then ' Got a drop message
  103.     ' Retrieve the handle to the internal dropfiles structure
  104.     hDrop% = DropMessage.wParam
  105.     
  106.     ' Get the number of files
  107.     iNumber = DragQueryFile(hDrop%, -1, cFilename, 127)
  108.     For j = 1 To iNumber
  109.         cFilename = String$(128, " ")
  110.         i = DragQueryFile(hDrop%, j - 1, cFilename, 127)
  111.         cFilename = Left$(cFilename, InStr(cFilename, Chr$(0)) - 1)
  112.         If (Right$(cFilename, 1) = "\") Then
  113.         cFilename = cFilename & "*.*"
  114.         End If
  115.         iDot = InStr(cFilename, ".")
  116.         If (iDot > 0) Then
  117.         cExtension = Mid$(cFilename, iDot, 4)
  118.         If (iNumber = 1) And (LCase$(Mid$(cFilename, iDot, 4)) = ".zip") Then
  119.             ListArchiveContents (cFilename)
  120.         Else
  121.             AddFileToArchive (cFilename)
  122.         End If
  123.         End If
  124.     Next j
  125.     ' Dispose of the hdrop% structure
  126.     DragFinish (hDrop%)
  127.     End If
  128.     i = DoEvents()
  129.     Loop While -1
  130. End Sub
  131.  
  132. Sub UpdateStatusBar ()
  133.     Dim cStatus As String
  134.     If (g_iCount > 0) Then
  135.     cStatus = "This archive contains " & Str$(g_iCount) & " files, "
  136.     cStatus = cStatus & " with a total uncompressed size of " & Str(g_lSize) & " bytes"
  137.     Else
  138.     cStatus = ""
  139.     End If
  140.     frmQuickZIP.lblStatusBar.Caption = cStatus
  141. End Sub
  142.  
  143.