ISAM vs BDR database

hide 0
Variables_ISAM()
Variables_fichiers()
Variables_objets()
Variables_application()
Labels()
Init()
Gui()
show 0
end

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' DECLARATION DES VARIABLES APPLICATION
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

SUB Variables_application()

'  nombre d' enregistrements
  dim inbase%

'  mode
  dim mode%

'  Evénements
  dim clic%
  dim change%
  dim dclic%
 
END_SUB
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' VARIABLES FICHIERS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

SUB Variables_fichiers()

  dim Path$
  Path$ = dir_current$
  if right$(Path$,1) = "\" : Path$ = left$(Path$,len(Path$)-1) : end_if
  Path$ = Path$+"\"
 
  dim kgf$ : kgf$ = Path$+"fic\KGF.dll"
 
  dim ico1$: ico1$= Path$+"ico\Add.ico"
  dim ico2$: ico2$= Path$+"ico\Save.ico"
  dim ico3$: ico3$= Path$+"ico\Trash.ico"
  dim ico4$: ico4$= Path$+"ico\Previous.ico"
  dim ico5$: ico5$= Path$+"ico\Next.ico"
END_SUB
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' VARIABLES OBJETS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

SUB Variables_objets()
  dim_local i%

  dim no%
 
  dim mm%    : no% = no%+1 : mm%    = no%
  dim sm%(6)  : for i% = 0 to 6 : no% = no%+1 : sm%(i%) = no% : next i%
 
  dim frame0% : no% = no%+1 : frame0% = no%
  dim frame1% : no% = no%+1 : frame1% = no%
  dim frame2% : no% = no%+1 : frame2% = no%
  dim frame3% : no% = no%+1 : frame3% = no%
 
  dim tbedit% : no% = no%+1 : tbedit% = no%
 
  dim Class%  : no% = no%+1 : Class%  = no%
  dim Feuil1% : no% = no%+1 : Feuil1% = no%
  dim Feuil2% : no% = no%+1 : Feuil2% = no%
 
  dim Alph%(6): for i% = 1 to 6 : no% = no%+1 : alph%(i%) = no% : next i%
  dim Nom%    : no% = no%+1 : Nom%    = no%
  dim Prenom% : no% = no%+1 : Prenom% = no%
  dim Tel%    : no% = no%+1 : Tel%    = no%
  dim Port%  : no% = no%+1 : Port%  = no%
  dim Mail%  : no% = no%+1 : Mail%  = no%
 
  dim Group%
  dim Butt%(8): for i% = 1 to 8 : no% = no%+1 : Butt%(i%) = no% : next i%
 
END_SUB

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' VARIABLES DATABASE
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

SUB Variables_ISAM()
  dim support$
  dim ISAM_vers$
  dim ISAM_IdentSize%
  dim ISAM_id%
  dim ISAM_nam$
  dim ISAM_exist%
  dim ISAM_RecLen%
  dim ISAM_Record$
END_SUB

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' DECLARATION DES LABELS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

SUB Labels()
  Label Clic
  Label Change
  Label DClic
  Label VisuTab
  Label Close
END_SUB

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' INITIALISATIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

SUB Init()
  dim_local res%,def$,defkey$

'  activation de kgf
  dll_on kgf$

'  initialisation de l' environnement isam
  res% = dll_call0("InitIsam")
 
'  recup de le version isam
  ISAM_vers$ = string$(25," ")
  res% = dll_call1("GetIsamVersion",adr(ISAM_vers$))
 
'  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$ ="PhoneBook"
  ISAM_exist% = dll_call1("IsamFileExists",adr(ISAM_nam$))

  if ISAM_exist% <0
'    création des champs
      def$ ="5,30,30,10,10,255"
      res% = dll_call2("SetIsamFields",Isam_ID%,adr(def$))
'    création des cles
      defkey$ ="1,1,1"
      res% = dll_call2("SetIsamKeyFields",Isam_ID%,adr(defkey$))
      res% = dll_call0("GetIsamOk")
      if res%<0 : MessageErreur(res%) : end_if

      defkey$ ="2,0,2"
      res% = dll_call2("SetIsamKeyFields",Isam_ID%,adr(defkey$))
      res% = dll_call0("GetIsamOk")
      if res%<0 : MessageErreur(res%) : end_if

      defkey$ ="3,1,3"
      res% = dll_call2("SetIsamKeyFields",Isam_ID%,adr(defkey$))
      res% = dll_call0("GetIsamOk")
      if res%<0 : MessageErreur(res%) : end_if

      defkey$ ="4,1,4"
      res% = dll_call2("SetIsamKeyFields",Isam_ID%,adr(defkey$))
      res% = dll_call0("GetIsamOk")
      if res%<0 : MessageErreur(res%) : end_if

      res% = dll_call2("CreateIsamFile",Isam_ID%,adr(ISAM_nam$))
  else
      res% = dll_call2("OpenIsamFile",Isam_ID%,adr(ISAM_nam$))
  end_if
 
'  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%)
 
'  détermination du mode (visualisation)
  if inbase% <1
      mode% = 1
  else
      mode% = 3
  end_if
END_SUB

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' INTERFACE UTILISATEUR
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

