KGF_dll - nouvelles versions

Une petite précision.
les champs ont une longueur fixe prédéfinie.

ex : 1 champ "nom" de 200 caractères.

lors de l' enregistrement, le texte enregistré devra être :

Code:: nom$=text$(objet_contenant_le_nom%)
nom$=trim$(nom$)
if len(nom$)<200
   nom$=nom$+string$(200-len(nom$)," ")
else
   if len(nom$)>200
   message "Texte trop long, Maxi 200 caractères"
   end_if
end_if

ou la dll s' en occupe ?

Pour un champ texte simple, c'est la DLL qui s'en occupe, dans la fonction FillIsamField. La doc de cette fonction explique cela parfaitement, et également le cas où il faudrait cadrer l'information à droite, comme dans le cas d'un champ servant de clé d'accès et contenant une valeur numérique.

Il y a encore quelques anomalies dans la doc - je suis en train de consolider cela. Mais c'est déjà assez clair.

Il y a quelques corrections dans la doc, et une correction de bug dans la DLL. Il vaut mieux recharger les deux...

Voici une petite application avec un fichier ISAM. Le programme va télécharger automatiquement un fichier CSV avec une liste des communes de France, le convertir en un fichier TXT réduit avec 3 champs:
- un nom simplifié limitéà 30 caractères (clé1)
- le code postal sur 5 caractères (clé 2)
- un champ de 80 caractères donnant un nom plus clair, mais sans être une clé
A partir de ce fichier, le programme crée automatiquement un fichier ISAM, puis affiche une fenêtre de saisie très simple:
une ligne pour le code postal, avec libellé, un champ de saisie, 3 boutons de recherche (par clé, précédent, suivant)
une ligne pour le nom, avec libellé, un champ de saisie, 3 boutons de recherche (par clé, précédent, suivant)

Bon, je sais, ce fichier n'est pas réellement à jour. Peu importe, d'ailleurs. C'est suffisant pour montrer le principe. Il charge d'ailleurs plus de 33.000 enregistrements dans le fichier ISAM ! Et il montre accessoirement un autre élément intéressant. Car le fichier téléchargé est un UTF8, alors que Panoramic a besoin du codage ANSI. J'ai donc intégré une procédure UTF8toANSI dans le programme. Cette procédure peut être extraite et utilisée séparément, sans problème.

Mais voici le code:

Code:: ' villes.bas
'
' Fichier ISAM: Villes
' Enregistrement:
' 1 - cle: A30
' 2 - cpo: A5
' 3 - nom: A80
' Clés:
' 1 = champ 1
' 2 = champ 2

label close0

dim err%, res%, s$
dim idsize%, Isam$, IsamID%, FName$, reclen%, rec$, cle$
dim cpo$, nom$, cre%, cpo1$, nom1$, cle1$, url$, champ_codpost%, champ_ville%

' =============== paramètres configurables
' URL pour télécharger les données
url$ = "http://www.blog.manit4c.com/wp-content/uploads/2011/09/liste_villes.csv"
' exemple d'une ligne de ce fichier:
' "567";"La Chapelle-sur-Chézy";"LA CHAPELLE SUR CHEZY";"02570";"2162";"22";"48.95";"3.383333";"2.46"
champ_codpost% = 4 : ' le 4ème champ est le code postal
champ_ville% = 2 : ' le 2ème champ est le nom de ville en clair
FName$ = "Villes" : ' chemin et nom du fichier ISAM, sans l'extension
' =============== fin des paramètres configurables

dll_on "KGF.dll"
on_close 0,close0
picture 1 : top 1,20 : left 1,20 : width 1,400 : height 1,120

CreerFichier()
InitIsam()
ChargerFichier()
GUI()

end

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

cpo:
ChercherCpo()
return

nom:
ChercherNom()
return

prvcpo:
ChercherCpoPrecedent()
return

prvnom:
ChercherNomPrecedent()
return

nxtcpo:
ChercherCpoSuivant()
return

nxtnom:
ChercherNomSuivant()
return

sub ChercherCpo()
dim_local n%, fill$
cpo$ = trim$(text$(11))
if cpo$<>""
if numeric(cpo$)=1
n% = val(cpo$)
if n%<99999
cpo$ = right$("00000"+str$(n%),5)
n% = dll_call4("ReadIsamRecordByKey",IsamID%,adr(rec$),2,adr(cpo$))
res% = dll_call0("GetIsamError")
if res%=0
cle1$ = string$(30," ")
fill$ = " "
res% = dll_call5("ExtractIsamField",IsamID%,1,adr(rec$),adr(cle1$),adr(fill$))
text 12,trim$(cle1$)
nom$ = string$(80," ")
fill$ = " "
res% = dll_call5("ExtractIsamField",IsamID%,3,adr(rec$),adr(nom$),adr(fill$))
text 13,trim$(nom$)
else
message "Code postal non trouvé"
end_if
exit_sub
end_if
end_if
end_if
message "Recherche impossible"
end_sub

