قسمت سوال با دست کاری کمی از کد های قبل درست شد.
ایین اون کلاس قبل با کمی دست کاری :
Public Class FormWarning
Inherits Form
Private Time1 As New Timer
Private Sub FormWarning_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
Me.Opacity = 0.95
Me.FormBorderStyle = Windows.Forms.FormBorderStyle.None
Me.Height = Screen.PrimaryScreen.WorkingArea.Height / 5
Me.Width = Screen.PrimaryScreen.WorkingArea.Width / 3.5
Me.Top = Screen.PrimaryScreen.WorkingArea.Height - Me.Height
Me.Left = Screen.PrimaryScreen.WorkingArea.Width - Me.Width
Me.AutoSize = True
Dim Time As New Timer
Time.Interval = 60000
Time.Enabled = True
AddHandler Time.Tick, AddressOf Time_
Time1.Interval = 200
Time1.Enabled = True
AddHandler Time1.Tick, AddressOf Time1_
End Sub
Private Sub FormWarning_MouseClick(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseClick
Dim i, n As Integer
Select Case e.X
Case Me.Width - 25 To Me.Width
i = 1
End Select
Select Case e.Y
Case "0" To "30"
n = 1
End Select
If n = 1 And i = 1 Then Me.Close()
End Sub
Private Sub FormWarning_MouseHover(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.MouseHover
Time1.Dispose()
For i As Single = Me.Opacity To 0.95 Step +0.000015
Me.Opacity = i
Next
End Sub
Private Sub FormWarning_MouseLeave(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.MouseLeave
Time1.Dispose()
For i As Single = Me.Opacity To 0.3 Step -0.000008
Me.Opacity = i
Next
End Sub
Private Sub FormWarning_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
Dim Objbr As New Drawing2D.LinearGradientBrush(Me.DisplayRectangle, Color.Azure, Color.Gainsboro, Drawing2D.LinearGradientMode.Vertical)
e.Graphics.FillRectangle(Objbr, Me.DisplayRectangle)
Objbr.Dispose()
Dim Wid As Integer = Me.Width
Dim Hgt As Integer = 35
Dim NewFont As Font
Dim R_P() As Point = {New Point(0, 0), New Point(Wid, 0), New Point(Wid, Hgt), New Point(0, Hgt)}
Dim P_Br As New System.Drawing.Drawing2D.PathGradientBrush(R_P)
P_Br.CenterColor = Color.Orange
NewFont = New Font("Comic Sans MS", 20, FontStyle.Bold)
e.Graphics.FillPolygon(P_Br, R_P)
e.Graphics.DrawString("/", NewFont, Brushes.Red, Me.Width - 25, 0)
e.Graphics.DrawString("\", NewFont, Brushes.Red, Me.Width - 25, 0)
End Sub
Private Sub Time_(ByVal sender As Object, ByVal e As System.EventArgs)
Me.Close()
End Sub
Private Sub Time1_(ByVal sender As Object, ByVal e As System.EventArgs)
If Me.Opacity >= 0.01 Then
Me.Opacity -= 0.01
End If
If Me.Opacity <= 0.3 Then
Time1.Dispose()
End If
End Sub
Public Sub Setting(ByVal Deleted1 As Boolean, ByVal Name1 As String, ByVal Path As String, Optional ByVal Number As Integer = 0)
Select Case Number
Case 0
Dim LblName As New Label
LblName.Location = New Point(5, 50)
LblName.Text = "ViruseName : " & Name1
LblName.AutoSize = True
Dim LblPath As New Label
LblPath.Location = New Point(5, 50 + 30)
LblPath.Text = "VirusePath : " & Path
LblPath.AutoSize = True
If Deleted1 = False Then Deleted1 = True Else Deleted1 = False
Dim LblDeleted As New Label
LblDeleted.Location = New Point(5, 50 + 30 + 30)
LblDeleted.Text = "ViruseDeleted : " & Deleted1
LblDeleted.AutoSize = True
Me.Controls.Add(LblName)
Me.Controls.Add(LblPath)
Me.Controls.Add(LblDeleted)
Case 1
Dim LblName As New Label
LblName.Location = New Point(5, 50)
LblName.Text = "ViruseName : " & Name1
LblName.AutoSize = True
Dim LblPath As New Label
LblPath.Location = New Point(5, 50 + 30)
LblPath.Text = "VirusePath : " & Path
LblPath.AutoSize = True
If Deleted1 = False Then Deleted1 = True Else Deleted1 = False
Dim LblDeleted As New Label
LblDeleted.Location = New Point(5, 50 + 30 + 30)
LblDeleted.Text = "ViruseDeleted : " & Deleted1
LblDeleted.AutoSize = True
Me.Controls.Add(LblName)
Me.Controls.Add(LblPath)
Me.Controls.Add(LblDeleted)
Dim BtnAllow As New Button
BtnAllow.Location = New Point(5, 140)
BtnAllow.Text = "Allow"
BtnAllow.AutoSize = True
Dim BtnLock As New Button
BtnLock.Location = New Point(5 + BtnAllow.Width + 5, 140)
BtnLock.Text = "Lock"
BtnLock.AutoSize = True
Dim BtnDelete As New Button
BtnDelete.Location = New Point(5 + BtnLock.Width + 5 + BtnAllow.Width + 5, 140)
BtnDelete.Text = "Delete"
BtnDelete.AutoSize = True
Me.Controls.Add(BtnAllow)
Me.Controls.Add(BtnLock)
Me.Controls.Add(BtnDelete)
AddHandler BtnAllow.Click, AddressOf BtnAllow_Click
AddHandler BtnLock.Click, AddressOf BtnLock_Click
AddHandler BtnDelete.Click, AddressOf BtnDelete_Click
End Select
End Sub
Public Address As String
Private Sub BtnAllow_Click(ByVal sender As Object, ByVal e As System.EventArgs)
On Error Resume Next
Dim Free As Integer = FreeFile()
FileOpen(Free, Address, OpenMode.Append, , OpenShare.Shared)
PrintLine(Free, vbCrLf & "Allow")
FileClose(Free)
Me.Close()
End Sub
Public FileAddress As String
Private Sub BtnLock_Click(ByVal sender As Object, ByVal e As System.EventArgs)
On Error Resume Next
On Error Resume Next
Dim Drive As String = FileIO.FileSystem.GetFileInfo(Address).Directory.R oot.ToString
Dim Free As Integer = FreeFile()
Dim fld As New System.IO.FileInfo(Drive & FileAddress)
Dim sec As System.Security.AccessControl.FileSecurity
sec = fld.GetAccessControl()
For Each rul As System.Security.AccessControl.FileSystemAccessRule In sec.GetAccessRules(True, True, GetType(System.Security.Principal.NTAccount))
sec.RemoveAccessRuleAll(rul)
Next
sec.SetAccessRuleProtection(True, False)
fld.SetAccessControl(sec)
sec.AddAccessRule(New Security.AccessControl.FileSystemAccessRule("CREAT OR OWNER", Security.AccessControl.FileSystemRights.FullContro l, Security.AccessControl.AccessControlType.Deny))
fld.SetAccessControl(sec)
FileOpen(Free, Address, OpenMode.Append, , OpenShare.Shared)
PrintLine(Free, vbCrLf & "Lock")
FileClose(Free)
Me.Close()
End Sub
Public FileName As String
Private Sub BtnDelete_Click(ByVal sender As Object, ByVal e As System.EventArgs)
On Error Resume Next
Dim Drive As String = FileIO.FileSystem.GetFileInfo(Address).Directory.R oot.ToString
If FileIO.FileSystem.FileExists(Drive & FileAddress) = True Then
SetAttr(Drive & FileAddress, FileAttribute.Normal)
SetAttr(Address, FileAttribute.Normal)
FileIO.FileSystem.DeleteFile(Drive & FileAddress)
FileIO.FileSystem.DeleteFile(Address)
Else
SetAttr(Address, FileAttribute.Normal)
SetAttr(Drive & "Recycler", FileAttribute.Normal)
FileIO.FileSystem.DeleteFile(Address)
FileIO.FileSystem.DeleteDirectory(Drive & "Recycler", FileIO.DeleteDirectoryOption.DeleteAllContents)
End If
Me.Close()
End Sub
End Class
این از کد قسمت جستجو بازم با کمی دست کاری :
On Error Resume Next
Dim GetDriveName() As System.IO.DriveInfo = System.IO.DriveInfo.GetDrives
Dim PutString As String
Dim Text() As String
Dim NumberOfText As Integer
Dim AutorunPath As String
Dim FileAutorunPath, FileAutorunName, FileAutorunFolder As String
Dim EvenStr As Integer
Dim Bo As Boolean
For Each Drive As System.IO.DriveInfo In GetDriveName
AutorunPath = Drive.Name & "Autorun.inf"
If Drive.Name <> "A:\" Then
If Drive.DriveType = IO.DriveType.Removable And FileIO.FileSystem.FileExists(AutorunPath) = True Then
PutString = FileIO.FileSystem.ReadAllText(AutorunPath)
Text = Split(PutString, vbCrLf)
For Each LineText As String In Text
Dim L As String
Dim Instr1 As Integer = InStr(PutString, "SHELL", CompareMethod.Text)
If Instr1 <> 0 Then
L = LineText
LineText = Mid(PutString, Instr1)
LineText = (Mid(LineText, Instr1, InStr(LineText, vbCrLf, CompareMethod.Text) - 1))
NumberOfText = InStr(LineText, "=")
If Mid(LineText, 1, 1) <> " " Then
EvenStr = NumberOfText + +1
Else
EvenStr = NumberOfText + +2
End If
If Mid(LineText, LineText.Length - 3, 1) <> "." Then
Dim S() As String = Split(Mid(LineText, EvenStr))
For Each ArrayText As String In S
If ArrayText <> " " And ArrayText <> "" And ArrayText <> vbCrLf And Bo = False Then
Bo = True
FileAutorunPath = ArrayText
FileAutorunName = FileIO.FileSystem.GetFileInfo(FileAutorunPath).Nam e
FileAutorunFolder = FileIO.FileSystem.GetFileInfo(FileAutorunPath).Dir ectory.Name
End If
Next
Else
FileAutorunPath = Mid(LineText, EvenStr)
FileAutorunName = FileIO.FileSystem.GetFileInfo(FileAutorunPath).Nam e
FileAutorunFolder = FileIO.FileSystem.GetFileInfo(FileAutorunPath).Dir ectory.Name
End If
If FileIO.FileSystem.FileExists(Drive.Name & FileAutorunPath) = True Then
SetAttr(Drive.Name & FileAutorunPath, FileAttribute.Normal)
SetAttr(AutorunPath, FileAttribute.Normal)
FileIO.FileSystem.DeleteFile(Drive.Name & FileAutorunPath)
FileIO.FileSystem.DeleteFile(AutorunPath)
Else
SetAttr(AutorunPath, FileAttribute.Normal)
SetAttr(Drive.Name & "Recycler", FileAttribute.Normal)
FileIO.FileSystem.DeleteFile(AutorunPath)
FileIO.FileSystem.DeleteDirectory(Drive.Name & "Recycler", FileIO.DeleteDirectoryOption.DeleteAllContents)
End If
Dim NewFrm As New FormWarning
NewFrm.Setting(FileIO.FileSystem.FileExists(Drive. Name & FileAutorunPath), FileAutorunName, Drive.Name & FileAutorunPath)
NewFrm.Show()
End If
If Instr1 = 0 And FileIO.FileSystem.FileExists(AutorunPath) = True Then
If L <> "" Then
LineText = L
End If
If Text(Text.Length - 2) <> "Allow" Then
If UCase(Mid(LineText, 1, 4)) = "OPEN" Then
NumberOfText = InStr(LineText, "=")
If Mid(LineText, 1, 1) <> " " Then
EvenStr = NumberOfText + +1
Else
EvenStr = NumberOfText + +2
End If
If Mid(LineText, LineText.Length - 3, 1) <> "." Then
Dim S() As String = Split(Mid(LineText, EvenStr))
For Each ArrayText As String In S
If ArrayText <> " " And ArrayText <> "" And Bo = False Then
Bo = True
FileAutorunPath = ArrayText
FileAutorunName = FileIO.FileSystem.GetFileInfo(FileAutorunPath).Nam e
FileAutorunFolder = FileIO.FileSystem.GetFileInfo(FileAutorunPath).Dir ectory.Name
End If
Next
Else
FileAutorunPath = Mid(LineText, EvenStr)
FileAutorunName = FileIO.FileSystem.GetFileInfo(FileAutorunPath).Nam e
FileAutorunFolder = FileIO.FileSystem.GetFileInfo(FileAutorunPath).Dir ectory.Name
End If
Dim NewFrm As New FormWarning
NewFrm.Address = AutorunPath
NewFrm.FileAddress = FileAutorunPath
NewFrm.FileName = FileAutorunName
NewFrm.Setting(FileIO.FileSystem.FileExists(Drive. Name & FileAutorunPath), FileAutorunName, Drive.Name & FileAutorunPath, 1)
NewFrm.Show()
End If
End If
End If
Next
End If
End If
Next
کد بالا اگه توی فایل آتوران از کلمه Shell استفاده نشده بود از تون سوال می کنه چی کارش کنم که سه حالت داره پاک کش کنه یا قفلش کنه یا اجزاه دسترسی بده.
و اگه از اون کلمه استفاده شده بود سریع اونو پاک می کنه و یه پیغام پاک وضعیت نشون میده.
من اینو امتحان کردم مشکلی نداشت اگه مشکلی دیدید بگین تا اصلاح بشه.
کد قسمت ریجستری هم چندی دیگر (شاید چندی دیگر شاید هم بیشتر) آماده میشه.