SUB Gui()
  dim_local h%,w%,res%,hint$,icon$

  height 0,330
  width 0,440
  top 0,(screen_y-height(0))/2
  left 0,(screen_x-width(0))/2
  font_name 0,"Arial"
  font_size 0,8
  caption 0,"My Phone Book"
  on_close 0,close
 
  main_menu mm%
  sub_menu sm%(0) : parent sm%(0),mm%  : caption sm%(0),"Mode"
  sub_menu sm% (1): parent sm%(1),sm%(0) : caption sm%(1),"Enregistrement" : on_click sm%(1),clic
  sub_menu sm% (2): parent sm%(2),sm%(0) : caption sm%(2),"Modification"  : on_click sm%(2),clic
  sub_menu sm% (3): parent sm%(3),sm%(0) : caption sm%(3),"Visualisation"  : on_click sm%(3),clic
  sub_menu sm% (4): parent sm%(4),sm%(0) : caption sm%(4),"Recherche"      : on_click sm%(4),clic
  sub_menu sm% (5): parent sm%(5),sm%(0) : caption sm%(5),"-"
  sub_menu sm% (6): parent sm%(6),sm%(0) : caption sm%(6),"Quitter"        : on_click sm%(6),clic
 
  Panel frame0%
  full_space frame0%
  h% = height(frame0%)
  w% = width(frame0%)
 
  Panel frame1%
  parent frame1%,frame0%
  height frame1%,26
  width frame1%,w%
 
  Panel frame2%
  parent frame2%,frame0%
  height frame2%,h%-52
  width frame2%,w%
  top frame2%,26
 
  Panel frame3%
  parent frame3%,frame0%
  height frame3%,26
  width frame3%,w%
  top frame3%,height(frame1%)+height(frame2%)
 
  edit tbedit%
  hide tbedit%
  on_change tbedit%,change
 
  res% = dll_call4("CreateToolbar",handle(frame1%),handle(tbedit%),handle(frame2%),0)
  res% = dll_call4("ModifyToolbar",2,0,0,0)
  res% = dll_call4("ModifyToolbar",7,16,0,0)
  hint$= "Nouveau"
  icon$= ico1$
  res% = dll_call4("AddButtonToToolbar",1,0,adr(hint$),adr(icon$))
  hint$= "Enregistrer"
  icon$= ico2$
  res% = dll_call4("AddButtonToToolbar",2,1,adr(hint$),adr(icon$))
  hint$= "Supprimer"
  icon$= ico3$
  res% = dll_call4("AddButtonToToolbar",3,2,adr(hint$),adr(icon$))
  hint$= "Precedent"
  icon$= ico4$
  res% = dll_call4("AddButtonToToolbar",4,3,adr(hint$),adr(icon$))
  hint$= "Suivant"
  icon$= ico5$
  res% = dll_call4("AddButtonToToolbar",5,4,adr(hint$),adr(icon$))
 
  Group% = dll_call0("CreateObjectGroup")

  alpha alph%(1)
  parent alph%(1),frame2%
  top alph%(1),15
  left alph%(1),5
  font_bold alph%(1)
  caption alph%(1),"Nom :"
 
  edit Nom%
  parent Nom%,frame2%
  width Nom%,200
  top Nom%,30
  left Nom%,5
 
  Button Butt%(1)
  parent Butt%(1),frame2%
  height Butt%(1),20
  width Butt%(1),20
  top Butt%(1),30
  left Butt%(1),210
  font_bold Butt%(1)
  caption Butt%(1),"<"
  cursor_point Butt%(1)
  on_click Butt%(1),clic
  res% = dll_call2("AddObjectToObjectGroup",Group%,object_internal(Butt%(1)))
 
  Button Butt%(2)
  parent Butt%(2),frame2%
  height Butt%(2),20
  width Butt%(2),20
  top Butt%(2),30
  left Butt%(2),230
  font_bold Butt%(2)
  caption Butt%(2),">"
  cursor_point Butt%(2)
  on_click Butt%(2),clic
  res% = dll_call2("AddObjectToObjectGroup",Group%,object_internal(Butt%(2)))
 
  alpha alph%(2)
  parent alph%(2),frame2%
  top alph%(2),55
  left alph%(2),5
  font_bold alph%(2)
  caption alph%(2),"Prénom :"
 
  edit Prenom%
  parent Prenom%,frame2%
  width Prenom%,200
  top Prenom%,70
  left Prenom%,5
 
  Button Butt%(3)
  parent Butt%(3),frame2%
  height Butt%(3),20
  width Butt%(3),20
  top Butt%(3),70
  left Butt%(3),210
  font_bold Butt%(3)
  caption Butt%(3),"<"
  cursor_point Butt%(3)
  on_click Butt%(3),clic
  res% = dll_call2("AddObjectToObjectGroup",Group%,object_internal(Butt%(3)))

  Button Butt%(4)
  parent Butt%(4),frame2%
  height Butt%(4),20
  width Butt%(4),20
  top Butt%(4),70
  left Butt%(4),230
  font_bold Butt%(4)
  caption Butt%(4),">"
  cursor_point Butt%(4)
  on_click Butt%(4),clic
  res% = dll_call2("AddObjectToObjectGroup",Group%,object_internal(Butt%(4)))
 
  alpha alph%(3)
  parent alph%(3),frame2%
  top alph%(3),95
  left alph%(3),5
  font_bold alph%(3)
  caption alph%(3),"Tel (domicile) :"
 
  edit Tel%
  parent Tel%,frame2%
  width Tel%,85
  top Tel%,110
  left Tel%,5
 
  Button Butt%(5)
  parent Butt%(5),frame2%
  height Butt%(5),20
  width Butt%(5),20
  top Butt%(5),110
  left Butt%(5),95
  font_bold Butt%(5)
  caption Butt%(5),"<"
  cursor_point Butt%(5)
  on_click Butt%(5),clic
  res% = dll_call2("AddObjectToObjectGroup",Group%,object_internal(Butt%(5)))

  Button Butt%(6)
  parent Butt%(6),frame2%
  height Butt%(6),20
  width Butt%(6),20
  top Butt%(6),110
  left Butt%(6),115
  font_bold Butt%(6)
  caption Butt%(6),">"
  cursor_point Butt%(6)
  on_click Butt%(6),clic
  res% = dll_call2("AddObjectToObjectGroup",Group%,object_internal(Butt%(6)))

  alpha alph%(4)
  parent alph%(4),frame2%
  top alph%(4),135
  left alph%(4),5
  font_bold alph%(4)
  caption alph%(4),"Tel (portable) :"
 
  edit Port%
  parent Port%,frame2%
  width Port%,85
  top Port%,150
  left Port%,5
 
  Button Butt%(7)
  parent Butt%(7),frame2%
  height Butt%(7),20
  width Butt%(7),20
  top Butt%(7),150
  left Butt%(7),95
  font_bold Butt%(7)
  caption Butt%(7),"<"
  cursor_point Butt%(7)
  on_click Butt%(7),clic
  res% = dll_call2("AddObjectToObjectGroup",Group%,object_internal(Butt%(7)))

  Button Butt%(8)
  parent Butt%(8),frame2%
  height Butt%(8),20
  width Butt%(8),20
  top Butt%(8),150
  left Butt%(8),115
  font_bold Butt%(8)
  caption Butt%(8),">"
  cursor_point Butt%(8)
  on_click Butt%(8),clic
  res% = dll_call2("AddObjectToObjectGroup",Group%,object_internal(Butt%(8)))
 
  alpha alph%(5)
  parent alph%(5),frame2%
  top alph%(5),175
  left alph%(5),5
  font_bold alph%(5)
  caption alph%(5),"Mail :"
 
  edit Mail%
  parent Mail%,frame2%
  width Mail%,350
  top Mail%,190
  left Mail%,5
 
  alpha alph%(6)
  parent alph%(6),frame3%
  top alph%(6),5
  font_bold alph%(6)
  caption alph%(6),"Enregistrement : 0 / "+str$(inbase%)
  left alph%(6),w%-(width(alph%(6))+5)

  SelectMode(mode%)
