直接连接网络盘时，如果目标网络盘是断开状态，程序会卡住！PC用户程序在需要取存网络盘文件时，最好先判断目标网络盘和本机是否连接状态；
在网上没有搜索到类似的文章，自己踩了坑，分享出来；
-----------开发环境 D7------
本机测试正常！
----------------
-------------------------Unit---开始
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
EMatch=(HJPFullMatch,HJPPartMatch);//HJPFullMatch完全匹配，HJPPartMatch部分匹配
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
function NetworkDiskExists(DirPath:string;MatchStyle:EMatch):Boolean;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TForm1 }
function TForm1.NetworkDiskExists(DirPath: string;
MatchStyle: EMatch): Boolean;
function VolumeID(DriveChar: Char): string;
var
OldErrorMode: Integer;
NotUsed, VolFlags: DWORD;
Buf: array [0..MAX_PATH] of Char;
begin
OldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
try
Buf[0] := #$00;
if GetVolumeInformation(PChar(DriveChar + ':\'), Buf, DWORD(sizeof(Buf)),
nil, NotUsed, VolFlags, nil, 0) then
SetString(Result, Buf, StrLen(Buf))
else Result := '';
if DriveChar < 'a' then
Result := AnsiUpperCaseFileName(Result)
else
Result := AnsiLowerCaseFileName(Result);
Result := Format('[%s]',[Result]);
finally
SetErrorMode(OldErrorMode);
end;
end;
function NetworkVolume(DriveChar: Char): string;
var
Buf: Array [0..MAX_PATH] of Char;
DriveStr: array [0..3] of Char;
BufferSize: DWORD;
begin
BufferSize := sizeof(Buf);
DriveStr[0] := UpCase(DriveChar);
DriveStr[1] := ':';
DriveStr[2] := #0;
if WNetGetConnection(DriveStr, Buf, BufferSize) = WN_SUCCESS then
begin
SetString(Result, Buf, BufferSize);
if DriveChar < 'a' then
Result := AnsiUpperCaseFileName(Result)
else
Result := AnsiLowerCaseFileName(Result);
end
else
Result := VolumeID(DriveChar);
end;
var
i:integer;
s:string;
begin
Result:=False;
for i := 65 to 90 do
begin
if (GetDriveType(Pchar(chr(i)+':\')) =DRIVE_REMOTE) then //网络盘
begin
s:=LowerCase(NetworkVolume(chr(i)));
SetLength(s,StrLen(PChar(s)));
if MatchStyle=HJPFullMatch then //HJPFullMatch,HJPPartMatch
begin
if SameText(DirPath,s) then
begin
Result:=True;
Break;
end;
end
else
begin
if Pos(LowerCase(DirPath),s)>0 then
begin
Result:=True;
Break;
end;
end;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if NetworkDiskExists('\\DOCUMENT\文件服务器',HJPFullMatch) then //如果是IP的请填IP，按照网络盘来传参数'\\192.168.1.99\文件服务器'
begin
ShowMessage('存在');
end;
end;
end.
--------------------------Unit---结束
------------Form开始
object Form1: TForm1
Left = 192
Top = 168
Width = 293
Height = 181
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Button1: TButton
Left = 88
Top = 56
Width = 75
Height = 25
Caption = 'Button1'
TabOrder = 0
OnClick = Button1Click
end
end
----------Form结束
-----------------------------------------资料补充-------
Windows单元；
const
DRIVE_UNKNOWN = 0;//驱动器类型不确定
{$EXTERNALSYM DRIVE_UNKNOWN}
DRIVE_NO_ROOT_DIR = 1;//系统目录不存在
{$EXTERNALSYM DRIVE_NO_ROOT_DIR}
DRIVE_REMOVABLE = 2;//可移动驱动器
{$EXTERNALSYM DRIVE_REMOVABLE}
DRIVE_FIXED = 3;//固定驱动器
{$EXTERNALSYM DRIVE_FIXED}
DRIVE_REMOTE = 4;//网络驱动器
{$EXTERNALSYM DRIVE_REMOTE}
DRIVE_CDROM = 5;//CD-ROM驱动器
{$EXTERNALSYM DRIVE_CDROM}
DRIVE_RAMDISK = 6;//虚拟驱动器
{$EXTERNALSYM DRIVE_RAMDISK}
