Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > Интернет и сети
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 05.05.2011, 16:06
YurIbr89 YurIbr89 вне форума
Прохожий
 
Регистрация: 05.05.2011
Сообщения: 8
Репутация: 10
По умолчанию Клиент- Сервер послать скриншот

Здраствуйте.
Есть клиент и сервер. Сервер через некоторое время делает скриншот рабочего стола, сохраняет его, затем посылает клиенту. Клиент в свою очередь тоже его сохраняет, а затем загружает в Image.
После чего наблюдается странная ситуация.
Снимок прилагется.

Сервер
Код:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, ScktComp, Clipbrd, ExtCtrls;

type
  TForm1 = class(TForm)
    ServerSocket1: TServerSocket;
    ProgressBar1: TProgressBar;
    StatusBar1: TStatusBar;
    Button2: TButton;
    Timer1: TTimer;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket1ClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket1ClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure Button2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  MS: TMemoryStream; // Буфер для файла
  
implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  ServerSocket1.Open; // Открываем сокет
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  ServerSocket1.Close; // Закрываем сокет
end;


procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
begin
 if Socket.ReceiveText = 'end' then // Если клиент принял файл, то...
 begin
 StatusBar1.SimpleText := 'Клиент принял файл';
 MS.Free; // Убиваем буфер
end;
end;



procedure TForm1.ServerSocket1ClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
 StatusBar1.SimpleText := 'Соединение установлено';
end;

procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
 StatusBar1.SimpleText := 'Соединение не установлено';
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
   Timer1.Enabled:=True;
end;


procedure TForm1.Timer1Timer(Sender: TObject);
  var
   bmp: TBitmap;
   Size: integer;
   P: ^Byte;

 begin
   bmp := TBitmap.Create;
    bmp.Width := Screen.Width;
    bmp.Height := Screen.Height;
    BitBlt(bmp.Canvas.Handle, 0, 0, Screen.Width, Screen.Height,
      GetDC(GetDesktopWindow), 0, 0, SRCCopy);
     Clipboard.Assign(bmp);
     bmp.SaveToFile('D:\FormImage.bmp');
       begin
        MS := TMemoryStream.Create; // Создаём буфер для файла
        MS.LoadFromFile('D:\FormImage.bmp'); // Загружаем файл в буфер
        // Посылаем информацию о файл (команда # название # размер)
        ServerSocket1.Socket.Connections[0].SendText('file#'+'D:\FormImage.bmp'+'#'+IntToStr(MS.Size)+'#');
        MS.Position := 0; // Переводим каретку в начало файла
        P := MS.Memory; // Загружаем в переменную "P" файл
        Size := ServerSocket1.Socket.Connections[0].SendBuf(P^, MS.Size); // Посылаем файл
        // Выводим прогресс
        ProgressBar1.Position := Size*100 div MS.Size;
        StatusBar1.SimpleText := 'Отправлено '+IntToStr(Size)+' из '+IntToStr(MS.Size)+' байт'
       end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Timer1.Enabled:=False;
end;

end.

Клиент
Код:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ScktComp, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    ClientSocket1: TClientSocket;
    ProgressBar1: TProgressBar;
    StatusBar1: TStatusBar;
    Image1: TImage;
    procedure Writing(Text: string);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ClientSocket1Connect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket1Disconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket); // Процедура записи в данных в буфер

  private
    { Private declarations }
    Name: string; // Имя файла
 Size: integer; // Размер файла
 Receive: boolean; // Режим клиента
 MS: TMemoryStream; // Буфер для файла
 x,y: integer;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


procedure TForm1.FormCreate(Sender: TObject);
begin
 ClientSocket1.Open; // Открываем сокет
 Receive := false; // Режим клиента - приём команд
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  ClientSocket1.Close; // Закрываем сокет
end;

procedure TForm1.ClientSocket1Connect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
 StatusBar1.SimpleText := 'Соединение установлено';
end;

procedure TForm1.ClientSocket1Disconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  StatusBar1.SimpleText := 'Соединение не установлено';
end;


