library hackpass;

 

uses

  Windows, Messages, SysUtils,Classes, System;

 

 

 

var

  gHook: DWORD = 0;

  gHandle: DWORD = 0;

const

  WH_MOUSE_LL    = 14;

 

type                                     // структура отлова sheelmouse left or right (up and down)

  LPMSLLHOOKSTRUCT = ^MSLLHOOKSTRUCT;

  {$EXTERNALSYM LPMSLLHOOKSTRUCT}

  tagMSLLHOOKSTRUCT = record

    pt: TPOINT;

    mouseData: DWORD;

    flags: DWORD;

    time: DWORD;

    dwExtraInfo: DWORD;

  end;

  {$EXTERNALSYM tagMSLLHOOKSTRUCT}

  MSLLHOOKSTRUCT = tagMSLLHOOKSTRUCT;

  {$EXTERNALSYM MSLLHOOKSTRUCT}

  TMsllHookStruct = MSLLHOOKSTRUCT;

  PMsllHookStruct = LPMSLLHOOKSTRUCT;

 

 

const

  WM_HOOKWHEEL = WM_APP + 1;

 

 

 

// объявление записи для всех событий в системе

type

 

  TMainMessage=record

    M_Handle:HWND;

    Msg: word;

    wParam: word;

    lParam: longint;

    X: Integer;

    Y: Integer;

    time:Cardinal;

   end;

  PMainMessage=^TMainMessage;

 

 

 

var

  SysHook:HHook=0;

  Wnd:HWnd=0;

 

    hwnd_: HWND;

    message_: UINT;

    wParam_ : WPARAM;

    lParam_ : LPARAM;

    time_   : DWORD;

    pt_     : TPoint;

 

    Main_Message:PMainMessage;

    M_List:TList;

    CurrrentMSec,CurrrentMSec_Pred:Cardinal;

 

 

 

    MwParam_ : WPARAM;

 

 

 

procedure SaveFile_Hook; // Запись событий в файл

var

   i:integer;

   FileName:string;

   f:file;

   Stream:TFileStream;

begin

FileName:=ExtractFilePath(ParamStr(0))+'\mainList.lrst';

        Stream:=TFileStream.Create(FileName,fmCreate);

        Stream.Write(M_List.Count,sizeof(M_List.Count));

        Stream.Free;

 

        Stream:=TFileStream.Create(FileName,fmOpenWrite);

           for i:=0 to M_List.Count-1 do

           begin

                Main_Message:=M_List.Items[i];

                Stream.Write(Main_Message^,sizeof(Main_Message^));

           end;

 

           Stream.Free;

end;

 

function Get_List_Event: WPARAM  export; stdcall;

begin

    Result:=MwParam_;

end;

 

 

//*********************************************

 

 // хук мыши MOUSEWHEEL

function MouseHook(nCode, wParam, lParam: integer): Lresult; stdcall;

var

  lMHS: LPMSLLHOOKSTRUCT;

begin

  if nCode < 0 then

  begin

    Result := CallNextHookEx(0, nCode, wParam, lParam);

    Exit;

  end;

  lMHS := Pointer( lParam );

  case wParam of

    WM_MOUSEWHEEL:

    begin

     MwParam_:=ShortInt(HiWord(lMHS^.mouseData));

 

 

       Wnd:=TMsg(Pointer(lParam)^).hwnd;

 

       hwnd_   :=Wnd;

       message_:=WM_MOUSEWHEEL;//TMsg(Pointer(lParam)^).message;

       wParam_ :=TMsg(Pointer(lParam)^).wParam ;

       lParam_ :=TMsg(Pointer(lParam)^).lParam ;

       time_   :=TMsg(Pointer(lParam)^).time   ;

       pt_     :=TMsg(Pointer(lParam)^).pt     ;

 

                        New(Main_Message);

                        Main_Message^.M_Handle:=hwnd_;

                        Main_Message^.Msg     :=message_;

                        Main_Message^.wParam  :=MwParam_;

                        Main_Message^.lParam  :=lParam_;

                        Main_Message^.X       :=pt_.X;

                        Main_Message^.Y       :=pt_.Y;

                        CurrrentMSec:=GetTickCount;

                        Main_Message^.time:=CurrrentMSec-CurrrentMSec_Pred;

                        CurrrentMSec_Pred:=CurrrentMSec;

                        M_List.Add(Main_Message);

                        SaveFile_Hook;

 

 

      PostMessage( gHandle, WM_APP+1, HiWord(lMHS^.mouseData), 0 );

    end;

  end;

  result := CallNextHookEx(0, nCode, wParam, lParam);

