⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 slist2.bas

📁 星子行主机控制系统用于主机管理,方便远程操作,通信等功能.更 方便用于局域网,管理速度快,连接简单方便.注意:星子行连接可用 于带路由主机与带路由主机之间连接,非路由与非路由之间连接.带
💻 BAS
字号:
Attribute VB_Name = "Slist2"

Option Explicit

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)


Public list2s() As String        '要传送文件对象数组
Public a4 As Long                '传入时用的索引
Public list2index As Long        '传出时用的索引

Private w1 As Long    '记录要发送文件的总大小

Public list2bool As Long   ' 确定是发数据还是文件夹名

Public Sub list2tolist1(a3 As String)

On Error Resume Next

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 list2to1(f1.path)
        
      Next
    
      Set fc = f.Files
      For Each f1 In fc
               
      ReDim Preserve list2s(a4)
      
          list2s(a4) = f1.path
          
         ' MsgBox a4 & "  " & list1path(a4)
          
          a4 = a4 + 1
          
      Next
     
Else
     
     ReDim Preserve list2s(a4)
     
     list2s(a4) = a3
     
     'MsgBox a4 & "  " & list1path(a4)
     
     a4 = a4 + 1
     
     
     
End If




End Sub



Private Sub list2to1(a1 As String)

      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 list2to1(f1.path)
        
      Next
    
      Set fc = f.Files
      For Each f1 In fc
               
      ReDim Preserve list2s(a4)
      
          list2s(a4) = f1.path
          
     '     MsgBox a4 & "  " & list1path(a4)
          
          a4 = a4 + 1
          
      Next




End Sub

Public Sub list2send()


On Error GoTo er

If (list2index <= UBound(list2s)) Then

Open list2s(list2index) For Binary As #1

w1 = LOF(1)


list2bool = 1

main1.Winsock5.SendData list2bool & w1 & "." & list2s(list2index)

If (w1 = 0) Then

Close #1

list2bool = 2

End If

list2index = list2index + 1

Else

list2bool = 0
list2index = 0

main1.Winsock5.SendData 2 & "完成发送"

a4 = 0

ReDim list2s(0)

End If


Exit Sub

er:
  list2index = list2index + 1

  list2bool = 0
  Close #1

  Call list2send

End Sub

Public Sub list2send2()

Dim w2 As Long
w2 = 8191
'w2 = 1048576

Dim file() As Byte



If (w1 <= w2) Then

    ReDim file(w1 - 1)

     Get #1, , file

     main1.Winsock5.SendData file
     
     list2bool = 2
    
Else
  
   Dim w5 As Long
   w5 = Loc(1)
   
  
  
  If (w5 + w2 + 1 >= w1) Then
   
   list2bool = 2
  
  
  ReDim file(w1 - w5 - 1)
  Get #1, , file
  main1.Winsock5.SendData file
  
     
  Else
  
  
  ReDim file(w2)
  
  Get #1, , file
  
 
  main1.Winsock5.SendData file
  
  
  End If
  
 
End If


End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -