Delphi-PRAXiS
Seite 3 von 3     123   

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Win32/Win64 API (native code) (https://www.delphipraxis.net/17-win32-win64-api-native-code/)
-   -   Delphi Welche unit wird benötigt? (https://www.delphipraxis.net/105443-welche-unit-wird-benoetigt.html)

bitsetter 23. Dez 2007 17:35

Re: Welche unit wird benötigt?
 
Du hättest natürlich einige Fehlermeldungen einbauen können oder einfach F7 benutzen. :roll:
Delphi-Quellcode:
procedure TForm1.Button4Click(Sender: TObject);
var
  TB: Commctrl.TBBUTTONINFO; p: Commctrl.PTBBUTTONINFO;
  ProcessHandle, wnd: THandle;
  BytesW, BytesR, ProcId: cardinal;
const
  BtnIndex= 0;
begin
  wnd:= ...;
  GetWindowThreadProcessId(wnd, @ProcId);
  ProcessHandle := OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_READ or PROCESS_VM_WRITE, False, ProcId);
  if ProcessHandle= 0 then
    MessageDlg(format('Fehler bei OpenProcess %s', [SyserrorMessage(getLastError)]), mtError, [mbOk], 0)
  else
    try
      p := VirtualAllocEx(ProcessHandle, nil, SizeOf(TB), MEM_COMMIT, PAGE_READWRITE);
      if Assigned(p) then
      begin
        TB.cbSize := SizeOf(TB);
        TB.dwMask := CommCtrl.TBIF_COMMAND;
        if not WriteProcessMemory(ProcessHandle, p, @TB, SizeOf(TB.cbSize) + SizeOf(TB.dwMask), BytesW) then
          MessageDlg(format('Fehler bei WriteProcessMemory %s', [SyserrorMessage(getLastError)]), mtError, [mbOk], 0);
        if SendMessage(wnd, TB_GETBUTTONINFO, BtnIndex, Cardinal(p))<> BtnIndex then
          MessageDlg('Fehler bei TB_GETBUTTONINFO', mtError, [mbOk], 0);
        if not ReadProcessMemory(ProcessHandle, p, @TB, SizeOf(TB), BytesR) then
          MessageDlg(format('Fehler bei ReadProcessMemory %s', [SyserrorMessage(getLastError)]), mtError, [mbOk], 0);
        if SendMessage(wnd, TB_PRESSBUTTON, TB.idCommand, MAKELONG (1, 0))= 0 then
          MessageDlg('Fehler bei TB_PRESSBUTTON', mtError, [mbOk], 0);
        VirtualFreeEx(ProcessHandle, p, 0, MEM_RELEASE);
      end
      else
        MessageDlg(format('Fehler bei VirtualAllocEx %s', [SyserrorMessage(getLastError)]), mtError, [mbOk], 0);
    finally
      CloseHandle(ProcessHandle);
    end;
end;
EDIT: Was für ein Betriebssystem hast du überhaupt?

ghost007 23. Dez 2007 18:34

Re: Welche unit wird benötigt?
 
Hi,
ich benutze WinXP ... ich hatte n paar ShowMessages eingebaut um den fehler zu lokalisieren ... aber, fehlanzeige

MfG - Ghost007

P.S. Ich werd ma deine letzte fassung testen ^^

[EDIT]
"Fehler bei OpenProcess falscher parameter" spuckt er mir aus
[/EDIT]

bitsetter 23. Dez 2007 19:36

Re: Welche unit wird benötigt?
 
Hast du auch der Variable Wnd das Handle der Toolbar übergeben?
Ansonsten habe ich es jetzt mal zum Testen so gemacht, dass der 2. Button in der Taskbar (ist ja auch eine Toolbar) von WinXP runtergedrückt wird.
Delphi-Quellcode:
procedure TForm1.Button1Click(Sender: TObject);
var
  TB: TTBBUTTON;
  p: PTBBUTTON;
  ProcessHandle, wnd: THandle;
  BytesR, ProcId: cardinal;
  count, loop, idx: integer;
const
  BtnIndex= 2;
begin
  Wnd := FindWindow('Shell_TrayWnd', nil);
  Wnd := FindWindowEx(Wnd, 0, 'ReBarWindow32', nil);
  Wnd := FindWindowEx(Wnd, 0, 'MSTaskSwWClass', nil);
  Wnd := FindWindowEx(Wnd, 0, 'ToolbarWindow32', nil);

  //wnd:=...;
  if isWindow(wnd) then
  begin
    idx:= 0;
    GetWindowThreadProcessId(wnd, @ProcId);
    ProcessHandle := OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_READ or PROCESS_VM_WRITE, False, ProcId);
    if ProcessHandle= 0 then
      MessageDlg(format('Fehler bei OpenProcess %s', [SyserrorMessage(getLastError)]), mtError, [mbOk], 0)
    else
      try
        p := VirtualAllocEx(ProcessHandle, nil, SizeOf(TB), MEM_COMMIT, PAGE_READWRITE);
        if Assigned(p) then
        begin
          count := SendMessage(wnd, TB_BUTTONCOUNT, 0, 0);
          if count= 0 then
            MessageDlg('Fehler bei TB_BUTTONCOUNT', mtError, [mbOk], 0);
          for loop := 0 to pred(count) do
          begin
            if SendMessage(wnd, TB_GETBUTTON, loop, Cardinal(p))= 0 then
              MessageDlg('Fehler bei TB_GETBUTTON', mtError, [mbOk], 0);
            if not ReadProcessMemory(ProcessHandle, p, @TB, SizeOf(TB), BytesR)then
              MessageDlg(format('Fehler bei ReadProcessMemory %s', [SyserrorMessage(getLastError)]), mtError, [mbOk], 0);
            if TB.fsState and TBSTATE_HIDDEN = 0 then//sichtbar
              inc(idx);
            if idx= BtnIndex then
            begin
              if SendMessage(wnd, TB_PRESSBUTTON, TB.idCommand, MAKELONG (1, 0))= 0 then
              MessageDlg('Fehler bei TB_PRESSBUTTON', mtError, [mbOk], 0);
            end;
          end;
          VirtualFreeEx(ProcessHandle, p, 0, MEM_RELEASE);
        end
        else
          MessageDlg(format('Fehler bei VirtualAllocEx %s', [SyserrorMessage(getLastError)]), mtError, [mbOk], 0);
      finally
        CloseHandle(ProcessHandle);
      end;
  end
  else
    MessageDlg('Kein gültiges Fenster Hande', mtError, [mbOk], 0);
end;

ghost007 23. Dez 2007 20:44

Re: Welche unit wird benötigt?
 
Langsam wird das argh strange ... ich hab ezz den code:

Delphi-Quellcode:
procedure TForm1.Button4Click(Sender: TObject);
var
  TB: TTBBUTTON;
  p: PTBBUTTON;
  ProcessHandle, wnd: THandle;
  BytesR, ProcId: cardinal;
  count, loop, idx: integer;
const
  BtnIndex= 2;
begin
  wnd := FindWindow('wxWindowClassNR','VLC media player');
  Wnd := FindWindowEx(Wnd, 0, 'ToolbarWindow32', nil);

  if isWindow(wnd) then
  begin
    idx:= 0;
    GetWindowThreadProcessId(wnd, @ProcId);
    ProcessHandle := OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_READ or PROCESS_VM_WRITE, False, ProcId);
    if ProcessHandle= 0 then
      MessageDlg(format('Fehler bei OpenProcess %s', [SyserrorMessage(getLastError)]), mtError, [mbOk], 0)
    else
      try
        p := VirtualAllocEx(ProcessHandle, nil, SizeOf(TB), MEM_COMMIT, PAGE_READWRITE);
        if Assigned(p) then
        begin
          count := SendMessage(wnd, TB_BUTTONCOUNT, 0, 0);
          if count= 0 then
            MessageDlg('Fehler bei TB_BUTTONCOUNT', mtError, [mbOk], 0);
          for loop := 0 to pred(count) do
          begin
            if SendMessage(wnd, TB_GETBUTTON, loop, Cardinal(p))= 0 then
              MessageDlg('Fehler bei TB_GETBUTTON', mtError, [mbOk], 0);
            if not ReadProcessMemory(ProcessHandle, p, @TB, SizeOf(TB), BytesR)then
              MessageDlg(format('Fehler bei ReadProcessMemory %s', [SyserrorMessage(getLastError)]), mtError, [mbOk], 0);
            if TB.fsState and TBSTATE_HIDDEN = 0 then//sichtbar
              inc(idx);
            if idx= BtnIndex then
            begin
              if SendMessage(wnd, TB_PRESSBUTTON, TB.idCommand, MAKELONG (1, 0))= 0 then
              MessageDlg('Fehler bei TB_PRESSBUTTON', mtError, [mbOk], 0);
            end;
          end;
          VirtualFreeEx(ProcessHandle, p, 0, MEM_RELEASE);
        end
        else
          MessageDlg(format('Fehler bei VirtualAllocEx %s', [SyserrorMessage(getLastError)]), mtError, [mbOk], 0);
      finally
        CloseHandle(ProcessHandle);
      end;
  end
  else
    MessageDlg('Kein gültiges Fenster Hande', mtError, [mbOk], 0);
