电视节目预告程序源代码.docx
《电视节目预告程序源代码.docx》由会员分享，可在线阅读，更多相关《电视节目预告程序源代码.docx（28页珍藏版）》请在冰豆网上搜索。
电视节目预告程序源代码
1、程序主窗口
DimMyData
Dimj
DimJm,iAsString
DimlAsLong
'-------------------------------------
'定义移动文本框光标行的函数
ConstEM_LINESCROLL=&HB6
PrivateDeclareFunctionSendMessageLib"user32"Alias"SendMessageA"（ByValhwndAsLong,ByValwMsgAsInteger,ByValwParamAsInteger,ByVallParamAsLong）AsLong
'-----------------------------------------
'------------------------------------------------------------------
'取得当前光标所在位置的行数
ConstEM_LINEFROMCHAR=&HC9
ConstEM_LINEINDEX=&HBB
'------------------------------------------------------------------
'下载数据文件的相关声明
PrivateDeclareFunctionURLDownloadToFileLib"urlmon"Alias"URLDownloadToFileA"（ByValpCallerAsLong,ByValszURLAsString,ByValszFileNameAsString,ByValdwReservedAsLong,ByVallpfnCBAsLong）AsLong
'----------------------------------------------------------
'运行和监视外部程序的相关声明
PrivateDeclareFunctionOpenProcessLib"kernel32"（ByValdwDesiredAccessAsLong,_
ByValbInheritHandleAsLong,ByValdwProcessIdAsLong）AsLong
PrivateDeclareFunctionGetExitCodeProcessLib"kernel32"（ByValhProcessAsLong,_
lpExitCodeAsLong）AsLong
PrivateDeclareFunctionCloseHandleLib"kernel32"（ByValhObjectAsLong）AsLong
PrivateiniPathAsString
PrivateConstPROCESS_QUERY_INFORMATION=&H400
PrivateConstSTATUS_PENDING=&H103
'----------------------------------------------------隐藏图标到系统托盘中
PublicLastStateAsInteger
'PrivateDeclareFunctionSendMessageLib"user32"Alias"SendMessageA"（ByValhwndAsLong,ByValwMsgAsLong,ByValwParamAsLong,lParamAsAny）AsLong
PrivateConstWM_SYSCOMMAND=&H112
PrivateConstSC_MOVE=&HF010&
PrivateConstSC_RESTORE=&HF120&
PrivateConstSC_SIZE=&HF000&
'----------------------------------------------------
PrivateSubAddJM_Click（）
Xgzt=True
AddForm.show
AddForm.Caption="添加节目"
EndSub
PrivateSubDelJM_Click（）
IfMsgBox（"当前记录将被删除，是否继续？
",16+vbYesNo,"警告"）=vbNoThen
ExitSub
EndIf
DataFilsRst.MoveFirst
DoWhileNotDataFilsRst.EOF
IfDataFilsRst!
节目名称=JmThen
StrJm=DataFilsRst!
节目分类
DataFilsRst.Delete
ExitDo
EndIf
DataFilsRst.MoveNext
Loop
ListView1.ListItems.Clear
DataFilsRst.MoveFirst
DoWhileNotDataFilsRst.EOF
IfDataFilsRst!
节目分类=StrJmThen
tStr=DataFilsRst!
序号
SetItem=ListView1.ListItems.Add（,,tStr）
tStr=DataFilsRst!
节目名称
Item.ListSubItems.Add,,tStr
EndIf
DataFilsRst.MoveNext
Loop
IfListView1.ListItems.Count<>0Then
SetItem=ListView1.ListItems
（1）
Jm=Item.SubItems
（1）
Xsjm
Else
RichTextBox1.Text=""
StatusBar1.Panels.Item
（2）.Text=StrJm
EndIf
EndSub
PrivateSubXsjm（）
DataFilsRst.MoveFirst
DoWhileNotDataFilsRst.EOF
IfDataFilsRst!
节目分类=StrJmThen
IfDataFilsRst!
节目名称=JmThen
RichTextBox1.FileName=App.Path+DataFilsRst!
文档
SSFrame2.Caption="《"&DataFilsRst!
节目名称&"》"&"节目内容"
StatusBar1.Panels.Item
（2）.Text=StrJm&"--"&DataFilsRst!
节目名称
ExitDo
EndIf
EndIf
DataFilsRst.MoveNext
Loop
EndSub
PrivateSubDownloadJm_Click（）
XzSComd_Click
EndSub
PrivateSubexit_Click（）
UnloadMe
EndSub
'PrivateSubForm_MouseDown（ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle）
'l=X\Screen.TwipsPerPixelX+Y\Screen.TwipsPerPixelY
'Ifl=WM_LBUTTONDOWNThen
'l=DelToTray（hwnd）
'TVjmForm.show
'EndIf
'EndSub
PrivateSubForm_MouseMove（ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle）
DimlMsgAsSingle
lMsg=X/Screen.TwipsPerPixelX
IflMsg=WM_RBUTTONUPOrlMsg=WM_LBUTTONUPThenMe.PopupMenusys
EndSub
PrivateSubForm_Load（）
Tptb=False
Jczt=True
DqDate=Format（Date,"yy"）&"/"&Format（Date,"mm"）&"/"&Format（Date,"dd"）
TVjmForm.Caption="全国一周电视节目预告"&"V"&App.Major&"."&App.Minor&".0."&App.Revision
Jmlx=0
ListView1.Top=960
ListView1.ListItems.Clear
SSCommand2
（1）.Top=ListView1.Height+960
SSCommand2
（2）.Top=ListView1.Height+1320
SSCommand2（3）.Top=ListView1.Height+1680
AddJM.Enabled=True
DelJM.Enabled=False
XgJM.Enabled=False
i=Weekday（Now）
SelectCasei
Case1
myDataxx="星期日"
Case2
myDataxx="星期一"
Case3
myDataxx="星期二"
Case4
myDataxx="星期三"
Case5
myDataxx="星期四"
Case6
myDataxx="星期五"
Case7
myDataxx="星期六"
EndSelect
OnErrorResumeNext
MyData=Format（Date,"LongDate"）&""&myDataxx&""&Format（Time,"hh:
mm:
ss"）
StatusBar1.Panels.Item
（1）.Text=MyData
myInit
DataFilsRst.MoveFirst
DoWhileNotDataFilsRst.EOF
IfDataFilsRst!
节目分类="中央频道节目"Then
tStr=DataFilsRst!
序号
SetItem=ListView1.ListItems.Add（,,tStr）
tStr=DataFilsRst!
节目名称
Item.ListSubItems.Add,,tStr
IfDataFilsRst!
序号=1Then
RichTextBox1.FileName=App.Path+DataFilsRst!
文档
SSFrame2.Caption="《"&DataFilsRst!
节目名称&"》"&"节目内容"
Jmdz=DataFilsRst!
文档
StatusBar1.Panels.Item
（2）.Text="中央频道节目--"&DataFilsRst!
节目名称
EndIf
EndIf
DataFilsRst.MoveNext
Loop
IfRichTextBox1.Text<>""Then
Forj=0To7'判断节目数据是否过期
DqDate=Format（Date+j,"yy"）&"/"&Format（Date+j,"mm"）&"/"&Format（Date+j,"dd"）
Where=InStr（RichTextBox1.Text,DqDate）'在文本中查找字符串。
IfWhereThen'如果找到，
ExitFor
Else
Ifj=7Then
'MsgBox"当前节目数据文件已经过期，请重新下载新的节目数据。
如果你已经更新，请检查并修改数据。
",48,"数据过期"
RichTextBox1.BackColor=&HC0E0FF
StatusBar1.Panels.Item
（2）.Text=StatusBar1.Panels.Item
（2）.Text&"（节目过期）"
ExitSub
EndIf
EndIf
Nextj
Else
IfDataFilsRst.RecordCount=0Then
MsgBox"系统中没有数据，请下载数据然后加载到数据库中。
",16,"系统提示"
EndIf
EndIf
Search=myDataxx
RichTextBox1.BackColor=&HFFFFFF
FileDw
IfErr.Number=94OrErr.Number=75Then
MsgBox"数据连接有错误，请检查当前节目数据连接并修改。
",16,"数据错误"
'XgJM_Click
EndIf
EndSub
PrivateSubForm_Resize（）'窗口状态
IfTVjmForm.WindowState=vbMinimizedThen
IfTptb=FalseThen
AddToTrayMe,sys
SetTrayTipTVjmForm.Caption
'------------------------------
Me.Visible=False
Tptb=True
Else
Me.Visible=False
EndIf
Else
'l=DelToTray（hwnd）
'Tptb=False
Me.Visible=True
EndIf
'IfWindowState<>vbMinimizedThenLastState=WindowState
EndSub
PrivateSubForm_Unload（CancelAsInteger）
l=DelToTray（hwnd）
End
EndSub
PrivateSubListView1_ItemClick（ByValItemAsMSComctlLib.ListItem）
RichTextBox1.BackColor=&HFFFFFF
RichTextBox1.Text=""
IfListView1.ListItems.Count=0Then
DelJM.Enabled=False
XgJM.Enabled=False
Else
XgJM.Enabled=True
DelJM.Enabled=True
EndIf
Jm=Item.SubItems
（1）
IfJmlx=0Then
StatusBar1.Panels.Item
（2）.Text="中央频道节目--"&Jm
ElseIfJmlx=1Then
StatusBar1.Panels.Item
（2）.Text="地方频道节目--"&Jm
ElseIfJmlx=2Then
StatusBar1.Panels.Item
（2）.Text="数字频道节目--"&Jm
ElseIfJmlx=3Then
StatusBar1.Panels.Item
（2）.Text="境外频道节目--"&Jm
EndIf
SSFrame2.Caption="《"&Jm&"》"&"节目内容"
OnErrorResumeNext
DataFilsRst.MoveFirst
DoWhileNotDataFilsRst.EOF
IfDataFilsRst!
节目名称=JmThen
Jmdz=DataFilsRst!
文档
RichTextBox1.FileName=App.Path+Jmdz
ExitDo
EndIf
DataFilsRst.MoveNext
Loop
IfJczt=TrueThen
IfRichTextBox1.Text<>""Then
Forj=0To7'判断节目数据是否过期，日期从当天开始加7天查找，如果加7天后仍然找不到，就证明数据过期，因为网站不能提供提前两周的节目单
DqDate=Format（Date+j,"yy"）&"/"&Format（Date+j,"mm"）&"/"&Format（Date+j,"dd"）'取得改变了的时间字符串
Where=InStr（RichTextBox1.Text,DqDate）'在文本中查找“时间”字符串。
IfWhereThen'如果找到，
Ifj=0Then
ExitFor
EndIf
Else
Ifj=7Then
RichTextBox1.BackColor=&HC0E0FF
StatusBar1.Panels.Item
（2）.Text=StatusBar1.Panels.Item
（2）.Text&"（节目过期）"
'MsgBox"当前节目数据文件已经过期，请重新下载新的节目数据。
如果你已经更新，请检查并修改数据。
",48,"数据过期"
ExitSub
EndIf
EndIf
Nextj
EndIf
EndIf
IfErr.Number=94OrErr.Number=75Then
IfMsgBox（"数据连接有错误，请单击“确定”后修改数据。
",16,"数据错误"）<>vbYesThen
XgJM_Click
EndIf
EndIf
Search=myDataxx
FileDw
EndSub
PrivateSubListView1_MouseDown（ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle）
IfButton=2Then
Jczt=False
PopupMenuJmgl
IfListView1.ListItems.Count=0Then
DelJM.Enabled=False
XgJM.Enabled=False
EndIf
EndIf
EndSub
PrivateSubRichTextBox1_Change（）
IfRichTextBox1.Text=""Then
Forj=0To6
XqSComd（j）.Enabled=False
Nextj
Else
Forj=0To6
XqSComd（j）.Enabled=True
Nextj
EndIf
EndSub
PrivateSubshow_Click（）
WindowState=0
Me.Visible=True
EndSub
PrivateSubSSCommand1_Click（）
ListView1.Top=2000
SSCommand2
（1）.Top=960
SSCommand2
（2）.Top=1320
SSCommand2（3）.Top=1680
ListView1.ListItems.Clear
XgJM.Enabled=False
EndSub
PrivateSubSSCommand2_Click（IndexAsInteger）
XgJM.Enabled=False
DelJM.Enabled=False
ListView1.ListItems.Clear
IfIndex=0Then
Jmlx=0
ListView1.Top=960
SSCommand2
（1）.Top=ListView1.Height+960
SSCommand2
（2）.Top=ListView1.Height+1320
SSCommand2（3）.Top=ListView1.Height+1680
DataFilsRst.MoveFirst
DoWhileNotDataFilsRst.EOF
IfDataFilsRst!
节目分类="中央频道节目"Then
tStr=DataFilsRst!
序号
SetItem=ListView1.ListItems.Add（,,tStr）
tStr=DataFilsRst!
节目名称
Item.ListSubItems.Add,,tStr
EndIf
DataFilsRst.MoveNext
Loop
StatusBar1.Panels.Item
（2）.Text="中央频道节目"
ElseIfIndex=1Then
Jmlx=1
ListView1.Top=1320
SSCommand2
（1）.Top=960
SSCommand2
（2）.Top=ListView1.Height+1320
SSCommand2（3）.Top=ListView1.Height+1680
DataFilsRst.MoveFirst
DoWhileNotDataFilsRst.EOF
IfDataFilsRst!
节目分类="地方频道节目"Then
tStr=DataFilsRst!
序号
SetItem=ListView1.ListItems.Add（,,tStr）
tStr=DataFilsRst!
节目名称
Item.ListSubItems.Add,,tStr
EndIf
DataFilsRst.MoveNext
Loop
StatusBar1.Panels.Item
（2）.Text="地方频道节目"
ElseIfIndex=2Then
Jmlx=2
ListView1.Top=1680
SSCommand2
（1）.Top=960
SSCommand2
（2）.Top=1320
SSCommand2（3）.Top=ListView1.
升级会员 