Mega Code Archive

 
Categories / Delphi / LAN Web TCP
 

Internet sıkkullananlara url ekleme

******************************************************** ******************************************************** *** 'ARKADAŞLAR LÜTFEN KODBANK"TAN YARDIM İSTEMEYİN' *** ************* 'FORUMLARDAN YARDIM İSTEYİN' ************* ******************************************************** ******************************************************** 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; try 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) ; finally Result:=str; end; 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;