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

creation d'une table par programmation a partir d'une table existante   


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

creation d'une table par programmation a partir d'une table existante
# 0000000306
ajouté le 29/03/2006 12:04:29 et modifié le 29/03/2006
consulté 9589 fois
Niveau débutant

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

Bonjour à toutes et à tous

Voici un prg  qui permet de creer un autre prg, permettant de construire une table dfb  libre, à partir d'une table existante.

Ce bout de code, est reproduit à partir du GENDBC livré avec FOXPRO.

Genddbc  construtruit un programme qui permet de générer  une  base de données avec ses tables, ses vues, ses connexion.

Ce programme permet de construire un programme qui genérera une table indépendante, à partir d'une table indépendante.

Atoutfoxmement

Aumeric

Code source :
LPARAMETERS m.monfichier_dbf, moncontructeur_prg



  IF TYPE('monfichier_dbf') <> "C" OR EMPTY(monfichier_dbf)
    m.monfichier_dbf = ALIAS()
    IF EMPTY(m.monfichier_dbf)
      USE? IN 99
      SELE 99
      m.monfichier_dbf = ALIAS()
      IF EMPTY(m.monfichier_dbf)
        RETURN .F.
      ENDIF
    ENDIF
  ELSE

    IF !USED(juststem(m.monfichier_dbf))
      USE (m.monfichier_dbf) IN 0 SHARED
    ENDIF
    SELECT (juststem(m.monfichier_dbf))
  ENDIF

  a_env_pres_pap = .f.

  IF TYPE('moncontructeur_prg') <> "C" OR EMPTY(moncontructeur_prg)
    moncontructeur_prg= PUTFILE('Output File:',alltrim(monfichier_dbf) + ".prg")
    IF EMPTY(moncontructeur_prg)
      rep = MESSAGEBOX('placer le contenu dans le presse papier ?',32+4,'Gentable')
      IF rep = 6 && yes
        a_env_pres_pap = .T.
        _CLIPTEXT = ""
      ELSE
        RETURN .F.
      ENDIF
    ENDIF
  ENDIF

  IF !a_env_pres_pap
    *!* Create the output file
    m.npointeur = FCREATE(m.moncontructeur_prg)
    IF m.npointeur < 1
      MESSAGEBOX('Le prg de destination ne peut pas être créé !: ' + m.moncontructeur_prg, 0,"erreur !")
      RETURN .F.
    ENDIF
  ELSE
    m.npointeur = 0
  ENDIF

  WAIT WINDOW "Construction et Ecriture de : " + ALLTRIM(monfichier_dbf) + "..." NOWAIT


  PRIVATE ALL EXCEPT g_*


  *! Get all the fields
  m.nbchamps = AFIELDS(a_champs)

  *! Header Information
  ecritfic(m.npointeur, "***** " + "Début structure " + m.monfichier_dbf + " *****")

  *! NOTE * NOTE * NOTE
  *! If the table is greater than 8 characters then it will fail on platforms that
  *! do not support this (Such as Win32s).
  m.cOldSetFullPath = SET("FULLPATH")
  SET FULLPATH OFF
  m.monfichier = DBF(ALIAS())
  SET FULLPATH &cOldSetFullPath
  m.monfichier = SUBSTR(m.monfichier, RAT(":", m.monfichier) + 1)
  m.machainedecreation = "CREATE TABLE " + m.monfichier + " free" + " ("

  *! Information about each field that can been written with CREATE TABLE - SQL
  FOR m.i = 1 TO m.nbchamps
    IF m.i = 1
      m.machainedecreation = m.machainedecreation + a_champs(m.i, 1) + " "
    ELSE
      m.machainedecreation = SPACE(LEN(m.monfichier_dbf) + 15) + ;
              a_champs(m.i, 1) + " "
    ENDIF
    m.machainedecreation = m.machainedecreation + a_champs(m.i, 2)
    DO CASE
      CASE a_champs(m.i, 2) == "C"
        m.machainedecreation = m.machainedecreation + "(" + ;
                ALLTRIM(STR(a_champs(m.i, 3))) + ")"
        IF a_champs(m.i, 6)
          m.machainedecreation = m.machainedecreation + " NOCPTRANS"
        ENDIF
      CASE a_champs(m.i, 2) == "M"
        IF a_champs(m.i, 6)
          m.machainedecreation = m.machainedecreation + " NOCPTRANS"
        ENDIF
      CASE a_champs(m.i, 2) == "N" OR ;
        a_champs(m.i, 2) == "F"
        machainedecreation = m.machainedecreation + "(" + ;
        ALLTRIM(STR(a_champs(m.i, 3))) + ;
        ", " + ALLTRIM(STR(a_champs(m.i, 4))) + ")"
      CASE a_champs(m.i, 2) == "B"
        m.machainedecreation = m.machainedecreation + "(" + ;
        ALLTRIM(STR(a_champs(m.i, 4))) ;
        + ")"
    ENDCASE

    IF a_champs(m.i, 5)
      m.machainedecreation = m.machainedecreation + " NULL"
    ELSE
      m.machainedecreation = m.machainedecreation + " NOT NULL"
    ENDIF



    IF m.i <> m.nbchamps
      m.machainedecreation = m.machainedecreation + ", ;"
    ELSE
      m.machainedecreation = m.machainedecreation + ")"
    ENDIF

    ecritfic(m.npointeur, m.machainedecreation)
  ENDFOR

  *! Get Index Information
  ecritfic(m.npointeur, CHR(13) + "***** " + " definition des index " + m.monfichier_dbf + " *****")
  m.cCollate = ""
  FOR m.i = 1 TO TAGCOUNT()
    m.cTag = UPPER(ALLTRIM(TAG(m.i)))
    IF m.cCollate <> IDXCOLLATE(m.i)
      m.cCollate = IDXCOLLATE(m.i)
      ecritfic(m.npointeur, "SET COLLATE TO '" + m.cCollate + "'")
    ENDIF
    IF !EMPTY(m.cTag)
      DO CASE
        CASE PRIMARY(m.i)
             IF !EMPTY(SYS(2021, m.i))
               IF EMPTY(m.g_cFilterExp)
                  MessageBox("NOT_SUPPORTED_LOC", 64, "WARNING_TITLE_LOC")
              ENDIF
                m.g_cFilterExp = m.g_cFilterExp + CHR(13) + ;
                               "TABLE_NAME_LOC" + m.monfichier_dbf + CHR(13) + ;
                               "PRIMARY_KEY_LOC" + SYS(14, m.i) + CHR(13) + ;
                               "FILTER_EXP_LOC" + SYS(2021, m.i)
             ENDIF
                     ecritfic(m.npointeur, "ALTER TABLE '" + m.monfichier_dbf + ;
                                  "' ADD PRIMARY KEY " + SYS(14, m.i) ;
                                  + " TAG " + m.cTag)
        CASE CANDIDATE(m.i)
          IF EMPTY(SYS(2021, m.i))
            ecritfic(m.npointeur, "INDEX ON " + SYS(14, m.i) + ;
                      " TAG " + m.cTag + " CANDIDATE")
          ELSE
               ecritfic(m.npointeur, "INDEX ON " + SYS(14, m.i) + ;
                      " TAG " + m.cTag + " FOR " + SYS(2021, m.i) + ;
                      + " CANDIDATE")
          ENDIF
        CASE UNIQUE(m.i)
          IF(EMPTY(SYS(2021, m.i)))
             ecritfic(m.npointeur, "INDEX ON " + SYS(14, m.i) + ;
                          " TAG " + m.cTag + " UNIQUE")
          ELSE
             ecritfic(m.npointeur, "INDEX ON " + SYS(14, m.i);
                                    + " TAG " + m.cTag + " FOR " + SYS(2021, m.i) ;
                                    + " UNIQUE")
                    ENDIF
        OTHERWISE
          IF(EMPTY(SYS(2021, m.i)))
             ecritfic(m.npointeur, "INDEX ON " + SYS(14, m.i) + ;
                                    " TAG " + m.cTag)
          ELSE
             ecritfic(m.npointeur, "INDEX ON " + SYS(14, m.i);
                                    + " TAG " + m.cTag + " FOR " + SYS(2021, m.i))
                    ENDIF
      ENDCASE
    ELSE
      EXIT FOR
    ENDIF
  ENDFOR

    ecritfic(m.npointeur, "")
  FCLOSE(m.npointeur)

  IF a_env_pres_pap
    MESSAGEBOX('le presse papier a été correctement rempli',0,'Gentable')
  ELSE
    MESSAGEBOX('la sortie a été envoyée sur le programme : ' + moncontructeur_prg+'.',0,'Gentable')
  ENDIF
RETURN

PROCEDURE ecritfic
  LPARAMETERS nfic, aecrire
  IF a_env_pres_pap
    _CLIPTEXT = _CLIPTEXT + CHR(13) + aecrire
  ELSE
    lnBytesSent = FPUTS(nfic, aecrire)
  ENDIF
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