procedure TForm1.Writing(Text: string);

 begin
 if MS.Size < Size then // Если принято байт меньше размера файла, то...
 MS.Write(Text[1], Length(Text)); // Записываем в буфер
 // Выводим прогресс закачки файла
 ProgressBar1.Position := MS.Size*100 div Size;
 StatusBar1.SimpleText := 'Принято '+IntToStr(MS.Size)+' из '+IntToStr(Size);
 if MS.Size = Size then // Если файл принят, то...
 begin
 Receive := false; // Переводим клиента в нормальный режим
 MS.Position := 0; // Переводим каретку в начало буфера
 MS.SaveToFile(Name); // Сохраняем файл
 ClientSocket1.Socket.SendText('end'); // Посылаем команду "end", то есть файл принят

 Form1.Image1.Picture.LoadFromFile('D:\FormImage.bmp');
 
 MS.Free; // Убиваем буфер
 StatusBar1.SimpleText := 'Файл принят';
 end; 
 end;


 
procedure TForm1.ClientSocket1Read(Sender: TObject;
  Socket: TCustomWinSocket);
var
 Rtext: string; // Принятый текст
 begin
 Rtext := Socket.ReceiveText;
 if Receive then // Если клиент в режиме приёма файла, то...
 Writing(RText) // Записываем данные в буфер
 else // Если клиент не в режиме приёма файла, то...
 if Copy(Rtext, 0, Pos('#', Rtext) -1) = 'file' then // Если это файл, то...
 begin MS := TMemoryStream.Create; // Создаём буфер для файла
 Delete(Rtext, 1, Pos('#', Rtext)); // Определяем имя файла
 Name := Copy(Rtext, 0, Pos('#', Rtext) -1); // Определяем имя файла
 Delete(Rtext, 1, Pos('#', Rtext)); // Определяем размер файла
 Size := StrToInt(Copy(Rtext, 0, Pos('#', Rtext) -1)); // Определяем размер файла
 Delete(Rtext, 1, Pos('#', Rtext)); // Удаляем последний разделитель
 Label1.Caption := 'Размер файла: '+IntToStr(Size)+' байт'; // Выводим размер файла
 Receive := true; // Переводим сервер в режим приёма файла
 Writing(RText); // Записываем данные в буфер

 end;
 end;

end.


Подскажите пожалуйста что не так.
Изображения
Тип файла: jpg Безымянный.jpg (96.8 Кбайт, 39 просмотров)

Последний раз редактировалось Aristarh Dark, 05.05.2011 в 16:11.
Ответить с цитированием
  #2  
Старый 05.05.2011, 16:12
Аватар для Aristarh Dark
Aristarh Dark Aristarh Dark вне форума
Модератор
 
Регистрация: 07.10.2005
Адрес: Москва
Сообщения: 2,906
Версия Delphi: Delphi XE
Репутация: выкл
По умолчанию

А чего не так? Белое пятно справа?
__________________
Некоторые программисты настолько ленивы, что сразу пишут рабочий код.

Если вас наказали ни за что - радуйтесь: вы ни в чем не виноваты.
Ответить с цитированием
  #3  
Старый 05.05.2011, 16:16
Аватар для NumLock
NumLock NumLock вне форума
Let Me Show You
 
Регистрация: 30.04.2010
Адрес: Северодвинск
Сообщения: 5,426
Версия Delphi: 7, XE5
Репутация: 59586
По умолчанию

обычная видео рекурсия в таких случаях - тестирование клиента и сервера на одной машине.
__________________
Пишу программы за еду.
__________________
Ответить с цитированием
  #4  
Старый 05.05.2011, 16:16
YurIbr89 YurIbr89 вне форума
Прохожий
 
Регистрация: 05.05.2011
Сообщения: 8
Репутация: 10
По умолчанию

Изображение должно загружаться на всё поле Image, а оно дабавляется справа с уменьшением размера.
Ответить с цитированием
  #5  
Старый 05.05.2011, 16:20
Аватар для NumLock
NumLock NumLock вне форума
Let Me Show You
 
Регистрация: 30.04.2010
Адрес: Северодвинск
Сообщения: 5,426
Версия Delphi: 7, XE5
Репутация: 59586
По умолчанию

это снимок предыдущего снимка!!! скорее всего. код не изучал - не читабельный он.
__________________
Пишу программы за еду.
__________________
Ответить с цитированием
  #6  
Старый 06.05.2011, 21:26
YurIbr89 YurIbr89 вне форума
Прохожий
 
Регистрация: 05.05.2011
Сообщения: 8
Репутация: 10
По умолчанию

Большое спасибо.
На двух машинах показывает нормально.
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 02:43.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter