KGF_dll - nouvelles versions

Sujet: Re: KGF_dll - nouvelles versions Ven 28 Oct 2016 - 3:08

KGF.dll V6.87 du 28/10/2016

Nouveautés:
- nouvelle fonction: CompilePanoramicToEXE

Modules modifiés:
KGF.dll
KGF.hlp

La doc et les sources sont à jour.

Cette fonction fait ce que Panoramic_Editor fait lors de la génération d'un EXE. On peut me faire maintenant directement à partir d'un programme Panoramic, soit en code 100 % Panoramic (30 à 50 secondes, suivant la puissance de la machine), soit par l'appel de cette nouvelle fonction DLL (1 à 2 secondes).

Voici un programme de démo. Copier le source dans le mémo de gauche, puis cliquer sur "Générer". Une checkbox en haut permet de choisir d'utiliser la DLL. Par défaut, c'est Panoramic seul:

Code:: label encoder

dim nom$

full_space 0
alpha 1 : top 1,40 : left 1,10 : caption 1,"En clair:"
alpha 2 : top 2,40 : left 2,520 : caption 2,"Encodé:"
memo 11 : top 11,70 : left 11,10 : width 11,500 : height 11,600 : bar_both 11
memo 12 : top 12,70 : left 12,520 : width 12,500 : height 12,600 : bar_both 12
button 21 : top 21,690 : left 21,300 : caption 21,"Encoder" : on_click 21,encoder
progress_bar 31 : hide 31 : top 31,720 : left 31,10 : width 31,500
check 41 : top 41,10 : left 41,100 : width 41,400 : caption 41,"Exécuter avec KGF.dll"
font_size 41,16 : font_bold 41 : font_color 41,255,0,0

end

encoder:
nom$ = "ProgrammeEncode.exe"
EncoderSource(nom$)
return

sub EncoderSource()
if checked(41)=1
dim_local res%, prg$
dll_on "KGF.dll"
prg$ = param_value$(0)
if file_exists(nom$)=1 then file_delete nom$
res% = dll_call3("CompilePanoramicToEXE",adr(prg$),handle(11),adr(nom$))
message "res%="+str$(res%)
dll_off
exit_sub
end_if

dim_local tin$, tout$, prg$, i%, k%, n%, n1%, cnt%, out$
dim_local p%, s$, t$, c%, m%, vide%(64000)
dim decoder%(255)

data 0, 22, 21, 20, 19, 18, 17, 16, 31, 30, 0, 28, 27, 0, 25, 24
data 7, 6, 5, 4, 3, 2, 1, 0, 15, 14, 13, 12, 11, 10, 9, 8
data 55, 54, 53, 52, 51, 50, 49, 48, 63, 62, 61, 60, 59, 58, 57, 56
data 39, 38, 37, 36, 35, 34, 33, 32, 47, 46, 45, 44, 43, 42, 41, 40
data 87, 86, 85, 84, 83, 82, 81, 80, 95, 94, 93, 92, 91, 90, 89, 88
data 71, 70, 69, 68, 67, 66, 65, 64, 79, 78, 77, 76, 75, 74, 73, 72
data 119,118,117,116,115,114,113,112,127,126,125,124,123,122,121,120
data 103,102,101,100, 99, 98, 97, 96,111,110,109,108,107,106,105,104
data 151,150,149,148,147,146,145,144,159,158,157,156,155,154,153,152
data 135,134,133,132,131,130,129,128,143,142,141,140,139,138,137,136
data 183,182,181,180,179,178,177,176,191,190,189,188,187,186,185,184
data 167,166,165,164,163,162,161,160,175,174,173,172,171,170,169,168
data 215,214,213,212,211,210,209,208,223,222,221,220,219,218,217,216
data 199,198,197,196,195,194,193,192,207,206,205,204,203,202,201,200
data 247,246,245,244,243,242,241,240,255,254,253,252,251,250,249,248
data 231,230,229,228,227,226,225,224,239,238,237,236,235,234,233,232

for i% = 0 to 255
read decoder%(i%)
next i%

prg$ = param_value$(0)
filebin_open_read 2,prg$
m% = filebin_size(2) - 8
filebin_position 2,m%
filebin_block_read 2,4,vide%(0)
n% = 0
for i%=3 to 0 step -1
n% = n%*256 + vide%(i%)
next i%
m% = m% - n%
filebin_position 2,0

if file_exists(nom$)=1 then file_delete nom$
filebin_open_write 1,nom$
max 31,m%
position 31,m%
show 31
while 64000<=m%
filebin_block_read 2,64000,vide%(0)
filebin_block_write 1,64000,vide%(0)
m% = m% - 64000
position 31,m%
end_while
if m%>0
filebin_block_read 2,m%,vide%(0)
filebin_block_write 1,m%,vide%(0)
end_if
filebin_close 2
position 31,0
' message "phase 1 ok"

out$ = ""
clear 12
cnt% = 0
if count(11)>0
for i%=1 to count(11)
s$ = item_read$(11,i%)
t$ = ""
if len(s$)>0
for k%=1 to len(s$)
n% = asc(mid$(s$,k%,1))
t$ = t$ +chr$(decoder%(n%))
vide%(k%-1) = decoder%(n%)
next k%
end_if
item_add 12,t$
cnt% = cnt% + len(t$) + 1
n% = len(t$)
vide%(n%) = 0
filebin_block_write 1,n%+1,vide%(0)
next i%
end_if

n% = cnt%
for i%=0 to 3
c% = bin_and(n%,255)
n% = int(n%/256)
vide%(i%) = c%
next i%
vide%(4) = 51
vide%(5) = 66
vide%(6) = 46
vide%(7) = 70
filebin_block_write 1,8,vide%(0)
filebin_close 1
' message "phase 2 ok"
hide 31
end_sub

Sujet: Re: KGF_dll - nouvelles versions Ven 28 Oct 2016 - 16:16

Juste pour info, ma tour est récente et conçu pour windows 8 et +, j'ai volontairement installé windows XP pour conserver la compatibilité pour d'autre logiciel plus ancien qui fonctionne pas très bien avec un OS récent. KGF est la seule dll qui bloque l'éxécution de cette manière. L'argument de l'OS ancien n'est pas valable pour moi, car on peut remarquer que les premières versions démarrent instantanément. Cela étant dit, j'utilise la dll très occasionnellemnt, ce n'est pas génant en soi.
C'est GPP qui y gagne Very Happy

Sujet: Re: KGF_dll - nouvelles versions Mar 1 Nov 2016 - 19:26

KGF.dll V6.88 du 01/11/2016

Nouveautés:
- nouvelle fonction: ExploreRegistry

Modules modifiés:
KGF.dll
KGF.hlp

La doc et les sources sont à jour.

Cette fonction permet de vérifier si une clé existe, retourner la liste de toutes les sous-clés d'une clé, retourner la liste de toutes les valeurs d'une clé,, vérifier qu'une valeur existe et retourner les données d'une valeur.

Voici une démo, active sur l'ensemble du registre:

Code:: label exec

dim res%, root%, cle$, valeur$, donnee$, n%, ruche%
dll_on "KGF.dll"

combo 1 : top 1,10 : left 1,10 : width 1,200
item_add 1,"1 - HKEY_CLASSES_ROOT"
item_add 1,"2 - HKEY_CURRENT_CONFIG"
item_add 1,"3 - HKEY_CURRENT_USER"
item_add 1,"4 - HKEY_LOCAL_MACHINE"
item_add 1,"5 - HKEY_USERS"
alpha 2 : top 2,10 : left 2,220 : caption 2,"Clé:"
edit 3 : top 3,10 : left 3,250 : width 3,200
combo 11 : top 11,40 : left 11,10 : width 11,200
item_add 11,"0 - Tester si clé existe"
item_add 11,"1 - Retourner la liste des sous-clés"
item_add 11,"2 - Retourner la liste valeurs"
item_add 11,"3 - Tester si la valeurexiste"
item_add 11,"4 - Retourner le contenu de la valeur"
button 12 : top 12,40 : left 12,220 : caption 12,"Exécuter" : on_click 12,exec