sub ChercherNom()
dim_local n%, fill$
cle$ = trim$(text$(12))
if cle$<>""
cle$ = left$(cle$+string$(30," "),30)
n% = dll_call4("ReadIsamRecordByKey",IsamID%,adr(rec$),1,adr(cle$))
res% = dll_call0("GetIsamError")
if res%=0
cle1$ = string$(30," ")
fill$ = " "
res% = dll_call5("ExtractIsamField",IsamID%,1,adr(rec$),adr(cle1$),adr(fill$))
text 12,trim$(cle1$)
cpo$ = string$(5," ")
fill$ = " "
res% = dll_call5("ExtractIsamField",IsamID%,2,adr(rec$),adr(cpo$),adr(fill$))
text 11,trim$(cpo$)
nom$ = string$(80," ")
fill$ = " "
res% = dll_call5("ExtractIsamField",IsamID%,3,adr(rec$),adr(nom$),adr(fill$))
text 13,trim$(nom$)
else
message "nom non trouvé"
end_if
exit_sub
end_if
message "Recherche impossible"
end_sub

sub ChercherCpoPrecedent()
dim_local fill$
cpo1$ = string$(5," ")
res% = dll_call4("ReadPreviousIsamRecord",IsamID%,adr(rec$),2,adr(cpo1$))
res% = dll_call0("GetIsamError")
if res%=0
fill$ = " "
res% = dll_call5("ExtractIsamField",IsamID%,2,adr(rec$),adr(cpo1$),adr(fill$))
if cpo1$<>cpo$
message "Fini"
exit_sub
end_if
cle$ = string$(30," ")
res% = dll_call5("ExtractIsamField",IsamID%,1,adr(rec$),adr(cle$),adr(fill$))
text 12,trim$(cle$)
nom$ = string$(80," ")
res% = dll_call5("ExtractIsamField",IsamID%,3,adr(rec$),adr(nom$),adr(fill$))
text 13,trim$(nom$)
else
message "Code postal non trouvé"
end_if
end_sub

sub ChercherNomPrecedent()
dim_local fill$
nom1$ = string$(80," ")
res% = dll_call4("ReadPreviousIsamRecord",IsamID%,adr(rec$),1,adr(nom1$))
res% = dll_call0("GetIsamError")
if res%=0
fill$ = " "
res% = dll_call5("ExtractIsamField",IsamID%,1,adr(rec$),adr(nom1$),adr(fill$))
' if trim$(nom1$)<>trim$(nom$)
' message "Fini"
' exit_sub
' end_if
cle1$ = string$(30," ")
res% = dll_call5("ExtractIsamField",IsamID%,1,adr(rec$),adr(cle1$),adr(fill$))
cpo$ = string$(5," ")
res% = dll_call5("ExtractIsamField",IsamID%,2,adr(rec$),adr(cpo$),adr(fill$))
nom$ = string$(80," ")
res% = dll_call5("ExtractIsamField",IsamID%,3,adr(rec$),adr(nom$),adr(fill$))
text 11,trim$(cpo$)
text 12,trim$(cle1$)
text 13,trim$(nom$)
else
message "Nom non trouvé"
end_if
end_sub

sub ChercherCpoSuivant()
dim_local fill$
cpo1$ = string$(5," ")
res% = dll_call4("ReadNextIsamRecord",IsamID%,adr(rec$),2,adr(cpo1$))
res% = dll_call0("GetIsamError")
if res%=0
fill$ = " "
res% = dll_call5("ExtractIsamField",IsamID%,2,adr(rec$),adr(cpo1$),adr(fill$))
if cpo1$<>cpo$
message "Fini"
exit_sub
end_if
cle$ = string$(30," ")
res% = dll_call5("ExtractIsamField",IsamID%,1,adr(rec$),adr(cle$),adr(fill$))
text 12,trim$(cle$)
nom$ = string$(80," ")
res% = dll_call5("ExtractIsamField",IsamID%,3,adr(rec$),adr(nom$),adr(fill$))
text 13,trim$(nom$)
else
message "Code postal non trouvé"
end_if
end_sub

sub ChercherNomSuivant()
dim_local fill$
nom1$ = string$(80," ")
res% = dll_call4("ReadNextIsamRecord",IsamID%,adr(rec$),1,adr(nom1$))
res% = dll_call0("GetIsamError")
if res%=0
fill$ = " "
res% = dll_call5("ExtractIsamField",IsamID%,1,adr(rec$),adr(nom1$),adr(fill$))
' if trim$(nom1$)<>trim$(nom$)
' message "Fini"
' exit_sub
' end_if
cle1$ = string$(30," ")
res% = dll_call5("ExtractIsamField",IsamID%,1,adr(rec$),adr(cle1$),adr(fill$))
cpo$ = string$(5," ")
res% = dll_call5("ExtractIsamField",IsamID%,2,adr(rec$),adr(cpo$),adr(fill$))
nom$ = string$(80," ")
res% = dll_call5("ExtractIsamField",IsamID%,3,adr(rec$),adr(nom$),adr(fill$))
text 11,trim$(cpo$)
text 12,trim$(cle1$)
text 13,trim$(nom$)
else
message "Nom non trouvé"
end_if
end_sub

sub GUI()
label cpo, nom, nxtcpo, nxtnom, prvcpo, prvnom

width 0,800 : height 0,200

alpha 1 : top 1,10 : left 1,10 : caption 1,"Code postal:"
alpha 2 : top 2,40 : left 2,10 : caption 2,"Nom:"
alpha 3 : top 3,70 : left 3,10 : caption 3,"Ville:"

edit 11 : top 11,10 : left 11,100
edit 12 : top 12,40 : left 12,100 : width 12,300
edit 13 : top 13,70 : left 13,100 : width 13,300

