[控件]文件HTTP上传和下载

一、实现以下功能：

1 web上文件浏览、过滤、选取多个文件。

2 web上文件上传和下载。
3获取本地机器MAC地址。
4文件内容获取。

二、控件代码

1 FileDialog.cls

Option Explicit

'**模 块 名：FileDialog

Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
Flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

Private Type CHOOSECOLOR
lStructSize As Long
hwndOwner As Long
hInstance As Long
rgbResult As Long
lpCustColors As Long
Flags As Long
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

Private Declare Function ChooseColorA Lib "comdlg32.dll" (pChoosecolor As CHOOSECOLOR) As Long
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (lpOFN As OPENFILENAME) As Long
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (lpOFN As OPENFILENAME) As Long

Public Enum FlagConstants
OFN_READONLY = &H1
OFN_OVERWRITEPROMPT = &H2
OFN_HIDEREADONLY = &H4
OFN_NOCHANGEDIR = &H8
OFN_SHOWHELP = &H10
OFN_ENABLEHOOK = &H20
OFN_ENABLETEMPLATE = &H40
OFN_ENABLETEMPLATEHANDLE = &H80
OFN_NOVALIDATE = &H100
OFN_ALLOWMULTISELECT = &H200
OFN_EXTENSIONDIFFERENT = &H400
OFN_PATHMUSTEXIST = &H800
OFN_FILEMUSTEXIST = &H1000
OFN_CREATEPROMPT = &H2000
OFN_SHAREAWARE = &H4000
OFN_NOREADONLYRETURN = &H8000
OFN_NOTESTFILECREATE = &H10000
OFN_NONETWORKBUTTON = &H20000
OFN_NOLONGNAMES = &H40000
OFN_EXPLORER = &H80000
OFN_NODEREFERENCELINKS = &H100000
OFN_LONGNAMES = &H200000
End Enum

Private CC As CHOOSECOLOR
Private OFN As OPENFILENAME

Public Color As Long
Public DialogTitle As String
Public DefaultExt As String
Public FileName As String
Public Filter As String
Public FilterIndex As Long
Public Flags As FlagConstants
Public InitDir As String

Sub ShowColor(ByVal hwndOwner As Long)
Dim lngRet As Long
CC.lStructSize = Len(CC)
CC.hwndOwner = hwndOwner
CC.rgbResult = Color
lngRet = ChooseColorA(CC)
If lngRet Then
'Color = CC.rgbResult
End If
End Sub

Sub ShowOpen(ByVal hwndOwner As Long)
Show hwndOwner
End Sub

Sub ShowSave(ByVal hwndOwner As Long)
Show hwndOwner, True
End Sub

Private Sub Show(ByVal hwndOwner As Long, Optional ByVal blnSave As Boolean)

Dim sFileName As String

sFileName = FileName & String(1024, vbNullChar)
With OFN
.lStructSize = Len(OFN)
.hwndOwner = hwndOwner
.lpstrFilter = Replace(Filter, "|", vbNullChar) & vbNullChar & vbNullChar
.nFilterIndex = FilterIndex
.lpstrFile = sFileName
.nMaxFile = Len(sFileName)
.lpstrInitialDir = InitDir
.lpstrTitle = DialogTitle
.Flags = Flags
.lpstrDefExt = DefaultExt
End With

Dim iNull As Integer, lngRet As Long
If blnSave Then
lngRet = GetSaveFileName(OFN)
Else
lngRet = GetOpenFileName(OFN)
End If
If lngRet Then
iNull = InStr(OFN.lpstrFile, vbNullChar & vbNullChar)
If iNull Then
FileName = Left$(OFN.lpstrFile, iNull - 1)
Else
FileName = OFN.lpstrFile
End If
Else
FileName = ""
End If
End Sub

2 modCommon.bas

'*************************************************************************
'**模 块 名：modCommon
'**说 明：版权所有2006 - 2007(C)
'**创 建 人：陈格生
'**日 期：2006-03-07 16:20:56
'**修 改 人：
'**日 期：
'**描 述：
'**版 本：V1.0.0
'*************************************************************************
Option Explicit

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

