Вопросы и ответы - Delphi - Сеть, интернет, протоколы - Библиотека программиста
Пользователь

Добро пожаловать,

Регистрация или входРегистрация или вход
Потеряли пароль?Потеряли пароль?

Ник:
Пароль:

Меню сайта




Ваше мнение
Легко ли найти нужную информацию на сайте?

Очень просто
Нахожу почти сразу
Приходится тщательно покопаться
Почти невозможно
Не нашел (лень разбираться)


Результаты
Другие опросы

Всего голосов: 559
Комментарии: 0


Наши партнеры


Смотрите на сайте отделка офисов м2.


Статистика




Programming books  Download software  Documentation  Scripts  Content Managment Systems(CMS)  Templates  Icon Sets  Articles  Contacts  Voting  Site Search




Вопросы и ответы - Delphi - Сеть, интернет, протоколы

                 
 
HTTP кодирование строки
Код
function HTTPEncode(const AStr: string): string;
const
NoConversion = ['A'..'Z', 'a'..'z', '*', '@', '.', '_', '-'];
var
Sp, Rp: PChar;
begin
SetLength(Result, Length(AStr) * 3);
Sp := PChar(AStr);
Rp := PChar(Result);
while Sp^ <> #0 do
begin
if Sp^ in NoConversion then
Rp^ := Sp^
else if Sp^ = ' ' then
Rp^ := '+'
else
begin
FormatBuf(Rp^, 3, '%%%.2x', 6, [Ord(Sp^)]);
Inc(Rp, 2);
end;
Inc(Rp);
Inc(Sp);
end;
SetLength(Result, Rp - PChar(Result));
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
Edit1.Text := HTTPEncode(Edit1.Text);
end;
URL декодирование строки
Код
{ **** UBPFD *********** by kladovka.net.ru ****
>> URL декодирование строки

Функция выполняет URL декодирование строки, заменяя все
подстроки вида '%HH', где 'HH' - шестнадцатеричные
цифры, на соответствующие символы.

Зависимости: Windows
Автор: Dimka Maslov, mainbox@endimus.ru, ICQ:148442121, Санкт-Петербург
Copyright: Dimka Maslov
Дата: 27 мая 2002 г.
********************************************** }

function UrlDecode(Str: string): string;

function HexToChar(W: word): Char;
asm
cmp ah, 030h
jl @@error
cmp ah, 039h
jg @@10
sub ah, 30h
jmp @@30
@@10:
cmp ah, 041h
jl @@error
cmp ah, 046h
jg @@20
sub ah, 041h
add ah, 00Ah
jmp @@30
@@20:
cmp ah, 061h
jl @@error
cmp al, 066h
jg @@error
sub ah, 061h
add ah, 00Ah
@@30:
cmp al, 030h
jl @@error
cmp al, 039h
jg @@40
sub al, 030h
jmp @@60
@@40:
cmp al, 041h
jl @@error
cmp al, 046h
jg @@50
sub al, 041h
add al, 00Ah
jmp @@60
@@50:
cmp al, 061h
jl @@error
cmp al, 066h
jg @@error
sub al, 061h
add al, 00Ah
@@60:
shl al, 4
or al, ah
ret
@@error:
xor al, al
end;

function GetCh(P: PChar; var Ch: Char): Char;
begin
Ch:=P^;
Result:=Ch;
end;

var
P: PChar;
Ch: Char;
begin
Result:='';
P:=@Str[1];
while GetCh(P, Ch) <> #0 do begin
case Ch of
'+': Result:=Result+' ';
'%': begin
Inc(P);
Result:=Result+HexToChar(PWord(P)^);
Inc(P);
end;
else Result:=Result+Ch;
end;
Inc(P);
end;
end;
URL кодирование строки
Код
{ **** UBPFD *********** by kladovka.net.ru ****
>> URL кодирование строки

Функция производит так назваемое URL кодирование строк для
использования в http запросах. Т.е. все алфавитно-цифровые
символы и знак подчёикивания '_' остаются неизменными,
пробел заменяется на '+', а все остальные символы на знак
процента '%' с двумя шестнадцатеричными цифрами.

Зависимости: Windows
Автор: Dimka Maslov, mainbox@endimus.ru, ICQ:148442121, Санкт-Петербург
Copyright: Dimka Maslov
Дата: 27 мая 2002 г.
********************************************** }

