Tạo password bằng số seri của máy (1 người xem)

[nad582]

chào các bạn!! Mình có vần đề như sau:
Khi mở file lên thì hiện lên 1 bảng (userForm) có 3 phần:
1 là username: chính là tên của máy tính
2 là Password 1: chính là số seri của máy tính
3 là Password 2: chính là số HDD của máy tính
khi điền đúng đủ 3 phần trên thì mở file, nếu 1 trong 3 phần trên sai thì close file.....
mình có file lấy số seri ở file đính kèm...
Nhờ các bạn giúp mình. Thanks nhiều...^^

 

[thaipv]

Em sửa code như sau thì chạy được nhưng có thông báo lỗi:
Anh chị chỉ giúp em với ạ.

Private Sub Workbook_Open()
    Dim madia As String, mamay As String
    Dim Arrdia
    Dim Arrmay
    Arrdia = Array("S3PGE65Q","S314J90H241608")
    Arrmay = Array("BFEBFBFF00040651","BFEBFBFF000406E3")
       For Each madia in Arrdia
        For Each mamay in Arrmay
    If doc_ma_dia <> madia Or doc_ma_may <> mamay Then
        If Application.Workbooks.Count = 1 Then
            Application.Quit
        Else
            ThisWorkbook.Close False
        End If
    End If
        Next
    Next    
End Sub

View attachment 163801

Bạn tìm hiểu lại cấu trúc lệnh "For each..." nhé. Mình đã viết lại code, bạn tham khảo bên dưới, lưu ý doc_ma_dia, doc_ma_may mình không biết bạn lấy từ đâu nhé :
[GPECODE=vb]Private Sub Workbook_Open()
Dim i As Long, arrDia, arrMay
arrDia = Array("S3PGE65Q", "S314J90H241608")
arrMay = Array("BFEBFBFF00040651", "BFEBFBFF000406E3")

For i = LBound(arrDia) To UBound(arrDia)
If arrDia(i) <> doc_ma_dia Or arrMay(i) <> doc_ma_may Then
If Application.Workbooks.Count = 1 Then
Application.Quit
Else
ThisWorkbook.Close False
End If
End If
Next
End Sub[/GPECODE]

 

[tuoigiyeuem]

Function doc_ma_dia()Dim ObjetoWMI As Object
Dim Disco As Object
Dim Discos As Object
Dim abc
Set ObjetoWMI = GetObject("WINMGMTS:")
Set Discos = ObjetoWMI.InstancesOf("Win32_PhysicalMedia")
abc = ""
For Each Disco In Discos
  abc = Disco.SerialNumber
  If Len(Trim(abc)) > 0 Then
    Exit For
  End If
Next
doc_ma_dia = Trim(abc)
End Function


Function doc_ma_may()
Dim i
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_Processor")
For Each objItem In colItems
i = objItem.ProcessorId
Next
doc_ma_may = i
End Function

Đây là code doc_ma_may, doc_ma_dia. Em thử code của anh nhưng k chạy được.

 

[Kiều Mạnh]

Bạn tìm hiểu lại cấu trúc lệnh "For each..." nhé. Mình đã viết lại code, bạn tham khảo bên dưới, lưu ý doc_ma_dia, doc_ma_may mình không biết bạn lấy từ đâu nhé :
[GPECODE=vb]Private Sub Workbook_Open()
Dim i As Long, arrDia, arrMay
arrDia = Array("S3PGE65Q", "S314J90H241608")
arrMay = Array("BFEBFBFF00040651", "BFEBFBFF000406E3")

For i = LBound(arrDia) To UBound(arrDia)
If arrDia(i) <> doc_ma_dia Or arrMay(i) <> doc_ma_may Then
If Application.Workbooks.Count = 1 Then
Application.Quit
Else
ThisWorkbook.Close False
End If
End If
Next
End Sub[/GPECODE]

Hình như code này chạy trên máy nào nó cũng Close hết hay sao ý .....
Mình mới test tren máy Mình thấy kiểu chi nó chết ... chỗ màu đỏ là máy Mình

Private Sub Check_XYZ()
    Dim i As Long, arrDia, arrMay
    arrDia = Array("[COLOR=#ff0000][B]WD-WMAYUS6019431[/B][/COLOR]", "S314J90H241608")
    arrMay = Array("[COLOR=#ff0000][B]BFEBFBFF0001067A[/B][/COLOR]", "BFEBFBFF000406E3")
     
    For i = LBound(arrDia) To UBound(arrDia)
        If arrDia(i) <> doc_ma_dia Or arrMay(i) <> doc_ma_may Then
            If Application.Workbooks.Count = 1 Then
                'Application.Quit
                MsgBox "OK 1"
            Else
                'ThisWorkbook.Close False
                MsgBox "OK 2"
            End If
        End If
    Next
End Sub

 

[thaipv]

Function doc_ma_dia()
Dim ObjetoWMI As Object
Dim Disco As Object
Dim Discos As Object
Dim abc
Set ObjetoWMI = GetObject("WINMGMTS:")
Set Discos = ObjetoWMI.InstancesOf("Win32_PhysicalMedia")
abc = ""
For Each Disco In Discos
  abc = Disco.SerialNumber
  If Len(Trim(abc)) > 0 Then
    Exit For
  End If
Next
doc_ma_dia = Trim(abc)
End Function


Function doc_ma_may()
Dim i
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_Processor")
For Each objItem In colItems
i = objItem.ProcessorId
Next
doc_ma_may = i
End Function

Đây là code doc_ma_may, doc_ma_dia. Em thử code của anh nhưng k chạy được.