end;

 

 // запуск хук мыши MOUSEWHEEL в вашем приложении

  function SetHook( ANotifyHandle: DWORD ): Boolean;

  begin

    Result := (gHook = 0) and (ANotifyHandle = 0);

    gHook := SetWindowsHookEx(WH_MOUSE_LL, @MouseHook, HInstance, 0);

    result := gHook <> 0;

    gHandle := ANotifyHandle;

  end;

 

 // остановка хук мыши MOUSEWHEEL в вашем приложении

  function RemoveHook: boolean;

  begin

    Result := UnhookWindowsHookEx(gHook);

  end;

 

//*********************************************

 

 

 

 

function SysMgsProc(code:integer; wParam:word; lParam: longint):longint;stdcall; // отлавливаем все остальные события в системе

begin

  // Передаём сообщение другим ловушкам в системе

  CallNextHookEx(SysHook, Code, wparam,lparam);

  // Проверяем сообщение

  if Code = HC_Action then

    begin

       // Получаем идентификатор окна, сгенерировавшего сообщение

       Wnd:=TMsg(Pointer(lParam)^).hwnd;

 

       hwnd_   :=Wnd;

       message_:=TMsg(Pointer(lParam)^).message;

       wParam_ :=TMsg(Pointer(lParam)^).wParam ;

       lParam_ :=TMsg(Pointer(lParam)^).lParam ;

       time_   :=TMsg(Pointer(lParam)^).time   ;

       pt_     :=TMsg(Pointer(lParam)^).pt     ;

 

                        New(Main_Message);

                        Main_Message^.M_Handle:=hwnd_;

                        Main_Message^.Msg     :=message_;

                        Main_Message^.wParam  :=wParam_;

                        Main_Message^.lParam  :=lParam_;

                        Main_Message^.X       :=pt_.X;

                        Main_Message^.Y       :=pt_.Y;

                        CurrrentMSec:=GetTickCount;

                        Main_Message^.time:=CurrrentMSec-CurrrentMSec_Pred;

                        CurrrentMSec_Pred:=CurrrentMSec;

 

               if TMsg(Pointer(lParam)^).message<>WM_MOUSEWHEEL then

                begin

                        M_List.Add(Main_Message);

                        SaveFile_Hook;

                end;

              

 

 

       // Проверяем тип сообщения для снятия звёздочек при вводе пароля

       // Если была нажата левая кнопка мыши

       // и удержана кнопка Control, то ...

       if TMsg(Pointer(lParam)^).message=WM_LButtonDown then

       if ((TMsg(Pointer(lParam)^).wParam and MK_Control) = MK_Control) then

        begin

          // Убрать в окне отправившем сообщение звёздочки

          SendMessage(Wnd,EM_SETPASSWORDCHAR,0,0);

          // Перерисовать окно

          InvalidateRect(Wnd,nil,true);

        end;

    

    end;

end;

 

 

// Процедура запуска  (State=true) и остановки (State=false) в вашем приложении

procedure RunStopHook(State:boolean) export; stdcall;

begin

   //Если State = true, то ...

   if State=true then

   begin

     // Запускаем ловушку

     SysHook := SetWindowsHookEx(WH_GETMESSAGE, @SysMgsProc, HInstance,0);

   end

   else  // иначе

   begin

     UnhookWindowsHookEx(SysHook);

     SysHook:=0;

   end;

end;

 

 

 // экспортируем процедуру и функции в ваше приложение

exports RunStopHook index 1; // 1, 2 ... номера под которыми они будут видны в вашем приложении

exports Get_List_Event index 2;

exports SetHook index 3;

exports RemoveHook index 4;

 

begin

    M_List:=TList.Create;            //  Создаём список

    CurrrentMSec_Pred:=GetTickCount; // Установить начальный отсчёт времени в системе

    MwParam_:=0;                    

end.

 

//***********************************************

 

 

unit unitSapr;

 

...

 

type  // объявление записи для всех событий в системе

//***************  Hook *******************

 

  TMainMessage=record

    Msg: word;

    wParam: word;

    lParam: longint;

    X: Integer;

    Y: Integer;

    time:Cardinal;

    M_Handle:HWND;

   end;

  PMainMessage=^TMainMessage;

 

//***************  Hook *******************

 

...

 

//***************  Hook *******************

        Main_Message:PMainMessage;          // указатель на эту запись

        Button2_Prerevat:boolean;

        procedure Load;                     // прочесть события созданные в режиме 'save' в вашем приложении из файла mainList.lrst

        procedure Powtorit;                 // повторить события созданные в режиме 'save' в вашем приложении

 

//***************  Hook *******************

 

...

 

