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

概要

FTPEDITORはFTPクライントのプログラムです。サーバー内のファイルを検索したり、
検索したテキストファイルを編集したりすることができます。
ファイル内およびファイル名は送信時と受信時で別々に指定の漢字コード（SJIS、JIS、EUC）に変換可能です。
▲TOPへ

使い方

  1. 「サーバー」、「ユーザー」、「パスワード」に、それぞれサーバーの「IPアドレス」、ログイン時の「ユーザー名」、「パスワード」を入力する。
  2. 受信するファイル内の「本文」および「ファイル名」の漢字コードを指定する（JISの場合は自動判別 します。
    EUC,SJISの場合は自動判別できない場合に変換するデフォルトの漢字コードとなります）。
  • ファイル名がわかっている場合
    1. 「ファイル」にファイル名を指定し、編集画面 でGETボタンをクリックする。
    2. ファイル内の本文が表示されるため、編集後PUTボタンをクリックする。
  • ファイル名がわからない場合
    1. 「ファイル」にディレクトリ名を指定し、検索画面で検索ボタンをクリックする。
    2. ディレクトリ名またはファイル名の一覧が表示されます。選択したい項目をダブルクリックするか、クリックして選択ボタンを押す。
    3. 選択した項目がファイル名の場合、自動的に編集画面となりファイル内の本文が表示されます。
      (→「ファイル名がわかっている場合」の2.へ)
      選択した項目がディレクトリ名の場合、その下の層のディレクトリ名またはファイル名の一覧が表示されます。
      （→該当のファイル名が表示されまで1.2.を繰り返す。）

　

検索画面

編集画面

▲TOPへ

ソースコード

'FTP EDITOR Ver.1.02(C)COPYRIGHT 1999 WILL
Option Explicit
Private m_Action%          'フラグ:処理の進行の状態を示す
Private m_PutData$         'システム既定の文字コードに変換された送信データ
Private m_Dirty As Boolean 'フラグ：「編集用テキストボックス」の内容変更の有無を示す
'本文の漢字コードを取得する
Private Function GetFileCode$()
    Dim i%
    
    For i = 0 To 2
        If Option1(i).Value = True Then
            GetFileCode = Option1(i).Caption
            Exit For
        End If
    Next
End Function

'ファイル名の漢字コードを取得する
Private Function GetSysCode$()
    Dim i%
    
    For i = 0 To 1
        If Option2(i).Value = True Then
            GetSysCode = Option2(i).Caption
            Exit For
        End If
    Next
End Function

'リストからファイルの種類を判別する
'戻り値は、先頭にファイルの種類を示す１文字に続き名前がくる
'不明の場合は、空文字
Private Function WhatKindOfFile$(List$)
    Dim n%, x$(), f$, p%

    'UNIXがFTPサーバーである場合、ls -algの出力結果がリストされている
    'これは、スペースで９分割されていて、９番目がファイル名である
    'DOS形式の場合は４分割されるディレクトリの場合<DIR>という文字がある
    n = Split(List, " ", x(), 9) 'x(1)...x(n)に分割
    
    If (n < 1) Then
        Exit Function
    End If
    
    f = ""
    
    If n = 4 Then  'MS-DOS
        If (Trim(x(3)) = "<DIR>") Then  'MS-DOS/ディレクトリ
            f = "D" & x(n)
        Else
            f = "F" & x(n)
        End If
    Else 'UNIX
        Select Case LCase(Left$(x(1), 1))
            Case "-"    '普通のファイル
                f = "F" & x(n)
            Case "d"    'ディレクトリ
                f = "D" & x(n)
            Case Else   '不明
                f = ""
        End Select
    End If
    WhatKindOfFile = f
End Function

'文字列を分割して配列に格納する
Private Function Split%(ByVal s$, ByVal d$, a$(), Optional mx% = 0)
    Dim i%, p%, n%
    
    If (mx < 0) Then
        mx = 0
    End If
   
    n = Len(d)
    s = LTrim(s)
    p = InStr(s, d)
    i = 0
    
    Do While (Len(s) > 0 And p > 0 And (mx = 0 Or mx > i + 1))
        i = i + 1
        ReDim Preserve a(i)
        a(i) = Mid$(s, 1, p - 1)
        s = LTrim(Mid$(s, p + n))
        p = InStr(s, d)
    Loop
    
    If (Len(s) > 0) Then
        i = i + 1
        ReDim Preserve a(i)
        a(i) = s
    End If
    Split = i
