Pic et Poc, les joyeux drilles

Sujet: Re: Pic et Poc, les joyeux drilles Ven 12 Oct 2012 - 2:02

J’ai fait mes tests et je confirme ce qu’a dit Klaus.
PANORAMIC, pour stocker en mémoire une chaine de caractères, procède comme ceci :
4 octets pour enregistrer la longueur de la chaine suivis des codes ASCII de tous les caractères formant la chaine.
Pour les 4 octets réservés à la longueur, l’octet le moins significatif est codé en premier.
On peut alors théoriquement aller jusqu’à une chaine de longueur FFFFFFFF (hexa), mais ceci reste à vérifier!

@ygeronimi

Je ne pense pas qu’il y a parmi nous quelqu’un qui parle Mandarin, mais tout le monde parle PANORAMIC !

Sujet: Re: Pic et Poc, les joyeux drilles Ven 12 Oct 2012 - 4:47

@papydall :
as-tu jeté un coup d'oeil à mon explication en début du topic sur les chaines de caractères ?
J'explique, par l'exemple, comment Delphi gère les chaines en mémoire...

Voir également ici, le paragraphe "C. Quelques précisions sur le type string"
qui explique ma démo...

EDIT: Une chose est sûre c'est que la structure dans Panoramic qui définie une variable de type entier est en partie définie comme ceci:

Code:: ' ADR-12 ## ## ## ## : pointeur sur une structure de type chaine qui contient le nom de la variable
' ADR-8 ## ## ## ## : inconnu (dimension ?)
' ADR-4 ## ## ## ## : inconnu
' ADR ## ## ## ## : valeur de la variable de type entier

Ce qui nous donne :

Code:: DIM MaVariable%:MaVariable%=1234
DIM Toto%:Toto%=7894
DIM Truc_muche%:Truc_muche%=5478972

InfoEntier(ADR(MaVariable%))
InfoEntier(ADR(Toto%))
InfoEntier(ADR(Truc_muche%))

END
SUB InfoEntier(ad%)
DIM_LOCAL Varname%,VarNameLenght%,i%,a$
' on recupere le pointeur sur la structure chaine
LPEEK(ad%-12):VarName%=LPEEK_return%
' puis la longueur de la chaine
LPEEK(VarName%-4) : VarNameLenght%=LPEEK_return%
' on va chercher le nom de la variable
FOR i%=0 TO VarNameLenght%-1
a$=a$+CHR$(PEEK(VarName%+i%))
NEXT i%
PRINT "Info sur un entier :"
PRINT " Nom de la variable :";a$
LPEEK(ad%)
PRINT " Valeur :";LPEEK_return%
END_SUB

SUB LPEEK(adr%)
IF VARIABLE("LPEEK_return%")=0 THEN DIM LPEEK_return%
DIM_LOCAL Value%,i%,a$,Value$
Value% = 0
FOR i%=0 TO 3
a$=HEX$(PEEK(adr%+i%)):IF LEN(a$)<2 THEN a$="0"+a$
Value$ = a$ + Value$
NEXT i%
LPEEK_return% = HEX(Value$)
END_SUB

Peut être qu'un tableau d'entier est un ensemble de int chainé entre-eux (cf. ADR-4 qui contiendrai un pointeur vers le int suivant) dans ce cas, coder le ADR() pour un tableau risque d'être pas évident et dangeureux car ADR(tab(1)) peut être à chaille par rapport à ADR(tab(0))...

Bon je vais arrêter là, Jack n'aime peut être pas qu'on jette un oeil dans ce qu'il a fait... Wink

Sujet: Re: Pic et Poc, les joyeux drilles Ven 12 Oct 2012 - 13:24

@Klaus : une piste...
J'ai pratiquement donné la solution pour les tableaux... Wink

Code:: DIM a%
DIM MonTableau%(1)
InfoEntier(ADR(a%)+80)

Sujet: Re: Pic et Poc, les joyeux drilles Ven 12 Oct 2012 - 18:15

Voici ce que j'ai réussi à faire, sachant que chaque case fait 80 octets, que l'adresse du nom est au offset -12 par rapport à adr(...), et qu'à l'offset -8, on trouve le codage du type de variable:
1 = integer simple 4 = tableau integer 1 dimension 7 = tableau integer 2 dimensions
2 = string simple 4 = tableau string 1 dimension 7 = tableau string 2 dimensions
3 = flottant simple 4 = tableau flottant 1 dimension 7 = tableau flottant 2 dimensions

Dans l'exemple suivant, il faut activer une des lignes DIM au début, et lancer le programme. Le mémo de gauche fait un dump décimal, celui de droite montre l'interprétation des données. J'ai trouvé comment des tableaux sont définis, et où se trouvent les dimensions.

Code:: dim a1%,test%,a2%
' dim a1%,test$,a2%
' dim a1%,test,a2%
' dim a1%,test%(18),a2%
' dim a1%,test$(18),a2%
' dim a1%,test(18),a2%
' dim a1%,test%(18,36),a2%
' dim a1%,test$(18,36),a2%
' dim a1%,test(18,36),a2%

dim x32%,a32%, s$, x32bis%
dim anom%, nom$, i%, type%, dimensions%(2)
dim types$(9)
' adr()-12 = adresse du nom
' adr()-8 = type 1=integer 2=string 3=flottant
' type+3 = tableau
' si tableau
' type=4:, adr()+44 = nombre d'éléments
' type=5:, adr()+48 = nombre d'éléments
' type=6:, adr()+52 = nombre d'éléments
' type=7:, adr()+44 et +56 = nombre d'éléments
' type=8:, adr()+48 = nombre d'éléments
' type=9:, adr()+52 = nombre d'éléments
' adr()-4 = ?

data "int","str","flo","int()","str()","flo()","int(,)","str(,)","flo(,)"
for i%=1 to 9
read types$(i%)
next i%

height 0,600

a1% = 378
' test = 257
a2% = 498

memo 1 : top 1,10 : left 1,10 : height 1,500 : bar_vertical 1
a32% = adr(a1%)-12
for i%=0 to 45
get32(a32%)
item_add 1,str$(i%*4)+": "+str$(a32%)+"="+str$(x32%)
a32% = a32% + 4
next i%

memo 2 : top 2,10 : left 2,300 : bar_vertical 2
a32% = adr(a1%)
for i%=1 to 3
getnom(a32%)
gettype(a32%)
s$ = s$ + " "+types$(type%)
if dimensions%(1)>0 then s$ = s$ + " "+str$(dimensions%(1))
if dimensions%(2)>0 then s$ = s$ + ","+str$(dimensions%(2))
if dimensions%(0)=1 then s$ = s$ + " éléments"
item_add 2,s$
a32% = a32% + 80
next i%

end

sub gettype(a%)
get32(a%-8)
type% = x32%
dimensions%(0) = 0
dimensions%(1) = 0
dimensions%(2) = 0
if type%>3
dimensions%(1) = 1
select type%
case 4: get32(a%+44)
case 5: get32(a%+48)
case 6: get32(a%+52)
case 7: get32(a%+44)
case 8: get32(a%+48)
case 9: get32(a%+52)
end_select
dimensions%(1) = x32%
if type%>6
select type%
case 7: get32(a%+56)
case 8: get32(a%+60)
case 9: get32(a%+64)
end_select
dimensions%(2) = x32%
end_if
end_if
end_sub

sub getnom(a%)
dim_local a1%
a1% = a% - 12
get32(a1%)
a1% = x32%
getstr(a1%)
end_sub

sub get32(a%)
poke adr(x32%),peek(a%)
poke adr(x32%)+1,peek(a%+1)
poke adr(x32%)+2,peek(a%+2)
poke adr(x32%)+3,peek(a%+3)
end_sub

sub getstr(a%)
dim_local i% : i% = a%
dim_local b%
s$ = ""
b% = peek(i%)
while b%<>0
s$ = s$ + chr$(b%)
i% = i% + 1
b% = peek(i%)
end_while
end_sub

Maintenant, ce que j'aimerais trouver, c'est où se trouvent les données des tableaux... Et même la valeur d'un flottant ne semble pas se trouver directement dans sa case.

Sujet: Re: Pic et Poc, les joyeux drilles Ven 12 Oct 2012 - 18:37

Bravo Klaus, tu es allé jusqu'au bout (enfin presque).
Pour ce qui est de situer le contenu des tableaux, ça me paraît bien difficile s'il faut aller à la pêche sans avoir de piste...

Sujet: Re: Pic et Poc, les joyeux drilles Ven 12 Oct 2012 - 20:52

Pour l'instant j'arrive à lister le nom de toutes les variables presentes ainsi que leur type (entier, reel,chaine$, tableau d'entier) en ram (meme les locales et les variables système...)

J'arrive à détecter les valeurs d'un tableau d'entier (les valeurs sont sur 4 octets). Elles sont à la suite les unes des autres mais je n'ai pas encore trouvé comment établir le lien entre elles et la structure de définition...

Sujet: Re: Pic et Poc, les joyeux drilles Ven 12 Oct 2012 - 21:01

Bravo Nardo, tu touches au but. Seras-tu le Sherlock Holmes de la structure des données ? Wink

Sujet: Re: Pic et Poc, les joyeux drilles Ven 12 Oct 2012 - 21:47

Bravo aussi Nardo, même si ça ne sert pas à grand chose après (sauf peut-être en interface avec les dll ?), ce sera au moins bon pour notre culture générale.

Je crois me souvenir qu'en Basic Peek et Poke servaient surtout à aller lire ou écrire dans la mémoire écran (image de l'écran en mémoire), pour faire des sauvegardes entre autres, mais je ne sais plus à quoi d'autre.
Je crois aussi que ce n'était pas simple du tout de manipuler les adresses mémoire, avec des découpages de la mémoire en segments (avec des adresses relatives, because sans doute des champs adresses trop petits ?), il semble qu'ici on adresse toute la mémoire en adresses absolues...

Sujet: Re: Pic et Poc, les joyeux drilles Ven 12 Oct 2012 - 22:30

Alors, Nardo26, comment fais-tu pour détecter les données d'un tableau d'entiers ? J'avais posté l'analyse de la liste des variables, mais il me manque le lien vers les données d'un tableau. Comment fais-tu ?

Sujet: Re: Pic et Poc, les joyeux drilles Sam 13 Oct 2012 - 11:23

Entretemps, j'ai trouvé le moyen de localiser des données flottantes et de string, et j'affiche les valeurs entières, string et flottantes dans l'analyse.

Peux-tu m'indiquer comment tu fais pour trouver les données d'un tableau d'entiers ? Voici mon dernier code;

Code:: dim x32%,a32%, s$, x32bis%
dim anom%, nom$, i%, j%, type%, dimensions%(2), f32
dim types$(9)
' adr()-12 = adresse du nom
' adr()-8 = type 1=integer 2=string 3=flottant
' type+3 = tableau
' si tableau
' type=4:, adr()+44 = nombre d'éléments
' type=5:, adr()+48 = nombre d'éléments
' type=6:, adr()+52 = nombre d'éléments
' type=7:, adr()+44 et +56 = nombre d'éléments
' type=8:, adr()+48 = nombre d'éléments
' type=9:, adr()+52 = nombre d'éléments
' adr()-4 = ?
' les données:
' type=1: 32 bits à adr()
' type=2: adresse du string à adr()+4
' type=3: 64 bits à adr()+12

' dim a1%,test%,a2%,t1%
dim a1%,test$,a2%,t2%
' dim a1%,test,a2%,t3%
' dim a1%,test%(18),a2%,t4%
' dim a1%,test$(18),a2%,t5%
' dim a1%,test(18),a2%,t6%
' dim a1%,test%(18,36),a2%,t7%
' dim a1%,test$(18,36),a2%,t8%
' dim a1%,test(18,36),a2%,t9%

data "int","str","flo","int()","str()","flo()","int(,)","str(,)","flo(,)"
for i%=1 to 9
read types$(i%)
next i%

height 0,600

a1% = 378
if variable("t2%")=1 then test$ = "abcde"
if variable("t3%")=1 then test = 2
if variable("t4%")=1 then test%(0)= 123 : test%(1)= 234
if variable("t7%")=1 then test%(0,0)= 123 : test%(1,0)= 234
a2% = 498

memo 1 : top 1,10 : left 1,10 : height 1,500 : bar_vertical 1
a32% = adr(a1%)-12
for i%=0 to 20*3+5
get32(a32%)
item_add 1,str$(i%*4)+": "+str$(a32%)+"="+str$(x32%)
a32% = a32% + 4
next i%

memo 2 : top 2,10 : left 2,300 : height 2,500 : bar_vertical 2
a32% = adr(a1%)
for i%=1 to 3
getnom(a32%)
gettype(a32%)
item_add 2,str$(a32%)
s$ = s$ + " "+types$(type%)
if dimensions%(1)>0 then s$ = s$ + " "+str$(dimensions%(1))
if dimensions%(2)>0 then s$ = s$ + ","+str$(dimensions%(2))
if dimensions%(0)=1 then s$ = s$ + " éléments"
item_add 2,s$
if dimensions%(0)=0
select type%
case 1
get32(a32%)
item_add 2," valeur="+str$(x32%)
case 2
get32(a32%+4)
getstr(x32%)
item_add 2," valeur="+s$
case 3
get64(a32%)
item_add 2," valeur="+str$(f32)
' item_add 2," test="+str$(test)
end_select
end_if
a32% = a32% + 80
next i%
end

sub get64(a%)
dim_local j%
for j%=0 to 7
poke adr(f32)+j%,peek(a%+12+j%)
next j%
end_sub

sub gettype(a%)
get32(a%-8)
type% = x32%
dimensions%(0) = 0
dimensions%(1) = 0
dimensions%(2) = 0
if type%>3
dimensions%(1) = 1
select type%
case 4: get32(a%+44)
case 5: get32(a%+48)
case 6: get32(a%+52)
case 7: get32(a%+44)
case 8: get32(a%+48)
case 9: get32(a%+52)
end_select
dimensions%(1) = x32%
if type%>6
select type%
case 7: get32(a%+56)
case 8: get32(a%+60)
case 9: get32(a%+64)
end_select
dimensions%(2) = x32%
end_if
end_if
end_sub

sub getnom(a%)
dim_local a1%
a1% = a% - 12
get32(a1%)
a1% = x32%
getstr(a1%)
end_sub

sub get32(a%)
poke adr(x32%),peek(a%)
poke adr(x32%)+1,peek(a%+1)
poke adr(x32%)+2,peek(a%+2)
poke adr(x32%)+3,peek(a%+3)
end_sub

sub getstr(a%)
dim_local i% : i% = a%
dim_local b%
s$ = ""
b% = peek(i%)
while b%<>0
s$ = s$ + chr$(b%)
i% = i% + 1
b% = peek(i%)
end_while
end_sub

EDIT
Ce que je cherche à faire, c'est de pouvoir passer l'adresse d'un tableau d'entiers à une DLL. Ce tableau servira pour communiquer des paramètres plus complexes à la DLL, et récupérer des résultats autres qu'un simple entier.

Bon, j'ai bien conscience qu'avec la prochaine version utilisant FreeBasic, tout cela risque fort de changer. N'importe, c'est in exercice de style intéressant, et le principe restera peut-être valable dans la nouvelle version, quitte à l'adapter.

Sujet: Re: Pic et Poc, les joyeux drilles Sam 13 Oct 2012 - 14:11

Voila ce que j'obtiens pour l'instant :

Code:: CAPTION 0,"Liste des variables"
WIDTH 0,SCREEN_X/2:HEIGHT 0,SCREEN_Y-80
MEMO 1:WIDTH 1,WIDTH(0)-40:HEIGHT 1,HEIGHT(0)-80
BAR_BOTH 1
PRINT_TARGET_IS 1
FONT_NAME 1,"Courier new"
DIM i%,s%,e%,tableau%(15),tableau2(47),tableau3$(12)
DIM chaine$:chaine$="contenu chaine"
DIM reel:reel=1.234
s%=0
REPEAT
s%=s%+1
GetName(ADR(i%)-(s%*80))
UNTIL GetName_return$="CLIPBOARD_STRING_PASTE$"

i%=ADR(i%)-(s%*80)
REPEAT
InfoVariable(i%)
i%=i%+80
UNTIL GetName_return$=""

END

SUB InfoVariable(ad%)
PRINT "-----------------------------------------------------------------------"
GetName(ad%)
IF GetName_return$<>""
GetType(ad%) : GetValue(ad%)
PRINT "Nom : "+GetName_return$+STRING$(50-LEN(GetName_return$)," ")+" Type: ",GetType_return$
PRINT "Contenu :"+GetValue_return$
END_IF
END_SUB

SUB GetName(Ad%)
DIM_LOCAL VarName%,i%,VarNameLenght%,v%
DIM_LOCAL t$:t$="ABCDEFGHIJKLMNOPQRSTUVWXYZ_$!%32"
IF VARIABLE("GetName_return$")=0 THEN DIM GetName_return$
GetName_return$=""

GetType(Ad%)
LPEEK(Ad%-8)
IF GetType_return%=LPEEK_return%
LPEEK(Ad%-12) : VarName%=LPEEK_return%
ELSE
LPEEK(Ad%-16) : VarName%=LPEEK_return%
END_IF
LPEEK(VarName%-4) : VarNameLenght%=LPEEK_return%
IF VarNameLenght% < 50
FOR i%=0 TO VarNameLenght%-1
v%=PEEK(VarName%+i%)
IF INSTR(t$,CHR$(v%))=0 THEN GetName_return$="":EXIT_SUB
GetName_return$=GetName_return$+CHR$(v%)
NEXT i%
END_IF
IF INSTR(GetName_return$,"!")<>0
DLIST 100:EXPLODE(GetName_return$,"!",100)
GetName_return$=ITEM_READ$(100,2)+" variable locale dans "+ITEM_READ$(100,1)
DELETE 100

END_IF
END_SUB

SUB GetType(ad%)
IF VARIABLE("GetType_return%")=0 THEN DIM GetType_return%
IF VARIABLE("GetType_return$")=0 THEN DIM GetType_return$
LPEEK(ad%-12)
IF LPEEK_return%=2 OR LPEEK_return%=5
GetType_return%=LPEEK_return%
ELSE
LPEEK(ad%-8)
GetType_return%=LPEEK_return%
END_IF
GetType_return$=""

SELECT GetType_return%
CASE 1
GetType_return$= "Entier"
CASE 2
GetType_return$= "Chaine de caractères"
CASE 3
GetType_return$= "Réel"
CASE 4
GetType_return$= "Tableau d'entier"
CASE 5
GetType_return$= "Tableau de chaine de caractères"
CASE 6
GetType_return$= "Tableau de réel"
END_SELECT
IF GetType_return$=""
GetType_return$ = STR$(GetType_return%)
DUMP(ad%-16)
DUMP(ad%)
DUMP(ad%+16)
END_IF

END_SUB

SUB GetValue(ad%)
DIM_LOCAL long%,struct%,i%,a$,b$,v%,v1
DIM_LOCAL tmpReel
IF VARIABLE("GetValue_return$")=0 THEN DIM GetValue_return$
GetValue_return$=""
GetType(ad%)
SELECT GetType_return%
CASE 20
DUMP(ad%)
CASE 3
FOR i%=0 TO 7
' bizarre cet offset de 12...
POKE adr(tmpReel)+i%,PEEK(ad%+12+i%)
NEXT i%
GetValue_return$=STR$(tmpReel)
CASE 2
ad%=ad%+4
LPEEK(ad%)
IF LPEEK_return%<>0
struct% = LPEEK_return%

' on récupère la longueur de la chaine
LPEEK(struct%-4): long%=LPEEK_return%
FOR i%=0 TO long% - 1
v%=PEEK(struct%+i%)
GetValue_return$ = GetValue_return$ + chr$(v%)
NEXT i%
IF GetValue_return$ = GetName_return$ THEN GetValue_return$="<vide>"
ELSE
GetValue_return$="<vide>"
END_IF
CASE 1
LPEEK(ad%):GetValue_return$=STR$(LPEEK_return%)
END_SELECT

END_SUB

SUB LPEEK(ad%)
IF VARIABLE("LPEEK_return%")=0 THEN DIM LPEEK_return%
DIM_LOCAL Value%,i%,Value$,c%
Value% = 0
FOR i%=0 TO 3
c%=PEEK(ad%+i%)
IF c%<16 : Value$="0"+HEX$(c%)+Value$
ELSE:Value$=HEX$(c%)+Value$:END_IF
NEXT i%
LPEEK_return% = HEX(Value$)
END_SUB

SUB DUMP(Ad%)
DIM_LOCAL i%,v%,a$,b$
a$="":b$=""
FOR i%=0 TO 15
v%=PEEK(Ad%+i%)
IF v%<16 : a$=a$+"0"+HEX$(v%)+" "
ELSE:a$=a$+HEX$(v%)+" ":END_IF
if MOD(i%+1,4)=0 THEN a$=a$+" "
if v%>31:b$=b$+chr$(v%)
ELSE:b$=b$+".":END_IF
NEXT i%
PRINT HEX$(Ad%)+" :"+a$+" "+b$
END_SUB

SUB EXPLODE(chaine$,delimiter$,liste%)
WHILE INSTR(chaine$,delimiter$)<>0
ITEM_ADD liste%,LEFT$(chaine$,INSTR(chaine$,delimiter$)-1)
chaine$=RIGHT$(chaine$,LEN(chaine$)-INSTR(chaine$,delimiter$))
END_WHILE
ITEM_ADD liste%,chaine$
END_SUB

Marrant on a pratiquement les meme nom de procedure... Laughing

Désolé Klaus mais :
Pour les données des tableaux d'entier, je les ai vue en dumpant la mémoire

Pic et Poc, les joyeux drilles - Page 2 19

, elles sont bien sagement alignées les unes à la suite des autres mais je n'ai pas encore trouvé le lien avec la structure...
Pour l'instant je regarde pourquoi la dernière variable de ma liste (T$) n'est pas correctement traitée...
et il reste pas mal de chose à voir...

Je jette un coup d'oeil à ton code, peut être que cela va m'aider pour comprendre mon pb...

Sujet: Re: Pic et Poc, les joyeux drilles Sam 13 Oct 2012 - 23:10

Heureka !!!!!!!!!!

J'ai trouvé !

Pour le moment, cela marche pour des tableaux d'entiers en une dimension, et c'est ce qui m'intéresse. Les données sont stockées juste après la table de symboles, en commençant à une limite de case (multiple de 80 octets). La marque à rechercher DANS CETTE POSITION est 818 décimal. Partant de là, il faut avancer 3 mots de 32 bits, donc 12 octets. Puis, pour chaque tableau, l'offset 20 (décimal) à partir de adr() donne l'offset à partir de l'adresse ainsi calculée. De là, on a les éléments du tableau, et leur nombre est dans adr()+44 pour les tableaux d'entiers.

Voici mon programme de démo, avec deux tableaux d'entiers, dont je récupère et affiche les valeurs. Ne faites pas attention aux noms des procédures - c'est du vite fait et sera fait plus joliment demain:

Code:: dim x32%,a32%, s$, x32bis%
dim anom%, nom$, i%, j%, type%, dimensions%(2), f32
dim types$(9), t32%, a32e%, dumpit%

dumpit% = 0 : ' mettre à 1 pour obtenir un dump décimal
' adr()-12 = adresse du nom
' adr()-8 = type 1=integer 2=string 3=flottant
' type+3 = tableau
' si tableau
' type=4:, adr()+44 = nombre d'éléments
' type=5:, adr()+48 = nombre d'éléments
' type=6:, adr()+52 = nombre d'éléments
' type=7:, adr()+44 et +56 = nombre d'éléments
' type=8:, adr()+48 = nombre d'éléments
' type=9:, adr()+52 = nombre d'éléments
' adr()-4 = ?
' les données:
' type=1: 32 bits à adr()
' type=2: adresse du string à adr()+4
' type=3: 64 bits à adr()+12

' Les données des tableaux linéaires sont stockées après la table des symboles.
' La marque est la suite (818,1,201) commençant à une limite de case de la
' table de symboles (multiples de 20). Il suffit donc de chercher 818 tous les
' 20 mots de 32 bits (80 octets) pour trouver le début.
' adr()+20 donne l'offset par rapport au début de cette zone pour le premier
' élément. L'offset adr()+44 donne le nombre de cellules.

' dim a1%,test%,a2%,t1%
' dim a1%,test$,a2%,t2%
' dim a1%,test,a2%,t3%
dim a1%,test%(18),testbis%(5),a2%,t4%
' dim a1%,test$(18),a2%,t5%
' dim a1%,test(18),a2%,t6%
' dim a1%,test%(18,36),a2%,t7%
' dim a1%,test$(18,36),a2%,t8%
' dim a1%,test(18,36),a2%,t9%

data "int","str","flo","int()","str()","flo()","int(,)","str(,)","flo(,)"
for i%=1 to 9
read types$(i%)
next i%

height 0,600

a1% = 378
if variable("t1%")=1 then test% = 765
if variable("t2%")=1 then test$ = "abcde"
if variable("t3%")=1 then test = 2
if variable("t4%")=1 then test%(0)= 12345 : test%(1)= 23456 : testbis%(0)=98765
if variable("t5%")=1 then test$(0)= "abcde" : test$(1)= "ABC"
if variable("t7%")=1 then test%(0,0)= 12345 : test%(1,0)= 23456
a2% = 498

memo 1 : top 1,10 : left 1,10 : height 1,500 : bar_vertical 1
a32% = adr(a1%)-12
for i%=0 to 20*3+5
get32(a32%)
item_add 1,str$(i%*4)+": "+str$(a32%)+"="+str$(x32%)
a32% = a32% + 4
next i%

memo 2 : top 2,10 : left 2,300 : height 2,500 : bar_vertical 2
a32% = adr(a1%) : ' on donne ici l'adresse de la première variable à tester
for i%=1 to 4 : ' la limite haute est le nombre de variables à parcourir
getnom(a32%)
gettype(a32%)
item_add 2,str$(a32%)
s$ = s$ + " "+types$(type%)
if dimensions%(1)>0 then s$ = s$ + " "+str$(dimensions%(1))
if dimensions%(2)>0 then s$ = s$ + ","+str$(dimensions%(2))
if dimensions%(0)=1 then s$ = s$ + " éléments"
item_add 2,s$
if dimensions%(0)=0
select type%
case 1
get32(a32%)
item_add 2," valeur="+str$(x32%)
case 2
get32(a32%+4)
getstr(x32%)
item_add 2," valeur="+s$
case 3
get64(a32%)
item_add 2," valeur="+str$(f32)
case 4
findelements(a32%)
for j%=0 to dimensions%(1)-1
get32(a32e%+j%*4)
item_add 2," value "+str$(j%)+"="+str$(x32%)
next j%
end_select
end_if
a32% = a32% + 80
next i%

if dumpit%=1
findt32(adr(a1%)-8192,adr(a1%)+8192)
dump(adr(a1%)-8192,adr(a1%)+8192)
end_if
end

sub findelements(a%)
dim_local k%, off%
get32(a%+20)
off% = x32%
k% = a% - 12 + 80
get32(k%)
while x32%<>818
k% = k% + 80
get32(k%)
end_while
a32e% = k% + 12 + off%*4
end_sub

sub get64(a%)
dim_local j%
for j%=0 to 7
poke adr(f32)+j%,peek(a%+12+j%)
next j%
end_sub

sub gettype(a%)
get32(a%-8)
type% = x32%
dimensions%(0) = 0
dimensions%(1) = 0
dimensions%(2) = 0
if type%>3
dimensions%(1) = 1
select type%
case 4: get32(a%+44)
case 5: get32(a%+48)
case 6: get32(a%+52)
case 7: get32(a%+44)
case 8: get32(a%+48)
case 9: get32(a%+52)
end_select
dimensions%(1) = x32%
if type%>6
select type%
case 7: get32(a%+56)
case 8: get32(a%+60)
case 9: get32(a%+64)
end_select
dimensions%(2) = x32%
end_if
end_if
end_sub

sub getnom(a%)
dim_local a1%
a1% = a% - 12
get32(a1%)
a1% = x32%
getstr(a1%)
end_sub

sub get32(a%)
poke adr(x32%),peek(a%)
poke adr(x32%)+1,peek(a%+1)
poke adr(x32%)+2,peek(a%+2)
poke adr(x32%)+3,peek(a%+3)
end_sub

sub getstr(a%)
dim_local i% : i% = a%
dim_local b%
s$ = ""
b% = peek(i%)
while b%<>0
s$ = s$ + chr$(b%)
i% = i% + 1
b% = peek(i%)
end_while
end_sub

sub dump(xa1%,xa2%)
dim_local j%
item_add 1,"Dump:"
for j%=xa1% to xa2% step 4
get32(j%)
BinToAscii(j%)
if x32%=12345
s$ = s$ + " <==="
else
if x32%<>0
if x32%=t32%
s$ = s$ + " <==="
end_if
end_if
end_if
item_add 1,str$(j%)+": "+str$(x32%)+"="+s$
next j%
item_add 1,"End Dump"
end_sub

sub findt32(xa1%,xa2%)
dim_local j%
item_add 1,"Search 1"
t32% = 0
for j%=xa1% to xa2% step 4
get32(j%)
if x32%=12345
item_add 2,"> "+str$(j%)+": 12345"
t32% = j%
exit_for
end_if
next j%
item_add 1,"End Search 1"
item_add 1,"Search 2"
if t32%<>0
for j%=xa1% to xa2% step 4
get32(j%)
if x32%=t32%
item_add 2,"* "+str$(j%)+": "+str$(x32%)
item_add 2,"* offset="+str$(t32%-adr(a1%))
item_add 1,"End Search 2"
exit_sub
end_if
next j%
end_if
item_add 1,"End Search 2"
end_sub

