login.frm

一个电视节目查询软件

VERSION 5.00
Object = "{EF6F6AB3-C2B2-11D3-8E15-B3780236B732}#1.0#0"; "UnZipper.ocx"
Begin VB.Form Login 
   AutoRedraw      =   -1  'True
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "电视节目更新"
   ClientHeight    =   3090
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   4680
   Icon            =   "Login.frx":0000
   LinkTopic       =   "Form2"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   MouseIcon       =   "Login.frx":628A
   ScaleHeight     =   3090
   ScaleWidth      =   4680
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  '窗口缺省
   Begin UnZipper.UnZip UnZip1 
      Left            =   4320
      Top             =   120
      _ExtentX        =   450
      _ExtentY        =   450
   End
   Begin VB.CommandButton Command3 
      Caption         =   "退出"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   14.25
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   3240
      TabIndex        =   5
      Top             =   2040
      Width           =   1095
   End
   Begin VB.CommandButton Command2 
      Caption         =   "装载节目"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   1800
      TabIndex        =   4
      Top             =   2040
      Width           =   1095
   End
   Begin VB.CommandButton Command1 
      Caption         =   "重新下载"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   360
      TabIndex        =   3
      Top             =   2040
      Width           =   1095
   End
   Begin VB.Label Label3 
      BeginProperty Font 
         Name            =   "方正稚艺简体"
         Size            =   14.25
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000FF&
      Height          =   375
      Left            =   1080
      TabIndex        =   2
      Top             =   1320
      Width           =   2655
   End
   Begin VB.Label Label2 
      Caption         =   "00-00-00"
      BeginProperty Font 
         Name            =   "幼圆"
         Size            =   15
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF8080&
      Height          =   375
      Left            =   2640
      TabIndex        =   1
      Top             =   600
      Width           =   1575
   End
   Begin VB.Label Label1 
      Caption         =   "最近下载日期："
      BeginProperty Font 
         Name            =   "方正稚艺简体"
         Size            =   15
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   480
      TabIndex        =   0
      Top             =   600
      Width           =   2295
   End
End
Attribute VB_Name = "Login"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Private Declare Function GetPrivateProfileString& Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String)
Private Declare Function WritePrivateProfileString& Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As String, ByVal lpFileName As String)

Dim fso As New FileSystemObject
Dim fil As File

Private Sub Command1_Click()

    Dim n As Long
    Dim sum As Integer       '目前可下载的链接数
    Dim strtv As String
    strtv = String(255, 0)
    Dim i As Integer
    i = 0
    
    n = GetPrivateProfileString&("download", "addsum", "", strtv, Len(strtv), App.Path & "\nettv.ini")
    sum = CInt(strtv)
    
    Do While i < sum        '实现日后增加下载新的更多的链接
        n = GetPrivateProfileString&("download", "address" & i, "", strtv, Len(strtv), App.Path & "\nettv.ini")
        n = URLDownloadToFile(0, strtv, App.Path & "\showtime" & i & ".zip", 0, 0)
        i = i + 1
    Loop
    
    i = 0
    
    Do While i < sum        '实现多文件的解压
        UnZip1.InputFile = App.Path & "\showtime" & i & ".zip"
        UnZip1.OutputFolder = App.Path & "\showtime"
        UnZip1.Go
        i = i + 1
    Loop
    
    i = 0
    
    Do While i < sum        '删除下载的文件
        Set fil = fso.GetFile(App.Path & "\showtime" & i & ".zip")
        fil.Delete
        i = i + 1
    Loop
    
    MsgBox "节目单更新完成！", vbOKOnly + vbExclamation, "提示"
    Form_Load
    
End Sub

Private Sub Command2_Click()

    Form1.Show
    Unload Login
    
End Sub

Private Sub Command3_Click()

    Unload Me
    
End Sub

Private Sub Form_Load()

    Dim tmp As String
    tmp = ""
    Dim f As TextStream
    Dim d As String
    
    On Error GoTo ErrorHandler
    
    Set f = fso.OpenTextFile(App.Path & "\showtime\节目单\01.txt")
    tmp = f.Read(8)
    d = Left(tmp, 2) & "-" & Mid(tmp, 4, 2) & "-" & Right(tmp, 2)
    Label2.Caption = CDate(d)
    
    If ((Date - CDate(d)) > 6 Or (Date - CDate(d)) < 0) Then
        Label3.Caption = "（本周没有下载）"
        Command1.Enabled = True
        Command2.Enabled = False
    Else
        Label3.Caption = "（本周已下载）"
        Command1.Enabled = False
        Command2.Enabled = True
    End If
    Exit Sub
    
ErrorHandler:
    MsgBox "请先下载节目单！", vbOKOnly + vbExclamation, "提示"
    Command2.Enabled = False
    Command1.Enabled = True
    
End Sub