AccessTr.neT

AccessTr.neT > Visual Basic 6 > Visual Basic 6 Örnekleri ve Uygulamaları > İmsakiye
Tam Versiyon: İmsakiye
Şu anda arşiv modunu görüntülemektesiniz. Tam versiyonu görüntülemek için buraya tıklayınız.
Sayfalar: 1 2 3

mehmetdemiral

28/08/2009, 00:24
Ozan uzun zamandır webden veri alma konusunda bayaa mesafe aldı. Ben de onun çalışmalarından ilham alıp bazı web çalışmaları yaptım karınca kararınca. Ama bu işlerin bir uzmanı daha var ki bu sitede, hiçbirimiz onun eline su dökemeyiz gibi geliyor. O da sevgili Eşref İgit'tir. Webden veri alma konusunda takıldığımız yerde "Aman sorun değil, nasıl olsa Eşref var" deyip rahatladığımız bir kaledir o... Şiddetle öneririm Eşref Usta'yı...

Bu arada kaynak paylaşım konumuz gümbürtüye gitmesin sayın Muhammet AytaşImg-grin)) Ayrıca çalışmanızdan veri alabildim. Sanırım internet'ten Html kodlarıyla veri aldığımız tüm uygulamalar bu kaderi paylaşmak zorunda. BAzen veri gelmiyor işte, yapacak bir şey yok. Ben bu açıdan Xml'nin gözünü seveyim. Teklemez bile.

maytas

28/08/2009, 04:09
(28/08/2009, 00:02)mehmetdemiral yazdı: [ -> ]Vb çalışmanızı exe olarak değil kaynak olarak yayınlamazsanız bunun adı paylaşım olmaz ki? Burası paylaşım sitesi olduğuna göre, öğrenmek isteyen arkadaşlar için kaynak kodları yayınlamak ister misiniz?

İncelemek ve geliştirmek isteyenler için kaynak kodları:
Kod:
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" ( _
ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
      
Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" ( _
ByVal hInternetSession As Long, ByVal sServerName As String, ByVal nServerPort As Integer, ByVal sUsername As String, _
ByVal sPassword As String, ByVal lService As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long

Private Declare Function HttpOpenRequest Lib "wininet.dll" Alias "HttpOpenRequestA" ( _
ByVal hHttpSession As Long, ByVal sVerb As String, ByVal sObjectName As String, ByVal sVersion As String, ByVal sReferer As String, ByVal something As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long

Private Declare Function HttpSendRequest Lib "wininet.dll" Alias "HttpSendRequestA" ( _
ByVal hHttpRequest As Long, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal sOptional As String, ByVal lOptionalLength As Long) As Long

Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer

Private Const INTERNET_FLAG_RELOAD = &H80000000
Private Const INTERNET_SERVICE_HTTP = 3
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Dim Web As Object

Public Function IsInternetReady() As Boolean

  Dim lSession As Long
  Dim lConnect As Long
  Dim lRequest As Long
  Dim lResponse As Long

  Const sURL = "www.microsoft.com"
  ' Open an Internet Session
  lSession = InternetOpen("NetReady", INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
  If lSession = 0 Then Exit Function
  ' Create a connection
  lConnect = InternetConnect(lSession, sURL, 80, vbNullString, vbNullString, INTERNET_SERVICE_HTTP, 0, 0)
  ' Generate an HTTP GET request
  lRequest = HttpOpenRequest(lConnect, "GET", sURL, "HTTP/1.0", vbNullString, 0, INTERNET_FLAG_RELOAD, 0)
  ' Send the request, Response will be non-zero if successful
  lResponse = HttpSendRequest(lRequest, vbNullString, Len(vbNullString), vbNullString, Len(vbNullString))
  Call InternetCloseHandle(lSession)
  Call InternetCloseHandle(lConnect)
  Call InternetCloseHandle(lRequest)

  IsInternetReady = lResponse
End Function

Private Sub Combo1_Click()
        ListView1.ListItems.Clear
        Label2.Caption = ""
        Label4.Caption = ""
        Label5.Caption = ""
End Sub

Private Sub Command1_Click()
Dim Litem As ListItem
Dim Satir As Integer, Ay As Integer, Sutun As Integer
On Error GoTo Hata
If Combo1.Text = Empty Then Exit Sub
Command1.Enabled = False
Combo1.Locked = True
Label2.Visible = False
If IsInternetReady = False Then GoTo Hata
If Not Web Is Nothing Then
    Set Web = CreateObject("InternetExplorer.application")
    Web.Navigate "http://www.diyanet.gov.tr/turkish/namazvakti/vakithes_imsakiye.asp"
    Do While Web.Busy: DoEvents: Loop
    Do While Web.ReadyState <> 4: DoEvents: Loop
End If
Screen.MousePointer = vbHourglass
Web.Document.getElementById("sehirler").Value = Degistir(Combo1.Text)
Web.Document.getElementById("Buton").Click
Do While Web.Busy: DoEvents: Loop
Do While Web.ReadyState <> 4: DoEvents: Loop
With ListView1
    .ColumnHeaders.Clear
    .ListItems.Clear
    .HideColumnHeaders = False
    .View = lvwReport
    .GridLines = True
    .ColumnHeaders.Add , , "Hicri Tarih", 1485
    .ColumnHeaders.Add , , "Miladi Tarih", 2745
    .ColumnHeaders.Add , , "İmsak", .Width / 11
    .ColumnHeaders.Add , , "Güneş", .Width / 11
    .ColumnHeaders.Add , , "Öğle", .Width / 11
    .ColumnHeaders.Add , , "İkindi", .Width / 11
    .ColumnHeaders.Add , , "Akşam", .Width / 11
    .ColumnHeaders.Add , , "Yatsı", .Width / 11
End With
Do While Web.Busy: DoEvents: Loop
Do While Web.ReadyState <> 4: DoEvents: Loop
    For Ay = 1 To 30
        Set Litem = ListView1.ListItems.Add
        Litem.Text = Web.Document.All.tags("table").Item(1).Rows(Ay).Cells(0).innertext & _
                    Web.Document.All.tags("table").Item(1).Rows(Ay).Cells(1).innertext
            Litem.SubItems(1) = Web.Document.All.tags("table").Item(1).Rows(Ay).Cells(2).innertext & _
            Web.Document.All.tags("table").Item(1).Rows(Ay).Cells(3).innertext & Trim(Web.Document.All.tags("table").Item(1).Rows(Ay).Cells(4).innertext)
        For Sutun = 5 To 10
            Litem.SubItems(Sutun - 3) = Replace(Trim(Web.Document.All.tags("table").Item(1).Rows(Ay).Cells(Sutun).innertext), " ", ":")
        Next
        If CDate(Web.Document.All.tags("table").Item(1).Rows(Ay).Cells(2).innertext & _
            Web.Document.All.tags("table").Item(1).Rows(Ay).Cells(3).innertext) < Date Then
            Litem.ForeColor = &HFF8080
            Litem.ListSubItems(1).ForeColor = &HFF8080
            Litem.ListSubItems(2).ForeColor = &HFF8080
            Litem.ListSubItems(3).ForeColor = &HFF8080
            Litem.ListSubItems(4).ForeColor = &HFF8080
            Litem.ListSubItems(5).ForeColor = &HFF8080
            Litem.ListSubItems(6).ForeColor = &HFF8080
            Litem.ListSubItems(7).ForeColor = &HFF8080
        ElseIf CDate(Web.Document.All.tags("table").Item(1).Rows(Ay).Cells(2).innertext & _
            Web.Document.All.tags("table").Item(1).Rows(Ay).Cells(3).innertext) = Date Then
            Litem.Bold = True
            Litem.ListSubItems(1).Bold = True
            Litem.ListSubItems(2).Bold = True
            Litem.ListSubItems(3).Bold = True
            Litem.ListSubItems(4).Bold = True
            Litem.ListSubItems(5).Bold = True
            Litem.ListSubItems(6).Bold = True
            Litem.ListSubItems(7).Bold = True
        End If
    Next
Web.Quit
Label2.Caption = "26 RAMAZAN'I 27 RAMAZAN'A bağlayan gece Kadir Gecesi olarak idrak edilecektir."
Label2.Visible = True
Screen.MousePointer = vbNormal
Command1.Enabled = True
Combo1.Locked = False
Exit Sub
Hata:
On Error Resume Next
Screen.MousePointer = vbNormal
Command1.Enabled = True
Label2.Caption = "İnternet bağlantısı yok."
Label2.Visible = True
Combo1.Locked = False
Web.Quit
End Sub


Private Sub Form_Load()
    Screen.MousePointer = vbHourglass
    Combo1.AddItem "ADANA"
    Combo1.AddItem "ADIYAMAN"
    Combo1.AddItem "AFYON"
    Combo1.AddItem "AĞRI"
    Combo1.AddItem "AKSARAY"
    Combo1.AddItem "AMASYA"
    Combo1.AddItem "ANKARA"
    Combo1.AddItem "ANTALYA"
    Combo1.AddItem "ARDAHAN"
    Combo1.AddItem "ARTVİN"
    Combo1.AddItem "AYDIN"
    Combo1.AddItem "BALIKESİR"
    Combo1.AddItem "BARTIN"
    Combo1.AddItem "BATMAN"
    Combo1.AddItem "BAYBURT"
    Combo1.AddItem "BİLECİK"
    Combo1.AddItem "BİNGÖL"
    Combo1.AddItem "BİTLİS"
    Combo1.AddItem "BOLU"
    Combo1.AddItem "BURDUR"
    Combo1.AddItem "BURSA"
    Combo1.AddItem "ÇANAKKALE"
    Combo1.AddItem "ÇANKIRI"
    Combo1.AddItem "ÇORUM"
    Combo1.AddItem "DENİZLİ"
    Combo1.AddItem "DİYARBAKIR"
    Combo1.AddItem "DÜZCE"
    Combo1.AddItem "EDİRNE"
    Combo1.AddItem "ELAZIĞ"
    Combo1.AddItem "ERZİNCAN"
    Combo1.AddItem "ERZURUM"
    Combo1.AddItem "ESKİŞEHİR"
    Combo1.AddItem "GAZİANTEP"
    Combo1.AddItem "GİRESUN"
    Combo1.AddItem "GÜMÜŞHANE"
    Combo1.AddItem "HAKKARİ"
    Combo1.AddItem "HATAY"
    Combo1.AddItem "IĞDIR"
    Combo1.AddItem "ISPARTA"
    Combo1.AddItem "İSTANBUL"
    Combo1.AddItem "İZMİR"
    Combo1.AddItem "KAHRAMANMARAŞ"
    Combo1.AddItem "KARABÜK"
    Combo1.AddItem "KARAMAN"
    Combo1.AddItem "KARS"
    Combo1.AddItem "KASTAMONU"
    Combo1.AddItem "KAYSERİ"
    Combo1.AddItem "KIRIKKALE"
    Combo1.AddItem "KIRKLARELİ"
    Combo1.AddItem "KIRŞEHİR"
    Combo1.AddItem "KİLİS"
    Combo1.AddItem "KOCAELİ"
    Combo1.AddItem "KONYA"
    Combo1.AddItem "KÜTAHYA"
    Combo1.AddItem "MALATYA"
    Combo1.AddItem "MANİSA"
    Combo1.AddItem "MARDİN"
    Combo1.AddItem "MERSİN"
    Combo1.AddItem "MUĞLA"
    Combo1.AddItem "MUŞ"
    Combo1.AddItem "NEVŞEHİR"
    Combo1.AddItem "NİĞDE"
    Combo1.AddItem "ORDU"
    Combo1.AddItem "OSMANİYE"
    Combo1.AddItem "RİZE"
    Combo1.AddItem "SAKARYA"
    Combo1.AddItem "SAMSUN"
    Combo1.AddItem "SİİRT"
    Combo1.AddItem "SİNOP"
    Combo1.AddItem "SİVAS"
    Combo1.AddItem "Ş.URFA"
    Combo1.AddItem "ŞIRNAK"
    Combo1.AddItem "TEKİRDAĞ"
    Combo1.AddItem "TOKAT"
    Combo1.AddItem "TRABZON"
    Combo1.AddItem "TUNCELİ"
    Combo1.AddItem "UŞAK"
    Combo1.AddItem "VAN"
    Combo1.AddItem "YALOVA"
    Combo1.AddItem "YOZGAT"
    Combo1.AddItem "ZONGULDAK"
    Combo1.Text = "BURSA"
    Set Web = CreateObject("InternetExplorer.application")
    Web.Navigate "http://www.diyanet.gov.tr/turkish/namazvakti/vakithes_imsakiye.asp"
    Label2.Visible = False
    Screen.MousePointer = vbNormal
End Sub


Private Sub Timer1_Timer()
    Dim Say As Byte, Tarih As Date, Saat As Date, Saat_Seri_No As Double, Iftar As Double, Sahur As Double
    On Error Resume Next
    Label3.Caption = Format(Now, "dddd dd.mm.yyyy hh:mm:ss")
    If ListView1.ListItems.Count > 0 Then
        For Say = 1 To ListView1.ListItems.Count
            Tarih = CDate(Split(ListView1.ListItems(Say).SubItems(1), " ")(0) & " " & Split(ListView1.ListItems(Say).SubItems(1), " ")(1))
            Saat = Format(Now, "hh:mm:ss")
            Saat_Seri_No = CDbl(TimeSerial(Hour(Saat), Minute(Saat), Second(Saat)))
            If Tarih = Date Then
                Iftar = CDbl(Tarih) + CDbl(CDate(ListView1.ListItems(Say).SubItems(6)))
                Sahur = CDbl(Tarih) + CDbl(CDate(ListView1.ListItems(Say).SubItems(2)))
                If CDbl(Now) > Sahur And CDbl(Now) < Iftar Then
                    Label4.Caption = Format(Iftar - CDbl(Now), "hh:mm:ss")
                    Label5.Caption = "İftara kalan süre:"
                ElseIf CDbl(Now) < Sahur Then
                    Sahur = CDbl(Tarih) + CDbl(CDate(ListView1.ListItems(Say).SubItems(2)))
                    Label4.Caption = Format(Sahur - CDbl(Now), "hh:mm:ss")
                    Label5.Caption = "Sahura kalan süre:"
                ElseIf CDbl(Now) > Iftar Then
                    Tarih = CDate(Split(ListView1.ListItems(Say + 1).SubItems(1), " ")(0) & " " & Split(ListView1.ListItems(Say).SubItems(1), " ")(1))
                    Sahur = CDbl(Tarih) + CDbl(CDate(ListView1.ListItems(Say + 1).SubItems(2)))
                    Label4.Caption = Format(Sahur - CDbl(Now), "hh:mm:ss")
                    Label5.Caption = "Sahura kalan süre:"
                End If
                If Saat_Seri_No >= CDbl(CDate(ListView1.ListItems(Say).SubItems(2))) And Saat_Seri_No < CDbl(CDate(ListView1.ListItems(Say).SubItems(3))) Then
                    If ListView1.ListItems(Say).ListSubItems(2).ForeColor <> vbRed Then
                        ListView1.ListItems(Say).ListSubItems(2).ForeColor = vbRed
                        ListView1.ListItems(Say).ListSubItems(3).ForeColor = &H800000
                        ListView1.ListItems(Say).ListSubItems(4).ForeColor = &H800000
                        ListView1.ListItems(Say).ListSubItems(5).ForeColor = &H800000
                        ListView1.ListItems(Say).ListSubItems(6).ForeColor = &H800000
                        ListView1.ListItems(Say).ListSubItems(7).ForeColor = &H800000
                        ListView1.ListItems(Say - 1).ListSubItems(7).ForeColor = &HFF8080
                        ListView1.Refresh
                    End If
                ElseIf Saat_Seri_No >= CDbl(CDate(ListView1.ListItems(Say).SubItems(3))) And Saat_Seri_No < CDbl(CDate(ListView1.ListItems(Say).SubItems(4))) Then
                    If ListView1.ListItems(Say).ListSubItems(3).ForeColor <> vbRed Then
                        ListView1.ListItems(Say).ListSubItems(3).ForeColor = vbRed
                        ListView1.ListItems(Say).ListSubItems(2).ForeColor = &H800000
                        ListView1.ListItems(Say).ListSubItems(4).ForeColor = &H800000
                        ListView1.ListItems(Say).ListSubItems(5).ForeColor = &H800000
                        ListView1.ListItems(Say).ListSubItems(6).ForeColor = &H800000
                        ListView1.ListItems(Say).ListSubItems(7).ForeColor = &H800000
                        ListView1.Refresh
                    End If
                ElseIf Saat_Seri_No >= CDbl(CDate(ListView1.ListItems(Say).SubItems(4))) And Saat_Seri_No < CDbl(CDate(ListView1.ListItems(Say).SubItems(5))) Then
                    If ListView1.ListItems(Say).ListSubItems(4).ForeColor <> vbRed Then
                        ListView1.ListItems(Say).ListSubItems(4).ForeColor = vbRed
                        ListView1.ListItems(Say).ListSubItems(3).ForeColor = &H800000
                        ListView1.ListItems(Say).ListSubItems(2).ForeColor = &H800000
                        ListView1.ListItems(Say).ListSubItems(5).ForeColor = &H800000
                        ListView1.ListItems(Say).ListSubItems(6).ForeColor = &H800000
                        ListView1.ListItems(Say).ListSubItems(7).ForeColor = &H800000
                        ListView1.Refresh
                    End If
                ElseIf Saat_Seri_No >= CDbl(CDate(ListView1.ListItems(Say).SubItems(5))) And Saat_Seri_No < CDbl(CDate(ListView1.ListItems(Say).SubItems(6))) Then
                    If ListView1.ListItems(Say).ListSubItems(5).ForeColor <> vbRed Then
                        ListView1.ListItems(Say).ListSubItems(5).ForeColor = vbRed
                        ListView1.ListItems(Say).ListSubItems(3).ForeColor = &H800000
                        ListView1.ListItems(Say).ListSubItems(4).ForeColor = &H800000
                        ListView1.ListItems(Say).ListSubItems(2).ForeColor = &H800000
                        ListView1.ListItems(Say).ListSubItems(6).ForeColor = &H800000
                        ListView1.ListItems(Say).ListSubItems(7).ForeColor = &H800000
                        ListView1.Refresh
                    End If
                ElseIf Saat_Seri_No >= CDbl(CDate(ListView1.ListItems(Say).SubItems(6))) And Saat_Seri_No < CDbl(CDate(ListView1.ListItems(Say).SubItems(7))) Then
                    If ListView1.ListItems(Say).ListSubItems(6).ForeColor <> vbRed Then
                        ListView1.ListItems(Say).ListSubItems(6).ForeColor = vbRed
                        ListView1.ListItems(Say).ListSubItems(3).ForeColor = &H800000
                        ListView1.ListItems(Say).ListSubItems(4).ForeColor = &H800000
                        ListView1.ListItems(Say).ListSubItems(5).ForeColor = &H800000
                        ListView1.ListItems(Say).ListSubItems(2).ForeColor = &H800000
                        ListView1.ListItems(Say).ListSubItems(7).ForeColor = &H800000
                        ListView1.Refresh
                    End If
                ElseIf Saat_Seri_No >= CDbl(CDate(ListView1.ListItems(Say).SubItems(7))) Then
                    If ListView1.ListItems(Say).ListSubItems(7).ForeColor <> vbRed Then
                        ListView1.ListItems(Say).ListSubItems(7).ForeColor = vbRed
                        ListView1.ListItems(Say).ListSubItems(3).ForeColor = &H800000
                        ListView1.ListItems(Say).ListSubItems(4).ForeColor = &H800000
                        ListView1.ListItems(Say).ListSubItems(5).ForeColor = &H800000
                        ListView1.ListItems(Say).ListSubItems(6).ForeColor = &H800000
                        ListView1.ListItems(Say).ListSubItems(2).ForeColor = &H800000
                        ListView1.Refresh
                    End If
                ElseIf Saat_Seri_No < CDbl(CDate(ListView1.ListItems(Say).SubItems(2))) Then
                    If ListView1.ListItems(Say - 1).ListSubItems(7).ForeColor <> vbRed Then
                        ListView1.ListItems(Say - 1).ListSubItems(7).ForeColor = vbRed
                        ListView1.ListItems(Say).ListSubItems(2).ForeColor = &H800000
                        ListView1.ListItems(Say).ListSubItems(3).ForeColor = &H800000
                        ListView1.ListItems(Say).ListSubItems(4).ForeColor = &H800000
                        ListView1.ListItems(Say).ListSubItems(5).ForeColor = &H800000
                        ListView1.ListItems(Say).ListSubItems(6).ForeColor = &H800000
                        ListView1.ListItems(Say).ListSubItems(7).ForeColor = &H800000
                        ListView1.Refresh
                    End If
                End If
            End If
        Next
    End If
    If Not (ListView1.SelectedItem Is Nothing) Then ListView1.SelectedItem.Selected = False
End Sub

Private Function Degistir(Kelime As String)
    Dim DiziA, DiziB
    Dim i As Integer
    DiziA = Array("Ğ", "Ü", "Ş", "Ç", "Ö", "İ", "ğ", "ü", "ş", "ç", "ö", "ı")
    DiziB = Array("G", "U", "S", "C", "O", "I", "g", "u", "s", "c", "o", "i")
    For i = 0 To UBound(DiziA)
    If InStr(Kelime, DiziA(i)) > 0 Then
        Kelime = Replace(Kelime, DiziA(i), DiziB(i))
    End If
    Next
    Degistir = Kelime
End Function

Alıntı:Yalnız yeni çalışmanuz bende sürekli internet bağlantınız yok diyor. Veri alamadım yani..
İlk çalışmamda İnternet bağlantısını denetleyen kodlar yok.
İkincide bunun da denetlenmesini istedim ve bu işi yapan API kodlarını netten aldım.
API kodlarını bilirsiniz, bunlar bu işin erbapları tarafından paylaşılan ve ezbere bilinmesi pek mümkün olmayan kodlar. Yani bu konuda paylaşanlara itibar etmek zorundayız.
Sizde ilk önce yok deyip daha sonra çalışamsının sebebini öğrenmek için ilgili kodları yeni bir projeye yapıştırın ve F8 ile adımlayarak çalıştırıp takip edin. Bu size fikir verir.

benremix

28/08/2009, 04:41
Katkı ve paylaşımlarınız için teşekkürler...Saygılar..

maytas

11/08/2010, 03:02
Merhaba.
Malüm Ramazan yine geldi çattı.
Bu arada herkese Hayırlı Ramazanlar dilerim.
Geçen sene hazırladığım Imsakiye programını birkaç düzeltme yapmak süretiyle güncelledim.
İsteyen indirip deneyebilir.
Değişiklikler:
Sabah oruç başlangıcında ve akşam oruç açma saatinde ezan okuyor.
Oturduğunuz ili her defasında seçmeniz geerkmiyor, 1 defa seçince bir sonraki açılışta yeni haliyle açılıyor.

http://www.4shared.com/file/cBXZ6Fx5/_2_...e_Kur.html

ogulcan92

12/08/2010, 14:14
Sn:maytas
Paylaşım için teşekkürler.

maytas

23/08/2010, 04:23
Merhaba.
Birkaç ilave daha yaptım.
Merak eden indirebilir.

http://www.4shared.com/file/ujjExzPq/Imsakiye_Kur.html
Sayfalar: 1 2 3
AccessTr.neT > Visual Basic 6 > Visual Basic 6 Örnekleri ve Uygulamaları > İmsakiye