سلام
بررسی وضعیت آدرس url توسط اینترنتی که با اون متصل هستیم:
Imports System.Net
Imports System.Text.RegularExpressions
Module Module1
Dim urlPattern As New Regex("[(http(s)?):\/\/(www\.)?a-zA-Z0-9@:%._\+~#=]{2,256}\.[a-z]{2,6}\b([-a-zA-Z0-9@:%_\+.~#?&//=]*)")
Sub Main(args() As String)
Dim Url As String = ""
Console.WriteLine()
Select Case args.Length
Case 1
Url = args(0)
If urlPattern.IsMatch(Url) = False Then
Console.ForegroundColor = ConsoleColor.Yellow
Console.WriteLine(" > Wrong URL Structure!: {0}", Url)
Console.ResetColor()
Exit Select
End If
If IsWebpageOnline(Url) = True Then
Console.ForegroundColor = ConsoleColor.Green
Console.WriteLine(" > URL is Accessible: {0}", Url)
Console.ResetColor()
End If
Case Is >= 2
Dim FileName As String = ""
Select Case args(0).ToLower
Case "-i", "-input"
FileName = args(1)
If Not IO.Path.GetExtension(FileName) = ".txt" Then
Console.ForegroundColor = ConsoleColor.Yellow
Console.WriteLine(" > File Extension Not Allowed!: {0}", FileName)
Console.ResetColor()
Exit Select
End If
If IO.File.Exists(FileName) = False Then
Console.ForegroundColor = ConsoleColor.Yellow
Console.WriteLine(" > File Not Found!: {0}", FileName)
Console.ResetColor()
Exit Select
End If
Dim Spl As String() = IO.File.ReadAllLines(FileName)
If args.Length = 4 Then
Select Case args(2).ToLower
Case "-o", "-output"
Dim TargetFile As String = args(3)
If Not IO.Path.GetExtension(TargetFile) = ".txt" Then
Console.ForegroundColor = ConsoleColor.Yellow
Console.WriteLine(" > File Extension Not Allowed!: {0}", TargetFile)
Console.ResetColor()
Exit Select
End If
If IO.File.Exists(TargetFile) = True Then
Console.ForegroundColor = ConsoleColor.Yellow
Console.WriteLine(" > File Already Exists!: {0}", TargetFile)
Console.Write(" > Do you want to Replace? [Y]es to accept: ")
Select Case Console.ReadLine()
Case "y", "yes"
Console.ResetColor()
GoTo writeFile0
End Select
Console.ResetColor()
Exit Select
End If
writeFile0: Dim lines As New List(Of String)
Dim Ex As Exception = Nothing
For i = 0 To Spl.Length - 1
Url = Spl(i)
If urlPattern.IsMatch(Url) = False Then
Console.ForegroundColor = ConsoleColor.Yellow
Console.WriteLine(" > Invalid URL Address!: {0}", Url)
lines.Add(String.Format(" {1} > Invalid URL Address!: {0}", Url, i + 1))
Continue For
End If
If IsWebpageOnline(Url, Ex) = True Then
Console.ForegroundColor = ConsoleColor.Green
Console.WriteLine(" > URL is Accessible: {0}", Url)
lines.Add(String.Format(" {1} > URL is Accessible: {0}", Url, i + 1))
Else
lines.Add(String.Format(" {2} > {1}: {0}", Url, Ex.Message, i + 1))
End If
Console.ResetColor()
Next
IO.File.WriteAllLines(TargetFile, lines.ToArray)
lines.Clear()
Case Else
End Select
ElseIf args.Length = 2 Then
For Each Url In Spl
If urlPattern.IsMatch(Url) = False Then
Console.ForegroundColor = ConsoleColor.Yellow
Console.WriteLine(" > Invalid URL Address!: {0}", Url)
Continue For
End If
If IsWebpageOnline(Url) = True Then
Console.ForegroundColor = ConsoleColor.Green
Console.WriteLine(" > URL is Accessible: {0}", Url)
End If
Console.ResetColor()
Next
End If
Case Else
If args.Length >= 3 Then
Select Case args(args.Length - 2).ToLower
Case "-o", "-output"
Dim TargetFile As String = args(args.Length - 1)
If Not IO.Path.GetExtension(TargetFile) = ".txt" Then
Console.ForegroundColor = ConsoleColor.Yellow
Console.WriteLine(" > File Extension Not Allowed!: {0}", TargetFile)
Console.ResetColor()
Exit Select
End If
If IO.File.Exists(TargetFile) = True Then
Console.ForegroundColor = ConsoleColor.Yellow
Console.WriteLine(" > File Already Exists!: {0}", TargetFile)
Console.Write(" > Do you want to Replace? [Y]es to accept: ")
Select Case Console.ReadLine()
Case "y", "yes"
Console.ResetColor()
GoTo writeFile
End Select
Console.ResetColor()
Exit Select
End If
writeFile: Dim lines As New List(Of String)
Dim Ex As Exception = Nothing
For i = 0 To args.Length - 3
Url = args(i)
If urlPattern.IsMatch(Url) = False Then
Console.ForegroundColor = ConsoleColor.Yellow
Console.WriteLine(" > Invalid URL Address!: {0}", Url)
lines.Add(String.Format(" {1} > Invalid URL Address!: {0}", Url, i + 1))
Continue For
End If
If IsWebpageOnline(Url, Ex) = True Then
Console.ForegroundColor = ConsoleColor.Green
Console.WriteLine(" > URL is Accessible: {0}", Url)
lines.Add(String.Format(" {1} > URL is Accessible: {0}", Url, i + 1))
Else
lines.Add(String.Format(" {2} > {1}: {0}", Url, Ex.Message, i + 1))
End If
Console.ResetColor()
Next
IO.File.WriteAllLines(TargetFile, lines.ToArray)
lines.Clear()
End Select
Exit Select
End If
For Each Url In args
If urlPattern.IsMatch(Url) = False Then
Console.ForegroundColor = ConsoleColor.Yellow
Console.WriteLine(" > Invalid URL Address!: {0}", Url)
Continue For
End If
If IsWebpageOnline(Url) = True Then
Console.ForegroundColor = ConsoleColor.Green
Console.WriteLine(" > URL is Accessible: {0}", Url)
End If
Console.ResetColor()
Next
End Select
End Select
End Sub
Public Function IsWebpageOnline(ByVal URL As String, Optional ByRef exception As Exception = Nothing) As Boolean
Dim req As WebRequest
Dim res As WebResponse = Nothing
Try
req = WebRequest.Create(URL)
req.Timeout = 10000
res = req.GetResponse()
Catch ex As Exception
Console.ForegroundColor = ConsoleColor.Yellow
Console.WriteLine(" > {0}: {1}", ex.Message, URL)
Console.ResetColor()
exception = ex
Return False
Finally
If res IsNot Nothing Then
res.Close()
End If
End Try
Return True
End Function
End Module
این یک Console Application هست که آدرسش باید به Environment اضافه بشه (متغیر Path)
ضمیمه 156201
ضمیمه 156202
و
Command Prompt رو اجرا و آدرس ها رو در "" بعداز نام App با فاصله از هم تایپ و Enter:
ضمیمه 156204
برای خواندن آدرس ها از فایل متنی بصورت خط به خط :
webaccess -i "d:\urls.txt"
برای گرفتن خروجی هم از گزینه o- یا option- استفاده می شه:
webaccess -i "d:\urls.txt" -o "D:\Output.txt"
یا:
webaccess "https://aparat.com/" "https://barnamenevis.org/" -o "D:\Output.txt"
