拷贝文件夹xp可以win7不行

Question

//变量
var
  FileOp:TSHFileOpStruct;
  FromBuf,ToBuf:Array[0..255] of AnsiChar;
  fp:string;
//执行代码
    FillChar(FromBuf,SizeOf(FromBuf),0);
    FillChar(ToBuf,SizeOf(ToBuf),0);
    StrPCopy(FromBuf,fp);//fp是源路径
    StrPCopy(ToBuf,Edit1.Text);
    FileOp.Wnd := Handle;
    FileOp.pFrom := @FromBuf;
    FileOp.pTo := @ToBuf;
    FileOp.wFunc := FO_COPY;
    FileOp.fFlags := FOF_NOCONFIRMATION OR FOF_MULTIDESTFILES;
    FileOp.fAnyOperationsAborted := False;
    FileOp.hNameMappings := nil;
    FileOp.lpszProgressTitle := '正在移动文件，请稍候...';
    if SHFileOperation(FileOp) <> 0 then
    begin
      Application.MessageBox('复制失败！','提示',MB_ICONINFORMATION);
      IsOk := False;
      Exit;
    end;代码在xp下没问题，win7在执行SHFileOperation时有如下提示：
求教

Answer 1

GetLastErr看看是什么错误，估计是权限之类的问题吧

Answer 2

WIN7 uac开启的时候，只能访问当前用户的配置目录，不能访问程序所在目录及其他目录，所以QQ在WIN7下把配置文件都放入用户配置目录了。

Answer 3

楼主可以把程序设置为admin运行试试，UAC对API的权限控制对开发来说很麻烦。

Answer 4

function File_Action(fFROM, fTO: string; Action: integer): Boolean;
// 对文件进行操作
var
    FData: TShFileOpStruct;
begin
    FillChar(FData, SizeOf(TShFileOpStruct), 0);
    FData.pFrom := pchar(fFROM + #0);
    // 设立数据源路径和文件、目录名,支(?,*通配符)
    if fTO <> '' then
        if fTO[length(fTO)] <> '\' then
            fTO := fTO + '\';
    FData.pTo := pchar(fTO + #0); // 设立目标路径
    case Action of
        0:
            FData.wFunc := FO_COPY; // copy
        1:
            FData.wFunc := FO_MOVE; // move
        2:
            FData.wFunc := FO_DELETE; // delete
        3:
            FData.wFunc := FO_RENAME; // rename,未使用
    else
        FData.wFunc := FO_COPY;
    end;
    FData.fFlags := FOF_ALLOWUNDO or FOF_CONFIRMMOUSE; 
    if ExtractFilePath(fFROM) = fTO then
        FData.fFlags := FOF_RENAMEONCOLLISION;
    FData.fAnyOperationsAborted := false;
    FData.hNameMappings := nil;
    case Action of
        0:
            FData.lpszProgressTitle := '复制文件'; // copy
        1:
            FData.lpszProgressTitle := '移动文件'; // move
        2:
            FData.lpszProgressTitle := '删除文件'; // delete
        3:
            FData.lpszProgressTitle := '重命名'; // rename
    end;
    Result := ShFileOperation(FData) = 0;
end;.
把AnsiChar都改成string;

Answer 5

谢谢楼上几位回复，关闭uac，取得管理权限，都试了不行，我怀疑是api的问题，所以发到这个版块

Answer 6

用这个函数，在Win7下测试通过，XP原来是可以的，不过最近没测试了，要改为移动，把FO_COPY改成FO_MOVE，要加头文件ShellAPI。function CopyDirectory(const Source, Dest: string; const UI: Boolean = False): boolean;
{
  复制目录对话框
}
var
  fo: TSHFILEOPSTRUCT;
begin
  FillChar(fo, SizeOf(fo), 0);
  with fo do
  begin
    Wnd := GetActiveWindow;
    wFunc := FO_COPY;
    pFrom := PChar(source + #0);
    pTo := PChar(Dest + #0);
    if UI then
      fFlags := FOF_ALLOWUNDO
    else
      fFlags := FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR;
  end;
  Result := (SHFileOperation(fo) = 0);
end;