function UrlEncode(Str: string): string;

function CharToHex(Ch: Char): Integer;
asm
and eax, 0FFh
mov ah, al
shr al, 4
and ah, 00fh
cmp al, 00ah
jl @@10
sub al, 00ah
add al, 041h
jmp @@20
@@10:
add al, 030h
@@20:
cmp ah, 00ah
jl @@30
sub ah, 00ah
add ah, 041h
jmp @@40
@@30:
add ah, 030h
@@40:
shl eax, 8
mov al, '%'
end;

var
i, Len: Integer;
Ch: Char;
N: Integer; P: PChar;
begin
Result:='';
Len:=Length(Str);
P:=PChar(@N);
for i:=1 to Len do begin
Ch:=Str[i];
if Ch in ['0'..'9', 'A'..'Z', 'a'..'z', '_'] then Result:=Result+Ch else begin
if Ch = ' ' then Result:=Result+'+' else begin
N:=CharToHex(Ch);
Result:=Result+P;
end;
end;
end;
end;


Пример использования:
Код

procedure TForm1.Button1Click(Sender: TObject);
var
S: string;
begin
S:=UrlEncode('Мастера Delphi');
ShellExecute(Handle, 'open',
PChar('http://www.yandex.ru/yandsearch?text='+S), '', '', SW_SHOWNORMAL);
end;
Есть ли соединение с инетом?
Часто приложению, которое работает в интернете, требуется знать, подключён пользователь к интернету или нет. Предлагаю Вам довольно гибкое решение этого вопроса.

За это отвечает ф-ии InternetGetConnectedState() из wininet.dll или InetIsOffLine() из url.dll

Для работы Вам необходимо импортировать функцию InetIsOffline из URL.DLL:

function InetIsOffline(Flag: Integer): Boolean; stdcall; external 'URL.DLL';

а затем поместить в программу простой вызов функции для проверки статуса соединения:

if InetIsOffline(0) then

ShowMessage('This computer is not connected to Internet!')

else

