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