'*************************************************************************
'**函 数 名：StrLeft
'**输 入：ByVal strMain(String) - 主字符串
'** ：ByVal strSep(String) - 子字符串
'**输 出：(String) - 字符串
'**功能描述：取字符串strMain中第一个strSep左边的字符串
'**全局变量：
'**调用模块：
'**作 者：陈格生
'**日 期：2006-03-07 16:21:36
'**修 改 人：
'**日 期：
'**版 本：V1.0.0
'*************************************************************************
Function StrLeft(ByVal strMain As String, ByVal strSep As String) As String
Dim intPos As Integer
intPos = InStr(strMain, strSep)
If intPos Then
StrLeft = Left$(strMain, intPos - 1)
End If
End Function

'*************************************************************************
'**函 数 名：StrLeftBack
'**输 入：ByVal strMain(String) - 主字符串
'** ：ByVal strSep(String) - 子字符串
'**输 出：(String) - 字符串
'**功能描述：取字符串strMain中最后一个strSep左边的字符串
'**全局变量：
'**调用模块：
'**作 者：陈格生
'**日 期：2006-03-07 16:25:24
'**修 改 人：
'**日 期：
'**版 本：V1.0.0
'*************************************************************************
Function StrLeftBack(ByVal strMain As String, ByVal strSep As String) As String
Dim intPos As Integer
'获取最后一个strSep的位置
intPos = InStrRev(strMain, strSep)
If intPos Then
StrLeftBack = Left$(strMain, intPos - 1)
End If
End Function

'*************************************************************************
'**函 数 名：StrRight
'**输 入：ByVal strMain(String) - 主字符串
'** ：ByVal strSep(String) - 子字符串
'**输 出：(String) - 字符串
'**功能描述：取字符串strMain中第一个strSep右边的字符串
'**全局变量：
'**调用模块：
'**作 者：陈格生
'**日 期：2006-03-07 16:26:31
'**修 改 人：
'**日 期：
'**版 本：V1.0.0
'*************************************************************************
Function StrRight(ByVal strMain As String, ByVal strSep As String) As String
Dim intPos As Integer
intPos = InStr(strMain, strSep)
If intPos Then
StrRight = Mid$(strMain, intPos + Len(strSep))
End If
End Function

'*************************************************************************
'**函 数 名：StrRightBack
'**输 入：ByVal strMain(String) - 主字符串
'** ：ByVal strSep(String) - 子字符串
'**输 出：(String) - 字符串
'**功能描述：取字符串strMain中最后一个strSep右边的字符串
'**全局变量：
'**调用模块：
'**作 者：陈格生
'**日 期：2006-03-07 16:27:23
'**修 改 人：
'**日 期：
'**版 本：V1.0.0
'*************************************************************************
Function StrRightBack(ByVal strMain As String, ByVal strSep As String) As String
Dim intPos As Integer
'获取最后一个strSep的位置
intPos = InStrRev(strMain, strSep)
If intPos Then
StrRightBack = Mid$(strMain, intPos + Len(strSep))
End If
End Function

'*************************************************************************
'**函 数 名：Explode
'**输 入：ByVal strMsg(String) - 主字符串
'** ：strSep(String) - 分隔字符串
'**输 出：字符串数组
'**功能描述：将一个字符串按分隔符分成几个字符串
'**全局变量：
'**调用模块：
'**作 者：陈格生
'**日 期：2006-03-07 16:29:02
'**修 改 人：
'**日 期：
'**版 本：V1.0.0
'*************************************************************************
Function Explode(ByVal strMsg As String, strSep As String)
Dim arrMsg() As String
Dim intCount As Long, intStart As Long, intPos As Long
'从第一个字母开始找
intStart = 1
Do
intPos = InStr(intStart, strMsg, strSep)
If intPos = 0 Then Exit Do
ReDim Preserve arrMsg(intCount)
arrMsg(intCount) = Mid$(strMsg, intStart, intPos - intStart)
intStart = intPos + Len(strSep)
intCount = intCount + 1
Loop
ReDim Preserve arrMsg(intCount)
arrMsg(intCount) = Mid$(strMsg, intStart)
Explode = arrMsg
End Function

