Güzel bir programla/notlarla yeni bir post.
Programın,notların işlemleri;
Vb.net kullanarak Web sayfalarını getirmek veya web sayfalarına değerler post ederek gelen değerleri almak. Alınan verileri excel dosyası oluşturup ilgili sütün/satırlara yazıp biçimlendirmeleri (hücre birleştirme,renklendirme) yapıp kayıt etmek.
Programın yaptıkları;
1-İzmir metro seferlerini www.izmir.bel.tr adresinden Get ile alıp kaynak kodunu temizledikten sonra excele aktarıp kayıt etmek
2-İzmir banliyo seferlerini www.izban.com.tr adresinden alıp kayıt etmek.
3-Vapur seferlerini www.izmir.bel.tr ulaşımdaki vapur alanında bulunan kalkış ve varış comboboxları içerisindeki değerlerin hepsini tek tek post ederek gelen değerlere göre sefer varsa excele atmak
4-Otobüs numaralarını kullanarak www.eshot.gov.tr sitesinden her bir otobüs numarası için güzergah,saatlerini alıp excele kayıt etmek.
Kısaca izmir offline ulaşım rehberi. (21 Ekim 2010)
Programın tam proje dosyasını indirmek için tıklayınız (vs 2005)
Imports System.Net
Imports System.Text
Imports System.IO
Imports Microsoft.Office.Core
Imports System.Threading
Imports System.Runtime.InteropServices
Public Class Form1
Shared threadcount As Integer = 0
Shared path As String = ""
Dim bitti As Boolean = False
Shared sonalinan As String = ""
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Control.CheckForIllegalCrossThreadCalls = False
End Sub
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnotobus.Click
If IsNumeric(txtotobusilk.Text) And IsNumeric(txtotobusson.Text) Then
If Val(txtotobusilk.Text) > Val(txtotobusson.Text) Then
MsgBox(“İlk otobüs son otobüs numarasından büyük olamaz”)
Exit Sub
End If
Else
MsgBox(“Lütfen otobüs numarası alanlarına rakam giriniz”)
Exit Sub
End If
DirectoryCheck()
path = txtpath.Text
Dim thbaslat As Thread
Dim thkbaslat As New ThreadStart(AddressOf OtobusTaramaBaslat)
thbaslat = New Thread(thkbaslat)
thbaslat.Start()
End Sub
Private Sub OtobusTaramaBaslat()
bitti = False
Dim thistatistik As Thread
Dim thkistatistik As New ThreadStart(AddressOf SbIstatistik)
thistatistik = New Thread(thkistatistik)
thistatistik.Start()
Dim alinansayisi As Integer = 0
btnotobus.Enabled = False
System.IO.Directory.CreateDirectory(path & “\Otobus”)
For i As Integer = Val(txtotobusilk.Text) To Val(txtotobusson.Text)
lblcalisilan.Text = i.ToString
tekrar:
If threadcount >= Val(txtmaxthread.Text) Then
Thread.Sleep(500)
GoTo tekrar
End If
Dim otobusclass As New OtobusTara
otobusclass.otobusno = i
Dim thsoft As New Thread(AddressOf otobusclass.Otobusbulyaz)
thsoft.IsBackground = True
thsoft.Priority = ThreadPriority.Normal
thsoft.Start()
Interlocked.Increment(threadcount)
Thread.Sleep(500)
Next
bitti = True
btnotobus.Enabled = True
‘Call ProcessKill()
lblsondurum.Text = “Sefer alım threadları tamamlandı” & vbCrLf & _
“Çalışan threadların sonlanması bekleniyor”
End Sub
Private Sub SbIstatistik()
bas:
If threadcount = 0 And bitti = True Then
lblthreadcount.Text = threadcount
lblsondurum.Text = “Sefer Alımları Tamamlandı” & vbCrLf & _
“Bazı excel prosesleri takılı kalmış olabilir” & vbCrLf & _
“Biraz bekledikten sonra excel işlemlerini sonlandırabilirsiniz”
Exit Sub
Else
lblalinan.Text = sonalinan
lblthreadcount.Text = threadcount
Thread.Sleep(100)
GoTo bas
End If
End Sub
Public Class OtobusTara
Public otobusno As Integer
Public Sub Otobusbulyaz()
Dim kaynakkodu As String = “”
Dim kaynak As String = “”
Dim guzergah As String = “”
Try
Dim istek As HttpWebRequest = HttpWebRequest.Create(“http://www.eshot.gov.tr/otobushareket/OtobusSaatleri.aspx?hatno=” & otobusno.ToString)
Dim cevap As HttpWebResponse = istek.GetResponse
Dim sr As IO.StreamReader = New IO.StreamReader(cevap.GetResponseStream())
kaynak = sr.ReadToEnd()
Catch ex As WebException
MsgBox(“Web sayfası alınırken sorun oluştu” & vbCrLf & ex.Message)
GoTo cikis
End Try
If Not (InStr(kaynak, “Hat No”) > 0) Then
‘Otobüs yok
GoTo cikis
End If
Dim baslangictext As String = “<th scope=””col””>”
Dim bitistext As String = “<input type=””hidden”””
Dim tablobas As Integer = InStr(kaynak, baslangictext)
If tablobas = 0 Then
‘Otobüs yok
GoTo cikis
End If
Dim guzergahbas As Integer = InStr(kaynak, “<span id=””lbGuzergah””>”) + 22
Dim guzergahson As String = InStr(kaynak, “<div id=””aciklamaDiv”””) – (InStr(kaynak, “<span id=””lbGuzergah””>”) + 61)
guzergah = Mid(kaynak, guzergahbas, guzergahson)
Dim tabloson As Integer = InStr(Mid(kaynak, tablobas, Len(kaynak) – tablobas), bitistext) – 20
kaynakkodu = Mid(kaynak, tablobas, tabloson)
kaynakkodu = Replace(kaynakkodu, Chr(13), “”)
kaynakkodu = Replace(kaynakkodu, Chr(10), “”)
kaynakkodu = Replace(kaynakkodu, ” “, “”)
kaynakkodu = Replace(kaynakkodu, ” “, “”)
kaynakkodu = Replace(kaynakkodu, “<th scope=””col””>”, “”)
kaynakkodu = Replace(kaynakkodu, “</td><td align=””center””>”, “;”)
kaynakkodu = Replace(kaynakkodu, “</td></tr><tr style=””background-color:White;””><td align=””center””>”, Chr(13))
kaynakkodu = Replace(kaynakkodu, “</td></tr><tr style=””background-color:#EDEDED;””><td align=””center””>”, Chr(13))
kaynakkodu = Replace(kaynakkodu, “</td></tr></table></div></td><td valign=””top””><div><table cellspacing=””0″” cellpadding=””4″” border=””0″” id=””grid3″” style=””color:#333333;width:150px;border-collapse:collapse;””><tr style=””color:White;background-color:#616161;font-weight:bold;””>”, Chr(13))
kaynakkodu = Replace(kaynakkodu, “</td></tr></table></div></td><td valign=””top””><div><table cellspacing=””0″” cellpadding=””4″” border=””0″” id=””grid2″” style=””color:#333333;width:150px;border-collapse:collapse;””><tr style=””color:White;background-color:#616161;font-weight:bold;””>”, Chr(13))
kaynakkodu = Replace(kaynakkodu, “</th></tr><tr style=””background-color:#EDEDED;””><td align=””center””>”, Chr(13))
kaynakkodu = Replace(kaynakkodu, “</th>”, “;”)
kaynakkodu = Replace(kaynakkodu, “</td></tr></table></div></td></tr></table> “, “”)
kaynakkodu = Replace(kaynakkodu, “Ç”, “C”)
kaynakkodu = Replace(kaynakkodu, “Ü”, “U”)
kaynakkodu = Replace(kaynakkodu, “ı”, “i”)
kaynakkodu = Replace(kaynakkodu, “ş”, “s”)
kaynakkodu = Replace(kaynakkodu, “Ö”, “Ö”)
kaynakkodu = Replace(kaynakkodu, “G?zergah”, “Guzergah”)
kaynakkodu = Replace(kaynakkodu, “KAR?”, “KARS”)
kaynakkodu = Replace(kaynakkodu, “ş”, “s”)
kaynakkodu = Replace(kaynakkodu, ” “, ” “)
Dim oXL As Excel.Application
Dim oWB As Excel.Workbook
Dim oSheet As Excel.Worksheet
oXL = CreateObject(“Excel.Application”)
oXL.Visible = False
oWB = oXL.Workbooks.Add
oSheet = oWB.ActiveSheet
Dim satirlar() As String = Split(kaynakkodu, Chr(13))
Dim cumartesi As Boolean = False
Dim pazar As Boolean = False
Dim cumartesisayisi As Integer = 0
Dim pazarsayisi As Integer = 0
oSheet.Cells(1, 1) = guzergah
For i As Integer = 0 To satirlar.Length – 1
Dim satir As String = satirlar(i).ToString
Dim ogeler() As String = Split(satir, “;”)
If ogeler.Length < 2 Then Exit For
If InStr(ogeler(0), “Kalkış”) And i > 5 And cumartesi = True Then
cumartesi = False
pazar = True
End If
If InStr(ogeler(0), “Kalkış”) And i > 5 And cumartesi = False And pazar = False Then
cumartesi = True
End If
If cumartesi = True Then
oSheet.Cells(cumartesisayisi + 2, 3) = ogeler(0)
oSheet.Cells(cumartesisayisi + 2, 4) = ogeler(1)
cumartesisayisi += 1
End If
If pazar = True Then
oSheet.Cells(pazarsayisi + 2, 5) = ogeler(0)
oSheet.Cells(pazarsayisi + 2, 6) = ogeler(1)
pazarsayisi += 1
End If
If cumartesi = False And pazar = False Then
oSheet.Cells(i + 2, 1) = ogeler(0)
oSheet.Cells(i + 2, 2) = ogeler(1)
End If
Next
If cumartesisayisi > 0 Then
‘ Eğer cumartesi günü sefer varsa C2 den başlayıp
‘ Cumartesi günü sonuna kadar renklendirelim
With oSheet.Range(“C2”, “D” & cumartesisayisi + 1)
‘.Font.Bold = True
.Interior.ColorIndex = 17
.VerticalAlignment = Excel.XlVAlign.xlVAlignCenter
End With
End If
With oSheet.Range(“A1”, “F1”)
‘ Otobüs guzergahını biçimlendirelim
.Merge()
.Font.Size = 7
.Font.Bold = True
.HorizontalAlignment = Excel.XlHAlign.xlHAlignCenter
End With
With oSheet.Range(“A2”, “F2”)
‘ Başlık bilgilerini biçimlendirelim
.WrapText = True
.ColumnWidth = 10
.Font.Size = 7
.Font.Bold = True
.Interior.ColorIndex = 13
.HorizontalAlignment = Excel.XlHAlign.xlHAlignCenter
.VerticalAlignment = Excel.XlVAlign.xlVAlignCenter
.EntireColumn.AutoFit()
End With
With oSheet.Range(“A3”, “F253”)
.Font.Size = 9
.EntireColumn.AutoFit()
.HorizontalAlignment = Excel.XlHAlign.xlHAlignCenter
.VerticalAlignment = Excel.XlVAlign.xlVAlignCenter
End With
Dim dosyaadi As String = otobusno & “-” & Replace(oSheet.Cells(2, 1).Value.ToString, ” Kalkış”, “”) & “-” & Replace(oSheet.Cells(2, 2).value.ToString, ” Kalkış”, “”) & “(” & guzergah & “)” & “.xls”
If Len(dosyaadi) > 150 Then
dosyaadi = otobusno & “-” & Replace(oSheet.Cells(2, 1).Value.ToString, ” Kalkış”, “”) & “-” & Replace(oSheet.Cells(2, 2).value.ToString, ” Kalkış”, “”) & “(” & Mid(guzergah, 1, 100) & “)” & “.xls”
End If
If System.IO.File.Exists(path + “\Otobus\” + dosyaadi) Then
Dim cvp = MessageBox.Show(“Kayıt edilmeye çalışılan dosya mevcut üzerine yazılsın mı?” & vbCrLf & “Dosyaadı:” & path + “\Otobus\” + dosyaadi, “Dosya Mevcut”, MessageBoxButtons.YesNo, MessageBoxIcon.Information, MessageBoxDefaultButton.Button1)
If cvp = vbYes Then
silveuzerineyaz:
‘Dosya mevcutsa eski dosyayı silelim
Try
System.IO.File.Delete(path + “\Otobus\” + dosyaadi)
Catch ex As IOException
MsgBox(“Dosya üzerine yazılırken hata oluştu” & vbCrLf & ex.Message)
Exit Sub
End Try
Else
Dim yenidosyaadi As String = “”
yenidosyaadi = InputBox(“Dosya Adını Giriniz iptal demeniz durumunda dosya kayıt edilmeyecektir”, “Yeni Adı Gir”, dosyaadi)
If yenidosyaadi = “” Or yenidosyaadi = dosyaadi Then
GoTo cikis
ElseIf yenidosyaadi <> dosyaadi Then
If InStr(yenidosyaadi, “.xls”) = 0 Then yenidosyaadi += “.xls”
dosyaadi = yenidosyaadi
End If
End If
End If
oSheet.SaveAs(path + “\Otobus\” + dosyaadi)
oWB.Close(False)
oXL.Workbooks.Close()
oXL.Quit()
sonalinan = otobusno
cikis:
Interlocked.Decrement(threadcount)
End Sub
End Class
Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnvapur.Click
DirectoryCheck()
path = txtpath.Text
Dim thbaslat As Thread
Dim thkbaslat As New ThreadStart(AddressOf VapurTara)
thbaslat = New Thread(thkbaslat)
thbaslat.Start()
End Sub
Private Sub VapurTara()
System.IO.Directory.CreateDirectory(path & “\Vapur”)
btnvapur.Enabled = False
‘ Programın çalışma aşamaları
‘ İzmir belediyesinin vapur.asp sayfasına bağlanıp
‘ Kalkış ve varış comboboxlarındaki değerler alındıktan sonra.
‘ Her kalkış noktasından her varış noktası için
‘ değerleri post edip gelen değerlere göre eğer vapur var ise
‘ kalkış ve varış noktalarına göre xls dosyası oluşturmakta.
Dim kaynak As String = “”
Dim kalkis As String = “”
Dim varis As String = “”
Try
Dim istek As HttpWebRequest = HttpWebRequest.Create(“http://www.izmir.bel.tr/vapur.asp”)
Dim cevap As HttpWebResponse = istek.GetResponse
Dim sr As IO.StreamReader = New IO.StreamReader(cevap.GetResponseStream(), Encoding.GetEncoding(“windows-1254”))
kaynak = sr.ReadToEnd()
Catch ex As WebException
MsgBox(“Web sayfası alınırken sorun oluştu” & vbCrLf & ex.Message)
GoTo cikis
End Try
Dim baslangictext As String = “<select class=””frm”” name=””kal””>”
Dim bitistext As String = “</select>”
Dim tablobas As Integer = InStr(kaynak, baslangictext) + 40
If tablobas = 0 Then
‘Ana web sayfası içerisindeki comboboxlardaki değerleri alalım
GoTo cikis
End If
Dim tabloson As Integer = InStr(Mid(kaynak, tablobas, Len(kaynak) – tablobas), bitistext) – 25
kalkis = Mid(kaynak, tablobas, tabloson)
kalkis = Replace(kalkis, Chr(13), “”)
kalkis = Replace(kalkis, Chr(10), “”)
kalkis = Replace(kalkis, ” “, “”)
kalkis = Replace(kalkis, ” “, “”)
kalkis = Replace(kalkis, ” “, “”)
kalkis = Replace(kalkis, ” <option value=”””, “”)
kalkis = Replace(kalkis, “<option value=”””, “”)
kalkis = Replace(kalkis, “”” >”, “;”)
kalkis = Replace(kalkis, “</option>”, Chr(13))
Dim kalkislar() As String = Split(kalkis, Chr(13))
‘ Her bir satır için bir dizi oluşturalım
baslangictext = “<select class=””frm”” name=””Var””>”
bitistext = “<select class=””frm”” name=””gun””>”
tablobas = InStr(kaynak, baslangictext) + 40
tabloson = InStr(Mid(kaynak, tablobas, Len(kaynak) – tablobas), bitistext) – 115
varis = Mid(kaynak, tablobas, tabloson)
varis = Replace(varis, Chr(13), “”)
varis = Replace(varis, Chr(10), “”)
varis = Replace(varis, ” “, “”)
varis = Replace(varis, ” “, “”)
varis = Replace(varis, ” “, “”)
varis = Replace(varis, ” <option value=”””, “”)
varis = Replace(varis, “<option value=”””, “”)
varis = Replace(varis, “”” >”, “;”)
varis = Replace(varis, “</option>”, Chr(13))
varis = Replace(varis, Chr(13) + Chr(32), “”)
Dim varislar() As String = Split(varis, Chr(13))
‘ Her bir satır için bir dizi oluşturalım
For i As Integer = 0 To kalkislar.Length – 1
For y As Integer = 0 To varislar.Length – 1
If InStr(kalkislar(i), “;”) = 0 Then GoTo sonraki
If InStr(varislar(y), “;”) = 0 Then GoTo sonraki
Dim strkalkis As String = Mid(kalkislar(i), 1, InStr(kalkislar(i), “;”) – 1)
Dim strvaris As String = Mid(varislar(y), 1, InStr(varislar(y), “;”) – 1)
If strkalkis <> strvaris Then
Dim strkalkispost As String = strkalkis
Dim strvarispost As String = strvaris
‘ Türkçe karakterler post edilirken
‘ aşağıdaki şekilde dönüştürmeleri gerekiyor.
strkalkispost = Replace(strkalkispost, ” “, “+”)
strkalkispost = Replace(strkalkispost, “(“, “%28”)
strkalkispost = Replace(strkalkispost, “)”, “%29”)
strkalkispost = Replace(strkalkispost, “Ü”, “%DC”)
strkalkispost = Replace(strkalkispost, “Ç”, “%C7”)
strkalkispost = Replace(strkalkispost, “Ş”, “%DE”)
strkalkispost = Replace(strkalkispost, “Ö”, “%D6″)
strvarispost = Replace(strvarispost, ” “, “+”)
strvarispost = Replace(strvarispost, “(“, “%28”)
strvarispost = Replace(strvarispost, “)”, “%29”)
strvarispost = Replace(strvarispost, “Ü”, “%DC”)
strvarispost = Replace(strvarispost, “Ç”, “%C7”)
strvarispost = Replace(strvarispost, “Ş”, “%DE”)
strvarispost = Replace(strvarispost, “Ö”, “%D6”)
lblsondurum.Text = “Alınıyor : ” & strkalkis & “-” & strvaris
‘Her vapur için hafta içi,c.tesi ve pazarı deneyelim
Dim z As Integer
Dim oXL As Excel.Application
Dim oWB As Excel.Workbook
Dim oSheet As Excel.Worksheet
Dim vapurungunsayisi As Integer = 0
Dim vapurhareketsayisi As Integer = 0
For z = 0 To 2
Dim oWeb As New System.Net.WebClient()
oWeb.Headers.Add(“Content-Type”, “application/x-www-form-urlencoded”)
Dim bytRetData As Byte()
Dim bytArguments As Byte()
If z = 0 Then
bytArguments = System.Text.Encoding.GetEncoding(“windows-1254”).GetBytes(“guncek=0&kal=” & strkalkispost & “&var=” & strvarispost & “&gun=H&cek=1”)
ElseIf z = 1 Then
bytArguments = System.Text.Encoding.GetEncoding(“windows-1254”).GetBytes(“guncek=1&kal=” & strkalkispost & “&var=” & strvarispost & “&gun=C&cek=1”)
Else
bytArguments = System.Text.Encoding.GetEncoding(“windows-1254”).GetBytes(“guncek=2&kal=” & strkalkispost & “&var=” & strvarispost & “&gun=P&cek=1”)
End If
Try
bytRetData = oWeb.UploadData(“http://www.izmir.bel.tr/vapur.asp?idd=2”, “POST”, bytArguments)
Catch ex As WebException
MsgBox(“Web sayfası alınırken hata oluştu” & vbCrLf & ex.Message)
Exit Sub
End Try
kaynak = System.Text.Encoding.GetEncoding(“windows-1254”).GetString(bytRetData)
If InStr(kaynak, “Bu kriterlere uygun vapur”) Then
‘GoTo sonraki
‘Eğer sorgulara karşılık olarak sayfa içeriğinde
‘ Bu kriterlere uygun vapur bulunamadı yer almıyorsa
‘ aşağıdaki işlemleri yapıyoruz
Else
vapurungunsayisi += 1
If z = 0 Then
oXL = CreateObject(“Excel.Application”)
oXL.Visible = False
oWB = oXL.Workbooks.Add
oSheet = oWB.ActiveSheet
End If
oSheet.Cells(1, 3) = “Hafta İçi”
oSheet.Cells(1, 5) = “Cumartesi”
oSheet.Cells(1, 7) = “Pazar”
baslangictext = “<table width=””565″” border=””0″” cellspacing=””0″” cellpadding=””0″”>”
baslangictext = “<td width=””135″” height=””12″” align=””center””><b>Kalkış</b></td>”
bitistext = “</table>”
tablobas = 0
tablobas = InStr(kaynak, baslangictext)
tabloson = 0
tabloson = InStr(Mid(kaynak, tablobas, Len(kaynak) – tablobas), bitistext) – 20
Dim vapurseferleri As String = Mid(kaynak, tablobas, tabloson)
vapurseferleri = Replace(vapurseferleri, “Ç”, “C”)
vapurseferleri = Replace(vapurseferleri, “Ü”, “U”)
vapurseferleri = Replace(vapurseferleri, “ı”, “i”)
vapurseferleri = Replace(vapurseferleri, “ş”, “s”)
vapurseferleri = Replace(vapurseferleri, “G?zergah”, “Guzergah”)
vapurseferleri = Replace(vapurseferleri, “KAR?”, “KARS”)
vapurseferleri = Replace(vapurseferleri, “ş”, “s”)
vapurseferleri = Replace(vapurseferleri, ” “, ” “)
vapurseferleri = Replace(vapurseferleri, ” “, “”)
vapurseferleri = Replace(vapurseferleri, ” “, “”)
vapurseferleri = Replace(vapurseferleri, ” “, “”)
vapurseferleri = Replace(vapurseferleri, Chr(10), “”)
vapurseferleri = Replace(vapurseferleri, Chr(13), “”)
vapurseferleri = Replace(vapurseferleri, “<td width=””135″” height=””12″” align=””center””><b>”, “”)
vapurseferleri = Replace(vapurseferleri, “</b></td><td width=””101″” height=””12″” align=””center””><b>”, “;”)
vapurseferleri = Replace(vapurseferleri, “</b></td><td width=””101″” height=””12″” align=””center””><b>”, “;”)
vapurseferleri = Replace(vapurseferleri, “</b></td><td width=””225″” height=””12″” align=””center””><b>”, “;”)
vapurseferleri = Replace(vapurseferleri, “</b></td><td width=””54″” height=””12″” align=””center””><b>”, “;”)
vapurseferleri = Replace(vapurseferleri, “<tr bgcolor=””#FFFFFF””><td width=””135″” align=””center”” height=””22″”>”, “”)
vapurseferleri = Replace(vapurseferleri, “</td><td align=””center”” width=””101″”>”, “;”)
vapurseferleri = Replace(vapurseferleri, “</td><td width=””225″”> “, “;”)
vapurseferleri = Replace(vapurseferleri, “</td><td width=””225″”>”, “;”)
vapurseferleri = Replace(vapurseferleri, “</td><td align=””center”” width=””54″”>”, “;”)
vapurseferleri = Replace(vapurseferleri, “</td></tr>”, Chr(13))
vapurseferleri = Replace(vapurseferleri, “</b>”, “”)
Dim seferler() As String = Split(vapurseferleri, Chr(13))
‘ En fazla kaç satır çıkmış onu excel renklendirme için alalım
If seferler.Length > vapurhareketsayisi Then vapurhareketsayisi = seferler.Length
For p As Integer = 0 To seferler.Length – 1
Dim satir As String = seferler(p).ToString
Dim ogeler() As String = Split(satir, “;”)
‘ Daha önce ; ile ayırdığımız değerler parçalayıp ilkgili hücrelere yazalım
If ogeler.Length < 3 Then Exit For
If z = 0 Then
oSheet.Cells(p + 2, 1) = ogeler(0)
oSheet.Cells(p + 2, 2) = ogeler(1)
oSheet.Cells(p + 2, 3) = ogeler(2)
oSheet.Cells(p + 2, 4) = ogeler(3)
ElseIf z = 1 Then
oSheet.Cells(p + 2, 5) = ogeler(2)
oSheet.Cells(p + 2, 6) = ogeler(3)
Else
oSheet.Cells(p + 2, 7) = ogeler(2)
oSheet.Cells(p + 2, 8) = ogeler(3)
End If
Next
End If ‘Vapur bulundu/bulunamadı
Next ‘z 0 dan 3 e kadar günler için
If vapurungunsayisi > 0 Then
With oSheet.Range(“A1”, “A2”)
.Merge()
End With
With oSheet.Range(“B1”, “B2”)
.Merge()
End With
With oSheet.Range(“C1”, “D1”)
.Merge()
End With
With oSheet.Range(“E1”, “F1”)
.Merge()
End With
With oSheet.Range(“G1”, “H1”)
.Merge()
End With
With oSheet.Range(“A1”, “H1”)
.HorizontalAlignment = Excel.XlHAlign.xlHAlignCenter
.VerticalAlignment = Excel.XlVAlign.xlVAlignCenter
End With
With oSheet.Range(“A2”, “H253”)
‘.WrapText = True
‘.ColumnWidth = 10
.Font.Size = 9
.EntireColumn.AutoFit()
.HorizontalAlignment = Excel.XlHAlign.xlHAlignCenter
.VerticalAlignment = Excel.XlVAlign.xlVAlignCenter
End With
oSheet.Range(“D1”, “D90”).ColumnWidth = 6
oSheet.Range(“D1”, “D90”).WrapText = True
oSheet.Range(“F1”, “F90”).ColumnWidth = 6
oSheet.Range(“F1”, “F90”).WrapText = True
oSheet.Range(“H1”, “H90”).ColumnWidth = 6
oSheet.Range(“H1”, “H90”).WrapText = True
oSheet.Range(“E3”, “F” & vapurhareketsayisi).Interior.ColorIndex = 17
oSheet.SaveAs(path & “\Vapur\” & strkalkis & “-” & strvaris & “.xls”)
oWB.Close()
oXL.Quit()
End If
End If ‘kalkış ile varış farklıysa
sonraki:
Next
Next
cikis:
lblsondurum.Text = “Vapur Listeleme Sona Erdi” & vbCrLf & “Bazı excel uygulamaları kapanmamış olabilir elle sonlandırabilirsiniz..”
btnvapur.Enabled = True
End Sub
Private Sub TextBox1_MouseClick(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles txtpath.MouseClick
objfolder.ShowNewFolderButton = True
bas:
objfolder.ShowDialog()
If objfolder.SelectedPath <> “” Then
txtpath.Text = objfolder.SelectedPath
End If
If Not System.IO.Directory.Exists(txtpath.Text) Then
MsgBox(“Dosyaların kayıt edileceği klasör mevcut değil”)
GoTo bas
End If
End Sub
Private Sub ProcessKill()
Dim isleyenprocess As Integer = 0
For Each proc As Process In Process.GetProcessesByName(“Excel”)
isleyenprocess += 1
Next proc
tekrarsonlandir:
For y As Integer = 0 To isleyenprocess
Dim objProcess As New Process()
objProcess.StartInfo.UseShellExecute = False
objProcess.StartInfo.RedirectStandardOutput = True
objProcess.StartInfo.CreateNoWindow = True
objProcess.StartInfo.RedirectStandardError = True
objProcess.StartInfo.FileName() = “taskkill.exe”
objProcess.StartInfo.Arguments() = “/im:excel.exe /f”
objProcess.Start()
Next
Thread.Sleep(5000)
isleyenprocess = 0
For Each proc As Process In Process.GetProcessesByName(“Excel”)
isleyenprocess += 1
Next proc
If isleyenprocess > 0 Then
GoTo tekrarsonlandir
End If
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
DirectoryCheck()
path = txtpath.Text
Dim thbaslat As Thread
Dim thkbaslat As New ThreadStart(AddressOf BanliyoTara)
thbaslat = New Thread(thkbaslat)
thbaslat.Start()
End Sub
Private Sub BanliyoTara()
lblsondurum.Text = “Banliyo seferleri alınıyor…”
System.IO.Directory.CreateDirectory(path & “\Banliyo”)
Dim kaynakkodu As String = “”
Dim kaynak As String = “”
Try
Dim istek As HttpWebRequest = HttpWebRequest.Create(“http://www.izban.com.tr/Sayfalar/Single.aspx?Page=33”)
Dim cevap As HttpWebResponse = istek.GetResponse
Dim sr As IO.StreamReader = New IO.StreamReader(cevap.GetResponseStream(), Encoding.GetEncoding(“windows-1254”))
kaynak = sr.ReadToEnd()
Catch ex As WebException
MsgBox(“Web sayfası alınırken sorun oluştu” & vbCrLf & ex.Message)
GoTo cikis
End Try
If Not (InStr(kaynak, “Alsancak”) > 0) Then
‘Banliyo Yok
GoTo cikis
End If
Dim baslangictext As String = “<tbody>”
Dim bitistext As String = “</tbody>”
Dim tablobas As Integer = InStr(kaynak, baslangictext)
If tablobas = 0 Then
‘tablo bulunamadı
GoTo cikis
End If
Dim tabloson As Integer = InStr(Mid(kaynak, tablobas, Len(kaynak) – tablobas), bitistext) – 20
kaynakkodu = Mid(kaynak, tablobas, tabloson)
kaynakkodu = Replace(kaynakkodu, Chr(13), “”)
kaynakkodu = Replace(kaynakkodu, Chr(10), “”)
kaynakkodu = Replace(kaynakkodu, ” “, “”)
kaynakkodu = Replace(kaynakkodu, ” “, “”)
kaynakkodu = Replace(kaynakkodu, “</tr>”, Chr(13))
kaynakkodu = Replace(kaynakkodu, “<font face=””Calibri”” color=””#000080″” size=””5″”>”, “”)
kaynakkodu = Replace(kaynakkodu, “<font color=””#000080″” size=””5″” face=””Calibri””>”, “”)
kaynakkodu = Replace(kaynakkodu, “<font color=””#ff0000″” size=””5″” face=””Calibri””>”, “”)
kaynakkodu = Replace(kaynakkodu, “</font>”, “”)
Dim satirlar() As String = Split(kaynakkodu, Chr(13))
Dim oXL As Excel.Application
Dim oWB As Excel.Workbook
Dim oSheet As Excel.Worksheet
oXL = CreateObject(“Excel.Application”)
oXL.Visible = False
oWB = oXL.Workbooks.Add
oSheet = oWB.ActiveSheet
oSheet.Cells(1, 1) = “Alsancak Kalkış”
oSheet.Cells(1, 2) = “Cumaovası Kalkış”
For i As Integer = 1 To satirlar.Length – 1
Dim ilkhucre As String = “”
Dim sonhucre As String = “”
Dim s As String = satirlar(i)
tablobas = InStr(s, “<strong>”) + 8
tabloson = InStr(s, “</strong>”)
ilkhucre = Mid(s, tablobas, tabloson – tablobas)
s = Mid(s, tabloson + 20, s.Length – tabloson)
tablobas = InStr(s, “<strong>”) + 8
tabloson = InStr(s, “</strong>”)
If tabloson = 0 Then
sonhucre = ” ”
Else
sonhucre = Mid(s, tablobas, tabloson – tablobas)
End If
oSheet.Cells(i + 1, 1) = ilkhucre
oSheet.Cells(i + 1, 2) = sonhucre
Next
With oSheet.Range(“A1”, “B253”)
.WrapText = True
.ColumnWidth = 10
.Font.Size = 9
.EntireColumn.AutoFit()
.HorizontalAlignment = Excel.XlHAlign.xlHAlignCenter
.VerticalAlignment = Excel.XlVAlign.xlVAlignCenter
End With
If System.IO.File.Exists(path & “\Banliyo\Seferler.xls”) Then
Dim cvp = MessageBox.Show(“Banliyo seferleri daha önce kayıt edilmiş?” & vbCrLf & “Dosyaadı:” + path & “\Banliyo\Seferler.xls”, “Dosya Mevcut”, MessageBoxButtons.YesNo, MessageBoxIcon.Information, MessageBoxDefaultButton.Button1)
If cvp = vbYes Then
silveuzerineyaz:
‘Dosya mevcutsa eski dosyayı silelim
Try
System.IO.File.Delete(path & “\Banliyo\Seferler.xls”)
Catch ex As IOException
MsgBox(“Dosya üzerine yazılırken hata oluştu” & vbCrLf & ex.Message)
lblsondurum.Text = “Banliyo seferleri yazılamadı”
oWB.Close()
oXL.Quit()
Exit Sub
End Try
End If
End If
oWB.SaveAs(path & “\Banliyo\Seferler.xls”)
oWB.Close()
oXL.Quit()
cikis:
lblsondurum.Text = “Banliyo seferleri alımı tamamlandı…”
End Sub
Private Sub btnmetro_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnmetro.Click
DirectoryCheck()
path = txtpath.Text
Dim thbaslat As Thread
Dim thkbaslat As New ThreadStart(AddressOf MetroTara)
thbaslat = New Thread(thkbaslat)
thbaslat.Start()
End Sub
Private Sub MetroTara()
lblsondurum.Text = “Metro seferleri alınıyor…”
System.IO.Directory.CreateDirectory(path & “\Metro”)
Dim kaynakkodu As String = “”
Dim kaynak As String = “”
Try
Dim istek As HttpWebRequest = HttpWebRequest.Create(“http://www.izmir.bel.tr/metro.asp”)
Dim cevap As HttpWebResponse = istek.GetResponse
Dim sr As IO.StreamReader = New IO.StreamReader(cevap.GetResponseStream(), Encoding.GetEncoding(“windows-1254”))
kaynak = sr.ReadToEnd()
Catch ex As WebException
MsgBox(“Web sayfası alınırken sorun oluştu” & vbCrLf & ex.Message)
GoTo cikis
End Try
If InStr(kaynak, “SEFER SIKLIKLARI”) = 0 Then
‘Sayfada gerekli veri yok
GoTo cikis
End If
Dim baslangictext As String = “<td colspan=””2″” bgcolor=””#BCCAD2″”>”
Dim tablobas As Integer = InStr(kaynak, baslangictext)
If tablobas = 0 Then
‘tablo bulunamadı
GoTo cikis
End If
Dim bitistext As String = “</table></td></tr> </table><br>”
Dim tabloson As Integer = InStr(Mid(kaynak, tablobas, Len(kaynak) – tablobas), bitistext) – 36
kaynakkodu = Mid(kaynak, tablobas + 35, tabloson)
kaynakkodu = Replace(kaynakkodu, Chr(13), “”)
kaynakkodu = Replace(kaynakkodu, Chr(10), “”)
kaynakkodu = Replace(kaynakkodu, ” “, “”)
kaynakkodu = Replace(kaynakkodu, ” “, “”)
kaynakkodu = Replace(kaynakkodu, “</tr> “, Chr(13))
kaynakkodu = Replace(kaynakkodu, “</tr>”, Chr(13))
kaynakkodu = Replace(kaynakkodu, “<tr bgcolor=””#FFFFFF””> <td width=””17%”” height=””20″”>”, “”)
kaynakkodu = Replace(kaynakkodu, “</td><td width=””16%”” bgcolor=””#FFFFFF””>”, “;”)
kaynakkodu = Replace(kaynakkodu, “</td><td width=””19%””>”, “;”)
kaynakkodu = Replace(kaynakkodu, “<div align=””center””><b>”, “”)
kaynakkodu = Replace(kaynakkodu, “</b></div></td><td colspan=””2″” bgcolor=””#D8E0E5″”> “, “;;”)
kaynakkodu = Replace(kaynakkodu, “</b></div></td><td colspan=””2″” bgcolor=””#EEF1F3″”>”, “;;”)
kaynakkodu = Replace(kaynakkodu, “<tr bgcolor=””#FFFFFF””> <td width=””17%””><font size=””1″”><b>”, “”)
kaynakkodu = Replace(kaynakkodu, “</b></font></td><td width=””16%””><font size=””1″”><b>”, “;”)
kaynakkodu = Replace(kaynakkodu, “</b></font><font size=””1″”><b>”, “”)
‘ kaynakkodu = Replace(kaynakkodu, “<td colspan=””2″” bgcolor=””#EEF1F3″”> “, “;;”)
‘kaynakkodu = Replace(kaynakkodu, “<td colspan=””2″” bgcolor=””#D8E0E5″”> “, “;;”)
kaynakkodu = Replace(kaynakkodu, “</td><td width=””16%””>”, “;”)
kaynakkodu = Replace(kaynakkodu, “</td>”, “”)
kaynakkodu = Replace(kaynakkodu, “</b></div>”, “”)
kaynakkodu = Replace(kaynakkodu, “</b></font>”, “”)
kaynakkodu = Replace(kaynakkodu, “<font size=””1″”><b>”, “”)
Dim satirlar() As String = Split(kaynakkodu, Chr(13))
Dim oXL As Excel.Application
Dim oWB As Excel.Workbook
Dim oSheet As Excel.Worksheet
oXL = CreateObject(“Excel.Application”)
oXL.Visible = False
oWB = oXL.Workbooks.Add
oSheet = oWB.ActiveSheet
oSheet.Range(“A1”, “B1”).Merge()
oSheet.Range(“C1”, “D1”).Merge()
oSheet.Range(“E1”, “F1”).Merge()
oSheet.Cells(1, 1) = “Hafta İçi”
oSheet.Cells(1, 3) = “Cumartesi”
oSheet.Cells(1, 5) = “Pazar”
For i As Integer = 1 To satirlar.Length – 1
Dim ogeler() As String = Split(satirlar(i), “;”)
If ogeler.Length > 4 Then
oSheet.Cells(i + 1, 1) = Trim(ogeler(0))
oSheet.Cells(i + 1, 2) = Trim(ogeler(1))
oSheet.Cells(i + 1, 3) = Trim(ogeler(2))
oSheet.Cells(i + 1, 4) = Trim(ogeler(3))
oSheet.Cells(i + 1, 5) = Trim(ogeler(4))
oSheet.Cells(i + 1, 6) = Trim(ogeler(5))
End If
Next
With oSheet.Range(“A1”, “F253”)
.WrapText = True
.ColumnWidth = 12
.Font.Size = 9
.EntireColumn.AutoFit()
.HorizontalAlignment = Excel.XlHAlign.xlHAlignCenter
.VerticalAlignment = Excel.XlVAlign.xlVAlignCenter
End With
If System.IO.File.Exists(path & “\Metro\Seferler.xls”) Then
Dim cvp = MessageBox.Show(“Banliyo seferleri daha önce kayıt edilmiş?” & vbCrLf & “Dosyaadı:” + path & “\Banliyo\Seferler.xls”, “Dosya Mevcut”, MessageBoxButtons.YesNo, MessageBoxIcon.Information, MessageBoxDefaultButton.Button1)
If cvp = vbYes Then
silveuzerineyaz:
‘Dosya mevcutsa eski dosyayı silelim
Try
System.IO.File.Delete(path & “\Metro\Seferler.xls”)
Catch ex As IOException
MsgBox(“Dosya üzerine yazılırken hata oluştu” & vbCrLf & ex.Message)
lblsondurum.Text = “Metro seferleri yazılamadı”
oWB.Close()
oXL.Quit()
Exit Sub
End Try
End If
End If
oWB.SaveAs(path & “\Metro\Seferler.xls”)
oWB.Close()
oXL.Quit()
cikis:
lblsondurum.Text = “Metro seferleri alımı tamamlandı…”
End Sub
Private Sub DirectoryCheck()
bas:
If Not System.IO.Directory.Exists(txtpath.Text) Then
MsgBox(“Dosyaların kayıt edileceği klasöre erişilemiyor”)
objfolder.ShowDialog()
txtpath.Text = objfolder.SelectedPath
GoTo bas
End If
End Sub
End Class
Programın tam proje dosyasını indirmek için tıklayınız (vs 2005)