外部Filter的寫作
VB 不同於以往的 Baisc語言
是要編譯後才可運作的程式語言
那一有功能的改良就要重新運作編譯一次
是否就成為定局 ??
難道沒有辦法取直譯語言的優點
改寫功能而不需重新編譯一次嗎？
這裡要教學的就是實現這項理想
如此只要注意好 參數的格式
人人都可以改你所想的功能
接下來這個程式需用到 ScriptControl控制元件 及 CommonDialog控制元件(comflg32.ocx)
來擔當直譯器與VB的橋樑
程式是截錄(改)個人 "四星彩模擬器v1.5.5" 之分析官網功能
因為目前內部Filter只支援分析
官網 http://www.roclotto.com.tw/news_fd61.asp?q=92 (092061期)
以後之網頁格式
所以才做了此設計
往後有不同的網頁格式
就可直接改 Filter.vbs 而不需對主程式再次編譯
是其主要用意及優勢
註：
.ScriptControl控制元件 附屬於 VB 6.0， 如果安裝之後沒有看到此一控制元件，
可在光碟的 \Common\Tools\VB\Script 目錄底下找此一控制元件，
其 .ocx 檔案名稱為 Msscript.ocx。
.有關 VBScript語法可見
http://72.14.203.104/search?q=cache:...&lr=lang_zh-TW
主程式
語法:
Dim gStrURLText As String
Dim gStrVBSText As String
Private Sub Command1_Click()
With CommonDialog1
.InitDir = App.Path
.DialogTitle = "開啟一包含URL的文件"
.CancelError = False
.Filter = "(*.txt)|*.txt"
.ShowOpen
If Len(Trim(.FileName)) = 0 Then
Exit Sub
End If
If InStr(1, .FileName, ":\") = 0 Then .FileName = App.Path + "\" + .FileName
Open .FileName For Input As #1 '開啟文字檔
gStrURLText = StrConv(InputB(LOF(1), #1), vbUnicode) '一次讀入整個檔案 放入全域變數中
Close #1 '關閉檔案
End With
Open App.Path & "\" & Text1.Text For Input As #2
gStrVBSText = StrConv(InputB(LOF(2), #2), vbUnicode) '將 .VBS的內容取出
Close #2
ScriptControl1.AddCode gStrVBSText '將取出的vbs腳本匯入 ScriptControl1
List2.Clear
Dim p As Procedure
For Each p In ScriptControl1.Procedures
List2.AddItem p.Name '讓 List2列出 vbs腳本包含的函數識別字
Next
Dim TempString1 As String, TempString2 As String, StartPos
List1.Clear
StartPos = -1
Do
TempString1 = ScriptControl1.Run("vbsHTMLStringAnalysis", gStrURLText, "開獎日期", StartPos)
If Len(TempString1) = 0 Then Exit Do '結束條件
TempString2 = ScriptControl1.Run("vbsHTMLStringAnalysis", gStrURLText, "開出獎號", StartPos)
List1.AddItem "[" & TempString1 & "] " & TempString2 '列映出分析出來的 開獎日期 & 獎號
DoEvents
Loop While True
End Sub
< Filter.vbs>
PHP 語法:
Function vbsHTMLStringAnalysis(strNumHTML , strCompareText , ByRef StartPos)
Dim S, E
S = InStrRev(strNumHTML, strCompareText, StartPos)
If S < 1 Then
vbsHTMLStringAnalysis = ""
Exit Function
End If
StartPos = S
S = InStr(S, strNumHTML, "<FONT", vbTextCompare)
S = InStr(S, strNumHTML, ">", vbTextCompare)
E = InStr(S, strNumHTML, "</FONT>", vbTextCompare)
E = E - S - 1
vbsHTMLStringAnalysis = Trim(Mid(strNumHTML, S + 1, E))
End Function
< URL.txt內容>
語法:
.....
<TD align=middle width=119><FONT size=2>開出獎號</FONT></TD>
<TD align=middle width=120><FONT color=#0000ff size=2>3672 </FONT> </TD>
~...
<TD align=middle width=119><FONT size=2>開獎日期</FONT></TD>
<TD align=middle width=120><FONT color=#0000ff size=2>95-04-07</FONT> </TD>
.....
原始程式碼下載: http://d.turboupload.com/d/504672/Ex...ForVB.rar.html |
