:: MVP ::
|
|
:: RSS ::
|
|
|
Как програмно открыть URL в новом окне браузера?
uses
{...,} ShellApi;
// Для того, чтобы Internet Explorer запустился,
// обязательно нужно, чтобы Label1.Caption начинался с
// "www." или "http://" { естественно без ковычек }
procedure TForm1.Label1Click(Sender: TObject);
begin
keybd_event( VK_SHIFT, 0, 0, 0 );
ShellExecute( 0, nil, PChar( Label1.Caption ),
nil, nil, SW_NORMAL );
keybd_event( VK_SHIFT, 0, KEYEVENTF_KEYUP, 0 );
end;
|
Как получить активный URL из браузера?
uses
{...,} DdeMan;
type
TForm1 = class(TForm)
private
{ Private declarations }
function Get_URL(Servicio: string): String;
public
{ Public declarations }
end;
function TForm1.Get_URL(Servicio: string): String;
var
Cliente_DDE: TDDEClientConv;
temp: PChar;
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: TObject);
begin
ShowMessage( Get_URL( 'IExplore' ) );
// ShowMessage( Get_URL( 'Netscape' ) );
end;
|
Как получить закладки из IE?
uses
{...,} ShlObj;
function GetIEFavourites(const FavPath: string):TStrings;
var
SearchRec: TSearchRec;
str: TStrings;
path, dir, filename: string;
Buffer: array[0..2047] of Char;
found: integer;
begin
str := TStringList.Create;
path := FavPath + '\*.url';
dir := ExtractFilepath( path );
found := FindFirst( path, faAnyFile, SearchRec );
while found = 0 do
begin
SetString( filename, Buffer, GetPrivateProfileString( 'InternetShortcut',
PChar( 'URL' ), nil, Buffer, SizeOf( Buffer ), PChar( dir + SearchRec.Name ) ) );
str.Add( filename );
found := FindNext( SearchRec );
end;
found := FindFirst( dir + '\*.*', faAnyFile, SearchRec );
while found = 0 do
begin
if ( ( SearchRec.Attr and faDirectory ) > 0 ) and ( SearchRec.Name[1] <> '.' ) then
str.AddStrings( GetIEFavourites( dir + '\' + SearchRec.Name ) );
found := FindNext( SearchRec );
end;
FindClose( SearchRec );
Result := str;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
pidl: PItemIDList;
FavPath: array[0..MAX_PATH] of char;
begin
SHGetSpecialFolderLocation( Handle, CSIDL_FAVORITES, pidl );
SHGetPathFromIDList( pidl, FavPath );
ListBox1.Items := GetIEFavourites( StrPas( FavPath ) );
end;
|
Как отчистить Temporary Internet Files?
// Способ первый
uses
{...,} WinInet;
procedure EmptyTemporaryInternetFiles;
var
lpEntryInfo: PInternetCacheEntryInfo;
hCacheDir: LongWord;
dwEntrySize: LongWord;
dwLastError: LongWord;
begin
dwEntrySize := 0;
FindFirstUrlCacheEntry( nil, TInternetCacheEntryInfo( nil^ ), dwEntrySize );
GetMem( lpEntryInfo, dwEntrySize );
hCacheDir := FindFirstUrlCacheEntry( nil, lpEntryInfo^, dwEntrySize );
if ( hCacheDir <> 0 ) then
DeleteUrlCacheEntry( lpEntryInfo^.lpszSourceUrlName );
FreeMem( lpEntryInfo );
repeat
dwEntrySize := 0;
FindNextUrlCacheEntry( hCacheDir, TInternetCacheEntryInfo( nil^ ), dwEntrySize );
dwLastError := GetLastError;
if ( GetLastError = ERROR_INSUFFICIENT_BUFFER ) then
begin
GetMem( lpEntryInfo, dwEntrySize );
if ( FindNextUrlCacheEntry( hCacheDir, lpEntryInfo^, dwEntrySize ) ) then
DeleteUrlCacheEntry( lpEntryInfo^.lpszSourceUrlName );
FreeMem( lpEntryInfo );
end;
until ( dwLastError = ERROR_NO_MORE_ITEMS );
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
EmptyTemporaryInternetFiles;
end;
// Способ второй
uses
{...,} WinInet;
procedure DeleteIECache;
var
lpEntryInfo: PInternetCacheEntryInfo;
hCacheDir: LongWord;
dwEntrySize: LongWord;
begin
dwEntrySize := 0;
FindFirstUrlCacheEntry( nil, TInternetCacheEntryInfo( nil^ ), dwEntrySize );
GetMem( lpEntryInfo, dwEntrySize );
if dwEntrySize > 0 then
lpEntryInfo^.dwStructSize := dwEntrySize;
hCacheDir := FindFirstUrlCacheEntry( nil, lpEntryInfo^, dwEntrySize );
if hCacheDir <> 0 then
begin
repeat
DeleteUrlCacheEntry( lpEntryInfo^.lpszSourceUrlName );
FreeMem( lpEntryInfo, dwEntrySize );
dwEntrySize := 0;
FindNextUrlCacheEntry( hCacheDir, TInternetCacheEntryInfo( nil^ ), dwEntrySize );
GetMem( lpEntryInfo, dwEntrySize );
if dwEntrySize > 0 then
lpEntryInfo^.dwStructSize := dwEntrySize;
until not FindNextUrlCacheEntry( hCacheDir, lpEntryInfo^, dwEntrySize );
end;
FreeMem( lpEntryInfo, dwEntrySize );
FindCloseUrlCache( hCacheDir );
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
DeleteIECache;
end;
|
Как узнать стартовую страницу Internet Explorer?
uses
{...,} Registry;
function GetIEStartPage: string;
var
Reg: TRegistry;
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_CURRENT_USER;
Reg.OpenKey( 'Software\Microsoft\Internet Explorer\Main', false );
try
Result := Reg.ReadString( 'Start Page' );
except
Result := '';
end;
Reg.CloseKey;
finally
Reg.Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage( GetIEStartPage );
end;
|
Как изменить стартовую страницу Internet Explorer?
uses
{...,} Registry;
function SetIEStartPage( APage: string ): boolean;
var
Reg: TRegistry;
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_CURRENT_USER;
Reg.OpenKey( 'Software\Microsoft\Internet Explorer\Main', false );
try
Reg.WriteString( 'Start Page', APage );
Result := True;
except
Result := false;
end;
Reg.CloseKey;
finally
Reg.Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
SetIEStartPage( 'http://decoding.narod.ru' );
end;
|
Как узнать версию IE?
uses
{...,} Registry;
function GetIEVersion( Key: string ): string;
var
Reg: TRegistry;
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
Reg.OpenKey( 'Software\Microsoft\Internet Explorer', false );
try
Result := Reg.ReadString( Key );
except
Result := '';
end;
Reg.CloseKey;
finally
Reg.Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage( 'IE-Version: ' + GetIEVersion( 'Version' )[1] + '.'
+ GetIEVersion( 'Version' )[3] );
ShowMessage( 'IE-Version: ' + GetIEVersion( 'Version' ) );
// <major version>.<minor version>.<build number>.<sub-build number>
end;
|
Как получить список последних открытых адресов IE?
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
Urls.Add( Reg.ReadString( S.Strings[i] ) );
finally
S.Free;
end;
Reg.CloseKey;
end;
finally
Reg.Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowTypedUrls( ListBox1.Items );
end;
|
Как определить установлен ли Internet Explorer?
uses
{...,} Registry;
function IE_installed( var Version: string ): boolean;
var
Reg: TRegistry;
begin
Reg := TRegistry.Create;
with Reg do
begin
RootKey := HKEY_LOCAL_MACHINE;
OpenKey( 'Software\Microsoft\Internet Explorer', false );
if ValueExists( 'Version' ) then
Version := ReadString( 'Version' )
else
Version := '';
CloseKey;
Free;
end;
Result := Version <> '';
end;
procedure TForm1.Button1Click(Sender: TObject);
var
IE_Version: string;
begin
if IE_Installed( IE_Version ) then
ShowMessage( Format( 'Установлен Internet Explorer версии %s', [IE_Version] ) );
end;
|
Как узнать путь к браузеру по умолчанию?
// Способ первый
uses
{...,} Registry;
procedure TForm1.Button1Click(Sender: TObject);
var
Reg: TRegistry;
ValueStr: string;
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_CLASSES_ROOT;
if Reg.OpenKey( 'htmlfile\shell\open\command', false ) then
begin
ValueStr := Reg.ReadString( '' );
Reg.CloseKey;
ShowMessage( ValueStr );
end
else
ShowMessage( 'No Default Webbrowser !' );
finally
Reg.Free;
end;
end;
// Способ второй
uses
{...,} Registry;
function GetDefBrowser: string;
var
Reg: TRegistry;
begin
Result := '';
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_CLASSES_ROOT;
if Reg.OpenKey( '\http\shell\open\command', FALSE ) then
if Reg.ValueExists('') then
Result := Reg.ReadString( '' );
Result := Copy( Result, 0, Length( Result ) - Length( ExtractFileExt( Result ) ) ) + '.exe';
if Copy( Result, 1, 1 ) = '"' then
Result := Copy( Result, 2, Length( Result ) - 1 );
Reg.CloseKey;
finally
Reg.Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage( GetDefBrowser );
end;
// Способ третий
uses
{...,} Registry;
function StripChar( SelChar: Char; PassedStr: string ): string;
var
DelPos: Integer;
begin
while Pos( SelChar, PassedStr ) <> 0 do
begin
DelPos := Pos( SelChar, PassedStr );
Delete( PassedStr, DelPos, 1 );
end;
Result := PassedStr;
end;
function GetDefaultBrowser: string;
var
Reg: TRegistry;
RegKeyInfo: TRegKeyInfo;
HtmlKey, AssocType, FullProgPath: string;
DelPos, DelLength: Integer;
begin
Reg := TRegistry.Create;
try
try
HtmlKey := '.html';
Reg.RootKey := HKEY_CLASSES_ROOT;
if Reg.KeyExists( HtmlKey ) then
begin
if Reg.OpenKey( HtmlKey, False ) then
begin
AssocType := Reg.ReadString( '' );
Reg.CloseKey;
AssocType := AssocType + '\shell\open\command';
if Reg.OpenKey( AssocType, False ) then
begin
FullProgPath := UpperCase( Reg.ReadString( '' ) );
FullProgPath := StripChar( '"', FullProgPath );
DelPos := Pos( 'EXE', FullProgPath );
DelLength := Length( FullProgPath ) - DelPos;
if DelPos <> 0 then
Delete( FullProgPath, DelPos+3, DelLength+1 );
Result := FullProgPath;
Reg.CloseKey;
end;
end;
end
else
Result := 'Не удалось обнаружить веб-браузер по умолчанию.';
except
Result := 'Не удалось обнаружить веб-браузер по умолчанию.';
end; { try/except }
finally
Reg.Free;
end; { try/finally }
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage( GetDefaultBrowser );
end;
|
При использовании материала - ссылка на сайт обязательна
|
|