Hi,
Dulu saya pernah mencoba membuat bot kecil untuk retrieve news dari kompas
dan detik.com yang bisa kita perintahkan untuk updating web site setiap
interval tertentu, cuma saya buat pakai vb yang kemudian menulis ke page
static...untuk kemudian diinclude oleh ssi, mudah2an listing di bawah bisa
membantu (prinsip yang sama dapat diterapkan pada kurs dan ramalan cuaca)
karena algorithm-nya sama.
Option Base 0
Option Compare Text
Private Sub Form_Load()
On Error Resume Next
For wyx = 1 To 20000
Dim strDaftarMedia As Variant
Dim arrMedia() As Variant
Dim intJumlahChar As Variant
Dim intCounter As Variant
Dim fs As Variant
Dim c As Variant
Dim strFullURL
Dim strUkFile
Dim strTempFileName
strDaftarMedia = "www.kompas.com|www.detik.com|"
intJumlahChar = Len(strDaftarMedia)
intCounter = 0
For A = 1 To intJumlahChar
If InStr(strDaftarMedia, "|") Then
ReDim Preserve arrMedia(intCounter)
arrMedia(intCounter) = Mid(strDaftarMedia, 1, (InStr(strDaftarMedia,
"|") - 1))
Debug.Print arrMedia(intCounter) & vbCr
intCounter = intCounter + 1
strDaftarMedia = Mid(strDaftarMedia, InStr(strDaftarMedia, "|") + 1,
intJumlahChar)
End If
Next
Debug.Print UBound(arrMedia)
For Connect = 0 To UBound(arrMedia)
Inet1.RemoteHost = arrMedia(Connect)
'Connecting to server ..................
Dim strTemp As Variant
strTemp = Inet1.OpenURL(("http://" & CStr(arrMedia(Connect))), icString)
'Create text file
Set fs = CreateObject("Scripting.FileSystemObject")
If CStr(arrMedia(Connect)) = "www.kompas.com" Then
Set c = fs.CreateTextFile(App.Path & "\tempkompas.htm", True)
strTempFileName = "tempkompas.htm"
End If
If CStr(arrMedia(Connect)) = "www.detik.com" Then
Set c = fs.CreateTextFile(App.Path & "\tempdetik.htm", True)
strTempFileName = "tempdetik.htm"
End If
'Extracting and parsing........
Dim intPosAwal As Variant
Dim intPosAkhir As Variant
Dim intJumLink As Variant
Dim strLink() As Variant
Dim strAHREF As Variant
Dim intTotalChar As Variant
intTotalChar = Len(strTemp)
intJumLink = -1
'jika masih ada link
For x = 1 To intTotalChar
If InStr(strTemp, "<a href") Then
intPosAwal = (InStr(strTemp, "<a href"))
intPosAkhir = ((InStr(strTemp, "</a>")) + 4)
strAHREF = Mid(strTemp, intPosAwal, intPosAkhir - intPosAwal)
'Buang image .................
If InStr(strAHREF, "<img") Then
strAHREF = ""
End If
' Buang link e-mail .................
If InStr(strAHREF, "mailto:") Then
strAHREF = ""
End If
'filter khusus detik.com
If arrMedia(Connect) = "www.detik.com" Then
strFullURL = "<a href='http://www.detik.com'>Detik.com</a>"
If InStr(strAHREF, "bolehmail") Then
strAHREF = ""
End If
'--------------------------------------------------------------------
If InStr(strAHREF, "#FFFFFF") Then
strAHREF = ""
End If
If InStr(strAHREF, "agrakom") Then
strAHREF = ""
End If
'---------------------------------------------------------------------------
-
If InStr(strAHREF, "detik.com") = False Then
strAHREF = Replace(strAHREF, "<a href=""", "<a
href=""http://www.detik.com")
End If
End If
'filter font size
If InStr(strAHREF, "size=""5""") Then
strAHREF = Replace(strAHREF, "size=""5""", "size='2'")
End If
If InStr(strAHREF, "size =""5""") Then
strAHREF = Replace(strAHREF, "size =""5""", "size='2'")
End If
If InStr(strAHREF, "size="" 5""") Then
strAHREF = Replace(strAHREF, "size="" 5""", "size='2'")
If InStr(strAHREF, "size=""3""") Then
strAHREF = Replace(strAHREF, "size=""3""", "size='2'")
End If
If InStr(strAHREF, "size =""3""") Then
strAHREF = Replace(strAHREF, "size =""4""", "size='2'")
End If
If InStr(strAHREF, "size="" 3""") Then
strAHREF = Replace(strAHREF, "size="" 3""", "size='2'")
End If
End If
'end of filter font size
'end of filter detik
' Filter khusus kompas
If arrMedia(Connect) = "www.kompas.com" Then
strFullURL = "<a href='http://www.kompas.com'>Kompas</a>"
If InStr(strAHREF, "<!--stitle") = False Then
strAHREF = ""
End If
strAHREF = Replace(strAHREF, "<a href=""", "<a
href=""http://www.kompas.com")
'filter font size
If InStr(strAHREF, "size=""4""") Then
strAHREF = Replace(strAHREF, "size=""4""", "size='2'")
End If
If InStr(strAHREF, "size =""4""") Then
strAHREF = Replace(strAHREF, "size =""4""", "size='2'")
End If
If InStr(strAHREF, "size="" 4""") Then
strAHREF = Replace(strAHREF, "size="" 4""", "size='2'")
End If
' end of font-size filter
End If
' end of filter kompas
If strAHREF <> "" Then
intJumLink = intJumLink + 1
ReDim Preserve strLink(intJumLink)
strLink(intJumLink) = strAHREF & "<br>" & vbCrLf
End If
strTemp = Mid(strTemp, intPosAkhir)
End If
Next
'write html begin
c.writeline "<HTML><HEAD>" & vbCrLf
c.writeline "<META http-equiv=pragma CONTENT=no-cache>" & vbCrLf
c.writeline "<META NAME='author' CONTENT='Andi Zain, [EMAIL PROTECTED]'>"
& vbCrLf
c.writeline "<META NAME='keywords' CONTENT=''>" & vbCrLf
c.writeline "<META NAME='description' CONTENT=''>" & vbCrLf
c.writeline "<style>" & vbCrLf
c.writeline "</style>" & vbCrLf
c.writeline "</head>" & vbCrLf
c.writeline "<body bgcolor=""orange"">" & vbCrLf
'end of html begin
c.writeline "Sumber: " & strFullURL & "<br>"
For z = 0 To UBound(strLink())
c.writeline strLink(z)
Next
c.writeline "</body></html>" & vbCrLf
c.Close
Set fs = Nothing
'end html end
xyz = UBound(strLink())
Call writeFinal(xyz, arrMedia(Connect))
Next
'Exit Sub
'errhandler:
'MsgBox Err.Number & vbCrLf & Err.Description & vbCrLf & Err.Source
Next
Unload Form1
End Sub
Sub writeFinal(total, media)
'-----Jika jumlah link lebih dari 10
If (total) > 9 Then
Set fso = CreateObject("Scripting.FileSystemObject")
Select Case media
Case "www.kompas.com"
fso.CopyFile (App.Path & "\tempkompas.htm"), (App.Path &
"\kompas.html"), True
Case "www.detik.com"
fso.CopyFile (App.Path & "\tempdetik.htm"), (App.Path & "\detik.html"),
True
Case Else
End Select
Set fso = Nothing
End If
End Sub
Regards,
Andi Zain
http://www.mm-inet.com
Dimana saya bisa mendapatkan kurs dollar dan informasi cuaca secara real
time yang bisa saya "tempelkan" pada web site saya ataupun bisa
mengolah/menyimpannya informasi kurs/cuaca tersebut. Artinya saya bisa
mengambil informasi kurs/cuaca tersebut dan bisa saya gabung dengan script
yang saya buat misal dengan Perl. Sehingga saya bisa menyimpannya ke sebuah
file data.
T5 kacih,
Anon Kuncoro Widigdo
www.iklanwap.com
>>>>> 2.5 Mbps InternetShop >> InternetZone << Margonda Raya 340 <<<<<
Berhenti langganan kirim email ke [EMAIL PROTECTED]
Arsip di http://www.mail-archive.com/[email protected]/
>>>>> 2.5 Mbps InternetShop >> InternetZone << Margonda Raya 340 <<<<<
Berhenti langganan kirim email ke [EMAIL PROTECTED]
Arsip di http://www.mail-archive.com/[email protected]/
