Delphi эмуляция клавиатуры и мышки в windows

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, Clipbrd, ExtCtrls, Menus, JPEG;

type

TForm1 = class(TForm)

Timer1: TTimer;

fooX: TLabel;

fooY: TLabel;

MainMenu1: TMainMenu;

N1: TMenuItem;

Weboffice1: TMenuItem;

N2: TMenuItem;

N3: TMenuItem;

Memo1: TMemo;

Edit1: TEdit;

Button2: TButton;

Button3: TButton;

Button4: TButton;

Button5: TButton;

Button6: TButton;

Button7: TButton;

Button8: TButton;

Button9: TButton;

Button10: TButton;

Button11: TButton;

Button12: TButton;

Button13: TButton;

Button14: TButton;

Button15: TButton;

Button16: TButton;

Button17: TButton;

procedure FormCreate(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure Timer1Timer(Sender: TObject);

procedure Weboffice1Click(Sender: TObject);

procedure N2Click(Sender: TObject);

procedure N3Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

procedure Button4Click(Sender: TObject);

procedure Button5Click(Sender: TObject);

procedure Button6Click(Sender: TObject);

procedure Button7Click(Sender: TObject);

procedure Button8Click(Sender: TObject);

procedure Button9Click(Sender: TObject);

procedure Button10Click(Sender: TObject);

procedure Button11Click(Sender: TObject);

procedure Button12Click(Sender: TObject);

procedure Button13Click(Sender: TObject);

procedure Button14Click(Sender: TObject);

procedure Button15Click(Sender: TObject);

procedure Button16Click(Sender: TObject);

procedure Button17Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

ClipBoard: TClipboard;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

begin

Form1.FormStyle := fsStayOnTop;

ClipBoard:=TClipboard.Create;

end;

procedure TForm1.Button1Click(Sender: TObject);

var p: TPoint;

var i: integer;

begin

ClipBoard.SetTextBuf('Клиент не взял трубку.');

SetCursorPos(200,125);

mouse_event(MOUSEEVENTF_LEFTDOWN,200,125,0,0);

mouse_event(MOUSEEVENTF_LEFTUP,200,125,0,0);

sleep(10);

keybd_event(VK_LCONTROL, 0, 0, 0); //Нажатие левого Ctrl.

keybd_event(Ord('V'), 0, 0, 0);

keybd_event(Ord('V'), 0, KEYEVENTF_KEYUP, 0); //Отпускание 'z'.

keybd_event(VK_LCONTROL, 0, KEYEVENTF_KEYUP, 0); //Отпускание левого Ctrl.

Mouse_Event(MOUSEEVENTF_WHEEL, 0, 0,DWORD(-120), 0);

sleep(1000);

Mouse_Event(MOUSEEVENTF_WHEEL, 0, 0,DWORD(-120), 0);

sleep(1000);

Mouse_Event(MOUSEEVENTF_WHEEL, 0, 0,DWORD(-120), 0);

sleep(2000);

For i:=125 to 335 do

Begin

SetCursorPos(200,i);

sleep(10);

End;

end;

procedure TForm1.Timer1Timer(Sender: TObject);

var foo: TPoint;

begin

GetCursorPos(foo);

fooX.Caption := IntToStr(foo.X);

fooY.Caption := IntToStr(foo.Y);

end;

procedure TForm1.Weboffice1Click(Sender: TObject);

begin

sleep(10);

ClipBoard.SetTextBuf('n');

SetCursorPos(730,455);

mouse_event(MOUSEEVENTF_LEFTDOWN,730,455,0,0);

mouse_event(MOUSEEVENTF_LEFTUP,730,455,0,0);

sleep(10);

keybd_event(VK_LCONTROL, 0, 0, 0); //Нажатие левого Ctrl.

keybd_event(Ord('A'), 0, 0, 0);

keybd_event(Ord('A'), 0, KEYEVENTF_KEYUP, 0); //Отпускание 'z'.

keybd_event(VK_LCONTROL, 0, KEYEVENTF_KEYUP, 0); //Отпускание левого Ctrl.

keybd_event(VK_DELETE, 0, 0, 0); //Нажатие Delete

keybd_event(VK_DELETE, 0, KEYEVENTF_KEYUP, 0); //Отпускание

keybd_event(VK_LCONTROL, 0, 0, 0);

keybd_event(Ord('V'), 0, 0, 0);

keybd_event(Ord('V'), 0, KEYEVENTF_KEYUP, 0);

keybd_event(VK_LCONTROL, 0, KEYEVENTF_KEYUP, 0);

sleep(950);

SetCursorPos(945,455);

mouse_event(MOUSEEVENTF_LEFTDOWN,945,455,0,0);

mouse_event(MOUSEEVENTF_LEFTUP,945,455,0,0);

sleep(10);

keybd_event(VK_LCONTROL, 0, 0, 0); //Нажатие левого Ctrl.

keybd_event(Ord('A'), 0, 0, 0);

keybd_event(Ord('A'), 0, KEYEVENTF_KEYUP, 0); //Отпускание 'z'.

keybd_event(VK_LCONTROL, 0, KEYEVENTF_KEYUP, 0); //Отпускание левого Ctrl.

keybd_event(VK_DELETE, 0, 0, 0); //Нажатие Delete

keybd_event(VK_DELETE, 0, KEYEVENTF_KEYUP, 0); //Отпускание

ClipBoard.SetTextBuf('d');

keybd_event(VK_LCONTROL, 0, 0, 0);

keybd_event(Ord('V'), 0, 0, 0);

keybd_event(Ord('V'), 0, KEYEVENTF_KEYUP, 0);

keybd_event(VK_LCONTROL, 0, KEYEVENTF_KEYUP, 0);

sleep(950);

SetCursorPos(1150,450);

mouse_event(MOUSEEVENTF_LEFTDOWN,1150,450,0,0);

mouse_event(MOUSEEVENTF_LEFTUP,1150,450,0,0);

end;

procedure TForm1.N2Click(Sender: TObject);

begin

sleep(10);

ClipBoard.SetTextBuf('eh');

SetCursorPos(981,385);

mouse_event(MOUSEEVENTF_LEFTDOWN,981,385,0,0);

mouse_event(MOUSEEVENTF_LEFTUP,981,385,0,0);

sleep(10);

keybd_event(VK_LCONTROL, 0, 0, 0); //Нажатие левого Ctrl.

keybd_event(Ord('A'), 0, 0, 0);

keybd_event(Ord('A'), 0, KEYEVENTF_KEYUP, 0); //Отпускание 'z'.

keybd_event(VK_LCONTROL, 0, KEYEVENTF_KEYUP, 0); //Отпускание левого Ctrl.

keybd_event(VK_DELETE, 0, 0, 0); //Нажатие Delete

keybd_event(VK_DELETE, 0, KEYEVENTF_KEYUP, 0); //Отпускание

keybd_event(VK_LCONTROL, 0, 0, 0);

keybd_event(Ord('V'), 0, 0, 0);

keybd_event(Ord('V'), 0, KEYEVENTF_KEYUP, 0);

keybd_event(VK_LCONTROL, 0, KEYEVENTF_KEYUP, 0);

sleep(150);

SetCursorPos(965,445);

mouse_event(MOUSEEVENTF_LEFTDOWN,965,445,0,0);

mouse_event(MOUSEEVENTF_LEFTUP,965,445,0,0);

sleep(10);

keybd_event(VK_LCONTROL, 0, 0, 0); //Нажатие левого Ctrl.

keybd_event(Ord('A'), 0, 0, 0);

keybd_event(Ord('A'), 0, KEYEVENTF_KEYUP, 0); //Отпускание 'z'.

keybd_event(VK_LCONTROL, 0, KEYEVENTF_KEYUP, 0); //Отпускание левого Ctrl.

keybd_event(VK_DELETE, 0, 0, 0); //Нажатие Delete

keybd_event(VK_DELETE, 0, KEYEVENTF_KEYUP, 0); //Отпускание

ClipBoard.SetTextBuf('df');

keybd_event(VK_LCONTROL, 0, 0, 0);

keybd_event(Ord('V'), 0, 0, 0);

keybd_event(Ord('V'), 0, KEYEVENTF_KEYUP, 0);

keybd_event(VK_LCONTROL, 0, KEYEVENTF_KEYUP, 0);

sleep(100);

SetCursorPos(960,520);

mouse_event(MOUSEEVENTF_LEFTDOWN,960,520,0,0);

mouse_event(MOUSEEVENTF_LEFTUP,960,520,0,0);

end;

procedure TForm1.N3Click(Sender: TObject);

begin

sleep(10);

ClipBoard.SetTextBuf('7');

SetCursorPos(815,435);

mouse_event(MOUSEEVENTF_LEFTDOWN,815,435,0,0);

mouse_event(MOUSEEVENTF_LEFTUP,815,435,0,0);

sleep(10);

keybd_event(VK_LCONTROL, 0, 0, 0); //Нажатие левого Ctrl.

keybd_event(Ord('A'), 0, 0, 0);

keybd_event(Ord('A'), 0, KEYEVENTF_KEYUP, 0); //Отпускание 'z'.

keybd_event(VK_LCONTROL, 0, KEYEVENTF_KEYUP, 0); //Отпускание левого Ctrl.

keybd_event(VK_DELETE, 0, 0, 0); //Нажатие Delete

keybd_event(VK_DELETE, 0, KEYEVENTF_KEYUP, 0); //Отпускание

keybd_event(VK_LCONTROL, 0, 0, 0);

keybd_event(Ord('V'), 0, 0, 0);

keybd_event(Ord('V'), 0, KEYEVENTF_KEYUP, 0);

keybd_event(VK_LCONTROL, 0, KEYEVENTF_KEYUP, 0);

sleep(250);

SetCursorPos(820,500);

mouse_event(MOUSEEVENTF_LEFTDOWN,820,500,0,0);

mouse_event(MOUSEEVENTF_LEFTUP,820,500,0,0);

sleep(10);

keybd_event(VK_LCONTROL, 0, 0, 0); //Нажатие левого Ctrl.

keybd_event(Ord('A'), 0, 0, 0);

keybd_event(Ord('A'), 0, KEYEVENTF_KEYUP, 0); //Отпускание 'z'.

keybd_event(VK_LCONTROL, 0, KEYEVENTF_KEYUP, 0); //Отпускание левого Ctrl.

keybd_event(VK_DELETE, 0, 0, 0); //Нажатие Delete

keybd_event(VK_DELETE, 0, KEYEVENTF_KEYUP, 0); //Отпускание

ClipBoard.SetTextBuf('gg');

keybd_event(VK_LCONTROL, 0, 0, 0);

keybd_event(Ord('V'), 0, 0, 0);

keybd_event(Ord('V'), 0, KEYEVENTF_KEYUP, 0);

keybd_event(VK_LCONTROL, 0, KEYEVENTF_KEYUP, 0);

sleep(100);

SetCursorPos(1100,580);

mouse_event(MOUSEEVENTF_LEFTDOWN,1100,580,0,0);

mouse_event(MOUSEEVENTF_LEFTUP,1100,580,0,0);

end;

procedure TForm1.Button2Click(Sender: TObject);

Var DC: HDC; bmp: TBitmap; JPEG: TJPEGImage;

begin

JPEG := TJPEGImage.Create;

bmp:=TBitmap.Create;

bmp.Height:=Screen.Height;

bmp.Width:=Screen.Width;

DC:=GetDC(0);

bitblt(bmp.Canvas.Handle, 0, 0, Screen.Width, Screen.Height,

DC, 0, 0, SRCCOPY);

JPEG.Assign(bmp);

// bmp.SaveToFile('c:/1/Screen.jpg'); // А так сохранится в BMP и занимать будет соответственно

JPEG.SaveToFile('c:/1/Screen.jpg'); //Здесь можешь изменить путь, куда нужно сохранить файл. Так же в этой строчке изменяется название файла.

ReleaseDC(0, DC);

bmp.Free;

end;

procedure SaveFromClipBoardTo(FileName: string);

var

CBFList: TList;

i: Integer;

h: THandle;

p: Pointer;

CBBlockLength,

Temp,

CBF: Cardinal;

FS: TFileStream;

begin

if OpenClipBoard(0) then begin

CBFList := TList.Create;

CBF := 0;

repeat

CBF := EnumClipboardFormats(CBF);

if CBF <> 0 then CBFList.Add(pointer(CBF));

until CBF = 0;

if CBFList.Count > 0 then begin

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

Temp := CBFList.Count;

FS.Write(Temp, SizeOf(Integer));

for i := 0 to CBFList.Count - 1 do begin

h := GetClipboardData(Cardinal(CBFList[i]));

if h > 0 then begin

CBBlockLength := GlobalSize(h);

if h > 0 then begin

p := GlobalLock(h);

if p <> nil then begin

Temp := Cardinal(CBFList[i]);

FS.Write(Temp, SizeOf(Cardinal));

FS.Write(CBBlockLength, SizeOf(Cardinal));

FS.Write(p^, CBBlockLength);

end;

GlobalUnlock(h);

end;

end;

end;

FS.Free;

end;

CBFList.Free;

CloseClipBoard;

end;

end;

procedure TForm1.Button3Click(Sender: TObject);

begin

SaveFromClipBoardTo('c:/1/b.b');

end;

procedure CopyFileToClipboard(const fname: string);

var

hmem, hFile: THandle;

size: LongInt;

p: Pointer;

begin

hFile := FileOpen(fname, fmOpenRead);

try

size := FileSeek(hFile, 0, 2);

FileSeek(hfile, 0, 0);

if size > 0 then

begin

hmem := GlobalAlloc(GHND, size);

if hMem <> 0 then

begin

p := GlobalLock(hMem);

if p <> nil then

begin

_hread(hFile, p, size);

GlobalUnlock(hMem);

Clipboard.SetAsHandle(CF_TEXT, hMem);

end

else

GlobalFree(hMem);

end;

end;

finally

FileClose(hFile);

end;

end;

procedure TForm1.Button4Click(Sender: TObject);

begin

CopyFileToClipboard('c:/1/b.b');

end;

procedure TForm1.Button5Click(Sender: TObject);

begin

ClipBoard.SetTextBuf('Клиент не взял трубку.');

end;

procedure TForm1.Button6Click(Sender: TObject);

begin

ClipBoard.SetTextBuf('Автоответчик после ожидания.');

end;

procedure TForm1.Button7Click(Sender: TObject);

begin

ClipBoard.SetTextBuf('Номер временно заблокирован.');

end;

procedure TForm1.Button8Click(Sender: TObject);

begin

ClipBoard.SetTextBuf('Автоответчик что занято.');

end;

procedure TForm1.Button9Click(Sender: TObject);

begin

ClipBoard.SetTextBuf('Обслуживание абонента временно приостановлено.');

end;

procedure TForm1.Button10Click(Sender: TObject);

begin

ClipBoard.SetTextBuf('Короткие гудки.');

end;

procedure TForm1.Button11Click(Sender: TObject);

begin

ClipBoard.SetTextBuf('Не ИП и ООО, не ЛПР по месту работы.');

end;

procedure TForm1.Button12Click(Sender: TObject);

begin

ClipBoard.SetTextBuf('Абонент разговаривает по другой линии.');

end;

procedure TForm1.Button13Click(Sender: TObject);

var foo: TPoint; xxx,yyy: integer;

begin

sleep(900);

GetCursorPos(foo);

xxx := foo.X;

yyy := foo.Y;

SetCursorPos(xxx,yyy);

mouse_event(MOUSEEVENTF_LEFTDOWN,xxx,yyy,0,0);

mouse_event(MOUSEEVENTF_LEFTUP,xxx,yyy,0,0);

sleep(10);

keybd_event(VK_LCONTROL, 0, 0, 0); //Нажатие левого Ctrl.

keybd_event(Ord('V'), 0, 0, 0);

keybd_event(Ord('V'), 0, KEYEVENTF_KEYUP, 0); //Отпускание 'z'.

keybd_event(VK_LCONTROL, 0, KEYEVENTF_KEYUP, 0); //Отпускание левого Ctrl.

end;

procedure TForm1.Button14Click(Sender: TObject);

begin

ClipBoard.SetTextBuf('Данный вид связи не доступен для абонента.');

end;

procedure TForm1.Button15Click(Sender: TObject);

begin

ClipBoard.SetTextBuf(', клиент на уточняющие вопросы не реагировал, положил трубку.');

end;

procedure TForm1.Button16Click(Sender: TObject);

begin

ClipBoard.SetTextBuf('Бросил трубку после презентации.');

end;

procedure TForm1.Button17Click(Sender: TObject);

begin

ClipBoard.SetTextBuf('Сброс.');

end;

end.

Комментарии

Если у Вас возникли вопросы, Вы можете задать их в форме ниже. В частности если Ваш вопрос по Bitrix и что то не получается - можно спросить. Ваш e-mail не публикуется, при этом я отвечу на него если будет что то по теме. Писать необходимо для людей - избегайте сленга, пишите орфографически правильно.

Имя:
E-mail:
Текст комментария:

Вы так же можете прочитать следующие статьи: