Mes aventures avec ISAM et Panoramic

Hide 0
Variables()
Labels()
Init()
Gui()
Show 0

Recherche_des_articles()
Creation_des_fichiers()
Creation_des_fiches()
Message "Base Créée !"
Quitter()

End

' +++ DECLARATION DES VARIABLES +++

SUB Variables()
   dim_local i%
'  adresses de dossiers

   dim Path$    : Path$    = dir_current$
   if right$(path$,1)="" : path$ = left$(path$,len(path$)-1) : end_if
   path$ = path$+""
  
   dim dir_Art$ : dir_Art$ = "C:\Users\Yannick\PLM_le_site\Articles"
   dim dir_dll$ : dir_dll$ = "C:\KGF"
'  adresses dll
   dim kgf$ : kgf$ = dir_dll$+"KGF.dll"
'  database
   dim support$
   dim ISAM_vers$
   dim ISAM_IdentSize%
   dim ISAM_id%
   dim ISAM_nam$
   dim ISAM_exist%
   dim ISAM_RecLen%
   dim ISAM_Record$
   dim ISAM_NbRec%
   dim inbase%
   dim keyinbase%
'  événements
   dim num_clic%
   dim num_dclic%
   dim num_change%
'  objets
   dim no%
   dim frame%     : no%=no%+1 : frame% =no%
   dim alph1%     : no%=no%+1 : alph1% =no%
   dim Pbar%      : no%=no%+1 : Pbar%  =no%
   dim liste%     : no%=no%+1 : liste% =no%
END_SUB

' +++ DECLARATION DES LABELS +++

SUB Labels()
   Label Clic
   Label DClic
   Label Change
END_SUB

' +++ INITIALISATIONS +++

SUB Init()
   dim_local version%,kgf_vers$,res%,i%,url$,fic$
  
'  activation de la dll
   if dir_exists(dir_dll$)=1
      dll_on kgf$
      kgf_vers$=string$(25," ")
      version% = DLL_call1("KGFdllVersion",adr(kgf_vers$))
      ' message trim$(kgf_vers$)
   else
      i% = Message_information_yes_no("Le dossier ''C:\KGF'' n' a pas été trouvé."+chr$(13)+"Voulez vous le télécharger maintenant ?...")
      if i%<>1
         dir_make dir_dll$
'        fonction à définir
      else
         res% = dll_call1("KillProcessByHandle",handle(0))
      end_if
   end_if
  
'  initialisation de l' environnement isam
   res% = dll_call0("InitIsam")
   ISAM_vers$ = string$(25," ")
   res% = dll_call1("GetIsamVersion",adr(ISAM_vers$))
   ' message trim$(ISAM_vers$)
END_SUB

' +++ INTERFACE UTILISATEUR +++

SUB Gui()

   height 0,100
   width 0,600
   top 0,(screen_y-height(0))/2
   left 0,(screen_x-width(0))/2
   font_name 0,"arial"
   font_size 0,8
   caption 0,""
  
   Panel frame%
   full_space frame%

   alpha alph1%
   parent alph1%,frame%
   top alph1%,15
   left alph1%,15
   font_color alph1%,0,0,200
  
   Progress_bar Pbar%
   hide Pbar%
   parent Pbar%,frame%
   width Pbar%,width(frame%)-30
   top Pbar%,30
   left Pbar%,15
  
   dlist liste%
  
END_SUB

' +++ MENUS +++

Clic:
   num_clic% = number_click
return

DClic:
   num_dclic% = number_double_click
return

Change:
   num_change% = number_change
return

' +++ FONCTIONS ET PROCEDURES +++

SUB Recherche_des_articles()
   dim_local i%,a$,fic$

   caption 0,"PLM Appli - Data Créator  [ Recherche des articles ]"
   caption alph1%,"0 Articles trouvés..."

   dir_change dir_Art$
   a$=file_find_first$
   a$=file_find_next$
   while a$<>"_"
      if upper$(file_extract_extension$(a$))=".PDF"
         fic$=file_extract_name$(a$)
         if left$(fic$,3)="art"
            item_add liste%,fic$
            i%=i%+1
            caption alph1%,str$(i%)+" Articles trouvés..."
         end_if
      end_if
      a$=file_find_next$
      wait 200
   end_while
   file_find_close
   dir_change Path$
END_SUB

' ------------------------------------------------------------------------------

SUB Creation_des_fichiers()
   dim_local i%,def$,res%,defkey$,court$

   caption 0,"PLM Appli - Data Créator  [ Création de la base données ]"
   caption alph1%,"Création des fichiers "+chr$(13)+"- PLM_appli.IX"+chr$(13)+"- PLM_appli.DAT"

'  création de l' identifiant isam
   ISAM_IdentSize% = dll_call0("GetIsamIdentifierSize")
   support$ = string$(ISAM_IdentSize%," ")
   ISAM_id% = dll_call1("CreateIsamIdentifier",adr(support$))

'  vérif de l' existence de la base ou pas
   ISAM_nam$ ="PLM_appli"
   ISAM_exist% = dll_call1("IsamFileExists",adr(ISAM_nam$))

   if ISAM_exist% =0
      file_delete Path$+"Fic\PLM_appli.IX"
      file_delete Path$+"Fic\PLM_appli.DAT"
   end_if

'  création des champs
   def$ ="6,6,4,20,20,60,110"
   res% = dll_call2("SetIsamFields",Isam_ID%,adr(def$))

'  création des cles
'  par ID / numero d article
   defkey$ ="1,1,1"
   res% = dll_call2("SetIsamKeyFields",Isam_ID%,adr(defkey$))
   res% = dll_call0("GetIsamOk")
   if res%<0 : MessageErreur(res%) : end_if
