Inclure un fichier dans une base de données Access

Gaël Donat

Cet article décrit l'installation et l'utilisation du module Access « File Includer »

- Titre : Inclure un fichier dans une base de données Access

- Auteur : Gaël Donat

- Parution : 16 décembre 2003

- Licence : Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright ® 2003 Gaël Donat. Aucune reproduction, même partielle, ne peut être faite de ce site et de l'ensemble de son contenu : textes, documents, images, etc. sans l'autorisation expresse de l'auteur. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.

Sommaire

- I. Principe Général

- II. Généralités

- II-A. Qu'est-ce qu'un module MDA ?

- II-B. Notion de base binaire / décimale / hexadécimale

- II-B-1. Base Décimale

- II-B-2. Base Binaire

- II-B-3. Base Hexadécimale

- II-C. Comment est constitué un fichier ?

- II-D. Quelle technique est utilisée par le module Access

- III. Téléchargement/Installation

- IV. Utilisation

- IV-A. Intégrer un fichier

- IV-A-1. Fonction « encode_fichier »

- IV-A-2. Fonction « encodage_massif »

- IV-B. Extraire un fichier

- IV-B-1. Fonction « decode_fichier »

- IV-C. Fonctions Diverses

- IV-C-1. Fonction « controle_existance »

- IV-C-2. Fonction « purge_all »

- IV-C-3. Fonction « suppr »

- IV-C-4. Fonction « list_fichier »

- IV-C-5. Fonction « verifie_tables »

- IV-C-6. Fonction « Create_database »

- V. Annexes

- V-A. Description et commentaire du code

- V-A-1. Module d'inclusion de fichier

- V-A-1-a. Les déclarations de module

- V-A-1-b. Les fonctions externes

- V-A-1-c. Les types personalisés

- V-A-1-d. Les constantes

- V-A-1-e. Fonction du module

- V-A-2. Module Recherche fichiers

- V-A-2-a. Les déclarations de module

- V-A-2-b. Les fonctions externes

- V-A-2-c. Les types personalisés

- V-A-2-d. Les constantes

- V-A-2-e. Fonction du module

- V-A-3. Module Création de base

- V-A-3-a. Les déclarations de module

- V-A-3-b. Les fonctions externes

- V-A-3-c. Les types personnalisés

- V-A-3-d. Les constantes

- V-A-3-e. Fonction du module

- V-B. Schéma des tables

- Conclusion

- Remerciements

I - Principe Général

Ce module permet d'intégrer dans une table le contenu réel d'un fichier et non une simple liaison avec ce dernier, ce qui permet en outre de n'avoir à fournir que la base Access (ou autre) et non les fichiers de dépendance. Grâce à ce module vous pouvez faire une application Access qui va contenir tous les fichiers dont elle a besoin pour fonctionner (OCX, BMP, DLL…), lors du premier lancement de cette dernière, elle pourra automatiquement « décompresser » les fichiers nécessaires.

Certains experts de base de données s'accordent à dire que contenir les objets images dans la base plutôt qu'un lien vers ces dernières placées dans un répertoire est une aberration. Le système décrit ici sert principalement en encapsuler des fichiers utiles à la base pour son fonctionnement. Je déconseille d'utiliser cette technique pour contenir de gros volume.

Cet exemple n'est bien évidemment pas la seul utilisation possible pour ce module, libre à vous de vous en servir comme bon vous semble.

II - Généralités

II-A - Qu'est-ce qu'un module MDA ?

Un module MDA est une base de données Access utilisée comme support vous permettant de ré-utiliser des fonctions toutes faites dans d'autres applications Access sans avoir besoin de les recréer.

II-B - Notion de base binaire / décimale / hexadécimale

II-B-1 - Base Décimale

La base décimale ou base 10 est le système employé à travers le monde pour les méthodes humaines de calculs, ce système peut prendre 10 états : 0,1,2,3,4,5,6,7,8,9.

Un nombre décimal ressemble donc à cela : 579854.

II-B-2 - Base Binaire

La base binaire ou base 2 est à la base de l'information numérique telle que nous la connaissons pour la simple raison qu'un système électrique fonctionne sur ce système, un chiffre binaire ne peut prendre que deux états : 1 ou 0, en électricité Allumé ou Éteint.

Un nombre binaire ressemble donc à cela : 100101

Transposé en décimal, voilà ce que cela donne :

Décimal

Binaire

0

0

1

1

2

10

3

11

4

100

5

101

6

110

7

111

8

1000

9

1001

II-B-3 - Base Hexadécimale

La base Hexadécimale ou base 16 tire son existence de l'informatique, car un chiffre hexadécimal se code avec 4 chiffres binaires, de plus la conversion de l'un à l'autre est très simple.

Pour compter en base 16 les différents états sont : 0,1,2,3,4,5,6,7,8,9,A,B,C,D,E,F

Les 6 lettres peuvent paraître déroutantes car nous n'avons pas l'habitude de compter ou d'effectuer des opérations avec des lettres mais le principe est le même qu'avec un chiffre.

Transposé en décimal, comme pour les binaires, voilà ce que cela donne :

Décimal

Hexadécimal

0

0

1

1

2

2

3

3

4

4

5

5

6

6

7

7

8

8

9

9

10

A

11

B

12

C

13

D

14

E

15

F

16

10

17

11

II-C - Comment est constitué un fichier ?

Un fichier sur le disque dur est une série de 1 et de 0.

Chacun de ces 1 ou 0 est appelé Bit.

Un ensemble de 8 bits est appelé Octet.

Un caractère représente 1 octet.

Les caractères servant à coder les fichiers suivent la normes ASCII , chaque caractère reçois un code entre 0 et 255.

Pourquoi exactement entre 0 et 255 ?

Nous avons vu qu'un octet se compose de 8 bits :

1. Minimum : 00000000

2. Maximum : 11111111

Cela donne en décimal : 0 à 255

Nous avons vu dans le paragraphe précédent qu'un nombre hexadécimal représente 4 bits : donc 0000 donne 0, et 1111 donne F

Pour un octet on a :

1. Minimum : 00

2. Maximum : FF (255 en décimal)

II-D - Quelle technique est utilisée par le module Access

Comme nous avons vu précédemment qu'un octet pouvait se noter grâce à deux lettres/chiffres en hexadécimal (trois en décimal) ce sont ces symboles que nous allons stocker directement dans la base Access, exactement comme cela apparaît dans un éditeur Hexadécimal par exemple.

Par exemple, prenons un fichier texte contenant la chaîne 'ghij' ce fichier ferai 4 octets (1 octet par lettre) : Le code ASCII de la lettre 'g' est 103, celui de 'j' est 106.

1. 'g' = 103

2. 'h' = 104

3. 'i' = 105

4. 'j' = 106

en hexadécimal nous aurons :

1. 'g' = 67

2. 'h' = 68

3. 'i' = 69

4. 'j' = 6A

La table contenant le fichier contiendra simplement : « 6768696A »

C'est aussi simple que cela !

III - Téléchargement/Installation

Téléchargement

Ce module est gratuit, il est téléchargeable :

- Version Office 97

- Version Office 2003

C'est un fichier au format .ZIP qui contient :

- Le module MDA

- Une copie de la licence GPL en français (version non officielle)

- Une copie de la licence GPL en anglais (version officielle)

- Un fichier Release contenant l'historique de mise à jour

Il faut décompresser ce fichier dans un répertoire quelconque (celui de votre application par exemple).

Installation

puis cliquer sur parcourir…

Sélectionner le fichier Compression.mda

Si tout c'est bien passé, vous devriez voir le module « Compression » coché.

Cliquer sur Ok pour sortir.

Félicitation, c'est installé.

IV - Utilisation

IV-A - Intégrer un fichier

Les fonctions permettant d'inclure un fichier dans la base de données sont les suivantes :

- encode_fichier

- encodage_massif

IV-A-1 - Fonction « encode_fichier »

Description

Cette fonction permet d'inclure un fichier dans la base de données. Son utilisation se fait comme ceci :

Public Sub encodage_fichier()
Dim li_retour As Integer
li_retour = Compression.encode_fichier("identifiant base", "nom du fichier avec chemin", confirmation)
End Sub

identifiant base contient l'identifiant qui vous permettra d'identifier et de récupérer le fichier une fois inclus dans la base.
Exemple : Fichier1

nom du fichier avec chemin correspond au nom du fichier physique sur votre disque dur.
Exemple : c:\mon_application\image1.bmp

Confirmation contient un code qui permet de dire si l'encodage est en mode silencieux ou non, dans la cas de fichier existant par exemple.

Voila les différentes valeurs :

- Écrase automatiquement le fichier existant dans la base

- Annule l'inclusion du fichier

- Ouvre une boite de dialogue

Le code de retour contient deux valeurs : si c'est Ok, la fonction retourne la taille du fichier inclus en octet, en cas d'erreur la fonction retourne -1.

IV-A-2 - Fonction « encodage_massif »

Description

Cette fonction permet d'inclure tous les fichiers d'un répertoire dans la base :

Public Sub encode_répertoire()
Dim li_retour As Integer
li_retour = Compression.encodage_massif("chemin", "masque", inclure_ss_répertoire, confirmation)
End Sub

chemin : indique le répertoire de d'origine pour l'inclusion
Exemple : c:\fichier\

masque : indique un pattern d'extension
Exemple : *.bmp ou *.* ou *.JP?G

inclure_ss_répertoire = booléen True pour inclure un tous les sous-répertoires False pour restreindre au répertoire désigné dans « chemin »

confirmation = même principe que pour la fonction précédente.

Retourne le nombre de fichiers encodés

IV-B - Extraire un fichier

Les fonctions permettant d'extraire un fichier dans la base de données sont les suivantes :

- decode_fichier

IV-B-1 - Fonction « decode_fichier »

Description

Cette fonction permet d'extraire un fichier précédemment inclus dans la base :

Public Sub decode_fichier()
Dim ls_retour
ls_retour = Compression.decode_fichier("identifiant base", "nom du fichier avec chemin")
End Sub

identifiant base contient l'identifiant qui vous permettra d'identifier et de récupérer le fichier une fois inclus dans la base.
Exemple : Fichier1

nom du fichier avec chemin correspond au nom du fichier physique sur votre disque dur.
Exemple : c:\mon_application\image1.bmp

