home *** CD-ROM | disk | FTP | other *** search
/ io Programmo 39 / IOPROG_39.ISO / SOFT / vbasic / xceedzip.exe / 16-bit / Samples / Vb3 / XZIPDEMO.BAS < prev    next >
Encoding:
BASIC Source File  |  1999-11-18  |  12.1 KB  |  337 lines
  1. Option Explicit
  2.  
  3. ' Variable to communicate to the ExtractDialog form
  4.  
  5. Global ExtractDialogCanceled As Integer
  6.  
  7. ' Constants to determine characteristics of Zip Open Dialog
  8.  
  9. Global Const OpenZip = 0
  10. Global Const NewZip = 1
  11. Global Const TestZip = 2
  12. Global Const FixZip = 3
  13. Global Const DeleteZip = 4
  14. Global Const SelectBin = 5
  15.  
  16. ' Constants to determine command executed by ExecuteSelFilesCmd
  17.  
  18. Global Const SF_Delete = 0
  19. Global Const SF_Extract = 1
  20.  
  21. ' Function to send a windows message
  22.  
  23. Declare Function SendMessage Lib "user" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, Lparam As Any) As Long
  24.  
  25. ' Other constants for listboxes, dialog boxes and windows calls
  26.  
  27. Global Const WM_USER = &H400
  28. Global Const LB_GETSELCOUNT = WM_USER + 17
  29. Global Const LB_GETCOUNT = WM_USER + 12
  30. Global Const LB_SELITEMRANGE = WM_USER + 28
  31. Global Const WM_SETREDRAW = &HB
  32. Global Const MB_ICONINFORMATION = 64
  33. Global Const MB_ICONSTOP = 16
  34. Global Const MB_ICONEXCLAMATION = 48
  35. Global Const MB_ICONQUESTION = 32
  36. Global Const MB_OKCANCEL = 1
  37. Global Const MB_YESNO = 4
  38. Global Const MB_YESNOCANCEL = 3
  39. Global Const MB_OK = 0
  40. Global Const ID_YES = 6
  41. Global Const ID_NO = 7
  42. Global Const ID_CANCEL = 2
  43. Global Const OFN_OVERWRITEPROMPT = &H2
  44. Global Const OFN_FILEMUSTEXIST = &H1000
  45. Global Const OFN_ALLOWMULTISELECT = &H200
  46. Global Const OFN_NOCHANGEDIR = &H8
  47. Global Const OFN_HIDEREADONLY = &H4
  48. Global Const FRM_MINIMIZED = 1
  49. Global Const FRM_MAXIMIZED = 2
  50.  
  51. ' This function counts the number of files in the list of files
  52. ' of the type returned by the SelectFilesToProcess function.
  53. '
  54. Function CountFilesInList (ByVal FileList As String) As Integer
  55.  
  56.    Dim Count As Integer
  57.    Dim Pos As Integer
  58.  
  59.    Count = 0
  60.    For Pos = 1 To Len(FileList)
  61.       If Mid$(FileList, Pos, 1) = " " Then Count = Count + 1
  62.    Next Pos
  63.    
  64.    If Count = 0 Then Count = 1
  65.    
  66.    CountFilesInList = Count
  67.  
  68. End Function
  69.  
  70. ' Returns the number of items in a listbox (API call, fast)
  71. '
  72. Function GetCount (ListBox As Control) As Integer
  73.   
  74.   GetCount = SendMessage(ListBox.hWnd, LB_GETCOUNT, 0, 0)
  75.  
  76. End Function
  77.  
  78. ' This function takes a list of files of the type that is returned by
  79. ' the SelectFilesToProcess function, and returns a single file (with
  80. ' pathname).
  81. '
  82. Function GetFileFromList (ByVal FileList As String, FileNumber As Integer) As String
  83.  
  84.    Dim Pos As Integer
  85.    Dim Count As Integer
  86.    Dim FNStart As Integer
  87.    Dim FNLen As Integer
  88.    Dim Path As String
  89.  
  90.    If InStr(FileList, " ") = 0 Then
  91.       GetFileFromList = FileList
  92.    Else
  93.       Count = 0
  94.       Path = Left$(FileList, InStr(FileList, " ") - 1)
  95.       If Right$(Path, 1) <> "\" Then Path = Path + "\"
  96.       FileList = FileList + " "
  97.       For Pos = 1 To Len(FileList)
  98.          If Mid$(FileList, Pos, 1) = " " Then
  99.             Count = Count + 1
  100.             If Count = FileNumber Then FNStart = Pos + 1
  101.             If Count = (FileNumber + 1) Then
  102.                FNLen = Pos - FNStart
  103.                Exit For
  104.             End If
  105.          End If
  106.       Next Pos
  107.       GetFileFromList = Path + Mid$(FileList, FNStart, FNLen)
  108.    End If
  109.  
  110. End Function
  111.  
  112. ' Returns the number of selected items in a listbox. (API call, fast)
  113. '
  114. Function GetSelCount (ListBox As Control) As Integer
  115.  
  116.    GetSelCount = SendMessage(ListBox.hWnd, LB_GETSELCOUNT, 0, 0)
  117.  
  118. End Function
  119.  
  120. ' This is a generic error handling procedure for the Xceed Zip VBX.
  121. ' It opens a message box containing a brief description of an
  122. ' error that has occured when manipulating Zip files.
  123. '
  124. ' Pass the return code from any method (like CmdAdd, CmdExtract...)
  125. ' in the ErrorCode parameter, and one word describing the current
  126. ' operation in the DoingWhat parameter.
  127. '
  128. Sub HandleError (ErrorCode As Integer, DoingWhat As String)
  129.  
  130.    Dim EDesc    As String     ' Error description text
  131.    Dim InfoOnly As Integer    ' False=Error, True=Warning
  132.  
  133.    EDesc = "" ' If this stays empty, we will not show a MsgBox
  134.    InfoOnly = False
  135.  
  136.    If ErrorCode <> XcdSuccess Then
  137.                  
  138.       Select Case ErrorCode
  139.  
  140.          Case XcdWarningGeneral, XcdWarningNoZipFile, XcdErrorNothingToDo
  141.             Rem Do not show a MsgBox for these codes
  142.          Case XcdWarningFilesSkipped
  143.             EDesc = "Some files were skipped while " + DoingWhat + "."
  144.             InfoOnly = True
  145.          Case XcdWarningEmptyZipFile
  146.             EDesc = "The Zip file is empty."
  147.             InfoOnly = True
  148.          Case XcdErrorUserAbort
  149.             EDesc = "The " + DoingWhat + " operation was aborted."
  150.             InfoOnly = True
  151.          Case XcdErrorNoZipFile
  152.             EDesc = "Could not find the archive file."
  153.          Case XcdErrorEOF, XcdErrorZipStruct
  154.             EDesc = "The archive file is corrupted. Try using the Fix option on it."
  155.          Case XcdErrorMemory
  156.             EDesc = "Ran out of memory while " + DoingWhat + "."
  157.          Case XcdErrorDiskFull
  158.             If MainForm.MainXZ.MultidiskMode Then
  159.                EDesc = "A full disk was inserted instead of an empty one."
  160.             Else
  161.                EDesc = "Disk full while " + DoingWhat + "."
  162.             End If
  163.          Case XcdErrorTestFailed
  164.             EDesc = "Test failed - Errors in the archive."
  165.          Case XcdErrorZeroTested
  166.             EDesc = "No files ended up being tested in the archive."
  167.          Case XcdErrorDLLNotFound
  168.             EDesc = "The XCDZIP.DLL or the XCDUNZIP.DLL file could not be found."
  169.          Case XcdErrorTempFile
  170.             EDesc = "Problem with the temporary file."
  171.          Case XcdErrorLatest
  172.             EDesc = "Could not update the Zip archive date. Archive only contains directories or is empty."
  173.          Case XcdErrorLibInUse
  174.             EDesc = "Another application is currently performing a similar task. Wait until the other application has completed its operation."
  175.          Case XcdErrorParentDir
  176.             EDesc = "Attempt to remove parent directory."
  177.          Case XcdErrorDosError
  178.             EDesc = "Read/Write error with the Zip file or one of the files to process."
  179.          Case XcdErrorNameRepeat
  180.             EDesc = "Names repeated in archive after discarding pathnames."
  181.          Case XcdErrorMultidisk
  182.             EDesc = "Cannot work on multiple-disk archives when not in Multidisk mode."
  183.          Case XcdErrorWrongDisk
  184.             EDesc = "Wrong disk was inserted too many times."
  185.          Case XcdErrorMultiDiskBadCall
  186.             EDesc = "Operation not supported for Multidisk Zip archives."
  187.          Case XcdErrorCantOpenBinary
  188.             EDesc = "Could not open the self-extractor binary."
  189.          Case XcdErrorCantOpenSFXConfig
  190.             EDesc = "Could not open the self-extractor configuration file"
  191.          Case XcdErrorInvalidEventParam
  192.             EDesc = "Invalid command parameter passed to an Xceed Zip event."
  193.          Case XcdErrorCantWriteSfx
  194.             EDesc = "Not enough space on first disk to write self-extractor."
  195.          Case XcdErrorRead
  196.             EDesc = "Problem reading from file while " + DoingWhat + "."
  197.          Case XcdErrorWrite
  198.             EDesc = "Problem writing to file while " + DoingWhat + "."
  199.          Case XcdErrorBinaryVersion
  200.             EDesc = "Invalid self-extractor binary version."
  201.          Case XcdErrorNotLicensed
  202.             EDesc = "This application was created with an unlicensed copy of the Xceed Zip component. It will only run in design mode."
  203.          Case XcdErrorCantCreateDir
  204.             EDesc = "Problem creating destination directory while " + DoingWhat + "."
  205.          Case XcdErrorBadCall   ' Programming error in this application
  206.             EDesc = "Invalid property settings. Programming error."
  207.          Case Else
  208.             EDesc = "An error occured while " + DoingWhat + " the specified files."
  209.       End Select
  210.  
  211.    End If
  212.  
  213.    If Len(EDesc) > 0 Then
  214.       If InfoOnly Then
  215.          MsgBox EDesc, MB_ICONEXCLAMATION  ' A warning
  216.       Else
  217.          MsgBox EDesc, MB_ICONSTOP         ' An error
  218.       End If
  219.    End If
  220.  
  221. End Sub
  222.  
  223. ' This function opens a dialog and lets the user select multiple
  224. ' files to be operated on.
  225. '
  226. ' This function will return the full path and filename of each
  227. ' and every selected file, all concatenated in one big string.
  228. ' If the Cancel button was used, then the function will return
  229. ' an empty string.
  230. '
  231. Function SelectFilesToProcess (Title As String) As String
  232.  
  233.    MainForm.SelectFilesDialog.CancelError = False
  234.    MainForm.SelectFilesDialog.Filename = ""
  235.  
  236.    MainForm.SelectFilesDialog.Flags = OFN_FILEMUSTEXIST + OFN_ALLOWMULTISELECT + OFN_NOCHANGEDIR + OFN_HIDEREADONLY
  237.  
  238.    MainForm.SelectFilesDialog.DialogTitle = Title
  239.    MainForm.SelectFilesDialog.Action = 1
  240.  
  241.    If Len(MainForm.SelectFilesDialog.Filename) > 0 Then
  242.       SelectFilesToProcess = MainForm.SelectFilesDialog.Filename
  243.    End If
  244.  
  245. End Function
  246.  
  247. ' This function opens up a 'Open File' Dialog to have the
  248. ' user select a Zip file. Depending on the DialogType parameter,
  249. ' the behavior of the dialog is different.
  250. '
  251. ' This function will return the full path and filename of the
  252. ' selected Zip file. If the Cancel button was used, then the
  253. ' function will return an empty string.
  254. '
  255. Function SelectZipFile (DialogType As Integer) As String
  256.  
  257.    MainForm.SelectZipDialog.Filename = ""
  258.    MainForm.SelectZipDialog.Flags = OFN_FILEMUSTEXIST + OFN_NOCHANGEDIR + OFN_HIDEREADONLY
  259.    MainForm.SelectZipDialog.Filter = "Zip archives (*.zip)|*.zip|Self-extracting Zip archives (*.exe)|*.exe|All files (*.*)|*.*"
  260.    Select Case DialogType
  261.       Case OpenZip
  262.          MainForm.SelectZipDialog.DialogTitle = "Open Archive"
  263.          MainForm.SelectZipDialog.Action = 1
  264.       Case NewZip
  265.          MainForm.SelectZipDialog.Flags = OFN_OVERWRITEPROMPT + OFN_NOCHANGEDIR + OFN_HIDEREADONLY
  266.          MainForm.SelectZipDialog.DialogTitle = "New Archive"
  267.          MainForm.SelectZipDialog.Action = 2  ' Pretend we are saving file
  268.       Case TestZip
  269.          MainForm.SelectZipDialog.DialogTitle = "Test Archive"
  270.          MainForm.SelectZipDialog.Action = 1
  271.       Case FixZip
  272.          MainForm.SelectZipDialog.DialogTitle = "Fix Archive"
  273.          MainForm.SelectZipDialog.Action = 1
  274.       Case DeleteZip
  275.          MainForm.SelectZipDialog.DialogTitle = "Delete Archive"
  276.          MainForm.SelectZipDialog.Action = 1
  277.       Case SelectBin
  278.          MainForm.SelectZipDialog.Filename = ""
  279.          MainForm.SelectZipDialog.Filter = "Self-extractor binary (*.bin)|*.bin|All files (*.*)|*.*"
  280.          MainForm.SelectZipDialog.DialogTitle = "Select self-extractor binary"
  281.          MainForm.SelectZipDialog.Action = 1
  282.       Case Else
  283.    End Select
  284.  
  285.    SelectZipFile = MainForm.SelectZipDialog.Filename
  286.  
  287. End Function
  288.  
  289. ' Turn on/off screen updating of a listbox.  This is necessary
  290. ' to increase the speed that items are added into a listbox
  291. ' because simply setting the listbox .Visible property to
  292. ' False is not enough.
  293. '
  294. Sub SetRedraw (ListBox As Control, RedrawState As Integer)
  295.  
  296.    Dim Void As Long
  297.  
  298.    ListBox.Visible = RedrawState
  299.    Void = SendMessage(ListBox.hWnd, WM_SETREDRAW, RedrawState, 0&)
  300.  
  301. End Sub
  302.  
  303. ' This function takes a string containing a path and tries to make it
  304. ' fit into a given control's display space (i.e: Panel and label captions.)
  305. ' Note: It considers a '\' to indicate the presence of a path in the string.
  306. '
  307. Function ShortenPathForDisplay (aString As String, aForm As Form, aWidth As Single) As String
  308.  
  309.   Dim TempString As String
  310.   Dim Pos As Long
  311.   Dim Pos2 As Long
  312.     
  313.   TempString = aString
  314.   
  315.   While aForm.TextWidth(TempString) > aWidth
  316.     
  317.     Pos = InStr(1, TempString, "...")
  318.     If Pos > 0 Then
  319.       TempString = Left$(TempString, Pos - 1) + Right$(TempString, Len(TempString) - Pos - 3)
  320.     End If
  321.     
  322.     Pos = InStr(3, TempString, "\")
  323.     Pos2 = InStr(Pos + 1, TempString, "\")
  324.     
  325.     If Pos2 = 0 Then
  326.       ShortenPathForDisplay = Left$(TempString, Pos) + "..." + Right$(TempString, Len(TempString) - Pos + 1)
  327.       Exit Function
  328.     End If
  329.     
  330.     TempString = Left$(TempString, Pos) + "..." + Right$(TempString, Len(TempString) - Pos2 + 1)
  331.     
  332.   Wend
  333.   ShortenPathForDisplay = TempString
  334.  
  335. End Function
  336.  
  337.