ATOUTFOX
COMMUNAUTÉ FRANCOPHONE DES PROFESSIONNELS FOXPRO
Visual FoxPro : le développement durable

copier une base de données en renommant le DBC   


L'auteur

eric leissler
France France
Membre Simple
# 0000002784
enregistré le 06/03/2010
http://www.aumeric.fr
68 ans
LEISSLER Eric
85290 MORTAGNE SUR SEVRE
de la société AUMERIC LOGICIELS
Fiche personnelle

Note des membres
pas de note

Contributions > 01 - PRG : Programmation

copier une base de données en renommant le DBC
# 0000000804
ajouté le 15/09/2011 15:44:19 et modifié le 15/09/2011
consulté 8627 fois
Niveau débutant

Version(s) Foxpro :
VFP 9.0
VFP 8.0
VFP 7.0
VFP 6.0
Description

Bonjour à toutes et à tous

J'avais besoin pour un client de faire une copie de toute la base de données et de renommer cette dernière afin que le programme initial puisse accéder soit à une base, soit à l'autre, soit au deux en même temps

Une simple copie n'aurait pas suffit, puisque les deux bases doivent porter un nom différent et ce nom est intégré dans chaque table dans l'entête.

Grace à notre excellent forum, ( Vive atoutfox) Francis m'a fait connaitre ce lien

http://www.tek-tips.com/faqs.cfm?fid=1671

J'ai téléchargé ce programme et l'ai corrigé.

attention :

Le programme ne copie pas la valeur par défaut mise dans un champs

il faut le faire à la main.

Pour ma part, j'ai des champs identifiant, qui sont par défaut le padl(idint,10,"0") (pour des raisons de compatibilité descendentes )

c'est pourquoi j'ai rajouté les lignes

For e=1 To Fcount()
If Alltrim(Lower(Field(e)))=="identifiant"

cmd = " ALTER table " + atables(i) + " alter COLUMN identifiant c(10) DEFAULT PADL(idint,10,'0')"
&cmd

Endif
Endfor


AXE d'amélioration à apporter :

parcourir les champs des tables initiales afin de mettre la valeur par défaut correspondantes dans les champs des tables de destinations.

Bonne journée à toutes et à tous

Eric

Code source :
**********************************************
* Programme initial téléchargé sur
*  http://www.tek-tips.com/faqs.cfm?fid=1671
*
*  Corrections apportées : Eric LEISSLER - AUMERIC LOGICIELS - 15/09/2011
*
***********************************************
Local e,i,tFromDBC,tToDBC
Set Safety Off
tFromDBC= Getfile("dbc","Sélectionnez le dbc à copier","select")
tFromDBC = Left(tFromDBC ,Len(tFromDBC ) -4)
tToDBC = Getdir("","Indiquez le nouveau dosssier ou créez le !","choix du dossier",64,.F.)
tToDBC=tToDBC + Inputbox("nom de la nouvelle base de données", "indiquez le nouveau nom")
tFromDBC = Allt(tFromDBC)
tToDBC = Allt(tToDBC)

Close Databases All

Create Database (tToDBC)
Open Database  (tFromDBC)
Adbobjects(atables,"TABLE")
For i=1 To Alen(atables,1)
  Set Database To (tFromDBC)
  Use (atables(i)) In 0
  Select(atables(i))
  Copy   To (Addbs(Justpath(tToDBC))+atables(i)) With Cdx Database (tToDBC)
  Use
  Set Database To (tToDBC)
  Use (atables(i)) In 0 Exclusive

  Select(atables(i))

  For e=1 To Fcount()
    If Alltrim(Lower(Field(e)))=="identifiant"

      cmd = " ALTER table " + atables(i) + " alter COLUMN identifiant c(10) DEFAULT PADL(idint,10,'0')"
      &cmd

    Endif
  Endfor


  Use
Next
Set Database To (tFromDBC)
Adbobjects(atables,"VIEW")

Close Databases All

Local lnObjectId, lnNewId, lnParentId, lcFromDBF, lcToDBF

Use (tFromDBC+".dbc") In 0 Alias old Exclusive
Use (tToDBC+".DBC") In 0 Alias new Exclusive

Select new
Pack
Go Bottom
lnNewId = Reccount()+1
lnParentId = lnNewId
Select old
Pack

For i=1 To Alen(atables,1)

  Locate For Alltrim(Upper(OBJECTNAME)) == Alltrim(Upper(atables(i)))
  lnObjectId = ObjectId
  Scatter Memvar Memo
  m.ObjectId = lnNewId
  nstart=1
  Do While .T.
    plen=Asc(Substr(m.property,nstart,1))+256*Asc(Substr(m.property,nstart+1,1))
    buf=Substr(m.property,nstart,plen)
    Do While .T.
      ns=At(Justfname(tFromDBC)+"!",buf,1)
      If ns=0
        Exit
      Endif
      buf=Stuff(buf,ns,Len(Justfname(tFromDBC)),Justfname(tToDBC))
    Enddo
    nlen=Len(buf)
    hnlen=Int(nlen/256)
    lnlen=Mod(nlen,256)
    buf=Stuff(buf,1,2,Chr(lnlen)+Chr(hnlen))
    m.property=Stuff(m.property,nstart,plen,buf)
    nstart=nstart+nlen
    If nstart>=Len(m.property)
      Exit
    Endif
  Enddo
  Select new
  Append Blank
  Gather Memvar Memo

  Select old
  Scan For ParentId = lnObjectId
    Scatter Memvar Memo
    lnNewId = lnNewId+1
    m.ObjectId = lnNewId
    m.ParentId = lnParentId
    nstart=1
    Do While .T.
      plen=Asc(Substr(m.property,nstart,1))+256*Asc(Substr(m.property,nstart+1,1))
      buf=Substr(m.property,nstart,plen)
      Do While .T.
        ns=At(Justfname(tFromDBC)+"!",buf,1)
        If ns=0
          Exit
        Endif
        buf=Stuff(buf,ns,Len(Justfname(tFromDBC)),Justfname(tToDBC))
      Enddo
      nlen=Len(buf)
      hnlen=Int(nlen/256)
      lnlen=Mod(nlen,256)
      buf=Stuff(buf,1,2,Chr(lnlen)+Chr(hnlen))
      m.property=Stuff(m.property,nstart,plen,buf)
      nstart=nstart+nlen
      If nstart>=Len(m.property)
        Exit
      Endif
    Enddo
    Select new
    Append Blank
    Gather Memvar Memo
    Select old
  Endscan
  lnNewId=lnNewId+1
  lnParentId = lnNewId
Next
Close Databases All


Return
Commentaires
Aucun commentaire enregistré ...
www.atoutfox.org - Site de la Communauté Francophone des Professionnels FoxPro - v3.4.0 - © 2004-2024.
Cette page est générée par un composant COM+ développé en Visual FoxPro 9.0-SP2-HF3