ShowMessage(You are connected to Internet!');

Эта функция возвращает TRUE если соединение с интернетов отсутствует, или FALSE если соединение установлено.

Замечание:

параметр Flag игнорируется, соответственно используем ноль.

Эта DLL обычно проинсталлирована на большинстве компьютеров. Она также существует в Win98 либо поставляется с Internet Explorer 4 или выше, Office 97 и т.д..

Более подробно можно прочитать в MSDN. Оригинал: http://msdn.microsoft.com/library/psdk/shellcc/shell/Functions/InetIsOffline.htm

Имена сетевого адаптера, устройства и описание
Имя виртуального устройства можно получить вот так:

Код
const
MAX_ADAPTER_NAME = 255;
type
PIP_ADAPTER_INDEX_MAP = ^IP_ADAPTER_INDEX_MAP;
IP_ADAPTER_INDEX_MAP = record
Index: DWORD;
Name: array [0..MAX_ADAPTER_NAME-1] of WideChar;
end;

PIP_INTERFACE_INFO = ^IP_INTERFACE_INFO;
IP_INTERFACE_INFO = record
NumAdapters: Longint;
Adapter: array [0..0] of IP_ADAPTER_INDEX_MAP;
end;

function GetIfEntry(pIfRow: PMibIfRow): DWORD; stdcall external 'iphlpapi.dll';
function GetNumberOfInterfaces(var pdwIntf: DWORD): DWORD; stdcall; external 'iphlpapi.dll';
function GetInterfaceInfo(pIfTable: PIP_INTERFACE_INFO; var dwOutBufLen:DWORD): DWORD;
stdcall; external 'iphlpapi.dll';
function GetAdapterIndex(AdapterName: PWideChar; var IfIndex: DWORD): DWORD;
stdcall; external 'iphlpapi.dll';

procedure TMainForm.Button1Click(Sender: TObject);
var
I, pdwIntf, dwOutBufLen, IfIndex: DWORD;
lpInfo: PIP_INTERFACE_INFO;
mirIfDescr: TMibIfRow;
begin
//if GetNumberOfInterfaces(pdwIntf) = NO_ERROR then
//begin
GetInterfaceInfo(nil, dwOutBufLen);
GetMem(lpInfo, dwOutBufLen);
try
if GetInterfaceInfo(lpInfo, dwOutBufLen) = NO_ERROR then
begin
for I := 0 to lpInfo^.NumAdapters - 1 do
begin
Memo1.Lines.Add('AdapterName: ' + lpInfo^.Adapter[I].Name);
if GetAdapterIndex(lpInfo^.Adapter[I].Name, IfIndex) = NO_ERROR then
Memo1.Lines.Add('AdapterIndex: ' + IntToStr(IfIndex))
else
RaiseLastOSError;
ZeroMemory(@mirIfDescr, SizeOf(TMibIfRow));
mirIfDescr.dwIndex := IfIndex;
if GetIfEntry(@mirIfDescr) = NO_ERROR then
Memo1.Lines.Add('AdapterDescription: ' + mirIfDescr.bDescr)
else
RaiseLastOSError;
end;
end
else
RaiseLastOSError;
finally
FreeMem(lpInfo);
end;
end
//else
//RaiseLastOSError;
end;
Как загрузить веб-страницу со скрытым IP?
Код
{ Add a button and memo }

implementation

{$R *.dfm}

uses
Urlmon;

procedure TForm1.Button1Click(Sender : TObject);
var
ca : iinterface;
rls : Integer;
stat : iBindStatusCallBack;
rr : Cardinal;
tag : _tagBindInfo;
exGuid : tguid;
noIp : Pointer;
res : HResult;
begin
// Make a 0.0.0.0 ip giud
exGuid.D1 := rr;
exGuid.D2 := word('0');
exGuid.D3 := word('.');
// Set Tag options
with tag do
begin
// set "0." ip guid
iid := exGuid;
// set needed size
cbSize := sizeOf('www.big-x.cjb.net');
// Add ip hiding ( not tested, but should work )
securityAttributes.lpSecurityDescriptor := noIp;
securityAttributes.nLength := length('0.0.0.0');
securityAttributes.bInheritHandle := True;
end;{
Extra: res := stat.GetBindInfo(rr, tag);}
//Start downloading webpage
try
urlmon.URLDownloadToFile(ca, 'www.big-x.cjb.net', 'filename.htm', 1, stat);
except
ShowMessage('Could not download the webpage!');
end;
//Load the webpage source to a memo
memo1.Lines.LoadFromFile('filename.htm');
end;
Как заполнить форму и отправить на сервер?
Код
<form method=GET action=http://localhost/cgi-bin/mget?>
<input type=text name=name1 value="имя" size="40" maxlength="20"><br>
<input type=text name=name2 value="фамилия" size="40" maxlength="20"><br>
<input type=submit>
</form>


2. Определить метод, который используется для отправки данных. В указанном выше примере это "GET" - form method=GET

3. Найти поля, которые необходимо заполнить.

В примере это:

Код
<input type=text name=name1 value="имя" size="40" maxlength="20"><br>
<input type=text name=name2 value="фамилия" size="40" maxlength="20"><br>


4. Используя компоненты для работы с протоколом TCP/IP, сформировать строку запроса.
Для определенности пусть это будет компонент TIdHTTP из пакета Indy, входящий в стандартный набор компонент Delphi.

Сформируем строку для отправки на сервер для нашего примера:

Пусть нам нужно отправить значениядля полей: имя=Vasya, фамилия=Pupkin.

В этом случае запрос будет выглядеть так:

Код
var
s: String;
begin
s := IdHTTP1.Get('http://localhost/cgi-bin/mget?name1=Vasya&name2=Pupkin')


В случае, если форма использует метод POST:

Код
<form method=POST action=http://localhost/cgi-bin/mget?>
<input type=text name=name1 value="имя" size="40" maxlength="20"><br>
<input type=text name=name2 value="фамилия" size="40" maxlength="20"><br>
<input type=submit>
</form>


формируем запрос для отправки несколько по-другому:

Код
var
tL: TStringList;
s: String;
begin
tL := TStringList.Create;
tL.Add('name1=Vasya');
tL.Add('name2=Pupkin');
try
s := IdHTTP1.Post('http://localhost/cgi-bin/mget',tL);
finally
tL.Free;
end;
Как можно разорвать соединение с интернетом?
Код
LONG lineDrop(HCALL hCall, LPCSTR lpsUserUserInfo, DWORD dwSize );


Как проверить существование URL?
Данная функция позволяет Вам проверить существование определённого адреса(URL) в интернете. Естественно она может пригодиться веб-мастерам, у которых на сайте много ссылок, и необходимо с определённой периодичнойстью эти ссылки проверять.

URL может быть как с префиксом http:/ так и без него - эта функция добавляет префикс http:// если он отсутствует (необходимо для функции internetOpenUrl которая так же поддерживает FTP:// и gopher://

Эта функция проверяет только два возвращаемых кода '200'(ОК) или '302' (Редирект), но Вы можете заставить проверять функцию и другие коды. Для этого достаточно модифицировать строчку "result := ".

Код
uses wininet;

function CheckUrl(url: string): boolean;
var
hSession, hfile, hRequest: hInternet;
dwindex, dwcodelen: dword;
dwcode: array[1..20] of char;
res: pchar;
begin
if pos('http://', lowercase(url)) = 0 then
url := 'http://' + url;
Result := false;
hSession := InternetOpen('InetURL:/1.0',
INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
if assigned(hsession) then
begin
hfile := InternetOpenUrl(
hsession,
pchar(url),
nil,
0,
INTERNET_FLAG_RELOAD,
0);
dwIndex := 0;
dwCodeLen := 10;
HttpQueryInfo(hfile, HTTP_QUERY_STATUS_CODE,
@dwcode, dwcodeLen, dwIndex);
res := pchar(@dwcode);
result := (res = '200') or (res = '302');
if assigned(hfile) then
InternetCloseHandle(hfile);
InternetCloseHandle(hsession);
end;
end;
Как узнать имя домена Windows NT/2000?
Код
function GetNTDomainName: string;
var hReg: TRegistry;
begin
hReg := TRegistry.Create;
hReg.RootKey := HKEY_LOCAL_MACHINE;
hReg.OpenKey('SOFTWAREMicrosoftWindows NTCurrentVersion
Winlogon', false );
Result := hReg.ReadString( 'DefaultDomainName' );
hReg.CloseKey;
hReg.Destroy;
end;
Как узнать имя компьютера?
Чтобы узнать имя, идентифицирующее компьютер в сети, на котором запущена Ваша программа, можно воспользоваться следующей функцией:

Код
uses Windows;

function GetComputerNetName: string;
var
buffer: array[0..255] of char;
size: dword;
begin
size := 256;
if GetComputerName(buffer, size) then
Result := buffer
else
Result := ''
end;
Как узнать размер файла в интернете?
Код
uses wininet;
...
function GetUrlSize(const URL:string):integer;//результат в байтах
var
hSession,hFile:hInternet;
dwBuffer:array[1..20] of char;
dwBufferLen,dwIndex:DWORD;
begin
Result:=0;
hSession:=InternetOpen('GetUrlSize',INTERNET_OPEN_TYPE_PRECONFIG,nil,nil,0);
if Assigned(hSession) then begin
hFile:=InternetOpenURL(hSession,PChar(URL),nil,0,INTERNET_FLAG_RELOAD,0);
dwIndex:=0;
dwBufferLen:=20;
if HttpQueryInfo(hFile,HTTP_QUERY_CONTENT_LENGTH,@dwBuffer,dwBufferLen,dwIndex) then Result:=StrToInt(StrPas(@dwBuffer));
if Assigned(hFile) then InternetCloseHandle(hFile);
InternetCloseHandle(hsession);
end;
end;
Как узнать тип соединения с интернетом?
Код
uses
WinInet;

const
MODEM = 1;
LAN = 2;
PROXY = 4;
BUSY = 8;

function GetConnectionKind(var strKind: string): Boolean;
var
flags: DWORD;
begin
strKind := '';
Result := InternetGetConnectedState(@flags, 0);
if Result then
begin
if (flags and MODEM) = MODEM then strKind := 'Modem';
if (flags and LAN) = LAN then strKind := 'LAN';
if (flags and PROXY) = PROXY then strKind := 'Proxy';
if (flags and BUSY) = BUSY then strKind := 'Modem Busy';
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
strKind: string;
begin
if GetConnectionKind(strKind) then
ShowMessage(strKind);
end;
Как узнать, подключен ли компьютер к сети?
Код
procedure TForm1.Button1Click(Sender: TObject);
begin
if GetSystemMetrics(SM_NETWORK) and $01 = $01 then
ShowMessage('Computer is attached to a network!')
else
ShowMessage('Computer is not attached to a network!');
end;
Коды ответов HTTP сервера
Успешные
200 OK
201 Created
202 Accepted
203 Non-Authoriative Information
204 No Content
205 Reset Content
206 Partial Content

Перенаправляющие
300 Multiple Choices
301 Moved Permanently
302 Moved Temporarily
303 See Other
304 Not Modified
305 Use Proxy (proxy redirect)

Клиентские ошибки
400 Bad Request
401 Unauthorized
402 Payment Required
403 Forbidden
404 Not Found
405 Method Not Allowed
406 Not Acceptable
407 Proxy Authentication Required
408 Request Timeout
409 Confict
410 Gone
411 Length Required
412 Precondition Failed
413 Request Entity To Large
414 Request-URI Too Long
415 Unsupported Media Type

Ошибки сервера
500 Internal Server Error
501 Not Implemented
502 Bad Gateway
503 Service Unavailable
504 Gateway Timeout
505 HTTP Version Not Supported
Можно ли определить интернет адрес?
Код
unit Unit1;



interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ActiveX, SHDocVw, MSHTML_TLB, StdCtrls;

type
TForm1 = class(TForm)
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

function GetHTMLCode(WB: IWebbrowser2; ACode: TStrings): Boolean;
var
Range: IHTMLTxtRange;
begin
Range := ((WB.Document as IHTMLDocument2).body as
IHTMLBodyElement).createTextRange;
ACode.Text := ACode.Text + Range.text;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
ShellWindow: IShellWindows;
WB: IWebbrowser2;
spDisp: IDispatch;
IDoc1: IHTMLDocument2;
k: Integer;
begin
ShellWindow := CoShellWindows.Create;
for k := 0 to ShellWindow.Count do
begin
spDisp := ShellWindow.Item(k);
if spDisp = nil then Continue;
spDisp.QueryInterface(IWebBrowser2, WB);
if WB <> nil then
begin
WB.Document.QueryInterface(IHTMLDocument2, iDoc1);
if iDoc1 <> nil then
begin
WB := ShellWindow.Item(k) as IWebbrowser2;
begin
Memo1.Lines.Add('****************************************');
Memo1.Lines.Add(WB.LocationURL);
Memo1.Lines.Add('****************************************');
GetHTMLCode(WB, Memo1.Lines);
end;
end;
end;
end;
end;

end.
Получение IP-адресов всех компьютеров в рабочей группе
Код
var
Computer: array[1..500] of string[25];
ComputerCount: Integer;

procedure FindAllComputers(Workgroup: string);
var
EnumHandle: THandle;
WorkgroupRS: TNetResource;
Buf: array[1..500] of TNetResource;
BufSize: Integer;
Entries: Integer;
Result: Integer;
begin
ComputerCount := 0;
Workgroup := Workgroup + #0;
FillChar(WorkgroupRS, SizeOf(WorkgroupRS), 0);
with WorkgroupRS do
begin
dwScope := 2;
dwType := 3;
dwDisplayType := 1;
dwUsage := 2;
lpRemoteName := @Workgroup[1];
end;
WNetOpenEnum(RESOURCE_GLOBALNET,
RESOURCETYPE_ANY,
0,
@WorkgroupRS,
EnumHandle);
repeat
Entries := 1;
BufSize := SizeOf(Buf);
Result :=
WNetEnumResource(EnumHandle,
Entries,
@Buf,
BufSize);
if (Result = NO_ERROR) and (Entries = 1) then
begin
Inc(ComputerCount);
Computer[ComputerCount] := StrPas(Buf[1].lpRemoteName);
end;
until (Entries <> 1) or (Result <> NO_ERROR);
WNetCloseEnum(EnumHandle);
end; { Find All Computers }
Получение имени пользователя и домена
Код
// Пример получения имени пользователя и домена под которым работает
// текущий поток или процесс
type
PTOKEN_USER = ^TOKEN_USER;
_TOKEN_USER = record
User : TSidAndAttributes;
end;
TOKEN_USER = _TOKEN_USER;

function GetCurrentUserAndDomain (
szUser : PChar; var chUser: DWORD; szDomain :PChar; var chDomain : DWORD
):Boolean;
var
hToken : THandle;
cbBuf : Cardinal;
ptiUser : PTOKEN_USER;
snu : SID_NAME_USE;
begin
Result:=false;
// Получаем маркер доступа текущего потока нашего процесса
if not OpenThreadToken(GetCurrentThread(),TOKEN_QUERY,true,hToken)
then begin
if GetLastError()< > ERROR_NO_TOKEN then exit;
// В случее ошибки - получаем маркер доступа нашего процесса.
if not OpenProcessToken(GetCurrentProcess(),TOKEN_QUERY,hToken)
then exit;
end;

// Вывываем GetTokenInformation для получения размера буфера
if not GetTokenInformation(hToken, TokenUser, nil, 0, cbBuf)
then if GetLastError()< > ERROR_INSUFFICIENT_BUFFER
then begin
CloseHandle(hToken);
exit;
end;

if cbBuf = 0 then exit;

// Выделяем память под буфер
GetMem(ptiUser,cbBuf);

// В случае удачного вызова получим указатель на TOKEN_USER
if GetTokenInformation(hToken,TokenUser,ptiUser,cbBuf,cbBuf)
then begin
// Ищем имя пользователя и его домен по его SID
if LookupAccountSid(nil,ptiUser.User.Sid,szUser,chUser,szDomain,chDomain,snu)
then Result:=true;
end;

// Освобождаем ресурсы
CloseHandle(hToken);
FreeMem(ptiUser);
end;

// Использовать функцию можно так :
var
Domain, User : array [0..50] of Char;
chDomain,chUser : Cardinal;
begin
chDomain:=50;
chUser :=50;
if GetCurrentUserAndDomain(User,chuser,Domain,chDomain)
then ...
end;

// Если вам необходимо получить только имя пользователя - используйте GetUserName
// Данный пример можно использовать и для определения - запущен ли процесс
// системой или пользователем. Учетной записи Localsystem соответствует
// имя пользователя - SYSTEM и домен NT AUTORITY (лучше проверить на практике)
Проверка правильности E-mail адреса
Если пользователю Вашего приложения необходимо вводить почтовый адрес, то возникает потребность в проверке адреса на правильнось. Конечно способов сделать это существует множество, но этот, на мой взгляд, самый короткий и доступный для понимания.

Код
function IsValidEmail(const Value: string): boolean;
function CheckAllowed(const s: string): boolean;
var
i: integer;
begin
Result:= false;
for i:= 1 to Length(s) do
begin
{ недопустимый символ в s - значит недопустимый адрес }
if not (s[i] in ['a'..'z', 'A'..'Z', '0'..'9', '_', '-', '.']) then
Exit;
end;
Result:= true;
end;
var
i: integer;
namePart, serverPart: string;
begin // начало выполнения IsValidEmail
Result:= false;
i:= Pos('@', Value);
if i = 0 then
Exit;
namePart:= Copy(Value, 1, i - 1);
serverPart:= Copy(Value, i + 1, Length(Value));
// @ не указано имя имя или сервер не указаны; минимально для сервера. "a.com"
if (Length(namePart) = 0) or ((Length(serverPart) < 1)) then
Exit;
i:= Pos('.', serverPart);
// должно иметь точку и как минимум два знака от конца
if (i = 0) or (i > (Length(serverPart) - 1)) then
Exit;
Result:= CheckAllowed(namePart) and CheckAllowed(serverPart);
end;


Печать страницы
Печать страницы


Внимание! Если у вас не получилось найти нужную информацию, используйте рубрикатор или воспользуйтесь поиском


.



книги по программированию исходники компоненты шаблоны сайтов C++ PHP Delphi скачать