À noter que si vous spécifiez une chaîne Vide (""), le module créera un fichier temporaire, dans le répertoire temporaire de Windows

ls_retour : contient le nom du fichier résultant de l'extraction, utilisé principalement pour récupérer le fichier créé temporairement par Windows si l'option nom du fichier avec chemin = ""

IV-C - Fonctions Diverses

Les fonctions diverses dans le module :

- controle_existance

- purge_all

- suppr

- list_fichier

- verifie_tables

IV-C-1 - Fonction « controle_existance »

Description

Cette fonction permet de savoir si un fichier (via son identifiant) existe déjà dans la base.

Public Sub controle()
Dim lb_test As Boolean
lb_test = Compression.controle_existance("identifiant base")
End Sub

identifiant base contient l'identifiant qui vous permet d'identifier et de récupérer le fichier une fois inclus dans la base
Exemple : Fichier1

lb_test : contient la valeur de retour : True si le fichier existe, False si il n'existe pas.

IV-C-2 - Fonction « purge_all »

Description

Cette fonction permet de vider toute la table des fichiers précédemment enregistrés (Attention cette opération est irréversible).

Compression.purge_all

Il n'y a aucun argument ni retour pour cette fonction.

IV-C-3 - Fonction « suppr »

Description

Cette fonction permet de supprimer un fichier existant dans la base via son identifiant

Compression.suppr ("identifiant base")

identifiant base contient l'identifiant qui vous permet d'identifier et de récupérer le fichier une fois inclus dans la base.
Exemple : Fichier1

Il n'y a aucun argument de retour pour cette fonction.

IV-C-4 - Fonction « list_fichier »

Description

Public Sub list()
Dim rs As DAO.Recordset
Set rs = list_fichier
End Sub

Il n'y a pas d'argument d'appel.

rs : RecordSet de retour.

Attention c'est un Recorset DAO !

IV-C-5 - Fonction « verifie_tables »

Description

Cette fonction permet de vérifier que les tables nécessaires à l'exécution du code du module sont bien en ligne.

If Compression.verifie_tables() Then
MsgBox "ok"
else
MsgBox "Marche pas"
End If

Il n'y a pas d'argument d'appel.

Cette fonction retourne une valeur booléenne (True=OK, False = KO).

IV-C-6 - Fonction « Create_database »

Description

Cette fonction permet de créer dans le module les tables nécessaires à son exécution.

Normalement cette fonction ne doit être appelé que si vous changez les valeurs des constantes (voir plus haut)

Compression.Create_database

Il n'y a pas d'argument d'appel. Il n'y a pas de retour.

V - Annexes

V-A - Description et commentaire du code

Pour les plus intéresses, personnellement je n'aime pas utiliser des boites noires, j'aime savoir ce que fait tel ou tel fonction et surtout comment elle est faite.

Vous trouverez ici, un descriptif détaillé des fonctions.

L'application est divisé en trois modules :

- le module « Module de compression » ;

- le module « Fonction Recherche fichiers » ;

- le module « Création de base » ;

Le premier s'occupe de l'encodage et l'inclusion dans la base à proprement parler.

Le second s'occupe de la recherche des fichiers lors de l'intégration d'un répertoire complet.

V-A-1 - Module d'inclusion de fichier

V-A-1-a - Les déclarations de module

Outre les habituelles :

Option Compare Database
Option Explicit

Il y a

Option Base 1

Cette déclaration permet de définir la borne inférieur des tableaux sans avoir besoin de le préciser.

V-A-1-b - Les fonctions externes

Je vous invite à vous reporter à un article dédié au API pour étudier les fonctions ci-dessous de façon plus détaillée.

API qui Permet de récuperer le chemin du répertoire temporaire Windows

Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _
(ByVal nBufferLength As Long, ByVal lpBuffer As String) _
As Long

API qui permet d'ecrire dans un fichier

Private Declare Function WriteFile Lib "kernel32" _
(ByVal hFile As Long, _
lpBuffer As Any, _
ByVal nNumberOfBytesToWrite As Long, _
lpNumberOfBytesWritten As Long, _
ByVal lpOverlapped As Any) _
As Long

API qui permet de lire un fichier

Private Declare Function ReadFile Lib "kernel32" _
(ByVal hFile As Long, _
lpBuffer As Any, _
ByVal nNumberOfBytesToRead As Long, _
lpNumberOfBytesRead As Long, _
ByVal lpOverlapped As Any) _
As Long

API qui permet de Creer ou ouvrir un fichier

Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" _
(ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, _
ByVal lpSecurityAttributes As Any, _
ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As Long) _
As Long

API qui permet de fermer un handle

Private Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) _
As Long

API qui permet de positionner un pointeur sur un fichier

Private Declare Function SetFilePointer Lib "kernel32" _
(ByVal hFile As Long, _
ByVal lDistanceToMove As Long, _
lpDistanceToMoveHigh As Long, _
ByVal dwMoveMethod As Long) _
As Long

API qui permet de changer les attributs d'un fichier

Private Declare Function SetFileAttributes Lib "kernel32" Alias "SetFileAttributesA" _
(ByVal lpFileName As String, _
ByVal dwFileAttributes As Long) _
As Long
Private Declare Function GetFileSize Lib "kernel32" _
(ByVal hFile As Long, _
lpFileSizeHigh As Long) _
As Long