sub BinToAscii(a%)
dim_local c%, j%
s$ = ""
for j%=0 to 3
c% = peek(a%+j%)
if c%<32
s$ = s$ + "."
else
s$ = s$ + chr$(c%)
end_if
next j%
end_sub

Conclusion: ma procédure findelements() donne l'adresse de la première valeur dans la variable a32e%. On l'appelle ainsi:

Code:: dim a1%,test%(25), a32e%
findelements(adr(a1%)+80)
message "a32e%="+str$(a32e%)

et c'est cette valeur qu'on passera à une DLL au lieu du adr(test%()) qui ne marche pas !

Sujet: Re: Pic et Poc, les joyeux drilles Sam 13 Oct 2012 - 23:56

Bien vu, tu as détronné le Shelock Holmes de la structure de données Wink

Bravo Klaus

Sujet: Re: Pic et Poc, les joyeux drilles Dim 14 Oct 2012 - 0:27

Ce n’est pas élémentaire mon cher Watson.

Sujet: Re: Pic et Poc, les joyeux drilles Dim 14 Oct 2012 - 1:53

Une petite application de cette trouvaille. J'ai ajouté un clone de la fonction GetFormMetrics à KGF.dll, qui passe du coup à
1.71 14/10/2012 ajout fonction GetFormMetricsEX

La nouvelle fonction a la forme suivante:

Code:: res% = dll_call2("GEtFormMetricsEX",handle(f%),adr%)

f% est un numéro de form (0 pour le programme actif), mais à la place de handle(f%), on peut aussi passer hand_form("Notepad") etc.
adr% est l'adresse réelle des données d'un tableau d'entiers à une seule dimension, d'une longueur minimale de 7 cellules (donc avec un dim tableau%(6) ).

Au retour, les 7 premières cellules du tableau seront chargées comme suit:
(0) = nombre de valeurs retournées (6 dans ce cas) sans compter ce compteur
(1) = LEFT de la fenêtre
(2) = TOP de la fenêtre
(3) = RIGHT de la fenêtre
(4) = BOTTOM de la fenêtre
(5) = WIDTH de la fenêtre
(6) = HEIGHT de la fenêtre

Le programme de démo précédent a été étendu pour montrer l'usage de cette fonction:

Code:: dim x32%,a32%, s$, x32bis%
dim anom%, nom$, i%, j%, type%, dimensions%(2), f32
dim types$(9), t32%, a32e%, dumpit%

dumpit% = 0 : ' mettre à 1 pour obtenir un dump décimal
' adr()-12 = adresse du nom
' adr()-8 = type 1=integer 2=string 3=flottant
' type+3 = tableau
' si tableau
' type=4:, adr()+44 = nombre d'éléments
' type=5:, adr()+48 = nombre d'éléments
' type=6:, adr()+52 = nombre d'éléments
' type=7:, adr()+44 et +56 = nombre d'éléments
' type=8:, adr()+48 = nombre d'éléments
' type=9:, adr()+52 = nombre d'éléments
' adr()-4 = ?
' les données:
' type=1: 32 bits à adr()
' type=2: adresse du string à adr()+4
' type=3: 64 bits à adr()+12

' Les données des tableaux linéaires sont stockées après la table des symboles.
' La marque est la suite (818,1,201) commençant à une limite de case de la
' table de symboles (multiples de 20). Il suffit donc de chercher 818 tous les
' 20 mots de 32 bits (80 octets) pour trouver le début.
' adr()+20 donne l'offset par rapport au début de cette zone pour le premier
' élément. L'offset adr()+44 donne le nombre de cellules.

' dim a1%,test%,a2%,t1%
' dim a1%,test$,a2%,t2%
' dim a1%,test,a2%,t3%
dim a1%,test%(18),testbis%(5),a2%,t4%
' dim a1%,test$(18),a2%,t5%
' dim a1%,test(18),a2%,t6%
' dim a1%,test%(18,36),a2%,t7%
' dim a1%,test$(18,36),a2%,t8%
' dim a1%,test(18,36),a2%,t9%

data "int","str","flo","int()","str()","flo()","int(,)","str(,)","flo(,)"
for i%=1 to 9
read types$(i%)
next i%

height 0,600 : left 0,200 : top 0,50

a1% = 378
if variable("t1%")=1 then test% = 765
if variable("t2%")=1 then test$ = "abcde"
if variable("t3%")=1 then test = 2
if variable("t4%")=1 then test%(0)= 12345 : test%(1)= 23456 : testbis%(0)=98765
if variable("t5%")=1 then test$(0)= "abcde" : test$(1)= "ABC"
if variable("t7%")=1 then test%(0,0)= 12345 : test%(1,0)= 23456
a2% = 498

memo 1 : top 1,10 : left 1,10 : height 1,500 : bar_vertical 1
a32% = adr(a1%)-12
for i%=0 to 20*3+5
get32(a32%)
item_add 1,str$(i%*4)+": "+str$(a32%)+"="+str$(x32%)
a32% = a32% + 4
next i%

memo 2 : top 2,10 : left 2,300 : height 2,500 : bar_vertical 2
a32% = adr(a1%) : ' on donne ici l'adresse de la première variable à tester
for i%=1 to 4 : ' la limite haute est le nombre de variables à parcourir
getnom(a32%)
gettype(a32%)
item_add 2,str$(a32%)
s$ = s$ + " "+types$(type%)
if dimensions%(1)>0 then s$ = s$ + " "+str$(dimensions%(1))
if dimensions%(2)>0 then s$ = s$ + ","+str$(dimensions%(2))
if dimensions%(0)=1 then s$ = s$ + " éléments"
item_add 2,s$
if dimensions%(0)=0
select type%
case 1
get32(a32%)
item_add 2," valeur="+str$(x32%)
case 2
get32(a32%+4)
getstr(x32%)
item_add 2," valeur="+s$
case 3
get64(a32%)
item_add 2," valeur="+str$(f32)
case 4
findelements(a32%)
for j%=0 to dimensions%(1)-1
get32(a32e%+j%*4)
item_add 2," value "+str$(j%)+"="+str$(x32%)
next j%
end_select
end_if
a32% = a32% + 80
next i%

if dumpit%=1
findt32(adr(a1%)-8192,adr(a1%)+8192)
dump(adr(a1%)-8192,adr(a1%)+8192)
end_if

' ****************************************************************
' *********** application pour uune fonction de DLL **************
' ****************************************************************
findelements(adr(a1%)+80)
item_add 2,"**** "+str$(a32e%)
dll_on "KGF.dll"
i% = dll_call2("GetFormMetricsEX",handle(0),a32e%)
dll_off
item_add 2,"Pour form 0:"
item_add 2,"nombre de résultats: "+str$(test%(0))
item_add 2,"left: "+str$(test%(1))
item_add 2,"top: "+str$(test%(2))
item_add 2,"right: "+str$(test%(3))
item_add 2,"bottom: "+str$(test%(4))
item_add 2,"width: "+str$(test%(5))
item_add 2,"height: "+str$(test%(6))

end

sub findelements(a%)
dim_local k%, off%
get32(a%+20)
off% = x32%
k% = a% - 12 + 80
get32(k%)
while x32%<>818
k% = k% + 80
get32(k%)
end_while
a32e% = k% + 12 + off%*4
end_sub

sub get64(a%)
dim_local j%
for j%=0 to 7
poke adr(f32)+j%,peek(a%+12+j%)
next j%
end_sub

sub gettype(a%)
get32(a%-8)
type% = x32%
dimensions%(0) = 0
dimensions%(1) = 0
dimensions%(2) = 0
if type%>3
dimensions%(1) = 1
select type%
case 4: get32(a%+44)
case 5: get32(a%+48)
case 6: get32(a%+52)
case 7: get32(a%+44)
case 8: get32(a%+48)
case 9: get32(a%+52)
end_select
dimensions%(1) = x32%
if type%>6
select type%
case 7: get32(a%+56)
case 8: get32(a%+60)
case 9: get32(a%+64)
end_select
dimensions%(2) = x32%
end_if
end_if
end_sub

sub getnom(a%)
dim_local a1%
a1% = a% - 12
get32(a1%)
a1% = x32%
getstr(a1%)
end_sub

sub get32(a%)
poke adr(x32%),peek(a%)
poke adr(x32%)+1,peek(a%+1)
poke adr(x32%)+2,peek(a%+2)
poke adr(x32%)+3,peek(a%+3)
end_sub

sub getstr(a%)
dim_local i% : i% = a%
dim_local b%
s$ = ""
b% = peek(i%)
while b%<>0
s$ = s$ + chr$(b%)
i% = i% + 1
b% = peek(i%)
end_while
end_sub

sub dump(xa1%,xa2%)
dim_local j%
item_add 1,"Dump:"
for j%=xa1% to xa2% step 4
get32(j%)
BinToAscii(j%)
if x32%=12345
s$ = s$ + " <==="
else
if x32%<>0
if x32%=t32%
s$ = s$ + " <==="
end_if
end_if
end_if
item_add 1,str$(j%)+": "+str$(x32%)+"="+s$
next j%
item_add 1,"End Dump"
end_sub

sub findt32(xa1%,xa2%)
dim_local j%
item_add 1,"Search 1"
t32% = 0
for j%=xa1% to xa2% step 4
get32(j%)
if x32%=12345
item_add 2,"> "+str$(j%)+": 12345"
t32% = j%
exit_for
end_if
next j%
item_add 1,"End Search 1"
item_add 1,"Search 2"
if t32%<>0
for j%=xa1% to xa2% step 4
get32(j%)
if x32%=t32%
item_add 2,"* "+str$(j%)+": "+str$(x32%)
item_add 2,"* offset="+str$(t32%-adr(a1%))
item_add 1,"End Search 2"
exit_sub
end_if
next j%
end_if
item_add 1,"End Search 2"
end_sub

sub BinToAscii(a%)
dim_local c%, j%
s$ = ""
for j%=0 to 3
c% = peek(a%+j%)
if c%<32
s$ = s$ + "."
else
s$ = s$ + chr$(c%)
end_if
next j%
end_sub