button 21 : top 21,10 : left 21,420 : caption 21,"Chercher" : on_click 21,cpo
button 22 : top 22,40 : left 22,420 : caption 22,"Chercher" : on_click 22,nom

button 31 : top 31,10 : left 31,520 : caption 31,"<<<" : on_click 31,prvcpo
button 32 : top 32,40 : left 32,520 : caption 32,"<<<" : on_click 32,prvnom

button 41 : top 41,10 : left 41,620 : caption 41,">>>" : on_click 41,nxtcpo
button 42 : top 42,40 : left 42,620 : caption 42,">>>" : on_click 42,nxtnom
end_sub

sub chargerFichier()
dim_local i%, s$, sep$, key$, fill$, IsamError%, upd%
sep$ = ","
rec$ = string$(reclen%," ")
if cre%=0
if message_confirmation_yes_no("Faut-il vérifier le fichier ISAM ?")<>1
print_target_is 0
delete 1
exit_sub
end_if
end_if
print_locate 20,80
print "Contrôle du fichier ISAM en cours..."
file_open_read 1,"villes_Klaus.txt"
fill$ = " "
while file_eof(1)=0
file_readln 1,s$
UTF8toANSI(s$)
s$ = ansi$
cle$ = string$(30," ")
cpo$ = string$(5," ")
nom$ = string$(80," ")

i% = i% + 1
res% = dll_call4("KGFDelimitedTextExtract",adr(s$),adr(sep$),1,adr(cle$))
res% = dll_call4("KGFDelimitedTextExtract",adr(s$),adr(sep$),2,adr(cpo$))
res% = dll_call4("KGFDelimitedTextExtract",adr(s$),adr(sep$),3,adr(nom$))
print_locate 20,100
print str$(i%)

key$ = cle$ + "*"
key$ = left$(key$,30)
res% = dll_call4("ReadIsamRecordByKey",IsamID%,adr(rec$),1,adr(key$))
IsamError% = dll_call0("GetIsamError")
if IsamError%=10200
if upd%=0
print_locate 20,80
print "Chargement du fichier ISAM en cours..."
upd% = 1
end_if
res% = dll_call6("FillIsamField",IsamID%,1,0,adr(rec$),adr(cle$),adr(fill$))
res% = dll_call6("FillIsamField",IsamID%,2,0,adr(rec$),adr(cpo$),adr(fill$))
res% = dll_call6("FillIsamField",IsamID%,3,0,adr(rec$),adr(nom$),adr(fill$))
res% = dll_call2("AddIsamRecord",IsamID%,adr(rec$))
end_if

' if i%>100 then exit_while
end_while
file_close 1
res% = dll_call0("GetIsamRecordCount")
message "prêt - nombre d'enregistrements: "+str$(res%)
print_target_is 0
delete 1
end_sub

sub InitIsam()
dim_local def$
idsize% = dll_call0("GetIsamIdentifierSize")
res% = dll_call0("InitIsam")
Isam$ = string$(idsize%," ")
IsamID% = dll_call1("CreateIsamIdentifier",adr(Isam$))
if dll_call1("IsamFileExists",adr(Fname$))<0

def$ = "3,30,5,80"
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%)
exit_sub
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%)
exit_sub
end_if

def$ = "2,0,2" : ' clé 2: champ 2
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é 2: "+str$(err%)
exit_sub
end_if

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%)
exit_sub
end_if

cre% = 1
else
res% = dll_call2("OpenIsamFile",IsamID%,adr(FName$))
if res%<0
res% = dll_call0("GetIsamError")
message "Erreur en ouverture: "+str$(res%)
exit_sub
end_if
end_if
reclen% = dll_call0("GetIsamRecordLength")
end_sub

sub CreerFichier()
dim_local s$, i%, res%, sep$, ville$, codpost$, k%, s1$, s2$, p%, cle$, fic$
sep$ = ";"
fic$ = "liste_villes.csv"

if file_exists("villes_Klaus.txt")=1 then exit_sub

print_target_is 1
print_locate 20,20
if file_exists(fic$)=0
print "Téléchargement du fichier CSV en cours..."
display
res% = DLL_call2("DownloadFile",adr(url$),adr(fic$))
end_if
file_open_read 1,fic$
file_readln 1,s$
file_open_write 2,"villes_Klaus.txt"

print_locate 20,40
print "Création du fichier TXT en cours..."
display
k% = 0
while file_eof(1)=0
file_readln 1,s$
i% = instr(s$," ")
while i%>0
s$ = left$(s$,i%-1)+"_"+mid$(s$,i%+1,len(s$))
i% = instr(s$," ")
end_while
k% = k% + 1
ville$ = string$(80," ")
codpost$ = string$(80," ")
res% = dll_call4("KGFDelimitedTextExtract",adr(s$),adr(sep$),champ_ville%,adr(ville$))
res% = dll_call4("KGFDelimitedTextExtract",adr(s$),adr(sep$),champ_codpost%,adr(codpost$))
ville$ = trim$(ville$)
cle$ = trim$(Left$(ville$,30))
if left$(cle$,2)="L'" then cle$ = Mid$(cle$,3,len(cle$)) + "(L')"
if left$(cle$,2)="D'" then cle$ = Mid$(cle$,3,len(cle$)) + "(D')"
if left$(cle$,3)="La " then cle$ = Mid$(cle$,4,len(cle$)) + "(La)"
if left$(cle$,3)="Le " then cle$ = Mid$(cle$,4,len(cle$)) + "(Le)"
if left$(cle$,4)="Les " then cle$ = Mid$(cle$,5,len(cle$)) + "(Les)"
file_writeln 2,cle$+","+trim$(codpost$)+","+ville$
print_locate 20,60
print str$(k%)
end_while
file_close 1
file_close 2
end_sub

