Excel VBA ile web servisi nasıl kullabilirim?

UlasEraslan · 13 Ekim 2020

Merhaba, Excel VBA ile " https://tckimlik.nvi.gov.tr/Service/KPSPublic.asmx?op=TCKimlikNoDogrula " servisini nasıl kullanabilirim?

Mahmut Kök · 13 Ekim 2020

TC Kimlik No doğrulamayla ilgili örnek kodu inceleyebilirsiniz. Kodlar biraz daha sadeleştirilebilir.

Eklenmesi gereken kütüphaneler:
Microsoft HTML Object Library
Microsoft XML, v6.0

Kod:

Option Explicit
Sub TCKimlikNoDogrula()


'Değişkenlerimiz.
Dim tc As String
Dim ad As String
Dim soyad As String
Dim dt As String

'DOĞRULAMA BURADAKİ VEİRLERE GÖRE YAPILACAK.
tc = "123456789" 'Buraya TC kimlik no yazın.
ad = "MAHMUT" 'isim
soyad = "KÖK" 'soyisim
dt = "1923" 'doğum tarihi


Dim sURL As String
Dim sEnv As String
Dim xmlhtp As New MSXML2.XMLHTTP60
Dim xmlDoc As New DOMDocument60
sURL = "https://tckimlik.nvi.gov.tr/Service/KPSPublic.asmx"


'Gidecek olan xml
sEnv = "<?xml version=""1.0"" encoding=""utf-8""?>"
sEnv = sEnv & "<soap:Envelope xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xmlns:xsd=""http://www.w3.org/2001/XMLSchema"" xmlns:soap=""http://schemas.xmlsoap.org/soap/envelope/"">"
sEnv = sEnv & "<soap:Body>"
sEnv = sEnv & "<TCKimlikNoDogrula xmlns=""http://tckimlik.nvi.gov.tr/WS"">"
sEnv = sEnv & "<TCKimlikNo>" & tc & "</TCKimlikNo>"
sEnv = sEnv & "<Ad>" & ad & "</Ad>"
sEnv = sEnv & "<Soyad>" & soyad & "</Soyad>"
sEnv = sEnv & "<DogumYili>" & dt & "</DogumYili>"
sEnv = sEnv & "</TCKimlikNoDogrula>"
sEnv = sEnv & "</soap:Body>"
sEnv = sEnv & "</soap:Envelope>"


Dim sonuc As String


With xmlhtp
.Open "post", sURL, False
.setRequestHeader "Host", "webservices.gama-system.com"
.setRequestHeader "Content-Type", "text/xml; charset=utf-8"
.setRequestHeader "KPSPublic", "https://tckimlik.nvi.gov.tr/Service/KPSPublic.asmx"
.setRequestHeader "Accept-encoding", "zip"
.send sEnv
xmlDoc.LoadXML .responseText

sonuc = .responseText

End With

Dim tag1 As String
Dim tag2 As String

tag1 = "<tckimliknodogrularesult>"
tag2 = "</tckimliknodogrularesult>"
Dim a As String

  a = Mid(sonuc, (InStr(1, sonuc, tag1, vbTextCompare) + (Len(tag1))), InStr(1, sonuc, tag2, vbTextCompare) - (InStr(1, sonuc, tag1, vbTextCompare) + (Len(tag1))))

  If (a = "true") Then
  a = "GEÇERLİ"
  Else
  a = "GEÇERSİZ"
  End If

MsgBox a


End Sub

UlasEraslan · 13 Ekim 2020

Mahmut Kök' Alıntı:

TC Kimlik No doğrulamayla ilgili örnek kodu inceleyebilirsiniz. Kodlar biraz daha sadeleştirilebilir.

Eklenmesi gereken kütüphaneler:
Microsoft HTML Object Library
Microsoft XML, v6.0

Kod:

Option Explicit
Sub TCKimlikNoDogrula()


'Değişkenlerimiz.
Dim tc As String
Dim ad As String
Dim soyad As String
Dim dt As String

