Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Работа с сетью в Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 06.12.2010, 17:36   #1
hunter03
Форумчанин
 
Регистрация: 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;
hunter03 вне форума Ответить с цитированием
Старый 06.12.2010, 17:38   #2
hunter03
Форумчанин
 
Регистрация: 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.



Посодействуйте в решении проблемы, заранее благодарен)
hunter03 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Захват видеопотока с 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