END_SUB

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' MENUS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Clic:
  clic% = number_click

  if clic% = sm%(1) : SelectMode(1) : mode%=1 : end_if
  if clic% = sm%(2) : SelectMode(2) : mode%=2 : end_if
  if clic% = sm%(3) : SelectMode(3) : mode%=3 : end_if
  if clic% = sm%(4) : SelectMode(4) : mode%=4 : end_if
  if clic% = sm%(6) : Quitter()    : end_if
 
  if clic% = butt%(1) :PreviousRecordKey(1) : end_if
  if clic% = butt%(2) :NextRecordKey(1)    : end_if
  if clic% = butt%(3) :PreviousRecordKey(2) : end_if
  if clic% = butt%(4) :NextRecordKey(2)    : end_if
  if clic% = butt%(5) :PreviousRecordKey(3) : end_if
  if clic% = butt%(6) :NextRecordKey(3)    : end_if
  if clic% = butt%(7) :PreviousRecordKey(4) : end_if
  if clic% = butt%(8) :NextRecordKey(4)    : end_if
return

Change:
  change% = number_change
  if change% = tbedit%
      change% = val(text$(tbedit%))
      select change%
      case 1 : NewRecord()
      case 2 : SaveRecord()
      case 3 : DeleteRecord()
      case 4 : PreviousRecord()
      case 5 : NextRecord()
      end_select
      return
  end_if
return

DClic:
return

VisuTab:
return

Close:
  Quitter()
return

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' FONCTIONS ET PROCEDURES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

SUB SelectMode(m%)
  dim_local i%,res%
  for i% = 1 to 4 : mark_off sm%(i%) : next i%
  mark_on sm%(m%)
  text Nom%,""
  text Prenom%,""
  text Tel%,""
  text Port%,""
  text Mail%,""
  select m%
  case 1
      caption sm%(0),"Mode enregistrement"
      res% = dll_call4("ModifyToolbar",4,1,1,0)
      res% = dll_call4("ModifyToolbar",4,2,1,0)
      res% = dll_call4("ModifyToolbar",4,3,0,0)
      res% = dll_call4("ModifyToolbar",4,4,0,0)
      res% = dll_call4("ModifyToolbar",4,5,0,0)
      res% = dll_call3("ObjectGroupFunction",Group%,1,0)
  case 2
      caption sm%(0),"Mode modification"
      res% = dll_call4("ModifyToolbar",4,1,0,0)
      res% = dll_call4("ModifyToolbar",4,2,1,0)
      res% = dll_call4("ModifyToolbar",4,3,0,0)
      res% = dll_call4("ModifyToolbar",4,4,0,0)
      res% = dll_call4("ModifyToolbar",4,5,0,0)
      res% = dll_call3("ObjectGroupFunction",Group%,1,0)
  case 3
      caption sm%(0),"Mode visualisation"
      res% = dll_call4("ModifyToolbar",4,1,0,0)
      res% = dll_call4("ModifyToolbar",4,2,0,0)
      res% = dll_call4("ModifyToolbar",4,3,0,0)
      res% = dll_call4("ModifyToolbar",4,4,1,0)
      res% = dll_call4("ModifyToolbar",4,5,1,0)
      res% = dll_call3("ObjectGroupFunction",Group%,1,0)
  case 4
      caption sm%(0),"Mode recherche"
      res% = dll_call4("ModifyToolbar",4,1,0,0)
      res% = dll_call4("ModifyToolbar",4,2,0,0)
      res% = dll_call4("ModifyToolbar",4,3,0,0)
      res% = dll_call4("ModifyToolbar",4,4,0,0)
      res% = dll_call4("ModifyToolbar",4,5,0,0)
      res% = dll_call3("ObjectGroupFunction",Group%,1,1)
  end_select
END_SUB

SUB NewRecord()
  text Nom%,""
  text Prenom%,""
  text Tel%,""
  text Port%,""
  text Mail%,""
END_SUB

SUB SaveRecord()
  dim_local res%,rec$,rec_verif$,i%
 
  rec$ = text$(Nom%)+text$(Prenom%)+text$(Tel%)+text$(Port%)+text$(Mail%)
  rec_verif$=rec$
  if len(trim$(rec_verif$))>0
      res% = dll_call2("AddIsamRecord",Isam_ID%,adr(rec$))
  else
      i% = message_warning_ok("Enregistrement impossible !"+chr$(13)+"Enregistrement vide...")
      exit_sub
  end_if
END_SUB

SUB DeleteRecord()
END_SUB

SUB PreviousRecord()
END_SUB

SUB NextRecord()
END_SUB

SUB PreviousRecordKey(k%)
END_SUB

SUB NextRecordKey(k%)
END_SUB


SUB Quitter()
  dim_local res%
  res% = dll_call0("FreeIsam")
  res% = dll_call1("CloseIsamFile",Isam_ID%)
  res% = 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

' demo_pour_Ygerinimi.bas

dim res%
dll_on "KGF.dll"

' L'exemple suvant montre comment définir une série de fichiers ISAM
' et les créer ou ouvrir automatiquement. Les paramétrages sont réalisés
' dans le code de la procédure, sous forme de DATA commentées.
ouvrir_fichiers()
  dim xfc%, xrc%, xkc%
  xfc% = dll_call1("GetIsamFieldCount",IsamID%(1))
  xrc% = dll_call1("GetIsamRecordCount",IsamID%(1))
  xkc% = dll_call1("GetIsamKeyCount",IsamID%(1))
  message "Cheveaux: "+str$(xfc%)+" champs et "+str$(xrc%)+" enregistrements et "+str$(xkc%)+" clés"
  xfc% = dll_call1("GetIsamFieldCount",IsamID%(2))
  xrc% = dll_call1("GetIsamRecordCount",IsamID%(2))
  xkc% = dll_call1("GetIsamKeyCount",IsamID%(2))
  message "Historique_des_courses: "+str$(xfc%)+" champs et "+str$(xrc%)+" enregistrements et "+str$(xkc%)+" clés"
  xfc% = dll_call1("GetIsamFieldCount",IsamID%(3))
  xrc% = dll_call1("GetIsamRecordCount",IsamID%(3))
  xkc% = dll_call1("GetIsamKeyCount",IsamID%(3))
  message "Personnel: "+str$(xfc%)+" champs et "+str$(xrc%)+" enregistrements et "+str$(xkc%)+" clés"

' on peut faire cohabiter les fichiers ISAM avec une BDR. Voici ce qu'il
' faut pour initialiser cela.
dim BDR$ : BDR$ = "C:\Fichers\MaBase.dat" : ' chemin et nom complet du fichier BDR
' ouvrir_BDR(BDR$)

end




' quelques SUBs pour créer les nouveaux enregistrements
' créer un nouveau cheval
sub nouveau_cheval(nom$,code%,naissance$,autre$)
  dim_local cd$, rec$, lrec%, fill$
  cd$ = right$(string$(8,"0")+str$(code%),8)  : ' construire ce code justifié à droite
  lrec% = dll_call1("GetIsamRecordLength",IsamID%(1)) : ' récupérer la longueur d'enregistrement
 
  rec$ = string$(lrec%," ")                    : ' préparer un enregistrement vide
  fill$ = " "                                  : ' caractère de remplissage
  res% = dll_call6("FillIsamField",IsamID%(1),1,0,adr(rec$),adr(nom$),adr(fill$))      : ' remplir champ 1
  fill$ = "0"                                  : ' caractère de remplissage
  res% = dll_call6("FillIsamField",IsamID%(1),2,1,adr(rec$),adr(cd$),adr(fill$))        : ' remplir champ 2
  fill$ = " "                                  : ' caractère de remplissage
  res% = dll_call6("FillIsamField",IsamID%(1),3,0,adr(rec$),adr(naissance$),adr(fill$)) : ' remplir champ 3
  fill$ = " "                                  : ' caractère de remplissage
  res% = dll_call6("FillIsamField",IsamID%(1),4,0,adr(rec$),adr(autre$),adr(fill$))    : ' remplir champ 4

  res% = dll_call2("AddIsamRecord",IsamID%(1),adr(rec$)) : ' ajouter le nouvel enregistrement
  ' les clés sont générées automatiquement !
  res% = dll_call0("GetIsamError")
  if res%=10230
    message "Oups... ce code cheval existe déjà - création impossible !"
    exit_sub
  end_if

  ' ici, ajouter l'entité du cheval dans la BDR
  BDRadd("Cheval_"+cd$,"")  : ' l'entité "cheval" est créée, sans données

end_sub






' Cette sub ouvre les fichiers existants, ou les crée s'ils n'existent pas.
' Elle crée automatiquement le tableau IsamID%(..) avec autant de cellules que
' de fichiers définis. Ce tableau est rempli avec les identifiants des fichiers
' ISAM qui seront utilisés pour chaque accès à ces fichiers.
sub ouvrir_fichiers()
  label creer_fichier, ouvrir_fichier    : ' sous-programmes à usage interne !
  ' ici, créer une variable globale pour CHAQUE fichier ISAM, mais pas un tableau !
  dim IsamID%(3)          : ' faire un tableau avec un élément pour chaque fichier
  dim IsmID%              : ' pour contenir un des IsamID%(x)
  dim_local nfic%, nchamp%, ncle%, nchampcle%
  dim_local ific%, ichamp%, icle%, ichampcle%
  dim_local def$, nom$, n%
 
  ' initialiser le système ISAM
  res% = dll_call0("InitIsam")
 
  ' initialiser les variables de support pour chaque fichier ISAM:
  ' ATTENION:cette section doit être adapté au nombre réel des fichiers !
  n% = dll_call0("GetIsamIdentifierSize") : ' récupérer la taille des variables de support
  ' répéter les 4 lignes suivantes pour chaque fichier:
  dim support_chevaux$
    support_chevaux$  = "a"+string$(n%-1," ")
    res% = dll_call1("CreateIsamIdentifier",adr(support_chevaux$))
    IsamID%(1) = res%
  dim support_histo$
    support_histo$    = "b"+string$(n%-1," ")
    res% = dll_call1("CreateIsamIdentifier",adr(support_histo$))
    IsamID%(2) = res%
  dim support_personnel$
    support_personnel$ = "c"+string$(n%-1," ")
    res% = dll_call1("CreateIsamIdentifier",adr(support_personnel$))
    IsamID%(3) = res%

