Posted on 2007-01-24 16:27
随心所欲 阅读(1268)
评论(0) 编辑 收藏 网摘 所属分类:
VB6
vb6的INet控件非常不好用。
1:功能有限。
比方说,从服务器端得到文件的修改时间和大小,这样的功能就没有。
2:不稳定
出的错误莫名其妙
3:返回的信息有错误
就像inet.execute ‘put .. ..’之类的命令,找不到失败的消息,网线都拔掉了,居然也不报错。
网上有其他的控件,但是好像不是免费的。
最后,还是选择了直接调用API函数来解决。
这是英文原文:http://support.microsoft.com/default.aspx?scid=kb;en-us;195653
具体的做法很简单(代码来源于上文)
1:获取API

API
1
Option Explicit
2
Public Const MAX_PATH = 260
3
Public Const INTERNET_FLAG_RELOAD = &H80000000
4
Public Const NO_ERROR = 0
5
Public Const FILE_ATTRIBUTE_READONLY = &H1
6
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
7
Public Const FILE_ATTRIBUTE_SYSTEM = &H4
8
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
9
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
10
Public Const FILE_ATTRIBUTE_NORMAL = &H80
11
Public Const FILE_ATTRIBUTE_TEMPORARY = &H100
12
Public Const FILE_ATTRIBUTE_COMPRESSED = &H800
13
Public Const FILE_ATTRIBUTE_OFFLINE = &H1000
14
Public Const INTERNET_FLAG_PASSIVE = &H8000000
15
Public Const FORMAT_MESSAGE_FROM_HMODULE = &H800
16
17
Type WIN32_FIND_DATA
18
dwFileAttributes As Long
19
ftCreationTime As Currency
20
ftLastAccessTime As Currency
21
ftLastWriteTime As Currency
22
nFileSizeHigh As Long
23
nFileSizeLow As Long
24
dwReserved0 As Long
25
dwReserved1 As Long
26
cFileName As String * MAX_PATH
27
cAlternate As String * 14
28
End Type
29
30
31
Public Const ERROR_NO_MORE_FILES = 18
32
33
Public Declare Function InternetFindNextFile()Function InternetFindNextFile Lib "wininet.dll" Alias "InternetFindNextFileA" _
34
(ByVal hFind As Long, lpvFindData As WIN32_FIND_DATA) As Long
35
36
Public Declare Function FtpFindFirstFile()Function FtpFindFirstFile Lib "wininet.dll" Alias "FtpFindFirstFileA" _
37
(ByVal hFtpSession As Long, ByVal lpszSearchFile As String, _
38
lpFindFileData As WIN32_FIND_DATA, ByVal dwFlags As Long, ByVal dwContent As Long) As Long
39
40
Declare Function FileTimeToLocalFileTime()Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As Any, lpLocalFileTime As Any) As Long
41
42
Public Const INTERNET_OPEN_TYPE_PRECONFIG = 0
43
Public Const INTERNET_INVALID_PORT_NUMBER = 0
44
Public Const INTERNET_SERVICE_FTP = 1
45
Public Const FTP_TRANSFER_TYPE_BINARY = &H2
46
Public Const FTP_TRANSFER_TYPE_ASCII = &H1
47
48
Public Declare Function FtpSetCurrentDirectory()Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" _
49
(ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
50
51
Public Declare Function FtpGetCurrentDirectory()Function FtpGetCurrentDirectory Lib "wininet.dll" Alias "FtpGetCurrentDirectoryA" _
52
(ByVal hFtpSession As Long, ByVal lpszCurrentDirectory As String, lpdwCurrentDirectory As Long) As Boolean
53
54
Public Declare Function InternetWriteFile()Function InternetWriteFile Lib "wininet.dll" _
55
(ByVal hFile As Long, ByRef sBuffer As Byte, ByVal lNumBytesToWite As Long, _
56
dwNumberOfBytesWritten As Long) As Integer
57
58
Public Declare Function FtpOpenFile()Function FtpOpenFile Lib "wininet.dll" Alias "FtpOpenFileA" _
59
(ByVal hFtpSession As Long, ByVal sBuff As String, ByVal Access As Long, ByVal Flags As Long, ByVal Context As Long) As Long
60
61
Public Declare Function FtpPutFile()Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" _
62
(ByVal hFtpSession As Long, ByVal lpszLocalFile As String, _
63
ByVal lpszRemoteFile As String, _
64
ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean
65
66
67
68
69
Public Declare Function FtpDeleteFile()Function FtpDeleteFile Lib "wininet.dll" _
70
Alias "FtpDeleteFileA" (ByVal hFtpSession As Long, _
71
ByVal lpszFileName As String) As Boolean
72
Public Declare Function InternetCloseHandle()Function InternetCloseHandle Lib "wininet.dll" _
73
(ByVal hInet As Long) As Long
74
75
Public Declare Function InternetOpen()Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" _
76
(ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, _
77
ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
78
79
Public Declare Function InternetConnect()Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" _
80
(ByVal hInternetSession As Long, ByVal sServerName As String, ByVal nServerPort As Integer, _
81
ByVal sUsername As String, ByVal sPassword As String, ByVal lService As Long, _
82
ByVal lFlags As Long, ByVal lContext As Long) As Long
83
84
85
Public Declare Function FtpGetFile()Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" _
86
(ByVal hFtpSession As Long, ByVal lpszRemoteFile As String, _
87
ByVal lpszNewFile As String, ByVal fFailIfExists As Boolean, ByVal dwFlagsAndAttributes As Long, _
88
ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean
89
90
91
Const rDayZeroBias As Double = 109205# ' Abs(CDbl(#01-01-1601#))
92
Const rMillisecondPerDay As Double = 10000000# * 60# * 60# * 24# / 10000#
93
94
Declare Function InternetGetLastResponseInfo()Function InternetGetLastResponseInfo Lib "wininet.dll" _
95
Alias "InternetGetLastResponseInfoA" _
96
(ByRef lpdwError As Long, _
97
ByVal lpszErrorBuffer As String, _
98
ByRef lpdwErrorBufferLength As Long) As Boolean
99
100
Declare Function FormatMessage()Function FormatMessage Lib "kernel32" Alias "FormatMessageA" _
101
(ByVal dwFlags As Long, ByVal lpSource As Long, ByVal dwMessageId As Long, _
102
ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, _
103
Arguments As Long) As Long
104
105
Declare Function GetModuleHandle()Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpLibFileName As String) As Long
106
107
108
Function Win32ToVbTime()Function Win32ToVbTime(ft As Currency) As Date
109
110
Dim ftl As Currency
111
112
' Call API to convert from UTC time to local time
113
If FileTimeToLocalFileTime(ft, ftl) Then
114
115
' Local time is nanoseconds since 01-01-1601
116
117
' In Currency that comes out as milliseconds
118
119
' Divide by milliseconds per day to get days since 1601
120
121
' Subtract days from 1601 to 1899 to get VB Date equivalent
122
123
Win32ToVbTime = CDate((ftl / rMillisecondPerDay) - rDayZeroBias)
124
125
Else
126
127
MsgBox Err.LastDllError
128
129
End If
130
131
End Function
132
133
134
2:几个常用命令
连接命令:
If hConnection <> 0 Then
InternetCloseHandle hConnection
End If
hConnection = InternetConnect(hOpen, strFTPIP, INTERNET_INVALID_PORT_NUMBER, strUser, strPass, INTERNET_SERVICE_FTP, dwSeman, 0)
If hConnection = 0 Then
ErrorOut Err.LastDllError, "InternetConnect"
Exit Sub
Else
Put命令:
If (FtpPutFile(hConnection, strLocalFile,strRemoteFile, dwType, 0) = False) Then
ErrorOut Err.LastDllError, "FtpPutFile"
Exit Sub
Else
others :
FtpGetCurrentDirectory
FtpSetCurrentDirectory
FtpFindFirstFile
InternetFindNextFile
FtpGetFile