Solved

I want to copy the favorites to another location for restoring it later.....

Posted on 2006-06-30
3
280 Views
Last Modified: 2010-04-05
Hi all


The following code provides me with the location of the Favorites

procedure TForm1.btn1Click(Sender: TObject);
var
 idlist: PItemIDList;
 path: array[0..MAX_PATH] of Char;
 result:string;
begin
  SHGetSpecialFolderLocation(0, CSIDL_FAVORITES, idlist);
   SHGetPathFromIDList(idlist, Path);
    Result := Path;
 end;

How do I make it copy them to "D:\backup", and later on restore it to that same location?
I have spent 3 days now and have downloaded dozens of samples but cannot figure it out

Fdehell
0
Comment
Question by:fdehell
3 Comments
 
LVL 6

Expert Comment

by:House_of_Dexter
ID: 17019268
procedure TForm1.SearchDirAndCopy(aDirectory, aDestDirectory: string);
var
  a_SearchRec: TSearchRec;
  a_FileName: string;
  a_FileAttrs: Integer;

begin
  a_FileAttrs := faReadOnly + faArchive + faAnyFile;
  if FindFirst(aDirectory + '*.lnk', a_FileAttrs, a_SearchRec) = 0 then
  begin
    repeat
      if (a_SearchRec.Attr and a_FileAttrs) = a_SearchRec.Attr then
      begin
        a_FileName :=   a_SearchRec.Name;
        CopyFile(PChar(aDirectory + a_FileName), PChar(aDestDirectory), false);
      end;
    until FindNext(a_SearchRec) <> 0;
    FindClose(a_SearchRec);
  end;
end;
0
 
LVL 26

Accepted Solution

by:
Russell Libby earned 500 total points
ID: 17019670

The favorites location may also contain .url files and others types, as well as paths. An example that transfers all favorites data (tested exporting, clearing existing favorites data, then importing back in)

Regards,
Russell

----

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Folders, StdCtrls, ShellApi;

type
  TForm1            =  class(TForm)
     Button1:       TButton;
     Button2:       TButton;
     procedure      Button1Click(Sender: TObject);
     procedure      Button2Click(Sender: TObject);
  private
     // Private declarations
  public
     // Public declarations
  end;

var
  Form1:            TForm1;

implementation
{$R *.DFM}

