Accueil > Forum > > > > Probleme de Handles
Probleme de Handles
dimanche 27 novembre 2005 à 01:06:36 |
Probleme de Handles

Mxbug
|
Yop
voila j'essaye de faire une ptite application d'auto message sur msn ( msn plus avec tout ses sons fait *** ) .
le code est le suivant avec quelques commentaires vite fait :
[quote]unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, MessengerAPIEvents, StdCtrls, WinSkinData;
type
TForm1 = class(TForm)
MessengerAPIDMessengerEvents1: TMessengerAPIDMessengerEvents;
Button1: TButton;
Edit1: TEdit;
Memo1: TMemo;
SkinData1: TSkinData;
procedure Button1Click(Sender: TObject);
procedure MessengerAPIDMessengerEvents1IMWindowCreated(Sender: TObject;
const pIMWindow: IDispatch);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1; // la form
Window: String; //
Handle: THandle; // le handle
Msg: Tmsg;
IMessage: String = ('je teste fais pas attention , merci ');
hwin:Hwnd ;
Wnd:Hwnd; //le handle de la fenetre msn
Tableau: array of Integer;
i : integer ;
implementation
{$R *.dfm}
Function TrimRight(Const S: String): String; // fonction pour avoir le titre
Var
I: Integer;
Begin
I := Length(S);
While (I > 0) And (S[I] <= ' ') Do Dec(I);
Result := Copy(S, 1, I);
end;
Function ActiveHandle: THandle; // fonction pour avoir le handle active
Begin
Result := GetForeGroundWindow;
End;
Function ActiveCaption: String; // fonction pour avoir le titre active
Var
Handle: THandle; // handle qu'on donnera a la conversation ouverte
Len: LongInt;
Title: String; // titre
Begin
hWin := FindWindowA(PChar('IMWindowClass'), Nil); // on trouve la conversation
Handle := hwin; // c ici qu'on donne le handle a la conversation
Len := GetWindowTextLength(Handle) + 1;
SetLength(Title, Len);
GetWindowText(Handle, pChar(Title), Len);
ActiveCaption := TrimRight(Title);
End;
Procedure SendKeys(Const text: String); // pour envoyer le message
Var
i: Integer;
shift: Boolean;
vk, scancode: Word;
ch: Char;
c, s: Byte;
Const
vk_keys: Array[0..9] Of Byte =
(VK_HOME, VK_END, VK_UP, VK_DOWN, VK_LEFT,
VK_RIGHT, VK_PRIOR, VK_NEXT, VK_INSERT,
VK_DELETE);
vk_shft: Array[0..2] Of Byte =
(VK_SHIFT, VK_CONTROL, VK_MENU);
flags: Array[false..true] Of Integer =
(KEYEVENTF_KEYUP, 0);
Begin
shift := false;
For i := 1 To Length(text) Do
Begin
ch := text[i];
If ch >= #250 Then
Begin
s := Ord(ch) - 250;
shift := Not Odd(s);
c := vk_shft[s Shr 1];
scancode := MapVirtualKey(c, 0);
Keybd_Event(c, scancode, flags[shift], 0);
End
Else
Begin
vk := 0;
If ch >= #240 Then
c := vk_keys[Ord(ch) - 240]
Else If ch >= #228 Then
c := Ord(ch) - 116
Else If ch < #32 Then
c := Ord(ch)
Else
Begin
vk := VkKeyScan(ch);
c := LoByte(vk);
End;
scancode := MapVirtualKey(c, 0);
If Not shift And (Hi(vk) > 0) Then
Keybd_Event(VK_SHIFT, $2A, 0, 0);
Keybd_Event(c, scancode, 0, 0);
Keybd_Event(c, scancode,
KEYEVENTF_KEYUP, 0);
If Not shift And (Hi(vk) > 0) Then
Keybd_Event(VK_SHIFT,
$2A, KEYEVENTF_KEYUP, 0);
End;
End;
End;
function TimerFunc (H: hwnd;uMsg : UINT;idEvent : UINT;dwTime : DWORD ): BOOL; stdcall; // pouyr finir l'envoi de message
begin
If (Handle <> ActiveHandle) Then
If (Window <> ActiveCaption) Then
Begin
Window := ActiveCaption;
If Window = ActiveCaption then
Begin
SendKeys(Pchar('Automessage : ' + IMessage + #13));
End;
End;
end;
procedure SwitchToThisWindow(h1: hWnd; x: bool); stdcall; // fonction pour mettre la fenetre en premier plan
external user32 Name 'SwitchToThisWindow';
procedure TForm1.FormCreate(Sender: TObject);
begin
setlength(tableau,10000000);
SetTimer(wnd,0,1000,@TimerFunc); // chaque 1 seconde on revient a la fonction qui envoi le message c a dire timerfunc
SetTimer(form1.handle,0,1000,@TForm1.MessengerAPIDMessengerEvents1IMWindowCreated); // chaque 1 seconde on revient a la fonction qui regarde si quelqun nous a parlé
end;
[color=red]procedure TForm1.MessengerAPIDMessengerEvents1IMWindowCreated(Sender: TObject;
const pIMWindow: IDispatch); //la fonction qui regarde si quelqun nous a parlé
begin
wnd:=FindWindowA(PChar('IMWindowClass'), Nil); // on recherche encore la fenetre et on la donne a wnd
for i:=0 to tableau[10000000] do //on parcour le tableau
if i=integer(wnd) then
break // on arrette la boucle
else //sinon
SwitchToThisWindow(wnd, True); // on met la fenetre au premier plan ( a ce moment timerfunc va envoyer le message )
tableau[i+1]:=integer(wnd) // on stocke dans une cellule du tableau le handle
end;[/color]
procedure TForm1.Button1Click(Sender: TObject);
begin
imessage:=edit1.text;
end;
end.
[/quote]
le probleme vient du code en rouge , avec mon code le programme est supposé a chaque ouverture de fenetre voir si c une fenetre msn , puis envoyer le message si s'en est une , puis stocker la valeur de son handle dans un tableau et puis reparcourir el tableau si il trouve le handle de la fenetre il la laisse tranquille et ne la met pas au premier plan , sinon il la met au premier plan et envoi le message et puis stock encore son handle dans le tableau .
le probleme ici c'est qu'elle devient toujours au premier plan meme si le handle a été inscrit sur le tableau :?.
voila merci esperant avoir été clair .
|
|
dimanche 27 novembre 2005 à 01:11:28 |
Re : Probleme de Handles

Mxbug
|
desolé , je reecris le code ici :
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, MessengerAPIEvents, StdCtrls, WinSkinData;
type
TForm1 = class(TForm)
MessengerAPIDMessengerEvents1: TMessengerAPIDMessengerEvents;
Button1: TButton;
Edit1: TEdit;
Memo1: TMemo;
SkinData1: TSkinData;
procedure Button1Click(Sender: TObject);
procedure MessengerAPIDMessengerEvents1IMWindowCreated(Sender: TObject;
const pIMWindow: IDispatch);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1; // la form
Window: String; //
Handle: THandle; // le handle
Msg: Tmsg;
IMessage: String = ('je teste fais pas attention , merci ');
hwin:Hwnd ;
Wnd:Hwnd; //le handle de la fenetre msn
Tableau: array of Integer;
i : integer ;
implementation
{$R *.dfm}
Function TrimRight(Const S: String): String; // fonction pour avoir le titre
Var
I: Integer;
Begin
I := Length(S);
While (I > 0) And (S[I] <= ' ') Do Dec(I);
Result := Copy(S, 1, I);
end;
Function ActiveHandle: THandle; // fonction pour avoir le handle active
Begin
Result := GetForeGroundWindow;
End;
Function ActiveCaption: String; // fonction pour avoir le titre active
Var
Handle: THandle; // handle qu'on donnera a la conversation ouverte
Len: LongInt;
Title: String; // titre
Begin
hWin := FindWindowA(PChar('IMWindowClass'), Nil); // on trouve la conversation
Handle := hwin; // c ici qu'on donne le handle a la conversation
Len := GetWindowTextLength(Handle) + 1;
SetLength(Title, Len);
GetWindowText(Handle, pChar(Title), Len);
ActiveCaption := TrimRight(Title);
End;
Procedure SendKeys(Const text: String); // pour envoyer le message
Var
i: Integer;
shift: Boolean;
vk, scancode: Word;
ch: Char;
c, s: Byte;
Const
vk_keys: Array[0..9] Of Byte =
(VK_HOME, VK_END, VK_UP, VK_DOWN, VK_LEFT,
VK_RIGHT, VK_PRIOR, VK_NEXT, VK_INSERT,
VK_DELETE);
vk_shft: Array[0..2] Of Byte =
(VK_SHIFT, VK_CONTROL, VK_MENU);
flags: Array[false..true] Of Integer =
(KEYEVENTF_KEYUP, 0);
Begin
shift := false;
For i := 1 To Length(text) Do
Begin
ch := text[i];
If ch >= #250 Then
Begin
s := Ord(ch) - 250;
shift := Not Odd(s);
c := vk_shft[s Shr 1];
scancode := MapVirtualKey(c, 0);
Keybd_Event(c, scancode, flags[shift], 0);
End
Else
Begin
vk := 0;
If ch >= #240 Then
c := vk_keys[Ord(ch) - 240]
Else If ch >= #228 Then
c := Ord(ch) - 116
Else If ch < #32 Then
c := Ord(ch)
Else
Begin
vk := VkKeyScan(ch);
c := LoByte(vk);
End;
scancode := MapVirtualKey(c, 0);
If Not shift And (Hi(vk) > 0) Then
Keybd_Event(VK_SHIFT, $2A, 0, 0);
Keybd_Event(c, scancode, 0, 0);
Keybd_Event(c, scancode,
KEYEVENTF_KEYUP, 0);
If Not shift And (Hi(vk) > 0) Then
Keybd_Event(VK_SHIFT,
$2A, KEYEVENTF_KEYUP, 0);
End;
End;
End;
function TimerFunc (H: hwnd;uMsg : UINT;idEvent : UINT;dwTime : DWORD ): BOOL; stdcall; // pouyr finir l'envoi de message
begin
If (Handle <> ActiveHandle) Then
If (Window <> ActiveCaption) Then
Begin
Window := ActiveCaption;
If Window = ActiveCaption then
Begin
SendKeys(Pchar('Automessage : ' + IMessage + #13));
End;
End;
end;
procedure SwitchToThisWindow(h1: hWnd; x: bool); stdcall; // fonction pour mettre la fenetre en premier plan
external user32 Name 'SwitchToThisWindow';
procedure TForm1.FormCreate(Sender: TObject);
begin
setlength(tableau,10000000);
SetTimer(wnd,0,1000,@TimerFunc); // chaque 1 seconde on revient a la fonction qui envoi le message c a dire timerfunc
SetTimer(form1.handle,0,1000,@TForm1.MessengerAPIDMessengerEvents1IMWindowCreated); // chaque 1 seconde on revient a la fonction qui regarde si quelqun nous a parlé
end;
procedure TForm1.MessengerAPIDMessengerEvents1IMWindowCreated(Sender: TObject;
const pIMWindow: IDispatch); //la fonction qui regarde si quelqun nous a parlé
begin
wnd:=FindWindowA(PChar('IMWindowClass'), Nil); // on recherche encore la fenetre et on la donne a wnd
for i:=0 to tableau[10000000] do //on parcour le tableau
if i=integer(wnd) then
break // on arrette la boucle
else //sinon
SwitchToThisWindow(wnd, True); // on met la fenetre au premier plan ( a ce moment timerfunc va envoyer le message )
tableau[i+1]:=integer(wnd) // on stocke dans une cellule du tableau le handle
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
imessage:=edit1.text;
end;
end.
|
|
dimanche 27 novembre 2005 à 07:48:47 |
Re : Probleme de Handles

Delphiprog
|
Tu as écrit : "le probleme vient du code en rouge".
Serions-nous tous subitement devenus daltoniens ? 
Pensez à cliquer sur Réponse acceptée lorsque la réponse vous convient.
|
|
dimanche 27 novembre 2005 à 11:15:58 |
Re : Probleme de Handles

Mxbug
|
yop
desolé c'est un copier coller d'un autre forum oui je n'ai pas eu de reponse voila le code en rouge :
procedure TForm1.MessengerAPIDMessengerEvents1IMWindowCreated(Sender: TObject;
const pIMWindow: IDispatch); //la fonction qui regarde si quelqun nous a parlé
begin
wnd:=FindWindowA(PChar('IMWindowClass'), Nil); // on recherche encore la fenetre et on la donne a wnd
for i:=0 to tableau[10000000] do //on parcour le tableau
if i=integer(wnd) then
break // on arrette la boucle
else //sinon
SwitchToThisWindow(wnd, True); // on met la fenetre au premier plan ( a ce moment timerfunc va envoyer le message )
tableau[i+1]:=integer(wnd) // on stocke dans une cellule du tableau le handle
end;
|
|
dimanche 27 novembre 2005 à 11:36:19 |
Re : Probleme de Handles

cirec
|
Bonjour MxBug, je suppose que c'est "MessengerAPIDMessengerEvents1IMWindowCreated" qui pose problème, donc ce qui est en Rouge à été modifier ou ajouté
Au passage tu déclares un tableau dinamique et tu lui fixes sa longueur à "10000000" l'intérêt du tableau dinamique c'est justement de pouvoir adapter sa taille au besoin. et " hwnd et THandle " sont de type Integer donc pas besoin de transtyper.
Et pour finir évite de déclarer une variable nomé handle qui pourrait être confondue par le compilateur avec le handle de la form où d'un composent renome le en aHandle par Ex. procedure TForm1.FormCreate(Sender: TObject); begin setlength(tableau,0); SetTimer(wnd,0,1000,@TimerFunc); // chaque 1 seconde on revient a la fonction qui envoi le message c a dire timerfunc SetTimer(form1.handle,0,1000,@TForm1.MessengerAPIDMessengerEvents1IMWindowCreated); // chaque 1 seconde on revient a la fonction qui regarde si quelqun nous a parlé end;
procedure TForm1.MessengerAPIDMessengerEvents1IMWindowCreated(Sender: TObject; const pIMWindow: IDispatch); //la fonction qui regarde si quelqun nous a parlé Var Found : Boolean; begin Found := False; wnd:=FindWindowA(PChar('IMWindowClass'), Nil); // on recherche encore la fenetre et on la donne a wnd If wnd <> 0 Then for i:=0 to High(tableau) do //on parcour le tableau (Tableau[1000000] = 38) if Tableau[i] = wnd then Begin Found := True; break;// on arrette la boucle End; If not Found Then //sinon Begin SetLength(Tableau, Length(Tableau)+1); //on ajoute une entrée au Tableau SwitchToThisWindow(wnd, True); // on met la fenetre au premier plan ( a ce moment timerfunc va envoyer le message ) tableau[High(Tableau)] := wnd // on stocke dans une cellule du tableau le handle End; end;

|
|
dimanche 27 novembre 2005 à 12:12:13 |
Re : Probleme de Handles

Mxbug
|
yop
merci a toi cirec ca marche ;) .
|
|
dimanche 27 novembre 2005 à 12:20:04 |
Re : Probleme de Handles

cirec
|
Content que ca fonctionne et dans l'évenement onClose de ta form tu peux mettre ceci Finalize(Tableau); // libère le tableau dinamique
et je me demande si il ne faut pas liberé ton timer, d'ailleur pourquoi n'utilises tu pas un TTimer  voilà c'est tout Bon dimanche @+ Cirec
|
|
dimanche 27 novembre 2005 à 20:08:36 |
Re : Probleme de Handles

Mxbug
|
yop
j'ai un nouveau ptit probleme ici :
function TimerFunc (H: hwnd;uMsg : UINT;idEvent : UINT;dwTime : DWORD ): BOOL; stdcall; // pouyr finir l'envoi de message
begin
If (Handle <> ActiveHandle) Then
If (Window <> ActiveCaption) Then
Begin
Window := ActiveCaption;
If Window = ActiveCaption then
Begin
SendKeys(Pchar('Automessage : ' + IMessage + #13));
End;
End;
end;
apres le sendkeys j'ai essayé de reduire la fenetre car sinon le prog ne prend pas en compte les autres fenetres , mais je n'y arrive pas elle ne se reduit pas j'ai essayé : showwindow et setwindowpos ,SetForegroundWindow ,en vain :( .
autre idée ??
|
|
dimanche 27 novembre 2005 à 23:06:02 |
Re : Probleme de Handles
|
lundi 28 novembre 2005 à 10:10:34 |
Re : Probleme de Handles

cirec
|

Pour ton petit souci : ShowWindow(handle de la Fenêtre , ShowCommand);
{ ShowWindow() Commands } SW_HIDE = 0; SW_SHOWNORMAL = 1 SW_NORMAL = 1; SW_SHOWMINIMIZED = 2; SW_SHOWMAXIMIZED = 3; SW_MAXIMIZE = 3; SW_SHOWNOACTIVATE = 4; SW_SHOW = 5; SW_MINIMIZE = 6; SW_SHOWMINNOACTIVE = 7; SW_SHOWNA = 8; SW_RESTORE = 9; SW_SHOWDEFAULT = 10; SW_MAX = 10;
Donc pour réduire : ShowWindow(Form1.Handle, SW_MINIMIZE );
et pour la restaurer: ShowWindow(Form1.Handle, SW_RESTORE);

|
|
Cette discussion est classée dans : end, tableau, handle, procedure, begin
Répondre à ce message
Sujets en rapport avec ce message
Hints dans une DLL [ par almi ]
J'ai une fenêtre (TForm) qui fonctionne parfaitement dans mon executable.Si je la place dans une DLL, j'obtiens le message :Ne peut assigner TFont à T
Problème Econversion Error lors de l'affichage d'une info bulle dans une fenetre MDIChild dans une DLL [ par DarkSky ]
Salut a tous,j'ai créer un projet MDI avec Delphi 6 donc les fenetre MDi Filles sont dans une DLL.j'ai une erreur EConversionError a la place de l'aff
pb d'affichage d'un TChart [ par Pegase20 ]
bonjour, J'affiche une autre fiche qui contient un graphique (créé à l'aide d'un TChart) quand je clique sur un bouton.Mon pb c'est que le graph ne
MDI Filles dans une DLL [ par DarkSky ]
..::= DarkSky =::..Salut almi,j'ai exactement le même problème que toi (Hint) sur l'utilisation de MDI Filles dans une DL
Probleme lecture/ecriture dans fichier. [ par Cybric ]
Bonsoir.Je débute avec DELPHI, donc novice.Je recopie tel quel le code de lecture de fichier trouvé dans "tout en poche" et cela ne fonctionne pas. Le
projet de chat avec delphi 7 [ par dk ]
hello every body j'aimerais faire un chat mais voila le probleme (si on peut dire) c ke g delphi 7 avec comme composant installer Tcpserver et Tcpclie
plein derreur a la fermeture de mon prog qui font lanter windows [ par dk ]
voila javais deja eu qq petits soucis avec le prjet de chat que je suis en train de realiser mais jamais a cette ampleur lol, qd je lance mon prog ca
Changer la forme de l'animation matrix [ par Also know as ]
Bonjour,Voici une méthode permettant de créer une animation à la matrix sans sa police.Il suffit juste d'appeler sa Form MainForm, mettre un memo et c
Reutiliser une procedure [ par jimmy69 ]
Bonjour a tous,Voila je debute avec delphi et je suis un peu fade :-) !!!!J'aimerais savoir s'il etait possible de reutiliser une procedure recement d
Aide pour appelé des procédures [ par prevok ]
Lorsque je démarre le programme, pas de problème, je peux aller choisir dans le menu l'option que je veux, qui appelle une procedure, mais quand de ce
Livres en rapport
|
Derniers Blogs
UNE JOLIE-HORLOGE ET PAS QU'UN PEU !UNE JOLIE-HORLOGE ET PAS QU'UN PEU ! par neodante
Pour les possesseurs d'iPhone, ça y est Bijin Tokei - qui se traduit littéralement en Français par " Jolie Horloge " - est arrivé et GRATUITEMENT s'il vous plaît ! Après la version Tokyo, Hokkaido, night club, racing, Gal, "pour les mademoiselles'", . voi...
Cliquez pour lire la suite de l'article par neodante TECHDAYS PARIS 2010 : CONNECTEZ VOS DONNéES à SHAREPOINT 2010 AVEC LES BUSINESS CONNECTIVITY SERVICESTECHDAYS PARIS 2010 : CONNECTEZ VOS DONNéES à SHAREPOINT 2010 AVEC LES BUSINESS CONNECTIVITY SERVICES par ROMELARD Fabrice
Animé par: Gaetan Bouveret et Julien Chomarat Business Connectivity Services (BCS) est dans SharePoint 2010 la version 2 de Business Data Catalog (BDC dans SharePoint 2007). Il s'agit de la solution permettant de visualiser des données provenan...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice [DIVERS] SUIVRE VOS SéRIES PRéFéRéS SUR LA TOILE[DIVERS] SUIVRE VOS SéRIES PRéFéRéS SUR LA TOILE par orion
Comme de nombreux geek, je suis un grand amateur de série TV et je rate régulièrement des épisodes de mes séries préférés. Une solution s'offre à vous avec ce merveilleux site : Tv Gorge - www.tvgorge.com Moteur de recherche à l'appui, vous pouvez ...
Cliquez pour lire la suite de l'article par orion TECHDAYS PARIS 2010 : LA BI DANS SHAREPOINT 2010TECHDAYS PARIS 2010 : LA BI DANS SHAREPOINT 2010 par ROMELARD Fabrice
Animé par: Vincent Bellet et Baptiste Giraudier La BI dans SharePoint 2010, Les nouveaux services d'application dans SP2010 et SQL Server Reporting services 2008 R2. La BI dans SharePoint est généralisée pour tous afin de permettre à tous les coll...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice
Forum
SAVEDIALOGSAVEDIALOG par zeydounnounou
Cliquez pour lire la suite par zeydounnounou
Logiciels
DB-MAIN (9.1.0)DB-MAIN (9.1.0)DB-MAIN is a data-modeling and data-architecture tool. It is designed to help developers and anal... Cliquez pour télécharger DB-MAIN Xilisoft DPG Convertisseur (5.1.37.0120)XILISOFT DPG CONVERTISSEUR (5.1.37.0120)Xilisoft DPG Convertisseur offre aux fans de Nintendo DS une bonne solution leur permettant de dé... Cliquez pour télécharger Xilisoft DPG Convertisseur GraphicsGale (2.01.01)GRAPHICSGALE (2.01.01)GraphicsGale est un logiciel de PixelArt avec de nombreuse fonctionnalités permettant de réalisé ... Cliquez pour télécharger GraphicsGale Architecte 3D (Platinum 2010)ARCHITECTE 3D (PLATINUM 2010)Architecte 3D Platinium vous permet de concevoir facilement les plans votre future maison, de l'é... Cliquez pour télécharger Architecte 3D TeamViewer 5 (TeamViewer 5)TEAMVIEWER 5 (TEAMVIEWER 5)Dépanner un ami,expliquer une manipulation devient un jeu d'enfant.
Prise en main d'un autre ord... Cliquez pour télécharger TeamViewer 5
Comparez les prix

HTC Magic
Entre 429€ et 429€
|