Přidat otázku mezi oblíbenéZasílat nové odpovědi e-mailem Delphi stisknuti klaves

Nie je to až také zložité, ale zas ani úplne jednoduché. :-)

uses tlhelp32;

type
  PEnumInfo = ^TEnumInfo;
  TEnumInfo = record
  ProcessID: DWORD;
  HWND: THandle;
  end;

function GetProcessID(ProcessName:string):Integer;
var
  Handle: tHandle;
  Process: tProcessEntry32;
  GotProcess: Boolean;
begin
  Handle:=CreateToolHelp32SnapShot(TH32CS_SNAPALL,0) ;
  Process.dwSize:=SizeOf(Process);
  GotProcess := Process32First(Handle,Process);
{$B-}
  if GotProcess and (Process.szExeFile<>ProcessName) then
  repeat
    GotProcess := Process32Next(Handle,Process);
  until (not GotProcess) or (Process.szExeFile=ProcessName);
{$B+}
  if GotProcess then Result := Process.th32ProcessID
  else Result := 0;
  CloseHandle(Handle);
end;

function EnumWindowsProc(Wnd: DWORD; var EI: TEnumInfo): Bool; stdcall;
var
  PID: DWORD;
begin
  GetWindowThreadProcessID(Wnd, @PID);
  Result := (PID <> EI.ProcessID) or (not IsWindowVisible(WND)) or
                (not IsWindowEnabled(WND));
  if not Result then EI.HWND := WND; //break on return FALSE
end;

function FindMainWindow(PID: DWORD): DWORD;
var
  EI: TEnumInfo;
begin
  EI.ProcessID := PID;
  EI.HWND := 0;
  EnumWindows(@EnumWindowsProc, Integer(@EI));
  Result := EI.HWND;
end;

function GetProcessHandle(str: string): THandle;
var
  PID : Integer;
begin
  PID:=GetProcessID(str);
  Result:=FindMainWindow(PID);
end;

procedure TForm7.Timer1Timer(Sender: TObject);
var
  Hx: THandle;
begin
   Hx := GetProcessHandle('firefox.exe');
   if hx <> 0 then
   begin
     SetForeGroundWindow(hx);
     keybd_event(VK_CONTROL, 1,0,0);                  //Send Ctrl down
     keybd_event(VK_TAB, 1,0,0);                      //Send Tab down
     keybd_event(VK_TAB, 1,KEYEVENTF_KEYUP,0);        //Send Tab up
     keybd_event(VK_CONTROL, 1, KEYEVENTF_KEYUP,0);   //Send Ctrl up}
   end;
end;
Napísané a testované mnou pod DELPHI XE2 na WIN7-64...

Reakce na odpověď

1 Zadajte svou přezdívku:
2 Napište svou odpověď:
3 Pokud chcete dostat ban, zadejte libovolný text:

Zpět do poradny