|
|||||||||||||||||||
| <Добавить в Избранное> <Сделать стартовой> <Реклама на сайте> <Контакты> | |||||||||||||||||||
|
|||||||||||||||||||
| |||||||||||||||||||
|
| |||||||||||||||||||
|
| |||||||||||||||||||
Раздел: Компьютерная документация -> Программирование -> Delphi / Pascal | |||||||||||||||||||
Работа с URL в DELPHIПриводимая здесь функция показывает, как Ваше приложение может извлечь из браузера (IE или Netscape) URL , как, например, это делает аська. Совместимость: Delphi 4.x (или выше) Не забудьте добавить DDEMan в Ваш проект! Собственно сам исходничек функции: uses windows, ddeman, ...... function Get_URL(Servicio: string): String; var Cliente_DDE: TDDEClientConv; temp:PChar; //<<-------------------------This is new begin Result := ''; Cliente_DDE:= TDDEClientConv.Create( nil ); with Cliente_DDE do begin SetLink( Servicio,'WWW_GetWindowInfo'); temp := RequestData('0xFFFFFFFF'); Result := StrPas(temp); StrDispose(temp); //<<-Предотвращаем утечку памяти CloseLink; end; Cliente_DDE.Free; end; procedure TForm1.Button1Click(Sender); begin showmessage(Get_URL('Netscape')); или showmessage(Get_URL('IExplore')); end; Взять часть URL, которая следует после названия сайта { 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; Вывести типы URL для Internet Explorer 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('SoftwareMicrosoftInternet ExplorerTypedURLs', 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; Извлечь имя файла из строки URL function ExtractUrlFileName(const AUrl: string): string; var i: Integer; begin i := LastDelimiter('/', AUrl); Result := Copy(AUrl, i + 1, Length(AUrl) - (i)); end; procedure TForm1.Button1Click(Sender: TObject); var s: string; begin s := ExtractUrlFileName('http://www.delphimania.de/index.php'); ShowMessage(s); //index.php end Как захватить текущий URL из окна Internet Explorer Описываем две функции GetText и GetURL: 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; Ну а затем пользуемся функцией GetURL, например, можем в поле ввода по нажатию на кнопку выводит текущий URL: procedure TForm1.Button1Click(Sender: TObject); begin Edit1.Text := GetURL; end; Как скачать любой URL используя стандартные настройки сети Начиная с Internet Explorer 3, Microsoft поддерживает очень полезные API, Wininet. Эти функции позволяют использовать все возможности IE, такие как настройки прокси, кэширование файлов и т.д. Ниже приведён пример использования этих функций для скачивания файла с нужного URL. Это может быть любой доступный URL, ftp://, http://, gopher://, и т.д. Более подробную информацию об этих функция можно посмотреть в MSDN - Win32 Internet API Functions. function DownloadFile(const Url: string): string; var NetHandle: HINTERNET; UrlHandle: HINTERNET; Buffer: array[0..1024] of char; BytesRead: cardinal; begin Result := ''; NetHandle := InternetOpen('Delphi 5.x', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0); if Assigned(NetHandle) then begin UrlHandle := InternetOpenUrl(NetHandle, PChar(Url), nil, 0, INTERNET_FLAG_RELOAD, 0); { UrlHandle правильный? Начинаем загрузку } if Assigned(UrlHandle) then begin FillChar(Buffer, SizeOf(Buffer), 0); repeat Result := Result + Buffer; FillChar(Buffer, SizeOf(Buffer), 0); InternetReadFile(UrlHandle, @Buffer, SizeOf(Buffer), BytesRead); until BytesRead = 0; InternetCloseHandle(UrlHandle); end else begin { UrlHandle неправильный. Генерируем исключительную ситуацию. } raise Exception.CreateFmt('Cannot open URL %s', [Url]); end; InternetCloseHandle(NetHandle); end else { NetHandle недопустимый. Генерируем исключительную ситуацию } raise Exception.Create('Unable to initialize Wininet'); end; //------------------------------------------------- implementation uses SysUtils,Windows,ShlObj; function NetShareAdd(ServerName:PChar; //указатель на имя компьютера, например 'Server'#0, если свой, то можно nil Level:Word; //уровень структуры Share_info, здесь 50 PShareInfo:PChar; //указатель на структуру Share_Info ParmErr:DWord) //указатель на ??? :dword;stdcall;external 'svrapi.dll';//svrapi для Win9X, NetApi32 для NT function NetShareDel(ServerName:PChar; NetName:PChar; Reserved:DWord):dword;stdcall;external 'svrapi.dll'; type _share_info_50 = record //структура Share уровня 50 NetName: array [1..13] of char; //Как будет называться диск в сети SType: byte; //тип =0 (STYPE_DISKTREE) - шарить диски Flags: word; //флаги $0191,$0192,$0193....(доступ из сети) Remark: PChar; //указатель на комментарий, видимый из сети Path: PChar; //указатель на имя ресурса, например 'c:'#0 RW_Password: array [1..9] of char; //пароль для полного доступа, если не нужен =#0 RO_Password: array [1..9] of char; //пароль для доступа на чтение, если не нужен =#0 end; //---------------------------- function SetShareOnDisk(HostName,LocalPath:string; NetName:TNetName;Remark:string; Access:word;RO_Passw,RW_Passw:TPassw):boolean; var ShareInfo:_Share_Info_50; begin Result:=false; StrPCopy(@ShareInfo.NetName,NetName); ShareInfo.SType:=0; ShareInfo.Flags:=Access; ShareInfo.Remark:=PChar(Remark); ShareInfo.Path:=PChar(LocalPath); StrPCopy(@ShareInfo.RO_Password,RO_Passw); StrPCopy(@ShareInfo.RW_Password,RW_Passw); ShareResult:=NetShareAdd(PChar(HostName), 50,@ShareInfo,$0000002a); //вызываем Share if ShareResult <> 0 then //расшарить неудалось Exit; SHChangeNotify(SHCNE_NETSHARE,SHCNF_PATH,PChar(LocalPath),nil); //сказать шеллу об изменениях Result:=true; end; //---------------------------- function RemoveShareFromDisk(HostName, NetName, LocalPath: string): boolean; begin Result:=false; ShareResult:=NetShareDel(PChar(HostName),PChar(NetName),0); //удалить шару if ShareResult <> 0 then Exit; SHChangeNotify(SHCNE_NETUNSHARE, SHCNF_PATH,PChar(LocalPath),nil); //сказать шеллу об изменениях Result:=true; end; end. Открыть URL в новом окне, используя WEBBrowser { Usually when you open a URL in new window in TWebBrowser it opens the Internet Explorer. This tip creates a new instance of your browser form and opens the new site in your browser. } procedure TForm1.WebBrowser1NewWindow2(Sender: TObject; var ppDisp: IDispatch; var Cancel: WordBool); var NewWindow: TForm1; begin // a new instance of the form will be created // Eine neue Instanz wird erstellt NewWindow := TForm1.Create(self); NewWindow.Show; ppDisp := NewWindow.Webbrowser1.DefaultDispatch; end; Проверить существование определённого 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; Фильтровать все ссылки в TMemo // For this tip you need Memo1, ListBox1, Label1, Button1. procedure TForm1.Button1Click(Sender: TObject); var i, p: Integer; s: string; begin ListBox1.Clear; for i := 0 to Memo1.Lines.Count - 1 do begin if Pos('http://', Memo1.Lines.Strings[i]) > 0 then begin s := ''; {If the current line contains a "http://", read on until a space is found Die aktuelle Zeile wird nach der Zeichenfolge "http://" durchsucht und bei Erfolg ab der gefundenen Position ausgelesen, bis ein Leerzeichen auftritt...} for p := Pos('http://', Memo1.Lines.Strings[i]) to Length(Memo1.Lines.Strings[i]) do if Memo1.Lines.Strings[i][p] <> ' ' then s := s + Memo1.Lines.Strings[i][p] else break; {Remove some characters if address doesn't end with a space Falls die gefundene Adresse nicht mit einem Leerzeichen abschlie?t, werden hier noch anhangende Textzeichen entfernt...} while Pos(s[Length(s)], '..;!")]}?''>') > 0 do Delete(s, Length(s), 1); // Add the Address to the list... //Gefundene Adresse in die Liste aufnehmen... ListBox1.Items.Add(s); end; end; // Show the number of Addresses in Label1 // Die Zahl der gefundenen Adressen in Label1 anzeigen... if ListBox1.Items.Count > 0 then label1.Caption := IntToStr(ListBox1.Items.Count) + ' Adresse(n) gefunden.' else label1.Caption := 'Keine Adresse gefunden.'; end; Источник: www.articles.org.ru
|
|||||||||||||||||||
| ||||||||||||||
|
| ||||||||||||||
|
|
|||||||
| При цитировании и перепечатке ссылка на www.compdoc.ru обязательна. Карта сайта. |