Как передать картинку по сети через ServerSocket

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: TwoK

WEB-сайт: http://forum.vingrad.ru

Да без проблем. Звиняйте, что на сях, но, тем не менее, на Борланд сях. Со стороны, откуда посылаем (у нас это клиент), пишем:

TFileStream* str = new TFileStream(«M:\\MyFile.jpg»,fmOpenRead);

//ИЛИ, если мы работаем без сохранения (тогда не создается файл)

TMemoryStream* str = new TMemoryStream ();

str->Position = 0;

Image1->Picture->Bitmap->SaveToStream(str);

//и, наконец, шлем на сервер битмап

str->Position = 0;

ClientSocket1->Socket->SendStream(str);

Обратите внимание, не забывайте перед каждой операцией с потоком устанавливать позицию в 0!!! Иначе получим не то, что хотелось бы Ну а со стороны приема (у нас это, соответственно, серверсокет), в событии приема пишем:

int ibLen = ServerSocket1->Socket->ReceiveLength();

char* buf= new char[ibLen 1];

TMemoryStream* str = new TMemoryStream();

str->Position = 0;

ServerSocket1->Socket->ReceiveBuf((void*)buf,ibLen);

str->WriteBuffer((void*)buf,ibLen);

str->Position = 0;

Image1->Picture->Bitmap->LoadFromStream(str);

//или

str->SaveToFile(«M:\\MyFile.jpg»);

Ну и ессно, как говорит Bigbrother, сделал дело — вызови деструктор! То есть почистить за собой надо, не знаю как в Паскале, но в сях мне надо удалить str и buf.

{/codecitation}

Как отправить вебформу на сервер при помощи TClientSocket (напрямую и через прокси)

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Посетитель у провайдера.

— Ой, что это у вас так крякнуло.

— Сервер наверное…

{

Присоедините следующие события к Вашему ClientSocket:

procedure T…Form.ClientSocket1Write;

procedure T…Form.ClientSocket1Read;

procedure T…Form.ClientSocket1Disconnect;

procedure T…Form.ClientSocket1Error;

Так же пример показывает, как направлять передачу через прокси-сервер.

Для отправки на вебсервер используется следующий формат:

Напрямую:

‘POST ‘ PostAddr ‘HTTP/1.0’ HTTP_Data Content

Через проксю:

‘POST http://’ Webserver PostAddr ‘HTTP/1.0’ HTTP_Data Content

}

const

WebServer = ‘www.somehost.com’;

WebPort = 80;

PostAddr = ‘/cgi-bin/form’;

{ Следующие переменные используются только для вебсервера: }

ProxyServer =’proxy.somewhere.com’;

ProxyPort = 3128;

// В заголовке post необходимы некоторые данные

HTTP_Data =

‘Content-Type: application/x-www-form-urlencoded’#10

‘User-Agent: Delphi/5.0 ()’#10 { Отрекламируем Delphi 5! }

‘Host: somewhere.com’#10

‘Connection: Keep-Alive’#10;

type

T…Form = class(TForm)

private

{ Private declarations }

HTTP_POST : string;

FContent : string;

// Эта переменная будет содержать ответ сервера

FResult : string;

public

{ Public declarations }

end;

{ Эти функции сделают некоторое url-кодирование }

{ Например. ‘John Smith’ => ‘John Smith’ }

function HTTPTran(St: string): string;

var

i: Integer;

begin

Result:=»;

for i:=1 to length(St) do

if St[i] in [‘a’..’z’,’A’..’Z’,’0′,’1′..’9′] then

Result:=Result St[i]

else

if St[i]=’ ‘ then

Result:=Result ‘ ‘

else

Result:=Result ‘%’ IntToHex(Byte(St[i]),2);

end;

procedure T…Form.ClientSocket1Write(Sender: TObject;

Socket: TCustomWinSocket);

begin

// Постим данные

Socket.SendText(HTTP_POST FContent);

end;

procedure T…Form.ClientSocket1Read(Sender: TObject;

Socket: TCustomWinSocket);

begin

// Получаем результат

FResult:=FResult Socket.ReceiveText;

end;

procedure T…Form.ClientSocket1Disconnect(Sender: TObject;

Socket: TCustomWinSocket);

begin

// ЗДЕСЬ МОЖНО ОБРАБОТАТЬ FResult //

end;

procedure T…Form.ClientSocket1Error(Sender: TObject;

Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;

var ErrorCode: Integer);

begin

