Module


  ソースコード




  

' ------------------------------------------------------
' コントロールサイズ調整用
' ------------------------------------------------------
Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
Declare Function GetClientRect Lib "user32" _
(ByVal hwnd As Long, _
lpRect As RECT) As Long

' ------------------------------------------------------
' イメージ番号
' ------------------------------------------------------
Global Const Image_Closed = 1
Global Const Image_Opend = 2
Global Const Image_Leaf = 5
Global Const Image_Up = 6

' ------------------------------------------------------
' ドラッグドロップ
' ------------------------------------------------------
Global nWidthTreeView As Integer
Global nDrag As Integer
Global ListSelect()

Public Const DRAG_BAR = 1
Public Const DRAG_FTPFILE = 2
Public Const DRAG_LOCALFILE = 3


' ******************************************************
' ドラッグドロップ
' ******************************************************
Public Sub DragDropAction( _
    frm As Form, _
    x As Single, _
    Source As Control, _
    Target As Object _
)

    ' *******************************
    ' 境界変更用
    ' *******************************
    Dim rc As RECT
    
    ' *******************************
    ' ダウンロード・アップロード用
    ' *******************************
    Dim strPath As String
    Dim strRet As String
    Dim nodフォルダ As Node
    
    Select Case nDrag
        
        ' ********************************************
        ' 境界変更
        ' ********************************************
        Case DRAG_BAR

            ' サイズ変更バーを左へ移動した場合
            If Target.Name = "trvサーバ" Then
                nWidthTreeView = x
            ' サイズ変更バーを右へ移動した場合
            Else
                nWidthTreeView = frm.trvサーバ.Width + x
            End If
            
            ' ***********************************
            ' ツリーのサイズ調整
            ' ***********************************
            GetClientRect frm.hwnd, rc
            With frm.trvサーバ
                .Width = nWidthTreeView
                .Height = frm.ScaleY(rc.Bottom, vbPixels, vbTwips)
            End With
        
            ' ***********************************
            ' ツリー以外のサイズ調整
            ' ***********************************
            Call ArrangeSize(frm)
        
        ' ********************************************
        ' ダウンロード
        ' ********************************************
        Case DRAG_FTPFILE
        
            Set nodフォルダ = frm.trvサーバ.SelectedItem
    
            If Target.Name = "lstローカル" Then
                strPath = frm.filローカル.Path & "\" & nodフォルダ.Text
                If vbOK = MsgBox("ダウンロードを開始します。よろしいですか?", vbOKCancel) Then
                    strRet = Module1.lbFTPDownload("/" & nodフォルダ.FullPath, strPath)
                    If strRet <> "" Then
                        MsgBox (strRet)
                    Else
                        MsgBox ("ダウンロードが終了しました")
                        
                        LoadListView frm
                        
                    End If
                End If
            End If
    
        ' ********************************************
        ' アップロード
        ' ********************************************
        Case DRAG_LOCALFILE
            
            If Target.Name = "trvサーバ" Then
                strPath = frm.filローカル.Path & "\" & frm.lstローカル.SelectedItem.Text
                If vbOK = MsgBox("アップロードを開始します。よろしいですか?", vbOKCancel) Then
                
                    strRet = Module1.lbFTPUpload( _
                                "/" & _
                                frm.trvサーバ.SelectedItem.FullPath & _
                                "/" & _
                                frm.lstローカル.SelectedItem.Text _
                                , strPath)
                    If strRet <> "" Then
                        MsgBox (strRet)
                    Else
                        MsgBox ("アップロードが終了しました")
                        
                        Call ResetTreeNode
                        
                    End If
                End If
            End If
    
    
    End Select
    
End Sub

' ******************************************************
' ローカルファイルリスト作成
' ******************************************************
Public Sub LoadListView(frm As Form)
    
    Dim i As Long
    Dim oFILE As FileListBox
    Dim oDIR As DirListBox
    Dim oLIST As ListView
    
    Dim oITEM As ListItem
    Dim strDir As String
    Dim nPos As Long
    
    Set oFILE = frm.filローカル
    Set oLIST = frm.lstローカル
    Set oDIR = frm.dirローカル
  
    ' *************************************************
    ' ファイルとディレクトリのリストを最新にする
    ' *************************************************
    oFILE.Path = CurDir()
    oFILE.Refresh
    oDIR.Path = CurDir()
    oDIR.Refresh
    
    ' *************************************************
    ' カレントディレクトリを表示
    ' *************************************************
    frm.lbl現在ディレクトリ.Caption = oFILE.Path
    
    ' *************************************************
    ' リストビューをクリア
    ' *************************************************
    oLIST.ListItems.Clear
    
    ' *************************************************
    ' 親ディレクトリへ移動用の項目を追加
    ' *************************************************
    Set oITEM = oLIST.ListItems.Add(, , "親ディレクトリ", , Image_Up)
    
    ' *************************************************
    ' ディレクトリリストを追加
    ' *************************************************
    For i = 0 To oDIR.ListCount - 1
        
        nPos = InStrRev(oDIR.List(i), "\")
        strDir = Right(oDIR.List(i), Len(oDIR.List(i)) - nPos)
        Set oITEM = oLIST.ListItems.Add(, , strDir, , Image_Closed)
            
    Next i
    
    ' *************************************************
    ' ファイルリストを追加
    ' *************************************************
    For i = 0 To oFILE.ListCount - 1
        
        Set oITEM = oLIST.ListItems.Add(, , oFILE.List(i), , Image_Leaf)
        oITEM.SubItems(1) = FileLen(oFILE.List(i))
        oITEM.SubItems(2) = FileDateTime(oFILE.List(i))
            
    Next i

    ' *************************************************
    ' 選択リスト用配列の初期化
    ' *************************************************
    ReDim ListSelect(frm.lstローカル.ListItems.Count)

End Sub

' ******************************************************
' フォームをデスクトップの中央に移動
' ******************************************************
Public Function lbCenterWindow(TargetForm As Form)

    With TargetForm
        .Move (Screen.Width - .Width) / 2, (Screen.Height - .Height) / 2
    End With

End Function

' ******************************************************
' 子ノードを追加
' ******************************************************
Public Function AddChildNode(TargetTree As TreeView, TargetIndex As Variant)

    Dim i As Integer

    For i = 1 To Form1.grd一覧.Rows - 1
        
        If Form1.grd一覧.TextMatrix(i, 5) = "10" Then
            If Left(Form1.grd一覧.TextMatrix(i, 1), 1) <> "." Then
                TargetTree.Nodes.Add _
                    TargetIndex, _
                    tvwChild, _
                    , _
                    Form1.grd一覧.TextMatrix(i, 1), _
                    Image_Closed
            End If
        End If
        If Form1.grd一覧.TextMatrix(i, 5) = "80" Then
            If Left(Form1.grd一覧.TextMatrix(i, 1), 1) <> "." Then
                TargetTree.Nodes.Add _
                    TargetIndex, _
                    tvwChild, _
                    , _
                    Form1.grd一覧.TextMatrix(i, 1), _
                    Image_Leaf
            End If
        End If
            
    Next i

End Function

' ******************************************************
' ノードを開く
' ******************************************************
Public Function OpenNode(TargetNode As Node)

    ' ターゲットのノードを開く
    TargetNode.Expanded = True
    
    ' ノードを開いた時のイメージを設定
    TargetNode.ExpandedImage = Image_Opend

End Function

' ******************************************************
' ツリービュー以外のサイズ調整
' ******************************************************
Public Function ArrangeSize(frm As Form)

    Dim rc As RECT

    ' *************************************************
    ' ウインドウ内のサイズ取得
    ' *************************************************
    GetClientRect frm.hwnd, rc
    
   ' *************************************************
    ' 境界
    ' *************************************************
    With frm.drgBar
        .Left = frm.trvサーバ.Width
        .Top = 0
        .Height = frm.ScaleY(rc.Bottom, vbPixels, vbTwips)
    End With
    
    ' *************************************************
    ' ドライブ変更用
    ' *************************************************
    With frm.drvローカル
        .Left = frm.trvサーバ.Width + frm.drgBar.Width
        .Top = 0
        .Width = frm.ScaleX(rc.Right, vbPixels, vbTwips) _
            - .Left
    End With
    
    ' *************************************************
    ' カレントディレクトリ表示
    ' *************************************************
    With frm.lbl現在ディレクトリ
        .Left = frm.trvサーバ.Width + frm.drgBar.Width
        .Top = frm.drvローカル.Height
        .Width = frm.ScaleX(rc.Right, vbPixels, vbTwips) _
            - .Left
    End With
    
    ' *************************************************
    ' ローカルディレクトリビュー
    ' *************************************************
    With frm.lstローカル
        .Left = frm.trvサーバ.Width + frm.drgBar.Width
        .Top = frm.drvローカル.Height _
                + frm.lbl現在ディレクトリ.Height
        .Width = frm.ScaleX(rc.Right, vbPixels, vbTwips) _
            - .Left
        .Height = frm.ScaleY(rc.Bottom, vbPixels, vbTwips) _
            - .Top
    End With

End Function

' ******************************************************
' ツリーのノードデータを再取得
' ******************************************************
Public Function ResetTreeNode()

    Dim nodフォルダ As Node
    Dim TargetText As String
    Dim TargetIndex As Integer
    Dim i As Integer
    
    Set nodフォルダ = Form2.trvサーバ.SelectedItem
    
    ' 選択しているノードのテキスト
    TargetText = nodフォルダ.Text
    ' 選択しているノードのインデックス
    TargetIndex = nodフォルダ.Index

    ' 選択しているノード以下のサーバ側のファイル一覧を作成
    Call Module1.lbFTPEnum( _
        nodフォルダ.FullPath, _
        "*.*", _
        Form1.grd一覧 _
    )
    
    ' 選択しているノードを削除
    Call Form2.trvサーバ.Nodes.Remove(TargetIndex)
    
    ' 削除したノードを再度追加
    Set nodフォルダ = Form2.trvサーバ.Nodes.Add _
        (Form2.trvサーバ.SelectedItem.Index, _
        tvwPrevious, _
        , _
        TargetText, _
        Image_Closed)
        
    ' 追加したノードを選択状態にする
    nodフォルダ.Selected = True
    
    ' 追加したノードのインデックス
    TargetIndex = Form2.trvサーバ.SelectedItem.Index

    ' 子ノードを追加
    Call AddChildNode(Form2.trvサーバ, TargetIndex)
    
    ' ターゲットのノードを開く
    Call OpenNode(Form2.trvサーバ.SelectedItem)

End Function

  










yahoo  google  MSDN  MSDN(us)  WinFAQ  Win Howto  tohoho  ie_DHTML  vector  wdic  辞書  天気 


[PROftpclient]
Mozilla/5.0 AppleWebKit/537.36 (KHTML, like Gecko; compatible; ClaudeBot/1.0; +claudebot@anthropic.com)
24/04/19 14:01:25
InfoBoard Version 1.00 : Language=Perl

1 BatchHelper COMprog CommonSpec Cprog CprogBase CprogSAMPLE CprogSTD CprogSTD2 CprogWinsock Cygwin GameScript HTML HTMLcss InstallShield InstallShieldFunc JScript JScriptSAMPLE Jsfuncs LLINK OldProg OracleGold OracleSilver PRO PRObrowser PROc PROconePOINT PROcontrol PROftpclient PROjscript PROmailer PROperl PROperlCHAT PROphp PROphpLesson PROphpLesson2 PROphpLesson3 PROphpfunction PROphpfunctionArray PROphpfunctionMisc PROphpfunctionString PROsql PROvb PROvbFunction PROvbString PROvbdbmtn PROvbonepoint PROwebapp PROwin1POINT PROwinSYSTEM PROwinYOROZU PROwindows ProjectBoard RealPHP ScriptAPP ScriptMaster VBRealtime Vsfuncs a1root access accreq adsi ajax amazon argus asp aspSample aspVarious aspdotnet aw2kinst cappvariety centura ckeyword classStyle cmaterial cmbin cmdbapp cmenum cmlang cmlistbox cmstd cmstdseed cmtxt cs daz3d db dbCommon dbaccess dnettool dos download flex2 flex3 flex4 framemtn framereq freeWorld freesoft gimp ginpro giodownload google hdml home hta htmlDom ie9svg install java javaSwing javascript jetsql jquery jsp jspTest jspVarious lightbox listasp listmsapi listmsie listmsiis listmsnt listmspatch listmsscript listmsvb listmsvc memo ms msde mysql netbeans oraPlsql oracle oracleWiper oraclehelper orafunc other panoramio pear perl personal pgdojo pgdojo_cal pgdojo_holiday pgdojo_idx pgdojo_ref pgdojo_req php phpVarious phpguide plsql postgres ps r205 realC realwebapp regex rgaki ruby rule sboard sc scprint scquest sdb sdbquest seesaa setup sh_Imagick sh_canvas sh_dotnet sh_google sh_tool sh_web shadowbox shgm shjquery shvbs shweb sjscript skadai skywalker smalltech sperl sqlq src systemdoc tcpip tegaki three toolbox twitter typeface usb useXML vb vbdb vbsfunc vbsguide vbsrc vpc wcsignup webanymind webappgen webclass webparts webtool webwsh win8 winofsql wmi work wp youtube