Простой способ отправки файлов при помощи TClientSocket и TServerSocket

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

Диктор новостей: «…Из Баку сообщают о разработке нового стандарта для локальных компьютерных сетей — Azernet».

unit Unit1;

interface

uses

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

Dialogs, ScktComp, ExtCtrls, StdCtrls;

type

TForm1 = class(TForm)

Image1: TImage;

Image2: TImage;

ClientSocket1: TClientSocket;

ServerSocket1: TServerSocket;

Button1: TButton;

procedure Image1Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure ClientSocket1Connect(Sender: TObject;

Socket: TCustomWinSocket);

procedure ServerSocket1ClientRead(Sender: TObject;

Socket: TCustomWinSocket);

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

private

{ Private declarations }

Reciving: boolean;

DataSize: integer;

Data: TMemoryStream;

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Image1Click(Sender: TObject);

begin

// Это процедура для открытия сокета на ПРИЁМ (RECEIVING).

// Button1.Click is this procedure as well.

ClientSocket1.Active:= true;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

// Открытие ОТПРАВЛЯЮЩЕГО (SENDING) сокета.

ServerSocket1.Active:= true;

end;

procedure TForm1.ClientSocket1Connect(Sender: TObject;

Socket: TCustomWinSocket);

begin

// Посылаем команду для начала передачи файла.

Socket.SendText(‘send’);

end;

procedure TForm1.ClientSocket1Read(Sender: TObject;

Socket: TCustomWinSocket);

var

s, sl: string;

begin

s:= Socket.ReceiveText;

// Если мы не в режиме приёма:

if not Reciving then

begin

// Теперь нам необходимо получить длину потока данных.

SetLength(sl, StrLen(PChar(s)) 1); // 1 for the null terminator

StrLCopy(@sl[1], PChar(s), Length(sl)-1);

DataSize:= StrToInt(sl);

Data:= TMemoryStream.Create;

// Удаляем информацию о размере из данных.

Delete(s, 1, Length(sl));

Reciving:= true;

end;

// Сохраняем данные в файл, до тех пор, пока не получим все данные.

try

Data.write(s[1], length(s));

if Data.Size = DataSize then

begin

Data.Position:= 0;

Image2.Picture.Bitmap.LoadFromStream(Data);

Data.Free;

Reciving:= false;

Socket.Close;

end;

except

Data.Free;

end;

end;

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;

Socket: TCustomWinSocket);

var

ms: TMemoryStream;

begin

// Клиент получает команду на передачу файла.

if Socket.ReceiveText = ‘send’ then

begin

ms:= TMemoryStream.Create;

try

// Получаем данные на передачу.

Image1.Picture.Bitmap.SaveToStream(ms);

ms.Position:= 0;

// Добавляем длину данных, чтобы клиент знал,

// сколько данных будет передано

// Добавляем #0 , чтобы можно было определить,

// где заканчивается информация о размере.