End Function

'FTP接続を始める
Private Sub StartFtp(Action%)
    
    m_Action = Action
    On Error GoTo err1
    
    'FTPサーバーに接続する接続済である場合エラー
    ftp1.Connect Text1, Text2, Text3
    
    'GETボタンを無効にする
    Command1.Enabled = False
    
    'PUTボタンを無効にする
    Command2.Enabled = False
    
    '中断ボタンを有効にする
    Command3.Enabled = True
    
    '検索ボタンを無効にする
    Command5.Enabled = False
    Exit Sub
err1:
    MsgBox Err.Description, vbExclamation, Err.Number
End Sub

'GETボタン
Private Sub Command1_Click()
    Dim r%
    
    'Text5の内容が変更されていた場合
    If m_Dirty = True Then
        'メッセージボックスを表示
        r = MsgBox("変更されている内容が失われますがよいですか？", vbYesNo, "Confirm")
        If r <> vbYes Then
            Exit Sub
        End If
    
    End If
    
    'Text5の内容が変更され,確認画面ではいと答えた場合
    StartFtp 11
End Sub

'PUTボタン
Private Sub Command2_Click()
    StartFtp 21
End Sub

'中断ボタン
Private Sub Command3_Click()
    ftp1.Abort
End Sub

'終了ボタン
Private Sub Command4_Click()
    Unload Me
End Sub

'検索ボタン
Private Sub Command5_Click()
    On Error GoTo err1
    
    'FTPサーバーに接続
    ftp2.Connect Text1, Text2, Text3
    
    '検索ボタンを無効にする
    Command5.Enabled = False
    
    'リストボックスを無効にする
    List1.Enabled = False
    Exit Sub
err1:
    MsgBox Err.Description, vbExclamation, Err.Number
End Sub

'選択ボタン
Private Sub Command6_Click()
    Dim f$ '①WhatKindOfFile()で取得したファイルの種類＋(ディレクトリ名＋)ファイル名または
				 '②ファイルの種類を外した(ディレクトリ名＋)ファイル名を示す
    Dim k$ 'ファイルの種類を示す
    Dim d$ 'ディレクトリ名またはファイル名またはディレクトリ名＋ファイル名を示す
    
    f = ""
        
    If List1.ListIndex <> -1 Then     'リストボックスから項目が選択された場合
		'ファイルの種類とファイル名を取得する
        f = WhatKindOfFile(List1.List(List1.ListIndex))
    End If
    
    If f = "" Then  'ファイルの種類が不明か何も選択されていない場合
        MsgBox "ファイルまたはディレクトリを選択してください", _
            vbExclamation, "SELECT FILE OR DIRECTORY"
        Exit Sub
    End If
    
    'fをファイルの種類とファイル名に分ける
    k = Left$(f, 1)
    f = Mid$(f, 2)
    
    'Text6の表示内容を確認し中身があればText6+/という状態にする
    If Len(Text6) = 0 Then                'Text6に何も表示されていない場合はdに何も入れない
        d = ""
    ElseIf Right$(Text6, 1) <> "/" Then   'Text6の右端が/でない場合はファイル名の右端に/を加える
        d = Text6 & "/"
    Else                'その他（右端に/がある）の場合表示されたままをdに入れる
        d = Text6
    End If
    
    'fが絶対パスのケースに対応する
    If Left$(f, 1) = "/" Then             'fが絶対パスであった場合はそのままdにfを入れる
        d = f
    Else
        d = d & f       'その他の場合はText6で指定されたディレクトリにfを加える
    End If
    
    'dがディレクトリならばText6にディレクトリ名を入れる
    If k = "D" Then
        Text6 = d
        Command5_Click
    
    'dがファイルであったならばText4にファイル名を入れる
    ElseIf k = "F" Then
        Text4 = d
        Command8_Click
        Command1_Click
    End If
End Sub

