form4.frm

高校排课系统.这个小程序使用了皮肤控件

VERSION 5.00
Object = "{74848F95-A02A-4286-AF0C-A3C755E4A5B3}#1.0#0"; "actskn43.ocx"
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form Form4 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "升级提示"
   ClientHeight    =   4800
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   6915
   Icon            =   "Form4.frx":0000
   LinkTopic       =   "Form4"
   MaxButton       =   0   'False
   ScaleHeight     =   4800
   ScaleWidth      =   6915
   StartUpPosition =   1  '所有者中心
   Begin VB.TextBox Text3 
      Height          =   270
      Left            =   600
      TabIndex        =   6
      Text            =   "Text2"
      Top             =   4800
      Width           =   255
   End
   Begin MSWinsockLib.Winsock Winsock1 
      Left            =   5520
      Top             =   4200
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   100
      Left            =   2280
      Top             =   0
   End
   Begin VB.Frame Frame1 
      Caption         =   "新版升级说明"
      Height          =   3735
      Left            =   120
      TabIndex        =   4
      Top             =   480
      Width           =   6615
      Begin VB.TextBox Text1 
         Height          =   3375
         Left            =   120
         Locked          =   -1  'True
         MultiLine       =   -1  'True
         ScrollBars      =   3  'Both
         TabIndex        =   5
         Text            =   "Form4.frx":000C
         Top             =   240
         Width           =   6375
      End
   End
   Begin VB.CommandButton Command2 
      Caption         =   "跳 过"
      Height          =   375
      Left            =   3720
      TabIndex        =   3
      Top             =   4320
      Width           =   1455
   End
   Begin VB.CommandButton Command1 
      Caption         =   "我要升级"
      Height          =   375
      Left            =   1680
      TabIndex        =   2
      Top             =   4320
      Width           =   1455
   End
   Begin ACTIVESKINLibCtl.Skin pkskn 
      Left            =   120
      OleObjectBlob   =   "Form4.frx":001D
      Top             =   0
   End
   Begin ACTIVESKINLibCtl.SkinLabel SkinLabel2 
      Height          =   375
      Left            =   5280
      OleObjectBlob   =   "Form4.frx":0251
      TabIndex        =   1
      Top             =   240
      Width           =   1455
   End
   Begin ACTIVESKINLibCtl.SkinLabel SkinLabel1 
      Height          =   375
      Left            =   5280
      OleObjectBlob   =   "Form4.frx":02AF
      TabIndex        =   0
      Top             =   0
      Width           =   1575
   End
End
Attribute VB_Name = "Form4"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim DataByte() As Byte
Dim StartTime As Date '连接服务器的时间
Dim UPI As Boolean

Private Sub Command1_Click()
'Shell "Rundll32.exe " & App.Path & "\update.exe", vbNormalFocus
Shell App.Path & "\Update.exe", vbNormalFocus
'ShellForWait App.Path & "\update.exe", , &HFFFF
'Shell "Explorer /s ," & App.Path & "\update.exe"
End
End Sub

Private Sub Command2_Click()
On Error Resume Next
EXIT_UP = True
Unload Me
Form1.Show
End Sub

Private Sub Form_Load()
pkskn.LoadSkin App.Path & "\chizh.skn"
pkskn.ApplySkinByName hWnd, "窗体"
pkskn.ApplySkin hWnd
SkinLabel1.Caption = "当前版本号:" & VersionN
SkinLabel2.Caption = "升级后版本:" & NEW_VersionN
UPTT
End Sub
Private Sub UPLIST_TXT()
 If Dir(FileName, vbNormal) <> "" Then
 Dim strinput As String
 Dim intfile As Integer
 intfile = FreeFile
 filesize = FileLen(FileName)
 Open FileName For Binary As #intfile
  strinput = Space(filesize)
 Get #intfile, , strinput
 Close #intfile
 Text1.Text = strinput
 End If
End Sub
Public Sub UPTT()
StartTime = Time()
If Winsock1.State = 0 Then '或0,6代表正在连接,7代表连接成功
Winsock1.RemoteHost = UPIP '返回或设置远程计算机，控件向它发送数据或从它那里接收数据。既可提供主机名，比如 "FTP://ftp.microsoft.com"，也可提供点格式下的 IP 地址字符串，比如 "100.0.1.1"。
Winsock1.RemotePort = 80 '返回或设置要连接的远程端口号
Winsock1.Connect
End If
Do While Winsock1.State <> sckConnected
    DoEvents: DoEvents: DoEvents: DoEvents
    '连接时间超过20秒或取消下载，退出该过程并返回false
    If DateDiff("s", StartTime, Time()) > 20 Then
        MsgBox "连接服务器时间过长!", vbInformation, "连接失败！"
        Exit Do
    End If
Loop
Text3.Text = UPlist '必须经过文本处理，否则将会有许多未知字符出错
strcommand = "GET " + Text3.Text + " HTTP/1.0" + vbCrLf 'GET 为FTP命令
strcommand = strcommand + vbCrLf      '记住一定要加上vbCrLf
FileName = App.Path & "\" & "uplist.up"
If Dir(FileName) <> "" Then
Kill FileName
End If
If Dir(FileName, vbNormal) <> "" Then
 Kill FileName
End If
bAppend = False
Winsock1.SendData strcommand  ''给远程计算机发送数据
Timer1.Enabled = True
End Sub

Private Sub Form_Unload(Cancel As Integer)
Call Command2_Click
End Sub

Private Sub Timer1_Timer()
If UPboolean = True Then
    UPboolean = False
    FileName = App.Path & "\" & "uplist.up"
    If FileLen(FileName) > 0 Then
    UPLIST_TXT
    End If
    Timer1.Enabled = False
End If
End Sub

Private Sub Winsock1_Close()
Winsock1.Close
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
   Dim ByteData1() As Byte
    '文件总长度的变量
    Dim Flen1 As Long
    '请求服务器返回的响应码
    Dim ReCode1 As String
    Winsock1.GetData ByteData1, vbByte, bytesTotal
    '下载数据保存数据，如果是连接后第一次返回的数据，返回服务器的响应码
    ReCode1 = SaveData(bytesTotal, ByteData1(), Flen1)
    DoEvents '控制切换
    Select Case ReCode1
    Case "200"
        '响应码为200表示成功
    Case "206"
        '响应码206表示断点续传成功
    Case "404"
        '响应码为404表示请求的下载的文件未找到
        MsgBox "文件不存在！", vbInformation, "下载失败"
        Winsock1.Close
    Case "error"
        '其他响应码视为错误
        Winsock1.Close
        MsgBox "请求出错！", vbInformation, "下载失败"
    Case "cancel"
        '用户取消
        Exit Sub
    End Select
    If Flen1 > 0 Then
        '如果任务第一次下载，则保存后得到文件长度
        filesize = Flen1
    End If
End Sub

Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
Winsock1.Close
End Sub