Đánh giá chủ đề:
  • 0 Votes - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
[Hướng dẫn] Có bạn nào giúp mình code này được kho
#1
Option Compare Database
Option Explicit
'Created by Ha Ngoc Huong (2014)

Public Function Get_SerialNumber() As String
'Lay thong tin ve serial cua o cung
On Error GoTo Err_GetSerialNumber
Dim fs, D
Set fs = CreateObject("Scripting.FileSystemObject")
Set D = fs.GetDrive(fs.GetDriveName(fs.GetAbsolutePathName("C:\")))
Get_SerialNumber = CStr(-D.SerialNumber)
Exit_GetSerialNumber:
Exit Function
Err_GetSerialNumber:
MsgBox "Lçi: " & Err.Number & " - " & Err.Description, vbInformation, "Th«ng b¸o"
Resume Exit_GetSerialNumber
End Function

Public Function Code_SerialNumber(Serial As String) As String
'Ma hoa serial number cua o cung
Dim strCoding As String
strCoding = Serial
strCoding = CStr((Val(strCoding) Mod 11011979) + 11031979)
Code_SerialNumber = strCoding
End Function

Public Sub Update_SerialNumber(strCoding As String)
'Ghi thong tin ma hoa vao mot file trong thu muc dac biet
On Error GoTo Err_UpdateSerialNumber
Dim fs, f
Dim strFileLuuPath As String
Set fs = CreateObject("Scripting.FileSystemObject")
strFileLuuPath = CStr(fs.GetSpecialFolder(1)) & "\mkserial.dll"
Set f = fs.CreateTextFile(strFileLuuPath, True) 'Tao file luu duoi dang ASCII
f.writeLine (strCoding)
f.Close

Exit_UpdateSerialNumber:
Exit Sub
Err_UpdateSerialNumber:
MsgBox "Lçi: " & Err.Number & " - " & Err.Description, vbInformation, "Th«ng b¸o"
Resume Exit_UpdateSerialNumber
End Sub

Public Function Exist_SerialFile() As Boolean
'Kiem tra xem da ton tai file mkserial.dll chua
Dim fs
Dim strFileLuuPath As String
Set fs = CreateObject("Scripting.FileSystemObject")
strFileLuuPath = CStr(fs.GetSpecialFolder(1)) & "\mkserial.dll"
If Dir(strFileLuuPath) = "" Then
Exist_SerialFile = False
Else
Exist_SerialFile = True
End If
End Function

Public Function Compare_SerialNumber() As Boolean
'So sanh ma so cua file da luu va serial cua o cung hien tai
Dim fs, f
Dim strCoding, strFileLuuPath, strSerialLuu As String
Set fs = CreateObject("Scripting.FileSystemObject")
'Doc thong tin tu File da luu
strFileLuuPath = CStr(fs.GetSpecialFolder(1)) & "\mkserial.dll"
Set f = fs.OpenTextFile(strFileLuuPath, 1, False)
Do While f.AtEndOfStream <> True
strSerialLuu = f.ReadLine
Loop
f.Close
'Doc thong tin serial cau o cung
strCoding = Code_SerialNumber(Get_SerialNumber())
'So sanh hai thong tin
If strSerialLuu <> strCoding Then
Compare_SerialNumber = False
Else
Compare_SerialNumber = True
End If
End Function
( Các bạn có thể giúp mình lấy mã main, Hoặc CPU hoặc toàn ổ cứng được không àh)
Chữ ký của ngochuong279 Xin chào, mình là ngochuong279, Tham gia http://thuthuataccess.com/forum từ ngày 11-11 -13.
Reply
Những người đã cảm ơn


Có thể liên quan đến chủ đề
Chủ đề: Tác giả Trả lời: Xem: Bài mới nhất
  [Help] K biết là lỗi hay gì cần trợ giúp. nhocdevill11 2 31 5 Giờ trước
Bài mới nhất: nhocdevill11
  [Hỏi] Việc set thuộc tính OnClick trong Code toancvp 5 229 31-10-16, 10:14 AM
Bài mới nhất: toancvp
  [Lỗi] Không chạy được VBA Code hungthanmx 3 219 04-09-16, 03:48 PM
Bài mới nhất: Nguyen Hoang Diep
  [Lỗi] Không import được hết dữ liệu từ Excel và Access huedhcs 2 159 03-07-16, 11:27 PM
Bài mới nhất: zinzin8x
  [Help] Nhờ anh em trong diễn đàn giúp mình thiết kế chương trình báo dịch hàng ngày vinhpaint 1 258 21-06-16, 09:15 AM
Bài mới nhất: zinzin8x

Chuyển nhanh:


User(s) browsing this thread: 1 Guest(s)
Diễn Đàn Thơ Văn Thi Ẩm Lâu|Nhà Hàng Sông Thơ