Lire un fichier dBase
Ce programme permet de lire et de gérer un fichier dBase.
Si mes clients doivent modifier des fichiers, ils doivent acheter une version de
dBasePlus afin d'être en règle avec la législation sur les copyright.
Avec cet outil compilé, la loi est respectée et il est possible d'interdire :
- l'ajout d'enregistrement,
- la destruction d'enregistrement,
- la modification des fichiers
Attention : si un fichier de niveau inférieur est modifié puis utilisé avec une vieille version de
dBase ou Clipper, il risque fort de ne plus fonctionner. Il en est de même pour les
fichiers untilisant des index NDX. Cest pour ce motif que j'ai mis un verrou sur les modifications.
Pour lancer ce programme, cliquez droit sur le fichier dbf à ouvrir,
sélectionnez "Ouvrir avec", sélectionnez "ViewverDbf.EXE" (ou du nom de l'exe après compilation).
Dans mes programmes, je n'utilise que des tables DBF et des index MDX.
Je suis en train de travailler sur ce programme : il va donc évoluer en fonction de mes disponibilités.
*
* ViewverDbf.wfm - Afficher un fichier dBase.
* --------------------------------------------
*
/*
En cours :
- Finitions de la forme CreeUneTable.wfm
A faire :
- Try pour ouverture exclusive
- Créer un index sur plusieurs champs avec formules
- Sortir ou copier la table
- Afficher les informations sur les champs
- Détruite une table
- Afficher les informations sur les index
- Recherche en LOCATE et CONTINUE
- Modifier la structure de la table
- Mettre les choix des index :
- UNIQUE ON / OFF
- ASCENDING / DESCENDING
- Mettre les derniers fichiers ouverts (fichier index date+heure descend)
A essayer :
- Fenêtres classe Popup en remplacement des diverses classes
- Classe de sélection des index
- Sous classes en remplacement des diverses classes
- Insertion de ligne
Plus tard :
- Voir pour faire ce programme avec la classe Grid en méthode objet.
*/
*
PARAMETER vFichier && Pour pouvoir double cliquer sur le fichier.
*
PUBLIC POSSIBILITE_MODIFIER
*
* Modifier la ligne suivante pour les autorisations.
*
POSSIBILITE_MODIFIER = 2 && 0 = Lire, 1 = Modifier, 2 = Tout autoriser.
*
#DEFINE C_oGris10 "0xE6E6E6"
#DEFINE C_oMagentaClair "0xFF00FF"
#DEFINE C_oNoir "0x000000"
#DEFINE C_oRouge "0x000080"
*
IF PCOUNT() = 0
vFichier = GETFILE("*.dbf") && Lancement direct du programme.
ENDIF
*
IF EMPTY(vFichier)
RETURN
ENDIF
*
LOCAL oTd && Vérification interdire anciennes versions.
* Peut-être pas de problème avec version 5 ??
oTd = new TableDef()
oTd.tableName := vFichier
oTd.load()
*
IF VAL(oTd.version) < 7
POSSIBILITE_MODIFIER = 0
ENDIF
*
oTd := null
*
IF POSSIBILITE_MODIFIER > 1
USE &vFichier ALIAS Test EXCLUSIVE
ELSE
USE &vFichier ALIAS Test
ENDIF
*
IF TYPE("GetSystemMetrics") # "FP" && Pour la taille de la forme.
EXTERN CINT GetSystemMetrics(CINT) User32.DLL
ENDIF
*
LOCAL F
F = new ViewverDbfForm()
F.open()
*
F := null
*
RETURN
*
* ------------------------------------------------------------------------------
CLASS ViewverDbfForm of FORM
* ------------------------------------------------------------------------------
*
this.Fichier = vFichier
this.IndexName = null && Nom de l'index en cours.
this.IndexKey = null && Cle de l'index en cours
this.PbWidth = 14
*
this.oTd = new TableDef()
this.oTd.tableName := this.Fichier
this.oTd.load()
*
this.VersionTable = this.oTd.version
*
with (this)
mdi := .F.
left := 0
top := 0
height := GetSystemMetrics(79) / 25
width := GetSystemMetrics(78) / 7.5
maximize := .F. && Ne se cadre pas en plein écran.
text := this.Fichier
onOpen := class::Dimensions
onClose := class::Form_OnClose
endwith
*
this.MENU1 = new MENU(this)
**
this.MENU1.FICHIER = new MENU(this.MENU1)
with (this.MENU1.FICHIER)
text := "Fichier"
endwith
*
this.MENU1.FICHIER.OUVRE = new MENU(this.MENU1.FICHIER)
with (this.MENU1.FICHIER.OUVRE)
text := "Ouvrir"
onClick := class::Ouvre
endwith
*
this.MENU1.FICHIER.CREE = new MENU(this.MENU1.FICHIER)
with (this.MENU1.FICHIER.CREE)
text := "Créer"
onClick := class::Creer
endwith
*
this.MENU1.FICHIER.QUITTER = new MENU(this.MENU1.FICHIER)
with (this.MENU1.FICHIER.QUITTER)
text := "Quitter"
onClick := {;form.close()}
endwith
**
this.MENU1.INDEX = new MENU(this.MENU1)
with (this.MENU1.INDEX)
text := "Index"
endwith
*
this.MENU1.INDEX.QUITTER = new MENU(this.MENU1.INDEX)
with (this.MENU1.INDEX.QUITTER)
text := "Ouvrir / Fermer"
onClick := class::SetOrder
endwith
*
this.MENU1.INDEX.CREESIMPLE = new MENU(this.MENU1.INDEX)
with (this.MENU1.INDEX.CREESIMPLE)
text := "Créer sur 1 champ"
onClick := class::IndexCreeSimple
endwith
*
this.MENU1.INDEX.REINDEX = new MENU(this.MENU1.INDEX)
with (this.MENU1.INDEX.REINDEX)
text := "Recontruire"
onClick := {;REINDEX}
endwith
*
this.MENU1.INDEX.DETRUIT = new MENU(this.MENU1.INDEX)
with (this.MENU1.INDEX.DETRUIT)
text := "Détruire"
onClick := class::IndexDetruit
endwith
**
this.MENU1.LIGNE = new MENU(this.MENU1)
with (this.MENU1.LIGNE)
text := "Lignes"
endwith
*
this.MENU1.LIGNE.VAHAUT = new MENU(this.MENU1.LIGNE)
with (this.MENU1.LIGNE.VAHAUT)
text := "Va au début"
onClick := {;GO TOP}
endwith
*
this.MENU1.LIGNE.VABAS = new MENU(this.MENU1.LIGNE)
with (this.MENU1.LIGNE.VABAS)
text := "Va à la fin"
onClick := {;GO BOTTOM}
endwith
*
this.MENU1.LIGNE.VANUM = new MENU(this.MENU1.LIGNE)
with (this.MENU1.LIGNE.VANUM)
text := "Va au numéro"
onClick := class::VaAuNumero
endwith
*
this.MENU1.LIGNE.AJOUTE = new MENU(this.MENU1.LIGNE)
with (this.MENU1.LIGNE.AJOUTE)
text := "Ajouter"
onClick := {;APPEND BLANK}
endwith
*
this.MENU1.LIGNE.DETRUIT = new MENU(this.MENU1.LIGNE)
with (this.MENU1.LIGNE.DETRUIT)
text := "Détruire"
onClick := class::ChampDetruit
endwith
*
this.BROWSE1 = new BROWSE(this)
with (this.BROWSE1)
alias := "Test"
modify := IIF(POSSIBILITE_MODIFIER = 0, .F., .T.)
onChange := class::Dimensions
onNavigate := class::Dimensions
left := 0
top := 1.0
colorHighlight := C_oNoir + "/" + C_oGris10 && Marche si "modify := .T."
endwith
*
this.TEXT1 = new TEXT(this)
with (this.TEXT1)
top := 0
height := 1
left := 0
alignVertical := 1
endwith
*
this.ENTRYFIELD1 = new ENTRYFIELD(this)
with (this.ENTRYFIELD1)
top := this.TEXT1.top
height := this.TEXT1.height
left := 0
width := 15
value := ""
key := class::VaAuNumeroKey
enabled := .F.
visible := .F.
endwith
*
* ------------------------------------------------------------------------------
FUNCTION ChampDetruit
* ------------------------------------------------------------------------------
*
IF MSGBOX("Détruire l'enregistrement : " + LTRIM(STR(RECNO(),16,0)) + " ?" ;
, "Attention", 4 + 32) = 6
DELETE
PACK
ENDIF
*
class::Dimensions()
*
RETURN null
*
* ------------------------------------------------------------------------------
FUNCTION Creer
* ------------------------------------------------------------------------------
*
/*
Télécharger la forme :
CreeUneTable.wfm
*/
*
LOCAL oCreer
*
TRY && Essaye d'ouvrir la classe.
oCreer = new CreeTable()
CATCH(exception e) && Si classe pas chargée.
TRY
SET PROCEDURE TO CreeUneTable.wfm ADDITIVE && Essaye de charger la forme.
CATCH(exception e)
MSGBOX("Le fichier CreeUneTable.wfm est absent, abandon", "Créer une table", 48)
class::Dimensions()
form.BROWSE1.setFocus()
RETURN null
ENDTRY
oCreer = new CreeTable()
ENDTRY
*
IF POSSIBILITE_MODIFIER > 0
LOCATE FOR FIELD(1) = null && Pour ne pas perdre la dernière modification.
ENDIF
CLOSE TABLES
*
oCreer.readModal()
*
IF oCreer.Enregistre == 1
form.Fichier := oCreer.TableNom
ENDIF
*
PRIVATE MACROfichier
MACROfichier = form.Fichier
IF POSSIBILITE_MODIFIER > 1
USE &MACROfichier ALIAS Test EXCLUSIVE
ELSE
USE &MACROfichier ALIAS Test
ENDIF
form.text := form.Fichier
form.BROWSE1.alias := "Test"
RELEASE MACROfichier
*
oCreer := null
class::Dimensions()
form.BROWSE1.setFocus()
*
RETURN null
*
* ------------------------------------------------------------------------------
FUNCTION Dimensions
* ------------------------------------------------------------------------------
*
form.MENU1.INDEX.CREESIMPLE.enabled := IIF(POSSIBILITE_MODIFIER > 1 , .T., .F.)
form.MENU1.INDEX.REINDEX.enabled := IIF(POSSIBILITE_MODIFIER > 1 , .T., .F.)
form.MENU1.INDEX.DETRUIT.enabled := IIF(POSSIBILITE_MODIFIER > 1 , .T., .F.)
*
form.MENU1.LIGNE.AJOUTE.enabled := IIF(POSSIBILITE_MODIFIER > 1 , .T., .F.)
form.MENU1.LIGNE.DETRUIT.enabled := IIF(POSSIBILITE_MODIFIER > 1 , .T., .F.)
*
form.BROWSE1.modify := IIF(POSSIBILITE_MODIFIER = 0, .F., .T.)
form.BROWSE1.height := form.height - 1.0
form.BROWSE1.width := form.width
*
form.TEXT1.width := form.width - form.ENTRYFIELD1.width
form.TEXT1.left := form.ENTRYFIELD1.width
form.TEXT1.text := " Enregistrement N0 : " ;
+ LTRIM(STR(IIF(RECCOUNT() = 0, 0, RECNO()), 16, 0)) ;
+ " / " + LTRIM(STR(RECCOUNT(), 16, 0)) ;
+ " Index : " + IIF(form.IndexName = null, "** Non **" ;
, form.IndexName + " Clé : " + form.IndexKey) ;
+ " Version table : " + form.VersionTable
*
form.refresh()
*
RETURN null
*
* ------------------------------------------------------------------------------
FUNCTION Form_OnClose
* ------------------------------------------------------------------------------
*
IF POSSIBILITE_MODIFIER > 0
LOCATE FOR FIELD(1) = null && Pour ne pas perdre la dernière modification.
ENDIF
*
CLOSE TABLES
*
RETURN null
*
* ------------------------------------------------------------------------------
FUNCTION IndexCreeSimple
* ------------------------------------------------------------------------------
*
LOCAL oIndex
*
oIndex = new CreeIndexSimple(form.Fichier)
oIndex.readModal()
*
IF .NOT. EMPTY(oIndex.IndexName)
form.IndexName := oIndex.IndexName
form.IndexKey := oIndex.IndexKey
PRIVATE MACROindex
MACROindex = oIndex.IndexName
SET ORDER TO &MACROindex
RELEASE MACROindex
ELSE
form.IndexName := null
form.IndexKey := null
SET ORDER TO
ENDIF
*
oIndex := null
*
class::Dimensions()
form.BROWSE1.setFocus()
*
RETURN null
*
* ------------------------------------------------------------------------------
FUNCTION IndexDetruit
* ------------------------------------------------------------------------------
*
SET ORDER TO && Fermeture index.
form.IndexName := null
form.IndexKey := null
*
LOCAL oIndex
*
oIndex = new DetruitIndex(form.Fichier)
oIndex.readModal()
*
oIndex := null
*
form.BROWSE1.alias := "Test"
GO TOP
class::Dimensions()
form.BROWSE1.setFocus()
*
RETURN null
*
* ------------------------------------------------------------------------------
FUNCTION Ouvre
* ------------------------------------------------------------------------------
*
LOCAL vFichier
*
vFichier = null
vFichier = GETFILE("*.dbf")
*
IF .NOT. EMPTY(vFichier)
IF POSSIBILITE_MODIFIER > 0
LOCATE FOR FIELD(1) = null && Pour ne pas perdre la dernière modification.
ENDIF
CLOSE TABLES
*
PRIVATE MACROfichier
MACROfichier = vFichier
form.Fichier := vFichier
*
form.oTd = new TableDef()
form.oTd.tableName := form.Fichier
form.oTd.load()
*
form.VersionTable = form.oTd.version
*
IF VAL(form.oTd.version) < 7
POSSIBILITE_MODIFIER = 0
ENDIF
*
form.BROWSE1.modify := IIF(POSSIBILITE_MODIFIER = 0, .F., .T.)
*
IF POSSIBILITE_MODIFIER > 1
USE &MACROfichier ALIAS Test EXCLUSIVE
ELSE
USE &MACROfichier ALIAS Test
ENDIF
*
form.text := form.Fichier
*
form.BROWSE1.alias := "Test"
*
RELEASE MACROfichier
ENDIF
*
class::Dimensions()
form.BROWSE1.setFocus()
*
RETURN null
*
* ------------------------------------------------------------------------------
FUNCTION VaAuNumero
* ------------------------------------------------------------------------------
*
form.ENTRYFIELD1.enabled := .T.
form.ENTRYFIELD1.visible := .T.
form.ENTRYFIELD1.setFocus()
*
RETURN null
*
* ------------------------------------------------------------------------------
FUNCTION VaAuNumeroKey(K)
* ------------------------------------------------------------------------------
*
IF CHR(K)$"0123456789"
form.ENTRYFIELD1.value += CHR(K)
ELSEIF K = 13
IF VAL(form.ENTRYFIELD1.value) > 0 .AND. VAL(form.ENTRYFIELD1.value) <= RECCOUNT()
GOTO VAL(form.ENTRYFIELD1.value)
ELSE
MSGBOX("Vous avez saisi un enregistrement hors fichier.", "Va au Numéro", 48)
ENDIF
form.ENTRYFIELD1.value := ""
form.ENTRYFIELD1.enabled := .F.
form.ENTRYFIELD1.visible := .F.
*
class::Dimensions()
form.BROWSE1.setFocus()
*
ENDIF
*
RETURN null
*
* ------------------------------------------------------------------------------
FUNCTION SetOrder
* ------------------------------------------------------------------------------
*
LOCAL oTd
*
oTd = new TableDef()
oTd.tableName := form.Fichier
oTd.load()
*
IF oTd.indexes.size > 0
LOCAL I, oTableau1, oTableau2, oSelect
*
oTableau1 = new Array()
oTableau2 = new Array()
*
FOR I = 1 TO oTd.indexes.size
oTableau1.add(oTd.indexes[I].indexname)
oTableau2.add(oTd.indexes[I].expression)
ENDFOR
*
oSelect = new SelecIndex(oTableau1, oTableau2)
oSelect.readModal()
*
IF .NOT. EMPTY(oSelect.IndexName)
form.IndexName := oSelect.IndexName
form.IndexKey := oSelect.IndexKey
PRIVATE MACROindex
MACROindex = oSelect.IndexName
SET ORDER TO &MACROindex
RELEASE MACROindex
ELSE
form.IndexName := null
form.IndexKey := null
SET ORDER TO
ENDIF
*
oTableau1 := null
oTableau2 := null
oSelect := null
*
GO TOP
*
ELSE
MSGBOX("Pas d'index MDX pour cette table.", "Sélection index", 64)
ENDIF
*
oTd := null
*
class::Dimensions()
form.BROWSE1.setFocus()
*
RETURN null
*
ENDCLASS
*
* ---------------------------------------------------------------------------
CLASS SelecIndex(oTableau1, oTableau2) OF FORM
* ---------------------------------------------------------------------------
*
this.Tableau1 = oTableau1
this.Tableau2 = oTableau2
*
this.IndexName = null
this.IndexKey = null
*
with (this)
Mdi := .F.
height := 7
left := 60
top := 5
width := 45
text := "Sélection d'un index"
onGotFocus := {;form.Cb1.setFocus()}
sysMenu := .F.
escExit := .F.
onOpen := class::Change
endwith
*
this.Txt1 = new TEXT(this)
with (this.Txt1)
Text := ""
FontBold := .F.
Width := 35
Top := 1
Left := 5
alignHorizontal := 1
endwith
*
this.Cb1 = new COMBOBOX(this)
with (this.Cb1)
onChange := class::Change
DataSource := "array form.Tableau1"
FontBold := .T.
Top := 3
Left := 5
Width := 35
Style := 2
endwith
*
this.Pb1 = new PUSHBUTTON(this)
with (this.Pb1)
onClick := class::Pb1_OnClick
height := 1
left := 1
top := 5.5
width := 20
text := "Ouvrir"
endwith
*
this.Pb2 = new PUSHBUTTON(this)
with (this.Pb2)
onClick := {;form.close()}
height := 1
left := 24
top := 5.5
width := 20
text := "Fermer"
endwith
*
* ------------------------------------------------------------------------------
FUNCTION Change
* ------------------------------------------------------------------------------
*
form.Txt1.text = "Clé : " + form.Tableau2[form.Tableau1.scan(form.Cb1.value)]
*
RETURN null
*
* -----------------------------------------------------------------------------
FUNCTION Pb1_OnClick
* -----------------------------------------------------------------------------
*
form.IndexName := form.cb1.value
form.IndexKey := form.Tableau1[form.Tableau1.scan(form.Cb1.value)]
*
form.close()
*
RETURN null
*
ENDCLASS
*
* ---------------------------------------------------------------------------
CLASS CreeIndexSimple(vFichier) OF FORM
* ---------------------------------------------------------------------------
*
/*
Dans ce programme, le nom de la clef de l'index est celle du champ.
Si la clef est crée, on ouvre ce nouvel index dans le forme précédente.
*/
*
LOCAL I
*
this.Fichier = vFichier
*
this.oTd = new TableDef()
this.oTd.tableName := this.Fichier
this.oTd.load()
*
this.Tableau1 = new Array() && Nom et clef de l'index.
this.Tableau2 = new Array() && Type du champ.
*
FOR I = 1 TO this.oTd.fields.size
this.Tableau1.add(this.oTd.fields[I].fieldname)
this.Tableau2.add(this.oTd.fields[I].type)
ENDFOR
*
this.IndexName = null
this.IndexKey = null
*
with (this)
Mdi := .F.
height := 7
left := 60
top := 5
width := 45
colorNormal := C_oNoir + "/" + C_oMagentaClair
text := "Création d'un index simple"
onGotFocus := {;form.Cb1.setFocus()}
sysMenu := .F.
escExit := .F.
onOpen := class::Change
endwith
*
this.Txt1 = new TEXT(this)
with (this.Txt1)
Text := ""
FontBold := .F.
Width := 35
Top := 1
Left := 5
alignHorizontal := 1
endwith
*
this.Cb1 = new COMBOBOX(this)
with (this.Cb1)
onChange := class::Change
DataSource := "array form.Tableau1"
FontBold := .T.
Top := 3
Left := 5
Width := 35
Style := 2
endwith
*
this.Pb1 = new PUSHBUTTON(this)
with (this.Pb1)
onClick := class::Pb1_OnClick
height := 1
left := 1
top := 5.5
width := 20
text := "Créer l'index"
endwith
*
this.Pb2 = new PUSHBUTTON(this)
with (this.Pb2)
onClick := {;form.close()}
height := 1
left := 24
top := 5.5
width := 20
text := "Abandonner"
endwith
*
* ------------------------------------------------------------------------------
FUNCTION Change
* ------------------------------------------------------------------------------
*
form.Txt1.text = "Type : " + form.Tableau2[form.Tableau1.scan(form.Cb1.value)]
*
RETURN null
*
* -----------------------------------------------------------------------------
FUNCTION Pb1_OnClick
* -----------------------------------------------------------------------------
*
PRIVATE MACROindex
*
MACROindex = form.cb1.value
INDEX ON &MACROindex TAG &MACROindex
RELEASE MACROindex
*
form.IndexName := form.cb1.value
form.IndexKey := form.cb1.value
*
form.close()
*
RETURN null
*
ENDCLASS
*
* ---------------------------------------------------------------------------
CLASS DetruitIndex(vFichier) OF FORM
* ---------------------------------------------------------------------------
*
LOCAL I
*
this.Fichier = vFichier
*
this.oTd = new TableDef()
this.oTd.tableName := this.Fichier
this.oTd.load()
*
this.Tableau1 = new Array() && Nom et clef de l'index.
this.Tableau2 = new Array() && Type du champ.
*
FOR I = 1 TO this.oTd.indexes.size
this.Tableau1.add(this.oTd.indexes[I].indexname)
this.Tableau2.add(this.oTd.indexes[I].expression)
ENDFOR
*
with (this)
Mdi := .F.
height := 7
left := 60
top := 5
width := 45
colorNormal := C_oNoir + "/" + C_oRouge
text := "Destruction d'un index"
onGotFocus := {;form.Cb1.setFocus()}
sysMenu := .F.
escExit := .F.
onOpen := class::Change
endwith
*
this.Txt1 = new TEXT(this)
with (this.Txt1)
Text := ""
FontBold := .F.
Width := 35
Top := 1
Left := 5
alignHorizontal := 1
endwith
*
this.Cb1 = new COMBOBOX(this)
with (this.Cb1)
onChange := class::Change
DataSource := "array form.Tableau1"
FontBold := .T.
Top := 3
Left := 5
Width := 35
Style := 2
endwith
*
this.Pb1 = new PUSHBUTTON(this)
with (this.Pb1)
onClick := class::Pb1_OnClick
height := 1
left := 1
top := 5.5
width := 20
text := "Détruire l'index"
endwith
*
this.Pb2 = new PUSHBUTTON(this)
with (this.Pb2)
onClick := {;form.close()}
height := 1
left := 24
top := 5.5
width := 20
text := "Abandonner"
endwith
*
* ------------------------------------------------------------------------------
FUNCTION Change
* ------------------------------------------------------------------------------
*
form.Txt1.text = "Clé : " + form.Tableau2[form.Tableau1.scan(form.Cb1.value)]
*
RETURN null
*
* -----------------------------------------------------------------------------
FUNCTION Pb1_OnClick
* -----------------------------------------------------------------------------
*
PRIVATE MACROfichier, MACROindex
*
IF MSGBOX("Détruire l'index : " + form.cb1.value ;
, "Détruire un index", 4 + 48) = 6
LOCATE FOR FIELD(1) = null && Pour ne pas perdre la dernière modification.
CLOSE TABLES
*
MACROfichier = LEFT(form.Fichier, LEN(form.Fichier) - 4)
MACROindex = form.cb1.value
DROP INDEX "&MACROfichier".&MACROindex
*
MACROfichier = form.Fichier
USE &MACROfichier ALIAS Test EXCLUSIVE
ENDIF
*
RELEASE MACROfichier, MACROindex
*
form.close()
*
RETURN null
*
ENDCLASS
