原發文者: 老羊 發文時間: 2007/06/11 00:46
這些陳述巳在上面講了好多好多次了,,難道某些人是沒看到??還是故意的??
天呀@@...........FROM老羊..(恕刪)
老羊大大，別生氣，按照我的觀察，因為發言進展速度太快，很有可能真有人沒看到！
我這人沒有太多空閒出去拍照，倒是喜歡在討論區看看圖、聽聽各路人馬的不同意見。
剛到這個討論區時，版面上並無法得知我上次到這次中間到底有哪些新帖我沒看到，但又很貪心的想全都看到，所以，我自己寫了個程式應付，是VB2005寫的。
我把程式藏在這裡公佈，讓跟我一樣喜歡常常看文的同好也能盯緊盤面看到好文！有VB2005的大大可以拿去用！(沒有VB2005的朋友，我就沒法度囉)，底下是程式碼：
模組（mdlMain）：
Module mdlMain
Public Function GetLastDateTime(ByVal sFilePath As String) As Date
'若資料夾中無此檔,則建立之
If Not IO.File.Exists(sFilePath) Then
Dim fsFile As IO.FileStream = IO.File.Create(sFilePath)
fsFile.Close()
End If
'開始讀檔
Using fsFile As New IO.FileStream(sFilePath, IO.FileMode.Open), srFile As New IO.StreamReader(fsFile, System.Text.Encoding.Default)
Dim sTmp As String = srFile.ReadLine()
If sTmp = "" Then
Return CDate("2006/1/1 上午 08:00:00")
Else
Return CDate(sTmp)
End If
End Using
End Function
Public Sub TimeSave(ByVal dNewDate As Date, ByVal sFilePath As String)
Using fsFile As New IO.FileStream(sFilePath, IO.FileMode.Create), swFile As New IO.StreamWriter(fsFile, System.Text.Encoding.Default)
swFile.WriteLine(dNewDate.ToString)
End Using
End Sub
Public Sub OpenIE(ByVal strUrl As String)
Dim ie As Object = CreateObject("InternetExplorer.Application")
With ie
.visible = True
.navigate(strUrl)
End With
ie = Nothing
End Sub
End Module
MDIForm（MDIMain）：
Imports System.Windows.Forms
Public Class MDIMain
Private Sub 攝影家手扎論壇ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 攝影家手扎論壇ToolStripMenuItem.Click
With frmPhotoSharp
.MdiParent = Me
.WindowState = FormWindowState.Maximized
.Show()
End With
End Sub
'其餘不相干的ToolStripMenuItem我就將之省略了
End Class
Form（frmPhotoSharp）：
Public Class frmPhotoSharp
Dim wbMain As New WebBrowser
Dim sMainUrl As String = "
http://forum.photosharp.com.tw/FORUM/
"
Dim sFilePath As String
Dim nMainPage As Integer = 1
Private Sub frmPhotoSharp_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
sFilePath = My.Application.Info.DirectoryPath & "\PhotoSharp_DateTime.txt"
With dgvMainPhorum
.AllowUserToAddRows = False
.Columns.Add("PhorumName", "論壇板名")
.Columns.Add("Title", "主題")
.Columns.Add("Author", "作者")
.Columns.Add("LastDate", "回應時間")
.Columns.Add("LinkUrl", "連結網址")
.Columns(0).Width = 100
.Columns(1).Width = 300
.Columns(2).Width = 130
.Columns(3).Width = 130
.Columns(4).Width = 300
.RowHeadersWidth = 20
End With
AddHandler wbMain.DocumentCompleted, AddressOf wbMain_DocumentCompleted
wbMain.Navigate(sMainUrl & "NewTopic.aspx")
End Sub
Private Sub wbMain_DocumentCompleted(ByVal sender As System.Object, ByVal e As System.Windows.Forms.WebBrowserDocumentCompletedEventArgs)
dtpOld.Value = GetLastDateTime(sFilePath)
dtpNew.Value = dtpOld.Value
Dim doc As String = wbMain.DocumentText
Dim n1 As Integer = 1, n2 As Integer = 1, m1, m2, i As Integer
With dgvMainPhorum
n1 = InStr(doc, "<tr class=" & """" & "title" & """" & ">")
Do
n1 = InStr(n1 + 1, doc, "<tr class=")
If n1 = 0 Then Exit Do
m1 = InStr(n1, doc, "<td")
m2 = InStr(m1, doc, "</")
m1 = InStrRev(doc, ">", m2)
If doc.Substring(m1, m2 - m1 - 1) = "搜尋" Then Exit Do
.Rows.Add()
.Rows(i).Height = 16
.Item(0, i).Value = doc.Substring(m1, m2 - m1 - 1)
m1 = InStr(m1 + 1, doc, "<td")
m1 = InStr(m1 + 1, doc, "<a href=")
m2 = InStr(m1 + 1, doc, "'>")
.Item(4, i).Value = doc.Substring(m1 + 8, m2 - m1 - 9)
m2 = InStr(m1, doc, "</")
m1 = InStrRev(doc, ">", m2)
.Item(1, i).Value = doc.Substring(m1, m2 - m1 - 1)
Dim tm1 As Integer = m1, tm2 As Integer = m2
m2 = InStr(m1, doc, "</td>")
Dim strTmp As String = doc.Substring(m1, m2 - m1)
m1 = InStr(strTmp, "分頁")
If m1 <> 0 Then
m1 = InStrRev(strTmp, "<a href=")
m2 = InStr(m1, strTmp, ">")
.Item(4, i).Value = strTmp.Substring(m1 + 8, m2 - m1 - 10)
End If
m1 = tm1 : m2 = tm2
m1 = InStr(m1 + 1, doc, "<td")
m2 = InStr(m1, doc, "</")
m1 = InStrRev(doc, ">", m2)
.Item(2, i).Value = doc.Substring(m1, m2 - m1 - 1)
For j As Integer = 1 To 3
m1 = InStr(m1 + 1, doc, "<td")
Next
m2 = InStr(m1, doc, "</")
m1 = InStrRev(doc, ">", m2)
Dim tmpDate As Date = CDate(Now.Year & "/" & doc.Substring(m1, m2 - m1 - 1) & ":00")
.Item(3, i).Value = tmpDate
If tmpDate > dtpOld.Value Then
.Item(3, i).Style.BackColor = Color.Red
.Item(3, i).Style.ForeColor = Color.Yellow
Else
.Item(3, i).Style.BackColor = Color.White
.Item(3, i).Style.ForeColor = Color.Black
End If
i = i + 1
Loop
.Sort(.Columns(3), System.ComponentModel.ListSortDirection.Descending)
End With
btnRecheck.Enabled = True
End Sub
Private Sub btnRecheck_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnRecheck.Click
btnRecheck.Enabled = False
lblNewDate.BackColor = System.Drawing.SystemColors.Control
lblNewDate.ForeColor = Color.Black
dgvMainPhorum.Rows.Clear()
wbMain.Refresh()
wbMain.Navigate(sMainUrl & "NewTopic.aspx")
End Sub
Private Sub btnTimeSave_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnTimeSave.Click
CType(sender, Button).Enabled = False
TimeSave(dtpNew.Value, sFilePath)
CType(sender, Button).Enabled = True
End Sub
Private Sub dgvMainPhorum_CellClick(ByVal sender As Object, ByVal e As System.Windows.Forms.DataGridViewCellEventArgs) Handles dgvMainPhorum.CellClick
If e.RowIndex >= 0 Then
Select Case e.ColumnIndex
Case 4
OpenIE(sMainUrl & dgvMainPhorum.Item(e.ColumnIndex, e.RowIndex).Value)
Case 3
dtpNew.Value = dgvMainPhorum.Item(e.ColumnIndex, e.RowIndex).Value
End Select
End If
End Sub
Private Sub dtpNew_ValueChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles dtpNew.ValueChanged
With lblNewDate
If dtpNew.Value <> dtpOld.Value Then
.BackColor = Color.Red
.ForeColor = Color.Yellow
Else
.BackColor = System.Drawing.SystemColors.Control
.ForeColor = Color.Black
End If
End With
End Sub
Private Sub btnHome_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnHome.Click
OpenIE(sMainUrl & "NewTopic.aspx")
End Sub
Private Sub btnPrePage_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnPrePage.Click
btnRecheck.Enabled = False
lblNewDate.BackColor = System.Drawing.SystemColors.Control
lblNewDate.ForeColor = Color.Black
dgvMainPhorum.Rows.Clear()
wbMain.Refresh()
If nMainPage > 1 Then nMainPage -= 1
wbMain.Navigate(sMainUrl & "NewTopic.aspx?page=" & nMainPage.ToString)
End Sub
Private Sub btnNextPage_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnNextPage.Click
btnRecheck.Enabled = False
lblNewDate.BackColor = System.Drawing.SystemColors.Control
lblNewDate.ForeColor = Color.Black
dgvMainPhorum.Rows.Clear()
wbMain.Refresh()
Try
nMainPage += 1
wbMain.Navigate(sMainUrl & "NewTopic.aspx?page=" & nMainPage.ToString)
Catch ex As Exception
nMainPage -= 1
End Try
End Sub
End Class
完畢，請各位大大享用！
