FORUM DE DISCUSSION SUR LE LANGAGE PANORAMIC

Développement d'applications avec le langage Panoramic
 
AccueilAccueil  FAQFAQ  RechercherRechercher  S'enregistrerS'enregistrer  MembresMembres  GroupesGroupes  Connexion  
Derniers sujets
» Compilateur FBPano
par jean_debord Aujourd'hui à 10:54

» demande pour recuperer un text speciale
par pascal10000 Hier à 22:04

» Casse-tête : Echanger les positions des cavaliers
par papydall Hier à 19:51

» KGF_dll - nouvelles versions
par Klaus Hier à 14:29

» Amélioration de la commande HINT
par papydall Mer 19 Juil 2017 - 3:30

» TEST SUR SHAPE
par papydall Mer 19 Juil 2017 - 1:17

» Un challenge à relever
par papydall Mar 18 Juil 2017 - 21:25

» Astuce : Indenter plusieurs lignes de code à la fois
par papydall Mar 18 Juil 2017 - 1:32

» Suggestion pour le forum
par papydall Lun 17 Juil 2017 - 20:28

» Truver les handles des onglets de Panoramic Editor
par Klaus Lun 17 Juil 2017 - 18:20

» Synedit_Editor - nouvelles versions
par Klaus Lun 17 Juil 2017 - 13:46

» Détermine si oui ou non un objet est PARENT d'un autre objet
par Klaus Dim 16 Juil 2017 - 11:58

» Une autre façon de terminer une application.
par papydall Dim 16 Juil 2017 - 3:53

» Déterminer le Handle de l’objet ayant le focus
par papydall Dim 16 Juil 2017 - 3:15

» Déterminer le HANDLE du Bureau
par papydall Dim 16 Juil 2017 - 1:59

Navigation
 Portail
 Index
 Membres
 Profil
 FAQ
 Rechercher
Rechercher
 
 

Résultats par :
 
Rechercher Recherche avancée
Juillet 2017
LunMarMerJeuVenSamDim
     12
3456789
10111213141516
17181920212223
24252627282930
31      
CalendrierCalendrier

Partagez | 
 

 Pic et Poc, les joyeux drilles

Voir le sujet précédent Voir le sujet suivant Aller en bas 
Aller à la page : Précédent  1, 2, 3, 4  Suivant
AuteurMessage
papydall

avatar

Nombre de messages : 5451
Age : 66
Localisation : Moknine (Tunisie) Entre la chaise et le clavier
Date d'inscription : 03/03/2012

MessageSujet: Re: Pic et Poc, les joyeux drilles   Ven 12 Oct 2012 - 3: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 !


Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://papydall-panoramic.forumarabia.com/
Nardo26

avatar

Nombre de messages : 2294
Age : 49
Localisation : Valence
Date d'inscription : 02/07/2010

MessageSujet: Re: Pic et Poc, les joyeux drilles   Ven 12 Oct 2012 - 5: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



Dernière édition par Nardo26 le Ven 12 Oct 2012 - 14:26, édité 1 fois (Raison : coquille...)
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://nardo26.lescigales.org
Nardo26

avatar

Nombre de messages : 2294
Age : 49
Localisation : Valence
Date d'inscription : 02/07/2010

MessageSujet: Re: Pic et Poc, les joyeux drilles   Ven 12 Oct 2012 - 14:24

@Klaus : une piste...
J'ai pratiquement donné la solution pour les tableaux... Wink
Code:
DIM a%
DIM MonTableau%(1)
InfoEntier(ADR(a%)+80)
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://nardo26.lescigales.org
Klaus

avatar

Nombre de messages : 10062
Age : 68
Localisation : Ile de France
Date d'inscription : 29/12/2009

MessageSujet: Re: Pic et Poc, les joyeux drilles   Ven 12 Oct 2012 - 19: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.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
JL35



Nombre de messages : 5890
Localisation : 77
Date d'inscription : 29/11/2007

MessageSujet: Re: Pic et Poc, les joyeux drilles   Ven 12 Oct 2012 - 19: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...
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Nardo26

avatar

Nombre de messages : 2294
Age : 49
Localisation : Valence
Date d'inscription : 02/07/2010

MessageSujet: Re: Pic et Poc, les joyeux drilles   Ven 12 Oct 2012 - 21: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...
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://nardo26.lescigales.org
Jicehel

avatar

Nombre de messages : 5841
Age : 44
Localisation : 77500
Date d'inscription : 19/04/2011

MessageSujet: Re: Pic et Poc, les joyeux drilles   Ven 12 Oct 2012 - 22:01

Bravo Nardo, tu touches au but. Seras-tu le Sherlock Holmes de la structure des données ? Wink
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
JL35



Nombre de messages : 5890
Localisation : 77
Date d'inscription : 29/11/2007

MessageSujet: Re: Pic et Poc, les joyeux drilles   Ven 12 Oct 2012 - 22: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...
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Klaus

avatar

Nombre de messages : 10062
Age : 68
Localisation : Ile de France
Date d'inscription : 29/12/2009

MessageSujet: Re: Pic et Poc, les joyeux drilles   Ven 12 Oct 2012 - 23: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 ?
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
Klaus

avatar

Nombre de messages : 10062
Age : 68
Localisation : Ile de France
Date d'inscription : 29/12/2009

MessageSujet: Re: Pic et Poc, les joyeux drilles   Sam 13 Oct 2012 - 12: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.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
Nardo26

avatar

Nombre de messages : 2294
Age : 49
Localisation : Valence
Date d'inscription : 02/07/2010

MessageSujet: Re: Pic et Poc, les joyeux drilles   Sam 13 Oct 2012 - 15: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 , 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...


Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://nardo26.lescigales.org
Klaus

avatar

Nombre de messages : 10062
Age : 68
Localisation : Ile de France
Date d'inscription : 29/12/2009

MessageSujet: Re: Pic et Poc, les joyeux drilles   Dim 14 Oct 2012 - 0: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 !
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
Jicehel

avatar

Nombre de messages : 5841
Age : 44
Localisation : 77500
Date d'inscription : 19/04/2011

MessageSujet: Re: Pic et Poc, les joyeux drilles   Dim 14 Oct 2012 - 0:56

Bien vu, tu as détronné le Shelock Holmes de la structure de données Wink Bravo Klaus
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
papydall

avatar

Nombre de messages : 5451
Age : 66
Localisation : Moknine (Tunisie) Entre la chaise et le clavier
Date d'inscription : 03/03/2012

MessageSujet: Re: Pic et Poc, les joyeux drilles   Dim 14 Oct 2012 - 1:27

Ce n’est pas élémentaire mon cher Watson.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://papydall-panoramic.forumarabia.com/
Klaus

avatar

Nombre de messages : 10062
Age : 68
Localisation : Ile de France
Date d'inscription : 29/12/2009

MessageSujet: Re: Pic et Poc, les joyeux drilles   Dim 14 Oct 2012 - 2: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, ...
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
Jicehel

avatar

Nombre de messages : 5841
Age : 44
Localisation : 77500
Date d'inscription : 19/04/2011

MessageSujet: Re: Pic et Poc, les joyeux drilles   Dim 14 Oct 2012 - 7: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
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Klaus

avatar

Nombre de messages : 10062
Age : 68
Localisation : Ile de France
Date d'inscription : 29/12/2009

MessageSujet: Re: Pic et Poc, les joyeux drilles   Dim 14 Oct 2012 - 13: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 ***************************************
' *************************************************************************
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
Klaus

avatar

Nombre de messages : 10062
Age : 68
Localisation : Ile de France
Date d'inscription : 29/12/2009

MessageSujet: Re: Pic et Poc, les joyeux drilles   Dim 14 Oct 2012 - 15: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.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
Nardo26

avatar

Nombre de messages : 2294
Age : 49
Localisation : Valence
Date d'inscription : 02/07/2010

MessageSujet: Re: Pic et Poc, les joyeux drilles   Lun 15 Oct 2012 - 8:23

Bravo Klaus !

Je vais regarder exactement comment tu as fait, j'ai pas trop eu le temps jusqu'à présent... Smile
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://nardo26.lescigales.org
Klaus

avatar

Nombre de messages : 10062
Age : 68
Localisation : Ile de France
Date d'inscription : 29/12/2009

MessageSujet: Re: Pic et Poc, les joyeux drilles   Lun 15 Oct 2012 - 10: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;
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
jean_debord

avatar

Nombre de messages : 734
Age : 62
Localisation : Limoges
Date d'inscription : 21/09/2008

MessageSujet: Re: Pic et Poc, les joyeux drilles   Lun 15 Oct 2012 - 12: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 ?
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://www.unilim.fr/pages_perso/jean.debord/index.htm
Klaus

avatar

Nombre de messages : 10062
Age : 68
Localisation : Ile de France
Date d'inscription : 29/12/2009

MessageSujet: Re: Pic et Poc, les joyeux drilles   Lun 15 Oct 2012 - 16: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 !
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
Klaus

avatar

Nombre de messages : 10062
Age : 68
Localisation : Ile de France
Date d'inscription : 29/12/2009

MessageSujet: Re: Pic et Poc, les joyeux drilles   Mar 16 Oct 2012 - 0: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.


Dernière édition par Klaus le Mar 16 Oct 2012 - 18:21, édité 1 fois
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
papydall

avatar

Nombre de messages : 5451
Age : 66
Localisation : Moknine (Tunisie) Entre la chaise et le clavier
Date d'inscription : 03/03/2012

MessageSujet: Re: Pic et Poc, les joyeux drilles   Mar 16 Oct 2012 - 2:09

Maitre es DLL, BRAVO pour ce travail minutieux!
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://papydall-panoramic.forumarabia.com/
Klaus

avatar

Nombre de messages : 10062
Age : 68
Localisation : Ile de France
Date d'inscription : 29/12/2009

MessageSujet: Re: Pic et Poc, les joyeux drilles   Mar 16 Oct 2012 - 2: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.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
Contenu sponsorisé




MessageSujet: Re: Pic et Poc, les joyeux drilles   

Revenir en haut Aller en bas
 
Pic et Poc, les joyeux drilles
Voir le sujet précédent Voir le sujet suivant Revenir en haut 
Page 2 sur 4Aller à la page : Précédent  1, 2, 3, 4  Suivant
 Sujets similaires
-
» Pic et Poc, les joyeux drilles
» kit rouge et or joyeux noel pour vous dire bonjour bis beauty
» Joyeux Noel !
» Joyeux Noël les gens ! <3
» JOYEUX NOEL !!!

Permission de ce forum:Vous ne pouvez pas répondre aux sujets dans ce forum
FORUM DE DISCUSSION SUR LE LANGAGE PANORAMIC :: PANORAMIC 32 bits :: Présentation et bavardage-
Sauter vers: