Extraction de fichiers

Description

Extracteur de fichiers en VB6 ...
Il peut soit : - Extraire un fichier
- Extraire tout son contenu

Il possède en + un DirectoryChooser (petit bout de code trouvé sur VBFrance qui permet de choisir un répertoire sur son pc)

Source / Exemple :


'#########################################################
'################### Extraction Module ###################
'############ By Ghuysmans99 (CodeS-SourceS) #############
'#########################################################

Option Explicit

Public Function ExtractFile(id As Integer, destfolder As String, Optional dtype As String = "FILES") As Boolean
 If Right(destfolder, 1) <> "\" Or Right(destfolder, 1) <> "/" Then
  destfolder = destfolder & "\"
 End If
 On Error GoTo file_corrupted
  Dim filename As String
  filename = LoadResString(id)
  filename = Replace(filename, "FN=", "")
  ExtractFile = Extract(id, destfolder & filename, dtype)
 On Error GoTo 0
 Exit Function
file_corrupted:
 ExtractFile = False
End Function

Private Function Extract(id As Integer, filedest As String, Optional dtype As String = "FILES") As Boolean
 Dim d() As Byte
 On Error Resume Next
 d = LoadResData(id, dtype)
 If Err Then
  Extract = False
  Exit Function
  Else
   Extract = True
 End If
 Open filedest For Binary As #1
  Put #1, , d
 Close #1
 If Err Then
  Extract = False
  Exit Function
  Else
   Extract = True
 End If
End Function

Public Function ExtractAll(DestinationPath As String) As Boolean
 If Right(DestinationPath, 1) <> "\" Or Right(DestinationPath, 1) <> "/" Then
  DestinationPath = DestinationPath & "\"
 End If
 
 Dim tempoColl As New Collection
 Const StartFileId As Integer = 101
 Dim FN As Integer 'Number of Files
 Dim tmp As String
 On Error GoTo file_corrupted
 tmp = LoadResString(100) 'Load first string
 On Error GoTo 0
 tmp = Replace(tmp, "NOF=", "")
 tmp = Replace(tmp, ";", "")
 On Error GoTo file_corrupted
 FN = CInt(tmp)
 tempoColl.Add "NOF=" & FN
 On Error GoTo 0
 
 Dim i As Integer
 Dim tmp2() As String
 'Parcours des noms de ficher avec verif.
 For i = StartFileId To StartFileId + (FN - 1)
  On Error GoTo file_corrupted
  tmp2 = Split(LoadResString(i), Chr(15))
  tmp = tmp2(0)
  tmp = Replace(tmp, "FN=", "")
  Extract i, DestinationPath & tmp
 Next i
 ExtractAll = True
 Exit Function
 
file_corrupted:
 ExtractAll = False
End Function

Public Function ListFiles() As Collection
 Dim tempoColl As New Collection
 Const StartFileId As Integer = 101
 Dim FN As Integer 'Number of Files
 Dim tmp As String
 On Error GoTo file_corrupted
 tmp = LoadResString(100) 'Load first string
 On Error GoTo 0
 tmp = Replace(tmp, "NOF=", "")
 tmp = Replace(tmp, ";", "")
 On Error GoTo file_corrupted
 FN = CInt(tmp)
 tempoColl.Add "NOF=" & FN
 On Error GoTo 0
 
 Dim i As Integer
 'Parcours des noms de ficher avec verif.
 For i = StartFileId To StartFileId + (FN - 1)
  On Error GoTo file_corrupted
  tmp = LoadResString(i)
  On Error GoTo 0
  tempoColl.Add Replace(tmp, "FN=", "") & " " & Chr(15) & i
 Next i
 
 GoTo set_result
file_corrupted:
  tempoColl.Add "ERR=File corrupted !"
set_result:
  Set ListFiles = tempoColl
End Function

Codes Sources

A voir également

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.