Developpez.com

Club des développeurs et IT pro
Plus de 4 millions de visiteurs uniques par mois

Inclure un fichier dans une base de données Access

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

Article lu   fois.

L'auteur

Profil ProSite personnel

Liens sociaux

Viadeo Twitter Facebook Share on Google+   

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 :

  • Minimum : 00000000
  • 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 :

  • Minimum : 00
  • 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.

  • 'g' = 103
  • 'h' = 104
  • 'i' = 105
  • 'j' = 106

en hexadécimal nous aurons :

  • 'g' = 67
  • 'h' = 68
  • 'i' = 69
  • '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 :

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

Image non disponible
Image non disponible

puis cliquer sur parcourir…

Sélectionner le fichier Compression.mda

Image non disponible
Image non disponible

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 :

 
Sélectionnez
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 :

 
Sélectionnez
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 :

 
Sélectionnez
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.

 
Sélectionnez
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).

 
Sélectionnez
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

 
Sélectionnez
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

 
Sélectionnez
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.

 
Sélectionnez
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)

 
Sélectionnez
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 :

 
Sélectionnez
Option Compare Database
Option Explicit

Il y a

 
Sélectionnez
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
Sélectionnez
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
Sélectionnez
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
Sélectionnez
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
Sélectionnez
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
Sélectionnez
Private Declare Function CloseHandle Lib "kernel32" _
        (ByVal hObject As Long) _
        As Long
API qui permet de positionner un pointeur sur un fichier
Sélectionnez
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
Sélectionnez
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
Sélectionnez
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
Sélectionnez
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
Sélectionnez
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

 
Sélectionnez
'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
Sélectionnez
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
Sélectionnez
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
Sélectionnez
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
Sélectionnez
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
Sélectionnez
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
Sélectionnez
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
Sélectionnez
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
Sélectionnez
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
Sélectionnez
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
Sélectionnez
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
Sélectionnez
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" _
        (ByVal lpFileName As String) _
        As Long
API qui permet de fermer le pointeur de recherche
Sélectionnez
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
Sélectionnez
Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
Structure recuperant la recherche
Sélectionnez
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

 
Sélectionnez
'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
Sélectionnez
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
Sélectionnez
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 :

 
Sélectionnez
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
Sélectionnez
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
Sélectionnez
Private Sub DropTables()
Call DropTable([Module de compression].TABLE_IMPORT)
Call DropTable([Module de compression].TABLE_FILE)
End Sub
CreateTables
Sélectionnez
Private Sub CreateTables()
Call CreateTable1 'Listage_fichier
Call CreateTable2 'Stockage
End Sub
CreateTable1
Sélectionnez
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
Sélectionnez
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
Sélectionnez
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
Sélectionnez
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
Sélectionnez
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
Sélectionnez
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
Sélectionnez
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
Sélectionnez
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
Sélectionnez
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)

Image non disponible
Image non disponible

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.

Vous avez aimé ce tutoriel ? Alors partagez-le en cliquant sur les boutons suivants : Viadeo Twitter Facebook Share on Google+   

  

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.