memo 21 : top 21,70 : width 21,400 : height 21,300
end

exec:
n% = item_index(11)
if n%<1 then return
ruche% = item_index(1)
if ruche%<1 then return

select n%
case 1
cle$ = text$(3)
res% = dll_call4("ExploreRegistry",0,ruche%,adr(cle$),0)
message str$(res%)
case 2
cle$ = text$(3)
res% = dll_call4("ExploreRegistry",1,ruche%,adr(cle$),handle(21))
message str$(res%)
case 3
cle$ = text$(3)
res% = dll_call4("ExploreRegistry",2,ruche%,adr(cle$),handle(21))
message str$(res%)
case 4
cle$ = text$(3)
res% = dll_call4("ExploreRegistry",3,ruche%,adr(cle$),0)
message str$(res%)
case 5
cle$ = text$(3)
res% = dll_call4("ExploreRegistry",4,ruche%,adr(cle$),handle(21))
message str$(res%)

end_select

end

Sujet: Re: KGF_dll - nouvelles versions Mar 1 Nov 2016 - 20:04

Intéressant !
L'exemple n'est pas trop parlant pour l'instant mais j'imagine qu'il va y avoir une suite... Wink

Sujet: Re: KGF_dll - nouvelles versions Mar 1 Nov 2016 - 21:02

Ben... essaie ce que ça donne avec HKEY_CLASSES_ROOT et la clé *, puis la cle *\shell ...

Sujet: Re: KGF_dll - nouvelles versions Mar 1 Nov 2016 - 21:17

Hummm, j'imagine qu'a un moment tu vas tenter d'insérer un clé depuis le programme... drunken

Sujet: Re: KGF_dll - nouvelles versions Mar 1 Nov 2016 - 21:32

Je ne pense pas. D'ailleurs, dans la page introduisant es fonctions de gestion du registre dans KGF.chm, j'ai clairement indiqué que je ne ferai pas de mise à jour du registre, par des fonctions DLL accessibles par panoramic. Le risque est trop grand. Pour ceux qui veulent absolument le faire par programme, il reste la création d'un script en VBS ou la créatioin d'un fichier *.REG qui sera ensuite exécuté par la commande EXECUTE. Mais au moins, je ne perterai pas la responsabilité en cas de problème, qu'il soit dû à un mauvais paramétrage du programmeur ou à un bug dans mes fonctions DLL. Par contre, je voulais rendre plus aisé de parcurir de registre, et le résultat est à la hauteur de ce que je voulais faire.

Sujet: Re: KGF_dll - nouvelles versions Mer 2 Nov 2016 - 0:33

Petit rajout à ExploreRegistry, mais sans changement de version:
nouveau code fonctiion 6
Ce code retourne dans le mémo l'arborescence de l'ensemble des sous-clés et valeurs, partir d'une clé donnée.

Voici le programme de démo adapté:

Code:: ' test_ExploreRegistry.bas

label exec

dim res%, root%, cle$, valeur$, donnee$, n%, ruche%
dll_on "KGF.dll"

combo 1 : top 1,10 : left 1,10 : width 1,200
item_add 1,"1 - HKEY_CLASSES_ROOT"
item_add 1,"2 - HKEY_CURRENT_CONFIG"
item_add 1,"3 - HKEY_CURRENT_USER"
item_add 1,"4 - HKEY_LOCAL_MACHINE"
item_add 1,"5 - HKEY_USERS"
alpha 2 : top 2,10 : left 2,220 : caption 2,"Clé:"
edit 3 : top 3,10 : left 3,250 : width 3,200
combo 11 : top 11,40 : left 11,10 : width 11,200
item_add 11,"0 - Tester si clé existe"
item_add 11,"1 - Retourner la liste des sous-clés"
item_add 11,"2 - Retourner la liste valeurs"
item_add 11,"3 - Tester si la valeurexiste"
item_add 11,"4 - Retourner le contenu de la valeur"
item_add 11,"5 - Retourner l'arborescence des sous-clés"
button 12 : top 12,40 : left 12,220 : caption 12,"Exécuter" : on_click 12,exec

memo 21 : top 21,70 : width 21,550 : height 21,300 : bar_both 21
end

exec:
n% = item_index(11)
if n%<1 then return
ruche% = item_index(1)
if ruche%<1 then return

select n%
case 1
cle$ = text$(3)
res% = dll_call4("ExploreRegistry",0,ruche%,adr(cle$),0)
message str$(res%)
case 2
cle$ = text$(3)
res% = dll_call4("ExploreRegistry",1,ruche%,adr(cle$),handle(21))
message str$(res%)
case 3
cle$ = text$(3)
res% = dll_call4("ExploreRegistry",2,ruche%,adr(cle$),handle(21))
message str$(res%)
case 4
cle$ = text$(3)
res% = dll_call4("ExploreRegistry",3,ruche%,adr(cle$),0)
message str$(res%)
case 5
cle$ = text$(3)
res% = dll_call4("ExploreRegistry",4,ruche%,adr(cle$),handle(21))
message str$(res%)
case 6
cle$ = text$(3)
res% = dll_call4("ExploreRegistry",5,ruche%,adr(cle$),handle(21))
message str$(res%)

end_select

end

Essayer, par exemple, avec HKEY_CLASSES_ROOT (première option dans la combo en haut à gauche), avec la clé "*" (juste une étoile, sans les guillemets !), et la fonction "5 - Retourner l'arborescence des sous-clés". Le résultat est assez sympa, et facile à exploiter par programme.

Sujet: Re: KGF_dll - nouvelles versions Mer 2 Nov 2016 - 14:12

Petit rajout à ExploreRegistry, mais sans changement de version:
nouveau code fonctiion 7
Ce code retourne dans le mémo l'arborescence de l'ensemble des sous-clés et valeurs, partir d'une clé donnée, mais avec l'affichage des données pour chaque valeur.

Voici le programme de démo adapté:

Code:: ' test_ExploreRegistry.bas

label exec

dim res%, root%, cle$, valeur$, donnee$, n%, ruche%
dll_on "KGF.dll"

combo 1 : top 1,10 : left 1,10 : width 1,200
  item_add 1,"1 - HKEY_CLASSES_ROOT"
  item_add 1,"2 - HKEY_CURRENT_CONFIG"
  item_add 1,"3 - HKEY_CURRENT_USER"
  item_add 1,"4 - HKEY_LOCAL_MACHINE"
  item_add 1,"5 - HKEY_USERS"
alpha 2 : top 2,10 : left 2,220 : caption 2,"Clé:"
edit 3 : top 3,10 : left 3,250 : width 3,200
combo 11 : top 11,40 : left 11,10 : width 11,300
  item_add 11,"0 - Tester si clé existe"
  item_add 11,"1 - Retourner la liste des sous-clés"
  item_add 11,"2 - Retourner la liste valeurs"
  item_add 11,"3 - Tester si la valeurexiste"
  item_add 11,"4 - Retourner le contenu de la valeur"
  item_add 11,"5 - Retourner l'arborescence des sous-clés"
  item_add 11,"6 - Retourner l'arborescence des sous-clés avec données"
button 12 : top 12,40 : left 12,320 : caption 12,"Exécuter" : on_click 12,exec

memo 21 : top 21,70 : width 21,550 : height 21,300 : bar_both 21 : font_name 21,"Courier"
end

