Вопрос SHFileOperation и Unicode

AtotIK

Новичок
Привет всем. В общем имеется проблема с применением на Unicode-версии.
Вой сам файл:
Код:
;***************************************************************;
;****************** SHFileOperation.iss ************************;
;***************************************************************;
;* Include this file in project. Example:
;* #include "SHFileOperation.iss"
;***************************************************************;
;************************ 1 ************************************;
;* function CopyDir(const fromDir, toDir: string): Boolean;
;* Example 1 (without <fromDir> trailing backslash):
;*  CopyDir('C:\TMP\MyApp', 'C:\TMP\Backup');
;* Result: C:\TMP\Backup\MyApp\..all <MyApp> subdirs and files
;* Example 2 (with <fromDir> trailing backslash):
;*  CopyDir('C:\TMP\MyApp\', 'C:\TMP\Backup');
;* Result: C:\TMP\Backup\..all <MyApp> subdirs and files
;***************************************************************;
;************************ 2 ************************************;
;* function MoveDir(const fromDir, toDir: string): Boolean;
;* Example 1 (without <fromDir> trailing backslash):
;*  MoveDir('C:\TMP\MyApp', 'C:\TMP\Backup');
;* Result: C:\TMP\Backup\MyApp\..all <MyApp> subdirs and files
;* Example 2 (with <fromDir> trailing backslash):
;*  MoveDir('C:\TMP\MyApp\', 'C:\TMP\Backup');
;* Result: C:\TMP\Backup\..all <MyApp> subdirs and files
;***************************************************************;
;************************ 3 ************************************;
;* function DelDir(dir: string; toRecycle: Boolean): Boolean;
;*  If <toRecycle> is True, <dir> deleted in Recycle Bin.
;***************************************************************;
;************************ 4 ************************************;
;* function RenameDir(const fromDir, toDir: string): Boolean;
;***************************************************************;
;***************************************************************;
;***************************************************************;
[_Code]
type
#ifdef UNICODE
  PChar = PAnsiChar;
#endif
  TSHFileOpStruct =  record
  Wnd: HWND;
  wFunc: UINT;
  pFrom: PChar;
  pTo: PChar;
  fFlags: Word; // FILEOP_FLAGS;
  fAnyOperationsAborted: BOOL;
  hNameMappings: HWND; // Pointer;
  lpszProgressTitle: PChar; { only used if FOF_SIMPLEPROGRESS }
  end;
const
// use in wFunc
  { $EXTERNALSYM FO_MOVE }
  FO_MOVE  = $0001;
  { $EXTERNALSYM FO_COPY }
  FO_COPY  = $0002;
  { $EXTERNALSYM FO_DELETE }
  FO_DELETE  = $0003;
  { $EXTERNALSYM FO_RENAME }
  FO_RENAME  = $0004;
// use in fFlags
  { $EXTERNALSYM FOF_MULTIDESTFILES }
  FOF_MULTIDESTFILES  = $0001;
  { $EXTERNALSYM FOF_CONFIRMMOUSE }
  FOF_CONFIRMMOUSE  = $0002;
  { $EXTERNALSYM FOF_SILENT }
  FOF_SILENT  = $0004;  { don't create progress/report }
  { $EXTERNALSYM FOF_RENAMEONCOLLISION }
  FOF_RENAMEONCOLLISION  = $0008;
  { $EXTERNALSYM FOF_NOCONFIRMATION }
  FOF_NOCONFIRMATION  = $0010;  { Don't prompt the user. }
  { $EXTERNALSYM FOF_WANTMAPPINGHANDLE }
  FOF_WANTMAPPINGHANDLE  = $0020;  { Fill in
SHFILEOPSTRUCT.hNameMappings
  Must be freed using
SHFreeNameMappings }
  { $EXTERNALSYM FOF_ALLOWUNDO }
  FOF_ALLOWUNDO  = $0040;
  { $EXTERNALSYM FOF_FILESONLY }
  FOF_FILESONLY  = $0080;  { on *.*, do only files }
  { $EXTERNALSYM FOF_SIMPLEPROGRESS }
  FOF_SIMPLEPROGRESS  = $0100;  { means don't show names of files }
  { $EXTERNALSYM FOF_NOCONFIRMMKDIR }
  FOF_NOCONFIRMMKDIR  = $0200;  { don't confirm making any
needed dirs }
  { $EXTERNALSYM FOF_NOERRORUI }
  FOF_NOERRORUI  = $0400;  { don't put up error UI }
function SHFileOperation(const lpFileOp: TSHFileOpStruct):Integer;
external 'SHFileOperation@shell32.dll stdcall';

function BackupDir(const fromDir, toDir: string; IsMove: Boolean): Boolean;
var
  fos: TSHFileOpStruct;
  _fromDir, _toDir: string;
  SR: TFindRec;
  res: Boolean;
begin
  ForceDirectories(toDir);
  if IsMove then
  fos.wFunc  := FO_MOVE else
  fos.wFunc  := FO_COPY;
  fos.fFlags := FOF_FILESONLY or FOF_SILENT or
  FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR;
  _fromDir:= AddBackslash(fromDir);
  _toDir  := AddBackslash(toDir);
  if (Length(fromDir) = Length(_fromDir)) then
  begin
  res:= FindFirst(_fromDir + '*', SR);
  try
  while res do
  begin
  if (SR.Name <> '') and (SR.Name <> '.') and (SR.Name <> '..') then
  begin
  if SR.Attributes = FILE_ATTRIBUTE_DIRECTORY then
  begin
  _fromDir:= _fromDir + SR.Name + #0#0;
  _toDir  := _toDir + #0#0;
  fos.pFrom  := PChar(_fromDir);
  fos.pTo  := PChar(_toDir);
  end else
  begin
  _fromDir:= _fromDir + SR.Name + #0#0;
  _toDir  := _toDir  + SR.Name + #0#0;
  fos.pFrom  := PChar(_fromDir);
  fos.pTo  := PChar(_toDir);
  end;
  Result := (0 = ShFileOperation(fos));
  _fromDir:= ExtractFilePath(_fromDir);
  _toDir:= ExtractFilePath(_toDir);
  end;
  res := FindNext(SR);
  end;
  finally
  FindClose(SR);
  end;
  end else
  begin
  _fromDir:= RemoveBackslashUnlessRoot(_fromDir) + #0#0;
  _toDir  := RemoveBackslashUnlessRoot(_toDir)  + #0#0;
  fos.pFrom  := PChar(_fromDir);
  fos.pTo  := PChar(_toDir);
  Result := (0 = ShFileOperation(fos));
  end;
end;

function MoveDir(const fromDir, toDir: string): Boolean;
begin
  Result := BackupDir(fromDir, toDir, True);
end;

function CopyDir(const fromDir, toDir: string): Boolean;
begin
  Result := BackupDir(fromDir, toDir, False);
end;

function DelDir(dir: string; toRecycle: Boolean): Boolean;
var
  fos: TSHFileOpStruct;
  _dir: string;
begin
  _dir:= RemoveBackslashUnlessRoot(dir) + #0#0;
  fos.wFunc  := FO_DELETE;
  fos.fFlags := FOF_SILENT or FOF_NOCONFIRMATION;
  if toRecycle then
  fos.fFlags := fos.fFlags or FOF_ALLOWUNDO;
  fos.pFrom  := PChar(_dir);
  Result := (0 = ShFileOperation(fos));
end;

function RenameDir(const fromDir, toDir: string): Boolean;
var
  fos: TSHFileOpStruct;
  _fromDir, _toDir: string;
begin
  _fromDir:= RemoveBackslashUnlessRoot(fromDir) + #0#0;
  _toDir  := RemoveBackslashUnlessRoot(toDir) + #0#0;
  fos.wFunc  := FO_RENAME;
  fos.fFlags := FOF_FILESONLY or FOF_ALLOWUNDO or
  FOF_SILENT or FOF_NOCONFIRMATION;
  fos.pFrom  := PChar(_fromDir);
  fos.pTo  := PChar(_toDir);
  Result := (0 = ShFileOperation(fos));
end;

function FilesMaskOperation(const fromDir, toDir, fileMask: string;
  FileOp: Integer; EmptyDirRemove: Boolean; toRecycle: Boolean): Boolean;
var
  fos: TSHFileOpStruct;
  _fromDir, _toDir: string;
  FSR, DSR: TFindRec;
  FindResult: Boolean;
  APath: string;
begin
  APath := AddBackslash(fromDir);
  FindResult := FindFirst(APath + fileMask, FSR);
  try
  while FindResult do
  begin
  if FSR.Attributes and FILE_ATTRIBUTE_DIRECTORY = 0 then
  begin
  Case FileOp of
  FO_COPY:
  begin
  fos.wFunc  := FO_COPY;
  end;
  FO_MOVE:
  begin
  fos.wFunc  := FO_MOVE;
  end;
  FO_DELETE:
  begin
  fos.wFunc  := FO_DELETE;
  if toRecycle then fos.fFlags := fos.fFlags or FOF_ALLOWUNDO;
  end;
  FO_RENAME:
  begin
  fos.wFunc  := FO_RENAME;
  end;
  else
  ;
  end;
  fos.fFlags := fos.fFlags or FOF_FILESONLY or FOF_SILENT or
  FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR;
  _fromDir:= APath + FSR.Name + #0#0;
  _toDir:= AddBackslash(toDir) + FSR.Name + #0#0;
  ForceDirectories(ExtractFilePath(_toDir));
  fos.pFrom  := PChar(_fromDir);
  fos.pTo  := PChar(_toDir);
  Result := (0 = ShFileOperation(fos));
  end;
  FindResult := FindNext(FSR);
  end;
  FindResult := FindFirst(APath + '*.*', DSR);
  while FindResult do
  begin
  if ((DSR.Attributes and FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY) and
  not ((DSR.Name = '.') or (DSR.Name = '..')) then
{Recursion} FilesMaskOperation(APath + DSR.Name,
  AddBackslash(toDir) + DSR.Name,
  fileMask, FileOp, EmptyDirRemove, toRecycle);
  FindResult := FindNext(DSR);
  end;
  finally
  FindClose(FSR);
  FindClose(DSR);
  if EmptyDirRemove then RemoveDir(APath);
  end;
end;
function CopyFiles(const fromDir, toDir, fileMask: string): Boolean;
begin
  Result := FilesMaskOperation(fromDir, toDir, fileMask,
  FO_COPY, False, False);
end;
function MoveFiles(const fromDir, toDir, fileMask: string): Boolean;
begin
  Result := FilesMaskOperation(fromDir, toDir, fileMask,
  FO_MOVE, True, False);
end;
function DelFiles(const fromDir, fileMask: string; toRecycle: Boolean ): Boolean;
begin
  Result := FilesMaskOperation(fromDir, '', fileMask,
  FO_DELETE, True, toRecycle);
end;
PChar = PAnsiChar; прописан. Проблема в том, что при копировании папки-отправителя в итоге копируются не все файлы. В данный момент в папке-отправителе 334 файла, копируется при этом 316 файлов. Причём при компилировании в разных версиях Inno и на разных системах проблема остаётся. Бывает так, что при разных путях до папки-отправщика копируется разное количество файлов.
Перенос папки вообще при этом не работает, просто создаётся папка-приёмщик и всё. Файлы в папке-отправителе остаются на месте.

На ANSI-версии всё великолепно работает.

Пример использования:
Код:
procedure SoundInstall();
begin
  if IsComponentSelected('Sound\Ring') then
begin
  CopyDir(ExpandConstant('{app}\res\audio\'),ExpandConstant('{app}\res_mods\0.9.2\audio'));
end;
end;

procedure XVMInstallCheck();
begin
  if IsComponentSelected('XVM') then
begin
  MoveDir(ExpandConstant('{app}\res_mods\xvm\db'),ExpandConstant('{app}\res_mods\xvm_token'));
end;
end;

procedure CurStepChanged(CurStep: TSetupStep);
begin
  If CurStep=ssInstall then
begin
  XVMInstallCheck();
  SoundInstall();
end;
end;

Очень хочется решить эту проблему, уже для самого себя интересно почему же всё это не работает.
Надеюсь на помощь.
 

AtotIK

Новичок
Не доглядел, нужно же ещё заменить String на AnsiString. Тему можно закрывать.
 

alexalsp

Новичок
У меня проблема в другом. Вообще не срабатывает переименование на unicod хотя на ansi все нормально срабатывает.

Код:
;***************************************************************;
;****************** SHFileOperation.iss ************************;
;***************************************************************;
;* Include this file in project. Example:
;* #include "SHFileOperation.iss"
;***************************************************************;
;************************ 1 ************************************;
;* function CopyDir(const fromDir, toDir: string): Boolean;
;* Example 1 (without <fromDir> trailing backslash):
;*     CopyDir('C:\TMP\MyApp', 'C:\TMP\Backup');
;* Result: C:\TMP\Backup\MyApp\..all <MyApp> subdirs and files
;* Example 2 (with <fromDir> trailing backslash):
;*     CopyDir('C:\TMP\MyApp\', 'C:\TMP\Backup');
;* Result: C:\TMP\Backup\..all <MyApp> subdirs and files
;***************************************************************;
;************************ 2 ************************************;
;* function MoveDir(const fromDir, toDir: string): Boolean;
;* Example 1 (without <fromDir> trailing backslash):
;*     MoveDir('C:\TMP\MyApp', 'C:\TMP\Backup');
;* Result: C:\TMP\Backup\MyApp\..all <MyApp> subdirs and files
;* Example 2 (with <fromDir> trailing backslash):
;*     MoveDir('C:\TMP\MyApp\', 'C:\TMP\Backup');
;* Result: C:\TMP\Backup\..all <MyApp> subdirs and files
;***************************************************************;
;************************ 3 ************************************;
;* function DelDir(dir: string; toRecycle: Boolean): Boolean;
;*   If <toRecycle> is True, <dir> deleted in Recycle Bin.
;***************************************************************;
;************************ 4 ************************************;
;* function RenameDir(const fromDir, toDir: string): Boolean;
;***************************************************************;
;***************************************************************;
;***************************************************************;

[Code]
type
   TSHFileOpStruct =  record
     Wnd: HWND;
     wFunc: UINT;
     pFrom: PAnsiChar;
     pTo: PAnsiChar;
     fFlags: Word; // FILEOP_FLAGS;
     fAnyOperationsAborted: BOOL;
     hNameMappings: HWND; // Pointer;
     lpszProgressTitle: PAnsiChar; { only used if FOF_SIMPLEPROGRESS }
   end;

const
// use in wFunc
   { $EXTERNALSYM FO_MOVE }
   FO_MOVE           = $0001;
   { $EXTERNALSYM FO_COPY }
   FO_COPY           = $0002;
   { $EXTERNALSYM FO_DELETE }
   FO_DELETE         = $0003;
   { $EXTERNALSYM FO_RENAME }
   FO_RENAME         = $0004;
// use in fFlags
   { $EXTERNALSYM FOF_MULTIDESTFILES }
   FOF_MULTIDESTFILES         = $0001;
   { $EXTERNALSYM FOF_CONFIRMMOUSE }
   FOF_CONFIRMMOUSE           = $0002;
   { $EXTERNALSYM FOF_SILENT }
   FOF_SILENT                 = $0004;  { don't create progress/report }
   { $EXTERNALSYM FOF_RENAMEONCOLLISION }
   FOF_RENAMEONCOLLISION      = $0008;
   { $EXTERNALSYM FOF_NOCONFIRMATION }
   FOF_NOCONFIRMATION         = $0010;  { Don't prompt the user. }
   { $EXTERNALSYM FOF_WANTMAPPINGHANDLE }
   FOF_WANTMAPPINGHANDLE      = $0020;  { Fill in
SHFILEOPSTRUCT.hNameMappings
                                          Must be freed using
SHFreeNameMappings }
   { $EXTERNALSYM FOF_ALLOWUNDO }
   FOF_ALLOWUNDO              = $0040;
   { $EXTERNALSYM FOF_FILESONLY }
   FOF_FILESONLY              = $0080;  { on *.*, do only files }
   { $EXTERNALSYM FOF_SIMPLEPROGRESS }
   FOF_SIMPLEPROGRESS         = $0100;  { means don't show names of files }
   { $EXTERNALSYM FOF_NOCONFIRMMKDIR }
   FOF_NOCONFIRMMKDIR         = $0200;  { don't confirm making any
needed dirs }
   { $EXTERNALSYM FOF_NOERRORUI }
   FOF_NOERRORUI              = $0400;  { don't put up error UI }


function SHFileOperation(const lpFileOp: TSHFileOpStruct):Integer;
external 'SHFileOperation@shell32.dll stdcall';

{****************************************************************}
{****************************************************************}
{****************************************************************}

function BackupDir(const fromDir, toDir: string; IsMove: Boolean): Boolean;
var
  fos: TSHFileOpStruct;
  _fromDir, _toDir: string;
  SR: TFindRec;
  res: Boolean;
begin
    ForceDirectories(toDir);
  if IsMove then
    fos.wFunc  := FO_MOVE else
    fos.wFunc  := FO_COPY;
    fos.fFlags := FOF_FILESONLY or FOF_SILENT or
               FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR;
    _fromDir:= AddBackslash(fromDir);
    _toDir  := AddBackslash(toDir);
  if (Length(fromDir) = Length(_fromDir)) then
    begin
        res:= FindFirst(_fromDir + '*', SR);
      try
        while res do
        begin
          if (SR.Name <> '') and (SR.Name <> '.') and (SR.Name <> '..') then
          begin
            if SR.Attributes = FILE_ATTRIBUTE_DIRECTORY then
              begin
                _fromDir:= _fromDir + SR.Name + #0#0;
                _toDir  := _toDir + #0#0;
                fos.pFrom  := PAnsiChar(_fromDir);
                fos.pTo    := PAnsiChar(_toDir);
              end else
              begin
                _fromDir:= _fromDir + SR.Name + #0#0;
                _toDir  := _toDir   + SR.Name + #0#0;
                fos.pFrom  := PAnsiChar(_fromDir);
                fos.pTo    := PAnsiChar(_toDir);
              end;
                Result := (0 = ShFileOperation(fos));
                _fromDir:= ExtractFilePath(_fromDir);
                _toDir:= ExtractFilePath(_toDir);
          end;
          res := FindNext(SR);
        end;
      finally
        FindClose(SR);
      end;
    end else
    begin
      _fromDir:= RemoveBackslashUnlessRoot(_fromDir) + #0#0;
      _toDir  := RemoveBackslashUnlessRoot(_toDir)   + #0#0;
      fos.pFrom  := PAnsiChar(_fromDir);
      fos.pTo    := PAnsiChar(_toDir);
      Result := (0 = ShFileOperation(fos));
    end;
end;

{****************************************************************}
function MoveDir(const fromDir, toDir: string): Boolean;
begin
  Result := BackupDir(fromDir, toDir, True);
end;

{****************************************************************}
function CopyDir(const fromDir, toDir: string): Boolean;
begin
  Result := BackupDir(fromDir, toDir, False);
end;

{****************************************************************}
function DelDir(dir: string; toRecycle: Boolean): Boolean;
var
  fos: TSHFileOpStruct;
  _dir: string;
begin
    _dir:= RemoveBackslashUnlessRoot(dir) + #0#0;
    fos.wFunc  := FO_DELETE;
    fos.fFlags := FOF_SILENT or FOF_NOCONFIRMATION;
  if toRecycle then
    fos.fFlags := fos.fFlags or FOF_ALLOWUNDO;
    fos.pFrom  := PAnsiChar(_dir);
  Result := (0 = ShFileOperation(fos));
end;

{****************************************************************}
function RenameDir(const fromDir, toDir: string): Boolean;
var
  fos: TSHFileOpStruct;
  _fromDir, _toDir: string;
begin
    _fromDir:= RemoveBackslashUnlessRoot(fromDir) + #0#0;
    _toDir  := RemoveBackslashUnlessRoot(toDir) + #0#0;
    fos.wFunc  := FO_RENAME;
    fos.fFlags := FOF_FILESONLY or FOF_ALLOWUNDO or
              FOF_SILENT or FOF_NOCONFIRMATION;
    fos.pFrom  := PAnsiChar(_fromDir);
    fos.pTo    := PAnsiChar(_toDir);
  Result := (0 = ShFileOperation(fos));
end;

{****************************************************************}
function FilesMaskOperation(const fromDir, toDir, fileMask: string; FileOp: Integer; EmptyDirRemove: Boolean; toRecycle: Boolean): Boolean;
var
  fos: TSHFileOpStruct;
  _fromDir, _toDir: string;
  FSR, DSR: TFindRec;
  FindResult: Boolean;
  APath: string;
begin
  APath := AddBackslash(fromDir);
  FindResult := FindFirst(APath + fileMask, FSR);
  try
    while FindResult do
    begin
      if FSR.Attributes and FILE_ATTRIBUTE_DIRECTORY = 0 then
        begin
          Case FileOp of
            FO_COPY:
              begin
                fos.wFunc  := FO_COPY;
              end;
            FO_MOVE:
              begin
                fos.wFunc  := FO_MOVE;
              end;
            FO_DELETE:
              begin
                fos.wFunc  := FO_DELETE;
                if toRecycle then fos.fFlags := fos.fFlags or FOF_ALLOWUNDO;
              end;
            FO_RENAME:
              begin
                fos.wFunc  := FO_RENAME;
              end;
          else
            ;
          end;
            fos.fFlags := fos.fFlags or FOF_FILESONLY or FOF_SILENT or
                   FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR;
            _fromDir:= APath + FSR.Name + #0#0;
            _toDir:= AddBackslash(toDir) + FSR.Name + #0#0;
            ForceDirectories(ExtractFilePath(_toDir));
            fos.pFrom  := PAnsiChar(_fromDir);
            fos.pTo    := PAnsiChar(_toDir);
            Result := (0 = ShFileOperation(fos));
        end;
      FindResult := FindNext(FSR);
    end;
    FindResult := FindFirst(APath + '*.*', DSR);
    while FindResult do
    begin
      if ((DSR.Attributes and FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY) and
        not ((DSR.Name = '.') or (DSR.Name = '..')) then
{Recursion} FilesMaskOperation(APath + DSR.Name, AddBackslash(toDir) + DSR.Name, fileMask, FileOp, EmptyDirRemove, toRecycle);
      FindResult := FindNext(DSR);
    end;
  finally
    FindClose(FSR);
    FindClose(DSR);
    if EmptyDirRemove then RemoveDir(APath);
  end;
end;

function CopyFiles(const fromDir, toDir, fileMask: String): Boolean;
begin
  Result := FilesMaskOperation(fromDir, toDir, fileMask,
         FO_COPY, False, False);
end;

function MoveFiles(const fromDir, toDir, fileMask: String): Boolean;
begin
  Result := FilesMaskOperation(fromDir, toDir, fileMask,
         FO_MOVE, True, False);
end;

function DelFiles(const fromDir, fileMask: String; toRecycle: Boolean ): Boolean;
begin
  Result := FilesMaskOperation(fromDir, '', fileMask,
         FO_DELETE, True, toRecycle);
end;
{****************************************************************}
{****************************************************************}
 
Последнее редактирование:

SBalykov

Старожил
У меня проблема в другом. Вообще не срабатывает переименование на unicod хотя на ansi все нормально срабатывает.

Код:
;***************************************************************;
;****************** SHFileOperation.iss ************************;
;***************************************************************;
;* Include this file in project. Example:
;* #include "SHFileOperation.iss"
;***************************************************************;
;************************ 1 ************************************;
;* function CopyDir(const fromDir, toDir: string): Boolean;
;* Example 1 (without <fromDir> trailing backslash):
;*     CopyDir('C:\TMP\MyApp', 'C:\TMP\Backup');
;* Result: C:\TMP\Backup\MyApp\..all <MyApp> subdirs and files
;* Example 2 (with <fromDir> trailing backslash):
;*     CopyDir('C:\TMP\MyApp\', 'C:\TMP\Backup');
;* Result: C:\TMP\Backup\..all <MyApp> subdirs and files
;***************************************************************;
;************************ 2 ************************************;
;* function MoveDir(const fromDir, toDir: string): Boolean;
;* Example 1 (without <fromDir> trailing backslash):
;*     MoveDir('C:\TMP\MyApp', 'C:\TMP\Backup');
;* Result: C:\TMP\Backup\MyApp\..all <MyApp> subdirs and files
;* Example 2 (with <fromDir> trailing backslash):
;*     MoveDir('C:\TMP\MyApp\', 'C:\TMP\Backup');
;* Result: C:\TMP\Backup\..all <MyApp> subdirs and files
;***************************************************************;
;************************ 3 ************************************;
;* function DelDir(dir: string; toRecycle: Boolean): Boolean;
;*   If <toRecycle> is True, <dir> deleted in Recycle Bin.
;***************************************************************;
;************************ 4 ************************************;
;* function RenameDir(const fromDir, toDir: string): Boolean;
;***************************************************************;
;***************************************************************;
;***************************************************************;

[Code]
type
   TSHFileOpStruct =  record
     Wnd: HWND;
     wFunc: UINT;
     pFrom: PAnsiChar;
     pTo: PAnsiChar;
     fFlags: Word; // FILEOP_FLAGS;
     fAnyOperationsAborted: BOOL;
     hNameMappings: HWND; // Pointer;
     lpszProgressTitle: PAnsiChar; { only used if FOF_SIMPLEPROGRESS }
   end;

const
// use in wFunc
   { $EXTERNALSYM FO_MOVE }
   FO_MOVE           = $0001;
   { $EXTERNALSYM FO_COPY }
   FO_COPY           = $0002;
   { $EXTERNALSYM FO_DELETE }
   FO_DELETE         = $0003;
   { $EXTERNALSYM FO_RENAME }
   FO_RENAME         = $0004;
// use in fFlags
   { $EXTERNALSYM FOF_MULTIDESTFILES }
   FOF_MULTIDESTFILES         = $0001;
   { $EXTERNALSYM FOF_CONFIRMMOUSE }
   FOF_CONFIRMMOUSE           = $0002;
   { $EXTERNALSYM FOF_SILENT }
   FOF_SILENT                 = $0004;  { don't create progress/report }
   { $EXTERNALSYM FOF_RENAMEONCOLLISION }
   FOF_RENAMEONCOLLISION      = $0008;
   { $EXTERNALSYM FOF_NOCONFIRMATION }
   FOF_NOCONFIRMATION         = $0010;  { Don't prompt the user. }
   { $EXTERNALSYM FOF_WANTMAPPINGHANDLE }
   FOF_WANTMAPPINGHANDLE      = $0020;  { Fill in
SHFILEOPSTRUCT.hNameMappings
                                          Must be freed using
SHFreeNameMappings }
   { $EXTERNALSYM FOF_ALLOWUNDO }
   FOF_ALLOWUNDO              = $0040;
   { $EXTERNALSYM FOF_FILESONLY }
   FOF_FILESONLY              = $0080;  { on *.*, do only files }
   { $EXTERNALSYM FOF_SIMPLEPROGRESS }
   FOF_SIMPLEPROGRESS         = $0100;  { means don't show names of files }
   { $EXTERNALSYM FOF_NOCONFIRMMKDIR }
   FOF_NOCONFIRMMKDIR         = $0200;  { don't confirm making any
needed dirs }
   { $EXTERNALSYM FOF_NOERRORUI }
   FOF_NOERRORUI              = $0400;  { don't put up error UI }


function SHFileOperation(const lpFileOp: TSHFileOpStruct):Integer;
external 'SHFileOperation@shell32.dll stdcall';

{****************************************************************}
{****************************************************************}
{****************************************************************}

function BackupDir(const fromDir, toDir: string; IsMove: Boolean): Boolean;
var
  fos: TSHFileOpStruct;
  _fromDir, _toDir: string;
  SR: TFindRec;
  res: Boolean;
begin
    ForceDirectories(toDir);
  if IsMove then
    fos.wFunc  := FO_MOVE else
    fos.wFunc  := FO_COPY;
    fos.fFlags := FOF_FILESONLY or FOF_SILENT or
               FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR;
    _fromDir:= AddBackslash(fromDir);
    _toDir  := AddBackslash(toDir);
  if (Length(fromDir) = Length(_fromDir)) then
    begin
        res:= FindFirst(_fromDir + '*', SR);
      try
        while res do
        begin
          if (SR.Name <> '') and (SR.Name <> '.') and (SR.Name <> '..') then
          begin
            if SR.Attributes = FILE_ATTRIBUTE_DIRECTORY then
              begin
                _fromDir:= _fromDir + SR.Name + #0#0;
                _toDir  := _toDir + #0#0;
                fos.pFrom  := PAnsiChar(_fromDir);
                fos.pTo    := PAnsiChar(_toDir);
              end else
              begin
                _fromDir:= _fromDir + SR.Name + #0#0;
                _toDir  := _toDir   + SR.Name + #0#0;
                fos.pFrom  := PAnsiChar(_fromDir);
                fos.pTo    := PAnsiChar(_toDir);
              end;
                Result := (0 = ShFileOperation(fos));
                _fromDir:= ExtractFilePath(_fromDir);
                _toDir:= ExtractFilePath(_toDir);
          end;
          res := FindNext(SR);
        end;
      finally
        FindClose(SR);
      end;
    end else
    begin
      _fromDir:= RemoveBackslashUnlessRoot(_fromDir) + #0#0;
      _toDir  := RemoveBackslashUnlessRoot(_toDir)   + #0#0;
      fos.pFrom  := PAnsiChar(_fromDir);
      fos.pTo    := PAnsiChar(_toDir);
      Result := (0 = ShFileOperation(fos));
    end;
end;

{****************************************************************}
function MoveDir(const fromDir, toDir: string): Boolean;
begin
  Result := BackupDir(fromDir, toDir, True);
end;

{****************************************************************}
function CopyDir(const fromDir, toDir: string): Boolean;
begin
  Result := BackupDir(fromDir, toDir, False);
end;

{****************************************************************}
function DelDir(dir: string; toRecycle: Boolean): Boolean;
var
  fos: TSHFileOpStruct;
  _dir: string;
begin
    _dir:= RemoveBackslashUnlessRoot(dir) + #0#0;
    fos.wFunc  := FO_DELETE;
    fos.fFlags := FOF_SILENT or FOF_NOCONFIRMATION;
  if toRecycle then
    fos.fFlags := fos.fFlags or FOF_ALLOWUNDO;
    fos.pFrom  := PAnsiChar(_dir);
  Result := (0 = ShFileOperation(fos));
end;

{****************************************************************}
function RenameDir(const fromDir, toDir: string): Boolean;
var
  fos: TSHFileOpStruct;
  _fromDir, _toDir: string;
begin
    _fromDir:= RemoveBackslashUnlessRoot(fromDir) + #0#0;
    _toDir  := RemoveBackslashUnlessRoot(toDir) + #0#0;
    fos.wFunc  := FO_RENAME;
    fos.fFlags := FOF_FILESONLY or FOF_ALLOWUNDO or
              FOF_SILENT or FOF_NOCONFIRMATION;
    fos.pFrom  := PAnsiChar(_fromDir);
    fos.pTo    := PAnsiChar(_toDir);
  Result := (0 = ShFileOperation(fos));
end;

{****************************************************************}
function FilesMaskOperation(const fromDir, toDir, fileMask: string; FileOp: Integer; EmptyDirRemove: Boolean; toRecycle: Boolean): Boolean;
var
  fos: TSHFileOpStruct;
  _fromDir, _toDir: string;
  FSR, DSR: TFindRec;
  FindResult: Boolean;
  APath: string;
begin
  APath := AddBackslash(fromDir);
  FindResult := FindFirst(APath + fileMask, FSR);
  try
    while FindResult do
    begin
      if FSR.Attributes and FILE_ATTRIBUTE_DIRECTORY = 0 then
        begin
          Case FileOp of
            FO_COPY:
              begin
                fos.wFunc  := FO_COPY;
              end;
            FO_MOVE:
              begin
                fos.wFunc  := FO_MOVE;
              end;
            FO_DELETE:
              begin
                fos.wFunc  := FO_DELETE;
                if toRecycle then fos.fFlags := fos.fFlags or FOF_ALLOWUNDO;
              end;
            FO_RENAME:
              begin
                fos.wFunc  := FO_RENAME;
              end;
          else
            ;
          end;
            fos.fFlags := fos.fFlags or FOF_FILESONLY or FOF_SILENT or
                   FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR;
            _fromDir:= APath + FSR.Name + #0#0;
            _toDir:= AddBackslash(toDir) + FSR.Name + #0#0;
            ForceDirectories(ExtractFilePath(_toDir));
            fos.pFrom  := PAnsiChar(_fromDir);
            fos.pTo    := PAnsiChar(_toDir);
            Result := (0 = ShFileOperation(fos));
        end;
      FindResult := FindNext(FSR);
    end;
    FindResult := FindFirst(APath + '*.*', DSR);
    while FindResult do
    begin
      if ((DSR.Attributes and FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY) and
        not ((DSR.Name = '.') or (DSR.Name = '..')) then
{Recursion} FilesMaskOperation(APath + DSR.Name, AddBackslash(toDir) + DSR.Name, fileMask, FileOp, EmptyDirRemove, toRecycle);
      FindResult := FindNext(DSR);
    end;
  finally
    FindClose(FSR);
    FindClose(DSR);
    if EmptyDirRemove then RemoveDir(APath);
  end;
end;

function CopyFiles(const fromDir, toDir, fileMask: String): Boolean;
begin
  Result := FilesMaskOperation(fromDir, toDir, fileMask,
         FO_COPY, False, False);
end;

function MoveFiles(const fromDir, toDir, fileMask: String): Boolean;
begin
  Result := FilesMaskOperation(fromDir, toDir, fileMask,
         FO_MOVE, True, False);
end;

function DelFiles(const fromDir, fileMask: String; toRecycle: Boolean ): Boolean;
begin
  Result := FilesMaskOperation(fromDir, '', fileMask,
         FO_DELETE, True, toRecycle);
end;
{****************************************************************}
{****************************************************************}
Замените везде String на AnsiString например:
Код:
function CopyDir(const fromDir, toDir: AnsiString): Boolean;
begin
  Result := BackupDir(fromDir, toDir, False);
end;
 

alexalsp

Новичок
SBalykov,

Спасибо. Вроде все заработало.

Я правильно понял, что все стринги надо было заменить ?

или только в конкретных блоках?

Я везде заменил...

Код:
[Code]
type
   TSHFileOpStruct =  record
     Wnd: HWND;
     wFunc: UINT;
     pFrom: PAnsiChar;
     pTo: PAnsiChar;
     fFlags: Word; // FILEOP_FLAGS;
     fAnyOperationsAborted: BOOL;
     hNameMappings: HWND; // Pointer;
     lpszProgressTitle: PAnsiChar; { only used if FOF_SIMPLEPROGRESS }
   end;

const
// use in wFunc
   { $EXTERNALSYM FO_MOVE }
   FO_MOVE           = $0001;
   { $EXTERNALSYM FO_COPY }
   FO_COPY           = $0002;
   { $EXTERNALSYM FO_DELETE }
   FO_DELETE         = $0003;
   { $EXTERNALSYM FO_RENAME }
   FO_RENAME         = $0004;
// use in fFlags
   { $EXTERNALSYM FOF_MULTIDESTFILES }
   FOF_MULTIDESTFILES         = $0001;
   { $EXTERNALSYM FOF_CONFIRMMOUSE }
   FOF_CONFIRMMOUSE           = $0002;
   { $EXTERNALSYM FOF_SILENT }
   FOF_SILENT                 = $0004;  { don't create progress/report }
   { $EXTERNALSYM FOF_RENAMEONCOLLISION }
   FOF_RENAMEONCOLLISION      = $0008;
   { $EXTERNALSYM FOF_NOCONFIRMATION }
   FOF_NOCONFIRMATION         = $0010;  { Don't prompt the user. }
   { $EXTERNALSYM FOF_WANTMAPPINGHANDLE }
   FOF_WANTMAPPINGHANDLE      = $0020;  { Fill in
SHFILEOPSTRUCT.hNameMappings
                                          Must be freed using
SHFreeNameMappings }
   { $EXTERNALSYM FOF_ALLOWUNDO }
   FOF_ALLOWUNDO              = $0040;
   { $EXTERNALSYM FOF_FILESONLY }
   FOF_FILESONLY              = $0080;  { on *.*, do only files }
   { $EXTERNALSYM FOF_SIMPLEPROGRESS }
   FOF_SIMPLEPROGRESS         = $0100;  { means don't show names of files }
   { $EXTERNALSYM FOF_NOCONFIRMMKDIR }
   FOF_NOCONFIRMMKDIR         = $0200;  { don't confirm making any
needed dirs }
   { $EXTERNALSYM FOF_NOERRORUI }
   FOF_NOERRORUI              = $0400;  { don't put up error UI }


function SHFileOperation(const lpFileOp: TSHFileOpStruct):Integer;
external 'SHFileOperation@shell32.dll stdcall';

{****************************************************************}
{****************************************************************}
{****************************************************************}

function BackupDir(const fromDir, toDir: AnsiString; IsMove: Boolean): Boolean;
var
  fos: TSHFileOpStruct;
  _fromDir, _toDir: AnsiString;
  SR: TFindRec;
  res: Boolean;
begin
    ForceDirectories(toDir);
  if IsMove then
    fos.wFunc  := FO_MOVE else
    fos.wFunc  := FO_COPY;
    fos.fFlags := FOF_FILESONLY or FOF_SILENT or
               FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR;
    _fromDir:= AddBackslash(fromDir);
    _toDir  := AddBackslash(toDir);
  if (Length(fromDir) = Length(_fromDir)) then
    begin
        res:= FindFirst(_fromDir + '*', SR);
      try
        while res do
        begin
          if (SR.Name <> '') and (SR.Name <> '.') and (SR.Name <> '..') then
          begin
            if SR.Attributes = FILE_ATTRIBUTE_DIRECTORY then
              begin
                _fromDir:= _fromDir + SR.Name + #0#0;
                _toDir  := _toDir + #0#0;
                fos.pFrom  := PAnsiChar(_fromDir);
                fos.pTo    := PAnsiChar(_toDir);
              end else
              begin
                _fromDir:= _fromDir + SR.Name + #0#0;
                _toDir  := _toDir   + SR.Name + #0#0;
                fos.pFrom  := PAnsiChar(_fromDir);
                fos.pTo    := PAnsiChar(_toDir);
              end;
                Result := (0 = ShFileOperation(fos));
                _fromDir:= ExtractFilePath(_fromDir);
                _toDir:= ExtractFilePath(_toDir);
          end;
          res := FindNext(SR);
        end;
      finally
        FindClose(SR);
      end;
    end else
    begin
      _fromDir:= RemoveBackslashUnlessRoot(_fromDir) + #0#0;
      _toDir  := RemoveBackslashUnlessRoot(_toDir)   + #0#0;
      fos.pFrom  := PAnsiChar(_fromDir);
      fos.pTo    := PAnsiChar(_toDir);
      Result := (0 = ShFileOperation(fos));
    end;
end;

{****************************************************************}
function MoveDir(const fromDir, toDir: AnsiString): Boolean;
begin
  Result := BackupDir(fromDir, toDir, True);
end;

{****************************************************************}
function CopyDir(const fromDir, toDir: AnsiString): Boolean;
begin
  Result := BackupDir(fromDir, toDir, False);
end;

{****************************************************************}
function DelDir(dir: AnsiString; toRecycle: Boolean): Boolean;
var
  fos: TSHFileOpStruct;
  _dir: AnsiString;
begin
    _dir:= RemoveBackslashUnlessRoot(dir) + #0#0;
    fos.wFunc  := FO_DELETE;
    fos.fFlags := FOF_SILENT or FOF_NOCONFIRMATION;
  if toRecycle then
    fos.fFlags := fos.fFlags or FOF_ALLOWUNDO;
    fos.pFrom  := PAnsiChar(_dir);
  Result := (0 = ShFileOperation(fos));
end;

{****************************************************************}
function RenameDir(const fromDir, toDir: AnsiString): Boolean;
var
  fos: TSHFileOpStruct;
  _fromDir, _toDir: AnsiString;
begin
    _fromDir:= RemoveBackslashUnlessRoot(fromDir) + #0#0;
    _toDir  := RemoveBackslashUnlessRoot(toDir) + #0#0;
    fos.wFunc  := FO_RENAME;
    fos.fFlags := FOF_FILESONLY or FOF_ALLOWUNDO or
              FOF_SILENT or FOF_NOCONFIRMATION;
    fos.pFrom  := PAnsiChar(_fromDir);
    fos.pTo    := PAnsiChar(_toDir);
  Result := (0 = ShFileOperation(fos));
end;

{****************************************************************}
function FilesMaskOperation(const fromDir, toDir, fileMask: AnsiString; FileOp: Integer; EmptyDirRemove: Boolean; toRecycle: Boolean): Boolean;
var
  fos: TSHFileOpStruct;
  _fromDir, _toDir: AnsiString;
  FSR, DSR: TFindRec;
  FindResult: Boolean;
  APath: AnsiString;
begin
  APath := AddBackslash(fromDir);
  FindResult := FindFirst(APath + fileMask, FSR);
  try
    while FindResult do
    begin
      if FSR.Attributes and FILE_ATTRIBUTE_DIRECTORY = 0 then
        begin
          Case FileOp of
            FO_COPY:
              begin
                fos.wFunc  := FO_COPY;
              end;
            FO_MOVE:
              begin
                fos.wFunc  := FO_MOVE;
              end;
            FO_DELETE:
              begin
                fos.wFunc  := FO_DELETE;
                if toRecycle then fos.fFlags := fos.fFlags or FOF_ALLOWUNDO;
              end;
            FO_RENAME:
              begin
                fos.wFunc  := FO_RENAME;
              end;
          else
            ;
          end;
            fos.fFlags := fos.fFlags or FOF_FILESONLY or FOF_SILENT or
                   FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR;
            _fromDir:= APath + FSR.Name + #0#0;
            _toDir:= AddBackslash(toDir) + FSR.Name + #0#0;
            ForceDirectories(ExtractFilePath(_toDir));
            fos.pFrom  := PAnsiChar(_fromDir);
            fos.pTo    := PAnsiChar(_toDir);
            Result := (0 = ShFileOperation(fos));
        end;
      FindResult := FindNext(FSR);
    end;
    FindResult := FindFirst(APath + '*.*', DSR);
    while FindResult do
    begin
      if ((DSR.Attributes and FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY) and
        not ((DSR.Name = '.') or (DSR.Name = '..')) then
{Recursion} FilesMaskOperation(APath + DSR.Name, AddBackslash(toDir) + DSR.Name, fileMask, FileOp, EmptyDirRemove, toRecycle);
      FindResult := FindNext(DSR);
    end;
  finally
    FindClose(FSR);
    FindClose(DSR);
    if EmptyDirRemove then RemoveDir(APath);
  end;
end;

function CopyFiles(const fromDir, toDir, fileMask: AnsiString): Boolean;
begin
  Result := FilesMaskOperation(fromDir, toDir, fileMask,
         FO_COPY, False, False);
end;

function MoveFiles(const fromDir, toDir, fileMask: AnsiString): Boolean;
begin
  Result := FilesMaskOperation(fromDir, toDir, fileMask,
         FO_MOVE, True, False);
end;

function DelFiles(const fromDir, fileMask: AnsiString; toRecycle: Boolean ): Boolean;
begin
  Result := FilesMaskOperation(fromDir, '', fileMask,
         FO_DELETE, True, toRecycle);
end;
 

El Sanchez

Новичок
Все правильно ...
1. Некорректный импорт SHFileOperation. Тут будет импортироваться ANSI-версия функции, отсюда и возня с PAnsiChar и AnsiString на Unicode. Нужно:
Код:
#define A = (Defined UNICODE) ? "W" : "A"
function SHFileOperation(var lpFileOp: TSHFileOpStruct): Integer; external 'SHFileOperation{#A}@shell32.dll stdcall';
2. Заменить определение типа TSHFileOpStruct на:
Код:
TSHFileOpStruct = record
  hwnd: HWND;
  wFunc: UINT;
  pFrom: string;
  pTo: string;
  fFlags: Word;
  fAnyOperationsAborted: BOOL;
  hNameMappings: LongWord;
  lpszProgressTitle: string;
end;
3. В коде string оставить как есть, не надо на AnsiString менять, PAnsiChar убрать, все добавки #0#0 заменить на #0.
 
Сверху