VBAでFTPサーバにアクセスする方法はいくつかあります。
ActiveXだったりRuntimeだったり専用DLLだったり。
しかし企業ではセキュリティ上外部のソースコードの使用が禁止されていたり機能が少なかったりします。
そこでWin32APIのみでFTPクライアントを実現するクラスを作成しました。
動作保証できるほど作りこんでいませんが、手軽にファイルのダウンロード、アップロード、ファイル一覧の取得などができます。
・Cl_FTP.cls
Option Explicit
'**********************************************************************************
'列挙型宣言
'**********************************************************************************
Public Enum FILEMEMBER 'ファイル情報を外部に公開するためだけに必要
FileName
IsDirectory
Permission
Permission_Octal
Link
Owner
Group
Size
LastModifiedDate
End Enum
'**********************************************************************************
'定数宣言
'**********************************************************************************
' Constants - InternetOpen.lAccessType
Private Const INTERNET_OPEN_TYPE_PRECONFIG As Long = 0&
Private Const INTERNET_OPEN_TYPE_DIRECT As Long = 1&
Private Const INTERNET_OPEN_TYPE_PROXY As Long = 3&
Private Const INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY As Long = 4&
' Constants - InternetOpen.dwFlags
Private Const INTERNET_FLAG_ASYNC As Long = &H10000000
Private Const INTERNET_FLAG_FROM_CACHE As Long = &H1000000
Private Const INTERNET_FLAG_OFFLINE As Long = INTERNET_FLAG_FROM_CACHE
' Constants - InternetConnect.nServerPort
Private Const INTERNET_INVALID_PORT_NUMBER As Long = 0&
Private Const INTERNET_DEFAULT_PORT As Long = 21&
Private Const INTERNET_DEFAULT_GOPHER_PORT As Long = 70&
Private Const INTERNET_DEFAULT_HTTP_PORT As Long = 80&
Private Const INTERNET_DEFAULT_HTTPS_PORT As Long = 443&
Private Const INTERNET_DEFAULT_SOCKS_PORT As Long = 1080&
' Constants - InternetConnect.dwServi0ce
Private Const INTERNET_SERVICE_FTP As Long = 1&
Private Const INTERNET_SERVICE_GOPHER As Long = 2&
Private Const INTERNET_SERVICE_HTTP As Long = 3&
' Constants - InternetConnect.dwFlags
Private Const INTERNET_FLAG_PASSIVE As Long = &H8000000
' Constants - FtpGetFile.dwFlags (FTP TransferType)
' Constants - FtpPutFile.dwFlags (FTP TransferType)
Private Const TRANSFER_TYPE_UNKNOWN As Long = &H0&
Private Const TRANSFER_TYPE_ASCII As Long = &H1&
Private Const TRANSFER_TYPE_BINARY As Long = &H2&
Private Const INTERNET_FLAG_TRANSFER_ASCII As Long = TRANSFER_TYPE_ASCII
Private Const INTERNET_FLAG_TRANSFER_BINARY As Long = TRANSFER_TYPE_BINARY
' Constants - FtpGetFile.dwFlags (Cache Flags)
' Constants - FtpPutFile.dwFlags (Cache Flags)
Private Const INTERNET_FLAG_RELOAD As Long = &H80000000
Private Const INTERNET_FLAG_RESYNCHRONIZE As Long = &H800
Private Const INTERNET_FLAG_NEED_FILE As Long = &H10
Private Const INTERNET_FLAG_HYPERLINK As Long = &H400
' Constants - FtpGetFile.dwFlagsAndAttributes
Private Const FILE_ATTRIBUTE_ARCHIVE As Long = &H20
Private Const FILE_ATTRIBUTE_ENCRYPTED As Long = &H4000
Private Const FILE_ATTRIBUTE_HIDDEN As Long = &H2
Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80
Private Const FILE_ATTRIBUTE_OFFLINE As Long = &H1000
Private Const FILE_ATTRIBUTE_READONLY As Long = &H1
Private Const FILE_ATTRIBUTE_SYSTEM As Long = &H4
Private Const FILE_ATTRIBUTE_TEMPORARY As Long = &H100
Private Const FILE_ATTRIBUTE_DIRECTORY As Long = &H10
Private Const FILE_ATTRIBUTE_COMPRESSED As Long = &H800
'dwFlags(転送方法)
Private Const FTP_TRANSFER_TYPE_ASCII As Long = &H1 'アスキーモード
Private Const FTP_TRANSFER_TYPE_BINARY As Long = &H2 'バイナリモード
Private Const MAX_PATH = 260
Private Const BufSize As Long = 256 'バッファサイズ
'**********************************************************************************
'API宣言
'**********************************************************************************
Private Declare Function FtpCommand Lib "wininet.dll" Alias "FtpCommandA" (ByVal hConnect As Long, fExpectResponse As Long, ByVal dwFlags As Long, ByVal lpszCommand As String, ByVal dwContext As Long, ByRef phFtpCommand As Long) As Long
Private Declare Function InternetReadFile Lib "wininet.dll" (ByVal hRequest As Long, ByRef lpBuffer As Any, ByVal dwNumberOfBytesToRead As Long, ByRef lpdwNumberOfBytesRead As Long) As Integer
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal lpszAgent As String, ByVal dwAccessType As Long, ByVal lpszProxyName As String, ByVal lpszProxyBypass As String, ByVal dwFlags As Long) As Long
Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" (ByVal HINTERNET As Long, ByVal lpszServerName As String, ByVal nServerPort As Integer, ByVal lpszUsername As String, ByVal lpszPassword As String, ByVal dwService As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal HINTERNET As Long) As Integer
Private Declare Function FtpGetCurrentDirectory Lib "wininet.dll" Alias "FtpGetCurrentDirectoryA" (ByVal hConnect As Long, ByVal lpszCurrentDirectory As String, ByRef lpdwCurrentDirectory As Long) As Boolean
Private Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" (ByVal hConnect As Long, ByVal lpszDirectory As String) As Long
Private Declare Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" (ByVal hConnect 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 Long
Private Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" (ByVal hConnect As Long, ByVal lpszLocalFile As String, ByVal lpszNewRemoteFile As String, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Private Declare Function FtpDeleteFile Lib "wininet.dll" Alias "FtpDeleteFileA" (ByVal hConnect As Long, ByVal lpszFileName As String) As Long
Private Declare Function FtpRenameFile Lib "wininet.dll" Alias "FtpRenameFileA" (ByVal hConnect As Long, ByVal lpszExisting As String, ByVal lpszNew As String) As Long
Private Declare Function FtpRemoveDirectory Lib "wininet.dll" Alias "FtpRemoveDirectoryA" (ByVal hConnect As Long, ByVal lpszDirectory As String) As Long
Private Declare Function InternetGetLastResponseInfo Lib "wininet.dll" Alias "InternetGetLastResponseInfoA" (lpdwError As Long, ByRef lpBuffer As Any, lpdwBufferLength As Long) As Long
'Private Declare Function FtpFindFirstFile Lib "wininet.dll" Alias "FtpFindFirstFileA" (ByVal hFtpSession As Long, ByVal lpszSearchFile As String, ByRef lpFindFileData As WIN32_FIND_DATA, ByVal dwFlags As Long, ByVal dwContent As Long) As Long
'Private Declare Function InternetFindNextFile Lib "wininet.dll" Alias "InternetFindNextFileA" (ByVal hFind As Long, ByRef lpvFindData As WIN32_FIND_DATA) As Long
'Private Declare Function SystemTimeToFileTime Lib "kernel32" (lpSystemTime As SYSTEMTIME, lpFileTime As FILETIME) As Long
'Private Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long
'Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
Private cServer As String '現在のサーバ
Private cUser As String '現在のユーザ
Private cPassWord As String '現在のパスワード
Private cDirectory As String '現在のディレクトリ
Private cPasvMode As Boolean 'PasvModeの有効/無効
Private hOpen As Long 'インターネットサービスのハンドル
Private hConnection As Long 'インターネットセッションのハンドル
Private col_FileInfoList As New Collection 'ファイルリスト。コンストラクタ書くのめんどいからここで初期化
'**********************************************************************************
'ファイル情報取得系関数群
'**********************************************************************************
Public Function GetFileList(ByVal vFileName As String) As Boolean
'============================================================
'LISTコマンドでファイルリスト取得
'============================================================
Dim var_SplitSpace As Variant 'スペース区切り
Dim col_FileInfo As Collection
Dim i As Long
Set col_FileInfoList = New Collection
'On Error Resume Next
var_SplitSpace = Split(LIST(vFileName), vbCrLf) 'LISTコマンドの結果を改行区切り
If var_SplitSpace(0) = "" Then
MsgBox vFileName & "は存在しない可能性があります", , "ftp client class error"
Exit Function
End If
For i = 0 To UBound(var_SplitSpace)
If SetFileItem(var_SplitSpace(i), col_FileInfo) = True Then Call col_FileInfoList.Add(col_FileInfo) 'ファイル情報をコレクションにしてリスト
Next i
GetFileList = True
End Function
Public Function GetFileListCount() As Long
'============================================================
'GetFileList関数で取得したファイルリストのコレクションのカウントを返す
'============================================================
GetFileListCount = col_FileInfoList.Count
End Function
Public Function GetFileListItem(ByVal Index As Long, vFileMember As FILEMEMBER) As Variant
'============================================================
'GetFileList関数で取得したファイルリストのインデックスの指定されたファイルの情報（メンバ）を返す
'============================================================
If 1 > Index Or Index > GetFileListCount Then
MsgBox "インデックスが不正です", , "ftp client class error"
Exit Function
End If
GetFileListItem = GetFileMember(col_FileInfoList(Index), vFileMember) 'ファイルリストの指定インデックスの指定メンバを帰す
End Function
Public Function GetFileItem(ByVal vFileName As String, vFileMember As FILEMEMBER) As Variant
'============================================================
'LISTコマンドでファイルの情報（メンバ）を返す
'============================================================
Static col_FileInfo As Collection
Static LastServer As String
Static LastUser As String
Static LastFileName As String
Static LastDirectory As String
'つづけて同じファイルの情報を取得する際に無駄にLISTするのを防ぐ
If LastServer = Server And LastUser = User And LastFileName = vFileName And LastDirectory = Directory Then
GetFileItem = GetFileMember(col_FileInfo, vFileMember) '前回のファイルメンバ取得
Else
If SetFileItem(LIST(vFileName), col_FileInfo) = False Then Exit Function 'ファイル情報取得
GetFileItem = GetFileMember(col_FileInfo, vFileMember) 'ファイルメンバ取得
End If
'今回の情報を保存
LastServer = Server
LastUser = User
LastFileName = vFileName
LastDirectory = Directory
End Function
Private Function SetFileItem(ByVal str_FileInfo As String, ByRef col_FileInfo As Collection) As Boolean
'============================================================
'LISTコマンドの結果を解析してコレクションのメンバにする
'============================================================
Dim var_SplitSpace As Variant 'スペース区切り
Set col_FileInfo = New Collection 'コレクション初期化
'On Error Resume Next
Do Until str_FileInfo = Replace(str_FileInfo, " ", " ") '文字列をスペース区切りにする
str_FileInfo = Replace(str_FileInfo, " ", " ")
Loop
var_SplitSpace = Split(str_FileInfo, " ") 'スペース区切りにする
If UBound(var_SplitSpace) < 8 Then Exit Function 'データがそろっているか確認
'データ格納
With col_FileInfo
Call .Add(True, "Exists") 'ファイルが存在しないフラグを立てておく
If Left(var_SplitSpace(0), 1) = "d" Then 'ディレクトリならTrue
Call .Add(True, "IsDirectory")
Else
Call .Add(False, "IsDirectory")
End If
Call .Add(Mid(var_SplitSpace(0), 2), "Permission") 'パーミッション
Call .Add(0, "Permission_Octal") 'パーミッション(8進数)
Call .Add(var_SplitSpace(1), "Link") 'リンク数
Call .Add(var_SplitSpace(2), "Owner") 'オーナー
Call .Add(var_SplitSpace(3), "Group") 'グループ
Call .Add(var_SplitSpace(3), "Size") 'サイズ
If IsDate(var_SplitSpace(5) & " " & var_SplitSpace(6) & " " & var_SplitSpace(7)) Then '最終更新日
Call .Add(Format(CDate(var_SplitSpace(5) & " " & var_SplitSpace(6) & " " & var_SplitSpace(7)), "yyyy/mm/dd"), "LastModifiedDate")
Else
Call .Add(0, "LastModifiedDate")
End If
If Left(var_SplitSpace(8), 1) = "/" Then '最初の/を削除
Call .Add(Mid(var_SplitSpace(8), 2), "FileName") 'ファイル名
Else
Call .Add(var_SplitSpace(8), "FileName") 'ファイル名
End If
End With
SetFileItem = True
End Function
Private Function GetFileMember(col_FileInfo As Collection, vFileMember As FILEMEMBER) As Variant
'============================================================
'コレクションから指定されたファイルの情報（メンバ）を返す
'============================================================
Select Case vFileMember
Case FileName
GetFileMember = col_FileInfo("FileName")
Case IsDirectory
GetFileMember = col_FileInfo("IsDirectory")
Case Permission
GetFileMember = col_FileInfo("Permission")
Case Permission_Octal
GetFileMember = col_FileInfo("Permission_Octal")
Case Link
GetFileMember = col_FileInfo("Link")
Case Owner
GetFileMember = col_FileInfo("Owner")
Case Group
GetFileMember = col_FileInfo("Group")
Case Size
GetFileMember = col_FileInfo("Size")
Case LastModifiedDate
GetFileMember = col_FileInfo("LastModifiedDate")
End Select
End Function
'**********************************************************************************
'FTP操作関数群
'**********************************************************************************
Private Function LIST(Optional ByVal vFileName As String = "") As String
'============================================================
'LISTコマンドの送信、結果取得
'============================================================
Dim lng_bytesRead As Long
Dim lng_phFtpCommand As Long
Dim byt_Buf() As Byte
Dim str_Bur As String
Call FtpCommand(hConnection, True, FTP_TRANSFER_TYPE_ASCII, "LIST " & vFileName, 0, lng_phFtpCommand) 'LIST送信
Do 'FTPcmdLISTの結果を取得
ReDim byt_Buf(BufSize - 1) As Byte 'バッファ初期化
Call InternetReadFile(lng_phFtpCommand, byt_Buf(0), BufSize, lng_bytesRead) 'バッファ読み出し
If lng_bytesRead = 0 Then Exit Do '読みだすものがなくなれば終了
str_Bur = str_Bur & StrConv(byt_Buf(), vbUnicode)
Loop
If InStr(str_Bur, Chr(0)) > 0 Then str_Bur = Left(str_Bur, InStr(str_Bur, Chr(0)) - 1) 'NULLの除去
If Right(str_Bur, 1) = Chr(13) Or Right(str_Bur, 1) = Chr(10) Then str_Bur = Left(str_Bur, Len(str_Bur) - 2) 'NULLの除去
Call GetInternetConnect 'コネクション再確立
LIST = str_Bur
End Function
Public Function Cd(ByVal vDirectory As String) As Boolean 'カレントディレクトリ移動
'=========================
'カレントディレクトリの変更
'=========================
If Connected = False Then
MsgBox "cd失敗。接続がありません", , "ftp client class error"
Exit Function
End If
If FtpSetCurrentDirectory(hConnection, vDirectory) = 0 Then 'ディレクトリ移動
MsgBox "ディレクトリの移動に失敗しました", , "ftp client class error"
Exit Function
End If
cDirectory = vDirectory 'カレントディレクトリ保存
Cd = True
End Function
Public Function Pwd() As String
'=========================
'カレントディレクトリの取得
'=========================
Dim lpszDir As String
Dim ret As Long
If Connected = False Then
MsgBox "pwd失敗。接続がありません", , "ftp client class error"
Exit Function
End If
lpszDir = String(BufSize, Chr(0)) 'バッファ領域の確保
If FtpGetCurrentDirectory(hConnection, lpszDir, BufSize) = 0 Then 'カレントディレクトリ取得失敗
MsgBox "カレントディレクトリの取得に失敗しました", , "ftp client class error"
Pwd = ""
Exit Function
End If
lpszDir = Left(lpszDir, InStr(lpszDir, Chr(0)) - 1) 'NULLの除去
cDirectory = lpszDir 'カレントディレクトリとして保存
Pwd = lpszDir
End Function
Public Function DeleteFile(ByVal vFileName As String) As Boolean
'=========================
'ファイル削除
'=========================
If Connected = False Then
MsgBox "DeleteFile失敗。接続がありません", , "ftp client class error"
Exit Function
End If
If FtpDeleteFile(hConnection, vFileName) = 0 Then
MsgBox "ファイルの削除に失敗しました", , "ftp client class error"
Exit Function
End If
DeleteFile = True
End Function
Public Function RemoveDirectory(ByVal vDirectoryName As String) As Boolean
'=========================
'ディレクトリ削除
'=========================
If Connected = False Then
MsgBox "RemoveDirectory失敗。接続がありません", , "ftp client class error"
Exit Function
End If
If FtpRemoveDirectory(hConnection, vDirectoryName) = 0 Then
MsgBox "ディレクトリの削除に失敗しました", , "ftp client class error"
Exit Function
End If
RemoveDirectory = True
End Function
Public Function RenameFile(ByVal vRenameFromFile As String, ByVal vRenameToFile As String) As Boolean
'=========================
'ファイル名変更
'=========================
If Connected = False Then
MsgBox "RenameFile失敗。接続がありません", , "ftp client class error"
Exit Function
End If
If FtpRenameFile(hConnection, vRenameFromFile, vRenameToFile) = 0 Then
MsgBox "ファイル名の変更に失敗しました", , "ftp client class error"
Exit Function
End If
RenameFile = True
End Function
Public Function MKD(ByVal vDirectoryName As String) As Long
'=========================
'ディレクトリの作成
'=========================
Dim lng_bytesRead As Long
Dim lng_phFtpCommand As Long
If Connected = False Then
MsgBox "MKD失敗。接続がありません", , "ftp client class error"
Exit Function
End If
MKD = FtpCommand(hConnection, False, FTP_TRANSFER_TYPE_BINARY, "MKD " & vDirectoryName, 0, lng_phFtpCommand) 'MKD送信
Call GetInternetConnect 'コネクション再確立
End Function
Public Function CDUP() As Long
'=========================
'一つ上のディレクトリへ移動
'=========================
Dim lng_bytesRead As Long
Dim lng_phFtpCommand As Long
If Connected = False Then
MsgBox "CDUP失敗。接続がありません", , "ftp client class error"
Exit Function
End If
CDUP = FtpCommand(hConnection, False, FTP_TRANSFER_TYPE_BINARY, "CDUP", 0, lng_phFtpCommand) 'CDUP送信
Call GetInternetConnect 'コネクション再確立
cDirectory = Me.Pwd 'カレントディレクトリの保存
End Function
Public Function FtpCmd(ByVal command As String) As Long
'=========================
'FtpCommandを実行
'=========================
Dim lng_phFtpCommand As Long
If Connected = False Then
MsgBox "ftpcommand失敗。接続がありません", , "ftp client class error"
Exit Function
End If
FtpCmd = FtpCommand(hConnection, False, FTP_TRANSFER_TYPE_BINARY, command, 0, lng_phFtpCommand) 'ftpcommand送信
Call GetInternetConnect 'コネクション再確立
End Function
Public Function CHMOD(ByVal vFileName As String, ByVal Permission As String) As Long
'=========================
'CHMODを実行
'=========================
Dim lng_phFtpCommand As Long
If Connected = False Then
MsgBox "CHMOD失敗。接続がありません", , "ftp client class error"
Exit Function
End If
CHMOD = GetInternetLastResponseInfo(FtpCommand(hConnection, False, FTP_TRANSFER_TYPE_BINARY, "SITE CHMOD " & Permission & " " & vFileName, 0, lng_phFtpCommand)) 'CHMOD送信
Call GetInternetConnect 'コネクション再確立
End Function
'**********************************************************************************
'プロパティ群
'**********************************************************************************
'=====================================================
'接続先FTPサーバ(IP)
'=====================================================
Public Property Get Server() As String
Server = cServer
End Property
Private Property Let Server(ByVal vServer As String)
cServer = vServer
End Property
'=====================================================
'ユーザー
'=====================================================
Public Property Get User() As String
User = cUser
End Property
Private Property Let User(ByVal vUser As String)
cUser = vUser
End Property
'=====================================================
'パスワード、値の設定のみ可能
'=====================================================
Private Property Get Password() As String
Password = cPassWord
End Property
Private Property Let Password(ByVal vPassword As String)
cPassWord = vPassword
End Property
'=====================================================
'パッシブモードの有効/無効、無効だとFTPCommand系がほとんど駄目になる
'=====================================================
Private Property Get PasvMode() As Boolean
PasvMode = cPasvMode
End Property
Private Property Let PasvMode(ByVal vPasvMode As Boolean)
cPasvMode = vPasvMode
End Property
'=====================================================
'接続状況、値の設定のみ可能
'=====================================================
Private Property Get Connected() As Boolean
If hOpen <> 0 And hConnection <> 0 Then
Connected = True
Exit Property
End If
End Property
'=====================================================
'現在のディレクトリ、値の取得のみ可能
'=====================================================
Public Property Get Directory() As String
Directory = cDirectory
End Property
'Public Property Let Directory(ByVal vDirectory As String)
'
'End Property
'**********************************************************************************
'インターネットセッション操作関数群
'**********************************************************************************
'=====================================================
'インターネットセッションをオープン
'=====================================================
Private Function GetInternetOpen() As Long
'すでにあるFTP接続を切断
If hConnection <> 0 Then InternetCloseHandle hConnection
If hOpen <> 0 Then InternetCloseHandle hOpen
hOpen = InternetOpen(vbNullString, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
GetInternetOpen = hOpen
End Function
'=====================================================
'コネクション取得
'=====================================================
Private Function GetInternetConnect() As Boolean
'すでにあるコネクションを切断
If hConnection <> 0 Then InternetCloseHandle hConnection
If PasvMode Then 'パッシブモード
hConnection = InternetConnect(hOpen, Server, INTERNET_INVALID_PORT_NUMBER, User, Password, INTERNET_SERVICE_FTP, INTERNET_FLAG_PASSIVE, 0)
Else
hConnection = InternetConnect(hOpen, Server, INTERNET_INVALID_PORT_NUMBER, User, Password, INTERNET_SERVICE_FTP, 0, 0)
End If
GetInternetConnect = hConnection
End Function
'=====================================================
'InternetGetLastResponseInfoラッパ
'=====================================================
Private Function GetInternetLastResponseInfo(ByVal lpdwResult As Long) As String
Dim lng_Length As Long
Dim str_Result As String
Dim byt_Buf() As Byte
Call InternetGetLastResponseInfo(lpdwResult, vbNullString, lng_Length)
If lng_Length = 0 Then Exit Function
ReDim byt_Buf(lng_Length - 1) As Byte
Call InternetGetLastResponseInfo(lpdwResult, byt_Buf(0), lng_Length)
str_Result = StrConv(byt_Buf(), vbUnicode)
If InStr(str_Result, Chr(0)) > 0 Then str_Result = Left(str_Result, InStr(str_Result, Chr(0)) - 1) 'NULLの除去
GetInternetLastResponseInfo = str_Result
End Function
'============================================================
'サーバへ接続
'============================================================
Public Function Connect(ByVal vServer As String, ByVal vUser As String, ByVal vPassword As String, Optional ByVal vPasvMode As Boolean = True, Optional ByVal vDirectory As String = "") As Boolean
Server = vServer
User = vUser
Password = vPassword
PasvMode = vPasvMode
If hOpen = 0 Then 'インターネットセッションオープン
If GetInternetOpen = 0 Then
MsgBox "インターネットセッションハンドルの取得に失敗しました", , "ftp client class error"
Exit Function
End If
End If
If GetInternetConnect = 0 Then 'コネクション確立
MsgBox "インターネットコネクションの確立に失敗しました", , "ftp client class error"
Exit Function
End If
If vDirectory <> "" Then
Connect = Me.Cd(vDirectory) 'ディレクトリの移動
Else
cDirectory = Me.Pwd 'カレントディレクトリの保存
Connect = True
End If
Connect = True
End Function
Public Sub Diconnect()
'============================================================
'現在の接続を切断、サーバ情報を破棄
'============================================================
If hConnection <> 0 Then InternetCloseHandle hConnection 'すでに接続がある場合、インターネットセッションを閉じる
If hOpen <> 0 Then InternetCloseHandle hOpen 'すでに接続がある場合、インターネットサービスを閉じる
hConnection = 0
hOpen = 0
End Sub
Private Sub Class_Terminate()
Call Me.Diconnect
End Sub
