Public Function PcType()
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\localhost\root\cimv2")
Set colChassis = objWMIService.ExecQuery _
("Select * from Win32_SystemEnclosure")
For Each objChassis In colChassis
For Each strChassisType In objChassis.ChassisTypes
Select Case strChassisType
Case 1
PcType = "Other"
Case 2
PcType = "Unknown"
Case 3
PcType = "Desktop"
Case 4
PcType = "Low Profile Desktop"
Case 5
PcType = "Pizza Box"
Case 6
PcType = "Mini Tower"
Case 7
PcType = "Tower"
Case 8
PcType = "Portable"
Case 9
PcType = "Laptop"
Case 10
PcType = "Notebook"
Case 11
PcType = "Handheld"
Case 12
PcType = "Docking Station"
Case 13
PcType = "All-in-One"
Case 14
PcType = "Sub-Notebook"
Case 15
PcType = "Space Saving"
Case 16
PcType = "Lunch Box"
Case 17
PcType = "Main System Chassis"
Case 18
PcType = "Expansion Chassis"
Case 19
PcType = "Sub-Chassis"
Case 20
PcType = "Bus Expansion Chassis"
Case 21
PcType = "Peripheral Chassis"
Case 22
PcType = "Storage Chassis"
Case 23
PcType = "Rack Mount Chassis"
Case 24
PcType = "Sealed-Case PC"
Case Else
PcType = "Unknown"
End Select
Next
Next
End Function
Public Function encode(ByVal x As String)
Dim i As Integer
Dim TempNum As Integer
For i = Len(x) To 1 Step -1
TempNum = Hex(Asc(Mid(x, i, 1)) + 50)
If encode = "" Then
encode = encode & CStr(TempNum)
Else
encode = encode & "-" & CStr(TempNum)
End If
Next
End Function
Public Function decode(ByVal x As String)
Dim temp() As String
Dim n As Integer
Dim i As Integer
Dim str As String
Dim m As Integer
temp = Split(x, "-")
n = UBound(temp)
For i = 0 To n
On Error GoTo errkeycode:
str = str & Chr(Int("&H" & temp(i)) - 50)
errkeycode:
Next
For m = Len(str) To 1 Step -1
decode = decode & Mid(str, m, 1)
Next
End Function
Public Function sncode(ByVal x As String)
Dim table As String
Dim i As Integer
Dim mw As String
Dim mwv As Integer
Dim ti As Integer
Dim rv As Integer
Dim rs As String
Dim b As Integer
table = "JSDJFKLUWRUOISDH;KSADJKLWQ;ABCDEFHIHL;KLADSDKJAGFWIHERQOWRLQH"
For i = 1 To Len(x)
mw = Mid(x, i, 1)
mwv = Asc(mw)
ti = ti + 1
If ti > Len(table) Then ti = 1
rv = Asc(Mid(table, ti, 1)) Mod mwv
rs = rs & Hex(rv)
Next
For b = 1 To Len(rs) Step 4
If sncode = "" Then
sncode = sncode & Mid(rs, b, 4)
Else
sncode = sncode & "-" & Mid(rs, b, 4)
End If
Next
End Function
Private Sub Command1_Click()
Dim x As DRIVER_INFO_OK
Dim i As Long
If IsWinNT = 1 Then
i = ReadPhysicalDriveInNT(ByVal 0, ByVal VarPtr(x), ByVal 256)
Else
i = ReadDrivePortsInWin9X(ByVal 0, ByVal VarPtr(x), ByVal 256)
End If
Dim s As String
s = StrConv(x.SerialNumber, vbUnicode)
's = Left(s, InStr(1, s, Chr(0)) - 1)
s = Trim(s)
Select Case PcType
Case "Notebook"
s = Mid(s, 1, 10)
Case "Portable"
s = Mid(s, 1, 10)
Case "Desktop"
s = Mid(s, 1, 8)
Case Else
s = Mid(s, 1, 6)
End Select
Const pwd = "杜欢-威驰"
Dim keycode As String
Dim sn As String
Dim company As String
keycode = Form1.Text1.Text
sn = Form1.Text2.Text
company = Form1.Text3.Text
If keycode = "" Or sn = "" Or company = "" Then
MsgBox "请将注册信息填写完整!", vbInformation, "Error:Information can not be null!"
Else
If (decode(keycode)) <> pwd Then
MsgBox "Key Code不正确!", vbInformation, "Error:Key Code is wrong!"
Else
If (sncode(s)) <> sn Then
MsgBox "Serial Number不正确!", vbInformation, "Error:Searial Number is wrong!"
Else
Call WriteToIni(App.Path & "\power.ini", "power", "RC", s)
Call WriteToIni(App.Path & "\power.ini", "power", "SN", sn)
Call WriteToIni(App.Path & "\power.ini", "power", "Company", company)
Call WriteToIni(App.Path & "\power.ini", "power", "PC", PcType)
MsgBox "注册成功！", vbInformation, "Register Successful"
Unload Form1
Set Form1 = Nothing
End If
End If
End If
End Sub
