bi partner programı için yazdım paylaşayım dedi.
üzerime gelmeyin örnekden esinlenerek kullanın işde.
+
alıntı yapacaklar kaynak göstermeyi unutmayın : p
Html Doğrulama
Sub HTMLDogrula()
Dim Sonuc As Boolean = False
Try
Dim lngResolveTimeout As Integer = 500
Dim lngConnectTimeout As Integer = 500
Dim lngSendTimeout As Integer = 500
Dim lngReceiveTimeout As Integer = 500
Dim strTestUrl As String = LblSiteAdi.Text & "/" & LblHTMLDosya.Text
Dim objHttpRequest = CreateObject("MSXML2.ServerXMLHTTP")
With objHttpRequest
.SetTimeouts(lngResolveTimeout, lngConnectTimeout, lngSendTimeout, lngReceiveTimeout)
.Open("GET", strTestUrl)
.Send()
Select Case .Status
Case 200 'No problem!
LblSiteDogrulamaSonuc.CssClass = "style4"
LblSiteDogrulamaSonuc.Text = strTestUrl & " doğrulandı"
SiteEkle()
Sonuc = True
Case 404 'Not found
LblSiteDogrulamaSonuc.CssClass = "style5"
LblSiteDogrulamaSonuc.Text = strTestUrl & " bulunamadı"
Sonuc = False
Case Else 'Some other problem
LblSiteDogrulamaSonuc.CssClass = "style5"
LblSiteDogrulamaSonuc.Text = "Hata oluştu. Lütfen tekrar deneyiniz " '& .Status()
Sonuc = False
End Select
End With
objHttpRequest = Nothing
Catch ex As Exception
LblSiteDogrulamaSonuc.CssClass = "style5"
LblSiteDogrulamaSonuc.Text = "Hata oluştu. Lütfen tekrar deneyiniz " '& .Status()
Sonuc = False
End Try
End Sub Meta Doğrulama
Protected Sub EtiketDogrula()
Try
Dim objRequest As WebRequest
Dim objResponse As WebResponse
Dim theurlresult As String
objRequest = HttpWebRequest.Create(LblSiteAdi.Text)
objResponse = objRequest.GetResponse()
Dim sr As New StreamReader(objResponse.GetResponseStream(), System.Text.Encoding.GetEncoding(1254))
theurlresult = sr.ReadToEnd()
Dim HeadStr As String = ""
HeadStr = Mid(theurlresult, InStr(theurlresult, "<head"))
HeadStr = Left(HeadStr, InStr(HeadStr, "</head>") + 7)
LblSiteDogrulamaSonuc.Text = Server.HtmlEncode(HeadStr)
Dim gelenStr As String = Server.HtmlEncode(theurlresult)
If InStr(Server.HtmlEncode(HeadStr), LblMeta.Text) > 0 Then
LblSiteDogrulamaSonuc.CssClass = "style4"
LblSiteDogrulamaSonuc.Text = " Meta Etiketi doğrulandı"
SiteEkle()
Else
LblSiteDogrulamaSonuc.CssClass = "style5"
LblSiteDogrulamaSonuc.Text = " Meta Etiketi doğrulanmadı"
End If
Catch ex As Exception
LblSiteDogrulamaSonuc.CssClass = "style5"
LblSiteDogrulamaSonuc.Text = " Hata oluştu. Lütfen tekrar deneyiniz"
End Try
End Sub 