' on définit 3 fichiers:
'  chevaux
'    champs:
'    :  1 = nom du cheval    = 40 caractères format A...A
'      2 = code du cheval    =  8 caractères format 99999999
'      3 = date de naissance =  8 caractères format aaaammjj
'      4 = autre donnée      = 20 caractères format A...A
'      ... (4 champs, dans cet exemple)
'    clés:
'      1 = nom du cheval    = champ 1
'      2 = code du cheval    = champ 2, clé unique
'  historique_des_courses
'    champs:
'      1 = code cheval      =  8 caractères format 99999999
'      2 = nom de la course  = 40 caractères format A...A
'      3 = date de la course =  8 caractères format aaaammjj
'      4 = code jockey      =  8 caractères format 99999999
'      5 = place obtenue    =  2 caractères format 99
'      ... (5 champs, dans cet exemple)
'    clés:
'      1 = historique cheval = champs 1 suivi de 3
'      2 = chronologie      = champ 3
'      3 = historique jockey = champ 4 suivi de 3
'  personnel
'    champs:
'      1 = nom de l'employé  = 40 caractères format A...A
'      2 = prénom            = 40 caractères format A...A
'      3 = code employé      =  8 caractères format 99999999
'      4 = type employé      =  2 caractères formap 99 (jockey, lad, secrétaire, ...)
'      5 = date de naissance =  8 caractères format aaaammjj
'      ... (5 champs, dans cet exemple)
'    clés:
'      1 = par nom          = champs 1 + 2
'      2 = code employé      = champ 3, clé unique
'
' On va définir tous ces paramètres dans des DATA:
DATA 3                  : ' nombre de fichiers définis dans cet exemple
  ' pour le premier fichier:
  data "C:\Fichiers\chevaux"  : ' nom ISAM du fichier (sans extension)
    data 4                    : ' nombre des champs
      data 25,8,8,20          : ' liste des longueurs des champs
    data 2                    : ' nombre des clés
      data 1,0                : ' première clé: 1 champ, doublons non interdits
        data 1                : ' champ 1 pour la clé
      data 1,1                : ' deuxième clé: 1 champ doublons interdits
        data 2                : ' champ 2 pour la clé
  ' pour le deuxième fichier:
  data "C:\Fichiers\historique_des_courses" : ' nom ISAM du fichier (sans extension)
    data 5                    : ' nombre des champs
      data 8,40,8,8,2        : ' liste des longueurs des champs
    data 3                    : ' nombre des clés
      data 2,0                : ' première clé; 2 champs, doublons non interdits
        data 1,3              : ' champs 1 et 3 pour la clé
      data 1,0                : ' deuxième clé; 1 champ, doublons non interdits
        data 3                : ' champ 3 pour la clé
      data 2,0                : ' troixième clé; 2 champs, doublons non interdits
        data 4,3              : ' champs 4 et 3 pour la clé
  ' pour le troisième fichier:
  data "C:\Fichiers\personnel" : ' nom ISAM du fichier (sans extension)
    data 5                    : ' nombre des champs
      data 10,20,8,2,8        : ' liste des longueurs des champs
      data 2,0                : ' première clé; 2 champs, doublons non interdits
        data 1,2              : ' champs 1 et 2 pour la clé
      data 1,1                : ' deuxième clé: 1 champ doublons interdits
        data 3                : ' champ 3 pour la clé
       
  read nfic%                  : ' prendre le nombre de fichiers
  for ific%=1 to nfic%        : ' boucle pour la définition d'un fichier
    read nom$                : ' prendre le nom ISAM du fichier
    IsmID% = IsamID%(ific%)
    res% = dll_call1("IsamFileExists",adr(nom$)) : ' tester si le fichier existe
    if res%<0                : ' le fichier n'existe pas ?
      gosub creer_fichier    : ' alors le créer
    else                      : ' sinon
      gosub ouvrir_fichier    : ' l'ouvrir
    end_if
  next ific%

  exit_sub                    : ' fin de la phase d'ouverture
 
  ' sous-programme interne: créer un fichier ISAM
  creer_fichier:
    read nchamp%              : ' prendre le nom de des champs
    res% = dll_call2("CreateIsamFile",IsmID%,adr(nom$)) : ' créer un fichier vide

    def$ = str$(nchamp%)      : ' préparer le paramètre pour la création du fichier
    for ichamp%=1 to nchamp%  : ' boucle sur les champs
      read n%                : ' prendre la longueur d'un champ
      def$ = def$ + "," + str$(n%) : ' et compléter la définition
    next ichamp%              : ' fin boucle sur les champs
    res% = dll_call2("SetIsamFields",IsmID%,adr(def$)) : ' définir les champs
    read ncle%                : ' récupérer le nombre de clés pour le fichier
    for icle%=1 to ncle%      : ' boucle sur les clés
      def$ = str$(icle%)      : ' initialiser la définition de la clé
      read nchampcle%        : ' récupérer le nombre de champs pour la clé
      read n%                : ' lire l'indicateur d'unicité
      def$ = def$ + "," + str$(n%)
      for ichampcle%=1 to nchampcle% : ' boucle sur les champs de la clé*
        read n%              : ' récupérer un numéro du champ de la clé
        def$ = def$ + "," + str$(n%)
      next ichampcle%        : ' fin de boucle sur les champs de la clé
      res% = dll_call2("SetIsamKeyFields",IsmID%,adr(def$)) : ' définir la clé
      if res%<0
        message nom$+"Erreur clé "+str$(icle%)+": res%="+str$(res%)
      end_if
    next icle%                : ' fin de boucle sur les clés
    res% = dll_call2("CreateIsamFile",IsmID%,adr(nom$))
    if res%<0
      res% = dll_call0("GetIsamError")
      message "CreateIsamFile GetIsamError: "+str$(res%)
    end_if
  return
 
  ' sous-programme interne: ouvrir un fichier ISAM
  ouvrir_fichier:
    res% = dll_call2("OpenIsamFile",IsmID%,adr(nom$)) : ' ouvrir un fichier ISAM existant
    : ' maintenant, il fait dépasser les DATA inutiles pour ce fichier:
    read nchamp%              : ' prendre le nom de des champs

    for ichamp%=1 to nchamp%  : ' boucle sur les champs
      read n%                : ' prendre la longueur d'un champ
    next ichamp%              : ' fin boucle sur les champs

    read ncle%                : ' récupérer le nombre de clés pour le fichier
    for icle%=1 to ncle%      : ' boucle sur les clés
      read nchampcle%        : ' récupérer le nombre de champs pour la clé
      read n%                : ' lire l'indicateur d'unicité
      for ichampcle%=1 to nchampcle% : ' boucle sur les champs de la clé*
        read n%              : ' récupérer un numéro du champ de la clé
      next ichampcle%        : ' fin de boucle sur les champs de la clé
    next icle%
  return

end_sub


' procédure pour initialiser le système BDR et l'utiliser en même temps
' que KGF.dll. Pour cela, il faut inclure BDR_SUB.bas en fin de programme
' et accéder la BDR par les SUBs de BDR_SUB.bas et non par les appels
' directs des fonctions de BDR.dll !
sub ouvrir_BDR(fic$)
  BDRinitialize("..\BDR\BDR.dll")    : ' initialisation de l'environnement BDR
  BDRopen(fic$)              : ' ouvertire de la base fe données
end_sub

' ceci est indispensable en fin de programme pour accéder BDR et KGF simultanément !
#INCLUDE "KGF_SUB.bas"

'  détermination du mode (visualisation)
  if inbase% <1
      mode% = 1
  else
      mode% = 3
  end_if

SUB SaveRecord()
  dim_local res%,rec$,rec_verif$,i%

  rec$ = text$(Nom%)+text$(Prenom%)+text$(Tel%)+text$(Port%)+text$(Mail%)
  rec_verif$=rec$
  if len(trim$(rec_verif$))>0
      res% = dll_call2("AddIsamRecord",Isam_ID%,adr(rec$))
  else
      i% = message_warning_ok("Enregistrement impossible !"+chr$(13)+"Enregistrement vide...")
      exit_sub
  end_if
END_SUB

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

' test_ISAM.bas


label close0
label crefic, opnfic, clsfic, copfic, envers, choix
label addrec, delrec, chgnam, chgid, chgadr


dim res%, version$, no%, n%, err%, s$, sr$, sf$, inverser%, lg%, f$
dim data$, key$, nrec%, key1$, key2$