'*************************************************************************
'**函 数 名：URLEncode
'**输 入：ByVal strInput(String) - 需编码的字符串
'** ：Optional ByVal blnNoPlus(Boolean) - 转换+号
'**输 出：(String) - 编码后的字符串
'**功能描述：对字符串进行编码
'**全局变量：
'**调用模块：Hex2
'**作 者：陈格生
'**日 期：2006-03-07 16:30:27
'**修 改 人：
'**日 期：
'**版 本：V1.0.0
'*************************************************************************
Public Function URLEncode(ByVal strInput As String, Optional ByVal blnNoPlus As Boolean) As String
Dim strChar As String
Dim intAscii As Integer
Dim i As Long
For i = 1 To Len(strInput)
strChar = Mid$(strInput, i, 1)
intAscii = Asc(strChar)
'处理"0" - "9", "a" - "z", "A" - "Z"
If ((intAscii < 58) And (intAscii > 47)) Or _
((intAscii < 91) And (intAscii > 64)) Or _
((intAscii < 123) And (intAscii > 96)) Then
URLEncode = URLEncode & strChar
Else
URLEncode = URLEncode & Hex2(CLng("&h" & Hex(intAscii)))
End If
Next
If Not blnNoPlus Then
URLEncode = Replace(URLEncode, "%20", "+")
End If
End Function

'*************************************************************************
'**函 数 名：URLDecode
'**输 入：ByVal strInput(String) - 需解码的字符串
'** ：Optional ByVal blnNoPlus(Boolean) - 标识是否转换+号
'**输 出：(String) - 解码后的字符串
'**功能描述：对字符串进行解码
'**全局变量：
'**调用模块：
'**作 者：陈格生
'**日 期：2006-03-07 16:32:47
'**修 改 人：
'**日 期：
'**版 本：V1.0.0
'*************************************************************************
Public Function URLDecode(ByVal strInput As String, Optional ByVal blnNoPlus As Boolean) As String
Dim strChar As String
Dim strAscii As String
Dim intAscii As Integer
Dim i As Long
If Not blnNoPlus Then
strInput = Replace(strInput, "+", " ")
End If
i = 1
Do Until i > Len(strInput)
strChar = Mid$(strInput, i, 1)
If strChar = "%" Then
strChar = strAscii & Mid$(strInput, i + 1, 2)
If IsNumeric("&h" & strChar) Then
Do
intAscii = CInt("&h" & strChar)
If intAscii < &H80 Then
URLDecode = URLDecode & Chr$(intAscii)
strAscii = ""
strChar = ""
Else
strAscii = strChar
strChar = Mid$(strChar, 3)
End If
Loop Until strChar = ""
i = i + 3
End If
End If
If strChar <> "" Then
URLDecode = URLDecode & Mid$(strInput, i, 1)
strAscii = ""
i = i + 1
End If
Loop
End Function

'*************************************************************************
'**函 数 名：Hex2
'**输 入：ByVal lngIn(Long) - 转换长整数
'**输 出：(String) - 转换后的编码
'**功能描述：将长整数转换为16进制编码
'**全局变量：
'**调用模块：
'**作 者：陈格生
'**日 期：2006-03-07 16:32:55
'**修 改 人：
'**日 期：
'**版 本：V1.0.0
'*************************************************************************
Function Hex2(ByVal lngIn As Long) As String
Dim strHex As String, intStart As Integer
strHex = Hex(lngIn)
If Len(strHex) Mod 2 = 1 Then
strHex = "0" & strHex
End If
intStart = 1
Do Until intStart > Len(strHex)
Hex2 = Hex2 & "%" & Mid$(strHex, intStart, 2)
intStart = intStart + 2
Loop
End Function

'*************************************************************************
'**函 数 名：MyMkDir
'**输 入：ByVal strDir(String) - 文件目录字符串
'**输 出：无
'**功能描述：指定路径的各上层目录不存在则需逐个创建
'**全局变量：
'**调用模块：
'**作 者：陈格生
'**日 期：2006-03-07 16:33:07
'**修 改 人：
'**日 期：
'**版 本：V1.0.0
'*************************************************************************
Sub MyMkDir(ByVal strDir As String)
On Error GoTo ErrHandle
Dim i As Integer
Dim strPre As String
i = InStr(strDir, "/")
Do While i
strPre = Left$(strDir, i)
MkDir strPre
i = InStr(i + 1, strDir, "/")
Loop
MkDir strDir
Exit Sub
ErrHandle:
Resume Next
End Sub

3 RJCommon.ctl

Option Explicit

Private Const SEGMENT_LENGTH = 2 ^ 20

'********************************
' 以下为控件属性代码
'********************************

Public Tags
Private gstrServerUrl As String
Private gstrServletPath As String
Private gstrRootPath As String
Private glngMaxFileSize As Long
'浏览文件对话框过滤器
Private gstrFilter As String

'获取服务器Url地址
Public Property Get ServerUrl() As String
ServerUrl = gstrServerUrl
End Property

'设置服务器Url地址
Public Property Let ServerUrl(ByVal strNewValue As String)
gstrServerUrl = strNewValue
End Property

'获取Servlet路径
Public Property Get ServletPath() As String
ServletPath = gstrServletPath
End Property

'设置Servlet路径
Public Property Let ServletPath(ByVal strNewValue As String)
gstrServletPath = strNewValue
End Property

'获取上传目录
Public Property Get RootPath() As String
RootPath = gstrRootPath
End Property

'设置上传目录
Public Property Let RootPath(ByVal strNewValue As String)
gstrRootPath = strNewValue
End Property

'获取上传文件大小限制
Public Property Get MaxFileSize() As Long
MaxFileSize = glngMaxFileSize
End Property

'设置上传文件大小限制
Public Property Let MaxFileSize(ByVal lngNewValue As Long)
glngMaxFileSize = lngNewValue
End Property

'获取浏览文件对话框过滤器
Public Property Get Filter() As String
Filter = gstrFilter
End Property

'设置浏览文件对话框过滤器
Public Property Let Filter(ByVal strNewValue As String)
gstrFilter = strNewValue
End Property

'**************************************
' 以下为控件方法代码
'**************************************

'控件使用实例
'Private Sub Command1_Click()
' Dim strFile As String
' Dim varFile As Variant
'
' 'strFile = FileBrowse1.Browse("所有文件(*.*)|*.*|Word文件(*.doc)|*.doc|Zip文件(*.zip)|*.zip")
' strFile = FileBrowse1.Browse()
' If strFile = "" Then Exit Sub
'
' varFile = Split(strFile, "|")
'
' Dim i As Integer
' strFile = ""
' For i = 1 To UBound(varFile)
' strFile = strFile & IIf(strFile = "", "", vbCrLf) & varFile(0) & "/" & varFile(i)
' Next
' MsgBox strFile
'End Sub

'*************************************************************************
'**函 数 名：Browse
'**输 入：strFilter 所使用文件过滤器，缺省为gstrFilter
'**输 出：String 格式：Path|FileName1|FileName2|……
'**功能描述：浏览本地文件，返回选定文件路径
'**全局变量：gstrFilter，可通过Filter属性设置
'**调用模块：FileDialog类
'**作 者：陈格生
'**日 期：2006-03-05 10:44:00
'**修 改 人：
'**日 期：
'**版 本：V1.0.0
'*************************************************************************
Public Function Browse(Optional ByVal strFilter As String, Optional ByVal blnSingle As Boolean) As String
On Error GoTo ErrHandle
Dim cdlFile As New FileDialog
With cdlFile
'.Filter = "所有文件(*.*)|*.*|Word文件(*.doc)|*.doc|Zip文件(*.zip)|*.zip"
'If strFilter = "" Then strFilter = "所有文件(*.*)|*.*"
'.Filter = strFilter
If strFilter = "" Then
.Filter = gstrFilter
Else
.Filter = strFilter
End If
.FileName = ""
If blnSingle Then
.Flags = OFN_HIDEREADONLY Or OFN_FILEMUSTEXIST Or OFN_EXPLORER
Else
.Flags = OFN_HIDEREADONLY Or OFN_FILEMUSTEXIST Or OFN_ALLOWMULTISELECT Or OFN_EXPLORER
End If
.ShowOpen UserControl.hWnd
If .FileName = "" Then Exit Function
Browse = Replace(.FileName, vbNullChar, "|")
End With
Exit Function
ErrHandle:
If Err.Number <> 32755 Then
MsgBox "浏览本地文件出错！", vbInformation, "Browse"
End If
End Function

'*************************************************************************
'**函 数 名：FileBrowse
'**输 入：strFile 读取文件路径，缺省时选择
'**输 出：String
'**功能描述：返回指定或选定文件内容
'**全局变量：
'**调用模块：FileDialog类
'**作 者：陈格生
'**日 期：2006-03-05 10:44:00
'**修 改 人：
'**日 期：
'**版 本：V1.0.0
'*************************************************************************
Public Function FileBrowse(Optional ByVal strFile As String) As String
On Error GoTo ErrHandle:
If strFile = "" Then
Dim cdlFile As New FileDialog
cdlFile.FileName = ""
cdlFile.Filter = "文本文件(*.txt)|*.txt|所有文件(*.*)|*.*"
cdlFile.Flags = OFN_HIDEREADONLY Or OFN_FILEMUSTEXIST
cdlFile.ShowOpen UserControl.hWnd
If cdlFile.FileName = "" Then Exit Function
strFile = cdlFile.FileName
End If
Dim intFile As Integer
Dim bytFile() As Byte
intFile = FreeFile()
Open strFile For Binary Access Read As #intFile
If LOF(intFile) Then
ReDim bytFile(LOF(intFile) - 1)
Get #intFile, , bytFile
FileBrowse = StrConv(bytFile, vbUnicode)
End If
Close #intFile
Exit Function
ErrHandle:
'ShowNormalError Me, "FileBrowse"
End Function

'*************************************************************************
'**函 数 名：UploadFile
'**输 入：strFile 上传文件的本地路径
'**输 出：String 返回上传后的文件名称
'**功能描述：上传本地文件
'**全局变量：glngMaxFileSize，gstrServerUrl，gstrServletPath
'**调用模块：InitUpload
'**作 者：陈格生
'**日 期：2006-03-05 10:44:00
'**修 改 人：
'**日 期：
'**版 本：V1.0.0
'*************************************************************************
Public Function UploadFile(ByVal strFile As String) As String
On Error GoTo ErrHandle:
'If gstrServerUrl = "" Then InitUpload
'If Not gblnInitilized Then InitSystemPara
If FileLen(strFile) > glngMaxFileSize Then
'ShowNormalError Me, "文件大小超过 " & glngMaxFileSize & " 字节 ，不允许上传！"
MsgBox "文件大小超过 " & glngMaxFileSize & " 字节 ，不允许上传！", vbExclamation + vbOKOnly, "警告"
Exit Function
End If

Dim intPointer As Integer
intPointer = Screen.MousePointer
Screen.MousePointer = vbArrowHourglass

Dim strURL As String
strURL = gstrServerUrl & gstrServletPath
Dim intFile As Integer, lngLength As Long
Dim lngStart As Long, lngLeft As Long
Dim xmlhttp, strName As String
Dim vData, lngSend As Long, strResponse As String
Set xmlhttp = CreateObject("Microsoft.XMLHTTP")
strName = URLEncode(Mid(strFile, InStrRev(strFile, "/") + 1))
intFile = FreeFile()
Open strFile For Binary As #intFile
Do
lngLeft = LOF(intFile) - lngStart
If lngLeft <= 0 Then Exit Do
lngLength = IIf(lngLeft > SEGMENT_LENGTH, SEGMENT_LENGTH, lngLeft)
ReDim bytData(lngLength - 1) As Byte
Get #intFile, , bytData
vData = bytData
xmlhttp.Open "POST", strURL, False
xmlhttp.setRequestHeader "Content-File", strName
If lngStart > 0 Then
xmlhttp.setRequestHeader "Content-Start", lngStart
End If
xmlhttp.Send vData
strResponse = StrConv(xmlhttp.responseBody, vbUnicode)
If Not IsNumeric(strResponse) Then
Screen.MousePointer = intPointer
'ShowNormalError Me, strResponse
Exit Do
Else
lngSend = strResponse
End If
strName = xmlhttp.getResponseHeader("Content-File")
lngStart = lngStart + lngLength
If lngSend <> lngStart Then
Screen.MousePointer = intPointer
'ShowNormalError Me, URLDecode(strName)
Exit Do
End If
Loop
Close #intFile
If lngLeft = 0 Then
UploadFile = URLDecode(strName)
End If

Screen.MousePointer = intPointer
Exit Function
ErrHandle:
Screen.MousePointer = intPointer
'ShowNormalError Me, "UploadFile"
End Function

