1. Accueil
  2. Visual Basic / VB.NET
  3. Sources Visual Basic / VB.NET
  4. Sources Fichier / Disque
  5. Module de lecture des fichiers dbf

Module de lecture des fichiers dbf

5/5 (6 avis)

Vue 16 236 fois - Téléchargée 990 fois

Télécharger le projet
Commenter

Description

Module .bas contenant les fonctions qui permettent de lire un fichier dbf3 ou 4, et donc d'en récupérer la structure et les données.

Source / Exemple : 


Attribute VB_Name = "lectDBF"
'********************************************************************************
'*
'*  Module de lecture des fichiers DBF 3 et 4.
'*  Il suffit d'appeller la fonction lireDBF(nomDuFichier$)
'*  Les valeurs récupérées sont insérées dans la variable valchamp() en final,
'*  au format texte. Pour retrouver le bon format, il faut convertir selon
'*  les paramètres de champ(x).fieldType.
'*  Pour plus d'infos sur le format dbf, le fabuleux site http://www.wotsit.org
'*
'*  auteur : Laurent Jégou, jegou@univ-tlse2.fr
'*           Dept. de Géographie
'*           Université de Toulouse-Le Mirail
'********************************************************************************
'
Private Type fieldDbf 'Type Champ contenant les diverses infos.
    fieldName As String 'Nom du champ
    fieldType As String 'Type de données
    fieldLength As Long 'Longueur du champ (en DBF toutes les données sont écrites en texte, donc de longueur constante par champ.
    fieldDecimales As Byte 'Nombre de décimales
End Type
Private EOFH As Boolean 'Fin du fichier oui/non.
Private champ() As fieldDbf 'Tableau des champs.
Private nbchamps As Byte 'Nombre de champs de la table (max = 255).
Private numEnr As Integer 'Nombre d'enregistrements de la table.
Private valchamp() As String 'Variable texte recevant les valeurs de la table.

Public Sub lireDBF(ficdbf$)
Dim a As Byte
Dim b As Byte
Dim c As Byte
Dim d As Byte
Dim ha$
Dim hb$
Dim hc$
Dim hd$
Dim valeur As Integer
Dim vdbl As Double
Dim lastDate As Date 'Dernière date de modification du fichier.
Dim numBHeader As Integer 'Nombre de bits du header.
Dim numBEnr As Integer 'Nombre de bits par enregistrement.
Dim nc$
Dim cec As Byte 'Numéro du champ en cours
ReDim champ(255)
Open ficdbf$ For Binary Access Read As #1 'Ouverture du fichier en mode séquentiel binaire.
Get #1, , a
Get #1, , b
Get #1, , c
Get #1, , d
    ha$ = Hex$(a): If Len(ha$) = 1 Then ha$ = "0" & ha$
    hb$ = Hex$(b): If Len(hb$) = 1 Then hb$ = "0" & hb$
    hc$ = Hex$(c): If Len(hc$) = 1 Then hc$ = "0" & hc$
    hd$ = Hex$(d): If Len(hd$) = 1 Then hd$ = "0" & hd$
    hb$ = CByte("&h" & hb$)
    hc$ = CByte("&h" & hc$)
    hd$ = CByte("&h" & hd$)
    If Val(hb$) >= 100 Then hb$ = Str$(2000 + (Val(hb$) - 100)) 'Bug de l'an 2000...
    lastDate = CDate(hd$ & "/" & hc$ & "/" & hb$)
Get #1, , a
Get #1, , b
Get #1, , c
Get #1, , d
    ha$ = Hex$(a): If Len(ha$) = 1 Then ha$ = "0" & ha$
    hb$ = Hex$(b): If Len(hb$) = 1 Then hb$ = "0" & hb$
    hc$ = Hex$(c): If Len(hc$) = 1 Then hc$ = "0" & hc$
    hd$ = Hex$(d): If Len(hd$) = 1 Then hd$ = "0" & hd$
    numEnr = CDbl("&h" & hd$ & hc$ & hb$ & ha$)
    Get #1, , a
    Get #1, , b
    ha$ = Hex$(a): If Len(ha$) = 1 Then ha$ = "0" & ha$
    hb$ = Hex$(b): If Len(hb$) = 1 Then hb$ = "0" & hb$
    numBHeader = CInt("&h" & hb$ & ha$)
    Get #1, , a
    Get #1, , b
    ha$ = Hex$(a): If Len(ha$) = 1 Then ha$ = "0" & ha$
    hb$ = Hex$(b): If Len(hb$) = 1 Then hb$ = "0" & hb$
    numBEnr = CInt("&h" & hb$ & ha$)
For i = 1 To 20
    Get #1, , a
Next i
nbchamps = 0
cec = 1 'Initialisation du numéro de champ en cours.
header:
    Get #1, , a
    ha$ = Hex$(a)
    If Len(ha$) = 1 Then ha$ = "0" & ha$
    If ha$ = "0D" Then GoTo records
    Get #1, Seek(1) - 2, a
    getDbfFieldHeader (cec) 'Appel de la fonction de lescture du header.
    cec = cec + 1
