1. Уважаемые гости и пользователи форума.
    Администрация настоятельно рекомендует не регистрировать несколько аккаунтов для одного пользователя. При выявлении наличия мультиаккаунтов будут заблокированы все учетные записи данного пользователя.
    Аккаунты, зарегистрированные на временную почту будут также заблокированы.

Вопрос SHFileOperation и Unicode

Тема в разделе "Inno Setup", создана пользователем AtotIK, 30 июл 2014.

  1. Пользователь

    Регистрация:
    2 май 2014
    Сообщения:
    37
    Симпатии:
    3
    Пол:
    Мужской
    Привет всем. В общем имеется проблема с применением на Unicode-версии.
    Вой сам файл:
    Код (Text):

    ;***************************************************************;
    ;****************** 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-версии всё великолепно работает.

    Пример использования:
    Код (Text):
    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;

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

    Регистрация:
    2 май 2014
    Сообщения:
    37
    Симпатии:
    3
    Пол:
    Мужской
    Не доглядел, нужно же ещё заменить String на AnsiString. Тему можно закрывать.
     
    Krinkels нравится это.
  3. Пользователь

    Регистрация:
    12 сен 2014
    Сообщения:
    5
    Симпатии:
    0
    Пол:
    Мужской
    У меня проблема в другом. Вообще не срабатывает переименование на unicod хотя на ansi все нормально срабатывает.

    Код (Text):
    ;***************************************************************;
    ;****************** 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;
    {****************************************************************}
    {****************************************************************}

     
     
    Последнее редактирование: 14 мар 2019
  4. Старожил

    Регистрация:
    31 мар 2015
    Сообщения:
    332
    Симпатии:
    171
    Пол:
    Мужской
    Замените везде String на AnsiString например:
    Код (Inno):

    function CopyDir(const fromDir, toDir: AnsiString): Boolean;
    begin
      Result := BackupDir(fromDir, toDir, False);
    end;
     
  5. Пользователь

    Регистрация:
    12 сен 2014
    Сообщения:
    5
    Симпатии:
    0
    Пол:
    Мужской
    SBalykov,

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

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

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

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

    Код (Text):
    [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;
     
  6. Старожил

    Регистрация:
    31 мар 2015
    Сообщения:
    332
    Симпатии:
    171
    Пол:
    Мужской
    Все правильно ...
     
    alexalsp нравится это.
  7. Пользователь

    Регистрация:
    13 ноя 2015
    Сообщения:
    17
    Симпатии:
    42
    Пол:
    Мужской
    1. Некорректный импорт SHFileOperation. Тут будет импортироваться ANSI-версия функции, отсюда и возня с PAnsiChar и AnsiString на Unicode. Нужно:
    Код (Inno):
    #define A = (Defined UNICODE) ? "W" : "A"
    function SHFileOperation(var lpFileOp: TSHFileOpStruct): Integer; external 'SHFileOperation{#A}@shell32.dll stdcall';
    2. Заменить определение типа TSHFileOpStruct на:
    Код (Inno):
    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.
     
    SBalykov, vint56 и Хамик нравится это.
  8. Старожил

    Регистрация:
    31 мар 2015
    Сообщения:
    332
    Симпатии:
    171
    Пол:
    Мужской
    El Sanchez
    Спасибо за поправку...
     

Поделиться этой страницей