SendMessage i DLL

0

Witam.

Poszukuję rozwiązania na przesłanie danych z jednego programu, a żeby odbierała to DLL'ka w drugim programie.
Na myśl przyszło mi rozwiązanie SendMessage, ale nie za bardzo wiem jak to zrealizować w DLL bo między samymi programami nie mam z tym problemu. Chyba że ktoś zna inny sposób jak to zrealizować?

Pozdrawiam
Vampir8

0

Chciałem Tobie pokazać przykładowe źródlo, ale pod Windows 7 to co działąlo na XP - już nie działa. Nie umiem zahookować funkcji SendMessageW kiedy wciskam klawisze w kalkulatorze. Wiadomo klasa okna się zmieniła, ale w ogóle uchwyt do okna w procedurze obsługi Hooka nie pokrywa się ani z oknem kalkulatora ani z tym co pokazuje API Monitor. A użycie API monitora jakby wpływa na działanie dllki z hookiem, będę musiał poszukać informacji jak zalożyć Hooka pod 64 bitowym systemem, ale co ciekawe korzystający z tych samych rozwiązań Hook na CreateDirectoryW działa ok. Także po walce trwającej z jakieś 4 godziny, i kombinacjach - poddaje się. A wracając do Twojego pytania. Możesz w dllce utworzyć okno zwykłe lub dialogowe i wtedy jeżeli zrobisz to w WinAPI to dllka nie spuchnie nieziemsko, a w procedurze obsługi komunikatów możesz przechwycić to co potrzebujesz. Możesz też to zrobić pod VCL tworząc formatkę i również obslużyć komunikaty. Jeżeli chcesz przekazywać komunikatem tekst to pogoogluj w celu znalezienia informacji na temat komunikatu WM_COPYDATA i przykładów. A tak w ogóle, po co komunikatami chcesz to robić. Przecież możesz wywołać jakąs wyeksportowaną funkcje ktora zwróci do programu to co potrzebujesz. Chociaż nie wiem co chcesz osiągnąć. Może podaj dokładny przykład, co chcesz zrobić.

0

Otóż napisałem sobie program który odbiera komunikaty od podłączonych urządzeń MIDI. Musiałem zrobić tak ponieważ ten drugi program korzysta z pluginów i wtedy mogłem wrzucić tylko jeden moduł na jedno urządzenie bo inaczej był problem z otwartym urządzeniem no i organicznie komunikatów dla jednego urządzenia do 64.
Więc to co zbiera mój program chciał bym wysyłać do każdego modułu w programie stworzonego przez plugin a potem sobie w nim filtrować co chce odebrać.
Program mniej więcej wygląda tak [url]

]

0

To najprościej chyba tak, jak wspomniałem: stworzyć w module dllki niewidoczne okno w WinAPI i niech ono odbiera komunikaty w procedurze obsługi okna, a później innym programem wysyłasz komunikaty przez SendMessage zamiast uchwytu podając stałą HWND_BROADCAST, która spowoduje, że komunikat "rozejdzie się" do wszystkich okien.

0

No i jest problem, bo jak tworze okno wtedy program się zatrzymuje, tak jakby przerywał tworzenie okna.
Jak zakomentuje "while GetMessage(msg, 0, 0, 0) do DispatchMessage(msg);"
wtedy wtyczka tworzy się normalnie lecz okno się nie ukazuje.

Ogólnie jest jeszcze chyba taka opcja żeby główny program odbierał komunikaty i jakoś żeby dll to odbierała?
Bo kod głównego programu posiadam, tylko jak to ogarnąć żeby działało tylko na te moduły?

Oto cały kod na którym działam:

library in_midi;

uses
  SysUtils,
  Windows,
  StdCtrls,
  Graphics,
  Messages,
  CheckLst,
  SyncObjs,
  INIFiles,
  Utils,
  FileCtrl,
  common in '..\common.pas';

{$R *.RES}

type
    TMyEvent = Record
        MidiMessage: Byte;      { MIDI message status byte }
        Data1: Byte;            { MIDI message data 1 byte }
    Data2: Byte;
    Control: Byte;          { button, fader, encoder }
    level : Tlevel;
  end;

