测试如果磁盘有写权限

Question

我需要知道，如果我的程序可以将文件写入到从正在运行所在的磁盘（硬盘，软盘，闪存，CD）。 我曾尝试是这样的：

     {$I-}
     Rewrite(myFile);                                       
     {$I+}
  Result:= (IOResult = 0);

的问题是，如果是只读盘时，Windows给我一个错误消息，告诉我，

  

“appName.exe - 写保护错误磁盘不能写，因为它是写保护，请删除该卷的写保护   USB_BOOT驱动器d :.取消TRYAGAIN继续“

如何测试进行写访问而不引发任何错误/警告消息？ 感谢。

---

编辑：

确定。 “虫”无关与上面提到的一段代码。我只认为它在那里出现。我的代码移动到只读光盘，并从那里运行它。错误出现在一个被称为“CreateShortcutEx”的功能，在这条线：

 MyPFile.Save(PWChar(WFileName),False);

MyPFile声明如下：

var
 MyObject  : IUnknown;
 MySLink   : IShellLink;
 MyPFile   : IPersistFile;
 Directory : String;
 WFileName : WideString;
 MyReg     : TRegIniFile;
begin
 MyObject := CreateComObject(CLSID_ShellLink);
 MySLink  := MyObject as IShellLink;
 MyPFile  := MyObject as IPersistFile;
 .....
end;

那么，为什么MyPFile试图写入应用程序的驱动器（只读的）如果WFileName参数是什么？“C：\ Documents和Settings \喇嘛喇嘛”

Answer 1

调用Windows API SetErrorMode（） 功能禁用错误消息框。

修改

我只是尝试，并且这样：

procedure TForm1.Button1Click(Sender: TObject);
var
  Str: TStream;
  OldMode: Cardinal;
begin
  OldMode := SetErrorMode(SEM_FAILCRITICALERRORS);

  try
    try
      Str := TFileStream.Create('z:\foo.txt', fmOpenReadWrite);
      try

      finally
        Str.Free;
      end;
    except end;
  finally
    SetErrorMode(OldMode);
  end;
end;

按预期工作。

Answer 2

不是很漂亮，但是这似乎为我工作。

---

function CanWrite(drive: string): boolean;
    var
        OldMode: Cardinal;
    begin
        OldMode := SetErrorMode(SEM_FAILCRITICALERRORS);
        try
            with TStringList.Create do
                try
                    SaveToFile(drive + ':\file.txt');
                    result := true;

                    try
                        deletefile(drive + ':\file.txt');
                    except
                    end;
                except
                    result := false;
                end;
        finally
            SetErrorMode(OldMode);
        end;
end;

---

呼叫以将其与

---

if CanWrite('g') = true then
    begin
        showmessage('Can Write');
    end
    else
    begin
        showmessage('Can not write');
end;

---

Answer 3

当你把你的代码的尝试中会发生什么/除？

另外，你可以尝试（像）这样的：

function CanWrite: boolean;
begin
  result := true;
  with TStringList.Create do
  try
    SaveToFile('file.txt');
  except
    result := false;
  finally
    Free;
  end;
end;

很抱歉，但我在德尔福不编码了，我没有地方安装德尔福。

Answer 4

有存在一个小的免费软件“驱动器准备好？”实用程序（ dready.com ）的霍斯特·谢弗写了也可以检查写访问。我没有测试过，但据我可以看到这可以作为一个解决方案;称之为例如作为“DREADY C：/ W”。并检查返回值