dim dll$  : dll$ = "KGF.dll"
dim FName$ : FName$ = "TestISAM"

dim Isam$, IsamID%, RecLen%

dim aNRec%, aDefSiz%, aNKeys%, aNFields%, aRecLen%, Grid%, envers%, gridlig%
dim eNom%, eID%, eAdresse%



full_space 0 : on_close 0,close0
no% = no% + 1 : button no% : top no%,40 : left no%, 20 : caption no%,"Créer fichier"  : on_click no%,crefic
no% = no% + 1 : button no% : top no%,40 : left no%,120 : caption no%,"Ouvrir fichier" : on_click no%,opnfic
no% = no% + 1 : button no% : top no%,40 : left no%,220 : caption no%,"Fermer fichier" : on_click no%,clsfic
no% = no% + 1 : button no% : top no%,70 : left no%, 20 : caption no%,"Copier fichier" : on_click no%,copfic

no% = no% + 1 : alpha no%  : top no%, 40 : left no%,400 : caption no%,"Enregistrements:"
no% = no% + 1 : alpha no%  : top no%, 10 : left no%,600 : caption no%,"Taille descripteur:"
no% = no% + 1 : alpha no%  : top no%, 40 : left no%,600 : caption no%,"Nombre de clés:"
no% = no% + 1 : alpha no%  : top no%, 70 : left no%,600 : caption no%,"Nombre de champs:"
no% = no% + 1 : alpha no%  : top no%,100 : left no%,600 : caption no%,"Longueur enregistrement:"

no% = no% + 1 : alpha no%  : top no%, 35 : left no%,500 : caption no%,"0"
  font_bold no% : font_size no%,12
  aNRec% = no%
no% = no% + 1 : alpha no%  : top no%,  5 : left no%,750 : caption no%,"0"
  font_bold no% : font_size no%,12
  aDefSiz% = no%
no% = no% + 1 : alpha no%  : top no%, 35 : left no%,750 : caption no%,"0"
  font_bold no% : font_size no%,12
  aNKeys% = no%
no% = no% + 1 : alpha no%  : top no%, 65 : left no%,750 : caption no%,"0"
  font_bold no% : font_size no%,12
  aNFields% = no%
no% = no% + 1 : alpha no%  : top no%, 95 : left no%,750 : caption no%,"0"
  font_bold no% : font_size no%,12
  aRecLen% = no%

no% = no% + 1 : check no%  : top no%,120 : left no%, 20 : caption no%,"Ordre inverse"
  envers% = no% : on_click no%,envers
no% = no% + 1 : grid no%  : top no%,150 : left no%, 20 : width no%,776 : height no%,255
  grid% = no% : on_click no%,choix
  grid_row no%,500 : grid_column no%,3 : grid_column_fixed grid%,0.01
  grid_one_column_width no%,1,200
  grid_one_column_width no%,2,50
  grid_one_column_width no%,3,500
  grid_write no%,1,1,"Nom" : grid_write no%,1,2,"ID" : grid_write no%,1,3,"Adresse"

no% = no% + 1 : alpha no%  : top no%,430 : left no%, 20 : caption no%,"Nom:"
no% = no% + 1 : alpha no%  : top no%,430 : left no%,230 : caption no%,"ID:"
no% = no% + 1 : alpha no%  : top no%,430 : left no%,280 : caption no%,"Adresse:"
no% = no% + 1 : edit no%  : top no%,460 : left no%, 20 : width no%,200
  eNom% = no%
no% = no% + 1 : edit no%  : top no%,460 : left no%,230 : width no%,40
  eID% = no%
no% = no% + 1 : edit no%  : top no%,460 : left no%,280 : width no%,500
  eAdresse% = no%

no% = no% + 1 : button no% : top no%,490 : left no%,20  : caption no%,"Ajouter"  : on_click no%,addrec
no% = no% + 1 : button no% : top no%,490 : left no%,120 : caption no%,"Supprimer"  : on_click no%,delrec
no% = no% + 1 : button no% : top no%,490 : left no%,280 : width no%,120 : caption no%,"Changer nom"  : on_click no%,chgnam
no% = no% + 1 : button no% : top no%,490 : left no%,410 : width no%,120 : caption no%,"Changer ID"  : on_click no%,chgid
no% = no% + 1 : button no% : top no%,490 : left no%,540 : width no%,120 : caption no%,"Changer adresse"  : on_click no%,chgadr

dll_on dll$

version$ = string$(25," ")
res% = dll_call1("GetIsamVersion",adr(version$))
caption 0,"Test ISAM (B-Tree) - "+version$
n% = dll_call0("GetIsamIdentifierSize")
caption aDefSiz%,str$(n%)

res% = dll_call0("InitIsam")

end

close0:
  if IsamID%<>0 then res% = dll_call1("CloseIsamFile",IsamID%)
  res% = dll_call0("FreeIsam")
  return

crefic:
  res% = dll_call0("IsamFileIsOpen")
  if res%=0
    message "Le fichier est actuellement ouvert !"
    return
  end_if
  res% = dll_call1("IsamFileExists",adr(FName$))
  if res%=0
    if message_confirmation_yes_no("Le fichier "+FName$+" existe déjà. Remplacer ?")<>1 then return
  end_if
  CreateIdentifier()
  InitContext()
  res% = dll_call0("GetIsamOk")
  if res%<0 then return

  res% = dll_call2("CreateIsamFile",IsamID%,adr(FName$))
  if res%<0
    err% = dll_call0("GetIsamError")
    if res%=-1 then message "Erreur en création de base: "+str$(err%)
    if res%=-2 then message "Erreur en réouverture de base: "+str$(err%)
    return
  end_if
  AfficherEtat()
  gridlig% = 0
  return
 
opnfic:
  res% = dll_call1("IsamFileExists",adr(FName$))
  if res%<0
    message "Le fichier "+FName$+" n'existe pas"
    return
  end_if
  res% = dll_call1("IsamFileIsOpen",IsamID%)
  if res%=0
    message "Le fichier est actuellement ouvert !"
    return
  end_if
  CreateIdentifier()
  res% = dll_call2("OpenIsamFile",IsamID%,adr(FName$))
  if res%<0
    res% = dll_call0("GetIsamError")
    message "Erreur en ouverture: "+str$(res%)
    return
  end_if
  AfficherEtat()
  AfficherTableau()
  gridlig% = 0
  return