'  Par Mag
   defkey$ ="2,0,2"
   res% = dll_call2("SetIsamKeyFields",Isam_ID%,adr(defkey$))
   res% = dll_call0("GetIsamOk")
   if res%<0 : MessageErreur(res%) : end_if
'  Par Sujet
   defkey$ ="3,0,3"
   res% = dll_call2("SetIsamKeyFields",Isam_ID%,adr(defkey$))
   res% = dll_call0("GetIsamOk")
   if res%<0 : MessageErreur(res%) : end_if
'  Par Auteur
   defkey$ ="4,0,4"
   res% = dll_call2("SetIsamKeyFields",Isam_ID%,adr(defkey$))
   res% = dll_call0("GetIsamOk")
   if res%<0 : MessageErreur(res%) : end_if

'  Création des fichiers ISAM
   dir_change Path$+"\Fic"
   res% = dll_call2("CreateIsamFile",Isam_ID%,adr(ISAM_nam$))
'   message str$(res%)

'  recup de la longueur d' un enregistrement
   ISAM_RecLen% = dll_call1("GetIsamRecordLength",Isam_ID%)
   ISAM_record$ = string$(ISAM_RecLen%," ")

'  recup du nombre d' enregistrements dans la base
   inbase% = dll_call1("GetIsamRecordCount",Isam_ID%)

'  recup du nombre de clés
   keyinbase% = dll_call1("GetIsamKeyCount",Isam_ID%)

END_SUB

' ------------------------------------------------------------------------------

SUB Creation_des_fiches()
   dim_local i%,a$,id$,mag$,rub$,aut$,art$,res%,url$,sf$,err%

   show Pbar%
   min Pbar%,0
   max Pbar%,count(liste%)
   position Pbar%,0
   caption 0,"PLM Appli - Data Créator  [ Création des fiches ]"

   res% = dll_call1("IsamFileIsOpen",Isam_ID%)
   if res%<0
       message "Le fichier ISAM est fermé !"
       exit_sub
   end_if

   for i% = 1 to count(liste%)
      position Pbar%,Position(Pbar%)+1
      caption alph1%,"Création de la fiche : "+str$(inbase%+1)+" / "+str$(count(liste%))
      display
      a$=item_read$(liste%,i%)
      id$=left$(a$,6)
      mag$=mid$(a$,7,4)
      rub$=mid$(a$,11,20) : remplace_caractere(rub$,"_"," ") : rub$=retour$ : rub$=trim$(rub$)
      aut$=mid$(a$,31,20) : remplace_caractere(aut$,"_"," ") : aut$=retour$ : aut$=trim$(aut$)
      art$=mid$(a$,51,60) : remplace_caractere(art$,"_"," ") : art$=retour$ : art$=trim$(art$)
      url$=a$
      ISAM_record$ = string$(ISAM_RecLen%," ")
      sf$ =" "
      res% = dll_call6("FillIsamField",Isam_ID%,1,1,adr(ISAM_Record$),adr(id$),adr(sf$))
      res% = dll_call6("FillIsamField",Isam_ID%,2,0,adr(ISAM_Record$),adr(mag$),adr(sf$))
      res% = dll_call6("FillIsamField",Isam_ID%,3,0,adr(ISAM_Record$),adr(rub$),adr(sf$))
      res% = dll_call6("FillIsamField",Isam_ID%,4,0,adr(ISAM_Record$),adr(aut$),adr(sf$))
      res% = dll_call6("FillIsamField",Isam_ID%,5,0,adr(ISAM_Record$),adr(art$),adr(sf$))
      res% = dll_call6("FillIsamField",Isam_ID%,6,0,adr(ISAM_Record$),adr(url$),adr(sf$))
      pause 100
      res% = dll_call2("AddIsamRecord",Isam_ID%,adr(ISAM_Record$))
      if res%<0
          err% = dll_call0("GetIsamError")
          message "Erreur en création "+str$(res%)+": "+str$(err%)
          exit_sub
      else
          inbase% = dll_call1("GetIsamRecordCount",Isam_ID%)
      end_if
   next i%
END_SUB

' ------------------------------------------------------------------------------

SUB Quitter()
  dim_local fin%
  fin% = dll_call1("CloseIsamFile",Isam_ID%)
  wait 100
  fin% = dll_call0("FreeIsam")
  wait 100
  fin% = dll_call1("KillProcessByHandle",handle(0))
END_SUB

' ------------------------------------------------------------------------------

SUB MessageErreur(e%)
  dim_local a$,i%
  i%=e%*-1
  select i%
  case 1 : a$="[1] La chaîne de définition es incohérente"
  case 2 : a$="[2] Le numéro de la clé est non numérique"
  case 3 : a$="[3] Le nombre de clés est invalide (<1 ou >(nombre de clés)+1))"
  case 4 : a$="[4] Le flag ''pas de doublons'' est non numérique"
  case 5 : a$="[5] Un numéro de champ est non numérique"
  case 6 : a$="[6] Un numéro de champ est invalide (<1 ou >(nombre de champ))"
  case 7 : a$="[7] Clé > 30 caractères"
  end_select
  message str$(res%)+chr$(13)+a$
END_SUB

' ------------------------------------------------------------------------------

SUB remplace_caractere(texte$,char_indesirable$,char_subsitution$)
    dim_local l% : l% = len(texte$)
    dim_local chaine$(l%),i%
    if variable ("retour$") = 0 then dim retour$
    retour$ = ""
    for i% = 1 to l%
       chaine$(i%)= mid$(texte$,i%,1)
       if chaine$(i%) = char_indesirable$  then  chaine$(i%) = char_subsitution$
    next i%
    for i% = 1 to l%
       retour$ = retour$+chaine$(i%)
    next i%
END_SUB