type
  TDetails = class(TObject)
  public
    gbDetails:        TGroupBox;
    lbxInputDevices:           TCheckListBox;
    flbConfig:        TFileListBox;
    scheme:   string;
    lConfig, lScheme: TLabel;
    output : array [1..64] of TSpectrum;
    outEvent: array [1..64] of TMyEvent;
    procedure lbxInputDevicesClickCheck(Sender: TObject);
    procedure flbConfigClick(Sender: TObject);
    procedure LoadFromINI;
  private
    fCriticalSection: TCriticalSection;
  public
    procedure DoMidiInData( const aDeviceIndex: integer; const aStatus, aData1, aData2: byte );
  end;

var
  Wnd: TWndClass;  // klasa okna
  Msg: TMsg;

procedure TDetails.lbxInputDevicesClickCheck(Sender: TObject);
begin

end;

procedure TDetails.LoadFromINI;
  var INI : TINIFile;
  i : integer;
begin
 begin
//   showmessage(getappdir + 'midi\' + ExtractFileName(flbConfig.FileName));
  INI := TINIFile.Create(getappdir + 'midi\' + ExtractFileName(flbConfig.FileName));
  try
    for i := 1 to 64 do begin
    outevent[i].MidiMessage := INI.ReadInteger('Output'+ inttostr(i), 'Message', 144);
    outevent[i].Data1 := INI.ReadInteger('Output'+ inttostr(i), 'Data1', 0);
    outevent[i].Control := INI.ReadInteger('Output'+ inttostr(i), 'Control', 0);
    end;
  finally
    INI.Free;
  end;
  end;
end;

procedure TDetails.flbConfigClick(Sender: TObject);
begin
  if length(flbConfig.FileName) > 0 then
    begin
    LoadFromINI;
    scheme:=flbConfig.FileName;
    end;
end;

procedure TDetails.DoMidiInData(const aDeviceIndex: integer; const aStatus,
  aData1, aData2: byte);
var
    thisEvent: TMyEvent;
  i: integer;
begin
  // skip active sensing signals from keyboard
  if aStatus = $FE then Exit;

  fCriticalSection.Acquire;
  try
            begin
            thisEvent.MidiMessage :=aStatus;
      thisEvent.Data1 :=aData1;
      thisEvent.Data2 :=aData2;
      for i:=1 to 64 do
        begin
          if (outevent[i].MidiMessage >= $90) and (outevent[i].MidiMessage <= $9F) then //note on
            if thisevent.MidiMessage = outevent[i].MidiMessage then
              begin
              if thisevent.Data1 = outevent[i].Data1 then
                begin
                  if thisevent.Data2 > $00 then Createspectrum(Output[i],levelmax);
                  if thisevent.Data2 = $00 then Createspectrum(Output[i],levelmin);
                end;
              end else
              if thisevent.MidiMessage = (outevent[i].MidiMessage - $10) then
              if thisevent.Data1 = outevent[i].Data1 then
                begin
                  Createspectrum(Output[i],levelmin);
                end;
          if (outevent[i].MidiMessage >= $B0) and (outevent[i].MidiMessage <= $BF) then //control change
          if thisevent.MidiMessage = outevent[i].MidiMessage then
            if thisevent.Data1 = outevent[i].Data1 then
              begin
              case outevent[i].Control of
                0,1: outevent[i].level := (thisevent.Data2 * 5119) div 127;
                2: begin
                     if thisevent.Data2 > $40 then
                       if (outevent[i].level + thisevent.Data2) >= levelmax
                         then outevent[i].level := levelmax else
                           outevent[i].level := outevent[i].level + abs(thisevent.Data2-64);
                     if thisevent.Data2 < $40 then
                     if ((outevent[i].level - thisevent.Data2) <= levelmin) or
                        ((outevent[i].level - thisevent.Data2) > levelmax)
                       then outevent[i].level := levelmin else
                         outevent[i].level := outevent[i].level - abs(thisevent.Data2-64);
                   end;
                end;
                Createspectrum(Output[i],outevent[i].level);
              end;
          if (outevent[i].MidiMessage >= $E0) and (outevent[i].MidiMessage <= $EF) then //pitch bend
            if thisevent.MidiMessage = outevent[i].MidiMessage then
              begin
              outevent[i].level :=10 *(((thisevent.Data2 * 128) + thisevent.Data1) div 32);
               Createspectrum(Output[i],outevent[i].level);
               end;
            end;

            end;

  finally
    fCriticalSection.Leave;
  end;
end;

function init(name: PChar; nameLength: DWORD): DWORD; cdecl;
begin
  Result := return('IMidi1|Hardware', name, nameLength);

end;

function WndProc(Wnd: HWND; uMsg: UINT; wPar: WPARAM; lPar: LPARAM): LRESULT; stdcall;
begin
{ na początek zwracamy wartość 0 ? meldunek jest przetwarzany }
  Result := 0;
  case uMsg of
   { w tym miejscu należy obsłużyć należne komunikaty }
   { w funkcji DefWindowProc przekazujemy takie same parametry, jak w funkcji okienkowej }
    WM_DESTROY: PostQuitMessage(0);
    else
     Result := DefWindowProc(Wnd, uMsg, wPar, lPar);
  end;
end;

function create(controlHandle: THandle): PLightningModule; cdecl;
var
  myDetails: TDetails;
begin
  New(Result);
  with Result^ do
  begin
    handle        := controlHandle;
    title         := 'Midi in';
    settings      := True;
    width         := -1;
    height        := -1;
    inputTop      := -1;
    infoTop       := -1;
    outputTop     := -1;
    inputs        := 0;
    outputs       := 6;
    inputTooltip  := '';
    outputTooltip := '';
    reserved      := nil;
    myDetails     := TDetails.Create;
    details       := myDetails;
  end;

  with Wnd do
  begin
    lpfnWndProc := @WndProc; // funkcja okienkowa
    hInstance := hInstance; // uchwyt do zasobów
    lpszClassName := 'My1stApp'; // klasa
    hbrBackground := COLOR_WINDOW; // kolor tła
  end;

  RegisterClass(Wnd); // zarejestruj nową klasę

  CreateWindow('My1stApp', 'Pierwszy program w WinAPI',WS_VISIBLE,0, 0, 100, 100,
  0, 0, hInstance, NIL);

  while GetMessage(msg, 0, 0, 0) do DispatchMessage(msg);
end;

function  action(lightningModule: PLightningModule; input, output: Integer; inputConnected, outputConnected: PChar; var bridge: TSpectrum): Boolean; cdecl;
var
  details: TDetails;
begin
  details := TDetails(lightningModule.details);

  bridge := details.Output[output];

  Result := true;
end;

procedure show(lightningModule: PLightningModule; handle: THandle); cdecl;
begin
  with TDetails(lightningModule.details) do
  begin
    gbDetails := TGroupBox.Create(nil);
    with gbDetails do
    begin
      Top          := detailsTop;
      Left         := detailsLeft;
      Width        := detailsWidth;
      Height       := detailsHeight;
      Ctl3D        := True;
      Color        := clBtnFace;
      Caption      := 'Midi Settings';
    end;

    lConfig := TLabel.Create(gbDetails);
    with lConfig do
    begin
      AutoSize   := True;
      Top        := 20;
      Left       := 8;
      Caption    := 'Devices:                                                          Scheme:';
      Parent     := gbDetails;
    end;

    lScheme := TLabel.Create(gbDetails);
    with lscheme do
    begin
      AutoSize   := True;
      Top        := 20;
      Left       := 400;
      Caption    := Scheme;
      Parent     := gbDetails;
    end;

    lbxInputDevices := TCheckListBox.Create(gbDetails);
    with lbxInputDevices do
    begin
      Top        := 40;
      Left       := 8;
      Width      := 208;
      Height     := 126;
      onClickCheck := lbxInputDevicesClickCheck;
      Parent     := gbDetails;
    end;

    flbConfig := TFileListBox.Create(gbDetails);
    with flbConfig do
    begin
      Top       := 40;
      Left      := 224;
      width     := 260;
      height    := 126;
      mask      := '*.ini';
      OnClick   := flbConfigClick;
      //Directory := GetAppDir;
      Parent    := gbDetails;
    end;

     gbDetails.ParentWindow := handle;
   //  lbxInputDevices.Items.Assign(MidiInput1.Devices );
       flbConfig.Directory:=getappdir+ 'midi\';
  end;
end;

procedure hide(lightningModule: PLightningModule); cdecl;
begin
  with TDetails(lightningModule^.details) do
  begin
    lbxInputDevices.Free;
    gbDetails.Free;
  end;
end;

procedure open(lightningModule: PLightningModule; settings: PChar); cdecl;
var
  bString: string;
begin
  bString := settings;
  with TDetails(lightningModule^.details) do
   // value := StrToIntDef(parse(bString, ','), 1);
end;

function  save(lightningModule: PLightningModule; settings: PChar; settingsLength: DWORD): DWORD; cdecl;
begin
  with TDetails(lightningModule^.details) do
   // Result := return(IntToStr(value), settings, settingsLength);
end;

procedure destroy(lightningModule: PLightningModule); cdecl;
var
  Details: TDetails;
begin
  details :=TDetails(lightningModule.details);
  FreeAndNil(details.fCriticalSection );
  TDetails(lightningModule^.details).Free;
  Dispose(lightningModule);
end;

exports
  init, create, action, show, hide, open, save, destroy;
end. 
0

Spróbuj AllocateHwnd i oczywiscie DeallocateHWnd przy zwalnianiu biblioteki.

0

Niestety ale AllocateHwnd też nie pomaga. Ale tak przeglądając internet wpadłem na pomysł
żeby to robić odwrotnie, otóż nie wysyłać do "DLL" tylko żeby DLL odpytywała drugą aplikację.

SendMessage(Uchwyt, WM_GETTEXT, SizeOf(Tekst), integer(@Tekst)); 

tylko problem taki ze zwraca mi to nazwę okna.

0

No tak wysłane SendMessage zwróci tekst z kontrolki której uchwyt podaleś w pierwszym parametrze. Jeżeli chcesz uzyskać uchwyty konkrolek z okna rodzica to poczytaj o funkcji EnumChildWindows. W google są przykłady jej użycia pod Delphi. A okno dllki jeżeli nie chcesz tego robić w VCL'u żeby nie spuchła to zrób puste okno dialogowe może być pusty zasób. Na przykład kiedyś kAzek tutaj doradzil mi taką sztuczkę, że jak chce program w WinAPI bez belki na pasku start, a nie chce zmieniać stylu widocznego okna dialogowego na taki bez paska (bo wtedy brzydko wygląda belka tytułowa z małym "X"'em i tym podobne wizualne dziwoty, przynajmniej pod XP bez kompozycji wygląda nieciekawie) to robisz plik *.rc z definicją niewidocznego okna zasobu na przykład takie:

