FTPに関して
VB6でFTPを作っていまして、
InternetGetLastResponseInfoの使い方がよくわかりません。
エラーが０にしかなりません。
どこを直せばいいかよくわかりません。
よろしくお願いします。
----clsFTP----
Option Explicit
Private lngInethnd As Long 'InterNet Open Handle
Private lngFtphnd As Long 'InterNet Connect Handle
Private msFtpSvr As String 'FTP Server IP
Private msFtpDir As String 'FTP Server Dir
Private msFtpUid As String 'FTP Login UserID
Private msFtpPwd As String 'FTP Login Password
Private msFtpFilNm As String 'FTP Target FileName
Private msFtpLclDir As String 'FTP Local Dir
Private msFtpSvrFile As String 'FTP Server File
'AccessType
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0& 'use registry configuration
Private Const INTERNET_OPEN_TYPE_DIRECT = 1& 'direct to net
Private Const INTERNET_OPEN_TYPE_PROXY = 3& 'via named proxy
'File Attribute
Private Const FILE_ATTRIBUTE_READONLY = &H1&
Private Const FILE_ATTRIBUTE_HIDDEN = &H2&
Private Const FILE_ATTRIBUTE_SYSTEM = &H4&
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10&
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20&
Private Const FILE_ATTRIBUTE_NORMAL = &H80&
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100&
Private Const FILE_ATTRIBUTE_COMPRESSED = &H800&
Private Const FILE_ATTRIBUTE_OFFLINE = &H1000&
'FTP TransferType
Private Const FTP_TRANSFER_TYPE_ASCII = &H1&
Private Const FTP_TRANSFER_TYPE_BINARY = &H2&
'Cache Flags
Private Const INTERNET_FLAG_RELOAD = &H80000000 'サーバからダウンロードを強制
Private Const INTERNET_FLAG_DONT_CACHE = &H4000000 'キャッシュに加えない
Private Const INTERNET_FLAG_RESYNCHRONIZE = &H800 'すべてを再読み込み
Private Const INTERNET_FLAG_NEED_FILE = &H10 'キャッシュできないときテンポラリ生成
Private Const INTERNET_FLAG_HYPERLINK = &H400 'リロードを強制
'ConnectServerPort
Private Const INTERNET_INVALID_PORT_NUMBER = 0 'use the protocol-specific default
Private Const INTERNET_DEFAULT_FTP_PORT = 21 'default for FTP servers
Private Const INTERNET_DEFAULT_GOPHER_PORT = 70 'default for Gopher servers
Private Const INTERNET_DEFAULT_HTTP_PORT = 80 'default for HTTP servers
Private Const INTERNET_DEFAULT_HTTPS_PORT = 443 'default for HTTPS servers
Private Const INTERNET_DEFAULT_SOCKS_PORT = 1080 'default for SOCKS firewall servers
'ConnectService
Private Const INTERNET_SERVICE_FTP = 1& 'FTP
Private Const INTERNET_SERVICE_GOPHER = 2& 'Gopher
Private Const INTERNET_SERVICE_HTTP = 3& 'HTTP
'WinInet を初期化
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
'(FTP, HTTP, Gopher)サービスに接続する
Private Declare Function InternetConnect Lib "Wininet.DLL" _
Alias "InternetConnectA" _
(ByVal hInternetSession 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 FtpSetCurrentDirectory Lib "Wininet.DLL" _
Alias "FtpSetCurrentDirectoryA" _
(ByVal hFtpSession As Long, ByRef lpszDirectory As Byte) As Long
'ファイルをサーバにコピー
Private Declare Function FtpPutFile Lib "Wininet.DLL" _
Alias "FtpPutFileA" _
(ByVal hFtpSession As Long, ByRef lpszLocalFile As Byte, _
ByRef lpszNewRemoteFile As Byte, ByVal dwFlags As Long, _
ByVal dwContext As Long) As Long
'ファイルをローカルディスクにコピー
Private Declare Function FtpGetFile Lib "Wininet.DLL" _
Alias "FtpGetFileA" _
(ByVal hFtpSession As Long, ByRef lpszRemoteFile As Byte, _
ByRef lpszNewFile As Byte, ByVal fFailIfExists As Long, _
ByVal dwFlagsAndAttributes As Long, ByVal dwFlags As Long, _
ByVal dwContext As Long) As Long
'WinInet で作成したハンドルをクローズ
Private Declare Function InternetCloseHandle Lib "Wininet.DLL" _
(ByVal hInternet As Long) As Long
'WinInet で作成したハンドルのステータスを取得する
Private Declare Function InternetGetLastResponseInfo Lib "Wininet.DLL" Alias "InternetGetLastResponseInfoA" ( _
lpdwError As Long, _
ByRef lpszBuffer As String, _
lpdwBufferLength As Long) As Boolean
'FTPコマンド実行
Private Declare Function FtpCommand Lib "Wininet.DLL" Alias "FtpCommandA" _
(ByVal hConnect As Long, _
fExpectResponse As Long, _
ByVal dwFlags As Long, _
ByRef lpszCommand As Byte, _
ByVal dwContext As Long, _
ByRef phFtpCommand As Long) As Long
'ファイルをサーバーから削除
Private Declare Function FtpDeleteFile Lib "Wininet.DLL" Alias "FtpDeleteFileA" ( _
ByVal hFtpSession As Long, _
ByRef lpszFileName As Byte) As Long
' ByVal lpszBuffer As String, _
'BOOL InternetGetLastResponseInfo(
' OUT LPDWORD lpdwError,
' OUT LPSTR lpszBuffer,
' IN OUT LPDWORD lpdwBufferLength
');
'-----------------------------------------------------------------------------------------------------
' 入力プロパティー
Public Property Let FtpServer(pFtpSvr As String)
msFtpSvr = pFtpSvr
End Property
Public Property Let FtpSvrDir(pFtpSvrDir As String)
msFtpDir = pFtpSvrDir
End Property
Public Property Let FtpUser(pFtpUser As String)
msFtpUid = pFtpUser
End Property
Public Property Let FtpPwd(pFtpPwd As String)
msFtpPwd = pFtpPwd
End Property
Public Property Let FtpLocalFileName(pFtpFilNm As String)
msFtpFilNm = pFtpFilNm
End Property
Public Property Let FtpLocalFilePath(pFtpFilePath As String)
msFtpLclDir = pFtpFilePath
End Property
Public Property Let FtpSvrFile(pFtpSvrFile As String)
msFtpSvrFile = pFtpSvrFile
End Property
' 出力プロパティー
Public Property Get FtpServer() As String
FtpServer = msFtpSvr
End Property
Public Property Get FtpSvrDir() As String
FtpSvrDir = msFtpDir
End Property
Public Property Get FtpUser() As String
FtpUser = msFtpUid
End Property
Public Property Get FtpPwd() As String
FtpPwd = msFtpDir
End Property
Public Property Get FtpLocalFileName() As String
'FtpFileName = msFtpFilNm
End Property
Public Property Get FtpLocalFilePath() As String
'FtpFilePath = msFtpLclDir
End Property
Public Property Get FtpSvrFile() As String
FtpSvrFile = msFtpSvrFile
End Property
Public Function ConnectFtpServer() As Integer
Dim lngRet As Long '戻り値
On Error GoTo FTPDATAGETINI_ERR
'InternetOpen (Handle を取得)
lngInethnd = InternetOpen(vbNullString, INTERNET_OPEN_TYPE_PRECONFIG, _
vbNullString, vbNullString, 0)
'InternetConnect (上記で取得した Handle で FTP Server に Connect)
lngFtphnd = InternetConnect(lngInethnd, msFtpSvr, INTERNET_DEFAULT_FTP_PORT, _
msFtpUid, msFtpPwd, INTERNET_SERVICE_FTP, 0, 0)
ConnectFtpServer = 0
If lngFtphnd = 0 Then
MsgBox "サーバ接続出来ませんでした"
ConnectFtpServer = 1
End
End If
Exit Function
FTPDATAGETINI_ERR:
'InternetConnect がされた後なのか判断
If lngFtphnd <> 0 Then
'Internet Handle Close 処理
lngRet = InternetCloseHandle(lngFtphnd)
End If
ConnectFtpServer = 1
End Function
Public Function PutFile() As Integer
Dim lngRet As Long '戻り値
Dim bytFtpBuff() As Byte 'UpLoad したい FTP Server 内の Directory
Dim bytLclBuff() As Byte 'UpLoad したいファイル名
Dim bytSvrBuff() As Byte 'UpLoad したいサーバーファイル名
Dim bytCommand() As Byte
Dim hResponse As Long
On Error GoTo FTPDATAGETINI_ERR
'UpLoad したい FTP Server 内の Directory
bytFtpBuff = StrConv((msFtpDir & vbNullChar), vbFromUnicode)
'FTP Server の CurrentDirectory を変更
lngRet = FtpSetCurrentDirectory(lngFtphnd, bytFtpBuff(0))
If lngRet = False Then
MsgBox "サーバーのディレクトリ変更に失敗しました" & vbCrLf & "error = " & lngRet, vbCritical, "FTP ERROR"
PutFile = 1
Exit Function
End If
'Fileの有無をチェック
If Dir(msFtpLclDir & "\" & msFtpFilNm) = "" Then
MsgBox "送信元のファイルが存在しません", vbCritical, "FTP ERROR"
PutFile = 1
End If
'Local の CurrentDrive を変更
ChDrive (Mid(msFtpLclDir, 1, 2))
'Local の CurrentDirectory を変更
ChDir (Mid(msFtpLclDir, 3, Len(msFtpLclDir)))
'UpLoad したいファイルの名前
bytLclBuff = StrConv((msFtpFilNm & vbNullChar), vbFromUnicode)
'UpLoad したいサーバーファイルの名前
bytSvrBuff = StrConv((msFtpSvrFile & vbNullChar), vbFromUnicode)
'UpLoad (BINARY-MODEの場合)
lngRet = FtpPutFile(lngFtphnd, bytLclBuff(0), bytSvrBuff(0), _
FTP_TRANSFER_TYPE_BINARY, 1)
PutFile = 0
If lngRet = False Then
MsgBox "ファイルの出力に失敗しました" & vbCrLf & "error = " & lngRet, vbCritical, "FTP ERROR"
Call DelFile
PutFile = 1
Else
MsgBox "ファイルの出力に成功しました"
End If
'UPLOADファイルのパーミッション変更
' bytCommand = StrConv(("site chmod 777 " & msFtpSvrFile & vbNullChar), vbFromUnicode)
' lngRet = FtpCommand(lngFtphnd, 1, FTP_TRANSFER_TYPE_ASCII, bytCommand(0), 0, hResponse)
Exit Function
FTPDATAGETINI_ERR:
'InternetConnect がされた後なのか判断
If lngFtphnd <> 0 Then
'Internet Handle Close 処理
lngRet = InternetCloseHandle(lngFtphnd)
End If
PutFile = 1
End Function
Public Function GetFile() As Integer
Dim lngRet As Long '戻り値
Dim strLclDir As String 'DownLoad したファイルを保存する Directory
Dim bytFtpBuff() As Byte 'FTP Server 内の Download するファイル名
Dim bytLclBuff() As Byte 'Download したファイルを保存するファイル名
Dim lngResponse As Long
Dim strResponse As String
Dim lngLength As Long
On Error GoTo FTPDATAGETINI_ERR
'FTP Server の取得ファイルが存在する Directory
bytFtpBuff = StrConv((msFtpDir & vbNullChar), vbFromUnicode)
'FTP Server の CurrentDirectory を変更
lngRet = FtpSetCurrentDirectory(lngFtphnd, bytFtpBuff(0))
'FTP Server から取得するファイルの名前
bytFtpBuff = StrConv((msFtpSvrFile & vbNullChar), vbFromUnicode)
'DownLoad 先をフルパスで指定
strLclDir = msFtpLclDir & IIf(Right(msFtpLclDir, 1) = "\", "", "\") & msFtpFilNm
bytLclBuff = StrConv((strLclDir & vbNullChar), vbFromUnicode)
' strLclDir = "e:\teruteru.txt"
' bytLclBuff = StrConv((strLclDir & vbNullChar), vbFromUnicode)
'ローカルに、すでに同一ファイル名が存在する場合は削除
If Dir(strLclDir) <> "" Then
Kill strLclDir
End If
lngRet = 0
'DownLoad (ASCII-MODEの場合＆キャッシュを使わずサーバからダウンロードを強制)
lngRet = FtpGetFile(lngFtphnd, bytFtpBuff(0), bytLclBuff(0), 1, FILE_ATTRIBUTE_NORMAL, _
FTP_TRANSFER_TYPE_BINARY Or INTERNET_FLAG_RELOAD, 0)
GetFile = 0
If lngRet = False Then
MsgBox "ファイルの出力に失敗しました" & vbCrLf & "error = " & lngRet, vbCritical, "FTP ERROR"
lngRet = InternetGetLastResponseInfo(lngResponse, strResponse, lngLength)
GetFile = 1
Else
MsgBox "ファイルの出力に成功しました"
End If
Exit Function
FTPDATAGETINI_ERR:
'InternetConnect がされた後なのか判断
If lngFtphnd <> 0 Then
'Internet Handle Close 処理
lngRet = InternetCloseHandle(lngFtphnd)
End If
GetFile = 1
End Function
Public Function DelFile() As Integer
Dim lngRet As Long '戻り値
Dim bytFtpBuff() As Byte 'FTP Server 内の Delete するファイル名
On Error GoTo FTPDATADELINI_ERR
'FTP Server の取得ファイルが存在する Directory
bytFtpBuff = StrConv((msFtpDir & vbNullChar), vbFromUnicode)
'FTP Server の CurrentDirectory を変更
lngRet = FtpSetCurrentDirectory(lngFtphnd, bytFtpBuff(0))
'FTP Server から取得するファイルの名前
bytFtpBuff = StrConv((msFtpSvrFile & vbNullChar), vbFromUnicode)
lngRet = 0
'ファイルの削除
lngRet = FtpDeleteFile(lngFtphnd, bytFtpBuff(0))
DelFile = 0
' If lngRet = False Then
' MsgBox "ファイルの削除に失敗しました" & vbCrLf & "error = " & lngRet, vbCritical, "FTP ERROR"
' DelFile = 1
' End If
Exit Function
FTPDATADELINI_ERR:
'InternetConnect がされた後なのか判断
If lngFtphnd <> 0 Then
'Internet Handle Close 処理
lngRet = InternetCloseHandle(lngFtphnd)
End If
DelFile = 1
End Function
Public Function ConnectClose() As Integer
Dim lngRet As Long '戻り値
'InternetConnect がされた後なのか判断
If lngFtphnd <> 0 Then
'Internet Handle Close 処理
lngRet = InternetCloseHandle(lngFtphnd)
End If
End Function
おいおい！ 関係無いコードまで貼り付けることは無いでしょう。
> lngRet = InternetGetLastResponseInfo(lngResponse, strResponse, lngLength)
このlngLengthには何が入っているの？
| ツイート |  |