get.frm

一个VB编写的校园即时广播系统,具有简单的定时广播性能

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 Getf 
   AutoRedraw      =   -1  'True
   BorderStyle     =   4  'Fixed ToolWindow
   Caption         =   "接收文件"
   ClientHeight    =   1920
   ClientLeft      =   2220
   ClientTop       =   2865
   ClientWidth     =   2640
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1920
   ScaleWidth      =   2640
   StartUpPosition =   3  '窗口缺省
   Begin ZLIBTOOLLib.ZlibTool zip 
      Height          =   570
      Left            =   315
      TabIndex        =   3
      Top             =   645
      Visible         =   0   'False
      Width           =   330
      _Version        =   65536
      _ExtentX        =   582
      _ExtentY        =   1005
      _StockProps     =   0
   End
   Begin MSWinsockLib.Winsock g 
      Left            =   315
      Top             =   0
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   327681
      LocalPort       =   8889
   End
   Begin MSWinsockLib.Winsock l 
      Left            =   -30
      Top             =   0
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   327681
      LocalPort       =   8889
   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 Label1 
      AutoSize        =   -1  'True
      Caption         =   "已收到的字节数:"
      Height          =   180
      Left            =   0
      TabIndex        =   2
      Top             =   1560
      Width           =   1350
   End
   Begin VB.Label Ll 
      BorderStyle     =   1  'Fixed Single
      Height          =   285
      Left            =   1350
      TabIndex        =   1
      Top             =   1515
      Width           =   1290
   End
End
Attribute VB_Name = "Getf"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Base 1
Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Private Declare Function waveOutGetNumDevs Lib "winmm.dll" () As Long
Dim Tempath As String, ifEnd As String
Dim Buf() As Byte, OpenFileNum As Integer

Private Sub Form_Load()
Dim ok As Integer
Reset
OpenFileNum = FreeFile
With Form1
.Sfile.Enabled = False
.SSound.Enabled = False
Tempath = Getwin(True)
  If .SoundGet = True Then
    If Dir(Tempath & "\sound", 16) = "" Then MkDir Tempath & "\sound"
      If Dir(Tempath & "\sound\RS") <> "" Then Kill Tempath & "\sound\RS"
      Open Tempath & "\sound\RS" For Binary As OpenFileNum
      .Chang 1, "传送语音"
    Me.Hide
 Else
     If .SeleFile = "" Then .SeleFile = "c:\Temp"
       If Dir(.SeleFile) <> "" Then Kill .SeleFile
        Open .SeleFile For Binary As OpenFileNum
         .Chang 4, "传送文件"
           Me.Show
 End If
     End With
     l.Listen
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Me.Visible = False
Reset
With Form1
.Sfile.Enabled = True
.SSound.Enabled = True
.SoundGet = False
.Caption = .Locateuser & "校园及时通"
.Chang 0, "校园及时通-" & .Locateuser
End With
End Sub

Private Sub g_DataArrival(ByVal bytesTotal As Long)
On Error Resume Next
ReDim Buf(bytesTotal) As Byte
g.PeekData ifEnd
g.GetData Buf()
ll.Caption = LOF(OpenFileNum)
If ifEnd = "lminceptend" Then
Call ProEnd
Exit Sub
End If
Put OpenFileNum, , Buf
g.SendData "okokokokokokokokokokok"
DoEvents
If Form1.SoundGet = False Then
Me.Caption = "已接收" & Int((LOF(OpenFileNum) / Form1.Filelegen * 100)) & "%"
Else
Form1.Caption = "估计还有" & Int(100 - ((LOF(OpenFileNum) / Form1.Filelegen * 100))) & "%"
End If
ll.Caption = LOF(OpenFileNum)
End Sub

Private Sub l_ConnectionRequest(ByVal requestID As Long)
g.Accept requestID
If Form1.SoundGet = False Then t.Text = t.Text & "OK ! 已联接" & Chr(13) & Chr(10)
End Sub

Private Sub ProEnd()
On Error Resume Next
Reset
If Form1.SoundGet = True Then
     Zip.InputFile = Tempath & "\sound\RS"
         If (Tempath & "\sound\RTmp") <> "" Then Kill Tempath & "\Sound\RTmp"
            Zip.OutputFile = Tempath & "\Sound\Rtmp"
               Zip.Decompress
                 sndPlaySound SavePath & "mag", &H1 Or &H2
                   If MsgBox("语音消息已全部接收,是否现在就听", vbYesNo + vbSystemModal + vbQuestion, "提示") = vbYes Then sndPlaySound Tempath & "\Sound\RTmp", &H1 Or &H2
                     Unload Me
Else
             Beep
               t.Text = t.Text & Chr(13) & Chr(10) & "已接收完"
             t.Text = t.Text & Chr(13) & Chr(10) & "文件名为" & Form1.SeleFile
          Me.Caption = "100% 已全部完成"
End If
End Sub

Private Sub g_Close()
If Form1.SoundGet = False Then t.Text = t.Text & "已断开连接" & Chr(13) & Chr(10)
Unload Me
End Sub