'切替ボタン
Private Sub Command8_Click()
    If Frame4.Visible = True Then       '編集フレームが有効な場合
        Frame3.Visible = True           '一覧フレームを有効にする
        Frame4.Visible = False          '編集フレームを無効にする
        Command8.Caption = "編集画面"   '切替ボタンの表示を「編集画面」にする
    Else
        Frame3.Visible = False          '一覧フレームを無効にする
        Frame4.Visible = True           '編集フレームを有効にする
        Command8.Caption = "検索画面"    '切替ボタンの表示を「検索画面」にする
    End If
End Sub

'フォームが呼び出された
Private Sub Form_Load()
    m_Dirty = False
    Command3.Enabled = False            '中断ボタンを無効にする
    Frame3.Visible = False              '一覧フレームを有効にする
    Command8.Caption = "検索画面"       '切替ボタンの表示を「検索画面」にする
End Sub

'フォームのサイズが変更された
Private Sub Form_Resize()
    On Error Resume Next
    
    '編集フレームの位置を指定
    Frame4.Left = 0
    Frame4.Height = Me.ScaleHeight - Frame4.Top
    Frame4.Width = Me.ScaleWidth
    
    'FTPOCXバージョン情報の表示位置を指定
    ftp1.Left = 0
    ftp1.Width = Frame4.Width
    ftp1.Top = Frame4.Height - ftp1.Height
    
    'Text5の表示位置を指定
    Text5.Top = 0
    Text5.Left = 0
    Text5.Width = Frame4.Width
    Text5.Height = Frame4.Height - ftp1.Height - Command1.Height * 2
    
    'GETボタンの位置を指定
    Command1.Top = Text5.Height + Command1.Height \ 2
    Command2.Top = Command1.Top
    Command3.Top = Command1.Top
    
    '一覧フレームの位置を指定
    Frame3.Top = Frame4.Top
    Frame3.Left = Frame4.Left
    Frame3.Height = Frame4.Height
    Frame3.Width = Frame4.Width
    
    'FTPOCXバージョン情報の表示位置を指定
    ftp2.Left = ftp1.Left
    ftp2.Top = ftp1.Top
    ftp2.Width = ftp1.Width
    ftp2.Height = ftp1.Height
    
    '検索ボタンの位置を指定
    Command5.Top = Command1.Top
    Command6.Top = Command1.Top
    Text6.Top = Command1.Top
    Text6.Width = (Frame3.Width - Text6.Left) * 0.9
    Label5.Top = Command1.Top
    
    'リストボックスの位置を指定
    List1.Left = 0
    List1.Top = 0
    List1.Width = Frame3.Width
    List1.Height = Frame3.Height - ftp2.Height - Command6.Height * 2
    
    On Error GoTo 0
End Sub

'送信が終了した
Private Sub ftp1_CommandDone(Code As Integer, Stat As String, Msg As String)
    If Code = 0 Then '正常に送信が終了
        Select Case m_Action
        Case 11           'GET
            m_Action = 12
            ftp1.Filetype = "A"             'ファイル転送モードをアスキーモードにする
            ftp1.FileCode = GetFileCode()   'ファイル本文の漢字コードを指定する
            ftp1.SysCode = GetSysCode()     'ファイル名の漢字コードを指定する
            ftp1.GetFile Text4              '指定されたファイルを取り出す
        Case 12
            ftp1.DisConnect                 'セッションを切断
            m_Dirty = False
        Case 21           ' PUT
            m_Action = 22
            m_PutData = StrConv(Text5, vbFromUnicode) 'Text5の文字列をUnicode からシステム既定の文字コードに変換
            ftp1.Filetype = "A"     'ファイル転送モードをアスキーモードにする
            ftp1.FileCode = GetFileCode()             'ファイル本文の漢字コードを指定する
            ftp1.SysCode = GetSysCode()               'ファイル名の漢字コードを指定する
            ftp1.PutFile Text4      'Text4にあるファイルをリモートファイルに格納する
        Case 22
            ftp1.DisConnect                 'セッションを切断
            m_Dirty = False
        End Select
    Else
        MsgBox Msg, vbExclamation, Stat & "(" & Code & ")"
        ftp1.DisConnect
    End If
End Sub