GoTo header
records:
nbchamps = cec - 1
ReDim Preserve champ(nbchamps)
ReDim valchamp(nbchamps, numEnr)
Call lirecontenu
End Sub

Private Sub getDbfFieldHeader(cec)
Dim a As Byte
Dim ha$
Dim nf$ 'Nom du champ.
Dim finNom As Boolean
finNom = False
For i = 1 To 11
    Get #1, , a
    ha$ = Chr$(a)
    If a = 0 And finNom = False Then
        champ(cec).fieldName = nf$
        nf$ = ""
        finNom = True
    Else
        If finNom = False Then nf$ = nf$ + ha$
    End If
Next i
Get #1, , a
ha$ = Chr$(a)
Select Case ha$ 'Affectation du type de données du champ en cours.
    Case Is = "C"
        champ(cec).fieldType = "Texte"
    Case Is = "F"
        champ(cec).fieldType = "Flottant"
    Case Is = "N"
        champ(cec).fieldType = "Numérique"
    Case Else
        champ(cec).fieldType = "Autre"
End Select
Get #1, , a 'Décalage
Get #1, , a
Get #1, , a
Get #1, , a
Get #1, , a
ha$ = Hex$(a): If Len(ha$) = 1 Then ha$ = "0" & ha$
champ(cec).fieldLength = CByte("&h" & ha$) 'Affectation de la longueur.
Get #1, , a
ha$ = Hex$(a): If Len(ha$) = 1 Then ha$ = "0" & ha$
champ(cec).fieldDecimales = CByte("&h" & ha$) 'Affectation du nombre de décimales.
For i = 1 To 14
    Get #1, , a
Next i
End Sub

Public Sub lirecontenu() 'Après lecture du header général et des header de champs, lecture des données.
Dim a As Byte
Dim nc$ 'Variable de stockage des valeurs.
For i = 1 To numEnr
    Get #1, , a
    For j = 1 To nbchamps
        nc$ = ""
        For k = 1 To champ(j).fieldLength
            Get #1, , a
            If Chr$(a) <> " " Then nc$ = nc$ + Chr$(a)
        Next k
        valchamp(j, i) = nc$ 'Valeur de l'enregistrement J du champ I
    Next j
Next i
Close #1 'Fermeture du fichier
End Sub
Télécharger le projet

Codes Sources

A voir également

Ajouter un commentaire Commentaires
Galactus13
Messages postés
332
Date d'inscription
lundi 29 septembre 2008
Statut
Membre
Dernière intervention
10 avril 2020
 1
24 janv. 2012 à 21:30
Enfin, je retrouve ce code et son auteur !
Un grand merci, il m'a bien aidé et encore aujourd'hui,
Après des légères modifications, je l'ai adapté pour un soft perso de conversion multiple dbf, csv, mdb,html, accdb, fic.
Tout sa dans un ListView à ma sauce de VulgarisBarbarian !
Faudra que je pense à mettre mon joujou ici ! même si c'est tout écrit en VB5~VB6 ! Et ma note: 10/10 !
cs_FanLaBise
Messages postés
19
Date d'inscription
mercredi 12 janvier 2005
Statut
Membre
Dernière intervention
24 janvier 2011
2 oct. 2008 à 21:14
Que dire de plus, j'utilise ce code depuis quelques années, il est tout simplement NIKEL ! ! ! Quelque-soit le type de base (je n'utilise que du DBF) il n'a aucun défaut... Sauf que maintenant, je suis sous DOT.NET... Et là, je rame à 100%... Je n'ai jamais eu besoin d'en savoir plus sur les bases de données grasse à cette super routine, mais je dois m'y mettre sérieusement, et celà me fais super ch.... Si quelqu'un a ce truc en DOT.NET...

Encore bravo à LeCarto....

FanLaBise...
danfaxel
Messages postés
2
Date d'inscription
lundi 9 août 2004
Statut
Membre
Dernière intervention
17 mars 2008
17 mars 2008 à 22:52
Bien pour le principe, mais un peu lent à l'exécution
df
LeCarto
Messages postés
16
Date d'inscription
mardi 28 novembre 2000
Statut
Membre
Dernière intervention
6 juillet 2007
8 juil. 2007 à 08:27
Bonjour, ArcGIS lit directement le format .dbf, et son VBA comprend des fonctions pour y accéder. Je vous renvoie à la documentation, car je n'ai jamais utilisé ce VBA. Vous pouvez aussi poser vos questions sur ce forum professionnel dédié aux SIG : http://www.forumsig.org
sabrachatilla
Messages postés
1
Date d'inscription
dimanche 8 juillet 2007
Statut
Membre
Dernière intervention
8 juillet 2007
8 juil. 2007 à 02:58
bonjour,
je veux me connecter à une dbf avec VB en utilisant les options d'ArcGis.
aidez moi s'il vous plait
Afficher les 6 commentaires
S'inscrire maintenant

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.

Du même auteur (LeCarto)