'*************************************************************************
'**函 数 名：DownloadFile
'**输 入：strURLFile 下载文件URL路径
'** strLocalFile 保存文件的本地路径，缺省路径同服务器
'** blnTrim 是否需要截取文件名称，缺省不截取
'**输 出：String 返回上传后的文件名称
'**功能描述：下载文件到本地
'**全局变量：glngMaxFileSize，gstrServerUrl，gstrServletPath
'**调用模块：InitUpload，RndTrim
'**作 者：陈格生
'**日 期：2006-03-05 10:44:00
'**修 改 人：
'**日 期：
'**版 本：V1.0.0
'*************************************************************************
Public Function DownloadFile(ByVal strURLFile As String, _
Optional ByVal strLocalFile As String, Optional ByVal blnTrim As Boolean) As String
On Error GoTo ErrHandle:
'If gstrServerUrl = "" Then InitUpload
'If Not gblnInitilized Then InitSystemPara
strURLFile = StrLeft(strURLFile & "?", "?")
If InStr(Left$(strURLFile, 7), ":") <= 0 Then
strURLFile = gstrServerUrl & strURLFile
End If
If strLocalFile = "" Then
If Dir(gstrRootPath, vbDirectory) = "" Then MyMkDir gstrRootPath
strLocalFile = gstrRootPath & "/" & StrRightBack(strURLFile, "/")
End If
If blnTrim Then
strLocalFile = RndTrim(strLocalFile)
End If
On Error GoTo ErrOpen:
If Dir(strLocalFile, vbHidden Or vbSystem) <> "" Then
Kill strLocalFile
Sleep 500
End If
On Error GoTo ErrHandle:

Dim intPointer As Integer
intPointer = Screen.MousePointer
Screen.MousePointer = vbHourglass

strURLFile = StrLeftBack(strURLFile, "/") & "/" _
& URLEncode(StrRightBack(strURLFile, "/"), True)
Dim intFile As Integer, lngLength As Long, lngStart As Long
intFile = FreeFile()
Open strLocalFile For Binary Access Write As #intFile

'Debug.Print strURLFile
Dim xmlhttp As Object
Set xmlhttp = CreateObject("Microsoft.XMLHTTP")
Call xmlhttp.Open("HEAD", strURLFile, False)
Call xmlhttp.Send
lngLength = xmlhttp.getResponseHeader("Content-Length")
'Debug.Print xmlhttp.getAllResponseHeaders
Dim bytData() As Byte, strRange As String
Do
Call xmlhttp.Open("GET", strURLFile, False)
strRange = "bytes=" & lngStart & "-"
lngStart = lngStart + SEGMENT_LENGTH
strRange = strRange & (lngStart - 1)
xmlhttp.setRequestHeader "Range", strRange
'Debug.Print strRange
Call xmlhttp.Send
'Debug.Print xmlhttp.getAllResponseHeaders
bytData = xmlhttp.responseBody
Put #intFile, , bytData
Loop While Loc(intFile) < lngLength
If LOF(intFile) = lngLength Then
Close #intFile
DownloadFile = strLocalFile
Else
Close #intFile
Kill strLocalFile
End If
Screen.MousePointer = intPointer
Exit Function
ErrHandle:
Screen.MousePointer = intPointer
If intFile > 0 Then Close #intFile
'ShowNormalError Me, "DownloadFile"
Exit Function
ErrOpen:
Screen.MousePointer = intPointer
Err.Clear
'ShowNormalError Me, "文件“" & strLocalFile & "”已经打开"
End Function

Public Function Escape(ByVal strInput) As String
Escape = URLEncode(strInput, True)
End Function

'***************************************
' 以下为控件中的私有方法代码
'***************************************

Private Sub UserControl_Initialize()
'设置控件大小
imgOCX.Move 0, 0
UserControl.Size imgOCX.Width, imgOCX.Height
'初始化本地文件浏览过滤器
gstrFilter = "所有文件(*.*)|*.*"
'初始化服务器的url地址
gstrServerUrl = "http://127.0.0.1"
'初始化上传文件servlet的url地址
gstrServletPath = "/servlet/UploadFile"
'初始化文件上传目录
gstrRootPath = "C:/Temp"
'初始化设置文件上传大小限制
glngMaxFileSize = SEGMENT_LENGTH
End Sub

Private Sub UserControl_Resize()
UserControl.Size imgOCX.Width, imgOCX.Height
End Sub

三、上传文件的Servlet代码MyUpload.java

import java.io.*;
import java.net.URLEncoder;
import javax.servlet.*;
import javax.servlet.http.*;

public class MyUpload extends HttpServlet
{
public MyUpload()
{
}

public void doGet(HttpServletRequest request,HttpServletResponse response)
{
try {
response.setContentType("text/plain");
response.getOutputStream().println("UploadFile Servlet (版本 1.1.0)");
}
catch(Exception e) {}
}

public void doPost(HttpServletRequest request,HttpServletResponse response)
{
ServletOutputStream sos = null;
DataInputStream dis = null;
RandomAccessFile raf = null;
try {
response.setContentType("text/plain");
sos = response.getOutputStream();
String strFile = request.getHeader("Content-File");
if(strFile==null)
{
strFile = "~upload.tmp";
}else{
strFile = decode(strFile);
if(strFile.startsWith(File.separator)) strFile = strFile.substring(1);
strFile = replaceAll(strFile,".." + File.separator,"");
}
//String strQuery = request.getQueryString();
//String strUploadPath = getParameter(strQuery,"UploadPath");
//if(strUploadPath == null) strUploadPath = "C://Temp//";
String strUploadPath = "C://Temp//";
mkdirall(strUploadPath);
int intLength = request.getContentLength();
int intStart = request.getIntHeader("Content-Start");
if(intStart < 0)
{
strFile = getUniqueFile(strUploadPath,strFile);
intStart = 0;
}
response.setHeader("Content-File",URLEncoder.encode(strFile));
dis = new DataInputStream(request.getInputStream());
raf = new RandomAccessFile(strUploadPath + strFile,"rw");
raf.seek(intStart);
byte bytUpload[] = new byte[1024];
int i;
while((i = dis.read(bytUpload,0,1024)) != -1) raf.write(bytUpload,0,i);
sos.println(raf.length());
}
catch(Exception e)
{
try {
String strError = e.toString() + ": " + e.getMessage();
System.out.println(strError);
e.printStackTrace();
response.setHeader("Content-File",URLEncoder.encode(strError));
sos.println(-1);
}
catch(Exception e1) {}
}
finally
{
try {
raf.close();
}
catch(Exception e2) {}
try {
dis.close();
}
catch(Exception e3) {}
try {
sos.close();
}
catch(Exception e4) {}
}
}

private static String getUniqueFile(String s, String s1)
{
int i = 1;
String s2 = "";
do
{
File file = new File(s + s2 + s1);
if(!file.exists()) break;
s2 = Integer.toString(i++) + File.separator;
} while(true);
if(i > 1) mkdirall(s + s2);
return s2 + s1;
}

private String replaceAll(String s, String s1, String s2)
{
for(int i = s.indexOf(s1); i >= 0; i = s.indexOf(s1, i + s2.length()))
s = s.substring(0, i) + s2 + s.substring(i + s1.length());

return s;
}

private static boolean mkdirall(String s)
{
File file = new File(s);
if(file.isDirectory()) return true;
for(int i = s.indexOf(File.separator); i >= 0; i = s.indexOf(File.separator, i + 1))
{
String s1 = s.substring(0, i);
file = new File(s1);
if(!file.isDirectory()) file.mkdir();
}

return file.isDirectory();
}

private static String decode(String s)
{
StringBuffer strBuffer = new StringBuffer();
for(int i = 0; i < s.length(); i++)
{
char c = s.charAt(i);
switch(c)
{
case 43: // '+'
strBuffer.append(' ');
break;
case 37: // '%'
try
{
strBuffer.append((char)Integer.parseInt(s.substring(i + 1, i + 3), 16));
}
catch(NumberFormatException nfe)
{
throw new IllegalArgumentException();
}
i += 2;
break;
default:
strBuffer.append(c);
break;
}
}

String s1 = strBuffer.toString();
try
{
byte abyte0[] = s1.getBytes("8859_1");
s1 = new String(abyte0);
}
catch(UnsupportedEncodingException uee) { }
return s1;
}

private static String getParameter(String strQuery, String strPara)
{
if(strQuery == null) return null;
strQuery = "&" + strQuery;
int i, j;
if((i = strQuery.toLowerCase().indexOf("&" + strPara.toLowerCase() + "=")) != -1)
{
i += strPara.length() + 2;
if((j = strPara.indexOf(38, i)) != -1)
return strPara.substring(i, j);
else
return strPara.substring(i);
} else
{
return null;
}
}
}

四、使用示例

