|
|
Регистрация Восстановить пароль |
Повторная активизация e-mail |
Регистрация | Задать вопрос |
Заплачу за решение |
Новые сообщения |
Сообщения за день |
Расширенный поиск |
Правила |
Всё прочитано |
|
Опции темы | Поиск в этой теме |
06.12.2010, 17:36 | #1 |
Форумчанин
Регистрация: 05.05.2009
Сообщений: 244
|
Захват мыши
Здравствуйте, столкнулся с проблемой...у меня лр в которой нужно сделать чтот типа удаленного рабочего стола....отправка скрина на сервер работает нормально(желательно сжать скрин , но эт такое)
У меня никак не выходит захватить мышь... Тут код сервака procedure Writing(Text: string); var Form1: TForm1; fName:string; //Имя файла fSize: integer; // Размер файла Receive: boolean; // Режим клиента MS: TMemoryStream; // Буфер для файла implementation {$R *.dfm} procedure TForm1.Writing(Text: string); begin if MS.Size < fSize then // Если принято байт меньше размера файла, то... MS.Write(Text[1], Length(Text)); // Записываем в буфер if MS.Size = fSize then // Если файл принят, то... begin Receive := false; // Переводим клиента в нормальный режим MS.Position := 0; // Переводим каретку в начало буфера if not(DirectoryExists(ExtractFilePath (ParamStr(0)) + '\' + '1')) then CreateDir(ExtractFilePath(ParamStr( 0)) + '\' + '1'); MS.SaveToFile(ExtractFilePath(Param Str(0)) + '\' + '1\' + fName); // Сохраняем файл //ServerSocket1.Socket.Connections[0].SendText('/dend'); // Посылаем команду "/dend", то есть файл принят memo1.Lines.Add('[Client]::Принят файл ' + fName); //Запишем в сообщения то что мы приняли файл end; end; procedure TForm1.ServerSocket1Accept(Sender: TObject; Socket: TCustomWinSocket); begin Memo1.Lines.Add (Socket.RemoteHost + ' Соеденено в ' + DateTimeToStr (Now)); end; procedure TForm1.Button2Click(Sender: TObject); begin ServerSocket1.Socket.Connections[0].SendText('1'); end; procedure TForm1.ServerSocket1ClientRead(Send er: TObject; Socket: TCustomWinSocket); var sMessage:string; begin sMessage := Socket.ReceiveText; if Receive then // Если клиент в режиме приёма файла, то... Writing(sMessage) // Записываем данные в буфер else // Если клиент не в режиме приёма файла, то... begin //начинается блок команд if Copy(sMessage, 0, Pos('#', sMessage) -1) = 'file' then // Если это файл, то... begin MS := TMemoryStream.Create; // Создаём буфер для файла Delete(sMessage, 1, Pos('#', sMessage)); // Определяем имя файла fName := Copy(sMessage, 0, Pos('#', sMessage) -1); // Определяем имя файла Delete(sMessage, 1, Pos('#', sMessage)); // Определяем размер файла fSize := StrToInt(Copy(sMessage, 0, Pos('#', sMessage) -1)); // Определяем размер файла Delete(sMessage, 1, Pos('#', sMessage)); // Удаляем последний разделитель Receive := true; // Переводим сервер в режим приёма файла memo1.Lines.Add('[Client]::Пришел файл ' + fName); //запишем в сообщения о том что нам послали файл memo1.Lines.Add('[Client]::Размер Файла ' + IntToStr(fSize)); //запишем размер файла Writing(sMessage); // Записываем данные в буфер end else memo1.Lines.Add('[Client]:' + sMessage); //нам пришло текстовое сообщение,так заишем же его end; end; procedure TForm1.FormCreate(Sender: TObject); begin MS := TMemoryStream.Create; // Создаём буфер для файла end; end. Тут клиент procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer); procedure FormCreate(Sender: TObject); procedure Timer1Timer(Sender: TObject); procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure Timer2Timer(Sender: TObject); private { Private declarations } public { Public declarations } //procedure wmCaptureChanged(var msg: tMessage); //message WM_CAPTURECHANGED; 77.122.205.41 end; var Form1: TForm1; MS:TMemoryStream; //Для файлика буфер sender:tobject; pp: TPoint; Shift: TShiftState; implementation {$R *.dfm} procedure GetWindowsScreen( PathToSave: string ); begin with TBitmap.Create do begin Width := Screen.Width; Height := Screen.Height; BitBlt( Canvas.Handle, 0, 0, Width, Height, GetDC( GetDesktopWindow ), 0, 0, SRCCOPY ); SaveToFile( PathToSave ); Free; end; end; |
06.12.2010, 17:38 | #2 |
Форумчанин
Регистрация: 05.05.2009
Сообщений: 244
|
тут второй кусок
procedure TForm1.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket); var s:string; n:integer; Size: integer; P: ^Byte; begin s:=Socket.ReceiveText; n:=strtoint(s); if n=1 then begin timer1.Enabled:=true; Timer1Timer(Sender); timer2.Enabled:=true; Timer2Timer(Sender); end; end; procedure TForm1.ClientSocket1Connect(Sender: TObject; Socket: TCustomWinSocket); begin edit1.Text := 'Соеденено с ' + Socket.RemoteHost; end; procedure TForm1.ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer); begin ShowMessage('Ошибка №' + IntToStr(ErrorCode)); //Возникла ошибка ErrorCode :=0; end; procedure TForm1.FormCreate(Sender: TObject); begin MS := TMemoryStream.Create; end; procedure TForm1.Timer1Timer(Sender: TObject); var Size: integer; //размерчик P: ^Byte; begin GetWindowsScreen('C:\Screen.bmp'); MS.LoadFromFile('C:\Screen.bmp'); // Загружаем файл в буфер ClientSocket1.Socket.SendText('file #'+ ExtractFileName('C:\Screen.bmp') +'#'+IntToStr(MS.Size)+'#'); MS.Position := 0; // Переводим каретку в начало файла P := MS.Memory; // Загружаем в переменную "P" файл ClientSocket1.Socket.SendBuf(P^, MS.Size); // Посылаем файл end; procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin setCapture(handle); SetCursorPos(x,y); end; procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin //caption := format('X: %d; Y: %d;', [X, Y]); setCapture(handle); SetCursorPos(x,y); end; procedure TForm1.Timer2Timer(Sender: TObject); begin GetCursorPos(pp); FormMouseDown(sender,mbleft,shift,p p.X,pp.Y); FormMouseMove(sender,shift,pp.X,pp. Y); end; end. Посодействуйте в решении проблемы, заранее благодарен) |
Похожие темы | ||||
Тема | Автор | Раздел | Ответов | Последнее сообщение |
Захват видеопотока с IP-камеры | Greek9000 | Софт | 5 | 30.01.2015 06:11 |
захват текста | NiCola999 | Общие вопросы C/C++ | 3 | 20.03.2010 12:50 |
видео захват | Dyaba | Общие вопросы C/C++ | 1 | 02.05.2009 19:24 |
TСhart, клик мыши и координаты XY, Определение координат оси при клике мыши | Aravild | Компоненты Delphi | 1 | 31.01.2009 16:28 |
QT. Захват видеовыхода из bochs. | NikLik | Qt и кроссплатформенное программирование С/С++ | 0 | 22.11.2008 21:45 |