VB局域网文件传送
做一个局域网文件的传送,本机文件夹间传送可以,但是选择网上邻居的文件夹就不行了!看看哈。到底什么问题?PrivateConstBIF_RETURNONLYFSDIRS=1...
做一个局域网文件的传送,本机文件夹间传送可以,但是选择网上邻居的文件夹就不行了!看看哈。到底什么问题?
Private Const BIF_RETURNONLYFSDIRS = 1 '从这里开始为API声明
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const MAX_PATH = 260
Private Declare Function SHBrowseForFolder Lib "Shell32" _
(lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "Shell32" _
(ByVal pidList As Long, _
ByVal lpBuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" _
(ByVal lpString1 As String, ByVal _
lpString2 As String) As Long
Private Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Dim a As New Shell 'Shell对象
Private Sub Command1_Click() '源文件夹
Dim lpIDList As Long
Dim sBuffer As String
Dim szTitle As String
Dim tBrowseInfo As BrowseInfo
With tBrowseInfo
.hWndOwner = Me.hWnd
.lpszTitle = lstrcat(szTitle, "")
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
End With
lpIDList = SHBrowseForFolder(tBrowseInfo)
If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
Text1.Text = sBuffer
End If
End Sub
Private Sub Command2_Click() '目标文件夹
Dim lpIDList As Long
Dim sBuffer As String
Dim szTitle As String
Dim tBrowseInfo As BrowseInfo
With tBrowseInfo
.hWndOwner = Me.hWnd
.lpszTitle = lstrcat(szTitle, "")
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
End With
lpIDList = SHBrowseForFolder(tBrowseInfo)
If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
Text2.Text = sBuffer
End If
End Sub
Private Sub Command3_Click()
If Text1.Text = "" Then
MsgBox "请选择源文件夹", 48, "无文件路径"
ElseIf Text2.Text = "" Then
MsgBox "请选择目标文件夹", 48, "无文件路径"
Else
Timer1.Enabled = True
Label3.Caption = "运行中……"
End If
End Sub
Private Sub Command4_Click()
Timer1.Enabled = False
Label3.Caption = "中断"
End Sub
Private Sub Timer1_Timer()
Dim limit_time As Data
limit_data = CDate(Now - 1 / 288) '时间标记,大于这个时间的文件属于新文件
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Dim fsobj
Set fsobj = fso.GetFolder(Text1.Text) '目标文件夹
Dim fsofolders
Set fsofolders = fsobj.SubFolders
Dim fsofile
Set fsofile = fsobj.Files
Dim i
For Each i In fsofile
If i.DateCreated > limit_data Then '如果文件的创建时间大于时间标记
FileCopy Text1.Text + "\" + i.Name, Text2.Text + "\" + i.Name '复制文件
End If
Next
End Sub
帮我把具体代码加到我的代码上吧!我可以继续追加! 展开
Private Const BIF_RETURNONLYFSDIRS = 1 '从这里开始为API声明
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const MAX_PATH = 260
Private Declare Function SHBrowseForFolder Lib "Shell32" _
(lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "Shell32" _
(ByVal pidList As Long, _
ByVal lpBuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" _
(ByVal lpString1 As String, ByVal _
lpString2 As String) As Long
Private Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Dim a As New Shell 'Shell对象
Private Sub Command1_Click() '源文件夹
Dim lpIDList As Long
Dim sBuffer As String
Dim szTitle As String
Dim tBrowseInfo As BrowseInfo
With tBrowseInfo
.hWndOwner = Me.hWnd
.lpszTitle = lstrcat(szTitle, "")
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
End With
lpIDList = SHBrowseForFolder(tBrowseInfo)
If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
Text1.Text = sBuffer
End If
End Sub
Private Sub Command2_Click() '目标文件夹
Dim lpIDList As Long
Dim sBuffer As String
Dim szTitle As String
Dim tBrowseInfo As BrowseInfo
With tBrowseInfo
.hWndOwner = Me.hWnd
.lpszTitle = lstrcat(szTitle, "")
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
End With
lpIDList = SHBrowseForFolder(tBrowseInfo)
If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
Text2.Text = sBuffer
End If
End Sub
Private Sub Command3_Click()
If Text1.Text = "" Then
MsgBox "请选择源文件夹", 48, "无文件路径"
ElseIf Text2.Text = "" Then
MsgBox "请选择目标文件夹", 48, "无文件路径"
Else
Timer1.Enabled = True
Label3.Caption = "运行中……"
End If
End Sub
Private Sub Command4_Click()
Timer1.Enabled = False
Label3.Caption = "中断"
End Sub
Private Sub Timer1_Timer()
Dim limit_time As Data
limit_data = CDate(Now - 1 / 288) '时间标记,大于这个时间的文件属于新文件
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Dim fsobj
Set fsobj = fso.GetFolder(Text1.Text) '目标文件夹
Dim fsofolders
Set fsofolders = fsobj.SubFolders
Dim fsofile
Set fsofile = fsobj.Files
Dim i
For Each i In fsofile
If i.DateCreated > limit_data Then '如果文件的创建时间大于时间标记
FileCopy Text1.Text + "\" + i.Name, Text2.Text + "\" + i.Name '复制文件
End If
Next
End Sub
帮我把具体代码加到我的代码上吧!我可以继续追加! 展开
4个回答
展开全部
可以用winsock控件
映射网络驱动器用WNetAddConnection2函数,查查MSDN,参数很简单
NetRESOURCE对象可以自己定义:
Private Type NETRESOURCE
dwScope As Long
dwType As Long
dwDisplayType As Long
dwUsage As Long
pLocalName As Long
pRemoteName As Long
pComment As Long
pProvider As Long
End Type
使用WinSock控件可以收发文件,并且不需要源主机提供网络共享。
原理如同一些黑客程序,使用Client/Server方式。
首先在Server主机定义两个Winsock控件,client主机定义一个Winsock控件。
首先把Server主机的一个Winsock控件设置TCP协议及使用的端口号,调用.listen方法。
Client主机的Winsock控件设置服务主机的IP地址和端口号,调用Connect方法。
服务主机的侦听Winsock会收到连接请求,使用Accept(另一个Winsock控件Name)来响应,完成连接的建立。
服务端程序读文件,通过Send方法传送数据,
客户端程序有数据到达后会引发DataArrive事件,在其中调用get方法获取数据,写文件。
完成后两端断开连接,调用Close方法。
映射网络驱动器用WNetAddConnection2函数,查查MSDN,参数很简单
NetRESOURCE对象可以自己定义:
Private Type NETRESOURCE
dwScope As Long
dwType As Long
dwDisplayType As Long
dwUsage As Long
pLocalName As Long
pRemoteName As Long
pComment As Long
pProvider As Long
End Type
使用WinSock控件可以收发文件,并且不需要源主机提供网络共享。
原理如同一些黑客程序,使用Client/Server方式。
首先在Server主机定义两个Winsock控件,client主机定义一个Winsock控件。
首先把Server主机的一个Winsock控件设置TCP协议及使用的端口号,调用.listen方法。
Client主机的Winsock控件设置服务主机的IP地址和端口号,调用Connect方法。
服务主机的侦听Winsock会收到连接请求,使用Accept(另一个Winsock控件Name)来响应,完成连接的建立。
服务端程序读文件,通过Send方法传送数据,
客户端程序有数据到达后会引发DataArrive事件,在其中调用get方法获取数据,写文件。
完成后两端断开连接,调用Close方法。
展开全部
这可是正规的vb编程啊
我那懂这么多
我那懂这么多
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
整个文件夹一起传送有点难度,我撤消我的回答.
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
你要在局域网里传东西,哪有这么麻烦,你直接开一个账号,然后共享一个文件,或者用netmeeting或者其他软件都可以实现局域网的传送
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询