Solved

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

Posted on 2006-06-30
3
281 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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
Migrating to Microsoft Office 365 is becoming increasingly popular for organizations both large and small. If you have made the leap to Microsoft’s cloud platform, you know that you will need to create a corporate email signature for your Office 365…
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…

863 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

28 Experts available now in Live!

Get 1:1 Help Now