clsfic:
  res% = dll_call1("CloseIsamFile",IsamID%)
  caption aRecLen%,"0"
  caption aNFields%,"0"
  caption aNKeys%,"0"
  caption aNRec%,"0"
  EffacerTableau()
  gridlig% = 0
  return

copfic:
  res% = dll_call1("IsamFileExists",adr(FName$))
  if res%<0
    message "Le fichier "+FName$+" n'existe pas"
    return
  end_if
  res% = dll_call0("IsamFileIsOpen")
  if res%=0
    message "Le fichier est actuellement ouvert !"
    return
  end_if
  f$ = FName$ + "_copy"
  res% = dll_call1("IsamFileExists",adr(f$))
  if res%=0
    if message_confirmation_yes_no("Le fichier "+FName$+"_copy existe déjà. Remplacer ?")<>1 then return
    file_delete FName$+"_copy.DAT"
    file_delete FName$+"_copy.IX"
  end_if
  CreateIdentifier()
  res% = dll_call2("CopyIsamFile",IsamID%,adr(FName$))
  res% = dll_call1("CloseIsamFile",IsamID%)
  message "Le fichier est recopié sous "+FName$+"_copy.DAT et "+FName$+"_copy.IX"
  return
 
envers:
  inverser% = checked(envers%)
  AfficherTableau()
  return
 
choix:
  lg% = grid_y_to_row(grid%,mouse_y_left_down(grid%))
  if trim$(grid_read$(grid%,lg%,1))="" then return
  gridlig% = lg%
  text eNom%,grid_read$(grid%,lg%,1)
  text eID%,grid_read$(grid%,lg%,2)
  text eAdresse%,grid_read$(grid%,lg%,3)
  return
 
addrec:
  res% = dll_call0("IsamFileIsOpen")
  if res%<0
    message "Le fichier n'est actuellement pas ouvert !"
    return
  end_if
  sr$ = string$(RecLen%,"*") : ' construire la chaîne de caractères représentant l'enregistrement

  s$ = trim$(text$(eNom%))
  if s$=""
    message "Le nom manque"
    return
  end_if
  sf$ = " "
  res% = dll_call6("FillIsamField",IsamID%,1,0,adr(sr$),adr(s$),adr(sf$))  : ' champ 1

  s$ = trim$(text$(eID%))
  if s$=""
    message "L'identifiant manque"
    return
  end_if
  sf$ = "²"
  res% = dll_call6("FillIsamField",IsamID%,2,1,adr(sr$),adr(s$),adr(sf$))  : ' champ 2

  s$ = trim$(text$(eAdresse%))
  sf$ = " "
  res% = dll_call6("FillIsamField",IsamID%,3,0,adr(sr$),adr(s$),adr(sf$))  : ' champ 3

  res% = dll_call2("AddIsamRecord",IsamID%,adr(sr$)) : ' ajout dans le fichier ISAM
  if res%<0
    err% = dll_call0("GetIsamError")
    message "Erreur en création "+str$(res%)+": "+str$(err%)
    return
  end_if
  res% = dll_call1("GetIsamRecordCount",IsamID%)
  caption aNRec%,str$(res%)
  AfficherTableau()
  return
 
delrec:
  res% = dll_call0("IsamFileIsOpen")
  if res%<0
    message "Le fichier n'est actuellement pas ouvert !"
    return
  end_if
  if gridlig%=0
    message "Aucune ligne n'est sélectionnée."
    return
  end_if
  data$ = string$(reclen%," ")
  key$ = right$(string$(8,"²")+trim$(grid_read$(grid%,gridlig%,2)),8)
  nrec% = dll_call4("ReadIsamRecordByKey",IsamID%,adr(data$),2,adr(key$))
  res% = dll_call0("GetIsamOk")
  if res%=0
    res% = dll_call4("CreateIsamKey",IsamID%,adr(data$),2,adr(key$))
    if message_confirmation_yes_no("Vraiment supprimer "+trim$(grid_read$(grid%,gridlig%,1))+" ?")<>1 then return
    res% = dll_call3("DeleteIsamRecord",IsamID%,adr(data$),nrec%)
    AfficherTableau()
    res% = dll_call1("GetIsamRecordCount",IsamID%)
    caption aNRec%,str$(res%)
    gridlig% = 0
  end_if
  return
 
chgnam:
  res% = dll_call0("IsamFileIsOpen")
  if res%<0
    message "Le fichier n'est actuellement pas ouvert !"
    return
  end_if
  if gridlig%=0
    message "Aucune ligne n'est sélectionnée."
    return
  end_if
  data$ = string$(reclen%," ")
  key$ = right$(string$(8,"²")+trim$(grid_read$(grid%,gridlig%,2)),8)
  nrec% = dll_call4("ReadIsamRecordByKey",IsamID%,adr(data$),2,adr(key$))
  res% = dll_call0("GetIsamOk")
  if res%=0
    key1$ = string$(20," ")
    res% = dll_call4("CreateIsamKey",IsamID%,adr(data$),1,adr(key1$))
    s$ = Trim$(text$(eNom%))
    key2$ = Left$(s$+String$(20," "),20)
    res% = dll_call5("ReplaceIsamKey",IsamID%,1,nrec%,adr(key1$),adr(key2$))
    res% = dll_call0("GetIsamOk")
    if res%=0
      sf$ = ""
      res% = dll_call6("FillIsamField",IsamID%,1,0,adr(data$),adr(key2$),adr(sf$))
      res% = dll_call3("UpdateIsamRecord",IsamID%,adr(data$),nrec%)
      grid_write grid%,gridlig%,1,trim$(key2$)
      AfficherTableau()
    else
      res% = dll_call0("GetIsamError")
      if res%=10230
        message "Mise à jour impossible - double clé"
      else
        message "Erreur en mise à jour: "+str$(res%)
      end_if
    end_if
  end_if
  return