API qui permet de recuperer un nom de fichier temporaire généré par windows

Private Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" _
(ByVal lpszPath As String, _
ByVal lpPrefixString As String, _
ByVal wUnique As Long, _
ByVal lpTempFileName As String) _
As Long

API qui permet de déplacer un fichier

Private Declare Function MoveFileEx Lib "kernel32" Alias "MoveFileExA" _
(ByVal lpExistingFileName As String, _
ByVal lpNewFileName As String, _
ByVal dwFlags As Long) _
As Long

API qui permet de supprimer un fichier

Private Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" _
(ByVal lpFileName As String) _
As Long

V-A-1-c - Les types personalisés

Pas de déclaration de Type.

V-A-1-d - Les constantes

'Les constantes ci-dessous sont modifiables
'La constante ci-dessous correspond au nombre de caractères à stocké par colonne
'(64*2=128) les colonnes doivent être en texte(128)

Public Const VAL_HACHAGE = 64
'Le nombre de colonne dans la table
Public Const VAL_COLONNE = 14
'Le nom de la table qui contient les données
Public Const TABLE_IMPORT = "Stockage"
'Le nom de la table qui liste les fichiers
Public Const TABLE_FILE = "Listage_fichier"

'Les constantes ci dessous NE DOIVENT EN AUCUN CAS ETRE MODIFIER
Const MOVEFILE_REPLACE_EXISTING = &H1
Const FILE_ATTRIBUTE_TEMPORARY = &H100
Const FILE_BEGIN = 0
Const FILE_SHARE_READ = &H1
Const FILE_SHARE_WRITE = &H2
Const CREATE_NEW = 1
Const OPEN_EXISTING = 3
Const GENERIC_READ = &H80000000
Const GENERIC_WRITE = &H40000000

V-A-1-e - Fonction du module

Fonction decode_fichier

Public Function encode_fichier(nom_fichier_logique As String, _
nom_fichier_physique As String, confirmation As Integer) As Long

Dim rs As Recordset
Dim bbytes() As Byte
Dim bhex() As String
Dim nSize As Long
Dim ret As Long
Dim hOrgFile As Long
Dim ll_i As Long
Dim ll_j As Long
Dim chaine() As String
Dim nb_ligne As Long
Dim val As String
Dim val2 As String
Dim val3 As Double
Dim nboctet As Integer

'on test si le module est opérationnel
If Not verifie_tables Then Exit Function

'on regarde si l'index existe déjà dans la table
If controle_existance(nom_fichier_logique) Then
'suivant le code de confirmation on switch sur les différents cas
If confirmation = 1 Then
'on écrase
suppr (nom_fichier_logique)
ElseIf confirmation = 2 Then
'on annule
encode_fichier = -1
Exit Function
'la ou pose la question à l'utilisateur
ElseIf confirmation = 3 Then
If MsgBox("Ce fichier logique : " & nom_fichier_logique & _
" Existe déjà dans la base." & vbCrLf & _
"Voulez vous l'écraser ?", vbQuestion + vbYesNo) = vbYes Then

'réponse client = ecrase
suppr (nom_fichier_logique)
Else
'réponse client = on annule
encode_fichier = -1
Exit Function
End If
End If
End If

'on ouvre le fichier dans le handle HorgFile
hOrgFile = CreateFile(nom_fichier_physique, _
GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0)

'on recupère la taille du fichier dans nSize
nSize = GetFileSize(hOrgFile, 0)

'si le fichier est inexistant
If nSize = -1 Then
encode_fichier = -1
Exit Function
End If

'on défini un pointeur sur le fichier via son handle
SetFilePointer hOrgFile, 0, 0, FILE_BEGIN
'on redimensionne le tableau bbytes suivant la taille du fichier
ReDim bbytes(nSize) As Byte

'on fait la lecture du fichier et on rempli le tableau bbytes
ReadFile hOrgFile, bbytes(1), UBound(bbytes), ret, ByVal 0&
CloseHandle hOrgFile
'on ferme le handle

'on redimensionne bbhex pour s'aligner avec un multiple de VAL_hachage*2
If nSize Mod VAL_HACHAGE <> 0 Then
nb_ligne = Int(nSize / VAL_HACHAGE) + 1
ReDim bhex(VAL_HACHAGE * nb_ligne) As String
Else
ReDim bhex(nSize) As String
nb_ligne = nSize / VAL_HACHAGE
End If

'on converti les codes Bbytes en Ascii
For ll_i = 1 To nSize
val = String(2 - Len(Hex(bbytes(ll_i))), "0")
val2 = Hex(bbytes(ll_i))
bhex(ll_i) = val & val2
Next
ReDim chaine(nb_ligne) As String
'on cumul dans le tableau bhex
For ll_i = 1 To nb_ligne
For ll_j = 1 To VAL_HACHAGE
chaine(ll_i) = chaine(ll_i) + bhex(((ll_i - 1) * VAL_HACHAGE) + ll_j)
Next
Next
'ensuite on boucle sur le nb de nb_ligne pour encapsuler ca dans la table
Set rs = CodeDb.OpenRecordset("SELECT * FROM [" & TABLE_IMPORT & "]")

