webbrowser избранное?
все варианты компилются и
procedure TForm1.ToolButton11Click(Sender: TObject);
var
url: TStringList;
fav: string;
title, b: string;
i: Integer;
c: Char;
begin
fav := Load('Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders',
'Favorites');
url := TStringList.Create;
try
url.Add('[InternetShortcut]');
url.Add('URL=' + webbrowser1.LocationURL);
url.Add('WorkingDirectory=' + WinDir());
url.Add('IconIndex=0');
url.Add('ShowCommand=7');
url.Add('IconFile=' + GetSysDir() + '\url.dll');
title := Webbrowser1.LocationName;
b := '';
for i := 1 to Length(title) do
begin
c := title;
if not (c in NotAllowed) then
begin
b := b + Webbrowser1.LocationName;
end;
end;
url.SaveToFile(fav + '\' + b + '.url');
finally
url.Free;
if InputQuery('Добавление в избранное',Webbrowser1.LocationName,title) then
url.SaveToFile(fav + '\' + b + '.url');
end;
появляется окошко
с предложением ввести в избранное открытую страницу после Ок пишет ошибка по
Address viol... 00000036.Read .... 00000036.
и всё ничего недобавляется.
Вариант 2
procedure TForm1.Addfavorites1Click(Sender: TObject);
var
H: HWnd;
p: procedure(Handle: THandle; Path: PChar); stdcall;
begin
H := LoadLibrary(PChar('shdocvw.dll'));
if H <> 0 then
begin
p := GetProcAddress(H, PChar('DoOrganizeFavDlg'));
if Assigned(p) then p(Application.Handle, PChar(Favorites1.Hint));
end;
FreeLibrary(h);
end;
появляется окно "Упорядочнить избранное" в нем опции "создать папку" "удалить папку" "Переместить папку" "Переминовать папку" и всё возможность сохранить в виде сылки нет.