Vì doc_ma_may, doc_ma_dia là hàm (Function) nên bạn cần có đóng, mở ngoặc '()' trong câu lệnh gọi, code ở bài #41 sửa lại như sau :
[GPECODE=vb]Private Sub Workbook_Open()
Dim i As Long, arrDia, arrMay
arrDia = Array("S3PGE65Q", "S314J90H241608") arrMay = Array("BFEBFBFF00040651", "BFEBFBFF000406E3")

For i = LBound(arrDia) To UBound(arrDia)
If arrDia(i) <> doc_ma_dia() Or arrMay(i) <> doc_ma_may() Then
If Application.Workbooks.Count = 1 Then
Application.Quit
Else
ThisWorkbook.Close False
End If
End If
Next
End Sub[/GPECODE]

 

[thaipv]

Hình như code này chạy trên máy nào nó cũng Close hết hay sao ý .....
Mình mới test tren máy Mình thấy kiểu chi nó chết ... chỗ màu đỏ là máy Mình

Private Sub Check_XYZ()
    Dim i As Long, arrDia, arrMay
    arrDia = Array("[COLOR=#ff0000][B]WD-WMAYUS6019431[/B][/COLOR]", "S314J90H241608")
    arrMay = Array("[COLOR=#ff0000][B]BFEBFBFF0001067A[/B][/COLOR]", "BFEBFBFF000406E3")
     
    For i = LBound(arrDia) To UBound(arrDia)
        If arrDia(i) <> doc_ma_dia Or arrMay(i) <> doc_ma_may Then
            If Application.Workbooks.Count = 1 Then
                'Application.Quit
                MsgBox "OK 1"
            Else
                'ThisWorkbook.Close False
                MsgBox "OK 2"
            End If
        End If
    Next
End Sub

Có lẽ thiếu ngoặc như ở bài #44 mình đã trình bày.

 

[thaipv]

Hình như code này chạy trên máy nào nó cũng Close hết hay sao ý .....Mình mới test tren máy Mình thấy kiểu chi nó chết ... chỗ màu đỏ là máy Mình

Private Sub Check_XYZ()    Dim i As Long, arrDia, arrMay    arrDia = Array("[COLOR=#ff0000][B]WD-WMAYUS6019431[/B][/COLOR]", "S314J90H241608")    arrMay = Array("[COLOR=#ff0000][B]BFEBFBFF0001067A[/B][/COLOR]", "BFEBFBFF000406E3")         For i = LBound(arrDia) To UBound(arrDia)        If arrDia(i)  doc_ma_dia Or arrMay(i)  doc_ma_may Then            If Application.Workbooks.Count = 1 Then                'Application.Quit                MsgBox "OK 1"            Else                'ThisWorkbook.Close False                MsgBox "OK 2"            End If        End If    NextEnd Sub

Hix, giải thuật sai các bác ạ (chưa thoát vòng lặp khi đúng). Xin sửa lại như sau :
[GPECODE=vb]Private Sub Workbook_Open()
Dim i As Long, arrDia, arrMay

arrDia = Array("S3PGE65Q", "S314J90H241608")
arrMay = Array("BFEBFBFF00040651", "BFEBFBFF000406E3")

For i = LBound(arrDia) To UBound(arrDia)
If arrDia(i) = doc_ma_dia() Then
If arrMay(i) = doc_ma_may() Then
'// Làm gì đó
Else
If Application.Workbooks.Count = 1 Then
Application.Quit
Else
ThisWorkbook.Close False
End If
End If
Exit For
End If
Next
End Sub[/GPECODE]

 

[Kiều Mạnh]

Hix, giải thuật sai các bác ạ (chưa thoát vòng lặp khi đúng). Xin sửa lại như sau :
[GPECODE=vb]Private Sub Workbook_Open()
Dim i As Long, arrDia, arrMay
arrDia = Array("S3PGE65Q", "S314J90H241608")
arrMay = Array("BFEBFBFF00040651", "BFEBFBFF000406E3")

For i = LBound(arrDia) To UBound(arrDia)
If arrDia(i) = doc_ma_dia() Then
If arrMay(i) = doc_ma_may() Then
Exit For
Else
If Application.Workbooks.Count = 1 Then
Application.Quit
Else
ThisWorkbook.Close False
End If
End If
End If
Next
End Sub[/GPECODE]

Bài này nếu là mình khỏi For ... Next làm chi khi Mở File nó quay tròn quay Tròn ...

Ma Mình chơi If ...and ... Then đơn giản gọn nhẹ xong Phim

 

[tuoigiyeuem]

Em thử test code trên cả máy chưa được nhập mã đĩa và mã máy mà vẫn mở được .

 

[Kiều Mạnh]

Em thử test code trên cả máy chưa được nhập mã đĩa và mã máy mà vẫn mở được .

Thì đơn giản vây đi
1/ Nếu Mình thì sẻ viết vây

Public Sub CheckSerial()
    Dim May1$, May2$, May3$, Serial$
    May1 = "WD-WMAYUS601943"
    May2 = "WD-WMAYUS6019431"
    May3 = "K12PAK5G"
    Serial = doc_ma_dia()
    If Serial <> May1 And Serial <> May2 And Serial <> May3 Then
        MsgBox "OK"
        'ThisWorkbook.Close False
    End If
End Sub

2/ Còn viết vầy cho Bạn nào mới Tập làm quen vơi VBA hiểu thêm một chút Về If

Public Sub CheckSerial2()
    Dim May1$, May2$, May3$, Serial$
    May1 = "WD-WMAYUS601943"
    May2 = "WD-WMAYUS6019431"
    May3 = "K12PAK5G"
    Serial = doc_ma_dia()
    If Serial <> May1 Then
        If Serial <> May2 Then
            If Serial <> May3 Then
                MsgBox "OK"
                'ThisWorkbook.Close False
            End If
        End If
    End If
End Sub