For ll_i = 1 To nb_ligne
If ll_i Mod VAL_COLONNE = 1 Then
If ll_i > VAL_COLONNE Then
rs(2) = nboctet
nboctet = 0
rs(VAL_COLONNE + 3) = format(Now(), "dd/mm/yyyy")
rs.Update
End If
rs.AddNew
rs(0) = nom_fichier_logique
End If
val3 = Int((ll_i - 1) / VAL_COLONNE)
val3 = ll_i - (val3 * VAL_COLONNE)
rs(val3 + 2) = Trim(chaine(ll_i))
nboctet = nboctet + (Len(Trim(chaine(ll_i))) / 2)
Next
rs(2) = nboctet
'on colle la date dans la table
rs(VAL_COLONNE + 3) = format(Now(), "dd/mm/yyyy")
rs.Update
'on retourne ensuite la taille du fichier
encode_fichier = nSize

End Function

decode_fichier

Public Function decode_fichier(nom_fichier_logique As String, _
nom_fichier_physique As String) As String
Dim rs As Recordset
Dim chaine() As String
Dim bbytes() As Byte
Dim ll_i As Long
Dim ll_j As Double
Dim nb_octet As Long
Dim car As String
Dim valeur As Integer
Dim adresse_mem As Long
Dim hNewFile As Long
Dim sTemp As String
Dim chemin As String
Dim ret As Long
If Not verifie_tables Then Exit Function
'on regarde le nb d'octet à définir
Set rs = CodeDb.OpenRecordset("SELECT Sum([" & TABLE_IMPORT & _
"].Nombre_octet) AS SommeDeNombre_octet FROM [" & TABLE_IMPORT & _
"] WHERE ((([" & TABLE_IMPORT & "].[Nom du Fichier])='" & _
nom_fichier_logique & "'));")
nb_octet = rs![SommeDeNombre_octet]

'on sort si problème
If IsNull(rs![SommeDeNombre_octet]) Then
decode_fichier = ""
Exit Function
End If

'on redimensionne les 2 tableaux bbytes, et chaine
ReDim bbytes(nb_octet) As Byte
ReDim chaine(Int(nb_octet / VAL_HACHAGE) + 1) As String

Set rs = CodeDb.OpenRecordset("SELECT * FROM [" & TABLE_IMPORT & _
"] WHERE [Nom du Fichier]='" & nom_fichier_logique & "' ORDER BY [Numéro]")
'on boucle sur toutes les lignes du RecordSet
While Not rs.EOF
For ll_i = 1 To VAL_COLONNE
If Not IsNull(rs(ll_i + 2)) Then
'on rempli le tableau chaine avec la valeur de la table (des octets donc)
ll_j = ((rs.AbsolutePosition) * VAL_COLONNE) + ll_i
chaine(ll_j) = rs(ll_i + 2)
End If
Next
rs.MoveNext
Wend
rs.close
'ensuite on boucle sur le tableau chaine
For ll_i = 1 To Int(nb_octet / VAL_HACHAGE) + 1
For ll_j = 1 To (VAL_HACHAGE * 2) - 1 Step 2
'on extrait le caractere
'puis on le converti avec la formule -> val("&h" & chaine(1))
If ll_j <= Len(chaine(ll_i)) Then
'on remplis le nouveau table bbytes
car = Mid(chaine(ll_i), ll_j, 2)
valeur = val("&h" & car)
adresse_mem = ((ll_i - 1) * VAL_HACHAGE) + (ll_j + 1) / 2
bbytes(adresse_mem) = valeur
End If
Next
Next
'Ensuite on recode le fichier
'on test si un fichier cible est défini
If Len(Trim(nom_fichier_physique)) = 0 Then
'non
sTemp = String(260, 0)
chemin = String(260, 0)
'on prend le chemin temporaire de windows
GetTempPath Len(chemin), chemin
chemin = Left$(chemin, InStr(1, chemin, Chr$(0)) - 1)
'on demande à windows le nom d'un fichier temporaire commencant par BDA
'windows cree un fichier vide (pour la reservation)
GetTempFileName chemin, "BDA", 0, sTemp
sTemp = Left$(sTemp, InStr(1, sTemp, Chr$(0)) - 1)
'on defini le fichier avec les attributs temporaires
SetFileAttributes sTemp, FILE_ATTRIBUTE_TEMPORARY
'on ouvre le fichier
hNewFile = CreateFile(sTemp, GENERIC_WRITE, FILE_SHARE_READ Or _
FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0)

'on ecrit les données dedans
WriteFile hNewFile, bbytes(1), UBound(bbytes), ret, ByVal 0&
'on ferme le handle
CloseHandle hNewFile
'on propage le nom du fichier en retour de fonction
decode_fichier = sTemp
Else
'oui
'on regarde si le fichier existe déjà
If Dir(nom_fichier_physique, vbNormal) <> "" Then
'oui -> on pose la question pour ecraser ou non
If MsgBox("Le fichier existe déjà. voulez vous l'écraser par le nouveau ?" _
, vbQuestion + vbYesNo, "Question") = vbYes Then

'oui on efface
DeleteFile nom_fichier_physique
Else
'non
nom_fichier_physique = ""
End
End If
End If
'on ouvre le fichier
hNewFile = CreateFile(nom_fichier_physique, GENERIC_WRITE, _
FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, CREATE_NEW, 0, 0)

'on ecrit le fichier
WriteFile hNewFile, bbytes(1), UBound(bbytes), ret, ByVal 0&
'on ferme le handle
CloseHandle hNewFile
'on retourne le nom de fichier
decode_fichier = nom_fichier_physique
End If
End Function

encodage_massif

Public Function encodage_massif(path As String, chaine As String, _
sous_dossier As Boolean, confirmation As Integer) As Integer

'on verifie si le module est opérationnelle
If Not verifie_tables Then Exit Function
'ok -> opérationnel
Dim filecount As Long
Dim dircount As Long
Dim rs As Recordset
'on fait la liste des fichiers
'on vide la table de listing fichier
DoCmd.SetWarnings False
CodeDb.Execute ("DELETE * FROM [" & TABLE_FILE & "]")
DoCmd.SetWarnings True

'on dresse la liste des fichiers via la fonction FindFilesAPI
FindFilesAPI path, chaine, filecount, dircount, sous_dossier
Set rs = CodeDb.OpenRecordset("SELECT * FROM [" & TABLE_FILE & "]")

'ensuite on boucle sur la table et on encode
While Not rs.EOF
'encodage par la boucle
encode_fichier rs![fichier], rs![chemin] & rs![fichier], confirmation
rs.MoveNext
Wend
'retourne le nb de fichiers encodés
encodage_massif = filecount

controle_existance

Public Function controle_existance(fichier_logique) As Boolean
'on regarde si le module est opérationnel
If Not verifie_tables Then Exit Function
Dim rs As Recordset

'on ouvre un recorset pour voir si le fichier existe
Set rs = CodeDb().OpenRecordset("SELECT * FROM [" & TABLE_IMPORT & _
"] WHERE [Nom du Fichier]='" & fichier_logique & "'")

If rs.RecordCount > 0 Then
'oui -> retourne TRUE
controle_existance = True
Else
'non retourne False
controle_existance = False
End If

End Function

purge_all

Public Function purge_all()
'on regarde si le module est opérationnel
If Not verifie_tables Then Exit Function
'ok
DoCmd.SetWarnings False
'on execute une requete de suppression sans distinction
CodeDb.Execute ("DELETE * FROM [" & TABLE_IMPORT & "]")
DoCmd.SetWarnings True
End Function

suppr

Public Function suppr(nom_fichier_logique As String)

'on regarde si le module est opérationnel
If Not verifie_tables Then Exit Function
'ok
DoCmd.SetWarnings False
'on execute une requete de suppresion avec l'argument
CodeDb.Execute ("DELETE * FROM [" & TABLE_IMPORT & _
"] WHERE [Nom du Fichier]='" & nom_fichier_logique & "'")
DoCmd.SetWarnings True
End Function

list_fichier

Public Function list_fichier() As DAO.Recordset
'on regarde si le module est opérationnel
If Not verifie_tables Then Exit Function
'ok
'on ouvre le recordset qu'on renvoie en retour de la fonction.

'Attention Recorset en DAO !!
Set list_fichier = CodeDb.OpenRecordset("SELECT * FROM [" & TABLE_IMPORT & "]")
End Function

verifie_tables

Public Function verifie_tables() As Boolean
Dim rs As Recordset
'on regarde nos 2 tables dans la table MSysObjects
'Attention Microsoft Stipule que ces tables peuvent etre modifiées par microsoft sans préavis.
'Il est normalement déconseillé de les utiliser.

'Dans la version prochaine, la technique de controle va changer.

Set rs = CodeDb.OpenRecordset("SELECT * FROM [MSysObjects] Where Name='" _
& TABLE_IMPORT & "' And Type=1")
If rs.RecordCount > 0 Then
rs.close
Set rs = CodeDb.OpenRecordset("SELECT * FROM [MSysObjects] Where Name='" _
& TABLE_FILE & "' And Type=1")
If rs.RecordCount > 0 Then
'c'est ok on retourne TRUE
verifie_tables = True
Else
'c'est KO on retourne False
verifie_tables = False
End If
Else
'c'est KO on retourne False
verifie_tables = False
End If

'Si on est false un petit messagebox
If Not verifie_tables Then
MsgBox "Table Inexistante dans le complément." & vbCrLf & _
"Le module n'est pas opérationnel", vbCritical, "Erreur"
End If

End Function

V-A-2 - Module Recherche fichiers

Ce module est adapté d'un code de KPD-Team (1999) inclus dans l'outil API-Guide.

V-A-2-a - Les déclarations de module

Aucune en dehors des deux déclarations de base.

V-A-2-b - Les fonctions externes

API qui permet de lire le premier fichier trouvé dans une structure

Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" _
(ByVal lpFileName As String, _
lpFindFileData As WIN32_FIND_DATA) _
As Long

API qui permet de lire le fichier suivant trouvé dans une structure

Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" _
(ByVal hFindFile As Long, _
lpFindFileData As WIN32_FIND_DATA) _
As Long

API qui permet de recuperer les attributs d'un fichier

Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" _
(ByVal lpFileName As String) _
As Long

API qui permet de fermer le pointeur de recherche

Private Declare Function FindClose Lib "kernel32" _
(ByVal hFindFile As Long) _
As Long

V-A-2-c - Les types personalisés