Socket.SendText(IntToStr(ms.Size) #0);

// Посылаем его.

Socket.SendStream(ms);

except

// Итак, осталось освободить поток, если что-то не так.

ms.Free;

end;

end;

end;

end.

{/codecitation}

Пример HTTP Get — загружаем файлы и страницы из Интернета

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

Встречаются два сис-админа. Один жалуется:

— Ну совсем рехнулся со своей работой. Вчера шел к тебе, набрал на домофоне 192.168… Никто не откликнулся, ну я и ушел… Второй отвечает:

— А ты не пробовал: 255.255.255.255?

{*************************************************************}

{ HTTPGet component for Delphi 32 }

{ Version: 1.94 }

{ E-Mail: info@utilmind.com }

{ WWW: http://www.utilmind.com }

{ Created: October 19, 1999 }

{ Modified: June 6, 2000 }

{ Legal: Copyright (c) 1999-2000, UtilMind Solutions }

{*************************************************************}

{ PROPERTIES: }

{ Agent: String — User Agent }

{ }

{* BinaryData: Boolean — This setting specifies which type }

{* of data will taken from the web. }

{* If you set this property TRUE then }

{* component will determinee the size }

{* of files *before* getting them from }

{* the web. }

{* If this property is FALSE then as we}

{* do not knows the file size the }

{* OnProgress event will doesn’t work. }

{* Also please remember that is you set}

{* this property as TRUE you will not }

{* capable to get from the web ASCII }

{* data and ofter got OnError event. }

{ }

{ FileName: String — Path to local file to store the data }

{ taken from the web }

{ Password, UserName — set this properties if you trying to }

{ get data from password protected }

{ directories. }

{ Referer: String — Additional data about referer document }

{ URL: String — The url to file or document }

{ UseCache: Boolean — Get file from the Internet Explorer’s }

{ cache if requested file is cached. }

{*************************************************************}

{ METHODS: }

{ GetFile — Get the file from the web specified in the URL }

{ property and store it to the file specified in }

{ the FileName property }

{ GetString — Get the data from web and return it as usual }

{ String. You can receive this string hooking }

{ the OnDoneString event. }

{ Abort — Stop the current session }

{*************************************************************}

{ EVENTS: }

{ OnDoneFile — Occurs when the file is downloaded }

{ OnDoneString — Occurs when the string is received }

{ OnError — Occurs when error happend }

{ OnProgress — Occurs at the receiving of the BINARY DATA }

{*************************************************************}

{ Please see demo program for more information. }

{*************************************************************}

{ IMPORTANT NOTE: }

{ This software is provided ‘as-is’, without any express or }

{ implied warranty. In no event will the author be held }

{ liable for any damages arising from the use of this }

{ software. }

{ Permission is granted to anyone to use this software for }

{ any purpose, including commercial applications, and to }

{ alter it and redistribute it freely, subject to the }

{ following restrictions: }

{ 1. The origin of this software must not be misrepresented, }

{ you must not claim that you wrote the original software. }

{ If you use this software in a product, an acknowledgment }

{ in the product documentation would be appreciated but is }

{ not required. }

{ 2. Altered source versions must be plainly marked as such, }

{ and must not be misrepresented as being the original }

{ software. }

{ 3. This notice may not be removed or altered from any }

{ source distribution. }

{*************************************************************}

unit HTTPGet;

interface

uses

Windows, Messages, SysUtils, Classes, WinInet;

type

TOnProgressEvent = procedure(Sender: TObject; TotalSize, Readed: Integer) of object;

TOnDoneFileEvent = procedure(Sender: TObject; FileName: String; FileSize: Integer) of object;

TOnDoneStringEvent = procedure(Sender: TObject; Result: String) of object;

THTTPGetThread = class(TThread)

private

FTAcceptTypes,

FTAgent,

FTURL,

FTFileName,

FTStringResult,

FTUserName,

FTPassword,

FTPostQuery,

FTReferer: String;

FTBinaryData,

FTUseCache: Boolean;

FTResult: Boolean;

FTFileSize: Integer;

FTToFile: Boolean;

BytesToRead, BytesReaded: DWord;

FTProgress: TOnProgressEvent;

procedure UpdateProgress;

protected

procedure Execute; override;

public

constructor Create(aAcceptTypes, aAgent, aURL, aFileName, aUserName, aPassword,

aPostQuery, aReferer: String; aBinaryData, aUseCache:

Boolean; aProgress: TOnProgressEvent; aToFile: Boolean);

end;

THTTPGet = class(TComponent)

private

FAcceptTypes: String;

FAgent: String;

FBinaryData: Boolean;

FURL: String;

FUseCache: Boolean;

FFileName: String;

FUserName: String;

FPassword: String;

FPostQuery: String;

FReferer: String;

FWaitThread: Boolean;

FThread: THTTPGetThread;

FError: TNotifyEvent;

FResult: Boolean;

FProgress: TOnProgressEvent;

FDoneFile: TOnDoneFileEvent;

FDoneString: TOnDoneStringEvent;

procedure ThreadDone(Sender: TObject);

public

constructor Create(aOwner: TComponent); override;

destructor Destroy; override;

procedure GetFile;

procedure GetString;

procedure Abort;

published

property AcceptTypes: String read FAcceptTypes write FAcceptTypes;

property Agent: String read FAgent write FAgent;

property BinaryData: Boolean read FBinaryData write FBinaryData;

property URL: String read FURL write FURL;

property UseCache: Boolean read FUseCache write FUseCache;

property FileName: String read FFileName write FFileName;

property UserName: String read FUserName write FUserName;

property Password: String read FPassword write FPassword;

property PostQuery: String read FPostQuery write FPostQuery;

property Referer: String read FReferer write FReferer;

property WaitThread: Boolean read FWaitThread write FWaitThread;

property OnProgress: TOnProgressEvent read FProgress write FProgress;

property OnDoneFile: TOnDoneFileEvent read FDoneFile write FDoneFile;

property OnDoneString: TOnDoneStringEvent read FDoneString write FDoneString;

property OnError: TNotifyEvent read FError write FError;

end;

procedure Register;

implementation

// THTTPGetThread

constructor THTTPGetThread.Create(aAcceptTypes, aAgent, aURL, aFileName, aUserName,

aPassword, aPostQuery, aReferer: String; aBinaryData, aUseCache:

Boolean; aProgress: TOnProgressEvent; aToFile: Boolean);

begin

FreeOnTerminate := True;

inherited Create(True);

FTAcceptTypes := aAcceptTypes;

FTAgent := aAgent;

FTURL := aURL;

FTFileName := aFileName;

FTUserName := aUserName;

FTPassword := aPassword;

FTPostQuery := aPostQuery;

FTReferer := aReferer;

FTProgress := aProgress;

FTBinaryData := aBinaryData;

FTUseCache := aUseCache;

FTToFile := aToFile;

Resume;

end;

procedure THTTPGetThread.UpdateProgress;

begin

FTProgress(Self, FTFileSize, BytesReaded);

end;

procedure THTTPGetThread.Execute;

var

hSession, hConnect, hRequest: hInternet;

HostName, FileName: String;

f: File;

Buf: Pointer;

dwBufLen, dwIndex: DWord;

Data: Array[0..$400] of Char;

TempStr: String;

RequestMethod: PChar;

InternetFlag: DWord;

AcceptType: LPStr;

procedure ParseURL(URL: String; var HostName, FileName: String);

procedure ReplaceChar(c1, c2: Char; var St: String);

var

p: Integer;

begin

while True do

begin

p := Pos(c1, St);

if p = 0 then Break

else St[p] := c2;

end;

end;

var

i: Integer;

begin

if Pos(‘http://’, LowerCase(URL)) 0 then

System.Delete(URL, 1, 7);

i := Pos(‘/’, URL);

HostName := Copy(URL, 1, i);

FileName := Copy(URL, i, Length(URL) — i 1);

if (Length(HostName) > 0) and (HostName[Length(HostName)] = ‘/’) then

SetLength(HostName, Length(HostName) — 1);

end;

procedure CloseHandles;

begin

InternetCloseHandle(hRequest);

InternetCloseHandle(hConnect);

InternetCloseHandle(hSession);

end;

begin

try

ParseURL(FTURL, HostName, FileName);

if Terminated then

begin

FTResult := False;

Exit;

end;

if FTAgent » then

hSession := InternetOpen(PChar(FTAgent),

INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0)

else

hSession := InternetOpen(nil,

INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);

hConnect := InternetConnect(hSession, PChar(HostName),

INTERNET_DEFAULT_HTTP_PORT, PChar(FTUserName), PChar(FTPassword), INTERNET_SERVICE_HTTP, 0, 0);

if FTPostQuery = » then RequestMethod := ‘GET’

else RequestMethod := ‘POST’;

if FTUseCache then InternetFlag := 0

else InternetFlag := INTERNET_FLAG_RELOAD;

AcceptType := PChar(‘Accept: ‘ FTAcceptTypes);

hRequest := HttpOpenRequest(hConnect, RequestMethod, PChar(FileName), ‘HTTP/1.0’,

PChar(FTReferer), @AcceptType, InternetFlag, 0);

if FTPostQuery = » then

HttpSendRequest(hRequest, nil, 0, nil, 0)

else

HttpSendRequest(hRequest, ‘Content-Type: application/x-www-form-urlencoded’, 47,

PChar(FTPostQuery), Length(FTPostQuery));

if Terminated then

begin

CloseHandles;

FTResult := False;

Exit;

end;

dwIndex := 0;

dwBufLen := 1024;

GetMem(Buf, dwBufLen);

FTResult := HttpQueryInfo(hRequest, HTTP_QUERY_CONTENT_LENGTH,

Buf, dwBufLen, dwIndex);

if Terminated then

begin

FreeMem(Buf);

CloseHandles;

FTResult := False;

Exit;

end;

if FTResult or not FTBinaryData then

begin

if FTResult then

FTFileSize := StrToInt(StrPas(Buf));

BytesReaded := 0;

if FTToFile then

begin

AssignFile(f, FTFileName);

Rewrite(f, 1);

end

else FTStringResult := »;

while True do

begin

if Terminated then

begin

if FTToFile then CloseFile(f);

FreeMem(Buf);

CloseHandles;

FTResult := False;

Exit;

end;

if not InternetReadFile(hRequest, @Data, SizeOf(Data), BytesToRead) then Break

else

if BytesToRead = 0 then Break

else

begin

if FTToFile then

BlockWrite(f, Data, BytesToRead)

else

begin

TempStr := Data;

SetLength(TempStr, BytesToRead);

FTStringResult := FTStringResult TempStr;

end;

inc(BytesReaded, BytesToRead);

if Assigned(FTProgress) then

Synchronize(UpdateProgress);

end;

end;

if FTToFile then

FTResult := FTFileSize = Integer(BytesReaded)

else

begin

SetLength(FTStringResult, BytesReaded);

FTResult := BytesReaded 0;

end;

if FTToFile then CloseFile(f);

end;

FreeMem(Buf);

CloseHandles;

except

end;

end;

// HTTPGet

constructor THTTPGet.Create(aOwner: TComponent);

begin

inherited Create(aOwner);

FAcceptTypes := ‘*/*’;

FAgent := ‘UtilMind HTTPGet’;

end;

destructor THTTPGet.Destroy;

begin

Abort;

inherited Destroy;

end;

procedure THTTPGet.GetFile;

var

Msg: TMsg;

begin

if not Assigned(FThread) then

begin

FThread := THTTPGetThread.Create(FAcceptTypes, FAgent, FURL, FFileName, FUserName,

FPassword, FPostQuery, FReferer, FBinaryData, FUseCache, FProgress, True);

FThread.OnTerminate := ThreadDone;

if FWaitThread then

while Assigned(FThread) do

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

begin

TranslateMessage(Msg);

DispatchMessage(Msg);

end;

end

end;

procedure THTTPGet.GetString;

var

Msg: TMsg;

begin

if not Assigned(FThread) then

begin

FThread := THTTPGetThread.Create(FAcceptTypes, FAgent, FURL, FFileName, FUserName,

FPassword, FPostQuery, FReferer, FBinaryData, FUseCache, FProgress, False);

FThread.OnTerminate := ThreadDone;

if FWaitThread then

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

begin

TranslateMessage(Msg);

DispatchMessage(Msg);

end;

end

end;

procedure THTTPGet.Abort;

begin

if Assigned(FThread) then

begin

FThread.Terminate;

FThread.FTResult := False;

end;

end;

procedure THTTPGet.ThreadDone(Sender: TObject);

begin

FResult := FThread.FTResult;

if FResult then

if FThread.FTToFile then

if Assigned(FDoneFile) then FDoneFile(Self, FThread.FTFileName, FThread.FTFileSize) else

else

if Assigned(FDoneString) then FDoneString(Self, FThread.FTStringResult) else

else

if Assigned(FError) then FError(Self);

FThread := nil;

end;

procedure Register;

begin

RegisterComponents(‘UtilMind’, [THTTPGet]);

end;

end.

{/codecitation}

Посылка файлов через сокет

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

Спать на работе — грех, не для того вам там дан бесплатный интернет!

Здесь мы рассмотрим посылку файлов через сокет. Итак, как же послать файл по сокету? Очень просто! Достаточно лишь открыть этот файл как файловый поток (TFileStream) и отправить его через сокет (SendStream)! Рассмотрим это на примере:

{Посылка файла через сокет}

procedure SendFileBySocket(filename: string);

var

srcfile: TFileStream;

begin

{Открываем файл filename}

srcfile := TFileStream.Create(filename,fmOpenRead);

{Посылаем его первому подключенному клиенту}

ServerSocket1.Socket.Connections[0].SendStream(srcfile);

{Закрываем файл}

srcfile.Free;

end;

Нужно заметить, что метод SendStream используется не только сервером, но и клиентом (ClientSocket1.Socket.SendStream(srcfile))

{/codecitation}

Получение файла из сети

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

Девушка под самый конец рабочего дня решила полчаса початиться. Открыла пиво… пьёт, по аське прикалывается, да и засиделась допоздна. Придётся до утра ждать (контору заперли). Так и сидела всю ночь, пивко попивала… Ближе к утру оставили её силы и она решила выключить комп и вздремнуть часок. Потянулась под стол за кнопкой Power, да и заснула в позе «речного омара». С утра один из сотрудников пришел немного раньше, чем обычно и застал девушку в той же позе. «Опа!» — подумал он, задрал ей юбку и пристроился. Девушка (сквозь сон):

— Ох! Hе юзайте меня, я в оффлайне.

Перевод одноимённой статьи с сайта delphi.about.com

Обычно при разработке приложений, которые планируется в дальнейшем обновлять и усовершенствовать, основные модули хранятся в виде пакетов (Package) или библиотек DLL. В настоящее время Internet предоставляет возможность без особых усилий осуществлять обновление этих модулей. Поэтому добавление к Вашему приложению функции авто-обновления, является наилучшим способом для обновления приложения.

Давайте посмотрим, как реализовывается данный механизм в любом FTP приложении.

Delphi предоставляет нам полный доступ к WinInet API (wininet.pas), который можно использовать для соединения и получения файлов с веб-сайта, который использует либо Hypertext Transfer Protocol (HTTP) либо File Transfer Protocol (FTP). Например, мы можем использовать функции из WinInet API для: добавления FTP браузера в любое приложение, создания приложения, которое автоматически скачивает файлы с общедоступных FTP серверов или поиска Internet сайтов, ссылающихся на графику и скачивать только графику.

Функция GetInetFile

uses Wininet;

function GetInetFile(const fileURL, FileName: string): boolean;

const

BufferSize = 1024;

var

hSession, hURL: HInternet;

Buffer: array[1..BufferSize] of Byte;

BufferLen: DWORD;

f: file;

sAppName: string;

begin

Result:=False;

sAppName := ExtractFileName(Application.ExeName);

hSession := InternetOpen(PChar(sAppName),

INTERNET_OPEN_TYPE_PRECONFIG,

nil, nil, 0);

try

hURL := InternetOpenURL(hSession,

PChar(fileURL),

nil,0,0,0);

try

AssignFile(f, FileName);

Rewrite(f,1);

repeat

InternetReadFile(hURL, @Buffer,

SizeOf(Buffer), BufferLen);

BlockWrite(f, Buffer, BufferLen)

until

BufferLen = 0;

CloseFile(f);

Result:=True;

finally

InternetCloseHandle(hURL)

end;

finally

InternetCloseHandle(hSession)

end;

end;

Обратите внимание:

Чтобы обеспечить некоторую визуальную обратную связь для пользователя, Вы можете добавить строчку наподобие FlashWindow(Application.Handle,True) в тело блока «повторить/до тех пор» (repeat/until). Вызов FlashWindow API высвечивает заголовок Вашего имени приложений в панели задач.

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

Для вызова функции GetInetFile можно использовать следующий код:

var

FileOnNet, LocalFileName: string;

begin

FileOnNet := ‘http://its_your_sire.ru/library/forminbpl.zip’;

LocalFileName := ‘File Downloaded From the Net.zip’;

if GetInetFile(FileOnNet, LocalFileName) = true then

ShowMessage(‘Download successful’)

else

ShowMessage(‘Error in file download’);

end;

Данный код запрашивает файл ‘forminbpl.zip’ с сайта, скачивает его, и сохраняет его как ‘File Downloaded From the Net.zip’.

Обратите внимание:

В зависимости от версии Delphi, Вы можете использовать различные компоненты, которые можно найти на Интернет страницах, посвещённых VCL и, которые можно использовать для упрощения создания приложений (например FTP компонент, необходимый для TNMFTP, находящийся на странице FastNet VCL).

{/codecitation}

Передать файл через Socket соединение

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

— Ну, ты молодец! Вчера сделал больше чем за целый месяц!!

— Да просто у меня Интернет не работал!

Для данной цели можно воспользоваться компонентами TNMStrmServ и TNMStrm, которые предназначены для обмена потоками данных.

Обработчик для клиента:

var

MyStream: TMemoryStream;

begin

MyStream := TMemoryStream.Create;

MyStream.LoadFromFile(‘c:\windows\рабочий стол\DelphiWorld.txt’);

NMStrm1.PostIt(MyStream);

MyStream.Free;

end;

Обработчик для сервера:

procedure TForm1.NMStrmServ1MSG(Sender: TComponent;

const sFrom: string; strm: TStream);

var

MyStream: TMemoryStream;

begin

MyStream := TMemoryStream.Create;

MyStream.CopyFrom(strm, NMStrmServ1.BytesTotal);

MyStream.SaveToFile(‘c:\windows\рабочий стол\DelphiWorld2.txt’);

end;

{/codecitation}

Качаем с докачкой

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

В Японии скончался старейший пингвин в мире.

Linux объявил 3-х дневный траур…

// ПРЕДИСЛОВИЕ:

{

Копаясь как-то в исходниках модулей третьей Delphi, я наткнулся на файл,

который назывался WinInet.pas. Имея врожденное любопытство, я заглянул

в него и нашел там очень много интересных вещей. О некоторых из них я

попытаюсь рассказать в данной статье, в частности, как, используя этот

модуль, организовать докачку файлов при обрыве связи. В модуле WinInet.pas

содержатся описания прототипов функций и некоторых типов входящих в т.н.

Microsoft Windows Internet Extensions, описания которых я не нашел в

справочной системе (хотя может плохо искал) :-(. Поэтому пришлось идти

почти вслепую.

}

// ТЕОРИЯ:

{

Для начала рассмотрим все функции, константы и типы, которые мы будем

использовать:

}

// 1) HINTERNET, вот как он описан:

type

HINTERNET = Pointer;

PHINTERNET = ^HINTERNET;

// При детальном рассмотрении, это обычный указатель.

// 2) функции InternetOpen и InternetCloseHandle:

function InternetOpen(lpszAgent: PChar; dwAccessType: DWORD;

lpszProxy, lpszProxyBypass: PChar; dwFlags: DWORD): HINTERNET; stdcall;

{

где:

lpszAgent <-|Имя программы, с помощью которой мы соединяемся,

|может принимать любые значения

dwAccessType <-|Каким макаром соединяться с и-нетом

|принимаемые значения:

| PRE_CONFIG_INTERNET_ACCESS -как в системном реестре

| LOCAL_INTERNET_ACCESS -напрямую

| GATEWAY_INTERNET_ACCESS -через GateWay

| CERN_PROXY_INTERNET_ACCESS -через проксю

lpszProxy <-|Имя прокси сервера (ставим в nil)

lpszProxyBypass<-|Не уверен, но смахивает на имена хостов, для которых не

|использовать проксю (ставим в nil)

dwFlags <-|Принимаеемые значения:

| INTERNET_FLAG_ASYNC -этот запрос асинхронный (если есть

| поддержка), но мы поставим 0

}

// возвращает пресловутый HINTERNET, который будет требоваться при вызове

// всех остальных функций. С вызова этой функции начинается вся наша работа

// с интернетом, а с вызова второй заканчивается.

function InternetCloseHandle(hInet: HINTERNET): BOOL; stdcall;

// где: nInet ранее созданый указатель.

// 3) функция InternetOpenUrl:

function InternetOpenUrl(hInet: HINTERNET; lpszUrl: PChar;

lpszHeaders: PChar; dwHeadersLength: DWORD; dwFlags: DWORD;

dwContext: DWORD): HINTERNET; stdcall;

{

где:

hInet <-|Ранее созданый указатель

lpszUrl <-|Сам УРЛ

lpszHeaders <-|Дополнительные строки в НТТР запрос

dwHeadersLength<-|Длинна предыдущего

dwFlags <-|Принимаемые значения:

| INTERNET_FLAG_RAW_DATA -принимать как RAW данные

| INTERNET_FLAG_EXISTING_CONNECT -не создавать для

| объекта нового соединения

| (поставим в 0)

dwContext <-|пока не знаю, ставим в 0

}

// Функция возвращает HINTERNET, указывающий на конкретный файл (далее он в

// параметрах функций будет называться hFile).

// 4) функция InternetReadFile:

function InternetReadFile(hFile: HINTERNET; lpBuffer: Pointer;

dwNumberOfBytesToRead: DWORD; var lpdwNumberOfBytesRead: DWORD): BOOL; stdcall;

{

где:

hFile <-|Указатель, созданый предыдущей функцией

lpBuffer <-|Указатель на буфер куда читать

dwNumberOfBytesToRead<-|Сколько максимум читать (можно сказать размер

| буфера, хотя не факт)

lpdwNumberOfBytesRead<-|Сколько реально прочитано байт

}

// Этой функой мы будем читать файл из и-нета.

// 5) функция InternetSetFilePointer:

function InternetSetFilePointer(hFile: HINTERNET;

lDistanceToMove: Longint; pReserved: Pointer;

dwMoveMethod, dwContext: DWORD): DWORD; stdcall;

{

где:

hFile <-|Указатель созданый функцией InternetOpenUrl

lDistanceToMove<-|На сколько байт смещать указатель

pReserved <-|??

dwMoveMethod <-|Как смещать (=0)

dwContext <-|??

}

// Собственно, эта функция и поможет нам организовать докачку. Она смещает

// указатель в файле, после чего передача файла начнется с этого места.

// В принципе этих данных уже достаточно для наших целей, но есть еще одна

// полезная функция, которая пригодится нам:

function InternetQueryDataAvailable(hFile: HINTERNET; var lpdwNumberOfBytesAvailable: DWORD;

dwFlags, dwContext: DWORD): BOOL; stdcall;

{

где:

hFile <-|Указатель, созданный функцией InternetOpenUrl

lpdwNumberOfBytesAvailable<-|Сколько осталось байт

dwFlags <-|??

dwContext <-|??

}

// Как вы уже догадались, с помощью этой функции можно узнать сколько

// осталось байт скачать (или размер файла, если вызвать ее сразу после

// InternetOpenUrl).

//Ну, собственно, и все по теории.

// ПРАКТИКА:

Условия задачи:

Скачиваемый файл сохраняется как c:\123.tmp

При очередном старте скачки идет проверка на наличие оного файла на винте, если он есть, считаем что надо докачивать. Размер этого файла является признаком того, с какого места надо качать.

Требуемые материалы:

Форма (TForm)-1 шт.

Кнопки (TButton)-2 шт.

Строка ввода (TEdit)-1 шт.

Progress bar для красоты (TProgressBar)-1 шт.

Метки (TLabel)-по необходимости.

Далее идет полный листинг модуля:

unit Unit1;

interface

uses

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

wininet,

StdCtrls, ComCtrls;

type

TForm1 = class(TForm)

Edit1: TEdit; //<-строка для УРЛа

Label1: TLabel;

Button1: TButton; //<-кнопка Start

Button2: TButton; //<-кнопка Stop

ProgressBar1: TProgressBar; //<-декорация

procedure Button1Click(Sender: TObject); //<-|процедура начала скачки

procedure Button2Click(Sender: TObject); //<-|принудительный обрыв

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

stop: boolean; //<-|вспомогательная переменная отв. за

// |остановку скачки

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);

var

hInet, //<-переменная сод. указатель на сессию

hURL: HINTERNET; //<-указатель на URL

fSize, //<-размер файла

ReadLen, //<-количество реально прочитанных байт

RestartPos: DWORD; //<-|позиция с которой начинается

// |докачка

fBuf: array[1..1024] of byte; //<-буфер куда качаем

f: file; //<-файл куда качаем

Header: string; //<-|дополнительная переменная в HTTP

// |заголовок

begin

RestartPos := 0; //<- |инициализация

fSize := 0; //<- |переменных

Button1.Enabled := false;

Button2.Enabled := true;

//Если на винте есть файл то считаем, что нужно докачивать

if FileExists(‘c:\123.tmp’) then

begin

AssignFile(f, ‘c:\123.tmp’);

Reset(f, 1);

RestartPos := FileSize(F);

Seek(F, FileSize(F));

end

else

begin

//иначе с начала

AssignFile(f, ‘c:\123.tmp’);

ReWrite(f, 1);

end;

//открываем сессию

hInet := InternetOpen(‘Mozilla’,

PRE_CONFIG_INTERNET_ACCESS,

nil,

nil,

0);

//Пишем дополнительную строку для заголовка

Header := ‘Accept: */*’;

//открываем URL

hURL := InternetOpenURL(hInet,

PChar(Edit1.Text),

pchar(Header),

StrLen(pchar(Header)),

0,

0);

//устанавливаем позицию в файле для докачки

if RestartPos > 0 then

InternetSetFilePointer(hURL,

RestartPos,

nil,

0,

0);

//смотрим ск-ко надо скачать

InternetQueryDataAvailable(hURL, fSize, 0, 0);

if RestartPos > 0 then

begin

ProgressBar1.Min := 0;

ProgressBar1.Max := fSize RestartPos;

ProgressBar1.Position := RestartPos;

end

else

begin

ProgressBar1.Min := 0;

ProgressBar1.Max := fSize RestartPos;

end;

//качаем до тех пор пока реально прочитаное число байт не

//будет равно нулю или не стор

while (ReadLen 0) and (stop = false) do

begin

//читаем в буфер

InternetReadFile(hURL, @fBuf, SizeOf(fBuf), ReadLen);

//смотрим ск-ко осталось докачать

InternetQueryDataAvailable(hURL, fSize, 0, 0);

ProgressBar1.Position := ProgressBar1.Max — fSize;

BlockWrite(f, fBuf, ReadLen); //<-пишем в файл

Application.ProcessMessages;

end;

stop := false;

Button1.Enabled := true;

Button2.Enabled := false;

InternetCloseHandle(hURL); //<-|закрываем

InternetCloseHandle(hInet); //<-|сесcии

CloseFile(f); //<-|и файл

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

stop := false; //<-прервать скачку

Button2.Enabled := false; //<-кнопка останова скачки

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

stop := true; //<-сообщаем о необходимости прерывания скачки

end;

end.

{/codecitation}

Как скачать файл через Proxy

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

— Сынок! Сколько раз тебе говорить, что я тебя родила, а не скачала из интернета!!!

DownloadFile(‘http://some.com/some.zip’, ‘c:\some.zip’);

function DownloadFile(const FileURL, FileName: String): Cardinal;

var

hSession, hFile: HInternet;

Buffer: array[1..1024] of Byte;

BufferLen, fSize: LongWord;

f: File;

begin

Result := 0;

hSession := InternetOpen(‘STEROID Download’,

INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);

if Assigned(hSession) then begin

hFile := InternetOpenURL(hSession, PChar(FileURL), nil, 0,

INTERNET_FLAG_RELOAD, 0);

if Assigned(hFile) then begin

AssignFile(f, FileName);

Rewrite(f,1);

fSize := 0;

repeat

InternetReadFile(hFile, @Buffer, SizeOf(Buffer), BufferLen);

BlockWrite(f, Buffer, BufferLen);

fSize := fSize BufferLen;

until (BufferLen = 0);

CloseFile(f);

Result := fSize;

InternetCloseHandle(hFile);

end;

InternetCloseHandle(hSession);

end;

end;

Комментарий:

function InternetOpen(lpszAgent: PChar;

dwAccessType: DWORD;

lpszProxy, lpszProxyBypass: PChar;

dwFlags: DWORD): HINTERNET; stdcall;

lpszAgent — строка символов, которая передается серверу и идентифицирует программное обеспечение, пославшее запрос.

dwAccessType

INTERNET_OPEN_TYPE_DIRECT : обрабатывает все имена хостов локально.

INTERNET_OPEN_TYPE_PRECONFIG : берет установки из реестра.

INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY — берет установки из реестра и предотвращает запуск Jscript или Internet Setup (INS) файлов.

! INTERNET_OPEN_TYPE_PROXY : использование прокси-сервера. В случае неудачи использует INTERNET_OPEN_TYPE_DIRECT.

LpszProxy — адрес прокси-сервера. Игнорируется только если параметр dwAccessType отличается от INTERNET_OPEN_TYPE_PROXY.

LpszProxyBypass — список имен или IP- адресов, соединяться с которыми нужно в обход прокси-сервера. В списке допускаются шаблоны. Так же, как и предыдущий параметр, не может содержать пустой строки. Если dwAccessType отличен от INTERNET_OPEN_TYPE_PROXY, то значения игнорируются, и параметр можно установить в nil.

DwFlags задает параметры, влияющие на поведение Internet- функций. Возможно применение комбинации из следующих разрешенных значений: INTERNET_FLAG_ASYNC, INTERNET_FLAG_FROM_CACHE, INTERNET_FLAG_OFFLINE.

{/codecitation}

Как сделать обмен файлами

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

Сначала Катя искала мужа через Интернет, потом через Интерпол.

Посмотри спецификацию протокола на

http://slavanap2.sourceforge.net/nap.txt или

http://opennap.sourceforge.net/napster.txt

Также есть следующие исходники:

— SlavaNap (Delphi 4) http://slavanap2.sourceforge.net

— OpenNap (C, console app) http://opennap.sourceforge.net

— TekNap (C, console app) http://www.teknap.com

Возможно, что существуют другие исходники. Это можно выяснить в napigator форумах (http://forums.napigator.com)

Кроме того есть mailing list для разработчиков napster-совместимых программ:

http://www.onelist.com/community/napdev

Там также есть архив группы napdev.

Или пошли пустое письмо на napdev-subscribe@yahoogroups.com

{/codecitation}

Как переслать файл через nonBlocking сокет

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

Благодаря американской компьютеризированной системе выборов президента, тысячи российских хакеров смогли принять участие в голосовании…

// а форме ServerSocket1, ClientSocket1 : (Active := False,

// Host := localhost, Port := 2001, xType := xNonBlocking),

// OpenDialog1, Button1, Memo1.

procedure TfmMain.FormCreate(Sender: TObject);

begin

ServerSocket1.Active:=true;

ClientSocket1.Active:=true;

end;

{— Server —}

procedure TfmMain.Button1Click(Sender: TObject);

var

sStream : TMemoryStream;

begin

sStream := TMemoryStream.Create;

if not OpenDialog1.Execute then

Exit;

sStream.LoadFromFile(OpenDialog1.FileName);

ServerSocket1.Socket.Connections[0].SendStreamThenDrop(sStream);

end;

{— Client —}

const

MAX_BUF_SIZE = $4095;

var

fStream: TFileStream;

{OnConnect}

procedure TfmMain.ClientSocket1Connect(Sender: TObject;

Socket: TCustomWinSocket);

begin

fStream:= TFileStream.Create(‘Receive.fil’, fmCreate);

end;

{OnRead}

procedure TfmMain.ClientSocket1Read(Sender: TObject;

Socket: TCustomWinSocket);

var

count :Integer;

buffer: Array [0..MAX_BUF_SIZE] of Char;

begin

repeat

Socket.Lock;

count:= Socket.ReceiveBuf(buffer,SizeOf(buffer));

if count > 0 then

fStream.WriteBuffer(buffer,count);

Socket.Unlock;

until (count <= 0);

Memo1.Lines.Add(IntToStr(fStream.Size));

end;

{OnDisconnect}

procedure TfmMain.ClientSocket1Disconnect(Sender: TObject;

Socket: TCustomWinSocket);

begin

fStream.Free;

end;

{/codecitation}

Как перед скачиванием узнать размер файла

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

Приходит юзер к провайдерам и говорит.

— У Вас маршрут на Москву не работает.

— А откуда Вы знаете?…

GetUrlInfo(HTTP_QUERY_CONTENT_LENGTH, ‘http://some.com/some.zip’);

function GetUrlInfo(const dwInfoLevel: DWORD; const FileURL: string):

string;

var

hSession, hFile: hInternet;

dwBuffer: Pointer;

dwBufferLen, dwIndex: DWORD;

begin

Result := »;

hSession := InternetOpen(‘STEROID Download’,

INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);

if Assigned(hSession) then begin

hFile := InternetOpenURL(hSession, PChar(FileURL), nil, 0,

INTERNET_FLAG_RELOAD, 0);

dwIndex := 0;

dwBufferLen := 20;

if HttpQueryInfo(hFile, dwInfoLevel, @dwBuffer, dwBufferLen, dwIndex)

then Result := PChar(@dwBuffer);

if Assigned(hFile) then InternetCloseHandle(hFile);

InternetCloseHandle(hsession);

end;

end;

{/codecitation}