Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win

x
?
Solved

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

Posted on 2006-06-30
3
Medium Priority
?
289 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
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 2000 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

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

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

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…
Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
This tutorial will teach you the special effect of super speed similar to the fictional character Wally West aka "The Flash" After Shake : http://www.videocopilot.net/presets/after_shake/ All lightning effects with instructions : http://www.mediaf…
How to fix incompatible JVM issue while installing Eclipse While installing Eclipse in windows, got one error like above and unable to proceed with the installation. This video describes how to successfully install Eclipse. How to solve incompa…
Suggested Courses

597 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