function Transfer(FromPath, ToPath: String): Boolean;
var  lpOpStruct:    TSHFileOpStruct;
begin

  // Clear struct
  FillChar(lpOpStruct, SizeOf(TSHFileOpStruct), 0);

  // Set params
  lpOpStruct.Wnd:=GetDesktopWindow;
  lpOpStruct.wFunc:=FO_COPY;
  lpOpStruct.pFrom:=PChar(FromPath+'\*'#0#0);
  lpOpStruct.pTo:=PChar(ToPath+#0#0);
  lpOpStruct.fFlags:=FOF_NOCONFIRMATION or FOF_SILENT or FOF_NOERRORUI or FOF_NOCONFIRMMKDIR;

  // Perform the operation
  result:=(SHFileOperation(lpOpStruct) = 0) and (lpOpStruct.fAnyOperationsAborted = False);

end;

// Export
procedure TForm1.Button1Click(Sender: TObject);
var  szFavorites:   String;
begin

  // Get favorites folder
  szFavorites:=GetFolderPath(CSIDL_FAVORITES);

  // Check folder
  if ((GetFileAttributes(PChar(szFavorites)) and FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY) then
  begin
     // Transfer to backup location
     Transfer(szFavorites, 'c:\backup\favorites');
  end;

end;

// Import
procedure TForm1.Button2Click(Sender: TObject);
var  szFavorites:   String;
begin

  // Get favorites folder
  szFavorites:=GetFolderPath(CSIDL_FAVORITES);

  // Check folder
  if ((GetFileAttributes(PChar(szFavorites)) and FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY) then
  begin
     // Transfer from backup loaction
     Transfer('c:\backup\favorites', szFavorites);
  end;

end;

end.

// You can use your current routine to get the favorites location, or the GetFolderPath from this unit
--- folders.pas ---

unit Folders;
////////////////////////////////////////////////////////////////////////////////
//   Unit           :  FOLDERS.PAS
////////////////////////////////////////////////////////////////////////////////
interface

////////////////////////////////////////////////////////////////////////////////
//   Include units
////////////////////////////////////////////////////////////////////////////////
uses
  Windows;

////////////////////////////////////////////////////////////////////////////////
//   Flags for SHGetFolderPath
////////////////////////////////////////////////////////////////////////////////
const
  SHGFP_TYPE_CURRENT            =  $0000;
  SHGFP_TYPE_DEFAULT            =  $0001;

////////////////////////////////////////////////////////////////////////////////
//   CSIDL constants
////////////////////////////////////////////////////////////////////////////////
const
  CSIDL_DESKTOP                 =  $0000;
  CSIDL_INTERNET                =  $0001;
  CSIDL_PROGRAMS                =  $0002;
  CSIDL_CONTROLS                =  $0003;
  CSIDL_PRINTERS                =  $0004;
  CSIDL_PERSONAL                =  $0005;
  CSIDL_FAVORITES               =  $0006;
  CSIDL_STARTUP                 =  $0007;
  CSIDL_RECENT                  =  $0008;
  CSIDL_SENDTO                  =  $0009;
  CSIDL_BITBUCKET               =  $000A;
  CSIDL_STARTMENU               =  $000B;
  CSIDL_MYDOCUMENTS             =  $000C;
  CSIDL_MYMUSIC                 =  $000D;
  CSIDL_MYVIDEO                 =  $000E;
  CSIDL_DESKTOPDIRECTORY        =  $0010;
  CSIDL_DRIVES                  =  $0011;
  CSIDL_NETWORK                 =  $0012;
  CSIDL_NETHOOD                 =  $0013;
  CSIDL_FONTS                   =  $0014;
  CSIDL_TEMPLATES               =  $0015;
  CSIDL_COMMON_STARTMENU        =  $0016;
  CSIDL_COMMON_PROGRAMS         =  $0017;
  CSIDL_COMMON_STARTUP          =  $0018;
  CSIDL_COMMON_DESKTOPDIRECTORY =  $0019;
  CSIDL_APPDATA                 =  $001A;
  CSIDL_PRINTHOOD               =  $001B;
  CSIDL_LOCAL_APPDATA           =  $001C;
  CSIDL_ALTSTARTUP              =  $001D;
  CSIDL_COMMON_ALTSTARTUP       =  $001E;
  CSIDL_COMMON_FAVORITES        =  $001F;
  CSIDL_INTERNET_CACHE          =  $0020;
  CSIDL_COOKIES                 =  $0021;
  CSIDL_HISTORY                 =  $0022;
  CSIDL_COMMON_APPDATA          =  $0023;
  CSIDL_WINDOWS                 =  $0024;
  CSIDL_SYSTEM                  =  $0025;
  CSIDL_PROGRAM_FILES           =  $0026;
  CSIDL_MYPICTURES              =  $0027;
  CSIDL_PROFILE                 =  $0028;
  CSIDL_SYSTEMX86               =  $0029;
  CSIDL_PROGRAM_FILESX86        =  $002A;
  CSIDL_PROGRAM_FILES_COMMON    =  $002B;
  CSIDL_PROGRAM_FILES_COMMONX86 =  $002C;
  CSIDL_COMMON_TEMPLATES        =  $002D;
  CSIDL_COMMON_DOCUMENTS        =  $002E;
  CSIDL_COMMON_ADMINTOOLS       =  $002F;
  CSIDL_ADMINTOOLS              =  $0030;
  CSIDL_CONNECTIONS             =  $0031;
  CSIDL_COMMON_MUSIC            =  $0035;
  CSIDL_COMMON_PICTURES         =  $0036;
  CSIDL_COMMON_VIDEO            =  $0037;
  CSIDL_RESOURCES               =  $0038;
  CSIDL_RESOURCES_LOCALIZED     =  $0039;
  CSIDL_COMMON_OEM_LINKS        =  $003A;
  CSIDL_CDBURN_AREA             =  $003B;
  CSIDL_COMPUTERSNEARME         =  $003D;
  CSIDL_FLAG_PER_USER_INIT      =  $0800;
  CSIDL_FLAG_NO_ALIAS           =  $1000;
  CSIDL_FLAG_DONT_VERIFY        =  $4000;
  CSIDL_FLAG_CREATE             =  $8000;
  CSIDL_FLAG_MASK               =  $FF00;

////////////////////////////////////////////////////////////////////////////////
//   Function prototype
////////////////////////////////////////////////////////////////////////////////
type
  TSHGetFolderPath     = function(hwndOwner: HWND; nFolder: DWORD; hToken: THandle; dwFlags: DWORD; lpszPath: PChar): HResult; stdcall;

////////////////////////////////////////////////////////////////////////////////
//   Function name
////////////////////////////////////////////////////////////////////////////////
const
  SHGETFOLDERPATH_NAME =  'SHGetFolderPathA';

////////////////////////////////////////////////////////////////////////////////
//   Function libraries
////////////////////////////////////////////////////////////////////////////////
const
  SHGETFOLDERPATH_LIBS:   Array [0..1] of PChar = ('shfolder.dll', 'shell32.dll');

////////////////////////////////////////////////////////////////////////////////
//   Dynamic loading structure
////////////////////////////////////////////////////////////////////////////////
type
  TSHGFPDyna           =  packed record
     hLib:                HINST;
     lpFunc:              TSHGetFolderPath;
  end;

////////////////////////////////////////////////////////////////////////////////
//
//   GetFolderPath
//
//   Arguments
//
//      CSIDL    -  Folder ID to retrieve the path for
//      Created  -  Returns true if the path was created, otherwise returns false
//
//   Returns the path for the specified folder ID.
//
//   Notes
//
//      Attempts to use the SHGetFolderPathA function from SHFOLDER.DLL first.
//      If this fails, it will attempt to load and resolve the funtion in
//      SHELL32.DLL and perform the call again.
//
////////////////////////////////////////////////////////////////////////////////
function   GetFolderPath(CSIDL: DWORD; out Created: Boolean): String; overload;
function   GetFolderPath(CSIDL: DWORD): String; overload;

implementation

function GetFolderPath(CSIDL: DWORD): String; overload;
var  bCreated:      Boolean;
begin

  // Call other overloaded version
  result:=GetFolderPath(CSIDL, bCreated);

end;

function GetFolderPath(CSIDL: DWORD; out Created: Boolean): String;
var  lpszPath:      Array [0..MAX_PATH] of Char;
     lpaDyna:       Array [0..1] of TSHGFPDyna;
     dwFlags:       DWORD;
     hrResult:      HResult;
     dwIndex:       Integer;
begin

  // Set default hResult
  hrResult:=E_NOTIMPL;

  // Clear the library / function struct
  ZeroMemory(@lpaDyna, SizeOf(lpaDyna));

  // Attempt to load and call the function address from both libraries
  for dwIndex:=0 to 1 do
  begin
     // Set default flags
     dwFlags:=CSIDL;
     // Load library
     lpaDyna[dwIndex].hLib:=LoadLibrary(SHGETFOLDERPATH_LIBS[0]);
     // Check load
     if (lpaDyna[dwIndex].hLib <> 0) then
     begin
        // Get function address
        @lpaDyna[dwIndex].lpFunc:=GetProcAddress(lpaDyna[dwIndex].hLib, SHGETFOLDERPATH_NAME);
        // Check function address
        if Assigned(@lpaDyna[dwIndex].lpFunc) then
        begin
           // Call the function
           hrResult:=lpaDyna[dwIndex].lpFunc(0, dwFlags, 0, SHGFP_TYPE_CURRENT, @lpszPath);
           // Check result, break if success
           if (hrResult = S_OK) then
              break
           // Check for not existing
           else if (hrResult = S_FALSE) then
           begin
              // Add create to the flags
              dwFlags:=dwFlags or CSIDL_FLAG_CREATE;
              // Peform the call again using the new flags
              hrResult:=lpaDyna[dwIndex].lpFunc(0, dwFlags, 0, SHGFP_TYPE_CURRENT, @lpszPath);
              // Check result
              if (hrResult = S_OK) then
                 break
              // Check for not existing
              else if (hrResult = S_FALSE) then
              begin
                 // Add dont' verify flag
                 dwFlags:=dwFlags or CSIDL_FLAG_DONT_VERIFY;
                 // Peform the call again using the new flags, (-1) default token handle, and "default" flag
                 hrResult:=lpaDyna[dwIndex].lpFunc(0, dwFlags, THandle(-1), SHGFP_TYPE_DEFAULT, @lpszPath);
                 // Check result
                 if (hrResult = S_OK) then break;
              end;
           end;
        end;
     end;
  end;

  // Unload the loaded libraries
  for dwIndex:=0 to 1 do
  begin
     if (lpaDyna[dwIndex].hLib <> 0) then FreeLibrary(lpaDyna[dwIndex].hLib);
  end;

  // Did we succeed?
  if (hrResult = S_OK) then
  begin
     // Set the path
     result:=lpszPath;
     // Set the Created flag
     Created:=((dwFlags and CSIDL_FLAG_CREATE) = CSIDL_FLAG_CREATE);
  end
  else
     // Failed to get path
     SetLength(result, 0);

end;

end.


0
 
LVL 1

Author Comment

by:fdehell
ID: 17021514
Ok I have tested the first solution, did not work out how I could get it to work, prolly my mistake but I really tried and did not suckseed.

The second solution, works as a charm, both of you thank you for your quick assistance, I will be having more questions, but this one is fixed, again thx!!!

Fdehell/Nullified
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Suggested Solutions

In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
Sending a Secure fax is easy with eFax Corporate (http://www.enterprise.efax.com). First, Just open a new email message.  In the To field, type your recipient's fax number @efaxsend.com. You can even send a secure international fax — just include t…
This video discusses moving either the default database or any database to a new volume.

708 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now