Наши проекты:
Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту |
||
ПРАВИЛА | FAQ | Помощь | Поиск | Участники | Календарь | Избранное | RSS |
[3.15.221.136] |
|
Сообщ.
#1
,
|
|
|
Надо написать эту прогу на Delphi 7.
Она хранится в Dat-файлах непонятного формата обычно в папке %userprofile%\local settings\history. Может есть какие-то функции типа GetExplorerHistoryItem? Ещё вариант: запустить Explorer с параметром "%userprofile%\local settings\history" и как-то заставить его отображать содержимое в форме моего приложения, при этом надо скрыть элементы управления и чтобы он реагировал на мышку (чтобы можно было удалять). Подскажите, как решить задачу? Спасибо. |
Сообщ.
#2
,
|
|
|
Ну примерно так:
//////////////////////////////////////////////////////////////////////////////// // // **************************************************************************** // * Unit Name : IEHistory // * Purpose : Демо отображения истории браузера // * Author : Александр (Rouse_) Багель // * Copyright : © Fangorn Wizards Lab 1998 - 2007 // * Version : 1.00 // * Home Page : http://rouse.drkb.ru // **************************************************************************** // program IEHistory; {$APPTYPE CONSOLE} uses Windows, ActiveX; const IID_IUrlHistoryStg2: TGUID = '{AFA0DC11-C313-11d0-831A-00C04FD5AE38}'; CLSID_CUrlHistory: TGUID = '{3C374A40-BAE4-11CF-BF7D-00AA006946EE}'; type TSTATURL = record cbSize: DWORD; // Размер структуры pwcsUrl: PWChar; // То, что было посещено pwcsTitle: PWChar; // Заголовок ftLastVisited: FILETIME; // Время последнего визита ftLastUpdated: FILETIME; // Время последнего обновления ftExpires: FILETIME; // Дата устаревания dwFlags: DWORD; // Флаги STATURL_QUERYFLAG_ISCACHED или STATURL_QUERYFLAG_TOPLEVEL end; IEnumSTATURL = interface(IUnknown) ['{3C374A42-BAE4-11CF-BF7D-00AA006946EE}'] function Next(celt: Integer; out elt; pceltFetched: PLongint): HRESULT; stdcall; function Skip(celt: Longint): HRESULT; stdcall; function Reset: HResult; stdcall; function Clone(out ppenum: IEnumSTATURL): HResult; stdcall; function SetFilter(poszFilter: PWideChar; dwFlags: DWORD): HResult; stdcall; end; IUrlHistoryStg = interface(IUnknown) ['{3C374A41-BAE4-11CF-BF7D-00AA006946EE}'] function AddUrl(pocsUrl: PWideChar; pocsTitle: PWideChar; dwFlags: Integer): HResult; stdcall; function DeleteUrl(pocsUrl: PWideChar; dwFlags: Integer): HResult; stdcall; function QueryUrl(pocsUrl: PWideChar; dwFlags: Integer; var lpSTATURL: TSTATURL): HResult; stdcall; function BindToObject(pocsUrl: PWideChar; var riid: TIID; out ppvOut: Pointer): HResult; stdcall; function EnumUrls(out ppenum: IEnumSTATURL): HResult; stdcall; end; function Translate(Value: String): String; begin SetLength(Result, Length(Value)); AnsiToOem(@Value[1], @Result[1]); end; var History: IUrlHistoryStg; Enum: IEnumSTATURL; Url: TSTATURL; uFetched: ULONG; begin if Succeeded(CoInitialize(nil)) then try if Succeeded(CoCreateInstance(CLSID_CUrlHistory, nil, CLSCTX_INPROC_SERVER, IID_IUrlHistoryStg2, History)) then try if Succeeded(History.EnumUrls(Enum)) then while Succeeded(Enum.Next(1, Url, @uFetched)) do begin if uFetched = 0 then Break; if Length(Url.pwcsTitle) = 0 then Writeln(Translate('Заголовок отсутствует.')) else Writeln(Translate(Url.pwcsTitle)); Write('>> '); Writeln(Url.pwcsUrl); end; finally History := nil; end; finally CoUninitialize; end; Readln; end. |
Сообщ.
#3
,
|
|
|
Спасибо за исходник.
Только нужно вместо Writeln(Url.pwcsUrl) писать Writeln(Translate(Url.pwcsUrl)), а то выводит только 1-ю букву. Не получилось удалить URL. Напишите пример, как удалить из полученного списка выбранный URL. И ещё вопрос: нет ли подобного способа для Cookies? Спасибо. |
Сообщ.
#4
,
|
|
|
Цитата AlekseyKopylov @ Только нужно вместо Writeln(Url.pwcsUrl) писать Writeln(Translate(Url.pwcsUrl)), а то выводит только 1-ю букву. У меня выводит все нормально Правда у меня 2006-ой Дельфи, а в структуре юникод, не знаю как семерка с ним работает. Цитата AlekseyKopylov @ Не получилось удалить URL. Напишите пример, как удалить из полученного списка выбранный URL. Вызови метод History.DeleteUrl() Добавлено Цитата AlekseyKopylov @ нет ли подобного способа для Cookies? А они в виде файлов лежат... С ними то что не так? Получить куку с нужного адреса можно через InternetGetCookie() |
Сообщ.
#5
,
|
|
|
С куками можно и через файлы, да.
Вызываю History.DeleteUrl('http://mail.ru',0), прога или вылетает без сообщений, или вызывает ошибку. Пробовал в try заключить, то же самое. Может не такие параметры надо использовать? Спасибо. |
Сообщ.
#6
,
|
|
|
никаких параметров не нужно... History.DeleteUrl('http://mail.ru',0) отрабатывает без ошибок.
Добавлено Ты кстати не забывай что работа ведется с юникодными строками а не с Анси |
Сообщ.
#7
,
|
|
|
Спасибо, всё работает. Я сдуру сунул вызов после History := nil :)
|
Сообщ.
#8
,
|
|
|
Опять проблема. Хочу вывести в ListBox. Создал обычное приложение.
unit Unit1; interface uses ActiveX, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) UrlList: TListBox; procedure FormCreate(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure UrlListKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); private { Private declarations } public { Public declarations } end; var Form1: TForm1; {$R *.dfm} const IID_IUrlHistoryStg2: TGUID = '{AFA0DC11-C313-11d0-831A-00C04FD5AE38}'; CLSID_CUrlHistory: TGUID = '{3C374A40-BAE4-11CF-BF7D-00AA006946EE}'; type TSTATURL = record cbSize: DWORD; pwcsUrl: PWChar; pwcsTitle: PWChar; ftLastVisited: FILETIME; ftLastUpdated: FILETIME; ftExpires: FILETIME; dwFlags: DWORD; end; IEnumSTATURL = interface(IUnknown) ['{3C374A42-BAE4-11CF-BF7D-00AA006946EE}'] function Next(celt: Integer; out elt; pceltFetched: PLongint): HRESULT; stdcall; function Skip(celt: Longint): HRESULT; stdcall; function Reset: HResult; stdcall; function Clone(out ppenum: IEnumSTATURL): HResult; stdcall; function SetFilter(poszFilter: PWideChar; dwFlags: DWORD): HResult; stdcall; end; IUrlHistoryStg = interface(IUnknown) ['{3C374A41-BAE4-11CF-BF7D-00AA006946EE}'] function AddUrl(pocsUrl: PWideChar; pocsTitle: PWideChar; dwFlags: Integer): HResult; stdcall; function DeleteUrl(pocsUrl: PWideChar; dwFlags: Integer): HResult; stdcall; function QueryUrl(pocsUrl: PWideChar; dwFlags: Integer; var lpSTATURL: TSTATURL): HResult; stdcall; function BindToObject(pocsUrl: PWideChar; var riid: TIID; out ppvOut: Pointer): HResult; stdcall; function EnumUrls(out ppenum: IEnumSTATURL): HResult; stdcall; end; //------------------------------------------------------------------------------ implementation function Translate(Value: String): String; begin SetLength(Result, Length(Value)); AnsiToOem(@Value[1], @Result[1]); end; //------------------------------------------------------------------------------ var History: IUrlHistoryStg; Enum: IEnumSTATURL; Url: TSTATURL; uFetched: ULONG; Urls: array of PWideChar; Count: integer = 0; procedure TForm1.FormCreate(Sender: TObject); begin if Succeeded(CoInitialize(nil)) then try if Succeeded(CoCreateInstance(CLSID_CUrlHistory, nil, CLSCTX_INPROC_SERVER, IID_IUrlHistoryStg2, History)) then try if Succeeded(History.EnumUrls(Enum)) then while Succeeded(Enum.Next(1, Url, @uFetched)) do begin if uFetched = 0 then Break; UrlList.Items.Add(Url.pwcsUrl); end; finally History := nil; end; finally CoUninitialize; //Проблема end; end; end. Всё выводится, но при закрытии приложения вылезает ошибка: Access Violation... Read at address..." и затем "Runtime Error 216 at 00403102". Если не вызывать CoUninitialize, то не вылезает. Но тогда Explorer не замечает удаления элементов History. |
Сообщ.
#9
,
|
|
|
Через IMalloc сначала освободи все данные которые тебе Enum.Next вернул...
|
Сообщ.
#10
,
|
|
|
Не могу найти информацию про IMalloc :(
Как им пользоваться? Спасибо. |
Сообщ.
#11
,
|
|
|
http://msdn2.microsoft.com/en-us/library/ms678425.aspx
Метод Free данного интерфейса применить к каждому Url полученному вызовом Enum.Next() |
Сообщ.
#12
,
|
|
|
Надо было написать Enum := nil, тогда ошибка пропадает. А этому IMalloc.Free надо указатель, а указателей тут вроде нет.
|
Сообщ.
#13
,
|
|
|
Цитата AlekseyKopylov @ А этому IMalloc.Free надо указатель, а указателей тут вроде нет. pwcsUrl: PWChar; pwcsTitle: PWChar; |
Сообщ.
#14
,
|
|
|
Пробовал применить IMalloc.Free к pwcsUrl и pwcsTitle: вылезает ошибка. Просто присваиваю им nil.
Сейчас программа не глючит (ошибки не выскакивают), но ведёт себя странно: удаляю урлы, они в ней больше не появляются после перезапуска. Но в IE в History всё равно всё остаётся, как будто не удалял. |