ErrorCode := 0; // Игнорируем ошибки

end;

{ А эта подпрограмма, которую можно

использовать для постинга данных формы. }

procedure T…Form.PostTheForm;

begin

// Очищаем результаты

FResult:=»;

// Вы можете ввести поля формы, которые необходимы

// Вот некоторые примеры:

FContent:=

‘Name=’ HTTPTran(‘John Smith’) ‘

Как запросить страницу с сайта 2

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: http://www.sources.ru

{

Присоедините следующий обработчик к Вашему TClientSocket.

Он получает файл с сервера и помещает его в строковую переменную

FText string variable. Однако он не убирает заголовок,

который так же посылается вебсервером.

Не забудьте задать правильный адрес сервера в объекте Socket.

Установите порт 80. А затем откройте его при помощи команды «Socket.Open;».

Автор: E.J.Molendijk

}

const

WebPage = ‘/index.html’;

var

FText: string;

procedure TForm1.SocketWrite(Sender: TObject;

Socket: TCustomWinSocket);

begin

Socket.SendText(‘GET ‘ Webpage ‘ HTTP/1.0’#10#10);

end;

procedure TForm1.SocketRead(Sender: TObject;

Socket: TCustomWinSocket);

begin

FText := FText Socket.ReceiveText

end;

procedure TForm1.SocketConnecting(Sender: TObject;

Socket: TCustomWinSocket);

begin

FText := »;

end;

procedure TForm1.SocketDisconnect(Sender: TObject;

Socket: TCustomWinSocket);

begin

{ — }

{ ЗДЕСЬ ВЫ МОЖЕТЕ ОБРАБАТЫВАТЬ ВАШ FText !!! }

{ — }

end;

procedure TForm1.SocketError(Sender: TObject;

Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;

var ErrorCode: Integer);

begin

ErrorCode := 0; { Ошибки игнорируем }

end;

{/codecitation}

Как запросить страницу с сайта

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: Fantasist

WEB-сайт: http://forum.vingrad.ru

unit Unit1;

interface

uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, ScktComp;

const

Request: AnsiString = ‘GET / HTTP/1.1’ #0$D#0$A

‘Accept: application/vnd.ms-excel, application/msword, */*’ #0$D#0$A

‘Accept-Language: en-us’ #0$D#0$A

‘Accept-Encoding: gzip, deflate’ #0$D#0$A

‘User-Agent: Mozilla/4.0 (compatible; MSIE 4.01; Windows 98)’ #0$D#0$A

‘Host: vingrad.com’ #0$D#0$A

‘Connection: Keep-Alive’ #0$D#0$A #0$D#0$A;

type

TForm1 = class(TForm)

Skt: TClientSocket;

Button1: TButton;

Memo1: TMemo;

procedure Button1Click(Sender: TObject);

procedure SktRead(Sender: TObject; Socket: TCustomWinSocket);

procedure SktConnect(Sender: TObject; Socket: TCustomWinSocket);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);

begin

Skt.Host := ‘vingrad.ru’;

Skt.Port := 80;

Skt.Open;

end;

procedure TForm1.SktRead(Sender: TObject; Socket: TCustomWinSocket);

begin

Memo1.Lines.Text := Memo1.Lines.Text Socket.ReceiveText;

end;

procedure TForm1.SktConnect(Sender: TObject; Socket: TCustomWinSocket);

begin

Socket.SendText(Request);

end;

end.

Request — это запрос который посылает мой IE5. В принципе, по протоколу HTTP он может ограничиваться: ‘GET / HTTP/1.1’ #13 #13. Если хотите запросить оределенный документ: ‘GET / HTTP/1.1’ #13 #13. Конечно, всегда можно воспользоваться готовыми компонентами.

{/codecitation}

Использование ServerSocket и ClientSocket

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Оформил: DeeCo

Автор: http://www.swissdelphicenter.ch

// Client Program:

// Send ‘power’ to Client to shutdown the machine.

// Send ‘reset’ to Client to reset the machine.

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ComCtrls, ScktComp;

type

TForm1 = class(TForm)

Clientsocket1: TClientSocket;

StatusBar1: TStatusBar;

Button1: TButton;

Button2: TButton;

Edit1: TEdit;

Label1: TLabel;

Button3: TButton;

CheckBox1: TCheckBox;

Checkbox2: TCheckBox;

procedure Button1Click(Sender : TObject);

procedure Button2Click(Sender : TObject);

procedure Clientsocket1Error(Sender : TObject; Socket : TCustomWinSocket;

ErrorEvent : TErrorEvent; var ErrorCode : integer);

procedure Clientsocket1Disconnect(Sender : TObject;

Socket : TCustomWinSocket);

procedure Clientsocket1Connect(Sender : TObject;

Socket : TCustomWinSocket);

procedure Button3Click(Sender : TObject);

procedure FormClose(Sender : TObject; var Action : TCloseAction);

procedure FormDestroy(Sender : TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1 : TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender : TObject);

begin

Clientsocket1.Active := True;

end;

procedure TForm1.Button2Click(Sender : TObject);

begin

Clientsocket1.Active := False;

end;

procedure TForm1.Clientsocket1Error(Sender : TObject;

Socket : TCustomWinSocket; ErrorEvent : TErrorEvent;

var ErrorCode : integer);

begin

errorcode := 0;

StatusBar1.SimpleText := ‘Error’;

end;

procedure TForm1.Clientsocket1Disconnect(Sender : TObject;

Socket : TCustomWinSocket);

begin

StatusBar1.SimpleText := ‘Disconnect’;

end;

procedure TForm1.Clientsocket1Connect(Sender : TObject;

Socket : TCustomWinSocket);

begin

StatusBar1.SimpleText := Clientsocket1.Address;

end;

procedure TForm1.Button3Click(Sender : TObject);

var

ukaz : string;

orders : string;

Text : string;

box : string;

begin

ukaz := edit1.Text;

Clientsocket1.Socket.SendText(ukaz);

if checkbox1.Checked = True then

begin

orders := ‘power’;

Clientsocket1.Socket.SendText(orders);

end;

if Checkbox2.Checked = True then

begin

Text := ‘reset’;

Clientsocket1.Socket.SendText(Text);

end;

end;

procedure TForm1.FormClose(Sender : TObject; var Action : TCloseAction);

begin

Clientsocket1.Active := False;

end;

procedure TForm1.FormDestroy(Sender : TObject);

begin

Clientsocket1.Active := False;

end;

end.

// Client Program

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, ScktComp, StdCtrls, ShellApi;

type

TForm1 = class(TForm)

Label1: TLabel;

Serversocket1: TServerSocket;

procedure FormClose(Sender : TObject; var Action : TCloseAction);

procedure FormDestroy(Sender : TObject);

procedure FormCreate(Sender : TObject);

procedure Serversocket1ClientError(Sender : TObject;

Socket : TCustomWinSocket; ErrorEvent : TErrorEvent;

var ErrorCode : integer);

procedure Serversocket1ClientRead(Sender : TObject;

Socket : TCustomWinSocket);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1 : TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormClose(Sender : TObject; var Action : TCloseAction);

begin

Serversocket1.Active := False;

end;

procedure TForm1.FormDestroy(Sender : TObject);

begin

Serversocket1.Active := False;

end;

procedure TForm1.FormCreate(Sender : TObject);

begin

Serversocket1.Active := True;

end;

procedure TForm1.Serversocket1ClientError(Sender : TObject;

Socket : TCustomWinSocket; ErrorEvent : TErrorEvent;

var ErrorCode : integer);

begin

errorcode := 0;

end;

procedure TForm1.Serversocket1ClientRead(Sender : TObject;

Socket : TCustomWinSocket);

var

ukaz : string;

orders : string;

Text : string;

box : string;

begin

ukaz := socket.ReceiveText;

label1.Caption := ‘reciving…’;

ShellExecute(Handle, ‘open’, PChar(ukaz), PChar(»), nil, sw_show);

Text := socket.ReceiveText;

orders := socket.ReceiveText;

if orders = ‘power’ then

begin

ShellExecute(Handle, ‘open’, PChar(‘shutdown.exe’), PChar(‘-s’), nil, sw_show);

Application.MessageBox(‘You will be turned off’, ‘Warning’, mb_iconexclamation);

Serversocket1.Active := False;

Form1.Close;

end;

if Text = ‘reset’ then

begin

ShellExecute(Handle, ‘open’, PChar(‘shutdown.exe’), PChar(‘-r’), nil, sw_show);

Application.MessageBox(‘You will be reset’, ‘Warning’, mb_iconexclamation);

Serversocket1.Active := False;

Form1.Close;

end;

end;

end.

{/codecitation}

Асинхронная ошибка

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Если Вы находите ошибки, исправить которые дело долгое и нудное, ничего не делайте — просто внесите их в список особенностей.

Вопрос: Почему не работает следующий код?

begin

ClietnSocket1.Open;

if ClietnSocket1.Socket.Connected then

ClietnSocket1.Socket.SendText(‘Hello’);

{..}

end;

// Выдает — ассинхронная ошибка.

Вы работаете в ассинхронном режиме. Следует использовать соответсвующие события.

{/codecitation}

TServerSocket и TClientSocket без scktsrvr.exe отказываются работать

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Встpечаются девушка и молодой человек, знакомые лишь виртуально. Молодой человек, смотpя на девушку:

— Так вот почему с тобой было так интеpесно говоpить — все остальное с тобой делать пpосто беcполезно.

Вопрос: У меня ни TServerSocket, ни TClientSocket без scktsrvr.exe отказываются работать! Слышал, что для решения проблемы можно что-то откуда-то вырезать и вклеить в программу.

Установите этот компонент:

unit Sck;

interface

uses

Classes, SysUtils, Windows, Messages,

ScktComp, SConnect, ActiveX, MidConst;

type

TNotifyClient = procedure (Sender: TObject; Thread: TServerClientThread) of

object;

{ TSocketDispatcher }

TSocketDispatcher = class;

{ TSocketDispatcherThread }

TSocketDispatcherThread = class(TServerClientThread, ISendDataBlock)

private

FRefCount: Integer;

FInterpreter: TDataBlockInterpreter;

FTransport: ITransport;

FInterceptGUID: string;

FLastActivity: TDateTime;

FTimeout: TDateTime;

FRegisteredOnly: Boolean;

protected

SocketDispatcher: TSocketDispatcher;

function CreateServerTransport: ITransport; virtual;

procedure AddClient;

procedure RemoveClient;

{ IUnknown }

function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;

function _AddRef: Integer; stdcall;

function _Release: Integer; stdcall;

{ ISendDataBlock }

function Send(const Data: IDataBlock; WaitForResult: Boolean): IDataBlock;

stdcall;

public

constructor Create(AOwner: TSocketDispatcher; CreateSuspended: Boolean;

ASocket: TServerClientWinSocket; const InterceptGUID: string;

Timeout: Integer; RegisteredOnly: Boolean);

procedure ClientExecute; override;

property LastActivity: TDateTime read FLastActivity;

end;

{ TSocketDispatcher }

TSocketDispatcher = class(TServerSocket)

private

FInterceptGUID: string;

FTimeout: Integer;

FRegisteredOnly: Boolean;

FOnRemoveClient: TNotifyClient;

FOnAddClient: TNotifyClient;

procedure GetThread(Sender: TObject; ClientSocket: TServerClientWinSocket;

var SocketThread: TServerClientThread);

published

constructor Create(AOwner: TComponent); override;

property InterceptGUID: string read FInterceptGUID write FInterceptGUID;

property Timeout: Integer read FTimeout write FTimeout;

property RegisteredOnly: Boolean read FRegisteredOnly write

FRegisteredOnly;

property OnAddClient: TNotifyClient read FOnAddClient write FOnAddClient;

property OnRemoveClient: TNotifyClient read FOnRemoveClient write

FOnRemoveClient;

end;

procedure Register;

implementation

procedure Register;

begin

RegisterComponents(‘Midas’, [TSocketDispatcher]);

end;

{ TSocketDispatcherThread }

constructor TSocketDispatcherThread.Create(AOwner: TSocketDispatcher;

CreateSuspended: Boolean; ASocket: TServerClientWinSocket;

const InterceptGUID: string; Timeout: Integer; RegisteredOnly: Boolean);

begin

SocketDispatcher := AOwner;

FInterceptGUID := InterceptGUID;

FTimeout := EncodeTime(Timeout div 60, Timeout mod 60, 0, 0);

FLastActivity := Now;

FRegisteredOnly := RegisteredOnly;

inherited Create(CreateSuspended, ASocket);

end;

function TSocketDispatcherThread.CreateServerTransport: ITransport;

var

SocketTransport: TSocketTransport;

begin

SocketTransport := TSocketTransport.Create;

SocketTransport.Socket := ClientSocket;

SocketTransport.InterceptGUID := FInterceptGUID;

Result := SocketTransport as ITransport;

end;

procedure TSocketDispatcherThread.AddClient;

begin

with SocketDispatcher do

if Assigned(OnAddClient) then OnAddClient(SocketDispatcher, Self);

end;

procedure TSocketDispatcherThread.RemoveClient;

begin

with SocketDispatcher do

if Assigned(OnRemoveClient) then OnRemoveClient(SocketDispatcher, Self);

end;

{ TSocketDispatcherThread.IUnknown }

function TSocketDispatcherThread.QueryInterface(const IID: TGUID;

out Obj): HResult;

begin

if GetInterface(IID, Obj) then Result := 0 else Result := E_NOINTERFACE;

end;

function TSocketDispatcherThread._AddRef: Integer;

begin

Inc(FRefCount);

Result := FRefCount;

end;

function TSocketDispatcherThread._Release: Integer;

begin

Dec(FRefCount);

Result := FRefCount;

end;

{ TSocketDispatcherThread.ISendDataBlock }

function TSocketDispatcherThread.Send(const Data: IDataBlock;

WaitForResult: Boolean): IDataBlock;

begin

FTransport.Send(Data);

if WaitForResult then

while True do

begin

Result := FTransport.Receive(True, 0);

if Result = nil then break;

if (Result.Signature and ResultSig) = ResultSig then

break else

FInterpreter.InterpretData(Result);

end;

end;

procedure TSocketDispatcherThread.ClientExecute;

var

Data: IDataBlock;

msg: TMsg;

Obj: ISendDataBlock;

Event: THandle;

WaitTime: DWord;

begin

CoInitialize(nil);

try

Synchronize(AddClient);

FTransport := CreateServerTransport;

try

Event := FTransport.GetWaitEvent;

PeekMessage(msg, 0, WM_USER, WM_USER, PM_NOREMOVE);

GetInterface(ISendDataBlock, Obj);

if FRegisteredOnly then

FInterpreter := TDataBlockInterpreter.Create(Obj, SSockets) else

FInterpreter := TDataBlockInterpreter.Create(Obj, »);

try

Obj := nil;

if FTimeout = 0 then

WaitTime := INFINITE else

WaitTime := 60000;

while not Terminated and FTransport.Connected do

try

case MsgWaitForMultipleObjects(1, Event, False, WaitTime,

QS_ALLEVENTS) of

WAIT_OBJECT_0:

begin

WSAResetEvent(Event);

Data := FTransport.Receive(False, 0);

if Assigned(Data) then

begin

FLastActivity := Now;

FInterpreter.InterpretData(Data);

Data := nil;

FLastActivity := Now;

end;

end;

WAIT_OBJECT_0 1:

while PeekMessage(msg, 0, 0, 0, PM_REMOVE) do

DispatchMessage(msg);

WAIT_TIMEOUT:

if (FTimeout > 0) and ((Now — FLastActivity) > FTimeout) then

FTransport.Connected := False;

end;

except

FTransport.Connected := False;

end;

finally

FInterpreter.Free;

FInterpreter := nil;

end;

finally

FTransport := nil;

end;

finally

CoUninitialize;

Synchronize(RemoveClient);

end;

end;

{ TSocketDispatcher }

constructor TSocketDispatcher.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

ServerType := stThreadBlocking;

OnGetThread := GetThread;

end;

procedure TSocketDispatcher.GetThread(Sender: TObject;

ClientSocket: TServerClientWinSocket;

var SocketThread: TServerClientThread);

begin

SocketThread := TSocketDispatcherThread.Create(Self, False, ClientSocket,

InterceptGUID, Timeout, RegisteredOnly);

end;

end.

{/codecitation}

CrtSock — модуль для работы с сокетами в Delphi32

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: Paul Toth

WEB-сайт: www.multimania.com/tothpaul

CrtSock. Модуль для работы с сокетами.

Совместимость: Delphi 2

Поддерживает TCP и UDP пакеты.

Не использует winsock.pas, поскольку обращается непосредственно к wsock32.dll.

Набор функций позволяет разрабатывать как клиентские, так и серверные приложения.

Перечень включенных в модуль функций:

// Server side :

// — start a server

// — wait for a client

function StartServer(Port:word):integer;

function WaitClient(Server:integer):integer;

function WaitClientEx(Server:integer; var ip:string):integer;

// Client side :

// — call a server

function CallServer(Server:string;Port:word):integer;

// Both side :

// — Assign CRT Sockets

// — Disconnect server

procedure AssignCrtSock(Socket:integer;

Var Input,Output:TextFile);

procedure Disconnect(Socket:integer);

// BroadCasting (UDP)

function StartBroadCast(Port:word):integer;

function SendBroadCast(Server:integer;

Port:word; s:string):integer;

function SendBroadCastTo(Server:integer;

Port:word;

ip,s:string):integer;

function ReadBroadCast(Server:integer; Port:word):string;

function ReadBroadCastEx(Server:integer;

Port:word;

var ip:string):string;

// BlockRead

function SockAvail(Socket:integer):integer;

function DataAvail(Var F:TextFile):integer;

Function BlockReadsock(Var F:TextFile;

var s:string):boolean;

Function send(socket:integer;

data:pointer;

datalen,

flags:integer):integer; stdcall; far;

Function recv(socket:integer;

data:pchar;

datalen,

flags:integer):integer; stdcall; far;

Дополнительно в комплект входят модули для работы с FTP, HTTP, SMTP, POP3.

В качестве примера приведена демонстрационная программа, использующая все эти возможности.

Скачать исходник: crtsock.zip (22k)

{/codecitation}

Функция определяющая запущен ли сервер удаленного доступа (RAS)

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Включает Webmaster свой компьютер:

— Вот блин, что-то со счетчиком, уже третий раз «166»!

(Смотрит на системный блок).

function CheckRAS: boolean;

const

MaxEntries = 100;

var

BufSize : Integer;

NumEntries : Integer;

Entries : array [1..MaxEntries] of TRasConn;

begin

Entries[1].dwSize := SizeOf(TRasConn);

Bufsize:=SizeOf(TRasConn)*MaxEntries;

FillChar(Stat, Sizeof(TRasConnStatus), 0);

RasEnumConnections(@Entries[1], BufSize, NumEntries);

if numentries > 0 then

result := true

else

result := false;

end;

{/codecitation}

Формулы передачи данных для начинающих

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Юзер — супорту:

— A чего это я постоянно слетаю с ваших модемов?!

— Летаешь — значит растешь!

Данным примером я попытаюсь дать ответы на следующие вопросы:

Каково различие между KBps и Kbps? В чём заключается отличие битов, байтов и бодов? Как определить скорость передачи данных? Как выяснить, насколько долго будет загружаться файл с определённой скоростью? Как посчитать время, оставшее до окончания загрузки?

Для начала хотельсы навести порядок с некоторой неразберихой по поводу KBps и Kbps (буква b в нижнем регистре). KBps это обозначение для килобайт в секунду, в то время как Kbps обозначает килобиты в секунду. 1 килобайт (KB) = 8 килобитам (Kb).

Когда речь идёт о скорости передачи, то применяется Kbps. Таким образом модем со скорость передачи 33.6K (33600 bps) передаёт данные со скоростью 4.2 KBps (4.2 килобайта в секунду). Как мы видим, разница между KB и Kb довольно ощутима. В этом кроется причина того, что некоторые пользователи модемов по своему незнанию не могут понять, почему данные передаются так медленно. На самом деле данные объёмом 33.6K передаются не за 1 секунду, а за 8, соответственно за одну секунду будет передано 33.6 Kb / 8 = 4.2.

Так же хотелось бы дать некоторые разъяснения по поводу слова «бод» (baud). Обычно для модема «боды» расшифровываются как бит в секунду. На самом деле это не так. Бод (Baud) означает частоту звука в телефонной линии. Т. е. в зависимости от модема, который Вы используете, количество бит, которые могут быть переданы зависит от частоты звука, необходимой для обеспечения нужной скорости передачи.

Обратите внимание: Приведённый ниже пример, использует компонент NetMasters TNMHTTP. Однако, если Вы «прикипели» к какому-то другому компоненту TCP/IP, то переделать пример под этот компонент не составит большого труда.

Используемые обозначения:

bps

байт, переданных за 1 секунду

KBps (KB/Sec)

bps / 1024

Kbps (Kb/Sec)

KBps x 8

Краткий алгоритм приведённого ниже примера:

Сохраняем в переменной время начала загрузки: nStartTime := GetTickCount;

Сохраняем в переменной размер файла (KB): nFileSize := «File Size»;

Начало передачи данных.

Обновляем количество переданных байт: Inc(nBytesTransferred, nNewBytes);

Получаем оставшееся время: nTimeElapsed := (GetTickCount — nStartTime) / 1000;

Вычисляем bps: nBps := BytesTransferred / nTimeElapsed;

Вычисляем KBps: nKBps := nBps / 1024;

Используемые данные:

Общее время скачивания (секунд) := nFileSize / nKBps;

bps := FloatToStr(nBps);

KB/Sec (KBps) := FloatToStr(nKBps);

Осталось секунд := FloatToStr(((nFileSize — BytesTransferred) / 1024) / KBps);

Рабочий пример:

unit Main;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, Gauges, Psock, NMHttp;

type

TfMain = class(TForm)

Label1: TLabel;

eURL: TEdit;

bGet: TButton;

lbMessages: TListBox;

gbDetails: TGroupBox;

lEstimate: TLabel;

lKBps: TLabel;

lReceived: TLabel;

lRemaining: TLabel;

gProgress: TGauge;

NMHTTP1: TNMHTTP;

lbps: TLabel;

bCancel: TButton;

procedure NMHTTP1PacketRecvd(Sender: TObject);

procedure bGetClick(Sender: TObject);

procedure bCancelClick(Sender: TObject);

procedure NMHTTP1Connect(Sender: TObject);

procedure NMHTTP1ConnectionFailed(Sender: TObject);

procedure NMHTTP1Disconnect(Sender: TObject);

procedure NMHTTP1Failure(Cmd: CmdType);

procedure NMHTTP1HostResolved(Sender: TComponent);

procedure NMHTTP1InvalidHost(var Handled: Boolean);

procedure NMHTTP1Status(Sender: TComponent; Status: string);

procedure NMHTTP1Success(Cmd: CmdType);

private

{ Private declarations }

function ss2nn(Seconds: Integer): string;

public

{ Public declarations }

end;

var

fMain: TfMain;

nFileSize: Double;

nStartTime: DWord;

implementation

{$R *.DFM}

{Цель этой функции состоит в том, чтобы определить,

сколько минут и секунд там находятся в данном количестве секунд}

function TfMain.ss2nn(Seconds: Integer): string;

var

nMin, nSec: Integer;

begin

{Проверяем, меньше чем 1/Min}

if Seconds < 60 then

Result := ‘0 minutes ‘ IntToStr(Seconds) ‘ seconds’

else

begin

{Определяем минуты}

nMin := Seconds div 60;

{Определяем секунды}

nSec := Seconds — (nMin * 60);

{Возвращаем результат}

Result := IntToStr(nMin) ‘ minutes ‘ IntToStr(nSec) ‘ seconds’;

end;

end;

procedure TfMain.NMHTTP1PacketRecvd(Sender: TObject);

var

nBytesReceived, nTimeElapsed, nBps, nKBps: Double;

begin

{Следующий код выполняется только однажды, при приёме первого пакета}

if nFileSize NMHTTP1.BytesTotal then

begin

{Получаем размер файла}

nFileSize := NMHTTP1.BytesTotal;

{Вычисляем время передачи, исходя из скорости соединения 33.6 Kbps}

lEstimate.Caption := ‘Estimated download time at 33.6 Kbps: ‘ ss2nn(Round(

(nFileSize / 1024) / 4.2));

{Получаем время начала}

nStartTime := GetTickCount;

end;

{Обновляем nBytesReceived}

nBytesReceived := NMHTTP1.BytesRecvd;

{Вычисляем количество секунд прошедших с момента начала передачи}

nTimeElapsed := (GetTickCount — nStartTime) / 1000;

{Проверяем на 0/Sec, если так, то устанавливаем 1,

чтобы предотвратить деления на ноль}

if nTimeElapsed = 0 then

nTimeElapsed := 1;

{Вычисляем байт в секунду}

nBps := nBytesReceived / nTimeElapsed;

{Вычисляем килобайт в секунду}

nKBps := nBps / 1024;

{Обновляем контролы}

gProgress.Progress := Round((nBytesReceived * 100) / nFileSize);

lbps.Caption := IntToStr(Round(nBps * 8)) ‘ bits per second’;

lKBps.Caption := IntToStr(Round(nKBps)) ‘ KB/Sec (KBps)’;

lReceived.Caption := FloatToStr(nBytesReceived) ‘ of ‘ FloatToStr(

nFileSize) ‘ bytes received’;

lRemaining.Caption := ss2nn(Round(((nFileSize — nBytesReceived) / 1024) /

nKBps)) ‘ remaining’;

end;

procedure TfMain.bGetClick(Sender: TObject);

begin

{Сбрасываем переменные}

nFileSize := 0;

{Обнуляем контролы}

lbMessages.Clear;

gProgress.Progress := 0;

lEstimate.Caption := ‘Estimated download time at 33.6 Kbps: 0 minutes 0 ‘

‘seconds’;

lbps.Caption := ‘0 bits per second’;

lKBps.Caption := ‘0 KB/Sec (KBps)’;

lReceived.Caption := ‘0 of 0 bytes received’;

lRemaining.Caption := ‘0 minutes 0 seconds remaining’;

{Получаем файл}

NMHTTP1.Get(eURL.Text);

end;

procedure TfMain.bCancelClick(Sender: TObject);

begin

{Разрываем соединение с сервером}

NMHTTP1.Disconnect;

{Обновляем lbMessages}

lbMessages.Items.Append(‘Get Canceled’);

lbMessages.Items.Append(‘Disconnected’);

end;

procedure TfMain.NMHTTP1Connect(Sender: TObject);

begin

{Запрещаем/Разрешаем контролы}

bGet.Enabled := False;

bCancel.Enabled := True;

{Работаем с lbMessages}

with lbMessages.Items do

begin

Append(‘Connected’);

Append(‘Local Address: ‘ NMHTTP1.LocalIP);

Append(‘Remote Address: ‘ NMHTTP1.RemoteIP);

end;

end;

procedure TfMain.NMHTTP1ConnectionFailed(Sender: TObject);

begin

ShowMessage(‘Connection Failed.’);

end;

procedure TfMain.NMHTTP1Disconnect(Sender: TObject);

begin

{Запрещаем/Разрешаем контролы}

bCancel.Enabled := False;

bGet.Enabled := True;

{Обновляем lbMessages}

if NMHTTP1.Connected then

lbMessages.Items.Append(‘Disconnected’);

end;

procedure TfMain.NMHTTP1Failure(Cmd: CmdType);

begin

case Cmd of

CmdGET : lbMessages.Items.Append(‘Get Failed’);

CmdOPTIONS : lbMessages.Items.Append(‘Options Failed’);

CmdHEAD : lbMessages.Items.Append(‘Head Failed’);

CmdPOST : lbMessages.Items.Append(‘Post Failed’);

CmdPUT : lbMessages.Items.Append(‘Put Failed’);

CmdPATCH : lbMessages.Items.Append(‘Patch Failed’);

CmdCOPY : lbMessages.Items.Append(‘Copy Failed’);

CmdMOVE : lbMessages.Items.Append(‘Move Failed’);

CmdDELETE : lbMessages.Items.Append(‘Delete Failed’);

CmdLINK : lbMessages.Items.Append(‘Link Failed’);

CmdUNLINK : lbMessages.Items.Append(‘UnLink Failed’);

CmdTRACE : lbMessages.Items.Append(‘Trace Failed’);

CmdWRAPPED : lbMessages.Items.Append(‘Wrapped Failed’);

end;

end;

procedure TfMain.NMHTTP1HostResolved(Sender: TComponent);

begin

lbMessages.Items.Append(‘Host Resolved’);

end;

procedure TfMain.NMHTTP1InvalidHost(var Handled: Boolean);

begin

ShowMessage(‘Invalid Host. Please specify a new URL.’);

end;

procedure TfMain.NMHTTP1Status(Sender: TComponent; Status: string);

begin

if NMHTTP1.ReplyNumber = 404 then

ShowMessage(‘Object Not Found.’);

end;

procedure TfMain.NMHTTP1Success(Cmd: CmdType);

begin

case Cmd of

{Удостоверяемся, что процедура получения не была прервана}

CmdGET:

if NMHTTP1.Connected then

lbMessages.Items.Append(‘Get Succeeded’);

CmdOPTIONS : lbMessages.Items.Append(‘Options Succeeded’);

CmdHEAD : lbMessages.Items.Append(‘Head Succeeded’);

CmdPOST : lbMessages.Items.Append(‘Post Succeeded’);

CmdPUT : lbMessages.Items.Append(‘Put Succeeded’);

CmdPATCH : lbMessages.Items.Append(‘Patch Succeeded’);

CmdCOPY : lbMessages.Items.Append(‘Copy Succeeded’);

CmdMOVE : lbMessages.Items.Append(‘Move Succeeded’);

CmdDELETE : lbMessages.Items.Append(‘Delete Succeeded’);

CmdLINK : lbMessages.Items.Append(‘Link Succeeded’);

CmdUNLINK : lbMessages.Items.Append(‘UnLink Succeeded’);

CmdTRACE : lbMessages.Items.Append(‘Trace Succeeded’);

CmdWRAPPED : lbMessages.Items.Append(‘Wrapped Succeeded’);

end;

end;

end.

{/codecitation}