form1.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 Form1 
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "星零排课系统登陆"
   ClientHeight    =   3195
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   5130
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3195
   ScaleWidth      =   5130
   StartUpPosition =   1  '所有者中心
   Begin VB.TextBox Text3 
      Height          =   375
      Left            =   5160
      TabIndex        =   7
      Text            =   "Text3"
      Top             =   3000
      Width           =   495
   End
   Begin MSWinsockLib.Winsock Winsock1 
      Left            =   4440
      Top             =   240
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   100
      Left            =   600
      Top             =   240
   End
   Begin VB.CommandButton Command3 
      Appearance      =   0  'Flat
      Caption         =   "点此访问爱星零工作室网站(http://www.lovexl.com.cn)"
      Height          =   375
      Left            =   0
      TabIndex        =   6
      Top             =   2880
      Width           =   5175
   End
   Begin VB.CommandButton Command2 
      Caption         =   "退 出"
      Height          =   375
      Left            =   2760
      MouseIcon       =   "Form1.frx":F84A
      MousePointer    =   99  'Custom
      TabIndex        =   5
      Top             =   2160
      Width           =   1215
   End
   Begin VB.CommandButton Command1 
      Caption         =   "确 定"
      Height          =   375
      Left            =   1080
      MouseIcon       =   "Form1.frx":F99C
      MousePointer    =   99  'Custom
      TabIndex        =   2
      Top             =   2160
      Width           =   1215
   End
   Begin ACTIVESKINLibCtl.Skin PKSkn 
      Left            =   1440
      OleObjectBlob   =   "Form1.frx":FAEE
      Top             =   240
   End
   Begin VB.TextBox Text2 
      Appearance      =   0  'Flat
      BackColor       =   &H00C0C0C0&
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   345
      IMEMode         =   3  'DISABLE
      Left            =   2160
      PasswordChar    =   "*"
      TabIndex        =   1
      Text            =   "admin"
      Top             =   1440
      Width           =   1815
   End
   Begin VB.TextBox Text1 
      Appearance      =   0  'Flat
      BackColor       =   &H00C0C0C0&
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   345
      Left            =   2160
      TabIndex        =   0
      Text            =   "admin"
      Top             =   840
      Width           =   1815
   End
   Begin ACTIVESKINLibCtl.SkinLabel SkinLabel1 
      Height          =   375
      Left            =   1080
      OleObjectBlob   =   "Form1.frx":FD22
      TabIndex        =   3
      Top             =   840
      Width           =   1335
   End
   Begin ACTIVESKINLibCtl.SkinLabel SkinLabel2 
      Height          =   375
      Left            =   1080
      OleObjectBlob   =   "Form1.frx":FD86
      TabIndex        =   4
      Top             =   1440
      Width           =   1335
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim DataByte() As Byte
Public Dw_Url As String
Dim StartTime As Date '连接服务器的时间
Dim UPI As Boolean


Private Sub Command1_Click()
On Error GoTo finish
'on error goto是一个防错代码，当出现错误，系统会自动转到后面的finish:后执行
Set kc1 = cnn.Execute("select * from 登陆 where 用户名='" & Text1.Text & "' and 密码='" & Text2.Text & "'")
'这里是执行了确定按钮后在登陆表中检索用户名和密码是否正确，如kc1的记录集指针指向尾部，即eof时
'提示用户名或密码错误，并把当前允许输入错误次数＋1，当用户输入的错误次数大于2即＝3的时候则直接退出系统
If kc1.EOF = True Then
 If pnum < 2 Then
 pnum = pnum + 1
 MsgBox "用户名或密码错误!", vbInformation, "错误次数：" & pnum
 Text1.Text = ""
 Text2.Text = ""
 Text1.SetFocus '提示用户名或密码错误后将光标自动定位到text1窗体上
 Exit Sub
 Else
 MsgBox "用户名或密码错误超过三次,系统会自动退出", vbInformation, "提示"
 End
 End If
Else
'当当前记录集不为空时，获取记录集的第2个字段是否等于超级管理员,是则admin全局变量的布尔值为true，否则为假
'这个值在formmain里会通过获取的来定义某些按钮可用，某些不可用
'kc1.fields(2)此处的2其实在数据库表中表现应为第3个字段，因为记录集获取是从0开始的，而数据库表中的记录字段则
'是从1开始的，所以两者之前总是相差1
 If kc1.Fields(2) = "超级管理员" Then
 admin = True
 Else
 admin = False
 End If
 Unload Me
 formmain.Show
End If
Exit Sub
finish: '当出现错误转到此处，提示错误标识
    MsgBox Err.Description
End Sub

Private Sub Command2_Click()
End
End Sub

Private Sub Command3_Click()
Shell "Explorer /s , http://www.lovexl.com.cn"
End Sub

Private Sub Form_Load()
If EXIT_UP = False Then
VersionNumber_load
End If
Me.Caption = Me.Caption & " 版本(" & Str(VersionN) & ")"
pkskn.LoadSkin App.Path & "\chizh.skn"
pkskn.ApplySkinByName hWnd, "窗体"
pkskn.ApplySkin hWnd
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then '当当前获取按钮是回车键时执行按钮image_click事件
Call Command1_Click
End If
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Call Command1_Click
End If
End Sub

Private Sub VersionNumber_load() '客户端设置读取机器ID快捷识别编号
Dim buff As String
Dim backFile As String
Dim ret As Integer
buff = String(255, 0)
ret = GetPrivateProfileString("Ver", "Ver", "", buff, 256, App.Path & "\PK.ini")
If ret = 0 Then
VersionN = "1.00"
ret = WritePrivateProfileString("Ver", "Ver", VersionN, App.Path & "\PK.ini")
Else
VersionN = buff
End If
'获取升级说明路径
ret = GetPrivateProfileString("Ver", "IP", "", buff, 256, App.Path & "\PK.ini")
If ret = 0 Then
ret = WritePrivateProfileString("Ver", "IP", "www.ah163.net.cn", App.Path & "\PK.ini")
Else
Text3.Text = buff
UPIP = Text3.Text
End If

'获取升级说明路径
ret = GetPrivateProfileString("Ver", "UPLIST", "", buff, 256, App.Path & "\PK.ini")
If ret = 0 Then
ret = WritePrivateProfileString("Ver", "UPLIST", "http://www.ah163.net.cn/lovexl/pkupdate/uplist.up", App.Path & "\PK.ini")
Else
UPlist = buff
End If

'获取URL网页
ret = GetPrivateProfileString("Ver", "UPURL", "", buff, 256, App.Path & "\PK.ini")
If ret = 0 Then
ret = WritePrivateProfileString("Ver", "UPURL", "http://www.ah163.net.cn/lovexl/pkupdate/update.up", App.Path & "\PK.ini")
Else
UPURL = buff
UPTT
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:
    '连接时间超过20秒或取消下载，退出该过程并返回false
    If DateDiff("s", StartTime, Time()) > 3 Then
        Exit Sub
    End If
Loop
Text3.Text = UPURL '必须经过文本处理，否则将会有许多未知字符出错
strcommand = "GET " + Text3.Text + " HTTP/1.0" + vbCrLf 'GET 为FTP命令
strcommand = strcommand + vbCrLf      '记住一定要加上vbCrLf
FileName = App.Path & "\" & "update.up"
If Dir(FileName, vbNormal) <> "" Then
 Kill FileName
End If
bAppend = False
Winsock1.SendData strcommand  ''给远程计算机发送数据
Timer1.Enabled = True
End Sub

Private Sub Ver_compare() '版本比较
If Dir(FileName, vbNormal) <> "" Then
 Dim strinput As String
 Dim intfile As Integer
 Dim str1() As String
 Dim filesize As Double
 intfile = FreeFile
 filesize = FileLen(FileName)
 Open FileName For Binary As #intfile
  strinput = Space(filesize)
 Get #intfile, , strinput
 Close #intfile
 str1 = Split(strinput, vbCrLf)
 If UBound(str1) > 0 Then
 NEW_VersionN = str1(0)
 If Mid(VersionN, 1, 4) <> NEW_VersionN Then
   Form4.Show
   Unload Me
   Form1.Refresh
 End If
 End If
End If
End Sub

Private Sub Timer1_Timer()
If UPboolean = True Then
    UPboolean = False
    If FileLen(FileName) >= filesize Then
    Ver_compare
    End If
    UPI = True
    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