Отправить E-mail

procedure TForm1.Button1Click(Sender: TObject);

begin

NMSMTP1.Host := ‘mail.host.com’;

NMSMTP1.UserID := ‘Username’;

NMSMTP1.Connect;

NMSMTP1.PostMessage.FromAddress := ‘your_mail@host.com’;

NMSMTP1.PostMessage.ToAddress.Text := ‘Kvrsoft@mail.ru’;

NMSMTP1.PostMessage.ToCarbonCopy.Text := ‘your_mail@host.com’;

NMSMTP1.PostMessage.ToBlindCarbonCopy.Text := ‘second_your_mail@host.com’;

NMSMTP1.PostMessage.Body.Text := ‘HI’;

NMSMTP1.PostMessage.Attachments.Text := ‘c:\File.txt’;

NMSMTP1.PostMessage.Subject := ‘Delphi World is Great!’;

NMSMTP1.SendMail;

ShowMessage(‘Mail sent !’);

NMSMTP1.Disconnect;

end;

Как загрузить адресную книгу

 

{codecitation class="brush: pascal; gutter: false;" width="600px"}uses Mapi;

procedure TfrmMain.btnOpenAddressBookClick(Sender: TObject);
var
lhSession, rc: Cardinal;
lpnNewRecips: PULONG;
lppNewRecips: PMapiRecipDesc;
lpRecips: MapiRecipDesc;
begin
lpnNewRecips := nil;
rc := MAPILogon(0, ‘Севостьянов Игорь’, », MAPI_LOGON_UI, 0, @lhSession);
if (rc SUCCESS_SUCCESS) then
SysErrorMessage(rc);
rc := MAPIAddress(lhSession, 0, ‘Адресная книга’, 0, », 0, lpRecips, 0, 0,
lpnNewRecips, lppNewRecips);
if (rc SUCCESS_SUCCESS) then
SysErrorMessage(rc)
else
rc := MAPIFreeBuffer(lppNewRecips); // free the memory used by MAPIAddress
if (rc SUCCESS_SUCCESS) then
SysErrorMessage(rc);
rc := MAPILogoff(lhSession, 0, 0, 0);
if (rc SUCCESS_SUCCESS) then
SysErrorMessage(rc);
 

{/codecitation}

Есть еще и в Deplhi Help C:\Program Files\Common Files\Borland Shared\MSHelp\mapi.hlp

Узнать директорию Cookie

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

uses
Registry;

function GetDirectory: string;
var
reg : TRegistry;
begin
reg := TRegistry.Create;
try
reg.RootKey := HKEY_LOCAL_MACHINE;
reg.OpenKey(‘SOFTWARE\Microsoft\Windows\CurrentVersion\Internet Settings\Cache\Special Paths\Cookies’,
False);
Result := reg.ReadString(‘Directory’);
finally
reg.Free;
end;
end;

//пример использования
procedure TForm1.Button1Click(Sender : TObject);
var
s : string;
begin
S := GetDirectory;
ShowMessage(GetDirectory);
end;{/codecitation}
 

Кириллица в параметрах CGI-запроса

Вопрос: Я хочу реализовать регистрацию своей программы через Internet. Для этого я вызываю CGI-скрипт, которому в качестве параметра передается имя пользователя. Однако, если имя набрано кириллицей, происходит ошибка. В чем дело?

Дело в том, что при передаче запроса по протоколу HTTP служебные символы и символы с кодами 128..255 надо кодировать. То есть, если пользователь ввел имя ‘Вася Пупкин’, то запрос для регистрации должен выглядеть не так:

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

http://site/cgi-bin/reg.pl?user=Вася Пупкин

{/codecitation}

а вот так:

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

http://site/cgi-bin/reg.pl?user=%C2%E0%F1%FF+%CF%F3%EF%EA%E8%ED

{/codecitation}

Решить проблему перекодировки туда и обратно может компонент TNMURL.

DK: Дополнительную информацию про кодирование URL’ов, можно прочитать в RFC1738

Добавляем Cookies

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

