📄 send.frm
字号:
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Object = "{E88121A0-9FA9-11CF-9D9F-00AA003A3AA3}#1.0#0"; "ZIPCOM.OCX"
Begin VB.Form Form2
AutoRedraw = -1 'True
BorderStyle = 4 'Fixed ToolWindow
Caption = "发送文件"
ClientHeight = 1920
ClientLeft = 5925
ClientTop = 840
ClientWidth = 2640
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 1920
ScaleWidth = 2640
StartUpPosition = 3 '窗口缺省
Visible = 0 'False
Begin ZLIBTOOLLib.ZlibTool Zip
Height = 225
Left = 360
TabIndex = 7
Top = 1230
Visible = 0 'False
Width = 195
_Version = 65536
_ExtentX = 344
_ExtentY = 397
_StockProps = 0
End
Begin MSWinsockLib.Winsock s
Left = -15
Top = 15
_ExtentX = 741
_ExtentY = 741
_Version = 327681
RemotePort = 8889
End
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 1000
Left = 420
Top = 0
End
Begin VB.TextBox t
Height = 1380
Left = -30
Locked = -1 'True
MultiLine = -1 'True
TabIndex = 0
ToolTipText = "状态框"
Top = 0
Width = 2715
End
Begin VB.Label OutTime
AutoSize = -1 'True
Caption = "1"
Height = 180
Left = 795
TabIndex = 2
Top = 1410
Width = 90
End
Begin VB.Label Sbyte
AutoSize = -1 'True
Caption = "1"
Height = 180
Left = 2070
TabIndex = 3
Top = 1410
Width = 90
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "已发送字节:"
Height = 225
Left = 0
TabIndex = 5
Top = 1665
Width = 990
End
Begin VB.Label ll
BorderStyle = 1 'Fixed Single
Height = 285
Left = 990
TabIndex = 1
Top = 1635
Width = 1665
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "每秒字节数:"
Height = 180
Left = 1110
TabIndex = 4
Top = 1410
Width = 990
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "经过时间:"
Height = 180
Left = 15
TabIndex = 6
Top = 1410
Width = 810
End
End
Attribute VB_Name = "Form2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Base 1
Option Explicit
Dim loge As Long
Dim t1 As Long, t2 As Long
Dim Seof As Boolean
Dim Bt As Long, SB As Long, Tempath As String
Dim Dbuf() As Byte, OpenFileNum As Integer
Private Sub Form_Load()
On Error Resume Next
Dim Commag As String
Tempath = Getwin(True)
Seof = False
loge = 0
With Form1
.Sfile.Enabled = False
.SSound.Enabled = False
If .SoundSend = False Then
.W1.SendData "sfil" & .Locateuser & "~" & .Selectuser & "~" & .SeleFile & "~" & FileLen(.SeleFile) & "~" & .W1.LocalIP & "F"
DoEvents
Me.Show
Else
If Dir(Tempath & "\SR") <> "" Then Kill Tempath & "\SR"
Zip.InputFile = Form1.Comm '将文件'Rtmp'进行压缩
Zip.OutputFile = Tempath & "\SR" '将压缩文件存为'Rtmp'
Zip.Compress
.W1.SendData "sfil" & .Locateuser & "~" & .Selectuser & "~" & Tempath & "\SR" & "~" & FileLen(Tempath & "\SR") & "~" & .W1.LocalIP & "S"
DoEvents
.SeleFile = Tempath & "\SR"
Me.Hide
End If
Close
OpenFileNum = FreeFile
Open .SeleFile For Binary As OpenFileNum '打开了二次,错误
End With
s.Close
Bt = CLng(Timer()): Timer1.Enabled = True
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Me.Visible = False
With Form1
.Sfile.Enabled = True
.SSound.Enabled = True
.SoundSend = False
.Chang 0, "校园及时通-" & .Locateuser
End With
End Sub
Private Sub s_Connect()
If Form1.SoundSend = False Then
t.Text = t.Text & "已连接" & Chr(13) & Chr(10)
t.Text = t.Text & "文件长为:" & LOF(OpenFileNum) & Chr(13) & Chr(10)
End If
t1 = CLng(Timer)
Call PreDate
End Sub
Private Sub PreDate()
On Error Resume Next
If Seof = True Then
Beep
If Form1.SoundSend = False Then t.Text = t.Text & Chr(13) & Chr(10) & "已发送完了" Else Wave.Caption = "语音消息已发送完"
s.SendData "lminceptend"
DoEvents
Timer1.Enabled = False
Beep
Close
Exit Sub
End If
loge = loge + 5000
If Not loge < LOF(OpenFileNum) Then
ReDim Dbuf(LOF(OpenFileNum) + 5000 - loge) As Byte
Seof = True
Else
ReDim Dbuf(5000) As Byte
End If
Get OpenFileNum, , Dbuf()
s.SendData Dbuf()
DoEvents
ll.Caption = loge
End Sub
Private Sub s_DataArrival(ByVal bytesTotal As Long)
Call PreDate
End Sub
Private Sub s_Close()
Reset
Unload Me
End Sub
Private Sub s_SendComplete()
If Timer1.Enabled = False And Seof = True Then
Unload Me
End If
End Sub
Private Sub Timer1_Timer()
On Error Resume Next
OutTime.Caption = CLng(Timer() - t1)
SB = CLng(loge / OutTime.Caption)
If OutTime.Caption <> 0 Then Sbyte.Caption = SB
If SB <> "" And SB <> 0 Then
If Form1.SoundSend = True Then
Wave.Caption = "还需" & Int((LOF(OpenFileNum) \ SB) - Timer() + t1) & "秒发送完"
Else
Me.Caption = "估计还需要" & Int((LOF(OpenFileNum) \ SB) - Timer() + t1) & "秒完成"
End If
Bt = CLng(Timer())
End If
If Timer() - Bt < 25 Then Exit Sub
Beep
With Form1
If .SoundSend = False Then
.ht.Text = "网络超时,传送框关闭" & .ht.Text & Chr(13) & Chr(10)
Else
.ht.Text = "网络超时,语音发送框关闭" & .ht.Text & Chr(13) & Chr(10): Unload Wave
End If
End With
Unload Me
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -