*.*"
.Flags = cdlOFNExplorer Or cdlOFNFileMustExist Or cdlOFNPathMustExist
.InitDir = "d:\"
End With
SendFile.Enabled = False
CloseNamePipe.Enabled = False
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
DisconnectNamedPipe hNamePipe
CloseHandle hFile
CloseHandle hNamePipe
End Sub
Private Sub SendFile_Click()
On Error Resume Next
Dim strFileName$, lpFileSize&, lpFileSizeHigh&, lpFileSizeLeast&, byteEnd() As Byte
Dim strShortName$
CDlg1.ShowOpen
If Err.Number = 32755 Then Exit Sub
strFileName = CDlg1.filename
strShortName = CDlg1.FileTitle
hFile = CreateFile(strFileName, GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0, OPEN_EXISTING, 0, 0)
If hFile = -1 Then
MsgBox "无法打开文件" & strFileName, vbInformation Or vbOKOnly
Exit Sub
End If
lpFileSize = GetFileSize(hFile, lpFileSizeHigh)
If lpFileSize = 0 Then
MsgBox "该文件大小为零，不用发送！", vbInformation Or vbOKOnly
CloseHandle hFile
Exit Sub
End If
lpFileSizeLeast = lpFileSize
byteEnd() = StrConv(strShortName, vbFromUnicode)
ReDim outBuffer(UBound(byteEnd))
ByteCopy byteEnd, outBuffer
WriteFile hNamePipe, byteEnd(0), UBound(byteEnd) + 1, BytesWrited, 0 '发送短文件名
ReDim inBuffer(5)
ReadFile hNamePipe, inBuffer(0), 6, BytesReaded, 0 '读取客户端对话信息
If StrConv(inBuffer, vbUnicode) = "Cancel" Then
MsgBox "客户端保存时选择了取消，发送终止！", vbInformation Or vbOKOnly
CloseHandle hFile
Exit Sub
End If
Label1.Caption = "正在传输中…"
While lpFileSize > 0
If lpFileSize > BufferSize Then
ReDim outBuffer(BufferSize - 1)
ReadFile hFile, outBuffer(0), BufferSize, BytesReaded, 0
WriteFile hNamePipe, outBuffer(0), BytesReaded, BytesWrited, 0
Else
ReDim outBuffer(lpFileSize - 1)
ReadFile hFile, outBuffer(0), lpFileSize, BytesReaded, 0
WriteFile hNamePipe, outBuffer(0), lpFileSize, BytesWrited, 0
End If
lpFileSize = lpFileSize - BytesReaded
ReadFile hNamePipe, inBuffer(0), 6, BytesReaded, 0
Wend
byteEnd() = StrConv("EOF", vbFromUnicode)
ReDim outBuffer(UBound(byteEnd))
ByteCopy byteEnd, outBuffer
WriteFile hNamePipe, outBuffer(0), 3, BytesWrited, 0
CloseHandle hFile
Label1 = "传送文件完毕！"
End Sub
Public Sub ByteCopy(bySrc() As Byte, byDes() As Byte)
Dim I As Long
For i = LBound(bySrc) To UBound(bySrc)
byDes(i) = bySrc(i)
Next
End Sub
客户端程序（模块中程序和服务器端是一样的，这里省略不写了），Form中有一个Text框，用以输入要打开连接的服务器端的命名管道的名称，一个CommonDialog(CDlg1)控件，另还有一“连接命名管道”（Connect）按钮和“断开连接”（Disconnect）按钮，程序如下：
Dim inBuffer() As Byte, BytesRead&, BytesReaded&, BytesWrited&, strFileName$
Private Sub Connect_Click()
Dim hRes&
strNamePipe = Text1
hRes = WaitNamedPipe(strNamePipe, -1)
If hRes = 0 Then
MsgBox "没有可用的命名管道以供连接！", vbInformation Or vbOKOnly
Exit Sub
End If
hNamePipe = CreateFile(strNamePipe, GENERIC_READ Or GENERIC_WRITE, 0, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
If hNamePipe = 0 Then
MsgBox "无法打开指定的命名管道进行读写！", vbInformation Or vbOKOnly
Exit Sub
End If
FileSave
End Sub
Private Sub Disconnect_Click()
CloseHandle hFile
CloseHandle hNamePipe
End Sub
Private Sub Form_Load()
With CDlg1
.CancelError = True
.DialogTitle = "保存为："
.FileName = ""
' .Filter = "所有文件(*.*)(北联网教程,专业提供视频软件下载)
……