WILLはネットワークに関するあらゆるソリューションをご提供します。
株式会社ウィル
HOME 新着情報 製品一覧 受託開発 Download 購入方法 トライアル サポート 会社案内
ウィルFTPサンプル　WILLFTP Ver1.0
　▼概要 　▼使い方 　▼willftp 　▼filedilg 　▼ソースコード 　プログラムのダウンロード→

概 要

WILLFTPはFTPクライアントのプログラムです。ファイル内容およびファイル名は送信時と受信時で別 々に指定の漢字コード(シフトJIS/JIS/EUC)に変換可能です。
なお、WILLFTP.EXEを実行するには、別途MAILOCX ,TCPIPOCX(シェアウエア)に含まれるTCPIP.OCXとKANJIOCX(シェアウエア)に含まれるKANJI.OCX必要です。
以上のプログラムはWindows95およびWindowsNT4.0で動作確認しています。
▲TOPへ

使い方

■サーバーの設定

  • サーバー
    FTPサーバーのIPアドレスを入力します。

  • ユーザー名、パスワード、アカウント
    サーバーログイン時のユーザー名、パスワード、アカウントを入力します。

■拡張機能の設定

  • パッシブモードの利用
    通信を行う際にパッシブモードを利用する場合はチェックボックスにチェックをつけます。

  • ファイヤーウォールの設定
    デフォルトは、「なし」です。
    設定を行う場合は、「 OPEN」、「SITE」、「USERタイプ１」、「USERタイプ２」の４種類のリストの中から選択してください。それぞれの動作内容は、下のテキストボックスに表示されます。表示された内容にしたがって、「サーバー名」、「ユーザー名」、「パスワード」を指定してください。

■接続・切断・中断

サーバーの設定が完了したら、「接続」ボタンをクリックしてサーバに接続します。切断する場合は「切断」ボタンを、処理を中断する場合は「中断」ボタンをクリックしてください。

■FTPコマンド

  • CHANGE DIR
    「ディレクトリ」のテキストボックスに指定したパスに移動します。

  • UPPER DIR
    開いているディレクトリの１つ上の階層に移動します。

  • GET FILE
    選択中のファイルをローカルマシンの指定したディレクトリに保存します。「LOCAL FILE DIALOG」画面が表示されますので、「ファイル名」、「転送タイプ」、「漢字コード」などを指定してください。

  • PUT/APPEND FILE
    ローカルマシンにあるファイルを、選択中のディレクトリに名前をつけて保存します。「LOCAL FILE DIALOG」画面が表示されますので、該当するファイルを選択し「ファイル名」、「転送タイプ」、「漢字コード」などを指定してください。

  • DELETE
    選択中のファイル及びディレクトリを削除します。

  • MAKE DIR
    開いているディレクトリの中に新規にディレクトリを作成します。「 Make Directry」画面が表示されますので、名前を指定してください。

  • SITE
    SITEコマンドを指定します。「SITE」画面が表示されますので、接続しているサーバー固有のコマンドを指定してください。

  • QUOT
    FTPOCXでサポートしていないFTPプロトコルのコマンドを指定できます。「QUOTE」画面が表示されますのでコマンドを指定してください。
▲TOPへ

willftp.frm

▲TOPへ

filedilg.frm

▲TOPへ

ソースコード

'(C)COPYRIGHT 1998 WILL
Option Explicit
Private Action%
Private FF%
Private m_Remain$
Private Const LB_SETHORIZONTALEXTENT = &H194
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" 
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

'コマンドを実行中にするときこれを呼び出す
Private Sub Processing(x%)
    Action = x
    Frame3.Enabled = False
    Command2.Enabled = False
    Command6.Enabled = True
    List1.Enabled = False
End Sub

'コマンドの実行が完了したらこれを呼び出す
Private Sub Idling(x%)
    Action = x
    Frame3.Enabled = True
    Command2.Enabled = True
    Command6.Enabled = False
    List1.Enabled = True
End Sub

'接続ボタン
Private Sub Command1_Click()
    
    Command1.Enabled = False
    Action = 1
    On Error GoTo command1_err1
    'FTPサーバーに接続する。サーバーアドレス、ユーザー名、パスワードの順。
    ftp1.Connect Text1, Text2, Text3
    On Error GoTo 0
    Exit Sub
    
command1_err1:
    Action = 0
    Command1.Enabled = True
End Sub

Private Sub Command10_Click()
    Dim d$
    
    d = InputBox("サーバー固有のコマンドを入力してください。", "SITE", "")
    If (d = "") Then
        Exit Sub
    End If
    Processing 3
    ftp1.Site d

End Sub

'切断ボタン
Private Sub Command2_Click()
    Processing -1
    ftp1.DisConnect
End Sub

'ChangeDirボタン
Private Sub Command3_Click()
    List1.Clear
    Processing 2
    ftp1.Cd Text4
    
End Sub

'Change Upperボタン
Private Sub Command4_Click()
    Processing 2
    ftp1.Cd ".."
End Sub

'GetFILEボタン
Private Sub Command5_Click()
    Dim n%, x$()
    If (List1.ListIndex <> -1) Then
        n = Split(List1.List(List1.ListIndex), " ", x(), 9)
        If (n <> 9) Then
            Exit Sub
        End If
        Select Case LCase(Left$(x(1), 1))
        Case "-"
            Load filedilg
            filedilg.Text1 = x(9)
            filedilg.Show 1
            If (Label1 <> "") Then
  Processing 4
  'FTPサーバーからファイルを転送する。
  'GetOpenイベントが上がる
  ftp1.GetFile x(9), Label1
            End If
        Case Else
            MsgBox "ファイルを選択してください。", vbExclamation, "NOT FILE"
        End Select
    Else
        MsgBox "ファイルを選択してください。", vbExclamation, "NOT SELETCED"
    End If

End Sub

'中断ボタン
Private Sub Command6_Click()
    Command6.Enabled = False
    '実行中の転送処理を中断する
    ftp1.Abort
End Sub

'PutFILEボタン
Private Sub Command7_Click()
    Dim n%, x$()
    'ローカルファイルを選択するためにダイヤログフォームを表示する
    Load filedilg
    filedilg.Text1 = ""
    filedilg.Text2 = ""
    '受信のときだけ表示するコントロール
    filedilg.Label2.Visible = True
    filedilg.Text2.Visible = True
    filedilg.Text1.Locked = True
    filedilg.Show 1
    filedilg.Label2.Visible = False
    filedilg.Text2.Visible = False
    filedilg.Text1.Locked = False
    If (Label1 <> "") Then  'CANCELの場合はlabel1が空になる
        FF = FreeFile
        On Error GoTo command7_err1
        Open Label1 For Binary Access Read As FF
        On Error GoTo 0
        Processing 3
        'ファイルをFTPサーバーに送信する。
        'PutDataイベントが上がる
        ftp1.PutFile filedilg.Text2
    End If
    Exit Sub
command7_err1:
    MsgBox Err.Description, vbExclamation, Label1
    
End Sub

'DELETEボタン
Private Sub Command8_Click()
    Dim n%, x$()
    If (List1.ListIndex <> -1) Then
        n = Split(List1.List(List1.ListIndex), " ", x(), 9)
        If (n <> 9) Then
            Exit Sub
        End If
        Select Case LCase(Left$(x(1), 1))
        Case "-"
            Processing 3
            'ファイルを削除する
            ftp1.Delete x(9)
        Case "d"
            Processing 3
            'ディレクトリを削除する
            'ディレクトリは空であること
            ftp1.RmDir x(9)
        Case Else
            MsgBox "ファイルを選択してください。", vbExclamation, "NOT FILE"
        End Select
    Else
        MsgBox "ファイルを選択してください。", vbExclamation, "NOT SELETCED"
    End If
End Sub

'ディレクトリを作成するボタン
Private Sub Command9_Click()
    Dim d$
    
    d = InputBox("作成するディレクトリ名を入力してください。", "MakeDirectory", "")
    If (d = "") Then
        Exit Sub
    End If
    Processing 3
    ftp1.MkDir d
End Sub

Private Sub Form_Load()
    Dim r&
    'リストボックスに横スクロールバーをつける
    ScaleMode = vbPixels
    Me.Font = List1.Font
    r = SendMessage(List1.hwnd, LB_SETHORIZONTALEXTENT, Me.TextWidth(Space(100)), ByVal 0&)
    Label7 = ftp1.Copyright
