version final geticon V1.0

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

rajout d'une commande!
geticon cherche si ResHacker est installé dans le système

Code:: dim FichierExe$,ext$,FichierIco$,dossierExe$,dossierIco$,FichierBat$,DossierTemp$
dim retour
dim a$,rhacker$,batch$
a$="
label creer,quitte
application_title "GetIcon Information"

dir_change "C:\Program Files\GetIcon\Temp"
DossierTemp$=dir_current$+"\"

DLL_ON "form.dll"
retour = DLL_CALL2("SetSize",HANDLE(0),0)
WIDTH 0,WIDTH(0)+1 : ' obligatoire pour "forcer" le rafraichissement de l'affichage du formulaire
retour = DLL_CALL2("SetMinimize",HANDLE( 0),0)
retour = DLL_CALL2("SetMaximize",HANDLE( 0),0)
dll_off

caption 0,"GetIcon V 1.0"
height 0,300 : width 0,600
on_close 0,quitte

Button 10 : caption 10,"Creer"
left 10,15 : top 10,220
on_click 10,creer

container 20
top 20,50 : Left 20,20
height 20,40 : width 20,160
Caption 20," Executable "

alpha 21
parent 21,20 : color 21,255,255,255
full_space 21
font_size 21,10

container 30
top 30,50 : Left 30,width(20)+50
height 30,40 : width 30,160
Caption 30," Icon "

alpha 31
parent 31,30 : color 31,255,255,255
full_space 31
font_size 31,10

alpha 32 : caption 32,""
top 32,30 : left 32,20

alpha 33 : caption 33,""
top 33,30 : left 33,width(20)+50

alpha 34 : caption 34,""
top 34,110 : left 34,30

container 40
top 40,20 : Left 40,380
height 40,200 : width 40,202
Caption 40," Apperçu "

picture 41
left 41,2 : width 41,197
height 41,177 : top 41,20
color 41,0,0,0
parent 41,40

open_dialog 50

if file_exists("C:\Program Files\Resource Hacker\ResHacker.exe")=0
message "il vous faut l'utilitaire Resource Hacker pour utilisé GetIcon"+chr$(10)+" www.angusj.com/resourcehacker"
end_if

rhacker$="C:\Program Files\Resource Hacker\ResHacker.exe"

end

creer:
if file_exists("C:\Program Files\Resource Hacker\ResHacker.exe")=0
message "Vous n'avez toujours pas Resource Hacker"+chr$(10)+"Vous devez l'installer"
return
end_if

' ************Sélection des fichiers!*************
caption 21,""
caption 31,""
caption 32,""
caption 33,""
caption 34,""
ext$=""
FichierExe$=""
FichierIco$=""
dossierExe$=""
dossierIco$=""
FichierBat$=""

' ***********Executable***************************
dll_on "kgf.dll"

filter 50,"Executable | *.exe"

dossierExe$=file_name$(50)
if dossierExe$="_" then return

FichierExe$=file_extract_name$(dossierExe$)
caption 21,FichierExe$

dossierExe$=file_extract_path$(dossierExe$)
caption 32,dossierExe$

' ***********Icône***************************
filter 50,"Icon | *.ico"

dossierIco$=file_name$(50)
if dossierIco$="_" then return

FichierIco$=file_extract_name$(dossierIco$)
caption 31,FichierIco$

dossierIco$=file_extract_path$(dossierIco$)
caption 33,dossierIco$

retour=dll_call1("LoadAnyImageFile",adr(FichierIco$))
stretch_on 41
clipboard_paste 41
dll_off

' *******************************************
if dossierIco$<>dossierExe$
Message "L'icône doit être du même dossier"
caption 21,""
caption 31,""
caption 32,""
caption 33,""
caption 34,""
ext$=""
FichierExe$=""
FichierIco$=""
dossierExe$=""
dossierIco$=""
FichierBat$=""

end_if

inactive 10

' ***************creation du script***************
ext$=file_extract_extension$(FichierExe$)
FichierExe$=left$(FichierExe$,len(FichierExe$)-len(ext$))

file_open_write 1,DossierTemp$+FichierExe$+".scp"
file_writeln 1,"//Ce script change l'icon"
file_writeln 1,""
file_writeln 1," [FILENAMES]"
file_writeln 1," Exe= "+dossierExe$+FichierExe$+".exe"
file_writeln 1," SaveAs= "+dossierExe$+FichierExe$+"_Nouveau.exe"
file_writeln 1,""
file_writeln 1," [COMMANDS]"
file_writeln 1," -addoverwrite "+dossierIco$+FichierIco$+", ICONGROUP,MAINICON,0"
file_close 1