//***************  Hook *******************

    TrackBar_Speed: TTrackBar;

...

 

  private

    { Private declarations }

 

//***************  Hook *******************

        M_List:TList;                       // класс для чтения событий в Load из mainList.lrst

        CurrrentMSec:Cardinal;

        CurrrentMSec_Pred:Cardinal;

        Button2_bool:boolean;

        Demo_POWTOR:boolean;

//***************  Hook *******************

 

 

//***************  Hook *******************

 

...

  var

    FormSapr: TFormSapr;

 

//***************  Hook *******************

    Glob_M_Handle:HWND;                     // т.к. адрес Handle объектов в вашем приложении при каждом запуске разный,

                        // то поможем узнать что это был за объект при воспроизведении событий

 

 // обьявление для вызова функций и процедуры из hackpass.dll

 procedure RunStopHook(State:boolean) export; stdcall; external 'hackpass.dll' index 1;

 function Get_List_Event:WPARAM  export; stdcall; external 'hackpass.dll' index 2;

 function  SetHook (ANotifyHandle: DWORD ): Boolean  export; stdcall; external 'hackpass.dll' index 3;

 function  RemoveHook: boolean export; stdcall; external 'hackpass.dll' index 4;

 

 

//***************  Hook *******************

 

 

 

 

procedure TFormSapr.FormCreate(Sender: TObject);

 

begin

 

//***************  Hook *******************

    M_List:=TList.Create;

    CurrrentMSec_Pred:=GetTickCount;

    Button2_bool:=true;    

    Button2_Prerevat:=false;

 

//***************  Hook *******************

 

...

 

// Перед воспроизводством события передаём в Powtorit Handle именно того объекта над которым двигалась мышь перед событим !!!

procedure TFormSapr.FormMouseMove(Sender: TObject; Shift: TShiftState; X,

  Y: Integer);

 

begin

//***************  Hook *******************

Glob_M_Handle:=FormSapr.Handle;

//***************  Hook *******************

 

end;

 

procedure TFormSapr.LMDSpeedButton2MouseMove(Sender: TObject;

  Shift: TShiftState; X, Y: Integer);

 

begin

 

         Glob_M_Handle:=TBitBtn(sender).Handle;

end;

 

procedure TFormSapr.StringGrid1MouseMove(Sender: TObject;

  Shift: TShiftState; X, Y: Integer);

begin

    Glob_M_Handle:=StringGrid1.Handle;

 

end;

 

procedure TFormSapr.LMDCheckBox4MouseMove(Sender: TObject;

  Shift: TShiftState; X, Y: Integer);

begin

    Glob_M_Handle:=LMDCheckBox4.Handle;

end;

 

 

procedure TFormSapr.LMDMaskEdit1MouseMove(Sender: TObject;

  Shift: TShiftState; X, Y: Integer);

begin

     Glob_M_Handle:=TLMDMaskEdit(sender).Handle;

end;

 

// и т.д. на всех визуальных объектах

// таким способом можно объявлять одной процедурой для объектов одного класса TBitBtn(sender).Handle;

 

 

// Перед воспроизводством события передаём в Powtorit Handle именно того объекта над которым двигалась мышь перед событим !!!

 

 

 

 

procedure TFormSapr.Load;  // читаем события в M_List из файла mainList.lrst созданного при работе вашего приложения в режиме save

var

    _M_Handle: HWND;

    _Msg     : word;

    _wParam  : word;

    _lParam  : longint;

    _X       : Integer;

    _Y       : Integer;

    _time    : Cardinal;

    _Name    :PAnsiChar;

    Stream: TFileStream;

 

 

   i,PLC:integer;

   FileName:string;

   f:file;

   _plc:integer;

   S_M:STRING;

begin

       if M_List<>nil then

       if  M_List.Count>0 then

       begin

          for i:=0 to M_List.Count-1 do

              Dispose(M_List[i]);

       end;

       FileName:=ExtractFilePath(ParamStr(0))+'\mainList.lrst';

 

  try

 

        Stream:=TFileStream.Create(FileName,fmOpenRead);

        Stream.Read(plc,sizeof(plc));

        plc:=Trunc(Stream.Size/24);

 

           for i:=0 to plc-1 do

           begin

               New(Main_Message);

              _plc:= Stream.Read(Main_Message^,sizeof(Main_Message^));

               M_List.Add(Main_Message);

           end;

 

        Stream.Free;

  Except

    ShowMessage('Aborted'+' : '+ IntToStr(i));

  end;

//  if AllocMemCount <> 0 then