C'est la procédure findelements() en collaboration avec la procédure get32() qui effectue la tâche de trouver l'adresse des données du tableau test%(19) dont les cellules de 0 à 6 seront utilisées. Prochainement, je mettrai à disposition une fonction Panoramic optimisée pour faire cela, ainsi qu'une fonction DLL simple et plus rapide pour faire la même chose.

Cela ouvre de nouveaux horizons. On peut retourner ainsi un nombre quelconque de résultats, et le principe est extensible aux chaînes de caractères. On peut aussi précharger un tel tableau avec toute une série de valeurs, puis appeler une fonction DLL qui sera ainsi affranchie de la limite des 6 paramètres maximum. Et même mieux: on peut ainsi avoir des fonctions DLL avec un nombre de paramètres variables ! Il suffit de respecter la convention de placer le nombre de paramètres dans la cellule d'indice 0, le premier paramètre dans (1), etc, et on peut appeler la même fonction avec 1,2,7,23 paramètres... Je pense par exemple à une fonction déterminant la valeur maximale d'une série de nombres, des moyennes, des valeurs statistiques, ...

Sujet: Re: Pic et Poc, les joyeux drilles Dim 14 Oct 2012 - 6:08

Les perspectives sont en effet énorme et les possibilité avec ta DLL le sont aussi... je sens que l'on va avoir quelques nouvelles versions Wink

Sujet: Re: Pic et Poc, les joyeux drilles Dim 14 Oct 2012 - 12:05

Voici une version du programme de démo, avec une procédure réutilisable ailleurs pour trouver l'adresse des données d'un tableau. Le principe est le suivant:
- sur une ligne de dim, on déclare une variable bidon, puis le tableau uni-dimensionnel dont on veut accéder les données. Exemple:
dim bidon%, montableau%(23) : ' 24 éléments disponibles
- on appelle la procédure adr_array() avec adr(bidon%) comme paramètre. Exemple:
adr_array(adr(bidon%))
- au retour, la variable adr_array% est définie et contient l'adresse de l'élément montableau%(0). On peut utiliser cette variable dns un appel à une dll, à la place de adr(montableau%()) qui malheureusement de passe pas au niveau de la syntaxe. Exemple:
res% = dll_call1("MaFonction",adr_array%)
La fonction de la DLL a accès aux données du tableau, en entrée et en sortie. Mais attention: il faut s'assurer que le programme Panoramic et la fonction de la DLL s'entendent sur le nombre d'éléments utilisables. Sinon, il est facile de toucher à des zones mémoire au-delà de l'espace véritablement réservé au tableau et cela peut produire des effets désastreux ! Il est donc vivement conseillé d'utiliser l'élément 0 du tableau pour indiquer le nombre d'éléments accessibles au-delà de l'élément 0. Cette valeur est donc inférieur ou égale à la dimension du tableau.

Un exemple complet:

Code:: dim res%,tableau%(23) : ' tableau de 24 cases dont 23 sont utilisables
adr_array(adr(res%)) : ' crée la variable adr_array% contenant l'adresse de l'élément (0)
dll_on "..."
tableau%(0) = 23 : ' signaler la limite à la DLL
dll_call1("MaFonction",adr_array%) : ' MaFonction peut utiliser les données de tableau% en entrée et sortie
...
' *************************************************************************
' ****** procédure pour trouver l'adresse d'un tableau à 1 dimension ******
' *************************************************************************
sub adr_array(pseudo%)
if variable("adr_array%")=0 then dim adr_array%
dim_local a%, k%, off%, v32%
a% = pseudo% + 80+20
poke adr(v32%),peek(a%)
poke adr(v32%)+1,peek(a%+1)
poke adr(v32%)+2,peek(a%+2)
poke adr(v32%)+3,peek(a%+3)
off% = v32%
k% = pseudo% - 12 + 80
poke adr(v32%),peek(k%)
poke adr(v32%)+1,peek(k%+1)
poke adr(v32%)+2,peek(k%+2)
poke adr(v32%)+3,peek(k%+3)
while (v32%<>818) and (v32%<>819)
item_add 2,str$(k%)+"="+str$(v32%)
' if k%>150520792
' message "oups: "+str$(k%)+" "+str$(v32%)
' k% = 150520792-12-off%*4
' exit_while
' end_if
k% = k% + 80
poke adr(v32%),peek(k%)
poke adr(v32%)+1,peek(k%+1)
poke adr(v32%)+2,peek(k%+2)
poke adr(v32%)+3,peek(k%+3)
end_while
adr_array% = k% + 12 + off%*4
end_sub
' *************************************************************************
' *************************** fin ***************************************
' *************************************************************************

Et voici le code complet du programme de démo adapté de cette manière:

Code:: ' *************************************************************************
' ****** procédure pour trouver l'adresse d'un tableau à 1 dimension ******
' *************************************************************************
sub adr_array(pseudo%)
if variable("adr_array%")=0 then dim adr_array%
dim_local a%, k%, off%, v32%
a% = pseudo% + 80+20
poke adr(v32%),peek(a%)
poke adr(v32%)+1,peek(a%+1)
poke adr(v32%)+2,peek(a%+2)
poke adr(v32%)+3,peek(a%+3)
off% = v32%
k% = pseudo% - 12 + 80
poke adr(v32%),peek(k%)
poke adr(v32%)+1,peek(k%+1)
poke adr(v32%)+2,peek(k%+2)
poke adr(v32%)+3,peek(k%+3)
while (v32%<>818) and (v32%<>819)
item_add 2,str$(k%)+"="+str$(v32%)
' if k%>150520792
' message "oups: "+str$(k%)+" "+str$(v32%)
' k% = 150520792-12-off%*4
' exit_while
' end_if
k% = k% + 80
poke adr(v32%),peek(k%)
poke adr(v32%)+1,peek(k%+1)
poke adr(v32%)+2,peek(k%+2)
poke adr(v32%)+3,peek(k%+3)
end_while
adr_array% = k% + 12 + off%*4
end_sub
' *************************************************************************
' *************************** fin ***************************************
' *************************************************************************

Sujet: Re: Pic et Poc, les joyeux drilles Dim 14 Oct 2012 - 14:01

J'ai ajouté une fonction ArrayAddress à KGF.dll qui passe donc à
1.72 14/10/2012 ajout fonction ArrayAddress

Cette fonction peut retourner l'adresse de l'élément 0 d'un tableau uni-dimensionnel d'entiers. La doc est mise à jour (dans les fonctions diverses). Le programme de démo ci-dessus contienr une variable au début dont la valeur gère son mode de fonctionnement:
AdrParDLL%=0 ==> on utilise la procédure adr_array()
AdrParDLL%=1 ==> on utilise la fonction ArrayAddress() de KGF.dll

Cette fonction fait exactement la même chose que la procédure adr_array, mais elle est beaucoup plus rapide.

EDIT

Encore plus for!
J'ai ajouté une fonction FindArrayAddress à KGF.dll qui passe donc à
1.73 14/10/2012 ajout fonction ArrayAddress

Cette fontion a un paramètre supplémentaire par lequel on peut spécifier le nom du tableau recherché ! Il suffit de passer en premier paramètre l'adresse de n'importe quelle variable définie n'importe où AVANT le tableau recherché, et en second paramètre l'adresse d'une variable string contenant le nom du tableau recherché.

Voici le programme de démo adapté à cela, avec une variable permettant de choisir entre les 3 modes d'obtention de l'adresse:

Code:: ' dim a1%,test%,a2%,t1%
' dim a1%,test$,a2%,t2%
' dim a1%,test,a2%,t3%
dim a1%,test%(18),testbis%(5),a2%,t4%
' dim a1%,test$(18),a2%,t5%
' dim a1%,test(18),a2%,t6%
' dim a1%,test%(18,36),a2%,t7%
' dim a1%,test$(18,36),a2%,t8%
' dim a1%,test(18,36),a2%,t9%

dim x32%,a32%, s$, x32bis%
dim anom%, nom$, i%, j%, type%, dimensions%(2), f32
dim types$(9), t32%, a32e%, dumpit%, AdrParDLL%

dumpit% = 0 : ' mettre à 0 pour cas normall
' dumpit% = 1 : ' mettre à 1 pour obtenir un dump décimal
' AdrParDLL% = 0 : ' mettre à 0 pour trouver l'adresse par procedure adr_array
' AdrParDLL% = 1 : ' mettre à 1 pour trouver l'adresse par fonction ArrayAddress
AdrParDLL% = 2 : ' mettre à 2 pour trouver l'adresse par fonction FindArrayAddress

' adr()-12 = adresse du nom
' adr()-8 = type 1=integer 2=string 3=flottant
' type+3 = tableau
' si tableau
' type=4:, adr()+44 = nombre d'éléments
' type=5:, adr()+48 = nombre d'éléments
' type=6:, adr()+52 = nombre d'éléments
' type=7:, adr()+44 et +56 = nombre d'éléments
' type=8:, adr()+48 = nombre d'éléments
' type=9:, adr()+52 = nombre d'éléments
' adr()-4 = ?
' les données:
' type=1: 32 bits à adr()
' type=2: adresse du string à adr()+4
' type=3: 64 bits à adr()+12

' Les données des tableaux linéaires sont stockées après la table des symboles.
' La marque est la suite (818,1,201) commençant à une limite de case de la
' table de symboles (multiples de 20). Il suffit donc de chercher 818 tous les
' 20 mots de 32 bits (80 octets) pour trouver le début.
' adr()+20 donne l'offset par rapport au début de cette zone pour le premier
' élément. L'offset adr()+44 donne le nombre de cellules.

data "int","str","flo","int()","str()","flo()","int(,)","str(,)","flo(,)"
for i%=1 to 9
read types$(i%)
next i%

height 0,600 : left 0,200 : top 0,50

a1% = 378
if variable("t1%")=1 then test% = 765
if variable("t2%")=1 then test$ = "abcde"
if variable("t3%")=1 then test = 2
if variable("t4%")=1 then test%(0)= 12345 : test%(1)= 23456 : testbis%(0)=98765
if variable("t5%")=1 then test$(0)= "abcde" : test$(1)= "ABC"
if variable("t7%")=1 then test%(0,0)= 12345 : test%(1,0)= 23456
a2% = 498

memo 1 : top 1,10 : left 1,10 : height 1,500 : bar_vertical 1
a32% = adr(a1%)-12
for i%=0 to 20*3+5
get32(a32%)
item_add 1,str$(i%*4)+": "+str$(a32%)+"="+str$(x32%)
a32% = a32% + 4
next i%

memo 2 : top 2,10 : left 2,300 : height 2,500 : bar_vertical 2
a32% = adr(a1%) : ' on donne ici l'adresse de la première variable à tester
for i%=1 to 4 : ' la limite haute est le nombre de variables à parcourir
getnom(a32%)
gettype(a32%)
item_add 2,str$(a32%)
s$ = s$ + " "+types$(type%)
if dimensions%(1)>0 then s$ = s$ + " "+str$(dimensions%(1))
if dimensions%(2)>0 then s$ = s$ + ","+str$(dimensions%(2))
if dimensions%(0)=1 then s$ = s$ + " éléments"
item_add 2,s$
if dimensions%(0)=0
select type%
case 1
get32(a32%)
item_add 2," valeur="+str$(x32%)
case 2
get32(a32%+4)
getstr(x32%)
item_add 2," valeur="+s$
case 3
get64(a32%)
item_add 2," valeur="+str$(f32)
case 4
findelements(a32%)
for j%=0 to dimensions%(1)-1
get32(a32e%+j%*4)
item_add 2," value "+str$(j%)+"="+str$(x32%)
next j%
end_select
end_if
a32% = a32% + 80
next i%

if dumpit%=1
findt32(adr(a1%)-8192,adr(a1%)+8192)
dump(adr(a1%)-8192,adr(a1%)+8192)
end_if

' ****************************************************************
' ************ application pour une fonction de DLL **************
' ****************************************************************
dll_on "KGF.dll"

select AdrParDLL%
case 0
adr_array(adr(a1%))
case 1
dim adr_array%
adr_array% = dll_call1("ArrayAddress",adr(a1%))
case 2
dim adr_array%
s$ = "test%"
adr_array% = dll_call2("FindArrayAddress",adr(a1%),adr(s$))
if adr_array%=0 then message "Le tableau est introuvable"
end_select

item_add 2,"**** "+str$(adr_array%)
i% = dll_call2("GetFormMetricsEX",handle(0),adr_array%)
item_add 2,"Pour form 0:"
item_add 2,"nombre de résultats: "+str$(test%(0))
item_add 2,"left: "+str$(test%(1))
item_add 2,"top: "+str$(test%(2))
item_add 2,"right: "+str$(test%(3))
item_add 2,"bottom: "+str$(test%(4))
item_add 2,"width: "+str$(test%(5))
item_add 2,"height: "+str$(test%(6))

dll_off
end

' *************************************************************************
' ****** procédure pour trouver l'adresse d'un tableau à 1 dimension ******
' *************************************************************************
sub adr_array(pseudo%)
if variable("adr_array%")=0 then dim adr_array%
dim_local a%, k%, off%, v32%
a% = pseudo% + 80+20
poke adr(v32%),peek(a%)
poke adr(v32%)+1,peek(a%+1)
poke adr(v32%)+2,peek(a%+2)
poke adr(v32%)+3,peek(a%+3)
off% = v32%
k% = pseudo% - 12 + 80
poke adr(v32%),peek(k%)
poke adr(v32%)+1,peek(k%+1)
poke adr(v32%)+2,peek(k%+2)
poke adr(v32%)+3,peek(k%+3)
while (v32%<>818) and (v32%<>819)
item_add 2,str$(k%)+"="+str$(v32%)
' if k%>150520792
' message "oups: "+str$(k%)+" "+str$(v32%)
' k% = 150520792-12-off%*4
' exit_while
' end_if
k% = k% + 80
poke adr(v32%),peek(k%)
poke adr(v32%)+1,peek(k%+1)
poke adr(v32%)+2,peek(k%+2)
poke adr(v32%)+3,peek(k%+3)
end_while
adr_array% = k% + 12 + off%*4
end_sub
' *************************************************************************
' *************************** fin ***************************************
' *************************************************************************

sub findelements(a%)
dim_local k%, off%
get32(a%+20)
off% = x32%
k% = a% - 12 + 80
get32(k%)
while x32%<>818
k% = k% + 80
get32(k%)
end_while
a32e% = k% + 12 + off%*4
end_sub

sub get64(a%)
dim_local j%
for j%=0 to 7
poke adr(f32)+j%,peek(a%+12+j%)
next j%
end_sub

sub gettype(a%)
get32(a%-8)
type% = x32%
dimensions%(0) = 0
dimensions%(1) = 0
dimensions%(2) = 0
if type%>3
dimensions%(1) = 1
select type%
case 4: get32(a%+44)
case 5: get32(a%+48)
case 6: get32(a%+52)
case 7: get32(a%+44)
case 8: get32(a%+48)
case 9: get32(a%+52)
end_select
dimensions%(1) = x32%
if type%>6
select type%
case 7: get32(a%+56)
case 8: get32(a%+60)
case 9: get32(a%+64)
end_select
dimensions%(2) = x32%
end_if
end_if
end_sub

sub getnom(a%)
dim_local a1%
a1% = a% - 12
get32(a1%)
a1% = x32%
getstr(a1%)
end_sub

sub get32(a%)
poke adr(x32%),peek(a%)
poke adr(x32%)+1,peek(a%+1)
poke adr(x32%)+2,peek(a%+2)
poke adr(x32%)+3,peek(a%+3)
end_sub

sub getstr(a%)
dim_local i% : i% = a%
dim_local b%
s$ = ""
b% = peek(i%)
while b%<>0
s$ = s$ + chr$(b%)
i% = i% + 1
b% = peek(i%)
end_while
end_sub

sub dump(xa1%,xa2%)
dim_local j%
item_add 1,"Dump:"
for j%=xa1% to xa2% step 4
get32(j%)
BinToAscii(j%)
if x32%=12345
s$ = s$ + " <==="
else
if x32%<>0
if x32%=t32%
s$ = s$ + " <==="
end_if
end_if
end_if
item_add 1,str$(j%)+": "+str$(x32%)+"="+s$
next j%
item_add 1,"End Dump"
end_sub

sub findt32(xa1%,xa2%)
dim_local j%
item_add 1,"Search 1"
t32% = 0
for j%=xa1% to xa2% step 4
get32(j%)
if x32%=12345
item_add 2,"> "+str$(j%)+": 12345"
t32% = j%
exit_for
end_if
next j%
item_add 1,"End Search 1"
item_add 1,"Search 2"
if t32%<>0
for j%=xa1% to xa2% step 4
get32(j%)
if x32%=t32%
item_add 2,"* "+str$(j%)+": "+str$(x32%)
item_add 2,"* offset="+str$(t32%-adr(a1%))
item_add 1,"End Search 2"
exit_sub
end_if
next j%
end_if
item_add 1,"End Search 2"
end_sub

sub BinToAscii(a%)
dim_local c%, j%
s$ = ""
for j%=0 to 3
c% = peek(a%+j%)
if c%<32
s$ = s$ + "."
else
s$ = s$ + chr$(c%)
end_if
next j%
end_sub

Maintenant, cela me semble complet et exploitable.

Sujet: Re: Pic et Poc, les joyeux drilles Lun 15 Oct 2012 - 7:23

Bravo Klaus !

Pic et Poc, les joyeux drilles - Page 2 18

Je vais regarder exactement comment tu as fait, j'ai pas trop eu le temps jusqu'à présent... Smile

Sujet: Re: Pic et Poc, les joyeux drilles Lun 15 Oct 2012 - 9:42

Pour les amateurs de Delphi, voici comment j'ai fait ma fonction FindArrayAddress:

Code:: // Cette fonction retourne l'adresse de l'élément 0 d'un tableau à 1 dimension dont la déclaration
// suit celle de la variable dont l'adresse est passée en paramètre.
{
Une case le la table de symboles des variables Panoramic a la structure suivante:
Longueur: 20 integer soit 80 octets
La première colonne donne l'offset par rapport au début du descripteur
La seconde colonne donne l'offset par rapport à adr(x)
0 -12 adresse du string contenant le nom (terminé par NUL)
4 -8 type de variable 1=int 2=str 3=flo +3=tableau 1 dim +4=tableu 2 dim
8 -4
adr(x) 12 0 donnée si type 1 (integer)
16 4 adresse du string terminé par NUL si type 2 (string)
20 8
24 12 1er mot de données sur 2 mots de 32 bits si type 3 (flottant)
28 16 2ème mot de données sur 2 mots de 32 bits si type 3 (flottant)
32 20
36 24
40 28
44 32
48 36
52 40
56 44 nombre d'éléments de première dimension si type=4 ou 7 (integer)
60 48 nombre d'éléments de première dimension si type=5 ou 8 (string)
64 52 nombre d'éléments de première dimension si type=6 ou 9 (flottant)
68 56 nombre d'éléments de seconde dimension si type=7 (integer)
72 60 nombre d'éléments de seconde dimension si type=8 (string)
76 64 nombre d'éléments de seconde dimension si type=9 (flottant)

}
function FindArrayAddress(adr:pinteger; nom:pstring):integer; stdcall; export;
var
name, temp: string;
ptr: pinteger;
off: integer;
begin
result := 0; // supposer "erreur"
name := UpperCase(nom^);
ptr := adr;
inc(ptr,-3); // pointer sur l'adresse du nom
temp := pstring(ptr)^; // prendre le nom de la variable
while temp<>name do begin // chercher la variable demandée
inc(ptr,20); // apasser à la var"iable suivante
if ptr^=0 then exit; // fin de table ? non trouvé !
temp := pstring(ptr)^; // prendre le nom de la variable suivante
end;
inc(ptr); // pointer sur le type de variable
if ptr^<>4 then exit; // pas type 4 (integer array) ? non trouvé !
inc(ptr,7); // pointer sur le offset
off := ptr^; // et le mémoriser
inc(ptr,12); // dépasser ce descripteur
while (ptr^<>818) and (ptr^<>819) do inc(ptr,20); // 80 octets: pointer au début du descripteur suivant
inc(ptr,3+off); // 12+off*4: adresse de l'élément (0)
result := integer(ptr);
end;

Sujet: Re: Pic et Poc, les joyeux drilles Lun 15 Oct 2012 - 11:07

Bravo et merci ! Je vais étudier tout cela attentivement ... C'est un bon exercice sur les pointeurs Smile

Pour faire des statistiques, il faudrait pouvoir accèder à des tableaux de réels.

Peut-être le compilateur le permettra-t-il ?

Sujet: Re: Pic et Poc, les joyeux drilles Lun 15 Oct 2012 - 15:30

Je suis en train de le faire. J'allais mettre cela en ligne, et j'ai fait une modif qui sème la pagaille. Je rectifie et je mets en ligne. Cela fonctionnera de façon identique aux tableaux des entiers. Il suffira de spécifier le nom d'un tableau de valeurs flottantes à FindArrayAddress pour récupérer l'adresse du début de la zone allouée. Notons que chaque élément prend 64 bits (2 mots de 32 bits).

Ce sera dispo bientôt !

Sujet: Re: Pic et Poc, les joyeux drilles Lun 15 Oct 2012 - 23:06

C'est fait: on a accès aux tableaux d'entiers ET de flottants ! Du coup, KGF.dll passe à la version
1.74 15/10/2012 fontion FindArrayAddress fonctionne pour tableaux d'entiers et flottants

En apparence, rien de changé. Seulement, la fonction FindArrayAddress accepte maintenant le nom d'un tableau d'entiers ou le nom d'un tableau de flottants comme deuxième paramètre. Enfin, adr() d'une chaîne de caractères contenant ce nom, bien sûr. Et le premier paramètre reste inchangé: c'est adr() d'une variable quelconque définie AVANT le tableau ciblé. Cela peut être la toute première variable définie dans le programme, et le ou les tableaux peuvent être définis bien après - leur définition n'a pas besoin de suivre immédiatement celle de cette variable.

Voici le petit programme de démo adapté à cela, et préconfiguré pour deux tableaux de flottants dont les valeurs seront récupérées via leur adresse:

Code:: dim x32%,a32%, s$, x32bis%
dim anom%, nom$, i%, j%, type%, dimensions%(2), f32
dim types$(9), a32e%, dumpit%, AdrParDLL%, adr_array%

' *** activer une des 9 lignes suivantes pour choisir la configuration
' dim a1%,test%,a2%,t1%
' dim a1%,test$,a2%,t2%
' dim a1%,test,a2%,t3%
' dim a1%,test%(18),testbis%(5),a2%,t4%
' dim a1%,test$(18),a2%,t5%
dim a1%,test(18),testbis(5),a2%,t6%
' dim a1%,test%(18,36),a2%,t7%
' dim a1%,test$(18,36),a2%,t8%
' dim a1%,test(18,36),a2%,t9%

dll_on "KGF.dll"

' *** activer une des deux lignes suivantes pour gérer le dump
dumpit% = 0 : ' mettre à 0 pour cas normall
' dumpit% = 1 : ' mettre à 1 pour obtenir un dump décimal

' *** activer une des 3 lignes suivantes pour choisir le type de recherched d'adresse
' AdrParDLL% = 0 : ' mettre à 0 pour trouver l'adresse par procedure adr_array
' AdrParDLL% = 1 : ' mettre à 1 pour trouver l'adresse par fonction ArrayAddress
AdrParDLL% = 2 : ' mettre à 2 pour trouver l'adresse par fonction FindArrayAddress

' adr()-12 = adresse du nom
' adr()-8 = type 1=integer 2=string 3=flottant
' type+3 = tableau
' si tableau
' type=4:, adr()+44 = nombre d'éléments
' type=5:, adr()+48 = nombre d'éléments
' type=6:, adr()+52 = nombre d'éléments
' type=7:, adr()+44 et +56 = nombre d'éléments
' type=8:, adr()+48 = nombre d'éléments
' type=9:, adr()+52 = nombre d'éléments
' adr()-4 = ?
' les données:
' type=1: 32 bits à adr()
' type=2: adresse du string à adr()+4
' type=3: 64 bits à adr()+12

' Les données des tableaux linéaires sont stockées après la table des symboles.
' La marque est la suite (818,1,201) commençant à une limite de case de la
' table de symboles (multiples de 20). Il suffit donc de chercher 818 tous les
' 20 mots de 32 bits (80 octets) pour trouver le début.
' adr()+20 donne l'offset par rapport au début de cette zone pour le premier
' élément. L'offset adr()+44 donne le nombre de cellules.

data "int","str","flo","int()","str()","flo()","int(,)","str(,)","flo(,)"
for i%=1 to 9
read types$(i%)
next i%

height 0,600 : left 0,200 : top 0,50 : ' 12345=1086856320

a1% = 378
if variable("t1%")=1 then test% = 765
if variable("t2%")=1 then test$ = "abcde"
if variable("t3%")=1 then test = 12345
if variable("t4%")=1 then test%(0)= 12345 : test%(1)= 23456 : testbis%(0)=98765
if variable("t5%")=1 then test$(0)= "abcde" : test$(1)= "ABC"
if variable("t6%")=1 then test(0)= 12345 : test(1)= 23456 : testbis(0)=98765
if variable("t7%")=1 then test%(0,0)= 12345 : test%(1,0)= 23456
a2% = 498

memo 1 : top 1,10 : left 1,10 : height 1,500 : bar_vertical 1
memo 2 : top 2,10 : left 2,300 : height 2,500 : bar_vertical 2

if dumpit%=1 then dump(adr(a1%)-12,adr(a1%)+8192)
a32% = adr(a1%) : ' on donne ici l'adresse de la première variable à tester
for i%=1 to 4 : ' la limite haute est le nombre de variables à parcourir
getnom(a32%)
nom$ = s$
gettype(a32%)
item_add 2,str$(a32%)
s$ = s$ + " "+types$(type%)
if dimensions%(1)>0 then s$ = s$ + " "+str$(dimensions%(1))
if dimensions%(2)>0 then s$ = s$ + ","+str$(dimensions%(2))
if dimensions%(0)=1 then s$ = s$ + " éléments"
item_add 2,s$
if dimensions%(0)=0
select type%
case 1: ' integer
get32(a32%)
item_add 2," valeur="+str$(x32%)
case 2: ' string
get32(a32%+4)
getstr(x32%)
item_add 2," valeur="+s$
case 3: ' flottant
get64(a32%)
item_add 2," valeur="+str$(f32)
case 4: ' tableau integer 1 dimension
findelements(a32%)
for j%=0 to dimensions%(1)-1
get32(a32e%+j%*4)
item_add 2," valeur "+str$(j%)+"="+str$(x32%)
next j%
case 5: ' tableau string 1 dimension à venir
case 6: ' tableau flottant 1 dimension
if AdrParDLL%=2
adr_array% = dll_call2("FindArrayAddress",adr(a1%),adr(nom$))
item_add 2,"tableau flottant "+nom$+" à "+str$(adr_array%)
for j%=0 to dimensions%(1)-1
' get64tableau(adr_array%+j%*8)
get64(adr_array%+j%*8-12)
item_add 2," valeur "+str$(j%)+"="+str$(f32)
next j%
end_if
end_select
end_if
a32% = a32% + 80
next i%

' ****************************************************************
' ************ application pour une fonction de DLL **************
' ****************************************************************
select AdrParDLL%
case 0
adr_array(adr(a1%))
case 1
dim adr_array%
adr_array% = dll_call1("ArrayAddress",adr(a1%))
case 2
if variable("t2%")=1
if variable("adr_array%")=0 then dim adr_array%
s$ = "test%"
adr_array% = dll_call2("FindArrayAddress",adr(a1%),adr(s$))
if adr_array%=0 then message "Le tableau est introuvable"
end_if
end_select

item_add 2,"**** "+str$(adr_array%)
if variable("t4%")=1
i% = dll_call2("GetFormMetricsEX",handle(0),adr_array%)
item_add 2,"Pour form 0:"
item_add 2,"nombre de résultats: "+str$(test%(0))
item_add 2,"left: "+str$(test%(1))
item_add 2,"top: "+str$(test%(2))
item_add 2,"right: "+str$(test%(3))
item_add 2,"bottom: "+str$(test%(4))
item_add 2,"width: "+str$(test%(5))
item_add 2,"height: "+str$(test%(6))
end_if

' test_local()

dll_off
end

' *************************************************************************
' ****** procédure pour trouver l'adresse d'un tableau à 1 dimension ******
' *************************************************************************
sub adr_array(pseudo%)
if variable("adr_array%")=0 then dim adr_array%
dim_local a%, k%, off%, v32%
a% = pseudo% + 80+20
poke adr(v32%),peek(a%)
poke adr(v32%)+1,peek(a%+1)
poke adr(v32%)+2,peek(a%+2)
poke adr(v32%)+3,peek(a%+3)
off% = v32%
k% = pseudo% - 12 + 80
poke adr(v32%),peek(k%)
poke adr(v32%)+1,peek(k%+1)
poke adr(v32%)+2,peek(k%+2)
poke adr(v32%)+3,peek(k%+3)
while (v32%<>818) and (v32%<>819)
item_add 2,str$(k%)+"="+str$(v32%)
' if k%>150520792
' message "oups: "+str$(k%)+" "+str$(v32%)
' k% = 150520792-12-off%*4
' exit_while
' end_if
k% = k% + 80
poke adr(v32%),peek(k%)
poke adr(v32%)+1,peek(k%+1)
poke adr(v32%)+2,peek(k%+2)
poke adr(v32%)+3,peek(k%+3)
end_while
adr_array% = k% + 12 + off%*4
end_sub
' *************************************************************************
' *************************** fin ***************************************
' *************************************************************************
sub test_local()
dim_local essai%
getnom(adr(essai%))
item_add 2,"variable locale: "+s$
get32(adr(essai%)-8)
item_add 2," de type "+str$(x32%)
end_sub

sub findelements(a%)
dim_local k%, off%
get32(a%+20)
off% = x32%
k% = a% - 12 + 80
get32(k%)
while x32%<>818
k% = k% + 80
get32(k%)
end_while
a32e% = k% + 12 + off%*4
end_sub

sub get64(a%)
dim_local j%
for j%=0 to 7
poke adr(f32)+j%,peek(a%+12+j%)
next j%
end_sub

sub get64tableau(a%)
dim_local j%
for j%=0 to 7
poke adr(f32)+j%,peek(a%+j%)
next j%
end_sub

sub gettype(a%)
get32(a%-8)
type% = x32%
dimensions%(0) = 0
dimensions%(1) = 0
dimensions%(2) = 0
if type%>3
dimensions%(1) = 1
select type%
case 4: get32(a%+44)
case 5: get32(a%+48)
case 6: get32(a%+52)
case 7: get32(a%+44)
case 8: get32(a%+48)
case 9: get32(a%+52)
end_select
dimensions%(1) = x32%
if type%>6
select type%
case 7: get32(a%+56)
case 8: get32(a%+60)
case 9: get32(a%+64)
end_select
dimensions%(2) = x32%
end_if
end_if
end_sub

sub getnom(a%)
dim_local a1%
a1% = a% - 12
get32(a1%)
a1% = x32%
getstr(a1%)
end_sub

sub get32(a%)
poke adr(x32%),peek(a%)
poke adr(x32%)+1,peek(a%+1)
poke adr(x32%)+2,peek(a%+2)
poke adr(x32%)+3,peek(a%+3)
end_sub

sub getstr(a%)
dim_local i% : i% = a%
dim_local b%
s$ = ""
b% = peek(i%)
while b%<>0
s$ = s$ + chr$(b%)
i% = i% + 1
b% = peek(i%)
end_while
end_sub

sub dump(xa1%,xa2%)
dim_local j%
item_add 1,"Dump:"
for j%=xa1% to xa2% step 4
get32(j%)
BinToAscii(j%)
if x32%=12345
s$ = s$ + " <==="
end_if
item_add 1,str$(j%)+": "+str$(x32%)+"="+s$
next j%
item_add 1,"End Dump"
end_sub

sub BinToAscii(a%)
dim_local c%, j%
s$ = ""
for j%=0 to 3
c% = peek(a%+j%)
if c%<32
s$ = s$ + "."
else
s$ = s$ + chr$(c%)
end_if
next j%
end_sub

Et voici la routine Delphi qui fait cela:

Code:: // Cette fonction retourne l'adresse de l'élément 0 d'un tableau à 1 dimension dont la déclaration
// suit celle de la variable dont l'adresse est passée en paramètre.
{
Une case le la table de symboles des variables Panoramic a la structure suivante:
Longueur: 20 integer soit 80 octets
La première colonne donne l'offset par rapport au début du descripteur
La seconde colonne donne l'offset par rapport à adr(x)
0 -12 adresse du string contenant le nom (terminé par NUL)
4 -8 type de variable 1=int 2=str 3=flo +3=tableau 1 dim +4=tableu 2 dim
8 -4
adr(x) 12 0 donnée si type 1 (integer)
16 4 adresse du string terminé par NUL si type 2 (string)
20 8
24 12 1er mot de données sur 2 mots de 32 bits si type 3 (flottant)
28 16 2ème mot de données sur 2 mots de 32 bits si type 3 (flottant)
32 20 offset premier élément dans partie 818 tableau entier 1 dimension (multiple de 4)
36 24
40 28 offset premier élément dans partie 1622 tableau flottant 1 dimension (multiple de 8)
44 32
48 36
52 40
56 44 nombre d'éléments de première dimension si type=4 ou 7 (integer)
60 48 nombre d'éléments de première dimension si type=5 ou 8 (string)
64 52 nombre d'éléments de première dimension si type=6 ou 9 (flottant)
68 56 nombre d'éléments de seconde dimension si type=7 (integer)
72 60 nombre d'éléments de seconde dimension si type=8 (string)
76 64 nombre d'éléments de seconde dimension si type=9 (flottant)
La table de symboles a la structure suivante:
entête 4 mots de 32 bits
0 0 (poids fort de la longueur de la table ?)
4 longueur de la table = nombre de variables * 80 + 14
8 1
12 nombre de variables (y copris la case vide)
vide 1 case vide de 20 mots de 32 bits
système liste de cases des variables système, chacune de 20 mots de 32 bits
application liste de cases des variables application, chacune de 20 mots de 32 bits
}
function FindArrayAddress(adr:pinteger; nom:pstring):integer; stdcall; export;
var
name, temp: string;
ptr: pinteger;
off, typ: integer;
begin
result := 0; // supposer "erreur"
name := UpperCase(nom^);
typ := 6; // supposer "flottant" (ni % ni $)
if RightStr(name,1)='%' then typ := 4;
if RightStr(name,1)='$' then typ := 5;
ptr := adr;
inc(ptr,-3); // pointer sur l'adresse du nom
temp := pstring(ptr)^; // prendre le nom de la variable
while temp<>name do begin // chercher la variable demandée
inc(ptr,20); // passer à la variable suivante
if ptr^=0 then exit; // fin de table ? non trouvé !
temp := pstring(ptr)^; // prendre le nom de la variable suivante
end;
inc(ptr); // pointer sur le type de variable
if ptr^<>typ then exit; // pas du type array du nom de la variable ? non trouvé !
case typ of
4: begin
inc(ptr,7); // pointer sur le offset
off := ptr^; // et le mémoriser
inc(ptr,12); // dépasser ce descripteur
end;
5: begin
end;
6: begin
inc(ptr,9); // pointer sur le offset
off := ptr^; // et le mémoriser
inc(ptr,10); // dépasser ce descripteur
end;
end;
case typ of
4: begin
while (ptr^<>0) do inc(ptr,20); // 80 octets: pointer au début du descripteur suivant
while (ptr^<>818) and (ptr^<>819) do inc(ptr); // chercher en mémoire
inc(ptr,3+off); // 12+off*4: adresse de l'élément (0)
end;
6: begin
while (ptr^<>0) do inc(ptr,20); // 80 octets: pointer au début du descripteur suivant
while (ptr^<>1622) do inc(ptr); // chercher en mémoire
inc(ptr,3+off*2); // 12+off*4*2: adresse de l'élément (0)
end
end;
result := integer(ptr);
end;

Je pense que pour un lien avec une DLL, que ce qoit en Delphi ou en FreeBasic, les tableaux uni-dimensionnels d'entiers et de flottants suffisent. On n'a pas besoin de tableaux bi-dimensionnels qui posent d'autres problèmes, et on n'a pas besoin nom plus de tableaux de chaînes de caractères. De toutes façons, on peut déjà maintenant passer une chaîne de caractères via adr(), pourvu que ses données soient préchargées à la bonne longueur. Et c'est suffisant.

EDIT

La doc a été mise à jour aussi - fonction FindArrayAddress dans la section des fonctions diverses.

NOTE IMPORTANTE

J'ai bien conscience que cette fonction est étroitement liée à l'implémentation actuelle de Panoramic, et plus précisément la version V0.24i4. Je n'ai pas testé avec les versions précédentes, bien qu'il soit fortement probable que cela marche aussi. Pas mon programme de démo, mais la fonction de la DLL, c'est ce qui compte.

Par contre, il faudra revérifier avec chaque nouvelle version et éventuellement adapter le tir. Et en particulier, il y a un point faible dans le mécanisme. C'est la recherche du début de la section des données pour des tableaux d'entiers, et du début de la section pour les tableaux de flottants. Ce n'est pas stocké au même endroit. Je le reconnais par une valeur décimale de 818 ou 819 pour les entiers, suivant la dernière cellule de la table de symboles, et 1622 pour les flottants. Je ne connais pas la signification de ces valeurs, et rien ne garantit que ces valeurs restent inchangées dans des versions futures. Je vérifierai chaque fois pour ajuster le programme.

La grande inconnue, ce sera le passage à la version basée sur FreeBasic. J'ai l'espoir que cette gymnastique ne sera plus nécessaire et qu'on pourra obtenir l'adresse de ces données par un moyen natif. Dans ce cas, je retirerai mes routines avec une grande satisfaction. D'ici là, FindArrayAddress a une utilité énorme pour tout ceux qui veulent accéder des fonctions API, des fonctions statistiques, financières, et j'en passe.

Prochainement, il y aura un ajout dans KGF_SUB pour gérer cela de façon plus conviviale.

Sujet: Re: Pic et Poc, les joyeux drilles Mar 16 Oct 2012 - 1:09

Maitre es DLL, BRAVO pour ce travail minutieux! Pic et Poc, les joyeux drilles - Page 2 Dix-sur-dix

Sujet: Re: Pic et Poc, les joyeux drilles Mar 16 Oct 2012 - 1:20

Merci !

J'ai la chance d'avoir le temps de le faire. Et comme je suis un vrai fan de Panoramic, je cherche à lui ajouter, avec mes petits moyens, des fonctionnalités qui peuvent le faire jouer dans une autre catégorie. Mais malheureusement, cela reste de l'amateurisme. Je n'ai pas accès à l'allocation des variables (ce qui est gênant pour les chaînes de caractères, aux adresses des routines et labels, aux mots-clé, ... C'est vrai que j'aimerais vraiment avoir accès à un mécanisme de plug-in. Mais en attendant, ma KGF.dll donne déjà on bon éventail d'extensions, et elle est appelée à croitre. Et avec le wrapper KGF_SUB.bas, on s'approche (un tout petit peu) de ce que j'aimerais faire.

» Joyeux Noël à tous !
» Joyeux Noël
» JOYEUX NOËL !!!
» JOYEUX NOEL à TOUS
» Joyeux Noël à tous