Модераторы: Snowy, bartram, MetalFan, bems, Poseidon, Riply
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Чтоб это исполнялось в определенном окне? 
:(
    Опции темы
hackvl
  Дата 19.1.2011, 15:07 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 42
Регистрация: 21.5.2010

Репутация: нет
Всего: нет



написал скриншот по клику мышы 100х100
теперь нужно чтоб это выполнялось в определенном окне например ICQ
Что и куда дописать?
Код

                         unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;
 
type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Image1: TImage;
    procedure Timer1Timer(Sender: TObject);
   
  end;
 
var
  Form1: TForm1;
   r: integer;
implementation
 
{$R *.dfm}
 
var
  hHook, hThread, hEvent: THandle;
 
function MouseProc(nCode: Integer;
  WParam: WPARAM; LParam: LPARAM): LRESULT stdcall;
begin
  if nCode = HC_ACTION then
    Result := CallNextHookEx(hHook, nCode, WParam, LParam);
  if WParam = WM_LBUTTONDOWN then
    SetEvent(hEvent);
end;

function ThreadProc(lpParameters: Pointer): DWORD; stdcall;
const
  WH_MOUSE_LL = 14;
begin
  hHook := SetWindowsHookEx(WH_MOUSE_LL, @MouseProc, HInstance, 0);
  if hHook <> 0 then
  try
    while True do
      if WaitForSingleObject(hEvent, 10) = WAIT_TIMEOUT then
        Application.HandleMessage
      else
        Exit;
  finally
    UnhookWindowsHook(hHook, @MouseProc);
  end;
end;
  //////////////////////////////////
   procedure ScreenShot(x: Integer;
 y: Integer;
 Width: Integer;
 Height: Integer;
bm: TBitMap);
var
 dc: HDC;
 lpPal: PLOGPALETTE;
begin
 if ((Width = 0) or
   (Height = 0)) then
   Exit;
 bm.Width  := Width;
 bm.Height := Height;
 {get the screen dc}
 dc := GetDc(0);
 if (dc = 0) then
   Exit;
 {do we have a palette device?}
 if (GetDeviceCaps(dc, RASTERCAPS) and
   RC_PALETTE = RC_PALETTE) then
 begin
   {allocate memory for a logical palette}
   GetMem(lpPal,
     SizeOf(TLOGPALETTE) +
   (255 * SizeOf(TPALETTEENTRY)));
   {zero it out to be neat}
   FillChar(lpPal^,
     SizeOf(TLOGPALETTE) +
   (255 * SizeOf(TPALETTEENTRY)),
     #0);
   {fill in the palette version}
   lpPal^.palVersion := $300;
   {grab the system palette entries}
   lpPal^.palNumEntries :=
     GetSystemPaletteEntries(dc,
     0,
     256,
     lpPal^.palPalEntry);
   if (lpPal^.PalNumEntries <> 0) then
     {create the palette}
     bm.Palette := CreatePalette(lpPal^);
   FreeMem(lpPal, SizeOf(TLOGPALETTE) +
   (255 * SizeOf(TPALETTEENTRY)));
 end;
 {copy from the screen to the bitmap}
 BitBlt(bm.Canvas.Handle,
   0,
   0,
   Width,
   Height,
   Dc,
   x,
   y,
   SRCCOPY);
 {release the screen dc}
 ReleaseDc(0, dc);
end;
 /////////////////////////////////
procedure TForm1.Timer1Timer(Sender: TObject);
var
x,y: integer; //координаты курсора
const
  Timeout = 99999999;
begin
  hEvent := CreateEvent(nil, False, False, nil);
  if hEvent <> 0 then
  try
    hThread := CreateThread(nil, 0, @ThreadProc, nil,
      0, PDWORD(nil)^);
    if hThread <> 0 then
    try
      case WaitForSingleObject(hEvent, Timeout) of
        WAIT_TIMEOUT:
          ShowMessage('хахахах.');
        WAIT_OBJECT_0:
///////////////////////////////

       begin
x:=Mouse.CursorPos.X; //соотвествено х
y:=Mouse.CursorPos.Y; //и собственно игрек
//GetCursorPos(pt);
ScreenShot(x-50,y-50,100,100, Image1.Picture.Bitmap); //делаем скрин шот нужного размера в нужном месте
image1.Picture.SaveToFile('C:\s\sc'+inttostr(r)); //сохраняем в файл скрин
r:=r+1; //добавляем единичку чтобы следующий скрин сохранился под другим именем

end;

//////////////////////////////////
      end;
    finally
      CloseHandle(hThread);
    end;
  finally
    CloseHandle(hEvent);
  end;
end;

end.

исходник http://depositfiles.com/files/g16npa5p1
PM MAIL   Вверх
kami
Дата 19.1.2011, 20:31 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1806
Регистрация: 25.8.2007
Где: Санкт-Петербург

Репутация: 15
Всего: 72



Тут нужно не дописать, а переписать.
На каждый чих создается новый поток, который устанавливает новый хук и всё это вместе начинает хорошо тормозить машину...
Хук нужно устанавливать 1 раз - при появлении необходимости в нем. И удалять 1 раз - при потере необходимости в нем. А не делать это неизвестно когда, причем забывая удалить. Вы не думали, что будет, если в ThreadProc сработает exit?
PM MAIL WWW   Вверх
hackvl
Дата 20.1.2011, 02:24 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 42
Регистрация: 21.5.2010

Репутация: нет
Всего: нет



да у меня жестоко начинает тормозить мышка после нескольких нажатий
вот есть другой ху но он почемуто неработает, объясните
Код

unit Unit1;
 
 interface
 
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
   Dialogs, AppEvnts, StdCtrls;
 
 type
   TForm1 = class(TForm)
   procedure ApplicationEventsMessage(var Msg: tagMSG;
       var Handled: Boolean);
   procedure FormClose(Sender: TObject; var Action: TCloseAction);
   procedure FormCreate(Sender: TObject);
   private
     { Private declarations }
   public
     { Public declarations }
   end;
 
 var
   Form1: TForm1;
 
 
 implementation
 
 {$R *.dfm}
 
 var
   JHook: THandle;
 
function JournalProc(Code, wParam: Integer; var EventStrut: TEventMsg): Integer; stdcall;
 var
   Char1: PChar;
 begin
   Result := CallNextHookEx(JHook, Code, wParam, Longint(@EventStrut));
   If Code < 0 then Exit;
   If Code = HC_SYSMODALON then Exit;
   If Code = HC_ACTION
    then
     begin
      If EventStrut.message = WM_LBUTTONDOWN
       then
        begin
  /////////////////////////////////////////     
  timer1.enabled:=true;// Наше действие (я написал чтоб таймер вкл но почемуто неработет?)
  ////////////////////////////////     
 end;
     end;
 end;
 
 
procedure TForm1.FormCreate(Sender: TObject);
begin
 JHook := SetWindowsHookEx(WH_JOURNALRECORD, @JournalProc, hInstance, 0);
 If JHook > 0
  then
   ShowMessage('Запущен')
  else
   ShowMessage('Ошибка запуска');
end;
 
procedure TForm1.ApplicationEventsMessage(var Msg: tagMSG;
       var Handled: Boolean);
begin
{хук автоматом снимается если вызван таск менеджер (Ctrl+Alt+Del)
 или Ctrl+Esc, запускаем поновой}
Handled := False;
If (Msg.message = WM_CANCELJOURNAL)
 then
  JHook := SetWindowsHookEx(WH_JOURNALRECORD, @JournalProc, 0, 0);
end;
 
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 UnhookWindowsHookEx(JHook);
end;
 
end.

PM MAIL   Вверх
kami
Дата 20.1.2011, 08:46 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1806
Регистрация: 25.8.2007
Где: Санкт-Петербург

Репутация: 15
Всего: 72



Цитата(hackvl @  20.1.2011,  02:24 Найти цитируемый пост)
вот есть другой ху но он почемуто неработает, объясните

тьфу на вас еще раз (с) "Иван Васильевич меняет профессию".

Какой таймер не работает? Где он создан? На форме не лежит, в рантайме не создается, событие OnTimer соответственно - не назначено... "и тут тэбэ нэт, и тут тэбэ нэт". Компилятор это пропустил? 
PM MAIL WWW   Вверх
Keeper89
Дата 20.1.2011, 12:29 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 2580
Регистрация: 26.2.2009

Репутация: 14
Всего: 58



kami, А еще говорят Delphi приучает к только формошлепству, а это что?


--------------------
PM MAIL WWW   Вверх
kami
Дата 20.1.2011, 13:58 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1806
Регистрация: 25.8.2007
Где: Санкт-Петербург

Репутация: 15
Всего: 72



Цитата(Keeper89 @  20.1.2011,  12:29 Найти цитируемый пост)
а это что?

А это непонятная, не адаптированная "под себя" вырезка из чьего-то кода, скорее всего - рабочего. Из которого убрано всё нужное и важное, и вместо этого вставлена активация несуществующего таймера.
PM MAIL WWW   Вверх
hackvl
Дата 20.1.2011, 16:09 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 42
Регистрация: 21.5.2010

Репутация: нет
Всего: нет



это я туда написал активацию таймера, кода на форму ето все кидаю и таймер и все, неработает хук етот почемуто
PM MAIL   Вверх
kami
Дата 20.1.2011, 19:22 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1806
Регистрация: 25.8.2007
Где: Санкт-Петербург

Репутация: 15
Всего: 72



Уважаемый hackvl,  пользуйтесь, пожалуйста, правилами великого и могучего русского языка.
Цитата(hackvl @  20.1.2011,  16:09 Найти цитируемый пост)
кода на форму ето все кидаю и таймер и все, неработает хук етот почемуто

Да? А компилятор компилирует и линковщик линкует? Полный код в студию, потому что представленный даже не откомпилируется.
PM MAIL WWW   Вверх
hackvl
Дата 21.1.2011, 02:41 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 42
Регистрация: 21.5.2010

Репутация: нет
Всего: нет



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

                  unit Unit1;
 
 interface
 
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
   Dialogs, AppEvnts, StdCtrls, ExtCtrls;
 
 type
   TForm1 = class(TForm)
    Timer1: TTimer;
   procedure ApplicationEventsMessage(var Msg: tagMSG;
       var Handled: Boolean);
   procedure FormClose(Sender: TObject; var Action: TCloseAction);
   procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
   private
     { Private declarations }
   public
     { Public declarations }
   end;
 
 var
   Form1: TForm1;
    Timer1:TTimer;
 
 implementation
 
 {$R *.dfm}
 
 var
   JHook: THandle;

function JournalProc(Code, wParam: Integer; var EventStrut: TEventMsg): Integer; stdcall;
 var
   Char1: PChar;
   Timer1:TTimer;
 begin
   Result := CallNextHookEx(JHook, Code, wParam, Longint(@EventStrut));
   If Code < 0 then Exit;
   If Code = HC_SYSMODALON then Exit;
   If Code = HC_ACTION
    then
     begin
      If EventStrut.message = WM_LBUTTONDOWN
       then
        begin
         timer1.enabled:=true; /// Наше действие
        end;
     end;
 end;
 
 
procedure TForm1.FormCreate(Sender: TObject);
begin
 JHook := SetWindowsHookEx(WH_JOURNALRECORD, @JournalProc, hInstance, 0);
 If JHook > 0
  then
   ShowMessage('запущен')
  else
   ShowMessage('незапущен');
end;
 
procedure TForm1.ApplicationEventsMessage(var Msg: tagMSG;
       var Handled: Boolean);
begin
{хук автоматом снимается если вызван таск менеджер (Ctrl+Alt+Del)
или Ctrl+Esc, запускаем поновой}
Handled := False;
If (Msg.message = WM_CANCELJOURNAL)
 then
  JHook := SetWindowsHookEx(WH_JOURNALRECORD, @JournalProc, 0, 0);
end;
 
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 UnhookWindowsHookEx(JHook);
end;
 
procedure TForm1.Timer1Timer(Sender: TObject);
begin
close;
end;

end.

PM MAIL   Вверх
kami
Дата 21.1.2011, 13:47 (ссылка) |    (голосов:1) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1806
Регистрация: 25.8.2007
Где: Санкт-Петербург

Репутация: 15
Всего: 72



hackvl, ууу, как всё запущено.
Давайте поиграем в вопрос-ответ по последнему приведенному коду.
Итак, у Вас в модуле Unit1 объявлено 2 таймера:
первый - на форме
Цитата(hackvl @  21.1.2011,  02:41 Найти цитируемый пост)

TForm1 = class(TForm)    
  Timer1: TTimer;

и второй - в теле модуля.
Цитата(hackvl @  21.1.2011,  02:41 Найти цитируемый пост)

var   Form1: TForm1;    
Timer1:TTimer;

Вопрос №1 - какой из этих таймеров будет создан, а какой нетl?
Вопрос №2 - к какому таймеру программа обращается из хука?

Если отвечаете правильно - продолжим разговор. Не ответите - Вам прямая дорога на форум "для новичков" и в DRKB, изучать раздел "создание компонентов в Run-time" и пару сопутствующих, навскидку и не вспомню.

PM MAIL WWW   Вверх
Keeper89
Дата 21.1.2011, 17:53 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 2580
Регистрация: 26.2.2009

Репутация: 14
Всего: 58



kami, ну зачем так грубо? smile человек кого то хакнуть собрался, столько усилий прикладывает, а ты его в раздел для новичков отправил smile


--------------------
PM MAIL WWW   Вверх
kami
Дата 21.1.2011, 19:15 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1806
Регистрация: 25.8.2007
Где: Санкт-Петербург

Репутация: 15
Всего: 72



Keeper89, да я ж не против, пусть хакает. Я тоже тесное знакомство с Delphi и WinAPI можно считать, начал с программы удаленного администрирования.
Цитата(Keeper89 @  21.1.2011,  17:53 Найти цитируемый пост)
ты его в раздел для новичков отправил

Не вижу ничего плохого в этом разделе. Имхо, именно там должны обсуждаться проблемы такого  smile   рода.
PM MAIL WWW   Вверх
Poseidon
Дата 22.1.2011, 03:44 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Delphi developer
****


Профиль
Группа: Комодератор
Сообщений: 5273
Регистрация: 4.2.2005
Где: Гомель, Беларусь

Репутация: 10
Всего: 133



Я вот только боюсь даже предположить что там будет творится в папке, куда будут сохранятся эти скиншоты, через пару дней работы этой программы. Это ж на каждый клик картинка...


--------------------
Если хочешь, что бы что-то работало - используй написанное, 
если хочешь что-то понять - пиши сам...
PM MAIL ICQ   Вверх
hackvl
Дата 22.1.2011, 10:51 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 42
Регистрация: 21.5.2010

Репутация: нет
Всего: нет



все сделал


Это сообщение отредактировал(а) hackvl - 25.1.2011, 05:46
PM MAIL   Вверх
bems
Дата 24.1.2011, 22:21 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Комодератор
Сообщений: 3400
Регистрация: 5.1.2006

Репутация: 21
Всего: 88



hackvl, фриланс в другом месте


--------------------
Обижено школьников: 8
PM MAIL   Вверх
  
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: WinAPI и системное программирование"
Snowybartram
MetalFanbems
PoseidonRrader
Riply

Запрещено:

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Delphi обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи
  • 99% ответов по WinAPI можно найти в MSDN Library, оставшиеся 1% здесь

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, bartram, MetalFan, bems, Poseidon, Rrader, Riply.

 
1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: WinAPI и системное программирование | Следующая тема »


 




[ Время генерации скрипта: 0.1083 ]   [ Использовано запросов: 21 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.