MyDAC NULL is not a valid integer value for field…

Иногда при использовании компонент MyDAC, при вставке записи возникает ошибка типа NULL is not a valid integer value for field…
Чтобы её исправить, в свойствах компонента TMyQuery -> Options выставить параметр DefaultValues = False

Троянские порты

Номер порта Протокол Название трояна

21TCP Blade Runner, Doly Trojan, Fore, Invisible FTP, WebEx, WinCrash

23TCP Tiny Telnet Server

25TCP Antigen, Email Password Sender, Haebu Coceda, Shtrilitz Stealth, Terminator, WinPC, WinSpy, Kuang2 0.17A-0.30

31TCP Hackers Paradise

80TCP Executor

456 TCP Hackers Paradise

555 TCP Ini-Killer, Phase Zero, Stealth Spy

666 TCP Satanz Backdoor

1001 TCP Silencer, WebEx

1011 TCP Doly Trojan

1095, 1097, 1098, 1099 TCP Rat

1170 TCP Psyber Stream Server, Voice

1234 TCP Ultors Trojan

1243, 6711, 6776TCP Sub 7

1245 TCP VooDoo Doll

1349 UDP Back Ofrice DLL

1492 TCP FTP99CMP

1600 TCP Shivka-Burka

1807 TCP SpySender

1981 TCP Shockrave

1999 TCP BackDoor 1.00-1.03

2001 TCP Trojan Cow

2023 TCP Ripper

2115 TCP BUGS

2140, 3150, 6670, 6771 TCP/UDP Deep Throat

2140, 3150 TCP The Invasor

2801 TCP Phineas Phucker

3024, 5742 TCP WinCrash

3129 TCP Masters Paradise

3700, 9872, 9873, 9874, 9875, 10067, 10167 TCP al of Doom

4092 TCP WinCrash

4567 TCP File Nail 1

4590 TCP ICQTrojan

5000TCP Bubbel

5000, 5001 TCP Sockets de Troie

5321 TCP Firehotcker

5400, 5401, 5402 TCP Blade Runner 0.80 Alpha

5569 TCP Robo-Hack

6969 TCP GateCrasher, Priority

7000 TCP Remote Grab

7300, 7301, 7306, 7307, 7308 TCP NetMonitor

7789 TCP ICQ Killer

9989 TCP iNi-Killer

10607TCP Coma 1.0.9

11000TCP Senna Spy

11223 TCP Progenic trojan

12223 TCP Hack’99 KeyLogger

12345, 12346 TCP NetBus 1.20-1.70, GabanBus

12361 ,12362 TCP Whack-a-mole

16969 TCP Priority

20001 TCP Millennium

20034 TCP NetBus 2.0 Beta-NetBus 2.01

21544 TCP GirlFriend 1.0 Beta-1.35

22222 TCP Prosiak

23456TCP Evil FTP, Ugly FTP

26274, 47262 TCP Delta

30100, 30101, 30102 TCP NetSphere 1.27a

30100, 30101, 30102 , 30103, 30103, 30103 TCP/UDP NetSphere 1.31

31337 UDP BackOfrice 1.20

31338 UDP DeepBO

31339 TCP NetSpy DK

31666 UDP BOWhack

31785, 31787, 31789, 31791, 31789, 31791 TCP/UDPHack Attack

33333 TCP Prosiak

34324 TCP BigGluck, TN

40412 TCP The Spy

40421, 40422, 40423, 40426 TCP Masters Paradise

50505 TCP Sockets de Troie

50766 TCP Fore

53001 TCP Remote Windows Shutdown

54321 TCP SchoolBus .69-1.11

61466 TCP Telecommando

65000 TCP Devil 1.3

69123 TCP ShitHeep

3003TCPСмерть Ламера

 

Порты

Здесь приводится список номеров портов и показывается за каким портом какая служба закреплена

7 echo

9 discard

11 systat

13 daytime

15 netstat

17 qotd

19 chargen

20 ftp-data

21 ftp

23 telnet

25 smtp

37 time

39 rlp

42 name

43 whois

53 domain

57 mtp

67 bootp

69 tftp

77 rje

79 finger

87 link

95 supdup

101 hostnames

102 iso-tsap

103 dictionary

104 x400-snd

105 csnet-ns

109 pop

110 pop3

111 portmap

113 auth

115 sftp

117 path

119 nntp

123 ntp

137 nbname

138 nbdatagram

139 nbsession

144 News

153 sgmp

158 tcprepo

161 snmp

162 snmp-trap

170 print-srv

175 vmnet

315 load

400 vmnet

500 sytek

512 biff

513 login

514 shell

515 printer

517 talk

518 ntalk

520 efs

525 timed

526 tempo

530 courier

531 conference

532 netnews

533 netwall

540 uucp

543 klogin

544 kshell

550 new-rwho

556 remotefs

560 rmonitor

561 monitor

600 garcon

601 maitrd

602 busboy

700 acctmaster

701 acctslave

702 acct

703 acctlogin

704 acctprinter

705 acctinfo

706 acctslave2

707 acctdisk

750 kerberos

751 kerberos_master

752 passwd_server

753 userreg_server

754 krb_prop

888 erlogin

Получить имена свободных com портов

Для начала подключите модуль Registry в области uses. Затем на форму нужно будет вынести кнопку и многострочное текстовое поле класса TMemo. Ну и по нажатию на кнопку написать следующий код:

procedure TForm1.Button1Click(Sender: TObject);

var

reg: TRegistry;

st: TStrings;

i: integer;

begin

reg := TRegistry.Create;

reg.RootKey := HKEY_LOCAL_MACHINE;

reg.OpenKey('hardware\devicemap\serialcomm', false);

st := TStringList.Create;

reg.GetValueNames(st);

for i := 0 to st.Count - 1 do

Memo1.Lines.Add(reg.ReadString(st.Strings[i]));

st.Free;

reg.CloseKey;

reg.free;

end;

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

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.

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

{ HTTPGet component for Delphi 32 }

{ 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 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}

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

Обычно при разработке приложений, которые планируется в дальнейшем обновлять и усовершенствовать, основные модули хранятся в виде пакетов (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).

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

Для данной цели можно воспользоваться компонентами 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 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}