fasend.bas

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

Attribute VB_Name = "Fasend"

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

Public fileinfo As Long         '记录下次要发送的信息，在完成一次发送操作时检查
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
'Public Const HWND_TOPMOST = -1
'Public Const SWP_NOSIZE = &H1

Dim w1 As Long     '为要传输文件的总大小

Public Filesdb As String

Public list1path() As String       '为listview1中要传送文件的路径的数组

Public list2path As String   'listview2中的当前文件夹对象路径
Dim list1index As Long    '在listimage 中枚举的进度   改为在数组中的素引

Public desktoppath As String   'list2中桌面的路径
Public x文档 As String         'list2中的文档的路径


Public l2f1 As String            '为被控方IP


Public Sub list1tolist2(er As Integer)   'er用于区别是否为出错处理程序



Fapt.Label6.Caption = "总 " & UBound(list1path) + 1 & "个文件，已传输" & list1index & "个文件."



If (list1index <= UBound(list1path)) Then


Call file1(list1path(list1index), list2path)


list1index = list1index + 1

Else

     Fapt.Command1.Caption = "完成"

     list1index = 0
     
     
     
      Call refu(list2path, 2)

End If



End Sub






Public Sub file1(path As String, filepath As String)

On Error GoTo er

Open path For Binary As #1


w1 = LOF(1)

If (w1 = 0) Then

fileinfo = 5

Else

fileinfo = 1

End If


Dim path1 As String
path1 = Faws.ListView1.SelectedItem.Key
Dim b2 As String
Dim b1 As Long
Dim b3 As Long
Dim name As String


If (Right(path1, 1) = "\") Then
 
 
path1 = Left(path1, Len(path1) - 1)
 
 
End If

 b2 = "\"
 b1 = Len(path1)
 Do While b1 >= 1
 b1 = b1 - 1
 
 b3 = InStr(b1, path1, b2, 1)
 
 If (b3 > 0) Then
 
 Exit Do
 End If
 
 Loop
 
 
 Fapt.Pbar1.Max = w1
 
 name = Mid(path, b3 + 1)
 



 
 Faws.Scmnet3.SendData "2" & w1 & "." & filepath & name      '发送文件信息
 
 
 


 
 Fapt.Label1.Caption = "从:" & Left(path, Len(path) - Len(path) + 42) & "..."
 Fapt.Label5.Caption = "到:" & Faws.Scmnet3.RemoteHostIP & "\\" & filepath & name & Left(filepath, Len(filepath) - Len(filepath) + 10) & "..."


 '''''''''''''''''''''''''''
  If w1 < 1024 Then
  
  Filesdb = "共有:" & Round(w1, 2) & "字节 "
  
  
  
  ElseIf w1 < 1048576 Then
  
  
  Filesdb = w1 / 1024
  
  Filesdb = "共有:" & Round(Filesdb, 2) & "KB "
  
  
  ElseIf w1 < 1073741824 Then
  
  
  Filesdb = w1 / 1024 / 1024
  
  Filesdb = "共有:" & Round(Filesdb, 2) & "MB "
  
  
  
  ElseIf w1 >= 1073741824 Then
  
   Filesdb = w1 / 1024 / 1024 / 1024
  
  Filesdb = "共有:" & Round(Filesdb, 2) & "GB "
  
  
  
  End If
  '''''''''''''''''''''''''''''''''''



 
Exit Sub

er:

MsgBox "读 “" & path & " ”出错，文件拒绝方问或其它原因", 16, "出错"
  
  list1index = list1index + 1
  fileinfo = 0
  Close #1

  Call list1tolist2(1)
 
 list1index = list1index - 1

End Sub


Public Sub file2()

Dim w3 As Long     '记录发送了多少字节数
Dim w2 As Long     '每次发送字节数
w2 = 8191
'w2 = 1048576
'w2 = 1073741824

Dim File() As Byte



If (w1 <= w2) Then

    ReDim File(w1 - 1)

     Get #1, , File

     Faws.Scmnet3.SendData File
     
     'Fapt.Pbar1.Value = w1
     
     fileinfo = 5
    ' Fapt.Label3.Caption = "已发送 " & w1 & " 字节"
    ' Fapt.Label4.Caption = "剩余 0" & " 字节"

    
Else
  
   Dim w5, fns As Long
   
   Dim jfns As String
   
   Dim Rnbs As Long
   
   Dim Robs As String
   
   w5 = Loc(1)
   
       Fapt.Pbar1.Value = w5
   
  ' Fapt.Label3.Caption = "已发送 " & w5 & " 字节"
   'Fapt.Label4.Caption = "剩余 " & w1 - w5 & " 字节"
   '''''''''''''''''''''''''''''
   
   Rnbs = w1 - w5

If w5 < 1024 Then
  
  jfns = "已发送:" & w5 & "字节 "

ElseIf w5 < 1048576 Then

jfns = w5 / 1024

jfns = "已发送:" & Round(jfns, 2) & "KB "

ElseIf w5 < 1073741824 Then

jfns = w5 / 1024 / 1024

jfns = "已发送:" & Round(jfns, 2) & "MB "

ElseIf w5 >= 1073741824 Then

jfns = w5 / 1024 / 1024 / 1024

jfns = "已发送:" & Round(jfns, 2) & "GB "

End If
   
   ''''''''''''''''''''''''''''''''
   
  If Rnbs < 1024 Then
  
  fns = (w5 / w1) * 100
  
  Fapt.Label2.Caption = "(" & Filesdb & jfns & " 剩余:" & Rnbs & "字节" & ")" & " 已完成" & fns & "%"
  
  ElseIf Rnbs < 1048576 Then
  
  fns = (w5 / w1) * 100
  
   Robs = Rnbs / 1024
  
  Fapt.Label2.Caption = "(" & Filesdb & jfns & "剩余:" & Round(Robs, 2) & "KB" & ")" & " 已完成:" & fns & "%"
  
  ElseIf Rnbs < 1073741824 Then
  
  fns = (w5 / w1) * 100
  
  Robs = Rnbs / 1024 / 1024
  
  Fapt.Label2.Caption = "(" & Filesdb & jfns & "剩余:" & Round(Robs, 2) & "MB" & ")" & " 已完成:" & fns & "%"
  
  ElseIf Rnbs >= 1073741824 Then
  
  fns = (w5 / w1) * 100
  
   Robs = Rnbs / 1024 / 1024 / 1024
  
  Fapt.Label2.Caption = "(" & Filesdb & jfns & "剩余:" & Round(Robs, 2) & "GB" & ")" & " 已完成:" & fns & "%"
  
  End If
  '''''''''''''''''''''''''''''''''''
  
   
' MsgBox w5 & "  " & w2 & "  " & w1
  
  If (w5 + w2 + 1 >= w1) Then
   
  fileinfo = 5
  
  
  ReDim File(w1 - w5 - 1)
  Get #1, , File
  Faws.Scmnet3.SendData File
  
  'Fapt.Pbar1.Value = w1
  
  ' Fapt.Label3.Caption = "已发送 " & w1 & " 字节"
  'Fapt.Label4.Caption = "剩余 0" & " 字节"
  


  Else
  
  
  ReDim File(w2)
  
  Get #1, , File
  
 
  Faws.Scmnet3.SendData File
  
  'Fapt.Pbar1.Value = w2
  
  
  End If
  
 
End If
End Sub