Structure pour la gestion de date en attribut de fichier

Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Structure recuperant la recherche

Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type

V-A-2-d - Les constantes

'la constante ci-dessous peut etre modifiée
Const TABLE_FILE = "Listage_fichier"

'les constantes ci-dessous NE DOIVENT EN AUCUN CAS ETRE MODIFIER
Const MAX_PATH = 260
Const MAXDWORD = &HFFFF
Const INVALID_HANDLE_VALUE = -1
Const FILE_ATTRIBUTE_ARCHIVE = &H20
Const FILE_ATTRIBUTE_DIRECTORY = &H10
Const FILE_ATTRIBUTE_HIDDEN = &H2
Const FILE_ATTRIBUTE_NORMAL = &H80
Const FILE_ATTRIBUTE_READONLY = &H1
Const FILE_ATTRIBUTE_SYSTEM = &H4
Const FILE_ATTRIBUTE_TEMPORARY = &H100

V-A-2-e - Fonction du module

StripNulls

Function StripNulls(OriginalStr As String) As String
'Cette fonction permet de supprimer le caractère de fin de chaine d'une chaine quelconque
'Si on trouve le chr$(0) on rentre dans la boucle
If (InStr(OriginalStr, Chr(0)) > 0) Then
'On prend les données à gauche de la chaine.
OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
End If
'on affecte la nouvelle chaine à l'argument de sortie.
StripNulls = OriginalStr
End Function

FindFilesAPI

Function FindFilesAPI(path As String, SearchStr As String, _
filecount As Long, dircount As Long, sub_dir As Boolean)

'déclaration des variables
Dim filename As String
Dim DirName As String
Dim dirNames() As String
Dim nDir As Integer
Dim i As Integer
Dim hSearch As Long
Dim WFD As WIN32_FIND_DATA
Dim Cont As Integer
Dim rs As DAO.Recordset

'On ouvre un curseur sur la table
Set rs = CodeDb().OpenRecordset("SELECT * from [" & TABLE_FILE & "]")

'si le chemin passé en argument n'a pas un \ on le rajoute
If Right(path, 1) <> "\" Then
path = path & "\"
End If
'Si on veut inclure les sous-répertoire (Sub_dir = true)
If sub_dir Then
' Recherche des sous répertoires
nDir = 0
'redimensionne ndir
ReDim dirNames(nDir)
Cont = True

'on cherche le premier fichier
hSearch = FindFirstFile(path & "*", WFD)
If hSearch <> INVALID_HANDLE_VALUE Then
'on boucle tant que la structure renvoi un nouveau répertoire (vérification avec cont)
Do While Cont
DirName = StripNulls(WFD.cFileName)
If (DirName <> ".") And (DirName <> "..") Then
If GetFileAttributes(path & DirName) And FILE_ATTRIBUTE_DIRECTORY Then
dirNames(nDir) = DirName
dircount = dircount + 1
nDir = nDir + 1
ReDim Preserve dirNames(nDir)
End If
End If
Cont = FindNextFile(hSearch, WFD)
Loop
Cont = FindClose(hSearch)
End If
End If
'fin de recherche des sous répertoire

'on attaque les fichiers
hSearch = FindFirstFile(path & SearchStr, WFD)
Cont = True

If hSearch <> INVALID_HANDLE_VALUE Then
While Cont
filename = StripNulls(WFD.cFileName)
If (filename <> ".") And (filename <> "..") Then
FindFilesAPI = FindFilesAPI + (WFD.nFileSizeHigh * MAXDWORD) + WFD.nFileSizeLow
filecount = filecount + 1
'on ajoute le fichier dans la liste
rs.AddNew
rs![chemin] = path
rs![fichier] = filename
rs.Update
End If
Cont = FindNextFile(hSearch, WFD)
Wend
Cont = FindClose(hSearch)
End If

If nDir > 0 Then
For i = 0 To nDir - 1
'si on accepte les sous répertoire on s'appelle recursivement
FindFilesAPI = FindFilesAPI + FindFilesAPI(path & dirNames(i) & "\", SearchStr, filecount, dircount, sub_dir)
Next i
End If
End Function

V-A-3 - Module Création de base

Ce module contient des fonctions permettant de créer la base, la source d'origine est le script de création de base de l'outil Case Studio 2 Je l'ai largement modifié notamment pour prendre un compte la partie dynamique (changement éventuel des constantes).

V-A-3-a - Les déclarations de module

En plus des deux déclarations de base, on trouve les déclarations suivantes :

Private dbs As Database
Private tdf As TableDef
Private idx As Index
Private rel As Relation

Rien de particulier dans ces déclarations.

V-A-3-b - Les fonctions externes

Pas de fonction externe.

V-A-3-c - Les types personnalisés

Pas de type personnalisé.

V-A-3-d - Les constantes

Pas de type constante.

V-A-3-e - Fonction du module

Create_database

Sub Create_database()
Set dbs = CodeDb()
On Error GoTo ErrorHandler
Call DropTables
Call CreateTables
Call CreatePrimaryKeys
MsgBox "Script successfully processed.", vbInformation
Exit Sub

ErrorHandler:
Select Case Err.Number
Case 3010
MsgBox "Table " & tdf.Name & " already exist!", vbInformation
Err.Clear
Case 3284
MsgBox "Index " & idx.Name & " for table " & tdf.Name & " already exist!", vbInformation
Err.Clear
Case Else
MsgBox Err.Description, vbCritical
End Select
End Sub

DropTables

Private Sub DropTables()
Call DropTable([Module de compression].TABLE_IMPORT)
Call DropTable([Module de compression].TABLE_FILE)
End Sub

CreateTables

Private Sub CreateTables()
Call CreateTable1 'Listage_fichier
Call CreateTable2 'Stockage
End Sub

CreateTable1

Private Sub CreateTable1()
Set tdf = dbs.CreateTableDef([Module de compression].TABLE_FILE)
Call AddFieldToTable("Chemin", dbText, 255, 0, "", "", "", False, False)
Call AddFieldToTable("Fichier", dbText, 255, 0, "", "", "", False, False)
dbs.TableDefs.Append tdf
End Sub

CreateTable2

Private Sub CreateTable2()
Dim li_i As Integer
Set tdf = dbs.CreateTableDef([Module de compression].TABLE_IMPORT)
Call AddFieldToTable("Nom du Fichier", dbText, 255, 0, "", "", "", False, False)
Call AddFieldToTable("Numéro", dbLong, 0, dbAutoIncrField, "", "", "", False, False)
Call AddFieldToTable("Nombre_octet", dbLong, 0, 0, "0", "", "", False, False)

'Ici on fait la création suivant le type de données des constantes déclarés
For li_i = 1 To [Module de compression].VAL_COLONNE
Call AddFieldToTable("Fichier" & li_i, dbText, [Module de compression].VAL_HACHAGE * 2, 0, "", "", "", False, False)
Next

Call AddFieldToTable("Date", dbText, 10, 0, "", "", "", False, False)
dbs.TableDefs.Append tdf
End Sub

CreatePrimaryKeys

Private Sub CreatePrimaryKeys()
Set tdf = dbs.TableDefs([Module de compression].TABLE_IMPORT)
Set idx = tdf.CreateIndex("PrimaryKey")

idx.Primary = True
idx.Unique = True
idx.IgnoreNulls = False

Call AddFieldToIndex("Nom du Fichier", False)
Call AddFieldToIndex("Numéro", False)

tdf.Indexes.Append idx

End Sub

DropTable

Private Sub DropTable(TableName As String)
Set tdf = Nothing
On Error Resume Next
Set tdf = dbs.TableDefs(TableName)
On Error GoTo 0
If Not tdf Is Nothing Then dbs.TableDefs.Delete (TableName)
End Sub

DropIndex

Private Sub DropIndex(TableName As String, IndexName As String)

Set tdf = Nothing
Set idx = Nothing
On Error Resume Next
Set tdf = dbs.TableDefs(TableName)
Set idx = tdf.Indexes(IndexName)
On Error GoTo 0
If (Not tdf Is Nothing) And (Not idx Is Nothing) Then tdf.Indexes.Delete (IndexName)
End Sub

AddFieldToTable

Private Sub AddFieldToTable(FieldName As String, DataType As String, _
SizeCol As Integer, Attributes As Long, DefaultValue As Variant, _
ValText As String, ValRule As String, NotN As Boolean, ZeroLength As Boolean)
Dim fld As Field

Set fld = tdf.CreateField(FieldName, DataType)
If SizeCol <> 0 Then
fld.Size = SizeCol
End If
If Attributes <> 0 Then
fld.Attributes = Attributes
End If
fld.Required = NotN
If DataType = dbText Or DataType = dbMemo Then fld.AllowZeroLength = ZeroLength
fld.DefaultValue = DefaultValue
fld.ValidationRule = ValRule
fld.ValidationText = ValText
tdf.Fields.Append fld

End Sub

AddPropertyToTable

Private Sub AddPropertyToTable(PropertyName As String, Value As Variant, DataType As String)
Dim prp As Property
Set prp = tdf.CreateProperty(PropertyName, DataType, Value)
tdf.Properties.Append prp
End Sub

AddPropertyToField

Private Sub AddPropertyToField(FieldName As String, PropertyName As String, Value As Variant, DataType As String)
Dim prp As Property
Dim fld As Field
Set fld = tdf.Fields(FieldName)
Set prp = fld.CreateProperty(PropertyName, DataType, Value)
fld.Properties.Append prp
End Sub

AddFieldToIndex

Private Sub AddFieldToIndex(FieldName As String, Descending As Boolean)

Dim fld As Field
Set fld = idx.CreateField(FieldName)
If Descending = True Then
fld.Attributes = dbDescending
End If
idx.Fields.Append fld
End Sub

V-B - Schéma des tables

Le schéma des tables est très simple, car l'application ne nécessite que deux tables, sans aucune relation entre elles (fonctionnalités indépendantes)

Conclusion

Voila c'est fini !

Rien de bien difficile.

Ce module est fourni en GPL, cela signifie que je le diffuse gratuitement et que vous avez le droit de le modifier à votre guise, mais en précisant exactement les modifications effectuées, Attention, mon nom doit toujours apparaître dans l'outil.

Remerciements

Un grand merci à Demco et Alacazam pour la correction orthographique, ainsi qu'à toute l'équipe de developpez.com pour leurs avis éclairés.