#define IDC_TAPPFORM 1000
IDC_TAPPFORM DIALOGEX 0 0 0 0
WS_EX_TOOLWINDOW
FONT 8, "MS Sans Serif", 400, 0
{
}

Kompilujesz brcc32.exe do *.res i później w dllce coś w stylu:

//...
const
  IDC_TAPPFORM = 1000;
//...
function HiddenDlgProc(hWnd : HWND; uMsg, wParam, lParam : Longint) : Bool; stdcall;
var
  Msg : TMsg;
  DlgH : Dword;
begin
  Result := False;
  // Poniżej obslugujesz komunikaty.
  case uMsg of
    WM_INITDIALOG :
      begin
        HiddenDialogHandle := hWnd;
        ShowWindow(HiddenDialogHandle, SW_HIDE);
        Result := True;
      end;
  end;
end;
// ...
var
  Res : integer;
begin
  hInstance := GetModuleHandle(nil);
  Res := DialogBoxParamA(hInstance, MAKEINTRESOURCE(IDC_TAPPFORM), 0, @HiddenDlgProc, 0);
  ExitProcess(Res);
end.

Bo być może faktycznie w dllce TranslateMessage i DispatchMessage - "głupieją". Chociaż nie powinny raczej, bo komunikaty dllka i jej okno pod VCL mogą spokojnie odbierać. Nie pisałem nigdy usługi, ale o ile się orientuje z tego co kiedyś przeczytałem to wiem, że jedynie usługa nie może chyba odbierać komunikatów oraz posiadać okna. Jednak jeżeli się mylę to mnie poprawcie. A jak chcesz tworzyć proste okna dialogowe w zasobach to możesz się wspomóc programem ResED z http://radasm.cherrytree.at/resed/ bardziej przewidziany dla ASM'a, ale na ogół proste pliki tc robi zgodne z brcc32.exe. Ewentualnie jakiś tam wiersz z czcionką poprawić. Jest też konwerter plików dfm do rc ale obsluguje tylko bardzo stare wersje Delphi na pewno poniżej 7.

1 użytkowników online, w tym zalogowanych: 0, gości: 1, botów: 0