'セッションが切断された
Private Sub ftp1_DisConnected(Code As Long, Msg As String)
    Command1.Enabled = True     'GETボタンを有効にする
    Command2.Enabled = True     'PUTボタンを有効にする
    Command3.Enabled = False    '中断ボタンを無効にする
    Command5.Enabled = True     '検索ボタンを有効にする
End Sub

'データを受信した
Private Sub ftp1_GetData(data As String)
    Text5 = Text5 & StrConv(data, vbUnicode)
End Sub

'ファイル転送が始まった
Private Sub ftp1_GetOpen(SaveFileName As String)
    'データを表示する領域を空にする
    Text5 = ""
End Sub

'サーバーが受信状態になった
Private Sub ftp1_PutData(data As String)
    data = m_PutData    'システム既定の文字コードに変換されたText5内の文字列をデータとして送信する
    m_PutData = ""      '送信セッションの切断のため送信データが空になるための準備をする
End Sub

'送信が終了した
Private Sub ftp2_CommandDone(Code As Integer, Stat As String, Msg As String)
    If Code = 0 Then        '正常に送信が終了
        Select Case Stat
        Case "Connect"'ConnectメソッドによりCommanndDoneイベントが発生した場合
            ftp2.SysCode = GetSysCode() 'サーバ上でのファイル名およびエラーメッセージで使用される
    '漢字コードをGetSysCode()で指定されたものににする
            ftp2.Dir Text6              'DirメソッドによりText6で指定したディレクトリのリストを取得する
        Case "Dir"    'DirメソッドによりCommandDoneイベントが発生した場合
            ftp2.DisConnect             'セッションを切断する
        End Select
    Else  '送信が正常に終了しなかった場合
        MsgBox Msg, vbExclamation, Stat & "(" & Code & ")"
        ftp2.DisConnect     'セッションを切断する
    End If

End Sub

'ディレクトリリストを1行受け取った
Private Sub ftp2_DirData(data As String)
    List1.AddItem data
End Sub

'ディレクトリリストの送信準備ができた
Private Sub ftp2_DirOpen()
    List1.Clear
End Sub

'FTPセッションが切断された
Private Sub ftp2_DisConnected(Code As Long, Msg As String)
    Command5.Enabled = True         '検索ボタンを有効にする
    List1.Enabled = True            'リストボックスを有効にする
End Sub

'リストボックスをクリックした
Private Sub List1_Click()
    Dim f$ '①WhatKindOfFile()で取得したファイルの種類＋(ディレクトリ名＋)ファイル名または
           '②ファイルの種類を外した(ディレクトリ名＋)ファイル名を示す
    Dim k$ 'ファイルの種類を示す
    Dim d$ 'ディレクトリ名またはファイル名またはディレクトリ名＋ファイル名を示す
    f = ""
    
    If List1.ListIndex <> -1 Then       'リストボックスから項目が選択された場合
        'リストからファイルの種類を判別
        f = WhatKindOfFile(List1.List(List1.ListIndex))
    End If
    
    If f = "" Then    'ファイルの種類が不明か何も選択されていない場合
        Exit Sub
    End If
    
    'fをファイルの種類とファイル名に分ける
    k = Left$(f, 1)
    f = Mid$(f, 2)
     
    'Text6の表示内容を確認し中身があればText6+/という状態にする
    If Len(Text6) = 0 Then              'Text6に何も表示されていない場合はdに何も入れない
        d = ""
    ElseIf Right$(Text6, 1) <> "/" Then 'その他（右端に/がある）の場合表示されたままをdに入れる
        d = Text6 & "/"
    Else              'その他（右端に/がある）の場合表示されたままをdに入れる
        d = Text6
    End If
    
    'fが絶対パスのケースに対応する
    If Left$(f, 1) = "/" Then           'fが絶対パスであった場合はそのままdにfを入れる
        d = f
    Else
        d = d & f     'その他の場合はText6で指定されたディレクトリにfを加える
    End If
    
    'dがファイルであったならばText4にファイル名を入れる
    If k = "F" Then
        Text4 = d
    End If

End Sub

Private Sub List1_DblClick()
    Command6_Click
End Sub

Private Sub Text5_Change()
    m_Dirty = True
End Sub
(C) Copyright 2003 WILL Corporation. All rights reserved.