分享
 
 
 

web页通过自写FTP组件上传文件

王朝other·作者佚名  2006-01-09
窄屏简体版  字體: |||超大  

最近因为要做一个视频点播系统,普通的WEB上传没有办法实现300M以上的这么大的传输数据量,想了很久,考虑还是用FTP来传比较好!!!

思路:

一 WEB部分

1 首先把WEB页获得本地要上传的文件名

2 WEB通过脚本把本地文件名(绝对路径)给客户端组件

3 WEB脚本控制组件开始传送数据

4 最后判断是否传输成功

二 组件部分

1 建立INTERNET连接

2 连接FTP服务器

3 获得本地文件名(绝对路径)

4 返回远程即将保存的文件名

5 传送数据

6 判断是否传输成功,返回状态

WEB页获取本地文件

组件返回远程文件名

组件传送数据

返回

本例在VB6.0 +WIN2000+ IIS5.0 + SERV-U 5.0 下调试成功

VB部分

一、建立一个ActiveX DLL工程

二、更改工程名FtpConn

三、更改类名:clsPutFile

四、加入一个空模块到工程中,此模块主要对需要使用的函数进行声明,在此不多做解释,代码如下:

Option Explicit

Declare Function GetProcessHeap Lib "kernel32" () As Long

Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long

Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long

Public Const HEAP_ZERO_MEMORY = &H8

Public Const HEAP_GENERATE_EXCEPTIONS = &H4

Declare Sub CopyMemory1 Lib "kernel32" Alias "RtlMoveMemory" ( _

hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)

Declare Sub CopyMemory2 Lib "kernel32" Alias "RtlMoveMemory" ( _

hpvDest As Long, hpvSource As Any, ByVal cbCopy As Long)

Public Const MAX_PATH = 260

Public Const NO_ERROR = 0

Public Const FILE_ATTRIBUTE_READONLY = &H1

Public Const FILE_ATTRIBUTE_HIDDEN = &H2

Public Const FILE_ATTRIBUTE_SYSTEM = &H4

Public Const FILE_ATTRIBUTE_DIRECTORY = &H10

Public Const FILE_ATTRIBUTE_ARCHIVE = &H20

Public Const FILE_ATTRIBUTE_NORMAL = &H80

Public Const FILE_ATTRIBUTE_TEMPORARY = &H100

Public Const FILE_ATTRIBUTE_COMPRESSED = &H800

Public Const FILE_ATTRIBUTE_OFFLINE = &H1000

Type FILETIME

dwLowDateTime As Long

dwHighDateTime As Long

End Type

Type WIN32_FIND_DATA

dwFileAttributes As Long

ftCreationTime As FILETIME

ftLastAccessTime As FILETIME

ftLastWriteTime As FILETIME

nFileSizeHigh As Long

nFileSizeLow As Long

dwReserved0 As Long

dwReserved1 As Long

cFileName As String * MAX_PATH

cAlternate As String * 14

End Type

Public Const ERROR_NO_MORE_FILES = 18

Public Declare Function InternetFindNextFile Lib "wininet.dll" Alias "InternetFindNextFileA" _

(ByVal hFind As Long, lpvFindData As WIN32_FIND_DATA) As Long

Public Declare Function FtpFindFirstFile Lib "wininet.dll" Alias "FtpFindFirstFileA" _

(ByVal hFtpSession As Long, ByVal lpszSearchFile As String, _

lpFindFileData As WIN32_FIND_DATA, ByVal dwFlags As Long, ByVal dwContent As Long) As Long

Public Declare Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" _