' ***************creation du script .bat***************
dll_on "utils.dll"
FichierBat$=FichierExe$
file_open_write 2,DossierTemp$+FichierBat$+".bat"
file_writeln 2," "+a$+rhacker$+a$+" -script "+a$+DossierTemp$+FichierBat$+".scp"+a$
file_close 2

batch$ = DossierTemp$+FichierBat$+".bat"
retour = DLL_CALL1("ExecuteAndWait", ADR(batch$))
if file_exists(dossierExe$+FichierExe$+"_Nouveau.exe")=1 then caption 34,"OK Fichier Créé"

file_delete DossierTemp$+FichierExe$+".scp"
file_delete DossierTemp$+FichierBat$+".bat"
active 10
dll_off
return

quitte:
dll_on "kgf.dll"
retour = dll_call1("KillProcessByHandle",handle(0))
dll_off
return

mettre l'ouverture d'une bibliothèque pour la version 2
et sera le top
et merci à Klaus et Nardo pour leurs aide je vois que j'ai affaire à des pro :lol!:

Unknown directory line 8....

Bonjour Pascal,

Quelques petites remarques :
- ligne 9 :
Si le répertoire de travail n'existe pas, le programme s'arrête sur une erreur.
Je te conseille d'utiliser le répertoire temporaire de Windows: tu est sûr qu'il existe et cela évite d'avoir autant de répertoires tmp qu'il y a de programme Panoramic

ou alors, tu t'assures de le créer proprement ET de le supprimer à la fin d'exécution du prog.

- ligne 179 :
l'appel à KillProcessByHandle n'est pas nécessaire puisque tu passes dans la procédure 'quitte' suite à l’évènement 'on_close'

Autre :

Chez moi reshacker est installé là :
C:\Program Files (x86)\Resource Hacker\ResHacker.exe

donc à voir l' adresse en dur dans le programme...

Jettes un coup d'oeil sur le source que j'ai mis et sur la façon dont je gère le répertoire C:\TempPano...

Je ne comprend pas pourquoi tu "forces" le rafraichissement du formulaire. Chez moi (win7) ce n'est pas nécessaire.

Si cela ne marche pas chez toi: tu peux faire un HIDE 0 au début et faire un SHOW 0 une fois que tu as créé tout tes objets.

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

bsr
ygeronimi
normal tu tourne avec windows 8! il n'y a que lui qui
prénomme programme files (86) alors que toute les autres
version le nomme programme files

nardo
pour tes questions
1: Si je met hide 0 une fenêtre de panoramic vierge
s’allume et s'éteint aussitôt

2: oui pourquoi pas temp de widows j'en ai mis un d'office
dans le dossier geticon

et enfin le sous programme 'quitte' obligé de le mettre sinon dès
que je quitte geticon il me me fait un plantage mais je ferrai un autre essai
pour voir c'est peut être au niveau de la mémoire qui flanche

bsr Pascal10000,

Je ne suis pas sous W8 mais W7...

Soit, c' est peut être une bizarrerie de microsoft, mais si tu veux que ton programme
soit portable tu dois en tenir compte... Wink

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

ygeronimi
ben le mieux c'est de retirer cette option pour toi!
c blizzard le mien n'est pas nommé avec un (86)

Je suis sous win7 et j'ai la même arborescence que ygeronimi...

Citation :: 1: Si je met hide 0 une fenêtre de panoramic vierge
s’allume et s'éteint aussitôt

Oui et une fois que tu as fini de déclarer tout tes objets dans la fenetre, juste avant le END,
tu mets la commande SHOW 0 pour que le form 0 réapparaisse...

Citation :: et enfin le sous programme 'quitte' obligé de le mettre sinon dès
que je quitte geticon il me me fait un plantage mais je ferrai un autre essai
pour voir c'est peut être au niveau de la mémoire qui flanche

Oui cela doit être cela car aucun d'entre nous utilise une fonction quelconque pour terminer un programme (sauf peut être la commande TERMINATE dans certains cas)