exec:
  n% = item_index(11)
  if n%<1 then return
  ruche% = item_index(1)
  if ruche%<1 then return

  select n%
   case 1
   cle$ = text$(3)
   res% = dll_call4("ExploreRegistry",0,ruche%,adr(cle$),0)
   message str$(res%)
   case 2
   cle$ = text$(3)
   res% = dll_call4("ExploreRegistry",1,ruche%,adr(cle$),handle(21))
   message str$(res%)
   case 3
   cle$ = text$(3)
   res% = dll_call4("ExploreRegistry",2,ruche%,adr(cle$),handle(21))
   message str$(res%)
   case 4
   cle$ = text$(3)
   res% = dll_call4("ExploreRegistry",3,ruche%,adr(cle$),0)
   message str$(res%)
   case 5
   cle$ = text$(3)
   res% = dll_call4("ExploreRegistry",4,ruche%,adr(cle$),handle(21))
   message str$(res%)
   case 6
   cle$ = text$(3)
   res% = dll_call4("ExploreRegistry",5,ruche%,adr(cle$),handle(21))
   message str$(res%)
   case 7
   cle$ = text$(3)
   res% = dll_call4("ExploreRegistry",6,ruche%,adr(cle$),handle(21))
   message str$(res%)

  end_select

end

Pour les données des valeurs, le programme affiche correctement les entiers, les chaînes de caractères et les binaires (sous forme de dump hexa).

Sujet: Re: KGF_dll - nouvelles versions Mer 2 Nov 2016 - 19:16

KGF.dll V6.89 du 02/11/2016

Nouveautés:
- ExploreRegistry: nouveaux codes opération pour la recherche de chaînes de caractères

Modules modifiés:
KGF.dll
KGF.hlp

La doc et les sources sont à jour.

Cette version consolide les différents rajouts de ces dernières heures, et offre 3 nouveux codes opération pour la recherche de chaînes de caractères:
- recherche dans les sous-clés
- recherche dans les sous-clés et noms des valeurs
- recherche dans les sous-clés, noms des valeurs et les données

Pour la recherche de chaînes de caractères, le critère est à placer dans la première ligne du mémo, le reste étant ignoré si présent.

Voici le programme de démo adapté:

Code:: ' test_ExploreRegistry.bas

label exec

dim res%, root%, cle$, valeur$, donnee$, n%, ruche%
dll_on "KGF.dll"

combo 1 : top 1,10 : left 1,10 : width 1,200
item_add 1,"1 - HKEY_CLASSES_ROOT"
item_add 1,"2 - HKEY_CURRENT_CONFIG"
item_add 1,"3 - HKEY_CURRENT_USER"
item_add 1,"4 - HKEY_LOCAL_MACHINE"
item_add 1,"5 - HKEY_USERS"
alpha 2 : top 2,10 : left 2,220 : caption 2,"Clé:"
edit 3 : top 3,10 : left 3,250 : width 3,200
combo 11 : top 11,40 : left 11,10 : width 11,330
item_add 11,"0 - Tester si clé existe"
item_add 11,"1 - Retourner la liste des sous-clés"
item_add 11,"2 - Retourner la liste valeurs"
item_add 11,"3 - Tester si la valeurexiste"
item_add 11,"4 - Retourner le contenu de la valeur"
item_add 11,"5 - Retourner l'arborescence des sous-clés"
item_add 11,"6 - Retourner l'arborescence des sous-clés avec données"
item_add 11,"7 - Chercher un critère dans les sous-clés"
item_add 11,"8 - Chercher un critère dans les sous-clés et valeurs"
item_add 11,"9 - Chercher un critère dans les sous-clés, valeurs et données"
button 12 : top 12,40 : left 12,350 : caption 12,"Exécuter" : on_click 12,exec

memo 21 : top 21,70 : width 21,550 : height 21,300 : bar_both 21 : font_name 21,"Courier"
end

exec:
n% = item_index(11)
if n%<1 then return
ruche% = item_index(1)
if ruche%<1 then return

select n%
case 1
cle$ = text$(3)
res% = dll_call4("ExploreRegistry",0,ruche%,adr(cle$),0)
message str$(res%)
case 2
cle$ = text$(3)
res% = dll_call4("ExploreRegistry",1,ruche%,adr(cle$),handle(21))
message str$(res%)
case 3
cle$ = text$(3)
res% = dll_call4("ExploreRegistry",2,ruche%,adr(cle$),handle(21))
message str$(res%)
case 4
cle$ = text$(3)
res% = dll_call4("ExploreRegistry",3,ruche%,adr(cle$),0)
message str$(res%)
case 5
cle$ = text$(3)
res% = dll_call4("ExploreRegistry",4,ruche%,adr(cle$),handle(21))
message str$(res%)
case 6
cle$ = text$(3)
res% = dll_call4("ExploreRegistry",5,ruche%,adr(cle$),handle(21))
message str$(res%)
case 7
cle$ = text$(3)
res% = dll_call4("ExploreRegistry",6,ruche%,adr(cle$),handle(21))
message str$(res%)
case 8
cle$ = text$(3)
res% = dll_call4("ExploreRegistry",7,ruche%,adr(cle$),handle(21))
message str$(res%)
case 9
cle$ = text$(3)
res% = dll_call4("ExploreRegistry",8,ruche%,adr(cle$),handle(21))
message str$(res%)
case 10
cle$ = text$(3)
res% = dll_call4("ExploreRegistry",9,ruche%,adr(cle$),handle(21))
message str$(res%)

end_select

end

Sujet: Re: KGF_dll - nouvelles versions Jeu 3 Nov 2016 - 12:29

KGF.dll V6.90 du 03/11/2016

Nouveautés:
- nouvelle fonction: PingPong

Modules modifiés:
KGF.dll
KGF.hlp

La doc et les sources sont à jour.

Voici l'extrait de la doc:

Citation :: Cette fonction implémente le jeu Ping-Pong, l'ancêtre des jeux vidéos. Dans un terrain de jeu vert, une raquette noire peut être manipulée par l'utilisateur. Elle se déplace uniquement horizontalement, en bas du terrain de jeu. Une balle blanche est injectée à partir du haut du terrain de jeu, avec une orientation aléatoire, mais une vitesse fixe. Lorsque la balle touche un des bords gauche, haut ou droite ou lorsqu'elle touche la raquette, elle est renvoyée selon son angle de réflexion. Mais lorsqu'elle touche le bord bas sans avoir été renvoyée par la raquette, la partie est terminée.

Et voici un programme Panoramic qui permet d'y jouer (ce code est dans la doc comme exemple !):

Code:: ' test_PingPong.bas

label creer, supprimer, sortir
label halt, continuer, gauche, droite
label key

dim res%

dll_on "KGF.dll"

caption 0,"Jeu de Ping-Pong"
height 0,500
main_menu 1
sub_menu 2 : parent 2,1 : caption 2,"Jeu"
sub_menu 3 : parent 3,2 : caption 3,"Créer" : on_click 3,creer
sub_menu 4 : parent 4,2 : caption 4,"Supprimer" : on_click 4,supprimer
sub_menu 10 : parent 10,2 : caption 10,"-"
sub_menu 11 : parent 11,2 : caption 11,"Sortir" : on_click 11,sortir

button 21 : top 21,10 : left 21,330 : caption 21,"Pause" : on_click 21,halt : hide 21
button 22 : top 22,40 : left 22,330 : caption 22,"Continuer" : on_click 22,continuer : hide 22
button 23 : top 23,70 : left 23,330 : caption 23,"Pause" : on_click 23,gauche : hide 23
button 24 : top 24,100 : left 24,330 : caption 24,"Continuer" : on_click 24,droite : hide 24

on_key_down 0,key

end

creer:
show 21 : show 22 : show 23 : show 24
res% = dll_call6("PingPong",handle(0),1,10,10,300,300)
return

supprimer:
res% = dll_call6("PingPong",0,0,0,0,0,0)
hide 21 : hide 22 : hide 23 : hide 24
return

sortir:
res% = dll_call6("PingPong",0,0,0,0,0,0)
terminate

halt:
res% = dll_call6("PingPong",0,2,0,0,0,0)
return

continuer:
res% = dll_call6("PingPong",0,3,0,0,0,0)
return

gauche:
res% = dll_call6("PingPong",0,4,0,0,0,0)
return

droite:
res% = dll_call6("PingPong",0,5,0,0,0,0)
return

key:
select scancode
case 37: gosub gauche
case 39: gosub droite
end_select
return

Sujet: Re: KGF_dll - nouvelles versions Sam 5 Nov 2016 - 22:01

KGF.dll V6.91 du 05/11/2016

Nouveautés:
- nouveau groupe de fonctions pour gérer l'importation de fichiers dans un EXE Panoramic

Modules modifiés:
KGF.dll
KGF.hlp

La doc et les sources sont à jour.

J"avais publié un outil en 100 % Panoramic qui fait ça. C'est TRES lent, du fait du manque de performance des commandes FILEBIN. Avec ces nouvelles fonctions DLL, c'est incomparablement plus rapide. Voici le programme de démo:

Code:: ' test_ImportFiles_par_KGF.bas

label ConnectInputExe, ImportFileToExe, RemoveFileFromExe, ExportFileFromExe, ListImportedFiles, DisconnectInputExe

dim res%, f$, i%, f1$

button 101 : top 101,10 : left 101, 10 : width 101,110 : caption 101,"ConnectInputExe" : on_click 101,ConnectInputExe
button 102 : top 102,10 : left 102,120 : width 102,110 : caption 102,"ImportFileToExe" : on_click 102,ImportFileToExe
button 103 : top 103,10 : left 103,230 : width 103,110 : caption 103,"RemoveFileFromExe" : on_click 103,RemoveFileFromExe
button 104 : top 104,10 : left 104,340 : width 104,110 : caption 104,"ExportFileFromExe" : on_click 104,ExportFileFromExe
button 105 : top 105,10 : left 105,450 : width 105,110 : caption 105,"ListImportedFiles" : on_click 105,ListImportedFiles

dll_on "KGF.dll"

open_dialog 1
save_dialog 4
list 2 : full_space 2 : height 2,height(2)-40 : top 2,40
memo 3 : hide 3 : bar_both 3
on_close 0,DisconnectInputExe

end

ConnectInputExe:
filter 1,"Exécutables Panoramic (*.exe)|*.exe"
f$ = file_name$(1)
if f$<>"_"
res% = dll_call1("ConnectInputExe",adr(f$))
message "ConnectInputExe: "+str$(res%)
end_if
return

ImportFileToExe:
filter 4,"Exécutables Panoramic (*.exe)|*.exe"
f$ = file_name$(4)
if f$<>"_"
filter 1,"Tous fichiers (*.*)|*.*"
f1$ = file_name$(1)
if f1$<>"_"
if file_exists(f$)=1
if message_confirmation_yes_no("Le fichier en sortie existe déjà. Remplacer ?")<>1 then return
file_delete f$
end_if
res% = dll_call2("ImportFileToExe",adr(f$),adr(f1$))
message "ImportFileToExe: "+str$(res%)
end_if
end_if
return

RemoveFileFromExe:
filter 4,"Exécutables Panoramic (*.exe)|*.exe"
f$ = file_name$(4)
if f$<>"_"
if file_exists(f$)=1
if message_confirmation_yes_no("Le fichier en sortie existe déjà. Remplacer ?")<>1 then return
file_delete f$
end_if
res% = dll_call2("RemoveFileFromExe",adr(f$),item_index(2))
message "ExportFileFromExe: "+str$(res%)
end_if
return

ExportFileFromExe:
res% = dll_call1("ExportFileFromExe",item_index(2))
message "ExportFileFromExe: "+str$(res%)
return

ListImportedFiles:
res% = dll_call1("ListImportedFiles",handle(3))
clear 2
if count(3)>0
for i%=1 to count(3)
item_add 2,item_read$(3,i%)
next i%
end_if
message "ListImportedFiles: "+str$(res%)
return

DisconnectInputExe:
res% = dll_call0("DisconnectInputExe")
return

En cas d'erreur, le code retour des fonctions est négatif. Voir la doc pour l'explication des codes.

L'idée derrière ces fonctions (et de l'outil en Panoramic) est de pouvoir inclure n'importe quel fichier dans un EXE Panoramic généré par Panoramic Editor, même un fichier ZIP, un autre EXE ou une DLL, pas juste des fichiers TXT et images comme BMP ou JPG. En cas de besoin, le programme peut alors exporter lui-même les fichiers dont il a besoin. En le faisant par ces fonctions DLL, c'est ultra-rapide.

Sujet: Re: KGF_dll - nouvelles versions Dim 6 Nov 2016 - 1:58

Ici, une nouvelle version du programme de démo, cette fois en incluant un mode "commande DOS". Le format général des commandes est:
test_ImportFiles_par KGF NUL: action exe p1 p2
avec le cas spécial
test_ImportFiles_par KGF NUL: help
pour avoir le mode d'emploi. Si le programme est appelé sans paramètres, c'est la version Windows qui s'affiche.

Code:: ' test_ImportFiles_par_KGF.bas

' Ce programme peut être lancé en mode console avec la syntaxe suivante:
' test_ImportFiles_par KGF NUL: action exe p1 p2
' tout est insensible à la casse
' les commandes suivantes sont disponibles
' test_ImportFiles_par_KGF NUL: import exe newexe file
' test_ImportFiles_par_KGF NUL: remove exe newexe index
' test_ImportFiles_par_KGF NUL: export exe index
' test_ImportFiles_par_KGF NUL: list exe
' test_ImportFiles_par_KGF NUL: help
' Le premier paramètre (exe) est le nom du fichier Panoramic EXE en entrée.
' Deux commandes ont besoin d'un fichier EXE en sortie (newexe).
' La commande import utilise un paramètre (file) donnant le nom (et chemin)
' du fichier à importer.
' Deux commandes utilisent un numéro (index) pour identifier le fichier importé
' à traiter. Cet index est le numéro d'ordre du fichier importé (1...nombre total).
' La commande list affiche un mémo avec la liste.

' *************************************************************************
' * Début du traitement des commandes DOS *
' *************************************************************************
if param_value$(2)<>""
  dim n%, cmd$, p1$, p2$, p3$, ind%, exe$, newexe$, file$, res%, i%, s$
  cmd$ = lower$(param_value$(2))
  if cmd$="import" : ' test_ImportFiles_par_KGF NUL: import exe newexe file
   dll_on "KGF.dll"
   exe$ = param_value$(3)
   if exe$=""
   message "Oups - EXE en entrée manque"
   terminate
   end_if
   res% = dll_call1("ConnectInputExe",adr(exe$))
   if res%<0
   message "Oups - ConnectInputExe "+str$(res%)
   terminate
   end_if
   newexe$ = param_value$(4)
   if newexe$=""
   message "Oups - NewEXE en sortie manque"
   res% = dll_call0("DisconnectInputExe")
   terminate
   end_if
   file$ = param_value$(5)
   if file$=""
   message "Oups - fichier à importer manquant"
   res% = dll_call0("DisconnectInputExe")
   terminate
   end_if
   res% = dll_call2("ImportFileToExe",adr(newexe$),adr(file$))
   if res%<0
   message "ImportFileToExe: "+str$(res%)
   res% = dll_call0("DisconnectInputExe")
   terminate
   end_if
   res% = dll_call0("DisconnectInputExe")
   terminate
  end_if

  if cmd$="remove" : ' test_ImportFiles_par_KGF NUL: remove exe newexe index
   dll_on "KGF.dll"
   exe$ = param_value$(3)
   if exe$=""
   message "Oups - EXE en entrée manque"
   terminate
   end_if
   res% = dll_call1("ConnectInputExe",adr(exe$))
   if res%<0
   message "Oups - ConnectInputExe "+str$(res%)
   terminate
   end_if
   newexe$ = param_value$(4)
   if newexe$=""
   message "Oups - NewEXE en sortie manque"
   res% = dll_call0("DisconnectInputExe")
   terminate
   end_if
   s$ = param_value$(5)
   if s$=""
   message "Oups - indice manquant"
   res% = dll_call0("DisconnectInputExe")
   terminate
   end_if
   if numeric(s$)=0
   message "Oups - indice non numérique"
   res% = dll_call0("DisconnectInputExe")
   terminate
   end_if
   ind% = val(s$)
   memo 3 : hide 3 : bar_both 3
   res% = dll_call1("ListImportedFiles",handle(3))
   if res%<0
   message "Oups - ListImportedFiles "+str$(res%)
   res% = dll_call0("DisconnectInputExe")
   terminate
   end_if
   if (ind%<1) or (ind%>res%)
   message "Oups - indice hors limites"
   res% = dll_call0("DisconnectInputExe")
   terminate
   end_if
   res% = dll_call2("RemoveFileFromExe",adr(newexe$),ind%)
   if res%<0
   message "RemoveFileFromExe: "+str$(res%)
   res% = dll_call0("DisconnectInputExe")
   terminate
   end_if
   res% = dll_call0("DisconnectInputExe")
   terminate
  end_if

  if cmd$="export" : ' test_ImportFiles_par_KGF NUL: export exe index
   dll_on "KGF.dll"
   exe$ = param_value$(3)
   if exe$=""
   message "Oups - EXE en entrée manque"
   terminate
   end_if
   res% = dll_call1("ConnectInputExe",adr(exe$))
   if res%<0
   message "Oups - ConnectInputExe "+str$(res%)
   terminate
   end_if
   s$ = param_value$(4)
   if s$=""
   message "Oups - indice manquant"
   res% = dll_call0("DisconnectInputExe")
   terminate
   end_if
   if numeric(s$)=0
   message "Oups - indice non numérique"
   res% = dll_call0("DisconnectInputExe")
   terminate
   end_if
   ind% = val(s$)
   memo 3 : hide 3 : bar_both 3
   res% = dll_call1("ListImportedFiles",handle(3))
   if res%<0
   message "Oups - ListImportedFiles "+str$(res%)
   res% = dll_call0("DisconnectInputExe")
   terminate
   end_if
   if (ind%<1) or (ind%>res%)
   message "Oups - indice hors limites"
   res% = dll_call0("DisconnectInputExe")
   terminate
   end_if
   res% = dll_call1("ExportFileFromExe",ind%)
   if res%<0
   message "ExportFileFromExe: "+str$(res%)
   res% = dll_call0("DisconnectInputExe")
   terminate
   end_if
   res% = dll_call0("DisconnectInputExe")
   terminate
  end_if

  if cmd$="list" : ' test_ImportFiles_par_KGF NUL: list exe
   dll_on "KGF.dll"
   exe$ = param_value$(3)
   if exe$<>""
   res% = dll_call1("ConnectInputExe",adr(exe$))
   if res%<0
   message "Oups - ConnectInputExe "+str$(res%)
   terminate
   end_if
   form 1 : caption 1,"Liste des fichiers importés"
   memo 3 : parent 3,1 : full_space 3 : bar_both 3
   res% = dll_call1("ListImportedFiles",handle(3))
   message "list: "+str$(res%)
   res% = dll_call0("DisconnectInputExe")
   end_if
   end
  end_if

  ' if cmd$="help" : ' test_ImportFiles_par_KGF NUL: help
   form 1 : caption 1,"Mode d'emploi"
   memo 3 : parent 3,1 : full_space 3
   item_add 3,"Liste des commandes possibles:"
   item_add 3,""
   item_add 3," test_ImportFiles_par_KGF NUL: import exe newexe file"
   item_add 3," test_ImportFiles_par_KGF NUL: remove exe newexe index"
   item_add 3," test_ImportFiles_par_KGF NUL: export exe index"
   item_add 3," test_ImportFiles_par_KGF NUL: list exe"
   item_add 3," test_ImportFiles_par_KGF NUL: help"
   end
  ' end_if
end_if

' *************************************************************************
' * Fin du traitement des commandes DOS *
' *************************************************************************

label ConnectInputExe, ImportFileToExe, RemoveFileFromExe, ExportFileFromExe, ListImportedFiles, DisconnectInputExe

dim res%, f$, i%, f1$

button 101 : top 101,10 : left 101, 10 : width 101,110 : caption 101,"ConnectInputExe" : on_click 101,ConnectInputExe
button 102 : top 102,10 : left 102,120 : width 102,110 : caption 102,"ImportFileToExe" : on_click 102,ImportFileToExe
button 103 : top 103,10 : left 103,230 : width 103,110 : caption 103,"RemoveFileFromExe" : on_click 103,RemoveFileFromExe
button 104 : top 104,10 : left 104,340 : width 104,110 : caption 104,"ExportFileFromExe" : on_click 104,ExportFileFromExe
button 105 : top 105,10 : left 105,450 : width 105,110 : caption 105,"ListImportedFiles" : on_click 105,ListImportedFiles

dll_on "KGF.dll"

open_dialog 1
save_dialog 4
list 2 : full_space 2 : height 2,height(2)-40 : top 2,40
memo 3 : hide 3 : bar_both 3
on_close 0,DisconnectInputExe

end

ConnectInputExe:
  filter 1,"Exécutables Panoramic (*.exe)|*.exe"
  f$ = file_name$(1)
  if f$<>"_"
   res% = dll_call1("ConnectInputExe",adr(f$))
   message "ConnectInputExe: "+str$(res%)
  end_if
  return

ImportFileToExe:
  filter 4,"Exécutables Panoramic (*.exe)|*.exe"
  f$ = file_name$(4)
  if f$<>"_"
   filter 1,"Tous fichiers (*.*)|*.*"
   f1$ = file_name$(1)
   if f1$<>"_"
   if file_exists(f$)=1
   if message_confirmation_yes_no("Le fichier en sortie existe déjà. Remplacer ?")<>1 then return
   file_delete f$
   end_if
   res% = dll_call2("ImportFileToExe",adr(f$),adr(f1$))
   message "ImportFileToExe: "+str$(res%)
   end_if
  end_if
  return

RemoveFileFromExe:
  filter 4,"Exécutables Panoramic (*.exe)|*.exe"
  f$ = file_name$(4)
  if f$<>"_"
   if file_exists(f$)=1
   if message_confirmation_yes_no("Le fichier en sortie existe déjà. Remplacer ?")<>1 then return
   file_delete f$
   end_if
   res% = dll_call2("RemoveFileFromExe",adr(f$),item_index(2))
   message "ExportFileFromExe: "+str$(res%)
  end_if
  return

ExportFileFromExe:
  res% = dll_call1("ExportFileFromExe",item_index(2))
  message "ExportFileFromExe: "+str$(res%)
  return

ListImportedFiles:
  res% = dll_call1("ListImportedFiles",handle(3))
  clear 2
  if count(3)>0
   for i%=1 to count(3)
   item_add 2,item_read$(3,i%)
   next i%
  end_if
  message "ListImportedFiles: "+str$(res%)
  return

DisconnectInputExe:
  res% = dll_call0("DisconnectInputExe")
  return

