100分/局域网映射驱动器的小程序实现/各位大侠指点指点

Question

我要把我们服务器上的两个共享文件夹映射成本机上的两个盘符。如服务器名：datacenter；两个文件夹pos，qos，映射成两个盘：P，Q。我的意思是生成一个.EXE，点击一个按纽就自动实现盘符的映射：请教各位大侠，具体的实现方法。

Answer 1

我已经用以下方法实现(如果可能,帮我回答这个问题:http://expert.csdn.net/Expert/topic/2464/2464603.xml?temp=.8645746)unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, FileCtrl, Buttons;type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;
  NetSource : TNetResource;   //连接服务器结构
  dwResult:DWORD;
  g_bflag :boolean;              //连接文件服务器的返回值  procedure ConnectServer ;
  function ConnectDrive(_drvLetter: string; _netPath: string; _showError: Boolean; _reconnect: Boolean): DWORD;
  function DisconnectNetDrive(_locDrive: string; _showError: Boolean; _force: Boolean;_save: Boolean): DWORD;
implementation
{$R *.dfm}
function ConnectDrive(_drvLetter: string; _netPath: string; _showError: Boolean;
 _reconnect: Boolean): DWORD;
var
 nRes: TNetResource;
 errCode: DWORD;
 dwFlags: DWORD;
begin FillChar(NRes, SizeOf(NRes), #0);
 nRes.dwType := RESOURCETYPE_DISK; nRes.lpLocalName := PChar(_drvLetter);
 nRes.lpRemoteName := PChar(_netPath);                    if _reconnect then
   dwFlags := CONNECT_UPDATE_PROFILE and CONNECT_INTERACTIVE
 else
   dwFlags := CONNECT_INTERACTIVE; errCode := WNetAddConnection3(Form1.Handle, nRes, nil, nil, dwFlags); if (errCode <> NO_ERROR) and (_showError) then
 begin
   Application.MessageBox(PChar('An error occured while connecting:' + #13#10 +
     SysErrorMessage(GetLastError)),
     'Error while connecting!',
     MB_OK);
 end;
 Result := errCode;                                       
end;
function DisconnectNetDrive(_locDrive: string; _showError: Boolean; _force: Boolean;
 _save: Boolean): DWORD;
var
 dwFlags: DWORD;
 errCode: DWORD;
begin if _save then
   dwFlags := CONNECT_UPDATE_PROFILE
 else
   dwFlags := 0; errCode := WNetCancelConnection2(PChar(_locDrive), dwFlags, _force);
 if (errCode <> NO_ERROR) and (_showError) then
 begin
   Application.MessageBox(PChar('An error occured while disconnecting:' + #13#10 +
     SysErrorMessage(GetLastError)),
     'Error while disconnecting',
     MB_OK);
 end;
 Result := errCode;                                        
end;procedure ConnectServer;
begin
    g_bFlag:=True;
    NetSource.dwType:= RESOURCETYPE_ANY;
    NetSource.lpLocalName:='';
    NetSource.lpRemoteName:=PAnsiChar('\\192.169.0.1');
    NetSource.lpProvider:='';
    dwResult:=WnetAddConnection2(NetSource,PAnsiChar('123456'),PAnsiChar('administrator'),CONNECT_UPDATE_PROFILE);
   //administrator为服务器的连接帐号,123456为密码,把帐号和密码改成你的即可
   if dwResult<>0 then
    begin
        MessageDlg('连接文件服务器失败!'#13#10'请重新设置!',mtWarning,[mbOk],0);
        g_bFlag:=False;
    end;
end;
{映射网络驱动器}
procedure TForm1.Button1Click(Sender: TObject);begin
  ConnectServer;
  ConnectDrive('p:', '\\192.169.0.1\nnmap', True, True);//nnmap为服务器共享目录
end;{断开网络驱动器}
procedure TForm1.Button2Click(Sender: TObject);
begin
DisconnectNetDrive('p:', True, True, True);
end;end.

Answer 2

大哥，我的和服务器的都是win2000的，用你的程序 ，不报错，但是 也没有反映的

Answer 3

试试这个
比如我要把\\Server\sys映射为F盘。
输入参数为\\server\sys\home\bruno,返回值是F:\home\brunoFunction UNCToDrive(UNCPath: STring): STring;
var
  DriveNum: Integer;
  DriveChar: Char;
  DriveBits: set of 0..25;
  StartSTr,TestStr: STring;
begin
  result := UNCPath;
  StartSTr := UNCPath;
  Integer(DriveBits) := GetLogicalDrives;
  for DriveNum := 0 to 25 do
  begin
    if (DriveNum in DriveBits) then begin
      DriveChar := Char(DriveNum + Ord('A'));
      TestSTr := ExpandUNCFileName(DriveChar+':\');
      If TEstStr <> '' then
        If Pos(Uppercase(TestSTr),Uppercase(STartSTr)) > 0 then
           begin
              Delete(StartSTr,1,Length(TestSTr));
              result := DriveChar+':\'+StartSTr;
              break;
           end;
        end;
  end;
end;