' procédure de convertion d'une chaîne de caractères de UTF8 en ANSI
' entrée: paramère utf8$
' sortie: variable globale ansi$ créée automatiquement si inexistante
sub UTF8toANSI(utf8$)
dim_local i%,c%, ca$
if variable("ansi$")=0 then dim ansi$
ansi$ = ""
while i%<len(utf8$)
i% = i% + 1
c% = asc(mid$(utf8$,i%,1))
if c%=195 : ' hex C3
i% = i% + 1
c% = asc(mid$(utf8$,i%,1))
ca$ = "?"
select c%
case 162
ca$ = "â"
case 160
ca$ = "à"
case 169
ca$ = "é"
case 170
ca$ = "ê"
case 168
ca$ = "è"
case 171
ca$ = "ë"
case 175
ca$ = "ï"
case 174
ca$ = "î"
case 180
ca$ = "ô"
case 187
ca$ = "û"
case 185
ca$ = "ù"
case 167
ca$ = "ç"
end_select
ansi$ = ansi$ + ca$
else
ansi$ = ansi$ + chr$(c%)
end_if
end_while
end_sub

C'est une belle démonstration des capacités et performances des fichiers ISAM. Rapidité d'accès en accès direct par clé, lecture séquentielle en avant ou en arrière selon n'importe quelle clé - ce sont quelques-uns des points forts de ce système !

EDIT
j'ai modifié légèrement le code pour rendre paramétrable l'URL de téléchargement, les numéros des champs pour le nom de ville et le code postal, ainsi que le chemin et nom du fichier ISAM. J'ai mis un petit commentaire également sur la SUB UTF8toANSI, en fin du code. Utilisez-la sur les fichiers texte téléchargés dont les caractères accentués posent problème...

Petite supplique... Laughing

Lorsque tu fais une modif dans la dll,
pourrais tu changer la date si la version ne change pas.
Les "updater" ne fonctionnent plus si rien ne change dans la version. Laughing

Nouvelle version:
KGF.dll V4.85 du 19/07/2015

Nouveautés:
- correction d'un bug dans CreateIsamFile

Modules modifiés:
KGF.dll

La doc et l'aide en ligne sont à jour. Les sources sont à jour également.

Voilà, Ygeronimi, c'est fait. La mise à jour automatique marchera...

Ok, merci Klaus !
cheers

Nouvelle version:
KGF.dll V4.86 du 21/07/2015

Nouveautés:
- nouvelles fonctions GetIsamFields et GetIsamKeyFields

Modules modifiés:
KGF.dll
KGF.chm

La doc et l'aide en ligne sont à jour. Les sources sont à jour également.

Il y avait déjà des fonctions pour récupérer la longueur d'enregistrements, le nombre de champs, le nombre de clés et le nombre de champs dans une clé donnée. On peut maintenant aussi récupérer, pour un fichier ouvert, la chaîne de caractères de définition des champs d'un enregistrement, ainsi que celle des champs d'une clé d'un enregistrement.

Ainsi, on peut ouvrir un fichier ISAM sans connaître sa structure, récupérer l'ensemble des informations pour recréer un autre fichier avec la même structure. On peut également utiliser cela pour créer une copie modifiée d'un fichier ISAM en ajoutant ou insérant un champ, puis relire l'ancien fichier, formater le nouvel enregistrement et l'ajouter dans le nouveau fichier.

Nouvelle version:
KGF.dll V4.87 du 26/07/2015

Nouveautés:
- les fonctions suivantes reçoivent l'identifiant ISAM en paramètre:
GetIsamRecordLength, GetIsamRecordCount, GetIsamFieldCount,
GetIsamKeyCount, GetIsamKeyFieldCount, IsamFileIsOpen

Modules modifiés:
KGF.dll
KGF.chm

La doc et l'aide en ligne sont à jour. Les sources sont à jour également.

Voici le programme de démo adapté à cette version:

Code:: ' villes.bas
'
' Fichier ISAM: Villes
' Enregistrement:
' 1 - cle: A30
' 2 - cpo: A5
' 3 - nom: A80
' Clés:
' 1 = champ 1
' 2 = champ 2

label close0

dim err%, res%, s$
dim idsize%, Isam$, IsamID%, FName$, reclen%, rec$, cle$
dim cpo$, nom$, cre%, cpo1$, nom1$, cle1$, url$, champ_codpost%, champ_ville%

' =============== paramètres configurables
' URL pour télécharger les données
url$ = "http://www.blog.manit4c.com/wp-content/uploads/2011/09/liste_villes.csv"
' exemple d'une ligne de ce fichier:
' "567";"La Chapelle-sur-Chézy";"LA CHAPELLE SUR CHEZY";"02570";"2162";"22";"48.95";"3.383333";"2.46"
champ_codpost% = 4 : ' le 4ème champ est le code postal
champ_ville% = 2 : ' le 2ème champ est le nom de ville en clair
FName$ = "Villes" : ' chemin et nom du fichier ISAM, sans l'extension
' =============== fin des paramètres configurables

