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
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ć.
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]http://www.youtube.com/watch?v=F_XUOTxk92U[/url]
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.
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.
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.
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.
Zarejestruj się i dołącz do największej społeczności programistów w Polsce.
Otrzymaj wsparcie, dziel się wiedzą i rozwijaj swoje umiejętności z najlepszymi.