Public Class ftpApi
Private Declare Function FtpFindFirstFile Lib "wininet.dll" Alias "FtpFindFirstFileA" (ByVal hOutboundSession As Integer, ByVal lpszSearchFile As String, ByRef lpFindFileData As WIN32_FIND_DATA, ByVal dwFlags As Integer, ByVal dwContent As Integer) As Integer
Private Declare Function InternetFindNextFile Lib "wininet.dll" Alias "InternetFindNextFileA" (ByVal hFind As Integer, ByRef lpvFindData As WIN32_FIND_DATA) As Integer
Private Declare Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" (ByVal hOutboundSession As Integer, ByVal lpszRemoteFile As String, ByVal lpszNewFile As String, ByVal fFailIfExists As Boolean, ByVal dwFlagsAndAttributes As Integer, ByVal dwFlags As Integer, ByVal dwContext As Integer) As Boolean
Private Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" (ByVal hOutboundSession As Integer, ByVal lpszLocalFile As String, ByVal lpszRemoteFile As String, ByVal dwFlags As Integer, ByVal dwContext As Integer) As Boolean
Private Declare Function FtpRenameFile Lib "wininet.dll" Alias "FtpRenameFileA" (ByVal hOutboundSession As Integer, ByVal sExistingName As String, ByVal sNewName As String) As Boolean
Private Declare Function FtpDeleteFile Lib "wininet.dll" Alias "FtpDeleteFileA" (ByVal hOutboundSession As Integer, ByVal lpszFileName As String) As Boolean
Private Declare Function FtpGetCurrentDirectory Lib "wininet.dll" Alias "FtpGetCurrentDirectoryA" (ByVal hConnect As Integer, ByVal lpszCurrentDirectory As String, ByRef lpdwCurrentDirectory As Integer) As Integer
Private Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" (ByVal hOutboundSession As Integer, ByVal lpszDirectory As String) As Boolean
Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" (ByVal hInternetSession As Integer, ByVal sServerName As String, ByVal nServerPort As Short, ByVal sUserName As String, ByVal sPassword As String, ByVal lService As Integer, ByVal lFlags As Integer, ByVal lContext As Integer) As Integer
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Integer, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Integer) As Integer
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Integer) As Integer
Private Declare Function InternetGetLastResponseInfo Lib "wininet.dll" Alias "InternetGetLastResponseInfoA" (ByRef lpdwError As Integer, ByVal lpszBuffer As String, ByRef lpdwBufferLength As Integer) As Boolean
' ---------------------------------------------------------
' ------------------- API Functions --------------------
' ---------------------------------------------------------
'文件创建时间
Private Structure FILETIME
Dim dwLowDateTime As Integer
Dim dwHighDateTime As Integer
End Structure
'文件信息
Private Structure WIN32_FIND_DATA
Dim dwFileAttributes As Integer
Dim ftCreationTime As FILETIME
Dim ftLastAccessTime As FILETIME
Dim ftLastWriteTime As FILETIME
Dim nFileSizeHigh As Integer
Dim nFileSizeLow As Integer
Dim dwReserved0 As Integer
Dim dwReserved1 As Integer
<VBFixedString(260), System.Runtime.InteropServices.MarshalAs(System.Runtime.InteropServices.UnmanagedType.ByValTStr, SizeConst:=260)> Public cFileName As String
<VBFixedString(14), System.Runtime.InteropServices.MarshalAs(System.Runtime.InteropServices.UnmanagedType.ByValTStr, SizeConst:=14)> Public cAlternate As String
End Structure
'Wininet.dll API's
' ---------------------------------------------------------
' ---------------- 功能块常量 -----------------
' ---------------------------------------------------------
Private Const FAILURE As Integer = 0
Private Const SUCCESS As Integer = 1
'错误消息
Private Const ERR_CHANGE_DIR As String = "Cannot change directory to <%s>. It either doesn't exist, or is protected"
Private Const ERR_CONNECT_ERROR As String = "Cannot connect to FTP server <%s> using User and Password Parameters"
Private Const ERR_ALREADY_CONNECTED As String = "Cannot change property while connected to FTP server"
Private Const ERR_NO_CONNECTION As String = "Cannot connect to FTP server"
Private Const ERR_DOWNLOAD As String = "Cannot get file <%s> from FTP server"
Private Const ERR_RENAME As String = "Cannot rename file <%s>"
Private Const ERR_DELETE As String = "Cannot delete file <%s> from FTP server"
Private Const ERR_CRITICAL As String = "Cannot get connection to WinInet.dll!"
'Type of service to access
Private Const INTERNET_SERVICE_FTP As Short = 1
'Flags
Private Const INTERNET_FLAG_RELOAD As Integer = &H80000000
Private Const INTERNET_FLAG_KEEP_CONNECTION As Integer = &H400000
Private Const INTERNET_FLAG_MULTIPART As Integer = &H200000
Private Const INTERNET_FLAG_PASSIVE As Integer = &H8000000
Private Const INTERNET_FLAG_NO_CACHE_WRITE As Integer = &H4000000
Private Const INTERNET_FLAG_EXISTING_CONNECT As Integer = &H20000000
'文件传送模式
Private Const FTP_TRANSFER_TYPE_UNKNOWN As Short = &H0S
Private Const FTP_TRANSFER_TYPE_ASCII As Short = &H1S
Private Const FTP_TRANSFER_TYPE_BINARY As Short = &H2S
'其他的
Private Const INTERNET_OPEN_TYPE_DIRECT As Short = 1
Private Const INET_SESSION_NAME As String = "ICB FTP Sesh"
Private Const ERROR_INTERNET_EXTENDED_ERROR As Short = 12003
Private Const NO_CONNECTION As Integer = FAILURE
Private Const FWDSLASH As String = "/"
Private Const BACKSLASH As String = "/"
' ---------------------------------------------------------
' ---------------- 功能块变量 -----------------
' ---------------------------------------------------------
'INET 句柄
Private m_hInet As Integer
'FTP 连接句柄
Private m_hSession As Integer
' FTP 规则
Private m_HostAddr As String
Private m_HostPort As Integer
Private m_User As String
Private m_Password As String
Private m_Dir As String
' ---------------------------------------------------------
' ------------------ 自定义类型 -------------------
' ---------------------------------------------------------
Public Enum FtpError
ERR_CANNOT_CONNECT = vbObjectError + 2001
ERR_NO_DIR_CHANGE = vbObjectError + 2002
ERR_CANNOT_RENAME = vbObjectError + 2003
ERR_CANNOT_DELETE = vbObjectError + 2004
ERR_NOT_CONNECTED_TO_SITE = vbObjectError + 2005
ERR_CANNOT_GET_FILE = vbObjectError + 2006
ERR_INVALID_PROPERTY = vbObjectError + 2007
ERR_FATAL = vbObjectError + 2008
End Enum
'文件传送类型
Public Enum FileTransferType
fttUnknown = FTP_TRANSFER_TYPE_UNKNOWN
fttAscii = FTP_TRANSFER_TYPE_ASCII
fttBinary = FTP_TRANSFER_TYPE_BINARY
End Enum
'________________________________________________________________________
Private Sub Class_Initialize_Renamed()
'初始化变量
m_hSession = NO_CONNECTION
m_hInet = NO_CONNECTION
m_HostAddr = vbNullString
m_HostPort = FAILURE
m_User = vbNullString
m_Password = vbNullString
m_Dir = vbNullString
End Sub
'________________________________________________________________________
Private Sub Class_Terminate_Renamed()
'关闭连接
If m_hSession Then InternetCloseHandle(m_hSession)
'关闭 API 句柄
If m_hInet Then InternetCloseHandle(m_hInet)
m_hSession = NO_CONNECTION
m_hInet = NO_CONNECTION
End Sub
Protected Overrides Sub Finalize()
Class_Terminate_Renamed()
MyBase.Finalize()
End Sub
'________________________________________________________________________
' ---------------------------------------------------------
' ------------------- --------------------
' ---------------------------------------------------------
'________________________________________________________________________
Public Property Host() As String
Get
'得到主机地址
Host = m_HostAddr
End Get
Set(ByVal Value As String)
'设置主机地址
If m_hSession = NO_CONNECTION Then
m_HostAddr = Value
Else
Err.Raise(FtpError.ERR_INVALID_PROPERTY, "clsFTP:Host [Let]", ERR_ALREADY_CONNECTED)
End If
End Set
End Property
'________________________________________________________________________
'________________________________________________________________________
Public Property Port() As Integer
Get
'端口
Port = m_HostPort
End Get
Set(ByVal Value As Integer)
''端口
If m_hSession = NO_CONNECTION Then
m_HostPort = Value
Else
Err.Raise(FtpError.ERR_INVALID_PROPERTY, "clsFTP:Port [Let]", ERR_ALREADY_CONNECTED)
End If
End Set
End Property
'________________________________________________________________________
'________________________________________________________________________
Public Property User() As String
Get
'用户名
User = m_User
End Get
Set(ByVal Value As String)
'用户名
If m_hSession = NO_CONNECTION Then
m_User = Value
Else
Err.Raise(FtpError.ERR_INVALID_PROPERTY, "clsFTP:User [Let]", ERR_ALREADY_CONNECTED)
End If
End Set
End Property
'________________________________________________________________________
'________________________________________________________________________
Public Property Password() As String
Get
'密码
Password = m_Password
End Get
Set(ByVal Value As String)
'密码
If m_hSession = NO_CONNECTION Then
m_Password = Value
Else
Err.Raise(FtpError.ERR_INVALID_PROPERTY, "clsFTP:Password [Let]", ERR_ALREADY_CONNECTED)
End If
End Set
End Property
'________________________________________________________________________
'________________________________________________________________________
Public Property Directory() As String
Get
'索引
Dim TempDir As String
If (GetDirName(TempDir) <> SUCCESS) Then
TempDir = "<Unknown>"
End If
Directory = TempDir
End Get
Set(ByVal Value As String)
'索引
If m_hSession = NO_CONNECTION Then
Err.Raise(FtpError.ERR_NOT_CONNECTED_TO_SITE, "clsFTP:Directory [Let]", ERR_NO_CONNECTION)
Else
ChangeDir(Value)
End If
End Set
End Property
'________________________________________________________________________
Public ReadOnly Property IsConnected() As Boolean
Get
'是否连接
Dim Temp As String
IsConnected = (GetDirName(Temp) = SUCCESS)
End Get
End Property
'________________________________________________________________________
' ---------------------------------------------------------
' --------------- 类函数 -------------------
' ---------------------------------------------------------
Public Function Connect(Optional ByVal Host As String = vbNullString, Optional ByVal Port As Integer = 0, Optional ByVal User As String = vbNullString, Optional ByVal Password As String = vbNullString) As Integer
'连接 FTP server
On Error GoTo Handler
Dim ErrMsg As String
Connect = FAILURE
If m_hInet = FAILURE Then
'创建 internet 会话
m_hInet = InternetOpen(INET_SESSION_NAME, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
If m_hInet = FAILURE Then
Err.Raise(FtpError.ERR_FATAL, "clsFTP:Class [Initialize]", ERR_CRITICAL)
End If
End If
'If we already have an FTP session open then raise error
If m_hSession Then
Err.Raise(FtpError.ERR_INVALID_PROPERTY, "clsFTP:Connect", "You are already connected to FTP Server " & m_HostAddr)
End If
'Overwrite any existing properties if they were supplied in the
'arguments to this method
If Host <> vbNullString Then m_HostAddr = Host
If Port <> 0 Then m_HostPort = Port
If User <> vbNullString Then m_User = User
If Password <> vbNullString Then m_Password = Password
m_hSession = InternetConnect(m_hInet, m_HostAddr, m_HostPort, m_User, m_Password, INTERNET_SERVICE_FTP, 0, 0)
'Check for connection errors
If m_hSession = NO_CONNECTION Then
ErrMsg = Replace(ERR_CONNECT_ERROR, "%s", m_HostAddr)
ErrMsg = ErrMsg & vbCrLf & GetINETErrorMsg(Err.LastDllError)
Err.Raise(FtpError.ERR_CANNOT_CONNECT, "clsFTP:Connect", ErrMsg)
End If
Connect = SUCCESS
ExitProc:
Exit Function
Handler:
Connect = Err.Number
Resume ExitProc
End Function
'________________________________________________________________________
Public Function Disconnect() As Integer
'Attempt to disconnect
On Error GoTo Handler
Disconnect = FAILURE
'Kill off API Handles
If m_hInet Then InternetCloseHandle(m_hInet)
If m_hSession Then InternetCloseHandle(m_hSession)
m_hSession = NO_CONNECTION
m_hInet = NO_CONNECTION
m_HostAddr = vbNullString
m_User = vbNullString
m_Password = vbNullString
m_Dir = vbNullString
Disconnect = SUCCESS
ExitProc:
Exit Function
Handler:
Disconnect = Err.Number
Resume ExitProc
End Function
'________________________________________________________________________
Public Function GetFile(ByVal HostFile As String, ByVal ToLocalFile As String, Optional ByRef tt As FileTransferType = FileTransferType.fttUnknown) As Integer
'Get the specified file and move to the desired location using
'[optional] specified file transfer type
On Error GoTo Handler
Dim ReturnVal As Integer
Dim RemoteFile As String
Dim RemoteDir As String
Dim LocalFile As String
Dim Pos As Integer
Dim ErrMsg As String
GetFile = FAILURE
'If not connected, raise an error
If m_hSession = NO_CONNECTION Then
Err.Raise(FtpError.ERR_NOT_CONNECTED_TO_SITE, "clsFTP:GetFile", ERR_NO_CONNECTION)
End If
'Get the file
ReturnVal = FtpGetFile(m_hSession, HostFile, ToLocalFile, False, INTERNET_FLAG_RELOAD, tt, 0)
If ReturnVal = FAILURE Then
ErrMsg = Replace(ERR_DOWNLOAD, "%s", HostFile)
Err.Raise(FtpError.ERR_CANNOT_GET_FILE, "clsFTP:GetFile", ErrMsg)
End If
GetFile = SUCCESS
ExitProc:
Exit Function
Handler:
GetFile = Err.Number
Resume ExitProc
End Function
'________________________________________________________________________
Public Function PutFile(ByVal LocalFile As String, ByVal ToHostFile As String, Optional ByRef tt As FileTransferType = FileTransferType.fttUnknown) As Integer
On Error GoTo Handler
Dim ReturnVal As Integer
Dim Pos As Integer
Dim ErrMsg As String
PutFile = FAILURE
'If not connected, raise an error
If m_hSession = NO_CONNECTION Then
Err.Raise(FtpError.ERR_NOT_CONNECTED_TO_SITE, "clsFTP:PutFile", ERR_NO_CONNECTION)
End If
ReturnVal = FtpPutFile(m_hSession, LocalFile, ToHostFile, tt, 0)
If ReturnVal = FAILURE Then
ErrMsg = Replace(ERR_DOWNLOAD, "%s", ToHostFile)
ErrMsg = ErrMsg & vbCrLf & GetINETErrorMsg(Err.LastDllError)
Err.Raise(FtpError.ERR_CANNOT_RENAME, "clsFTP:PutFile", ErrMsg)
End If
PutFile = SUCCESS
ExitProc:
Exit Function
Handler:
PutFile = Err.Number
Resume ExitProc
End Function
'________________________________________________________________________
Public Function GetDirListing(ByRef FileNames() As String, ByRef FileSizes() As Integer, Optional ByVal SubDir As String = vbNullString) As Integer
On Error GoTo Handler
Dim WFD As WIN32_FIND_DATA
'UPGRADE_NOTE: Filter 已升级到 Filter_Renamed。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1061"”
Dim Filter_Renamed As String
Dim hFind, hFindConnect As Integer
Dim FileSize As Integer
Dim TempFileName As String
Dim TempFileSize As Integer
Dim FullDir As String
Dim i As Short
GetDirListing = FAILURE
'UPGRADE_WARNING: Screen 属性 Screen.MousePointer 具有新的行为。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2065"”
'System.Windows.Forms.Cursor.Current = System.Windows.Forms.Cursors.WaitCursor
'Obtain the current FTP path
Filter_Renamed = "*.*"
FullDir = m_Dir & SubDir
AddRemFwdSlash(FullDir, 1)
'If not connected, raise an error
If m_hSession = NO_CONNECTION Then
Err.Raise(FtpError.ERR_NOT_CONNECTED_TO_SITE, "clsFTP:PutFile", ERR_NO_CONNECTION)
End If
'Connection handles used by the FtpFindFirstFile
'API go out of scope once the files are
'listed, therefore it can not be reused.
'This restriction is handled by obtaining
'a fresh connection handle each time a call
'to FtpFindFirstFile is required, and releasing
'it once finished.
hFindConnect = GetInternetConnectHandle()
hFind = FtpFindFirstFile(m_hSession, FullDir & Filter_Renamed, WFD, INTERNET_FLAG_RELOAD Or INTERNET_FLAG_NO_CACHE_WRITE, 0)
If hFind Then
i = 0
Do
ReDim Preserve FileNames(i)
ReDim Preserve FileSizes(i)
TempFileName = ClipNull(WFD.cFileName)
If Len(TempFileName) Then
If WFD.dwFileAttributes And FileAttribute.Directory Then
TempFileName = TempFileName & FWDSLASH
TempFileSize = 0
Else
TempFileSize = WFD.nFileSizeLow
End If
FileNames(i) = TempFileName
FileSizes(i) = TempFileSize
End If
'Continue while valid
i = i + 1
Loop While InternetFindNextFile(hFind, WFD)
End If 'If hFind&
InternetCloseHandle(hFindConnect)
InternetCloseHandle(hFind)
'UPGRADE_WARNING: Screen 属性 Screen.MousePointer 具有新的行为。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2065"”
'System.Windows.Forms.Cursor.Current = System.Windows.Forms.Cursors.Default
GetDirListing = SUCCESS
ExitProc:
Exit Function
Handler:
GetDirListing = Err.Number
Resume ExitProc
End Function
'________________________________________________________________________
Public Function RenameFile(ByVal FileNameOld As String, ByVal FileNameNew As String) As Integer
On Error GoTo Handler
'The FTP rename command can be thought of as being more than just a simple host
'file renaming facility. When invoking a rename command on a file in a sub-folder from
'the current FTP folder, the file is essentially 'moved' to its new location
'in one simple step. Actually, the file is NOT physically copied to a new location
'and the old one deleted. Because the file on the FTP server is being renamed to
'a target directory in the same file system, FTP is clever enough just
'to change the file's directory pointer so the file never gets recopied. This
'is critical in preserving file integity, and is of significant importance to
'us in our use of buffer directories.
Dim ReturnVal As Integer
Dim ErrMsg As String
RenameFile = FAILURE
'If not connected, raise an error
If m_hSession = NO_CONNECTION Then
Err.Raise(FtpError.ERR_NOT_CONNECTED_TO_SITE, "clsFTP:RenameFile", ERR_NO_CONNECTION)
End If
ReturnVal = FtpRenameFile(m_hSession, FileNameOld, FileNameNew)
'Raise an error if we couldn't rename the file (most likely that
'a file with the new name already exists
If ReturnVal = FAILURE Then
ErrMsg = Replace(ERR_RENAME, "%s", FileNameOld)
ErrMsg = ErrMsg & vbCrLf & GetINETErrorMsg(Err.LastDllError)
Err.Raise(FtpError.ERR_CANNOT_RENAME, "clsFTP:RenameFile", ErrMsg)
End If
RenameFile = SUCCESS
ExitProc:
Exit Function
Handler:
RenameFile = Err.Number
Resume ExitProc
End Function
'________________________________________________________________________
Public Function DeleteFile(ByVal FileToDelete As String) As Integer
On Error GoTo Handler
Dim ReturnVal As Integer
Dim ErrMsg As String
DeleteFile = FAILURE
'Check for a connection
If m_hSession = NO_CONNECTION Then
Err.Raise(FtpError.ERR_NOT_CONNECTED_TO_SITE, "clsFTP:DeleteFile", ERR_NO_CONNECTION)
End If
ReturnVal = FtpDeleteFile(m_hSession, FileToDelete)
'Raise an error if the file couldn't be deleted
If ReturnVal = FAILURE Then
ErrMsg = Replace(ERR_DELETE, "%s", FileToDelete)
Err.Raise(FtpError.ERR_CANNOT_DELETE, "clsFTP:DeleteFile", ErrMsg)
End If
DeleteFile = SUCCESS
ExitProc:
Exit Function
Handler:
DeleteFile = Err.Number
Resume ExitProc
End Function
'________________________________________________________________________
' ---------------------------------------------------------
' ----------------- Private Functions ---------------------
' ---------------------------------------------------------
Private Function GetDirName(ByRef FTPDir As String) As Integer
On Error GoTo Handler
Dim BufferLen As Integer
Dim BufferStr As String
Dim ReturnVal As Integer
GetDirName = FAILURE
FTPDir = vbNullString
m_Dir = vbNullString
'If not connected, raise an error
If m_hSession = NO_CONNECTION Then
Err.Raise(FtpError.ERR_NOT_CONNECTED_TO_SITE, "clsFTP:GetDirName", ERR_NO_CONNECTION)
End If
BufferStr = Space(256)
BufferLen = Len(BufferStr)
ReturnVal = FtpGetCurrentDirectory(m_hSession, BufferStr, BufferLen)
If ReturnVal = SUCCESS Then
'return a properly qualified path
BufferStr = ClipNull(BufferStr)
m_Dir = BufferStr
FTPDir = m_Dir
GetDirName = SUCCESS
End If
ExitProc:
Exit Function
Handler:
GetDirName = Err.Number
Resume ExitProc
End Function
'________________________________________________________________________
Private Function ChangeDir(ByVal HostDir As String) As Integer
On Error GoTo Handler
Dim ReturnVal As Integer
Dim ErrMsg As String
ChangeDir = FAILURE
'Ensure that rightmost character is a backslash
AddRemSlash(HostDir, 1)
'Replace all back-slashes with forward-slashes: Telnet standard
HostDir = Replace(HostDir, BACKSLASH, FWDSLASH)
'Check for a connection
If m_hSession = NO_CONNECTION Then
Err.Raise(FtpError.ERR_NOT_CONNECTED_TO_SITE, "clsFTP:ChangeDir", ERR_NO_CONNECTION)
End If
ReturnVal = FtpSetCurrentDirectory(m_hSession, HostDir)
'If we can't change directory - raise an error
If ReturnVal = FAILURE Then
ErrMsg = ERR_CHANGE_DIR
ErrMsg = Replace(ErrMsg, "%s", HostDir)
Err.Raise(CInt(ERR_CHANGE_DIR), "clsFTP:ChangeDir", ErrMsg)
End If
ChangeDir = SUCCESS
ExitProc:
Exit Function
Handler:
ChangeDir = Err.Number
Resume ExitProc
End Function
'________________________________________________________________________
Private Function GetINETErrorMsg(ByVal ErrNum As Integer) As String
Dim LenError, LenBuffer As Integer
Dim Buffer As String
'Get extra info from the WinInet.DLL
If ErrNum = ERROR_INTERNET_EXTENDED_ERROR Then
'Get message size and number
InternetGetLastResponseInfo(LenError, vbNullString, LenBuffer)
Buffer = New String(vbNullChar, LenBuffer + 1)
'Get message
InternetGetLastResponseInfo(LenError, Buffer, LenBuffer)
GetINETErrorMsg = vbCrLf & Buffer
End If
End Function
'________________________________________________________________________
Private Function GetInternetConnectHandle() As Integer
Dim sServerName As String
Dim H As Integer
'Obtains a new handle expressly for use with the
'FtpFindFirstFile API.
'
'Care must be taken to close only the handle
'returned by this function once the listing
'of the directory has been obtained.
If m_hInet Then
H = InternetConnect(m_hInet, m_HostAddr, m_HostPort, m_User, m_Password, INTERNET_SERVICE_FTP, INTERNET_FLAG_EXISTING_CONNECT Or INTERNET_FLAG_PASSIVE, &H0S)
End If
GetInternetConnectHandle = H
End Function
'________________________________________________________________________
Private Function AddRemFwdSlash(ByRef PathName As String, ByVal IsSlash As Byte) As Integer
On Error GoTo Handler
AddRemFwdSlash = FAILURE
If IsSlash Then 'We want a "/" at end
If Right(PathName, 1) <> FWDSLASH Then PathName = PathName & FWDSLASH
Else 'We don't want a "/" at end
If Right(PathName, 1) = FWDSLASH Then
PathName = Mid(PathName, 1, Len(PathName) - 1)
End If
End If
AddRemFwdSlash = SUCCESS
ExitProc:
Exit Function
Handler:
AddRemFwdSlash = Err.Number
'MsgBox Err.Number & ": " & Err.Description, _
'vbExclamation, "AddRemFwdSlash Error"
Resume ExitProc
End Function
'________________________________________________________________________
Public Function AddRemSlash(ByRef PathName As String, ByVal IsSlash As Byte) As Integer
On Error GoTo Handler
AddRemSlash = FAILURE
If IsSlash Then 'We want a "/" at end
If Right(PathName, 1) <> BACKSLASH Then PathName = PathName & BACKSLASH
Else 'We don't want a "/" at end
If Right(PathName, 1) = BACKSLASH Then
PathName = Mid(PathName, 1, Len(PathName) - 1)
End If
End If
AddRemSlash = SUCCESS
ExitProc:
Exit Function
Handler:
AddRemSlash = Err.Number
'MsgBox Err.Number & ": " & Err.Description, _
'vbExclamation, "AddRemSlash Error"
Resume ExitProc
End Function
'________________________________________________________________________
'UPGRADE_NOTE: str 已升级到 str_Renamed。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1061"”
Private Function ClipNull(ByVal str_Renamed As String) As String
Dim Pos As Short
Pos = InStr(1, str_Renamed, vbNullChar)
If Pos > 0 Then
ClipNull = Left(str_Renamed, Pos - 1)
End If
End Function
End Class