(ByVal hFtpSession As Long, ByVal lpszRemoteFile As String, _

ByVal lpszNewFile As String, ByVal fFailIfExists As Boolean, ByVal dwFlagsAndAttributes As Long, _

ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean

Public Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" _

(ByVal hFtpSession As Long, ByVal lpszLocalFile As String, _

ByVal lpszRemoteFile As String, _

ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean

Public Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" _

(ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean

' Initializes an application's use of the Win32 Internet functions

Public Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" _

(ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, _

ByVal sProxyBypass As String, ByVal lFlags As Long) As Long

' User agent constant.

Public Const scUserAgent = "vb wininet"

' Use registry access settings.

Public Const INTERNET_OPEN_TYPE_PRECONFIG = 0

Public Const INTERNET_OPEN_TYPE_DIRECT = 1

Public Const INTERNET_OPEN_TYPE_PROXY = 3

Public Const INTERNET_INVALID_PORT_NUMBER = 0

Public Const FTP_TRANSFER_TYPE_ASCII = &H1

Public Const FTP_TRANSFER_TYPE_BINARY = &H1

Public Const INTERNET_FLAG_PASSIVE = &H8000000

' Opens a HTTP session for a given site.

Public Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" _

(ByVal hInternetSession As Long, ByVal sServerName As String, ByVal nServerPort As Integer, _

ByVal sUsername As String, ByVal sPassword As String, ByVal lService As Long, _

ByVal lFlags As Long, ByVal lContext As Long) As Long

Public Const ERROR_INTERNET_EXTENDED_ERROR = 12003

Public Declare Function InternetGetLastResponseInfo Lib "wininet.dll" Alias "InternetGetLastResponseInfoA" ( _

lpdwError As Long, _

ByVal lpszBuffer As String, _

lpdwBufferLength As Long) As Boolean

' Number of the TCP/IP port on the server to connect to.

Public Const INTERNET_DEFAULT_FTP_PORT = 21

Public Const INTERNET_DEFAULT_GOPHER_PORT = 70

Public Const INTERNET_DEFAULT_HTTP_PORT = 80

Public Const INTERNET_DEFAULT_HTTPS_PORT = 443

Public Const INTERNET_DEFAULT_SOCKS_PORT = 1080

Public Const INTERNET_OPTION_CONNECT_TIMEOUT = 2

Public Const INTERNET_OPTION_RECEIVE_TIMEOUT = 6

Public Const INTERNET_OPTION_SEND_TIMEOUT = 5

Public Const INTERNET_OPTION_USERNAME = 28

Public Const INTERNET_OPTION_PASSWORD = 29

Public Const INTERNET_OPTION_PROXY_USERNAME = 43

Public Const INTERNET_OPTION_PROXY_PASSWORD = 44

' Type of service to access.

Public Const INTERNET_SERVICE_FTP = 1

Public Const INTERNET_SERVICE_GOPHER = 2

Public Const INTERNET_SERVICE_HTTP = 3

' Opens an HTTP request handle.

Public Declare Function HttpOpenRequest Lib "wininet.dll" Alias "HttpOpenRequestA" _

(ByVal hHttpSession As Long, ByVal sVerb As String, ByVal sObjectName As String, ByVal sVersion As String, _

ByVal sReferer As String, ByVal something As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long

' Brings the data across the wire even if it locally cached.

Public Const INTERNET_FLAG_RELOAD = &H80000000

Public Const INTERNET_FLAG_KEEP_CONNECTION = &H400000

Public Const INTERNET_FLAG_MULTIPART = &H200000

Public Const GENERIC_READ = &H80000000

Public Const GENERIC_WRITE = &H40000000

' Sends the specified request to the HTTP server.

Public Declare Function HttpSendRequest Lib "wininet.dll" Alias "HttpSendRequestA" (ByVal _

hHttpRequest As Long, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal sOptional As _

String, ByVal lOptionalLength As Long) As Integer

' Queries for information about an HTTP request.

Public Declare Function HttpQueryInfo Lib "wininet.dll" Alias "HttpQueryInfoA" _

(ByVal hHttpRequest As Long, ByVal lInfoLevel As Long, ByRef sBuffer As Any, _

ByRef lBufferLength As Long, ByRef lIndex As Long) As Integer

' The possible values for the lInfoLevel parameter include:

Public Const HTTP_QUERY_CONTENT_TYPE = 1

Public Const HTTP_QUERY_CONTENT_LENGTH = 5

Public Const HTTP_QUERY_EXPIRES = 10

Public Const HTTP_QUERY_LAST_MODIFIED = 11

Public Const HTTP_QUERY_PRAGMA = 17

Public Const HTTP_QUERY_VERSION = 18

Public Const HTTP_QUERY_STATUS_CODE = 19

Public Const HTTP_QUERY_STATUS_TEXT = 20

Public Const HTTP_QUERY_RAW_HEADERS = 21

Public Const HTTP_QUERY_RAW_HEADERS_CRLF = 22

Public Const HTTP_QUERY_FORWARDED = 30

Public Const HTTP_QUERY_SERVER = 37

Public Const HTTP_QUERY_USER_AGENT = 39

Public Const HTTP_QUERY_SET_COOKIE = 43

Public Const HTTP_QUERY_REQUEST_METHOD = 45

Public Const HTTP_STATUS_DENIED = 401

Public Const HTTP_STATUS_PROXY_AUTH_REQ = 407

' Add this flag to the about flags to get request header.

Public Const HTTP_QUERY_FLAG_REQUEST_HEADERS = &H80000000

Public Const HTTP_QUERY_FLAG_NUMBER = &H20000000

' Reads data from a handle opened by the HttpOpenRequest function.

Public Declare Function InternetReadFile Lib "wininet.dll" _

(ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, _

lNumberOfBytesRead As Long) As Integer

Public Declare Function InternetWriteFile Lib "wininet.dll" _

(ByVal hFile As Long, ByVal sBuffer As String, _

ByVal lNumberOfBytesToRead As Long, _

lNumberOfBytesRead As Long) As Integer

Public Declare Function FtpOpenFile Lib "wininet.dll" Alias _

"FtpOpenFileA" (ByVal hFtpSession As Long, _

ByVal sFileName As String, ByVal lAccess As Long, _

ByVal lFlags As Long, ByVal lContext As Long) As Long

Public Declare Function FtpDeleteFile Lib "wininet.dll" _

Alias "FtpDeleteFileA" (ByVal hFtpSession As Long, _

ByVal lpszFileName As String) As Boolean

Public Declare Function InternetSetOption Lib "wininet.dll" Alias "InternetSetOptionA" _

(ByVal hInternet As Long, ByVal lOption As Long, ByRef sBuffer As Any, ByVal lBufferLength As Long) As Integer

Public Declare Function InternetSetOptionStr Lib "wininet.dll" Alias "InternetSetOptionA" _

(ByVal hInternet As Long, ByVal lOption As Long, ByVal sBuffer As String, ByVal lBufferLength As Long) As Integer

' Closes a single Internet handle or a subtree of Internet handles.

Public Declare Function InternetCloseHandle Lib "wininet.dll" _

(ByVal hInet As Long) As Integer

' Queries an Internet option on the specified handle

Public Declare Function InternetQueryOption Lib "wininet.dll" Alias "InternetQueryOptionA" _

(ByVal hInternet As Long, ByVal lOption As Long, ByRef sBuffer As Any, ByRef lBufferLength As Long) As Integer

' Returns the version number of Wininet.dll.

Public Const INTERNET_OPTION_VERSION = 40

' Contains the version number of the DLL that contains the Windows Internet

' functions (Wininet.dll). This structure is used when passing the

' INTERNET_OPTION_VERSION flag to the InternetQueryOption function.

Public Type tWinInetDLLVersion

lMajorVersion As Long

lMinorVersion As Long

End Type

' Adds one or more HTTP request headers to the HTTP request handle.

Public Declare Function HttpAddRequestHeaders Lib "wininet.dll" Alias "HttpAddRequestHeadersA" _

(ByVal hHttpRequest As Long, ByVal sHeaders As String, ByVal lHeadersLength As Long, _

ByVal lModifiers As Long) As Integer

' Flags to modify the semantics of this function. Can be a combination of these values:

' Adds the header only if it does not already exist; otherwise, an error is returned.

Public Const HTTP_ADDREQ_FLAG_ADD_IF_NEW = &H10000000

' Adds the header if it does not exist. Used with REPLACE.

Public Const HTTP_ADDREQ_FLAG_ADD = &H20000000

' Replaces or removes a header. If the header value is empty and the header is found,

' it is removed. If not empty, the header value is replaced

Public Const HTTP_ADDREQ_FLAG_REPLACE = &H80000000

五、输入类代码,代码如下:

Option Explicit

Dim bActiveSession As Boolean

Dim hOpen As Long

Dim hConnection As Long

Dim scUserAgent As String

Dim strServer As String

Dim strUser As String

Dim strPassword As String

Dim nFlag As Long

Dim bRet As Boolean

Dim szFileLocal As String

Dim szFileRemote As String

Dim dwType As Integer

Public Function PUTFILE() As Boolean

On Error Resume Next

hOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)

hConnection = InternetConnect(hOpen, strServer, INTERNET_INVALID_PORT_NUMBER, strUser, strPassword, INTERNET_SERVICE_FTP, nFlag, 0)

bRet = FtpPutFile(hConnection, szFileLocal, szFileRemote, _

dwType, 0)

Call CloseConn

PUTFILE = bRet

End Function

Sub CloseConn()

If hConnection <> 0 Then InternetCloseHandle hConnection

hConnection = 0

End Sub

Function getRemoteName(filename)

Dim arrName() As String

arrName = Split(filename, ".")

Randomize

getRemoteName = Date & CInt(Rnd * 1000) & "." & arrName(UBound(arrName))

End Function

Private Sub Class_Initialize()

scUserAgent = "My FTP"

strServer = "www.XXX.cn"

strUser = "Username"

strPassword = "Password"

nFlag = INTERNET_FLAG_PASSIVE

szFileLocal = "DefultLocalFileName"

szFileRemote = "DefultRemoteFileName"

dwType = 1

End Sub

Public Property Get connServer() As Variant

connServer = strServer

End Property

Public Property Let connServer(ByVal vNewValue As Variant)

strServer = vNewValue

End Property

Public Property Get connUser() As Variant

connUser = strUser

End Property

Public Property Let connUser(ByVal vNewValue As Variant)

strUser = vNewValue

End Property

Public Property Get connPassword() As Variant

connPassword = strPassword

End Property

Public Property Let connPassword(ByVal vNewValue As Variant)

strPassword = vNewValue

End Property

Public Property Let LocalFileName(ByVal vNewValue As Variant)

szFileLocal = vNewValue

szFileRemote = getRemoteName(vNewValue)

End Property

Public Property Get RemoteFileName() As Variant

RemoteFileName = szFileRemote

End Property

六、生成DLL

七、使用VB6的打包工具打包成“Internet ActiveX 安装包”,这是,VB打包后,还会给一个例子的HTML文件

八、建立HTML文件

<HTML>

<HEAD>

<TITLE>FtpConn.CAB</TITLE>

</HEAD>

<BODY>

<OBJECT ID="clsPutFile"

CLASSID="CLSID:D9BACC8F-0A99-46DA-ADA3-F1C25A48AA78"

CODEBASE="FtpConn.CAB#version=1,0,0,0">

</OBJECT>

<INPUT type="file" name="FileName"><button onclick="go()">GO~!</button>

<SCRIPT LANGUAGE="JavaScript">

<!-- by Newrocky 2004-12-7 QQ:1936234

function go()

{

if (FileName.value!='')

{

clsPutFile.LocalFileName=FileName.value;

alert(clsPutFile.RemoteFileName);//查看远程文件名

if (clsPutFile.PutFile()) //开始传送文件,如果返回true则成功,反之失败

{

alert('上传文件成功!');

}

else

{

alert('上传文件失败!')

}

}

else

{

alert('请选择您要上传的文件');

}

}

//-->

</SCRIPT>

</BODY>

</HTML>

ok~!

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有