end;
Hab angeblich kein gültiges window handle ... wobei eine funktion mit dem gleichen handle geht

Delphi-Quellcode:
procedure TForm1.Button3Click(Sender: TObject);
begin
 Label1.Caption:=(IntToStr(SendMessage(wnd,TB_BUTTONCOUNT,0,0)));
end;
Geht wunderbar

MfG - Ghost007

bitsetter 23. Dez 2007 23:22

Re: Welche unit wird benötigt?
 
Liste der Anhänge anzeigen (Anzahl: 1)
Das hättest du ja schon eher sagen können, dass du den VCL Player per Code steuern möchtest, den habe ich nämlich auch. Bei mir funktioniert auch da der Code(siehe Anhang). Die ersten 3 Buttons sind alle gedrückt und das war es auch schon, steuern lässt sich der Player mit dem Code jedenfalls nicht.

Zitat:

Zitat von ghost007
Hab angeblich kein gültiges window handle ... wobei eine funktion mit dem gleichen handle geht

Gibt es ja nicht, war der Player überhaupt an nicht dass das Handle = 0 war, bei mir kommt so eine Meldung nicht.

Ich habe jedoch noch etwas rum experimentiert, mit folgende Code lässt sich der Player bei mir steuern:
Delphi-Quellcode:
  //sendmessage(FindWindow('wxWindowClassNR', 'VLC media player'), WM_COMMAND, $1772, $80326);//Open
  sendmessage(FindWindow('wxWindowClassNR', 'VLC media player'), WM_COMMAND, $1784, $80326);//Play
  //sendmessage(FindWindow('wxWindowClassNR', 'VLC media player'), WM_COMMAND, $1783, $80326);//STOP
  //sendmessage(FindWindow('wxWindowClassNR', 'VLC media player'), WM_COMMAND, $1785, $80326);
  //sendmessage(FindWindow('wxWindowClassNR', 'VLC media player'), WM_COMMAND, $1787, $80326);
  //sendmessage(FindWindow('wxWindowClassNR', 'VLC media player'), WM_COMMAND, $1788, $80326);
  //sendmessage(FindWindow('wxWindowClassNR', 'VLC media player'), WM_COMMAND, $1786, $80326);
  //sendmessage(FindWindow('wxWindowClassNR', 'VLC media player'), WM_COMMAND, $177B, $80326);
Alles in der gleichen Reihenfolge wie in der Toolbar.

ghost007 24. Dez 2007 00:42

Re: Welche unit wird benötigt?
 
Hi,
sorry das ich das mit dem vlc nich erwähnt hatte ... dachte das das bei jeder toolbar gehen sollte :/ und danke für deinen code zum, steuern :).

MfG - Ghost007

P.S. Der Player ist gelaufen ^^


Alle Zeitangaben in WEZ +1. Es ist jetzt 20:58 Uhr.
Seite 3 von 3     123   

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz