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

📄 send.frm

📁 一个VB编写的校园即时广播系统,具有简单的定时广播性能
💻 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 + -