PS:
Toutes ces lignes de commande contiennent un "NUL:" b(sans les guillemets) comme premier paramètre. Ceci est dû à un bug dans Panoramic qui tente systématiquement d'exécuter le fichier passé en premier paramètre, et ce avant de commencer à exécuter le code Panoramic du programme. Ceci a été signalé dans la rubrique appropriée, et le "NUL:" est juste une astuce pour contourner ce problème.

Sujet: Re: KGF_dll - nouvelles versions Lun 7 Nov 2016 - 16:19

Salut Klaus

Dans l’aide de KGF.dll Interception des clics sur un objet
L’exemple que tu donnes comporte un « minibug » (une erreure et nom notre ami ! Wink

) :
Le memo et le edit porte le même numéro d’identificateur 10.

Code:: dim res%, hnd%, hndpos%
memo 10 : hnd% = handle(10)
edit 10 : hndpos% = handle(10) : hide 10
' intercepter les évènements sur le mémo et signaler les coordonnées
res% = dll_call2("ClickSetHook",hnd%,hndpos%)

Sujet: Re: KGF_dll - nouvelles versions Lun 7 Nov 2016 - 17:14

KGF.dll V6.92 du 07/11/2016

Nouveautés:
- correction d'un bug dans la gestion des interceptions des clics

Modules modifiés:
KGF.dll

La doc est inchangée? Les sources sont à jour.

Merci à Papidall pour le signalement de l'erreur de la doc. Elle sera corrigée prochainement.

Voici une démo plus complète de ces fonctions. Le programme présente deux panels. L'action de la souris sur ces panels sera tracée et le résultat affiché dans des champs EDIT en-dessous. On intercept sur chacun des panels tous les évènements possibles.

Code:: ' test_interception_clicks.bas

label clic1, clic2, clic3, clic5, clic6, clic7

dim res%, hnd10%, hnd11%, hndpos%
dim hnd_button1%, hnd_button2%, hnd_button3%, hnd_button4%, hnd_button5%, hnd_button6%, hnd_button7%

panel 10 : hnd10% = handle(10)
panel 11 : hnd11% = handle(11) : left 11,200

alpha 19 : top 19,170 : left 19,10 : caption 19,"Infos:"
edit 20 : hndpos% = handle(20) : top 20,170 : left 20,100

button 31 : hnd_button1% = handle(31) : hide 31 : on_click 31,clic1
button 32 : hnd_button2% = handle(32) : hide 32 : on_click 32,clic2
button 33 : hnd_button3% = handle(33) : hide 33 : on_click 33,clic3
' button 34 : hnd_button4% = handle(34) : hide 34 : on_click 34,clic4
button 35 : hnd_button5% = handle(35) : hide 35 : on_click 35,clic5
button 36 : hnd_button6% = handle(36) : hide 36 : on_click 36,clic6
button 37 : hnd_button7% = handle(37) : hide 37 : on_click 37,clic7

alpha 41 : top 41,200 : left 41,10 : caption 41,"clic gauche"
alpha 42 : top 42,230 : left 42,10 : caption 42,"double clic"
alpha 43 : top 43,260 : left 43,10 : caption 43,"clic droit"
alpha 44 : top 44,290 : left 44,10 : caption 44,"...réservé..."
alpha 45 : top 45,320 : left 45,10 : caption 45,"entrant"
alpha 46 : top 46,350 : left 46,10 : caption 46,"sortant"
alpha 47 : top 47,380 : left 47,10 : caption 47,"souris bouge"
alpha 48 : top 48,410 : left 48,10 : caption 48,"évènement"
edit 51 : top 51,200 : left 51,100 : width 51,150
edit 52 : top 52,230 : left 52,100 : width 52,150
edit 53 : top 53,260 : left 53,100 : width 53,150
' edit 54 : top 54,290 : left 54,100 : width 54,150
edit 55 : top 55,320 : left 55,100 : width 55,150
edit 56 : top 56,350 : left 56,100 : width 56,150
edit 57 : top 57,380 : left 57,100 : width 57,150
edit 58 : top 58,410 : left 58,100 : width 58,150
spin 61 : top 61,200 : left 61,260 : position 61,0
spin 62 : top 62,230 : left 62,260 : position 62,0
spin 63 : top 63,260 : left 63,260 : position 63,0
' spin 64 : top 64,290 : left 64,260 : position 64,0
spin 65 : top 65,320 : left 65,260 : position 65,0
spin 66 : top 66,350 : left 66,260 : position 66,0
spin 67 : top 67,380 : left 67,260 : position 67,0

dll_on "KGF.dll"

' intercepter les évènements sur le panel 10 et signaler les coordonnées
res% = dll_call2("ClickSetHook",hnd10%,hndpos%)
res% = dll_call2("ClickSetLink",hnd_button1%,1)
res% = dll_call2("ClickSetLink",hnd_button2%,2)
res% = dll_call2("ClickSetLink",hnd_button3%,3)
' res% = dll_call2("ClickSetLink",hnd_button4%,4) : ' réservé !
res% = dll_call2("ClickSetLink",hnd_button5%,5)
res% = dll_call2("ClickSetLink",hnd_button6%,6)
res% = dll_call2("ClickSetLink",hnd_button7%,7)

' intercepter les évènements sur le panel 11 et signaler les coordonnées
res% = dll_call2("ClickSetHook",hnd11%,hndpos%)
res% = dll_call2("ClickSetLink",hnd_button1%,1)
res% = dll_call2("ClickSetLink",hnd_button2%,2)
res% = dll_call2("ClickSetLink",hnd_button3%,3)
' res% = dll_call2("ClickSetLink",hnd_button4%,4) : ' réservé !
res% = dll_call2("ClickSetLink",hnd_button5%,5)
res% = dll_call2("ClickSetLink",hnd_button6%,6)
res% = dll_call2("ClickSetLink",hnd_button7%,7)

end

clic1:
text 51,text$(20)
position 61,position(61)+1
display
return

clic2:
text 52,text$(20)
position 62,position(62)+1
display
return

clic3:
text 53,text$(20)
position 63,position(63)+1
display
return

clic5:
text 55,text$(20)
position 65,position(65)+1
display
return

clic6:
text 56,text$(20)
position 66,position(66)+1
display
return

clic7:
text 57,text$(20)
position 67,position(67)+1
display
return

Note:

Accessoirement, cette version contient deux fontions non documentée (et certainement provisoires):

Code:: ' === lire size% octets d'un fichier binaire infile$ dans une variable outstring$, commençant à l'octet start%
res% = dll_call4("ReadBinaryStringFromFile",adr(infile$),adr(outstring$),start%,size%)export;
   Codes retour:
   0 = ok
   -1 = erreur en ouvrant du fichier
   -2 = erreur en positionnement
   -3 = erreur en lecture
   infile$: passé par adr(fichier$) avec fichier$ contenant nom ou le chemin avec le nom du fichier à lire
   outstring$: passé par adr(s$) avec s$ recevant le texte lu - doit être assez large pour ça !
   start%: adresse de début de lecture, ou lecture à partir de la position courante si start<0
   size%: nombre d'octets à lire

' === lire n mots de 32 bis d'un fichier binaire dans un tableau d'entiers Panoramic
function ReadIntegerArray32FromFile(adr(infile$), outadr%, start%,len%)
   Codes retour:
   0 = ok
   -1 = erreur en ouvrant du fichier
   -2 = erreur en positionnement
   -3 = erreur en lecture
   infile$: passé par adr(fichier$) avec fichier$ contenant nom ou le chemin avec le nom du fichier à lire
   outadr%: passé par adr(buf%) avec buf% recevant les données lues - doit être assez large pour ça !
   start%: indice de début de lecture, ou lecture à partir de la position courante si start<0
   size%: nombre d'entiers à lire

Sujet: Re: KGF_dll - nouvelles versions Jeu 10 Nov 2016 - 2:39

KGF.dll V6.93 du 09/11/2016

Nouveautés:
- nouvelles fonctions ultra-rapides de gestion de fichiers binaires en lecture/écriture

Modules modifiés:
KGF.dll
KGF.dll

La doc et les sources sont à jour.

Ces fonctions sont:

Citation :: ConnectToBinaryFile = établir une connexion avec un fichier binaire
DisconnectFromBinaryFile = fermer une connexion avec un fichier binaire
ReadBinaryStringFromFile = lire un fichier binaire dans une chaîne de caractères
WriteFileFromBinaryString = écrire une chaîne de caractères dans un fichier binaire
ReadIntegerArray32FromFile = lire un fichier binaire dans un tableau d'entiers
WriteFileFromntegerArray32 = écrire un tableau d'entiers dans un fichier binaire
PositionBinaryFile = positionner dans un fichier binaire et retourner la position résltante

La doc est dans la section "Fichiers importés". Ces fonctions, ultra-rapides, permettent de lire des parties d'un fichier binaire dans une chaîne de caractères ou un tableau d'entiers à 1 dimension, ou l'inverse. La vitesse est particulièrement spectaculaire en traitant en une seule commande des blocs de 1 ou 2 méga-octets, ou même plus.

On peut bien sûr ouvrir 2 ou plusieurs fichiers binaires simultanément. Pour cela, il suffit d'utiliser deux ou plusieursvariables distinctes pour les identifiants des fichiers: ID1%, ID2%, ... ou dim ID%(5). Bien sûr, passer toujours l'identifiant du fichier visé en paramètre auc fonctions. C'est comme un canal de fichier en Panoramic.

La petite démo ci-après montre le principe de fonctionnement avec un tableau de 7 mots (buf%(6)), mais on peut utiliser n'importe quelle taille:

Code:: ' test_write_binary_array.bas

dim buf%(5), i%, j%, k%, res%, f$, f1$, c%, ID%
dll_on "KGF.dll"

buf%(0) = -1
for i%=0 to 1
  for j%=1 to 5
   buf%(j%) = 256 + i%*16 + j%
  next j%
next i%

f$ = "test_read_2_dimensional_array.dat"
if file_exists(f$)=1 then file_delete f$
f1$ = "test_read_2_dimensional_array_bis.dat"
if file_exists(f1$)=1 then file_delete f1$

filebin_open_write 1,f$
  for j%=0 to 5
   c% = buf%(j%)
   for k%=1 to 4
   filebin_write 1,bin_and(c%,255)
   c% = int(c%/256)
   next k%
  next j%
filebin_close 1

ID% = dll_call2("ConnectToBinaryFile",adr(f1$),2)
res% = dll_call4("WriteFileFromIntegerArray32",ID%,adr(buf%),0,6)
res% = dll_call1("DisconnectFromBinaryFile",ID%)

for j%=0 to 5
  buf%(j%) = 0
next j%
ID% = dll_call2("ConnectToBinaryFile",adr(f$),0)
res% = dll_call4("ReadIntegerArray32FromFile",ID%,adr(buf%),0,6)
res% = dll_call1("DisconnectFromBinaryFile",ID%)

for i%=0 to 5
  print right$("0000000"+hex$(buf%(i%)),8)
next i%
print

for j%=0 to 5
  buf%(j%) = 0
next j%
ID% = dll_call2("ConnectToBinaryFile",adr(f1$),0)
res% = dll_call4("ReadIntegerArray32FromFile",ID%,adr(buf%),0,6)
res% = dll_call1("DisconnectFromBinaryFile",ID%)

for i%=0 to 5
  print right$("0000000"+hex$(buf%(i%)),8)
next i%

end

Voici le code Delphi (très simple !) de l'ensemble de ces routines:

Code:: unit KGF_unit_ImportFile;

interface
uses
SysUtils,
Windows,
Messages,
Classes,
Dialogs

;

function ConnectToBinaryFile(sfile: pstring; act: integer):integer; stdcall; forward;
function DisconnectFromBinaryFile(aStream: TFileStream):integer; stdcall; forward;
function ReadBinaryStringFromFile(sStream: TFileStream; outstring: integer; start,len: integer):integer; stdcall; forward;
function WriteFileFromBinaryString(sStream: TFileStream; instring: integer; start,len: integer):integer; stdcall; forward;
function ReadIntegerArray32FromFile(sStream: TFileStream; outadr: pointer; start,len: integer):integer; stdcall; forward;
function WriteFileFromIntegerArray32(sStream: TFileStream; inadr: pointer; start,len: integer):integer; stdcall; forward;
function PositionBinaryFile(sStream: TFileStream; act, inadr: integer):integer; stdcall; forward;

implementation

// ouvrir un fichier binaire
{ Codes retour:
   0 = erreur
   n%>0 = ID du fichier

   file: passé par adr(fichier$) avec fichier$ contenant nom ou le chemin avec le nom du fichier à ouvrir
   act: code action: 0=read 1=write 2=create
}
function ConnectToBinaryFile(sfile: pstring; act: integer):integer; stdcall; export;
var
  sStream: TFileStream;
begin
  result := 0;
  try
   case act of
   0: begin // read
   sStream := TFileStream.Create(sfile^, fmOpenRead); // ouvrir le fichier en lecture
   result := integer(sStream);
   end;
   1: begin // write
   sStream := TFileStream.Create(sfile^, fmOpenWrite); // ouvrir le fichier en lecture
   result := integer(sStream);
   end;
   2: begin // create
   sStream := TFileStream.Create(sfile^, fmCreate); // ouvrir le fichier en lecture
   result := integer(sStream);
   end;
   end;
  except
  end;
end;

// fermer un fichier binaire
{ Codes retour:
   0 = ok
   -1 = erreur

   aStream: passé ID% avec ID%$ contenant l'ID du fichier binaire ouvert par OpenBinaryFile
}
function DisconnectFromBinaryFile(aStream: TFileStream):integer; stdcall; export;
begin
  result := -1;
  try
   aStream.Free;
   result := 0;
  except
  end;
end;

// lire n octets d'un fichier binaire dans une chaîne Panoramic
{ Codes retour:
   0 = ok
   -1 = erreur en positionnement
   -2 = erreur en lecture

   sStream: passé par ID% avec ID% contenant l'identifiant du fichier à lire
   outstring: passé par adr(s$) avec s$ recevant le texte lu - doit être assez large pour ça !
   start: adresse de début de lecture, ou lecture à partir de la position courante si start<0
   len: nombre d'octets à lire
}
function ReadBinaryStringFromFile(sStream: TFileStream; outstring: integer; start,len: integer):integer; stdcall; export;
begin
  result := -1;
  try
   if start>=0 then sStream.Position := start; // positionner à l'endroit voulu
   result := -2;
   sStream.ReadBuffer(pointer(pinteger(outstring)^)^,len); // lire le nombre de caractères
   result := 0;
  except
  end;
end;

// écrire n octets d'une chaîne Panoramic dans un fichier binaire
{ Codes retour:
   0 = ok
   -1 = erreur en positionnement
   -2 = erreur en écriture

   sStream: passé par ID% avec ID% contenant l'identifiant du fichier à écrire
   instring: passé par adr(s$) avec s$ fournissant le texte à écrire - doit être assez large pour ça !
   start: adresse de début de'écriture, ou écriture à partir de la position courante si start<0
   len: nombre d'octets à écrire
}
function WriteFileFromBinaryString(sStream: TFileStream; instring: integer; start,len: integer):integer; stdcall; export;
begin
  result := -1;
  try
   if start>=0 then sStream.Position := start; // positionner à l'endroit voulu
   result := -2;
   sStream.WriteBuffer(pointer(pinteger(instring)^)^,len); // lire le nombre de caractères
   result := 0;
  except
  end;
end;

// lire n mots de 32 bis d'un fichier binaire dans un tableau d'entiers Panoramic
{ Codes retour:
   0 = ok
   -1 = erreur en positionnement
   -2 = erreur en lecture

   sStream: passé par ID% avec ID% contenant l'identifiant du fichier à lire
   outadr: passé par adr(buf%) avec buf% recevant les données lues - doit être assez large pour ça !
   start: indice de début de lecture, ou lecture à partir de la position courante si start<0
   len: nombre d'entiers à lire
}
function ReadIntegerArray32FromFile(sStream: TFileStream; outadr: pointer; start,len: integer):integer; stdcall; export;
begin
  result := -1;
  try
   if start>=0 then sStream.Position := start*4; // positionner à l'endroit voulu
   result := -2;
   sStream.ReadBuffer(outadr^,len*4); // lire le nombre de caractères
   result := 0;
  except
  end;
end;

// écrire n mots de 32 bis d'un tableau d'entiers Panoramic dans un fichier binaire
{ Codes retour:
   0 = ok
   -1 = erreur en positionnement
   -2 = erreur en lecture

   sStream: passé par ID% avec ID% contenant l'identifiant du fichier à écrire
   inadr: passé par adr(buf%) avec buf% contenant les données à écrire - doit être assez large pour ça !
   start: indice de début d'écriture, ou écriture à partir de la position courante si start<0
   len: nombre d'entiers à écrire
}
function WriteFileFromIntegerArray32(sStream: TFileStream; inadr: pointer; start,len: integer):integer; stdcall; export;
begin
  result := -1;
  try
   if start>=0 then sStream.Position := start*4; // positionner à l'endroit voulu
   result := -2;
   sStream.WriteBuffer(inadr^,len*4); // écrire le nombre de caractères
   result := 0;
  except
  end;
end;

// positionner un fichier binaire à une adresse et retourner l'adresse résultante
// écrire n mots de 32 bis d'un tableau d'entiers Panoramic dans un fichier binaire
{ Codes retour:
   0 = ok
   -1 = adresse invaliude
   -2 = erreur en positionnement

   sStream: passé par ID% avec ID% contenant l'identifiant du fichier à écrire
act: passé par constante ou act%, valeur 0...4
   inadr: passé par constante ou a%
}
function PositionBinaryFile(sStream: TFileStream; act, inadr: integer):integer; stdcall; export;
begin
  result := -1;
  try
   case act of
   0: begin // retourner la position actuelle
   result := sStream.Position;
   end;
   1: begin // positionner en absolu par octet
   if inadr<0 then exit;
   result := -2;
   sStream.Position := inadr;
   result := sStream.Position;
   end;
   2: begin // positionner en absolu par mots de 32 bits
   if inadr<0 then exit;
   result := -2;
   sStream.Position := inadr*4;
   result := sStream.Position;
   end;
   3: begin // positionner en relatif par octet
   if (sStream.Position+inadr)<0 then exit;
   result := -2;
   sStream.Position := sStream.Position + inadr;
   result := sStream.Position;
   end;
   4: begin // positionner en relatif par mots de 32 bits
   if (sStream.Position+inadr*4)<0 then exit;
   result := -2;
   sStream.Position := sStream.Position + inadr*4;
   result := sStream.Position;
   end;
   end;
  except
  end;
end;

exports
  ConnectInputExe,
  ImportFileToExe,
  RemoveFileFromExe,
  ExportFileFromExe,
  ListImportedFiles,
  DisconnectInputExe

  ,ConnectToBinaryFile, DisconnectFromBinaryFile
  ,ReadBinaryStringFromFile, WriteFileFromBinaryString, ReadIntegerArray32FromFile, WriteFileFromIntegerArray32
  ,PositionBinaryFile
  ;

end.

Sujet: Re: KGF_dll - nouvelles versions Jeu 10 Nov 2016 - 22:52

Bonsoir Klaus,

Je ne vois pas bien ce qu'apportent les nouvelles fonctions
ReadBinaryStringFromFile et WriteFileFromBinaryString
par rapport aux fonctions déjà existantes (et que j'utilise volontiers)
ReadBinaryFileToString et WriteStringToBinaryFile
?

Sujet: Re: KGF_dll - nouvelles versions Jeu 10 Nov 2016 - 23:18

Les fonctions ReadBinaryFileToString et WriteStringToBinaryFile traitent en une seule opération, un fichier entier. Alors que ReadBinaryStringFromFile et WriteFileFromBinaryString travaillent sur des portions d'un fichier, dont l'adresse de départ et la longueur peuvent être librement choisies. Mieux, elles peuvent s'enchaîner en série sur un même fichier, éventuellement en changeant le positionnement avec la fonction PositionBinaryFile, ce qui donne un accès parfaitement libre en accès direct à n'importe quelle partie d'un fichier, et sur n'importe quelle longueur.

EDIT

Sans parler des nouvelles possibilités de charger ces segments de fichiers, non seulement dans une chaîne de caractères, mais également dans un tableau d'entiers. Et non octet par octet comme les fonctions FILEBIN_BLOCK_READ etc, mais bien un mot binaire de 32 bits dans chaque élément du tableau d'entiers.

Sujet: Re: KGF_dll - nouvelles versions Ven 11 Nov 2016 - 0:21

Merci pour ces précisions Klaus, effectivement je n'avais pas regardé en détail, et je note pour un usage ultérieur, ce sont des possibilités intéressantes.

Sujet: Re: KGF_dll - nouvelles versions Lun 14 Nov 2016 - 12:47

KGF.dll V6.94 du 14/11/2016

Nouveautés:
- RichEditFunction code 12: prise en charge correcte de texte en format RTF

Modules modifiés:
KGF.dll

La doc est inchangée. Les sources sont à jour.

Sujet: Re: KGF_dll - nouvelles versions Sam 19 Nov 2016 - 22:29

Bonsoir Klaus

Suite au message de Mimic concernant une detection d'un virus par avast après le téléchargement de GPP sur son PC j'ai fais toute une serie de tests. Suite a l'installation de F-PROT en version Trial et d'un scan complet voila ce que j'ai :

KGF_dll - nouvelles versions - Page 34 Sans_t10

KGF_dll - nouvelles versions - Page 34 Sans_t10

En résumé toutes les copies de KGF.DLL sur mon PC sont touchées.
J'ai tenté de télécharger la dernière version depuis ton site mais lors de sa vérification j'ai le même soucis.

Regarde le lien ici. Il en parle en détail et a priori il toucherait les application Delphi...

Qu'en penses tu ?

Sujet: Re: KGF_dll - nouvelles versions Sam 19 Nov 2016 - 23:00

Je l'ai analysé aussi, avec mes outils, et je n'ai évidemment rien trouvé, parce qu'il n'y a rien... Déclare le fichier dans la liste blanche - je garantis qu'il n'y a pas de risque !

Sujet: Re: KGF_dll - nouvelles versions Sam 19 Nov 2016 - 23:08

Ok Klaus !

Merci pour ta réponse rapide.

Ce qui est bizarre c'est que même Avast l'a détecté aussi (d'après Mimic dans son message sur le Gestionnaire de Projets Panoramic cet après midi). C'est ce qui m'a lancé à faire un scan complet et avec plusieurs outils différents pour m'en assurer...

Sujet: Re: KGF_dll - nouvelles versions Sam 19 Nov 2016 - 23:15

Pour KGF.dll, je pense qu'il détecte certains API utilises dans KGF.dll, en particulier ceux qui gèrent la cmmunication entre processus et ceux qui peuvent chercher ou lire dans toute la mémoire virtuele d'un processus. Cela permettrait évidemment de faire des choses pas nettes, mais dans KGF.dll, ce n'est pas l'objectif.

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