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
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.