//    MessageBox(0, 'An unexpected memory leak has occurred.', 'Unexpected Memory Leak', MB_OK or MB_ICONERROR or MB_TASKMODAL);

 

   IF I=0 THEN

     S_M:='Прочтено '+IntToStr(i) +' событий. Демонстрация невозможна!'

   else

     S_M:='Прочтено '+IntToStr(i) +' событий. Нажмите Воспроизвести сценарий!';

   Panel_Flash_Stop.SetError(S_M ,cf_Message);

end;

 

 

procedure TFormSapr.Powtorit; // Запускаем режим DEMO вашего приложения. Например для решения рутинных задач.

var

    i,j:integer;

    _CurrrentMSec:Cardinal;

    sped:integer;

 

begin

        CurrrentMSec_Pred:=GetTickCount;

        Main_Message:=M_List.Items[0];

        SendMessage(Main_Message^.M_Handle,Main_Message^.Msg,Main_Message^.wParam,Main_Message^.lParam);

        j:=0;

        for i:=1 to M_List.Count-1 do

        begin

 

            Main_Message:=M_List.Items[i];

 

 

           _CurrrentMSec:=Round(Main_Message^.time/TrackBar_Speed.Position); // так можно изменять скорость демо воспроизведения уменьшая

                                         // искусственно промежутки между событиями см. FormKeyDown ниже

            repeat

              CurrrentMSec:=GetTickCount;

              if (CurrrentMSec-CurrrentMSec_Pred)>=_CurrrentMSec then

              begin

                   Button2_bool:=true;

 

                   SetCursorPos(Main_Message^.X,Main_Message^.Y);  // установить указатель мыши в ту же позицию что и в режиме save

 

                   if Main_Message^.Msg =  WM_MOUSEWHEEL then

                   begin

                          Glob_M_Handle:= FormSapr.Handle;

                          MiddleButton:=Main_Message^.wParam; // передаём в Message.WheelDelta  procedure WMMouseWheel(var Message: TWMMouseWheel); message WM_MOUSEWHEEL;

                          SendMessage(Glob_M_Handle,Main_Message^.Msg,Main_Message^.wParam,Main_Message^.lParam);

                   end

                   else

                            SendMessage(Glob_M_Handle,Main_Message^.Msg,Main_Message^.wParam,Main_Message^.lParam);

 

                              

              end

              else

              Inc(j);

 

              Application.ProcessMessages;

            until Button2_bool;

 

              if Button2_Prerevat then

                 Exit;

                Button2_bool:=false;

 

            CurrrentMSec_Pred:=GetTickCount;

        end;

end;

 

 

 

 

procedure TFormSapr.FormShow(Sender: TObject);

begin

//***************  Hook *******************

 

 if ((ParamCount>0)and(paramstr(1)='save')) then   // если приложение запущено в режиме записи событий

 begin

  RunStopHook(true);                               // запуск мониторов

  SetHook( Self.Handle );

 end;

//***************  Hook *******************

...

end;

 

 

 

procedure TFormSapr.FormClose(Sender: TObject; var Action: TCloseAction);

 

begin

//***************  Hook *******************

  if ((ParamCount>0)and(paramstr(1)='save')) then

  begin

       RunStopHook(false);                        // выключение мониторов

       RemoveHook;

  end;

//***************  Hook *******************

 

end;

 

 

 

 

 

procedure TFormSapr.ColorBtn36Click(Sender: TObject);

begin

      Load;                                          // читать события из файла

end;

 

 

 

procedure TFormSapr.ColorBtn37Click(Sender: TObject);

begin

 

      Powtorit;                                   // воспроизвести эти события

end;

 

 

 

// Это чтобы прервать выполнение DEMO на любом объёкте при демонстрации и перейти в режим работы (одновременный клик левой и правой кнопкой мыши)

procedure TFormSapr.StringGrid1MouseDown(Sender: TObject; // StringGrid, ListBox и т.д.

  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

           if (Shift = [ssLeft,ssRight]) then // нажаты две кнопки мыши - остановить DEMO и перейти к разработке

               FormSapr.Button2_Prerevat:=true;

 

end;

 

 

 

procedure TFormSapr.FormKeyDown(Sender: TObject; var Key: Word; // это чтобы менять скорость воспроизведения на ходу ...

  Shift: TShiftState);

begin

 

 

   if Key =vk_left then

      TrackBar_Speed.Position:=TrackBar_Speed.Position-2;

 

   if Key =VK_RIGHT then

        TrackBar_Speed.Position:=TrackBar_Speed.Position+2;

 

   if TrackBar_Speed.Position<1 then

      TrackBar_Speed.Position:=1

   else

   if TrackBar_Speed.Position>100 then

      TrackBar_Speed.Position:=100;

 

end;