<OBJECT ID="RJCommon"
CLASSID="CLSID:461E35C0-3F6E-490E-8EF9-D0D7739403C8"
CODEBASE="RJCommon.CAB#version=1,0,0,0" style="display:none">
</OBJECT>
<input type="text" name="ShowPath" value="" style="width:100%">
<input type="button" value="Browse..." onclick="showPath(document.all.ShowPath)">
<input type="text" name="UploadFile" value="" style="width:100%">
<input type="button" value="Upload JScript" onclick="uploadFile(document.all.ShowPath,document.all.UploadFile)">
<input type="button" value="Upload VBScript" name="Upload">
<input type="button" value="Upload Test" name="Test">
<input type="text" name="DownloadFile" value="" style="width:100%">
<input type="button" value="Download File" onclick="DownloadFile(document.all.DownloadFile)">
<input type="text" name="MacAddress" value="" style="width:100%">
<input type="button" value="Mac Address" onclick="getMacAddress(document.all.MacAddress)">
<textarea type="text" name="ShowFile" value="" style="width:100%;height:200px"></textarea>
<input type="button" value="View File" onclick="showFile(document.all.ShowFile)">
<script language="javascript">
var ocx=document.all.RJCommon;
//浏览文件，支持文件过滤和选择多个文件
function showPath(src)
{
var strText="";
ocx.Filter="Word文件(*.doc)|*.doc|所有文件(*.*)|*.*";
var strFile=ocx.Browse();
//var strFile=ocx.Browse("Word文件(*.doc)|*.doc|所有文件(*.*)|*.*");
//ocx.Filter="所有文件(*.*)|*.*|Word文件(*.doc)|*.doc|Zip文件(*.zip)|*.zip";
//var strFile=ocx.Browse("Word文件(*.doc)|*.doc|所有文件(*.*)|*.*");
if(strFile=="") return false;
if(strFile.indexOf("|")!=-1)//选定多个文件
{
var varFile = strFile.split("|");
var strPath = varFile[0];
for(var i=1;i<varFile.length;i++)
{
strText += "," + strPath + varFile[i];
}
src.value=strText.substr(1);
}else{//选定单个文件
src.value=strFile;
}
}
//上传文件
function uploadFile(src,obj)
{
var strText="";
var strFile=ocx.Browse();
if(strFile=="") return false;
if(strFile.indexOf("|")!=-1)//选定多个文件
{
var varFile = strFile.split("|");
var strPath = varFile[0];
for(var i=1;i<varFile.length;i++)
{
strFile = ocx.UploadFile(strPath + varFile[i]);
if(strFile!="") strText += "," + strFile;
}
src.value=strText.substr(1);
}else{//选定单个文件
strFile = ocx.UploadFile(strFile);
src.value=strFile;
}
}
//上传测试
function uploadTest()
{
ocx.MaxFileSize=1024;
var strTemp = ocx.UploadFile("C://Flow.cab");
if(strTemp!="")
alert("文件上传成功!" + strTemp);
else
alert("文件上传失败!");
}
//下载文件
function DownloadFile(src)
{
var strUrl = "http://rjdept1:8072/domcfg.nsf/cabs/$file/flow.cab";
var strFile = "C://Flow.cab";
var strTemp = ocx.DownloadFile(strUrl, strFile);
src.value = strTemp;
alert("文件下载成功!");
}
//获取MAC地址
function getMacAddress(src)
{
src.value=ocx.MacAddress;
}
//显示选定文件内容
function showFile(src)
{
var strText="";
var strFile=ocx.FileBrowse();
if(strFile=="") return false;
src.value=strFile;
}
//替换所有字符串
function replaceAll(s, s1, s2)
{
for(var i = s.indexOf(s1); i >= 0; i = s.indexOf(s1, i + s2.length))
s = s.substring(0, i) + s2 + s.substr(i + s1.length);
return s;
}
</script>
<script language="VBScript">
<!--
Sub Upload_onClick
Dim strFile, varFile, strTemp, i
strFile = RJCommon.Browse()
If strFile = "" Then Exit Sub
'设置上传参数
RJCommon.ServerUrl = "http://rjdept1:8072"
RJCommon.ServletPath = "/servlet/MyUpload"
If InStr(strFile, "|") > 0 Then
varFile = Split(strFile, "|")
strFile = ""
For i = 1 To UBound(varFile)
strTemp = varFile(0) & "/" & varFile(i)
strTemp = RJCommon.UploadFile(strTemp)
strFile = strFile & vbCrLf & varFile(0) & "/" & strTemp
Next
Else
strFile = RJCommon.UploadFile(strFile)
End If
If strFile="" Then
MsgBox "上传失败！"
Else
MsgBox "上传成功！"
End If
End Sub
Sub Test_onClick
Dim strFile

strFile=RJCommon.UploadFile("C:/Flow.cab")
If strFile="" Then
MsgBox "上传失败！"
Else
MsgBox "上传成功！"
End If
End Sub
-->
</script>