用vb访问共享资源的初级问题，高分在线等

[bravetiger617]

如何用代码访问局域网上另外的一台机器的共享资源？要求不论本机还是对方机器重新启动只要程序运行就可以访问！
我试了试如下代码
Dim brtn As Double
Dim strpath As String
On Error GoTo errdl
Dim strpst As String
strpst = "\\bj\yanyu_GSM"
strpath = "net use" + strpst + " bjyy/user:bjyy" ''''共享路径 用户和密码
brtn = Shell(strpath)
strpath = Dir(strpst & "\")
If strpath <> "" Then
Dim inp As Integer
inp = 2
Open strpst + "\" + strpath For Input As #1
Dim strlin As String
Line Input #1, strlin
Close #1
End If
但是总是提示没有路径，在另外一台同网的机器上就可以。
在我的机器上通过局域网登陆一下bj机器后代码就可以执行。---如何登陆另一台机器命令和参数如何写？？

[高高兴兴的晶晶]

两边是什么系统？
一般就是网络的问题或者就是系统问题，9X下和win2k下是有差别的

[caiyuanyuan]

up

[csdnexplore]

晕倒，这样的代码多的很，我的~~
Add Three Command And Two TextBox On The Form:
'Form:
Private Sub Command1_Click()

'添加网络驱动器(第一个参数共享信息、第二个参数、共享到本地的磁盘、第三个参数：登陆用户名第四个参数：登陆密码)
If NetDriveConnect("\\TollServer\Pic$", "S:", Trim$(Text.Text), Trim$(Text2.Text)) = False Then
MsgBox "无法建立网络驱动器，请确认网络服务器可以使用且共享已经打开！"
Exit Sub
End If

End Sub

Private Sub Command2_Click()

'关闭网络驱动器
Call NetDriveDisconnect(LocalNetDrive)

End Sub

Private Sub Command3_Click()

Dim f As New FileSystemObject
Dim SourceFile As String
Dim DestFile As String

f.CopyFile SourceFile, LocalNetDrive & "\" & DestFile, True

End Sub

'Module:
Option Explicit
'*********************网络驱动器定义开始 ***************************************'

'添加到网络驱动器的连接
Public Declare Function WNetAddConnection2 Lib "mpr.dll" Alias _
"WNetAddConnection2A" (lpNetResource As NETRESOURCE, _
ByVal lpPassword As String, ByVal lpUserName As String, _
ByVal dwFlags As Long) As Long

'取消到网络驱动器的连接
Public Declare Function WNetCancelConnection2 Lib "mpr.dll" Alias _
"WNetCancelConnection2A" (ByVal lpName As String, _
ByVal dwFlags As Long, ByVal fForce As Long) As Long

Public Const NO_ERROR = 0
Public Const CONNECT_UPDATE_PROFILE = &H1

'网络驱动器参数
Public Const RESOURCETYPE_DISK = &H1
Public Const RESOURCETYPE_PRINT = &H2
Public Const RESOURCETYPE_ANY = &H0
Public Const RESOURCE_CONNECTED = &H1
Public Const RESOURCE_REMEMBERED = &H3
Public Const RESOURCE_GLOBALNET = &H2
Public Const RESOURCEDISPLAYTYPE_DOMAIN = &H1
Public Const RESOURCEDISPLAYTYPE_GENERIC = &H0
Public Const RESOURCEDISPLAYTYPE_SERVER = &H2
Public Const RESOURCEDISPLAYTYPE_SHARE = &H3
Public Const RESOURCEUSAGE_CONNECTABLE = &H1
Public Const RESOURCEUSAGE_CONTAINER = &H2
'错误常量
Public Const ERROR_ACCESS_DENIED = 5&
Public Const ERROR_ALREADY_ASSIGNED = 85&
Public Const ERROR_BAD_DEV_TYPE = 66&
Public Const ERROR_BAD_DEVICE = 1200&
Public Const ERROR_BAD_NET_NAME = 67&
Public Const ERROR_BAD_PROFILE = 1206&
Public Const ERROR_BAD_PROVIDER = 1204&
Public Const ERROR_BUSY = 170&
Public Const ERROR_CANCELLED = 1223&
Public Const ERROR_CANNOT_OPEN_PROFILE = 1205&
Public Const ERROR_DEVICE_ALREADY_REMEMBERED = 1202&
Public Const ERROR_EXTENDED_ERROR = 1208&
Public Const ERROR_INVALID_PASSWORD = 86&
Public Const ERROR_NO_NET_OR_BAD_PATH = 1203&


'网络驱动器映射
Public Type NETRESOURCE
dwScope As Long
dwType As Long
dwDisplayType As Long
dwUsage As Long
lpLocalName As String
lpRemoteName As String
lpComment As String
lpProvider As String
End Type
'定义一个全局的本地网络驱动器变量（当网络驱动器连接的时候自动更新，同时要检测是否关闭原来的网络驱动器）
Public LocalNetDrive As String
'*********************网络驱动器定义结束 ***************************************'
'*********************网络驱动器开始 ***************************************'

'连接到网络驱动器
Public Function NetDriveConnect(ByVal RemotePath As String, ByVal Localpath As String, ByVal lpUserName As String, ByVal lpPassword As String) As Boolean

NetDriveConnect = False
Dim NetR As NETRESOURCE
Dim ErrInfo As Long

On Error GoTo Error_NetDriveConnect

If f.DriveExists(Localpath) = True Then '如果该磁盘已经存在，就不再重新建立连接
NetDriveConnect = True
LocalNetDrive = Localpath
Else
NetR.dwScope = RESOURCE_GLOBALNET
NetR.dwType = RESOURCETYPE_DISK
NetR.dwDisplayType = RESOURCEDISPLAYTYPE_SHARE
NetR.dwUsage = RESOURCEUSAGE_CONNECTABLE
NetR.lpLocalName = Localpath
LocalNetDrive = Localpath
NetR.lpRemoteName = RemotePath
ErrInfo = WNetAddConnection2(NetR, lpPassword, lpUserName, CONNECT_UPDATE_PROFILE) '用户名和密码
If ErrInfo = NO_ERROR Then NetDriveConnect = True
End If
Exit Function

Error_NetDriveConnect:
NetDriveConnect = False

End Function
'断开网络驱动器
Public Function NetDriveDisconnect(ByVal LocalNetDrive As String) As Boolean

NetDriveDisconnect = False
Dim ErrInfo As Long

On Error GoTo Error_NetDriveDisconnect

ErrInfo = WNetCancelConnection2(LocalNetDrive, CONNECT_UPDATE_PROFILE, True)
If ErrInfo = NO_ERROR Then NetDriveDisconnect = True

Exit Function

Error_NetDriveDisconnect:
NetDriveDisconnect = False

End Function

[bravetiger617]

两边都是2000server

[csdnexplore]

试试行不行再说了~~

[bravetiger617]

好像代码有问题呀，
Public Function NetDriveConnect(ByVal RemotePath As String, ByVal Localpath As String, ByVal lpUserName As String, ByVal lpPassword As String) As Boolean
函数中
f为定义，加了 Dim f As New FileSystemObject 还是报错

[bravetiger617]

up

[华芸智森]

如:
If Left$(P_DbCode, 2) = "\\" Then
TmpPath = FilePath(P_DbCode)
DisNet "M:"
DoEvents
MapDriv "M:", IIF(RIGHT(TMPPATH,1)="\" ,Left(TmpPath, Len(TmpPath) - 1),TMPPATH), P_UserLog.NetPwd, P_UserLog.NetUser
Call Wait(5)
End If

'********模块********************
Option Explicit

Private Type NETRESOURCE
dwScope As Long
dwType As Long
dwDisplayType As Long
dwUsage As Long
lpLocalName As String
lpRemoteName As String
lpComment As String
lpProvider As String
End Type

Const NO_ERROR = 0
Const CONNECT_UPDATE_PROFILE = &H1

Const RESOURCETYPE_DISK = &H1
Const RESOURCETYPE_PRINT = &H2
Const RESOURCETYPE_ANY = &H0
Const RESOURCE_CONNECTED = &H1
Const RESOURCE_REMEMBERED = &H3
Const RESOURCE_GLOBALNET = &H2
Const RESOURCEDISPLAYTYPE_DOMAIN = &H1
Const RESOURCEDISPLAYTYPE_GENERIC = &H0
Const RESOURCEDISPLAYTYPE_SERVER = &H2
Const RESOURCEDISPLAYTYPE_SHARE = &H3
Const RESOURCEUSAGE_CONNECTABLE = &H1
Const RESOURCEUSAGE_CONTAINER = &H2

Private Declare Function WNetAddConnection2 Lib "mpr.dll" Alias "WNetAddConnection2A" _
(lpNetResource As NETRESOURCE, _
ByVal lpPassword As String, _
ByVal lpUserName As String, _
ByVal dwFlags As Long) As Long

Private Declare Function WNetCancelConnection2 Lib "mpr.dll" Alias "WNetCancelConnection2A" _
(ByVal lpName As String, _
ByVal dwFlags As Long, _
ByVal fForce As Long) As Long

Public Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" _
(ByVal lpBuffer As String, nSize As Long) As Long

Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" _
(ByVal lpBuffer As String, nSize As Long) As Long
'返回网络资源的UNC路径
Public Declare Function WNetGetConnection Lib "mpr.dll" Alias "WNetGetConnectionA" _
(ByVal lpszLocalName As String, _
ByVal lpszRemoteName As String, _
cbRemoteName As Long) As Long
Declare Function WNetCancelConnection Lib "mpr.dll" Alias "WNetCancelConnectionA" (ByVal lpszName As String, ByVal bForce As Long) As Long
'

'记录操作员登录信息
Public Type UserLog
ID As String '操作员ID
Name As String '操作员名称
PassWord As String '操作员密码
LogDate As Date '登录日期
LogTime As Date '登录时间
NetUser As String
NetPwd As String
End Type

Public P_DbCtrl As New SmDbCtrl
Public P_Cnn As New ADODB.Connection
Public P_WorkPath As String
Public P_DbCode As String
Public P_UserLog As UserLog

'
'取路径名
'函数:FilePath
'参数: Fname 文件绝对路径.
'返回值:路径名.
'如:"C:\PROMAS\AA.EXE",则返回 "C:\PROMAS\"
Public Function FilePath(Fname As String) As String
Dim A As Integer
Dim B As Integer
Dim JlStr As String
FilePath = ""
B = 0
For A = Len(Fname) To 1 Step -1
If Mid$(Fname, A, 1) = "\" Then
B = A: GoTo 100
End If
Next A

100:

JlStr = Left$(Fname, B)
FilePath = JlStr
End Function


'建立和断开网络映射,取工作站名称及用户名称
'------------------------------------------
'1.MapDriv
'**建立网络映射** _
NETFLAG=MapDriv(DrivName, NetPath,Password, UserName)

'参数说明: _
DrivName 映射成的本地驱动器名 _
NetPath 网络路径 _
Password 密码(如果没有则用"") _
UserName 用户名(如果没有则用"") _

'返回值 =TRUE 连接成功,=FALSe 连接失败
'------------------------------------------
'2.DisNet
'**断开网络驱动器** _
FLAG=DisNet(NetDriv) _
NetDriv 断开的网络驱动器名 _

'返回值 =True 成功,=False 失败
'-----------------------------------------
'3.ComputerName
'**返回本工作站名称** _
ComName = ComputerName()

'返回值: 本机名称
'-----------------------------------------
'4.UserName
'**返回当前用户名称** _
UserName() As String
'
'返回值: 网络登录者名称
'----------------------------------------

'**建立网络映射**
'NETFLAG=MapDriv(DrivName, NetPath,Password, UserName)

'参数说明:
'DrivName 映射成的本地驱动器名
'NetPath 网络路径
'Password 密码(如果没有则用"")
'UserName 用户名(如果没有则用"")
'返回值 =TRUE 成功连接,=FALSe 连接失败
'============================================
Public Function MapDriv(DrivName As String, NetPath As String, PassWord As String, UserName As String) As Boolean
'建立网络连接
Dim NetR As NETRESOURCE
Dim ErrInfo As Long

With NetR
.dwScope = RESOURCE_GLOBALNET
.dwType = RESOURCETYPE_DISK
.dwDisplayType = RESOURCEDISPLAYTYPE_SHARE
.dwUsage = RESOURCEUSAGE_CONNECTABLE
.lpLocalName = UCase(DrivName) '映射成本机盘符
.lpRemoteName = UCase(NetPath) '映射的网络路径
End With
'建立连接,返回ERR代码
ErrInfo = WNetAddConnection2(NetR, PassWord, UserName, 0)
'检查代码
MapDriv = (ErrInfo = NO_ERROR)
End Function
'

'**断开网络驱动器**
'FLAG=DisNet(NetDriv)
'NetDriv 断开的网络驱动器名
'返回值 =True 成功,=False 失败
'=====================================
Public Function DisNet(NetDriv As String) As Boolean
Dim ErrInfo As Long
Dim ErrRe As Long
Dim strLocalName As String
strLocalName = UCase(NetDriv) '断开的映射盘
'断开,返回ERR代码
ErrRe = WNetCancelConnection(strLocalName, True)
ErrInfo = WNetCancelConnection2(strLocalName, CONNECT_UPDATE_PROFILE, True)
'检查代码
If ErrInfo = NO_ERROR Then
DisNet = True
Else
DisNet = False
End If
End Function
'

[bravetiger617]

up