'DOĞRULAMA BURADAKİ VEİRLERE GÖRE YAPILACAK.
tc = "123456789" 'Buraya TC kimlik no yazın.
ad = "MAHMUT" 'isim
soyad = "KÖK" 'soyisim
dt = "1923" 'doğum tarihi


Dim sURL As String
Dim sEnv As String
Dim xmlhtp As New MSXML2.XMLHTTP60
Dim xmlDoc As New DOMDocument60
sURL = "https://tckimlik.nvi.gov.tr/Service/KPSPublic.asmx"


'Gidecek olan xml
sEnv = "<?xml version=""1.0"" encoding=""utf-8""?>"
sEnv = sEnv & "<soap:Envelope xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xmlns:xsd=""http://www.w3.org/2001/XMLSchema"" xmlns:soap=""http://schemas.xmlsoap.org/soap/envelope/"">"
sEnv = sEnv & "<soap:Body>"
sEnv = sEnv & "<TCKimlikNoDogrula xmlns=""http://tckimlik.nvi.gov.tr/WS"">"
sEnv = sEnv & "<TCKimlikNo>" & tc & "</TCKimlikNo>"
sEnv = sEnv & "<Ad>" & ad & "</Ad>"
sEnv = sEnv & "<Soyad>" & soyad & "</Soyad>"
sEnv = sEnv & "<DogumYili>" & dt & "</DogumYili>"
sEnv = sEnv & "</TCKimlikNoDogrula>"
sEnv = sEnv & "</soap:Body>"
sEnv = sEnv & "</soap:Envelope>"


Dim sonuc As String


With xmlhtp
.Open "post", sURL, False
.setRequestHeader "Host", "webservices.gama-system.com"
.setRequestHeader "Content-Type", "text/xml; charset=utf-8"
.setRequestHeader "KPSPublic", "https://tckimlik.nvi.gov.tr/Service/KPSPublic.asmx"
.setRequestHeader "Accept-encoding", "zip"
.send sEnv
xmlDoc.LoadXML .responseText

sonuc = .responseText

End With

Dim tag1 As String
Dim tag2 As String

tag1 = "<tckimliknodogrularesult>"
tag2 = "</tckimliknodogrularesult>"
Dim a As String

  a = Mid(sonuc, (InStr(1, sonuc, tag1, vbTextCompare) + (Len(tag1))), InStr(1, sonuc, tag2, vbTextCompare) - (InStr(1, sonuc, tag1, vbTextCompare) + (Len(tag1))))

  If (a = "true") Then
  a = "GEÇERLİ"
  Else
  a = "GEÇERSİZ"
  End If

MsgBox a


End Sub

Çok teşekkür ederim. Tam istediğim şekilde elleriniz dert görmesin

maliex · 13 Ekim 2020

reCAPTCHA doğrulamasını nasıl aşabiliyor ?

seri no sıra no gün/ay bilgileri olmadan nasıl olabiliyor ?

UlasEraslan · 13 Ekim 2020

Bu Nüfus vatandaşlık hizmetlerinin verdigi ücretsiz bir web servis uygulaması. Yani istenilen herhangi doğrulama yok. Ayrıca sadece yıl bilgisi istiyor buda onların seçimi

veyselemre · 13 Ekim 2020

Kod:

Option Explicit
'Set Reference to Microsoft XML, v6.0
Sub tcKimlikNoDogrulaSayfadan()
    Dim sURL As String
    Dim sEnv As String
    Dim sEnv_ As String
    Dim xmlhtp As New MSXML2.XMLHTTP60
    Dim i As Single

    sURL = "https://tckimlik.nvi.gov.tr/Service/KPSPublic.asmx"

    sEnv = "<?xml version='1.0' encoding='utf-8'?>"
    sEnv = sEnv & "<soap12:Envelope xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance' xmlns:xsd='http://www.w3.org/2001/XMLSchema' xmlns:soap12='http://www.w3.org/2003/05/soap-envelope'>"
    sEnv = sEnv & "  <soap12:Body>"
    sEnv = sEnv & "    <TCKimlikNoDogrula xmlns='http://tckimlik.nvi.gov.tr/WS'>"
    sEnv = sEnv & "      <TCKimlikNo>@1</TCKimlikNo>"
    sEnv = sEnv & "      <Ad>@2</Ad>"
    sEnv = sEnv & "      <Soyad>@3</Soyad>"
    sEnv = sEnv & "      <DogumYili>@4</DogumYili>"
    sEnv = sEnv & "    </TCKimlikNoDogrula>"
    sEnv = sEnv & "  </soap12:Body>"
    sEnv = sEnv & "</soap12:Envelope>"

    Range("E2:E" & Rows.Count).ClearContents

    With xmlhtp
        For i = 2 To Cells(Rows.Count, 1).End(3).Row
            sEnv_ = Replace(sEnv, "@1", Cells(i, 1))
            sEnv_ = Replace(sEnv_, "@2", Cells(i, 2))
            sEnv_ = Replace(sEnv_, "@3", Cells(i, 3))
            sEnv_ = Replace(sEnv_, "@4", Cells(i, 4))
            .Open "POST", sURL, False
            .setRequestHeader "Host", "tckimlik.nvi.gov.tr"
            .setRequestHeader "Content-Type", "application/soap+xml; charset=utf-8"
            .send sEnv_
           
            If InStr(.responseText, "<TCKimlikNoDogrulaResult>true") Then
                Cells(i, 5) = True
            ElseIf InStr(.responseText, "<TCKimlikNoDogrulaResult>false") Then
                Cells(i, 5) = False
            Else
                Cells(i, 5) = "Hatalı/Eksik veri yada bağlantı hatası..."
            End If
           
        Next i
    End With

    Set xmlhtp = Nothing
End Sub

Kod:

Option Explicit
'Set Reference to Microsoft XML, v6.0
Function tcKimlikNoDogrula(tcNo, ad, soyad, dYil)
    If tcNo = "" Or tcNo = "" Or soyad = "" Or tcNo = "" Then
        tcKimlikNoDogrula = "Eksik Veri"
        Exit Function
    End If
    Dim sURL As String
    Dim sEnv As String
    Dim xmlhtp As New MSXML2.XMLHTTP60
    Dim i As Single
    Dim sonuc As Boolean

    sURL = "https://tckimlik.nvi.gov.tr/Service/KPSPublic.asmx"

    sEnv = "<?xml version='1.0' encoding='utf-8'?>"
    sEnv = sEnv & "<soap12:Envelope xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance' xmlns:xsd='http://www.w3.org/2001/XMLSchema' xmlns:soap12='http://www.w3.org/2003/05/soap-envelope'>"
    sEnv = sEnv & "  <soap12:Body>"
    sEnv = sEnv & "    <TCKimlikNoDogrula xmlns='http://tckimlik.nvi.gov.tr/WS'>"
    sEnv = sEnv & "      <TCKimlikNo>" & tcNo & "</TCKimlikNo>"
    sEnv = sEnv & "      <Ad>" & ad & "</Ad>"
    sEnv = sEnv & "      <Soyad>" & soyad & "</Soyad>"
    sEnv = sEnv & "      <DogumYili>" & dYil & "</DogumYili>"
    sEnv = sEnv & "    </TCKimlikNoDogrula>"
    sEnv = sEnv & "  </soap12:Body>"
    sEnv = sEnv & "</soap12:Envelope>"

    With xmlhtp
        For i = 2 To Cells(Rows.Count, 1).End(3).Row
            .Open "POST", sURL, False
            .setRequestHeader "Host", "tckimlik.nvi.gov.tr"
            .setRequestHeader "Content-Type", "application/soap+xml; charset=utf-8"
            .send sEnv
            If InStr(.responseText, "<TCKimlikNoDogrulaResult>true") Then
                tcKimlikNoDogrula = True
            ElseIf InStr(.responseText, "<TCKimlikNoDogrulaResult>false") Then
                tcKimlikNoDogrula = False
            Else
                tcKimlikNoDogrula = "Hatalı/Eksik veri yada bağlantı hatası..."
            End If
        Next i
    End With

    Set xmlhtp = Nothing
End Function

Haluk · 13 Ekim 2020

Kod:

Sub GetData_NVI()
    'Haluk - 27/03/2018
    'Nüfus ve Vatandaşlık İşleri Genel Müdürlüğü (NVİ) resmi sitesinden
    'TC Kimlik No doğrulaması yapmak üzere SOAP1.1 isteği yollayıp, dönen XML verilerini okuyan kod çalışmasıdır.
    
    Dim objHTTP As Object, WshShell As Object, xmlDoc As Object
    Dim strXML As Variant
    Dim URL As String, tempFile As String
    Dim adoStream As Object
    Dim RetVal As Object
    
    Const adTypeText = 2
    Const adSaveCreateOverWrite = 2
    
    Range("C8") = Empty
    
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    URL = "https://tckimlik.nvi.gov.tr/Service/KPSPublic.asmx"
    
    objHTTP.Open "POST", URL, False
    objHTTP.setRequestHeader "Content-Type", "text/xml; charset=UTF-8"
    objHTTP.setRequestHeader "SOAPAction", "http://tckimlik.nvi.gov.tr/WS/TCKimlikNoDogrula"
    
    strXML = "<?xml version=""1.0"" encoding=""UTF-8""?>"
    strXML = strXML & "<soap:Envelope xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"""
    strXML = strXML & " xmlns:xsd=""http://www.w3.org/2001/XMLSchema"""
    strXML = strXML & " xmlns:soap=""http://schemas.xmlsoap.org/soap/envelope/"">"
    strXML = strXML & "<soap:Body>"
    strXML = strXML & "<TCKimlikNoDogrula xmlns=""http://tckimlik.nvi.gov.tr/WS"">"
    strXML = strXML & "<TCKimlikNo>" & Range("C3") & "</TCKimlikNo>"
    strXML = strXML & "<Ad>" & Range("C4") & "</Ad>"
    strXML = strXML & "<Soyad>" & Range("C5") & "</Soyad>"
    strXML = strXML & "<DogumYili>" & Range("C6") & "</DogumYili>"
    strXML = strXML & "</TCKimlikNoDogrula>"
    strXML = strXML & "</soap:Body>"
    strXML = strXML & "</soap:Envelope>"
    
    objHTTP.send strXML
    
    If objHTTP.Status = 500 Then
        MsgBox "İşleminiz gerçekleştirilemedi....." & vbCrLf _
             & "Tüm verileri eksiksiz olarak BÜYÜK HARF kullanarak tekrar deneyin..."
        Exit Sub
    ElseIf objHTTP.Status = 400 Then
        MsgBox "Sunucuya anlaşılamayan bir istek gönderildi, kodları kontrol edin..."
        Exit Sub
    ElseIf objHTTP.Status = 200 Then
        strRetVal = objHTTP.responseText
        
        Set WshShell = CreateObject("WScript.Shell")
        strDocuments = WshShell.SpecialFolders("MyDocuments")
        tempFile = strDocuments & Application.PathSeparator & "NVI.xml"
        If Dir(tempFile) <> "" Then Kill tempFile
        
        
        Set adoStream = CreateObject("ADODB.Stream")
        
        adoStream.Charset = "utf-8"
        adoStream.Type = adTypeText
        
        adoStream.Open
        adoStream.WriteText strRetVal
        
        adoStream.SaveToFile tempFile, adSaveCreateOverWrite
        
        Set xmlDoc = CreateObject("MSXML2.DOMDocument")
        
        xmlDoc.async = False
        xmlDoc.validateOnParse = False
        xmlDoc.Load tempFile
        
        myNode = "//TCKimlikNoDogrulaResult"
        
        Set RetVal = xmlDoc.SelectSingleNode(myNode)
        Range("C8") = RetVal.Text
    End If
    
    Kill tempFile
    Set RetVal = Nothing
    Set WshShell = Nothing
    Set objHTTP = Nothing
End Sub

Excel VBA ile web servisi nasıl kullabilirim?

UlasEraslan

Mahmut Kök

Özel Üye

UlasEraslan

maliex

UlasEraslan

veyselemre

Özel Üye

Ekli dosyalar

Haluk

𐱅𐰇𐰼𐰚