dll_on "KGF.dll"
on_close 0,close0
picture 1 : top 1,20 : left 1,20 : width 1,400 : height 1,120

CreerFichier()
InitIsam()
ChargerFichier()
GUI()

end

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

cpo:
  ChercherCpo()
  return

nom:
  ChercherNom()
  return

prvcpo:
  ChercherCpoPrecedent()
  return

prvnom:
  ChercherNomPrecedent()
  return

nxtcpo:
  ChercherCpoSuivant()
  return

nxtnom:
  ChercherNomSuivant()
  return

sub ChercherCpo()
  dim_local n%, fill$
  cpo$ = trim$(text$(11))
  if cpo$<>""
   if numeric(cpo$)=1
   n% = val(cpo$)
   if n%<99999
   cpo$ = right$("00000"+str$(n%),5)
   n% = dll_call4("ReadIsamRecordByKey",IsamID%,adr(rec$),2,adr(cpo$))
   res% = dll_call0("GetIsamError")
   if res%=0
   cle1$ = string$(30," ")
   fill$ = " "
   res% = dll_call5("ExtractIsamField",IsamID%,1,adr(rec$),adr(cle1$),adr(fill$))
   text 12,trim$(cle1$)
   nom$ = string$(80," ")
   fill$ = " "
   res% = dll_call5("ExtractIsamField",IsamID%,3,adr(rec$),adr(nom$),adr(fill$))
   text 13,trim$(nom$)
   else
   message "Code postal non trouvé"
   end_if
   exit_sub
   end_if
   end_if
  end_if
  message "Recherche impossible"
end_sub

sub ChercherNom()
  dim_local n%, fill$
  cle$ = trim$(text$(12))
  if cle$<>""
   cle$ = left$(cle$+string$(30," "),30)
   n% = dll_call4("ReadIsamRecordByKey",IsamID%,adr(rec$),1,adr(cle$))
   res% = dll_call0("GetIsamError")
   if res%=0
   cle1$ = string$(30," ")
   fill$ = " "
   res% = dll_call5("ExtractIsamField",IsamID%,1,adr(rec$),adr(cle1$),adr(fill$))
   text 12,trim$(cle1$)
   cpo$ = string$(5," ")
   fill$ = " "
   res% = dll_call5("ExtractIsamField",IsamID%,2,adr(rec$),adr(cpo$),adr(fill$))
   text 11,trim$(cpo$)
   nom$ = string$(80," ")
   fill$ = " "
   res% = dll_call5("ExtractIsamField",IsamID%,3,adr(rec$),adr(nom$),adr(fill$))
   text 13,trim$(nom$)
   else
   message "nom non trouvé"
   end_if
   exit_sub
  end_if
  message "Recherche impossible"
end_sub

sub ChercherCpoPrecedent()
  dim_local fill$
  cpo1$ = string$(5," ")
  res% = dll_call4("ReadPreviousIsamRecord",IsamID%,adr(rec$),2,adr(cpo1$))
  res% = dll_call0("GetIsamError")
  if res%=0
   fill$ = " "
   res% = dll_call5("ExtractIsamField",IsamID%,2,adr(rec$),adr(cpo1$),adr(fill$))
   if cpo1$<>cpo$
   message "Fini"
   exit_sub
   end_if
   cle$ = string$(30," ")
   res% = dll_call5("ExtractIsamField",IsamID%,1,adr(rec$),adr(cle$),adr(fill$))
   text 12,trim$(cle$)
   nom$ = string$(80," ")
   res% = dll_call5("ExtractIsamField",IsamID%,3,adr(rec$),adr(nom$),adr(fill$))
   text 13,trim$(nom$)
  else
   message "Code postal non trouvé"
  end_if
end_sub

sub ChercherNomPrecedent()
  dim_local fill$
  nom1$ = string$(80," ")
  res% = dll_call4("ReadPreviousIsamRecord",IsamID%,adr(rec$),1,adr(nom1$))
  res% = dll_call0("GetIsamError")
  if res%=0
   fill$ = " "
   res% = dll_call5("ExtractIsamField",IsamID%,1,adr(rec$),adr(nom1$),adr(fill$))
' if trim$(nom1$)<>trim$(nom$)
' message "Fini"
' exit_sub
' end_if
   cle1$ = string$(30," ")
   res% = dll_call5("ExtractIsamField",IsamID%,1,adr(rec$),adr(cle1$),adr(fill$))
   cpo$ = string$(5," ")
   res% = dll_call5("ExtractIsamField",IsamID%,2,adr(rec$),adr(cpo$),adr(fill$))
   nom$ = string$(80," ")
   res% = dll_call5("ExtractIsamField",IsamID%,3,adr(rec$),adr(nom$),adr(fill$))
   text 11,trim$(cpo$)
   text 12,trim$(cle1$)
   text 13,trim$(nom$)
  else
   message "Nom non trouvé"
  end_if
end_sub

sub ChercherCpoSuivant()
  dim_local fill$
  cpo1$ = string$(5," ")
  res% = dll_call4("ReadNextIsamRecord",IsamID%,adr(rec$),2,adr(cpo1$))
  res% = dll_call0("GetIsamError")
  if res%=0
   fill$ = " "
   res% = dll_call5("ExtractIsamField",IsamID%,2,adr(rec$),adr(cpo1$),adr(fill$))
   if cpo1$<>cpo$
   message "Fini"
   exit_sub
   end_if
   cle$ = string$(30," ")
   res% = dll_call5("ExtractIsamField",IsamID%,1,adr(rec$),adr(cle$),adr(fill$))
   text 12,trim$(cle$)
   nom$ = string$(80," ")
   res% = dll_call5("ExtractIsamField",IsamID%,3,adr(rec$),adr(nom$),adr(fill$))
   text 13,trim$(nom$)
  else
   message "Code postal non trouvé"
  end_if
end_sub

sub ChercherNomSuivant()
  dim_local fill$
  nom1$ = string$(80," ")
  res% = dll_call4("ReadNextIsamRecord",IsamID%,adr(rec$),1,adr(nom1$))
  res% = dll_call0("GetIsamError")
  if res%=0
   fill$ = " "
   res% = dll_call5("ExtractIsamField",IsamID%,1,adr(rec$),adr(nom1$),adr(fill$))
' if trim$(nom1$)<>trim$(nom$)
' message "Fini"
' exit_sub
' end_if
   cle1$ = string$(30," ")
   res% = dll_call5("ExtractIsamField",IsamID%,1,adr(rec$),adr(cle1$),adr(fill$))
   cpo$ = string$(5," ")
   res% = dll_call5("ExtractIsamField",IsamID%,2,adr(rec$),adr(cpo$),adr(fill$))
   nom$ = string$(80," ")
   res% = dll_call5("ExtractIsamField",IsamID%,3,adr(rec$),adr(nom$),adr(fill$))
   text 11,trim$(cpo$)
   text 12,trim$(cle1$)
   text 13,trim$(nom$)
  else
   message "Nom non trouvé"
  end_if
end_sub

sub GUI()
  label cpo, nom, nxtcpo, nxtnom, prvcpo, prvnom

  width 0,800 : height 0,200

  alpha 1 : top 1,10 : left 1,10 : caption 1,"Code postal:"
  alpha 2 : top 2,40 : left 2,10 : caption 2,"Nom:"
  alpha 3 : top 3,70 : left 3,10 : caption 3,"Ville:"

  edit 11 : top 11,10 : left 11,100
  edit 12 : top 12,40 : left 12,100 : width 12,300
  edit 13 : top 13,70 : left 13,100 : width 13,300

  button 21 : top 21,10 : left 21,420 : caption 21,"Chercher" : on_click 21,cpo
  button 22 : top 22,40 : left 22,420 : caption 22,"Chercher" : on_click 22,nom

  button 31 : top 31,10 : left 31,520 : caption 31,"<<<" : on_click 31,prvcpo
  button 32 : top 32,40 : left 32,520 : caption 32,"<<<" : on_click 32,prvnom

  button 41 : top 41,10 : left 41,620 : caption 41,">>>" : on_click 41,nxtcpo
  button 42 : top 42,40 : left 42,620 : caption 42,">>>" : on_click 42,nxtnom
end_sub

sub chargerFichier()
  dim_local i%, s$, sep$, key$, fill$, IsamError%, upd%
  sep$ = ","
  rec$ = string$(reclen%," ")
  if cre%=0
   if message_confirmation_yes_no("Faut-il vérifier le fichier ISAM ?")<>1
   print_target_is 0
   delete 1
   exit_sub
   end_if
  end_if
  print_locate 20,80
  print "Contrôle du fichier ISAM en cours..."
  file_open_read 1,"villes_Klaus.txt"
  fill$ = " "
  while file_eof(1)=0
   file_readln 1,s$
   UTF8toANSI(s$)
   s$ = ansi$
   cle$ = string$(30," ")
   cpo$ = string$(5," ")
   nom$ = string$(80," ")

   i% = i% + 1
   res% = dll_call4("KGFDelimitedTextExtract",adr(s$),adr(sep$),1,adr(cle$))
   res% = dll_call4("KGFDelimitedTextExtract",adr(s$),adr(sep$),2,adr(cpo$))
   res% = dll_call4("KGFDelimitedTextExtract",adr(s$),adr(sep$),3,adr(nom$))
   print_locate 20,100
   print str$(i%)

   key$ = cle$ + "*"
   key$ = left$(key$,30)
   res% = dll_call4("ReadIsamRecordByKey",IsamID%,adr(rec$),1,adr(key$))
   IsamError% = dll_call0("GetIsamError")
   if IsamError%=10200
   if upd%=0
   print_locate 20,80
   print "Chargement du fichier ISAM en cours..."
   upd% = 1
   end_if
   res% = dll_call6("FillIsamField",IsamID%,1,0,adr(rec$),adr(cle$),adr(fill$))
   res% = dll_call6("FillIsamField",IsamID%,2,0,adr(rec$),adr(cpo$),adr(fill$))
   res% = dll_call6("FillIsamField",IsamID%,3,0,adr(rec$),adr(nom$),adr(fill$))
   res% = dll_call2("AddIsamRecord",IsamID%,adr(rec$))
   end_if

' if i%>100 then exit_while
  end_while
  file_close 1
  res% = dll_call1("GetIsamRecordCount,IsamID%")
  message "prêt - nombre d'enregistrements: "+str$(res%)
  print_target_is 0
  delete 1
end_sub

sub InitIsam()
  dim_local def$
  idsize% = dll_call0("GetIsamIdentifierSize")
  res% = dll_call0("InitIsam")
  Isam$ = string$(idsize%," ")
  IsamID% = dll_call1("CreateIsamIdentifier",adr(Isam$))
  if dll_call1("IsamFileExists",adr(Fname$))<0

   def$ = "3,30,5,80"
   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%)
   exit_sub
   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%)
   exit_sub
   end_if

   def$ = "2,0,2" : ' clé 2: champ 2
   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é 2: "+str$(err%)
   exit_sub
   end_if

   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%)
   exit_sub
   end_if

   cre% = 1
  else
   res% = dll_call2("OpenIsamFile",IsamID%,adr(FName$))
   if res%<0
   res% = dll_call0("GetIsamError")
   message "Erreur en ouverture: "+str$(res%)
   exit_sub
   end_if
  end_if
  reclen% = dll_call1("GetIsamRecordLength",IsamID%)
end_sub

sub CreerFichier()
  dim_local s$, i%, res%, sep$, ville$, codpost$, k%, s1$, s2$, p%, cle$, fic$
  sep$ = ";"
  fic$ = "liste_villes.csv"

  if file_exists("villes_Klaus.txt")=1 then exit_sub

  print_target_is 1
  print_locate 20,20
  if file_exists(fic$)=0
   print "Téléchargement du fichier CSV en cours..."
   display
   res% = DLL_call2("DownloadFile",adr(url$),adr(fic$))
  end_if
  file_open_read 1,fic$
  file_readln 1,s$
  file_open_write 2,"villes_Klaus.txt"

  print_locate 20,40
  print "Création du fichier TXT en cours..."
  display
  k% = 0
  while file_eof(1)=0
   file_readln 1,s$
   i% = instr(s$," ")
   while i%>0
   s$ = left$(s$,i%-1)+"_"+mid$(s$,i%+1,len(s$))
   i% = instr(s$," ")
   end_while
   k% = k% + 1
   ville$ = string$(80," ")
   codpost$ = string$(80," ")
   res% = dll_call4("KGFDelimitedTextExtract",adr(s$),adr(sep$),champ_ville%,adr(ville$))
   res% = dll_call4("KGFDelimitedTextExtract",adr(s$),adr(sep$),champ_codpost%,adr(codpost$))
   ville$ = trim$(ville$)
   cle$ = trim$(Left$(ville$,30))
   if left$(cle$,2)="L'" then cle$ = Mid$(cle$,3,len(cle$)) + "(L')"
   if left$(cle$,2)="D'" then cle$ = Mid$(cle$,3,len(cle$)) + "(D')"
   if left$(cle$,3)="La " then cle$ = Mid$(cle$,4,len(cle$)) + "(La)"
   if left$(cle$,3)="Le " then cle$ = Mid$(cle$,4,len(cle$)) + "(Le)"
   if left$(cle$,4)="Les " then cle$ = Mid$(cle$,5,len(cle$)) + "(Les)"
   file_writeln 2,cle$+","+trim$(codpost$)+","+ville$
   print_locate 20,60
   print str$(k%)
  end_while
  file_close 1
  file_close 2
end_sub

' procédure de convertion d'une chaîne de caractères de UTF8 en ANSI
' entrée: paramère utf8$
' sortie: variable globale ansi$ créée automatiquement si inexistante
sub UTF8toANSI(utf8$)
  dim_local i%,c%, ca$
  if variable("ansi$")=0 then dim ansi$
  ansi$ = ""
  while i%<len(utf8$)
   i% = i% + 1
   c% = asc(mid$(utf8$,i%,1))
   if c%=195 : ' hex C3
   i% = i% + 1
   c% = asc(mid$(utf8$,i%,1))
   ca$ = "?"
   select c%
   case 162
   ca$ = "â"
   case 160
   ca$ = "à"
   case 169
   ca$ = "é"
   case 170
   ca$ = "ê"
   case 168
   ca$ = "è"
   case 171
   ca$ = "ë"
   case 175
   ca$ = "ï"
   case 174
   ca$ = "î"
   case 180
   ca$ = "ô"
   case 187
   ca$ = "û"
   case 185
   ca$ = "ù"
   case 167
   ca$ = "ç"
   end_select
   ansi$ = ansi$ + ca$
   else
   ansi$ = ansi$ + chr$(c%)
   end_if
  end_while
end_sub

Et voici la démo avec un fichier de contacts:

Code:: ' 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%)
res% = res% - 1 - 2 : ' déduire la définition des champs et la définition des deux clés
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%)
res% = res% - 1 - 2 : ' déduire la définition des champs et la définition des deux clés
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% = dll_call1("GetIsamRecordCount",IsamID%)
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

Nouvelle version:
KGF.dll V4.88 du 27/07/2015

Nouveautés:
- la fonction SetIsamKeyFields retourne maintenant un code erreur -7 si la longueur totale de la clé dépasse 30 caractères

Modules modifiés:
KGF.dll
KGF.chm

La doc et l'aide en ligne sont à jour. Les sources sont à jour également.

Ce cas était bien testé, mais j'avais oublié de retourner le code erreur. Voilà qui est corrigé.

Nouvelle version:
KGF.dll V4.89 du 28/07/2015

Nouveautés:
- correction d'un bug dans CreateIsamFile

Modules modifiés:
KGF.dll

La doc et l'aide en ligne sont à jour. Les sources sont à jour également.