procedure TwebDispatcher.WebAction(Sender: TObject; Request: TWebRequest;
Response: TWebResponse; var Handled: Boolean);
begin
with (Response.Cookies.Add) do
begin
name := ‘TESTNAME’;
Value := ‘TESTVALUE’;
Secure := False;
Expires := Now;
Response.Cookies.WebResponse.SendResponse;
end;
end;{/codecitation}
 

Проверить существование определённого URL

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

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

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

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

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;{/codecitation}
 

Вывести типы URL для Internet Explorer

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

uses registry;

procedure ShowTypedUrls(Urls: TStrings);
var
Reg: TRegistry;
S: TStringList;
i: Integer;
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_CURRENT_USER;
if Reg.OpenKey(‘Software\Microsoft\Internet Explorer\TypedURLs’, False) then
begin
S := TStringList.Create;
try
reg.GetValueNames(S);
for i := 0 to S.Count — 1 do
begin
Urls.Add(reg.ReadString(S.Strings[i]));
end;
finally
S.Free;
end;
Reg.CloseKey;
end;
finally
Reg.Free;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ShowTypedUrls(ListBox1.Items);
end;{/codecitation}
 

Как захватить текущий URL из окна Internet Explorer

Описываем две функции GetText и GetURL:

{codecitation class="brush: pascal; gutter: false;" width="600px"}function GetText(WindowHandle: hwnd):string;
var
txtLength : integer;
buffer: string;
begin
TxtLength := SendMessage(WindowHandle, WM_GETTEXTLENGTH, 0, 0);
txtlength := txtlength + 1;
setlength (buffer, txtlength);
sendmessage (WindowHandle,wm_gettext, txtlength, longint(@buffer[1]));
result := buffer;
end;

function GetURL:string;
var
ie,toolbar,combo,
comboboxex,edit,
worker,toolbarwindow:hwnd;
begin
ie := FindWindow(pchar(‘IEFrame’),nil);
worker := FindWindowEx(ie,0,’WorkerA’,nil);
toolbar := FindWindowEx(worker,0,’rebarwindow32′,nil);
comboboxex := FindWindowEx(toolbar, 0, ‘comboboxex32’, nil);
combo := FindWindowEx(comboboxex,0,’ComboBox’,nil);
edit := FindWindowEx(combo,0,’Edit’,nil);
toolbarwindow := FindWindowEx(comboboxex, 0, ‘toolbarwindow32’, nil);
result := GetText(edit);
end;
{/codecitation} 

Ну а затем пользуемся функцией GetURL, например, можем в поле ввода по нажатию на кнопку выводит текущий URL:

{codecitation class="brush: pascal; gutter: false;" width="600px"}procedure TForm1.Button1Click(Sender: TObject);
begin
Edit1.Text := GetURL;
end;
{/codecitation}

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

{codecitation class="brush: pascal; gutter: false;" width="600px"}{
InternetCrackUrl() takes a URL as a parameter and breaks it down into components,
which are then accessible via the TURLComponents structure.

InternetCrackUrl() zerlegt eine URL in seine Komponenten, welche dann ьber die
TURLComponents Struktur zugдnglich sind.
}

uses
WinInet;

procedure TForm1.Button1Click(Sender: TObject);
var
aURLC: TURLComponents;
const
TEST_URL = ‘http://www.swissdelphicenter.ch/de/tipsindex.php’;
begin
FillChar(aURLC, SizeOf(TURLComponents), 0);
with aURLC do
begin
lpszScheme := nil;
dwSchemeLength := INTERNET_MAX_SCHEME_LENGTH;
lpszHostName := nil;
dwHostNameLength := INTERNET_MAX_HOST_NAME_LENGTH;
lpszUserName := nil;
dwUserNameLength := INTERNET_MAX_USER_NAME_LENGTH;
lpszPassword := nil;
dwPasswordLength := INTERNET_MAX_PASSWORD_LENGTH;
lpszUrlPath := nil;
dwUrlPathLength := INTERNET_MAX_PATH_LENGTH;
lpszExtraInfo := nil;
dwExtraInfoLength := INTERNET_MAX_PATH_LENGTH;
dwStructSize := SizeOf(aURLC);
end;
if InternetCrackUrl(PChar(TEST_URL), Length(TEST_URL), 0, aURLC) then
begin
ShowMessage(aURLC.lpszUrlPath);
end;
end;
{/codecitation}