Le truc c'est que parfois, Panoramic plante et l'application "PANORAMIC.EXE" (l'interpreteur: cf gestionnaire des taches) qui est lancé en arriere plan reste en mémoire.
Pour corriger ce problème, j'ai réalisé, il y a un petit moment une application qui permet de "tuer" cette application.
Perso j'ai rajouté un lien vers mon petit utilitaire dans la barre de lancement rapide. En cas de gros plantage, je lance mon utilitaire pour libérer la RAM...

Le lien vers l'utilitaire : kill_pano.exe

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

je suis également sous W 7 intégrale

Je suis sous Window 7 Edition Intégrale et je n’ai pas ce (x86).
J’ai tout simplement Program Files sans plus.

J'ai la version 64 bits et le repertoire x86 existe pour les prog en 32bits:
version final geticon V1.0 Version_win

J' ai la même ! Laughing

Mais je suis jaloux, j' ai que 3.7 en indice de performance ! Laughing

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

ygeronimi
ne pleure pas je n'ai que 3.4

Je pense que le repertoire avec (x86) n'est installé que sur les versions 64 bits.

A confirmer... drunken

Confirmé, Minibug.

En ce qui concerne l'analyse des performances, il y a un problème avec W8.1.
A partir de cette version, le module qui affiche cette information, n'est plus
livré avec le système. Par contre, l'information est toujours présente.
Le programme suivant affiche tous les indices disponibles. Et accessoirement,
il est un excellent exemple d'utilisation de l'objet XML de KGF.dll, car le fichier
résultat exploré est en format XML (environ 140 ko...).

Code:: ' analyse_performances.bas

dim kgf$ : kgf$ = "KGF.dll"
dim perfrep$ : perfrep$ = "C:\Windows\Performance\WinSAT\DataStore"
dim path$ : path$ = "WinSAT/WinSPR"
dim sep$ : sep$ = "/"

dim perf2$, perf1$
dim res%, XML1%, XML2%, name$, data$, rep$, f$

memo 1 : full_space 1 : bar_both 1
button 2 : top 2,200 : left 2,100 : width 2,200

dll_on kgf$

rep$ = dir_current$
dir_change perfrep$
f$ = file_find_first$
while f$<>"_"
if instr(f$,"Formal.Assessment")>0
if instr(f$,"(Initial)")>0 then perf1$ = perfrep$ + "\" + f$
if instr(f$,"(Recent)")>0 then perf2$ = perfrep$ + "\" + f$
end_if
f$ = file_find_next$
end_while
file_find_close
dir_change rep$

if file_exists(perf1$)=1
caption 2,"Chargement du fichier de données..."
XML1% = dll_call1("LoadXmlFromFile",adr(perf1$))

item_add 1,"Analyse de performance d'origine:"

res% = dll_call4("SelectXmlElementByPath",XML1%,0,adr(path$),adr(sep$))
res% = dll_call1("GetFirstXmlChild",XML1%)
while res%>0
if res%>0
name$ = string$(40," ")
data$ = string$(40," ")
res% = dll_call2("GetXmlName",XML1%,adr(name$))
res% = dll_call2("GetXmlData",XML1%,adr(data$))
item_add 1,trim$(name$)+" = "+trim$(data$)
res% = dll_call1("GetNextXmlSister",XML1%)
end_if
end_while
end_if

if file_exists(perf2$)=1
caption 2,"Chargement du fichier de données..."
XML2% = dll_call1("LoadXmlFromFile",adr(perf2$))

item_add 1,""
item_add 1,"Analyse de performance récente:"

res% = dll_call4("SelectXmlElementByPath",XML2%,0,adr(path$),adr(sep$))
res% = dll_call1("GetFirstXmlChild",XML2%)
while res%>0
if res%>0
name$ = string$(40," ")
data$ = string$(40," ")
res% = dll_call2("GetXmlName",XML2%,adr(name$))
res% = dll_call2("GetXmlData",XML2%,adr(data$))
item_add 1,trim$(name$)+" = "+trim$(data$)
res% = dll_call1("GetNextXmlSister",XML2%)
end_if
end_while
end_if

if count(1)<2
item_add 1,"Oups... aucune analyse trouvée dans:"
item_add 1," "+perfrep$
item_add 1,"Dans une fenêtre Dos en mode Administrateur, lancez:"
item_add 1," winsat formal"
item_add 1,"Cela va reconstruire le fichier nécessaire."
end_if

caption 2,"" : hide 2

end

Nickel, il marche très bien sous win7, ton prog Klaus !
C'est même un peu plus détaillé que ce que propose l'interface de windows.

Ce sont simplement les informations disponibles dans le ou les fichiers "...Formal.Assessment..." dans le dossier "C:\Windows\Performance\WinSAT\DataStore". C'est fourni de base, par MicroSoft. J'ai simplement utilisé mon composant XML pour analyser ce fichier. Rien de compliqué...

Petit complément de fonctionnalité pour mon petit utilitaire: l'affichage du fichier XML complet, reconstitué et formaté avec l'indentation adéquate:

Code:: ' analyse_performances.bas

label detail

dim kgf$ : kgf$ = "KGF.dll"
dim perfrep$ : perfrep$ = "C:\Windows\Performance\WinSAT\DataStore"
dim path$ : path$ = "WinSAT/WinSPR"
dim sep$ : sep$ = "/"

dim perf2$, perf1$
dim res%, XML1%, XML2%, name$, data$, rep$, f$

width 0,350 : height 0,600
memo 1 : full_space 1 : bar_both 1
width 1,width(1)
width 0,width(0) + 2*width(1)
memo 3 : width 3,width(1) : height 3,height(1) : bar_both 3 : left 3,width(1)
memo 5 : width 5,width(1) : height 5,height(1) : bar_both 5 : left 5,2*width(1)
button 2 : top 2,200 : left 2,20 : width 2,260
button 4 : top 4,200 : left 4,left(3)+20 : width 4,260 : hide 4
on_click 4,detail : caption 4,"Afficher XML"

dll_on kgf$

rep$ = dir_current$
dir_change perfrep$
f$ = file_find_first$
while f$<>"_"
if instr(f$,"Formal.Assessment")>0
if instr(f$,"(Initial)")>0 then perf1$ = perfrep$ + "\" + f$
if instr(f$,"(Recent)")>0 then perf2$ = perfrep$ + "\" + f$
end_if
f$ = file_find_next$
end_while
file_find_close
dir_change rep$

if file_exists(perf1$)=1
caption 2,"Chargement du fichier de données..."
XML1% = dll_call1("LoadXmlFromFile",adr(perf1$))

item_add 1,"Analyse de performance d'origine:"

res% = dll_call4("SelectXmlElementByPath",XML1%,0,adr(path$),adr(sep$))
res% = dll_call1("GetFirstXmlChild",XML1%)
while res%>0
if res%>0
name$ = string$(40," ")
data$ = string$(40," ")
res% = dll_call2("GetXmlName",XML1%,adr(name$))
res% = dll_call2("GetXmlData",XML1%,adr(data$))
item_add 1,trim$(name$)+" = "+trim$(data$)
res% = dll_call1("GetNextXmlSister",XML1%)
end_if
end_while
show 4
end_if

if file_exists(perf2$)=1
caption 2,"Chargement du fichier de données..."
XML2% = dll_call1("LoadXmlFromFile",adr(perf2$))

item_add 1,""
item_add 1,"Analyse de performance récente:"

res% = dll_call4("SelectXmlElementByPath",XML2%,0,adr(path$),adr(sep$))
res% = dll_call1("GetFirstXmlChild",XML2%)
while res%>0
if res%>0
name$ = string$(40," ")
data$ = string$(40," ")
res% = dll_call2("GetXmlName",XML2%,adr(name$))
res% = dll_call2("GetXmlData",XML2%,adr(data$))
item_add 1,trim$(name$)+" = "+trim$(data$)
res% = dll_call1("GetNextXmlSister",XML2%)
end_if
end_while
show 4
end_if

if count(1)<2
item_add 1,"Oups... aucune analyse trouvée dans:"
item_add 1," "+perfrep$
item_add 1,"Dans une fenêtre Dos en mode Administrateur, lancez:"
item_add 1," winsat formal"
item_add 1,"Cela va reconstruire le fichier nécessaire."
end_if

caption 2,"" : hide 2

end

detail:
hide 4
if XML1%<>0
caption 2,"Conversion des données d'origine - patience..."
show 2
display
res% = dll_call2("SaveXmlToMemo",XML1%,handle(3))
item_insert 3,1,"Données d'origine:"
display
hide 2
end_if
if XML2%<>0
caption 2,"Conversion des données récentes - patience..."
show 2
display
res% = dll_call2("SaveXmlToMemo",XML2%,handle(5))
item_insert 5,1,"Données récentes:"
display
hide 2
end_if
return

Soyez patients - les fichiers XML étant importants, le délai l'est aussi...

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

encore une amélioration de geticon

petit problème lors de l'affichage des dossiers
au niveau des captions de alpha 32 et 33
ils se chevauchais l'un sur l'autre lorsque
les noms étaient trop long, il
a fallut que je trouve une parade pour qu'ils
se coupe en deux
voila la parade

dossierIco$=file_extract_path$(dossierIco$)
if len(dossierIco$)>24
texte$=dossierIco$
texte$=insert$(texte$,chr$(10),instr_pos(texte$,"\",15))
top 33,20
else
texte$=dossierIco$
end_if

caption 33,texte$

de plus si l'opérateur veut faire une 2 eme modif l'aperçu
ne se réinitialisais pas donc la commande hide 41 était
nécessaire pour remédier a cela

et enfin j'ai r'ajouté au caption fichier créé le nom du dossier ainsi que
celui de .exe

geticon est sur mydrive

id:panoramic@pascal10000
code:panoramic123
bon w-end

» base de données final version
» geticon V2
» amélioration de geticon
» Que signifient version "régulière" et version "instantanée"
» Éditeur de texte : Mini Word