电视节目预告程序源代码.docx

电视节目预告程序源代码.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.