chgid:
  res% = dll_call0("IsamFileIsOpen")
  if res%<0
    message "Le fichier n'est actuellement pas ouvert !"
    return
  end_if
  if gridlig%=0
    message "Aucune ligne n'est sélectionnée."
    return
  end_if
  data$ = string$(reclen%," ")
  key$ = right$(string$(8,"²")+trim$(grid_read$(grid%,gridlig%,2)),8)
  nrec% = dll_call4("ReadIsamRecordByKey",IsamID%,adr(data$),2,adr(key$))
  res% = dll_call0("GetIsamOk")
  if res%=0
    s$ = Trim$(text$(eID%))
    key2$ = Right$(String$(8,"²")+s$,8)
    res% = dll_call5("ReplaceIsamKey",IsamID%,2,nrec%,adr(key$),adr(key2$))
    res% = dll_call0("GetIsamOk")
    if res%=0
      sf$ = "²"
      res% = dll_call6("FillIsamField",IsamID%,2,1,adr(data$),adr(key2$),adr(sf$))
      res% = dll_call3("UpdateIsamRecord",IsamID%,adr(data$),nrec%)
      grid_write grid%,gridlig%,2,trim$(text$(eID%))
    else
      res% = dll_call0("GetIsamError")
      if res%=10230
        message "Mise à jour impossible - double clé"
      else
        message "Erreur en mise à jour: "+str$(res%)
      end_if
    end_if
  end_if


  return

chgadr:
  res% = dll_call0("IsamFileIsOpen")
  if res%<0
    message "Le fichier n'est actuellement pas ouvert !"
    return
  end_if
  if gridlig%=0
    message "Aucune ligne n'est sélectionnée."
    return
  end_if
  data$ = string$(reclen%," ")
  key$ = right$(string$(8,"²")+trim$(grid_read$(grid%,gridlig%,2)),8)
  nrec% = dll_call4("ReadIsamRecordByKey",IsamID%,adr(data$),2,adr(key$))
  res% = dll_call0("GetIsamOk")
  if res%=0
    s$ = Left$(Trim$(text$(eAdresse%))+string$(40," "),40)
    sf$ = " "
    res% = dll_call6("FillIsamField",IsamID%,3,0,adr(data$),adr(s$),adr(sf$))
    res% = dll_call3("UpdateIsamRecord",IsamID%,adr(data$),nrec%)
    res% = dll_call0("GetIsamOk")
    if res%=0
      grid_write grid%,gridlig%,3,trim$(s$)
    else
      res% = dll_call0("GetIsamError")
      message "Erreur en écriture: "+str$(res%)
    end_if
  else
    res% = dll_call0("GetIsamError")
    message "Erreur en lecture: "+str$(res%)
  end_if
  return
 
sub CreateIdentifier()
  dim_local n%, i%, def$
  n% = dll_call0("GetIsamIdentifierSize")
  Isam$ = string$(n%," ")
  IsamID% = dll_call1("CreateIsamIdentifier",adr(Isam$))
  exit_sub
 
  for i%=0 to 3
    poke adr(IsamID%)+i%,peek(adr(Isam$+i%))
  next i%
  for i%=0 to n%-1
    poke IsamID%+i%,0
  next i%
end_sub

sub InitContext()
  dim_local def$
  def$ = "3,20,8,40"
  res% = dll_call2("SetIsamFields",IsamID%,adr(def$))    : ' définir les champs
  res% = dll_call0("GetIsamOk")
  if res%<0
    res% = dll_call0("GetIsamError")
    message "Erreur en définition des champs: "+str$(err%)
  end_if
  def$ = "1,0,1"                                            : ' clé 1: champ 1
  res% = dll_call2("SetIsamKeyFields",IsamID%,adr(def$)) : ' autoriser doublons
  res% = dll_call0("GetIsamOk")
  if res%<0
    res% = dll_call0("GetIsamError")
    message "Erreur en définition de clé 1: "+str$(err%)
  end_if
  def$ = "2,1,2"                                            : '  clé 2: champ 2
  res% = dll_call2("SetIsamKeyFields",IsamID%,adr(def$)) : ' interdire doublons
  res% = dll_call0("GetIsamOk")
  if res%<0
    res% = dll_call0("GetIsamError")
    message "Erreur en définition d clé 2: "+str$(err%)
  end_if
end_sub

sub AfficherEtat()
  res% = dll_call1("GetIsamRecordLength",IsamID%)
  caption aRecLen%,str$(res%)
  RecLen% = res%
  res% = dll_call1("GetIsamFieldCount",IsamID%)
  caption aNFields%,str$(res%)
  res% = dll_call1("GetIsamKeyCount",IsamID%)
  caption aNKeys%,str$(res%)
  res% = res% - 1 - 2 : ' déduire la définition des champs et la définition des deux clés
  caption aNRec%,str$(res%)
end_sub

sub EffacerTableau()
  dim_local l%, c%
  l% = 1
  while l%<500
    l% = l% + 1
    if trim$(grid_read$(grid%,l%,1))="" then exit_while
    grid_write grid%,l%,1,""
    grid_write grid%,l%,2,""
    grid_write grid%,l%,3,""
  end_while
  text eNom%,""
  text eID%,""
  text eAdresse%,""
end_sub

sub AfficherTableau()
  dim_local r%, ref%, key$, data$, field$, fill$
  EffacerTableau()
  r% = 2
  ref% = 0
  if inverser%=1
    key$ = string$(20,chr$(255))
  else
    key$ = string$(20," ")
  end_if
  data$ = string$(RecLen%," ")
  if inverser%=1
    res% = dll_call3("ResetIsamKey",IsamID%,1,1)
  else
    res% = dll_call3("ResetIsamKey",IsamID%,1,0)
  end_if
 
  while dll_call0("GetIsamOk")=0
    if inverser%=1
      res% = dll_call4("ReadPreviousIsamRecord",IsamID%,adr(data$),1,adr(key$))
    else
      res% = dll_call4("ReadNextIsamRecord",IsamID%,adr(data$),1,adr(key$))
    end_if
    res% = dll_call0("GetIsamOk")
    if res%=0
      if Left$(Key$,1)="²"
      else
        field$ = String$(20," ")
        fill$ = " "
        res% = dll_call5("ExtractIsamField",IsamID%,1,adr(data$),adr(field$),adr(fill$))
        key$ = field$
        grid_write grid%,r%,1,trim$(field$)

        field$ = String$(8," ")
        fill$ = "²"
        res% = dll_call5("ExtractIsamField",IsamID%,2,adr(data$),adr(field$),adr(fill$))
        grid_write grid%,r%,2,trim$(field$)

        field$ = String$(40," ")
        fill$ = " "
        res% = dll_call5("ExtractIsamField",IsamID%,3,adr(data$),adr(field$),adr(fill$))
        grid_write grid%,r%,3,trim$(field$)

        r% = r% + 1
        if r%>500 then exit_while
      end_if
    else
      res% = dll_call0("GetIsamError")
      if (res%<>10250) and (res%<>10260) then message "IsamError="+s$tr(res%)
      exit_while
    end_if
  end_while
 
end_sub