End Sub

'リストボックスをダブるクリックすると、ChangeDirまたはGetFileする
Private Sub List1_DblClick()
    Dim n%, x$()
    If (List1.ListIndex <> -1) Then
        'UNIXがFTPサーバーである場合、ls -algの出力結果がリストされている。
        'これは、スペースで９分割されていて、９番目がファイル名である。
        'このような出力をしない場合、正しいファイル名をえられないことがある。
        n = Split(List1.List(List1.ListIndex), " ", x(), 9)
        If (n <> 9) Then
            Exit Sub
        End If
        Select Case LCase(Left$(x(1), 1))
        Case "-"    '普通のファイル
            Load filedilg
            filedilg.Text1 = x(9)
            filedilg.Show 1
            If (Label1 <> "") Then
  Processing 4
  'ファイルをサーバーから転送する
  'GetOpenイベントが上がるのを待つ
  ftp1.GetFile x(9), Label1
            End If
        Case "d"    'ディレクトリ
            Processing 2
            'ChageDirする
            ftp1.Cd x(9)
        Case Else
            MsgBox "ファイルまたはディレクトリを選択してください。", vbExclamation, "NOT FILE OR DIRECTORY"
        End Select
    End If

End Sub

'ftpに対するコマンドの完了通知
'Code%  正常終了なら0、エラーがある場合は0以外
'Stat$  実行したftpコマンド
'Msg$   FTPサーバーからの最後の応答
Private Sub ftp1_CommandDone(Code%, Stat$, Msg$)
    Dim p%, q%
    
    If (Code = 0) Then
        Select Case Action
        Case 1  'Connectした
            Processing 2
            'ChageDirする
            ftp1.Cd Text4
        Case 2  'Cdした
            'ftp.cdは最後にPWDコマンドを行う。Msgにディレクトリ名があるはず。
            p = InStr(1, Msg, Chr$(34)) '34はダブルクオート
            If (p > 0) Then
  q = InStr(p + 1, Msg, Chr$(34))
  Text4 = Mid$(Msg, p + 1, q - p - 1)
            End If
            'FTPサーバーのシステム漢字コードを指定する
            'ファイル名に漢字が含まれていた時はJIS/SJIS/EUCであればUNICODEに
            '自動変換する。漢字が含まれなければここでの設定は無視される。
            If (Option3.Value = True) Then
  ftp1.SysCode = "SJIS"
            Else
  ftp1.SysCode = "EUC"
            End If
            Processing 4
            'ディレクトリ一覧を得る
            ftp1.Dir
        Case 3  'put delete mkdir rmdir した
            If (Option3.Value = True) Then
  ftp1.SysCode = "SJIS"
            Else
  ftp1.SysCode = "EUC"
            End If
            Processing 4
            'ディレクトリ一覧を得る
            ftp1.Dir
        Case 4
            Idling 5
        Case 5
            '
        Case -1
            Idling 0
        End Select
    Else
        MsgBox Msg
        Idling 5
    End If
End Sub

'Ls/Dirコマンド：起動するとこのイベントがまず発生する
Private Sub ftp1_DirOpen()
    List1.Clear
End Sub

'Ls/Dirコマンド：１ファイルに付き１行送られる。dataはUnicodeである。
Private Sub ftp1_DirData(data$)
    List1.AddItem data
End Sub
'Ls/Dirコマンド：終わりの印
Private Sub ftp1_DirClose()
    'することはなにもない
End Sub

'FileGetコマンド：FileGetコマンドを起動すると、このイベントがまず発生する
'SaveFileNameはFileGetコマンドの第２引数がわたってくる
Private Sub ftp1_GetOpen(SaveFileName As String)
    m_Remain = ""
    Err.Clear
    On Error Resume Next
    Kill SaveFileName
    On Error GoTo 0
    FF = FreeFile
    On Error GoTo getopen_err1
    Open SaveFileName For Binary Access Write As FF
    On Error GoTo 0
    Exit Sub
getopen_err1:
    MsgBox Err.Description, vbExclamation, SaveFileName
End Sub
(C) Copyright 2003 WILL Corporation. All rights reserved.