ファイルを一つダウンロード

  COMMONDLG.bas

http://hpcgi2.nifty.com/lightbox/list_lightbox.cgi?mid=PROvbFunction&id=021202183524

より作成



  API 定義



  
' ------------------------------------------------------
' ダウンロード
' ------------------------------------------------------
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

' ------------------------------------------------------
' フラグ
' ------------------------------------------------------
Const FTP_TRANSFER_TYPE_BINARY = &H2
Const INTERNET_FLAG_RELOAD = &H80000000

' ------------------------------------------------------
' 属性
' ------------------------------------------------------
Const FILE_ATTRIBUTE_DIRECTORY = &H10
Const FILE_ATTRIBUTE_READONLY = &H1
Const FILE_ATTRIBUTE_HIDDEN = &H2
Const FILE_ATTRIBUTE_SYSTEM = &H4
Const FILE_ATTRIBUTE_ARCHIVE = &H20
Const FILE_ATTRIBUTE_NORMAL = &H80

  



  ダウンロード関数

  
' ******************************************************
' ダウンロード
' ******************************************************
Public Function lbFTPDownload( _
    RemoteTarget As String, _
    LocalTarget As String _
) As String

    Dim bRet As Boolean
    Dim nLastDllError As Long

    bRet = FtpGetFile( _
                hCon, _
                RemoteTarget, _
                LocalTarget, _
                False, _
                FILE_ATTRIBUTE_NORMAL, _
                FTP_TRANSFER_TYPE_BINARY Or INTERNET_FLAG_RELOAD, _
                0)
    nLastDllError = Err.LastDllError
    
    If bRet Then
        lbFTPDownload = ""
    Else
        lbFTPDownload = "(" & nLastDllError & ") " & Err.Description
    End If

End Function

  



  イベント

  
' ******************************************************
' ファイルを一つダウンロード
' ******************************************************
Private Sub grd一覧_DblClick()

    Dim nRow As Integer
    Dim strPath As String
    Dim strRet
    
    nRow = Me.grd一覧.Row
    
    If Me.grd一覧.TextMatrix(nRow, 5) = "10" Then
        MsgBox ("ディレクトリはダウンロードできません")
        Exit Sub
    End If
    
    strPath = Me.grd一覧.TextMatrix(nRow, 1)
    If COMMONDLG.SaveFileDlg("ファイルを保存", Me.hWnd, "全て,*.*", 1, strPath) Then
        If vbOK = MsgBox("ダウンロードを開始します。よろしいですか?", vbOKCancel) Then
            strRet = Module1.lbFTPDownload("cgi-bin/" & Me.grd一覧.TextMatrix(nRow, 1), strPath)
            If strRet <> "" Then
                MsgBox (strRet)
            Else
                MsgBox ("ダウンロードが終了しました")
            End If
        End If
    End If

End Sub

  










  infoboard   管理者用   
このエントリーをはてなブックマークに追加





フリーフォントWEBサービス
SQLの窓WEBサービス

SQLの窓フリーソフト

素材

一般WEBツールリンク

SQLの窓

フリーソフト

JSライブラリ