Le problème était double:
1. le fichier était systématiquement créé avec 2 clés, sans tenir compte du nombre de clés paramétrées
2. le nombre d'enregistrements présents n'était pas renseigné correctement après une création, seulement après une réouverture

J' ai mis à jour la dll mais j' ai toujours mon " acces violation"... Crying or Very sad

Je vais essayer de trouver cela...

Nouvelle version:
KGF.dll V4.90 du 28/07/2015

Nouveautés:
- correction d'un bug dans OpenIsamFile

Modules modifiés:
KGF.dll

La doc et l'aide en ligne sont à jour. Les sources sont à jour également.

Correction du problème de plantage en ouverture d'un fichier ISAM si la longueur d'enregistrement était plus grande que 255 caractères

Nombre de messages : 812 Localisation : Troyes Date d'inscription : 05/02/2011

bjr klaus

Pourrais tu inséré de nouvelle commande à
kgf dans StringGrid pour incorporer des objets
panoramic dans un grid?
je pensai a un combo,un check et un option
selon son handle de l'objet créé et à la position
dans le grid souhaité
si ce n'est pas possible et ben passe la demande!
A+

Je comprends l'intérêt de ta demande, Pascal10000. Mais je n'ai aucun moyen de faire cela à partir d'une DLL. Ce serait plutôt une suggestion pour Jack, dans la rubrique "Vous souhaits d'amélioration...".

Nouvelle version:
KGF.dll V4.91 du 28/07/2015

Nouveautés:
- ajout des fonctions AddFont et RemoveFont

Modules modifiés:
KGF.dll
KGF.chm

La doc et l'aide en ligne sont à jour. Les sources sont à jour également.

J'en ai rêvé et Klaus l'a fait !! lol!

Et plus vite que l'éclair !!! cheers

Merci Klaus !

Oh là, doucement ! Je n'ai pas de fichier TTF pour tester cela. J'ai juste codé cela soigneusement, mais c'est sans filet, pour le moment. Essaie ces fonctions, et en cas de problème, il faudra que tu me passes le TTF pour la mise au point. Voici le code exact des deux fonctions:

Code:: function AddFont(nom: pstring):integer; stdcall; export;
begin
try
AddFontResource(pchar(nom^));
except
result := -1;
exit;
end;
SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
result := 0;
end;

function RemoveFont(nom: pstring):integer; stdcall; export;
begin
try
RemoveFontResource(pchar(nom^));
except
result := -1;
exit;
end;
SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
result := 0;
end;

OK klaus !

Je viens de rentrer a la maison et le fichier que j'ai testé est resté au boulot.
Je dois m'absenter une petite heure donc je testerai dans la soirée.

Je te tiens au courant et encore merci. Wink

Bonsoir Klaus.

Bon alors voila :

Si j'utilise la DLL, avec ma font.ttf elle la charge bien sauf que je n'ai pas mes caracteres speciaux qui sont CHR$(21) et CHR$(22)

et lorsque j'installe la police dans windows j'ai bien mes 2 caractères.

Je ne comprends pas pourquoi ? Exclamation

Désolé Klaus !

Autant pour moi, ca fonctionne. cheers

Une mauvaise manipulation dans le test ! Suspect

Encore merci. Wink

Super ! Je suis ravi que ça marche comme ça !

Maintenant, essaie d'appliquer la mise en ressource de la police dans le fichier EXE généré, si cela peut t'intéresser pour la distribution. Sinon, n'importe quel programme de génération d'installation met la police en place également - pour ma part, j'utilise Inno Setup.

Autre sujet: tu sais qu'on peut faire des polices avec des images bitmap pour chaque caractère ? Un peu comme Wingdings. Cela pourrait être sympa d'avoir un procédé pour placer une série d'icônes dans une police et de les afficher simplement comme du texte, en choisissant la bonne police.

Avant cela il faut que je comprenne comment fonctionne les différent logiciels de création de font.

Avec ICOMOON je n'arrive pas a mettre les icônes sous le bon numéro (Identifiant CH$(xxx))
Par défaut il propose 20 pour le premier caractère mais ensuite les icone transformer je retrouve en 30 ou 33.

J'ai pensé ensuite les mettre en 250... mais la je vois plus du tout les icônes.

je ne comprends pas tout !
Je vais faire des recherches sur internet pour l'utilisation de ce logiciel. drunken

Normalement, en cliquant sur le bouton "Font", tu as un moyen de choisir le caractère auquel tu assignes l'icône, selon la doc du dernier lien de la collection de liens que je t'ai envoyé dans l'autre fil de discussion...

Nouvelle version:
KGF.dll V4.92 du 30/07/2015

Nouveautés:
- correction d'un bug dans les fonctions ReadNextIsamRecord et ReadPreviousIsamRecord

Modules modifiés:
KGF.dll

La doc et l'aide en ligne sont à jour. Les sources sont à jour également.

C'était un bug insidieux: après une tentative de lecture au-delà de la dernière clé dans l'index, selon la direction de recherche, le contenu de l'enregistrement et celui de la clé passée en paramètre était modifié, bien que le code retour indiquait une erreur. Ceci est corrigé: en cas de dépassement de l'index, l'enregistrement et la clé sont maintenues et les fonctions retournent la valeur de 0.

» KGF_dll - nouvelles versions
» Nouvelles versions
» Synedit_Editor - nouvelles versions
» KGF_dll - nouvelles versions
» KGF_dll - nouvelles versions