Làm để File XYZ chạy được ở Máy tính A hoặc B , nhưng không cho chạy ở Máy tính khác!

Hong.Van · 22/2/13

Em chào Thầy cô & anh Chị!
Ở cty em có nhiều máy tính, bây giờ em muốn File "XYZ" chạy được ở máy tính A hoặc Máy tính B, ngòai 2 máy tính này thì sẽ không cho chạy bấy kỳ ở máy tính khác (Mục đích không cho copy File "XYZ" tràn lan ở các máy tính khác)
-----------
Em có sưu tầm code đọc Serial HDD

Mã:

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

giả sử em có Serial HDD:
Của Máy A là : S01JJ40Y233766
Của Máy B là : K12PAK5G
----------
Bây giờ em muốn dùng Sub Aut

pen() để kiểm tra Serial HDD của hai máy tính nói trên, nếu đúng thì tiếp tục, nếu sai thì thóat File. Nhờ Thầy cô & anh chị viết giúp code
---------------
Em cũng biết vấn đề bảo mật của Excel là hạn chế, nhưng vấn đề trên cũng để hạn chế copy File ra tùm lum rồi không biết cái nào là bản chính, cái nào là phụ!
Em cảm ơn!

Quang_Hải · 22/2/13

Hong.Van đã viết:
Em chào Thầy cô & anh Chị!
Ở cty em có nhiều máy tính, bây giờ em muốn File "XYZ" chạy được ở máy tính A hoặc Máy tính B, ngòai 2 máy tính này thì sẽ không cho chạy bấy kỳ ở máy tính khác (Mục đích không cho copy File "XYZ" tràn lan ở các máy tính khác)
-----------
Em có sưu tầm code đọc Serial HDD

Mã:

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

giả sử em có Serial HDD:
Của Máy A là : S01JJ40Y233766
Của Máy B là : K12PAK5G
----------
Bây giờ em muốn dùng Sub Autpen() để kiểm tra Serial HDD của hai máy tính nói trên, nếu đúng thì tiếp tục, nếu sai thì thóat File. Nhờ Thầy cô & anh chị viết giúp code
---------------
Em cũng biết vấn đề bảo mật của Excel là hạn chế, nhưng vấn đề trên cũng để hạn chế copy File ra tùm lum rồi không biết cái nào là bản chính, cái nào là phụ!
Em cảm ơn!

Lúc trước mình cũng làm cái này rồi. Chỉ cần check tên đường dẫn nếu đúng username thì cho mở, không thì thoát. Không cần tới serial của ổ đĩa gì cả.

ndu96081631 · 22/2/13

Hong.Van đã viết:
Em chào Thầy cô & anh Chị!
Ở cty em có nhiều máy tính, bây giờ em muốn File "XYZ" chạy được ở máy tính A hoặc Máy tính B, ngòai 2 máy tính này thì sẽ không cho chạy bấy kỳ ở máy tính khác (Mục đích không cho copy File "XYZ" tràn lan ở các máy tính khác)
-----------
Em có sưu tầm code đọc Serial HDD

Mã:

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

giả sử em có Serial HDD:
Của Máy A là : S01JJ40Y233766
Của Máy B là : K12PAK5G
----------
Bây giờ em muốn dùng Sub Autpen() để kiểm tra Serial HDD của hai máy tính nói trên, nếu đúng thì tiếp tục, nếu sai thì thóat File. Nhờ Thầy cô & anh chị viết giúp code
---------------
Em cũng biết vấn đề bảo mật của Excel là hạn chế, nhưng vấn đề trên cũng để hạn chế copy File ra tùm lum rồi không biết cái nào là bản chính, cái nào là phụ!
Em cảm ơn!

Thì cứ viết bình thường thôi... Tôi không nghĩ là bạn không làm được
ví dụ:

Mã:

Sub Auto_Open()
  Dim sSeri As String
  sSeri = doc_ma_dia
  If sSeri <> "S01JJ40Y233766" And sSeri <> "K12PAK5G" Then ThisWorkbook.Close False
End Sub

Đại khái vậy

PhanTuHuong · 22/2/13

Thay And bằng Or là hợp lý nhất. Có trường hợp máy tính vẫn bị trùng mã.

Hong.Van · 22/2/13

PhanTuHuong đã viết:
Thay And bằng Or là hợp lý nhất. Có trường hợp máy tính vẫn bị trùng mã.

Em thấy, nếu And bằng Or thì code sẽ thóat, vì 1 trong 2 điều kiện không thỏa thì bị đóng File
---------
Nhưng em thấy dùng And mà nếu chỉ có 1 trường hợp đúng (chắc chắn là như vậy) thì file kg thoát??? vì khi dùng And theo em thì 2 điều kiện cùng thỏa thì OK
Em cũng còn đang khó hiểu chỗ này? nhờ các Thầy & anh chị giải thích thêm
Em cảm ơn!

ndu96081631 · 22/2/13

Hong.Van đã viết:
Em thấy, nếu And bằng Or thì code sẽ thóat, vì 1 trong 2 điều kiện không thỏa thì bị đóng File
---------
Nhưng em thấy dùng And mà nếu chỉ có 1 trường hợp đúng (chắc chắn là như vậy) thì file kg thoát??? vì khi dùng And theo em thì 2 điều kiện cùng thỏa thì OK
Em cũng còn đang khó hiểu chỗ này? nhờ các Thầy & anh chị giải thích thêm
Em cảm ơn!

Dùng And là đúng rồi
If sSeri <> "S01JJ40Y233766" And sSeri <> "K12PAK5G" Then nghĩa là nếu sSeri cùng khác cả 2 chuổi mà bạn cho thì mới thoát, ngược lại, chỉ cần đúng 1 trong 2 chuổi sẽ không có chuyện gì xảy ra
Nếu dùng OR thì phải viết thế này:
If Not (sSeri = "S01JJ40Y233766" Or sSeri = "K12PAK5G") Then

PhanTuHuong · 22/2/13

Đúng là dùng And, tôi lại hiểu ngược vấn đề --=0

hungpecc1 · 22/2/13

cho mình hỏi bạn Hồng.Vân , trên đây là trường hợp bạn dùng cho 2 máy A và B, bây giờ muốn mở rông lên dùng cho cả 1 phòng 50 CPU ( muốn cho file không ra khỏi phòng ) ---> bạn sẽ đi từng máy tính để lấy Seri hay là dùng code VBA ? !$@!!

Hong.Van · 22/2/13

hungpecc1 đã viết:
cho mình hỏi bạn Hồng.Vân , trên đây là trường hợp bạn dùng cho 2 máy A và B, bây giờ muốn mở rông lên dùng cho cả 1 phòng 50 CPU ( muốn cho file không ra khỏi phòng ) ---> bạn sẽ đi từng máy tính để lấy Seri hay là dùng code VBA ?

Hi, không biết bạn đang hỏi đố? hay hỏi bài?
Nếu hỏi đố thì cho mình biết cách nha! Còn hỏi bài thì phải chờ cách giải của Thầy cô & anh chị thôi
Theo tôi biết, nếu cty có s/d mạng LAN, thì tại máy chủ có thể lấy hết các Serial HDD của các máy khác thì fải???
------
Nếu bỏ qua File bị Crack, thì cách của tôi để quản lý trực tiếp giữa giữa người làm trực tiếp trên File và KTTrưởng, tránh trường hợp Post file lung tung ...
Thân!

hungpecc1 · 22/2/13

Hong.Van đã viết:
Hi, không biết bạn đang hỏi đố? hay hỏi bài?
Nếu hỏi đố thì cho mình biết cách nha! Còn hỏi bài thì phải chờ cách giải của Thầy cô & anh chị thôi
Theo tôi biết, nếu cty có s/d mạng LAN, thì tại máy chủ có thể lấy hết các Serial HDD của các máy khác thì fải???
------
Nếu bỏ qua File bị Crack, thì cách của tôi để quản lý trực tiếp giữa giữa người làm trực tiếp trên File và KTTrưởng, tránh trường hợp Post file lung tung ...
Thân!

Hix kthức của mình còn hạn chế lắm , nếu không muốn nói là "gà"--> ^^ làm sao mình " hỏi đố? " như bạn nói được **~**

VetMini · 22/2/13

Vì chỉ có 2 cho nên ta mới làm như vậy. Nếu nhiều máy thì đặt một chuỗi const:

private Const MAYCOQUYEN = "|mayA|mayB|mayC|..."

rồi dò sê ri dĩa trong đó.

Cỡ 50 máy thì phải dùng network. Code gởi id của máy lên server hỏi thăm.

Hong.Van · 25/3/13

Mã:

[COLOR=#000000][I]Function doc_ma_dia()    Dim ObjetoWMI As Object[/I][/COLOR]
    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) [COLOR=#000000][I]End Function[/I][/COLOR]

Các thầy cô & anh chị cho em hỏi Code trên (bài #1) chỉ kiểm tra Serial HDD của Win 32 bit, nó kg kiểm tra được win 64 bit
Em muốn code trên kiểm tra được đổng thời Win 32 & Win 64 thì code sửa như thế nào?
Em cảm ơn!

hungpecc1 · 25/3/13

Hong.Van đã viết:
Các thầy cô & anh chị cho em hỏi Code trên (bài #1) chỉ kiểm tra Serial HDD của Win 32 bit, nó kg kiểm tra được win 64 bit
Em muốn code trên kiểm tra được đổng thời Win 32 & Win 64 thì code sửa như thế nào?
Em cảm ơn!

Thử code này xem, mình vẫn hay dùng code này --> chưa kiểm tra trên 64bits

[GPECODE=vb]
Function GetDriveSerialNumber(Optional ByVal DriveLetter As String) As Long
Dim fso As Object, Drv As Object
Set fso = CreateObject("Scripting.FileSystemObject")
If DriveLetter <> "" Then
Set Drv = fso.GetDrive(DriveLetter)
Else
Set Drv = fso.GetDrive(fso.GetDriveName(Application.Path))
End If
With Drv
If .IsReady Then
DriveSerial = Abs(.SerialNumber)
Else
DriveSerial = -1
End If
End With
Set Drv = Nothing
Set fso = Nothing
GetDriveSerialNumber = DriveSerial
End Function
[/GPECODE]

Hong.Van · 25/3/13

hungpecc1 đã viết:
Thử code này xem, mình vẫn hay dùng code này --> chưa kiểm tra trên 64bits

Đã kiểm tra, chạy OK !

MrTeCong · 5/1/15

ndu96081631 đã viết:
Thì cứ viết bình thường thôi... Tôi không nghĩ là bạn không làm được
ví dụ:

Mã:

Sub Auto_Open() Dim sSeri As String sSeri = doc_ma_dia If sSeri <> "S01JJ40Y233766" And sSeri <> "K12PAK5G" Then ThisWorkbook.Close False End Sub

Đại khái vậy

Thầy cho em hỏi !
Sao em copy dán phần code thầy cho vào nhưng vẫn vào file bình thường ko bị chặn ạ !$@!!

hungpecc1 · 5/1/15

MrTeCong đã viết:
Thầy cho em hỏi !
Sao em copy dán phần code thầy cho vào nhưng vẫn vào file bình thường ko bị chặn ạ

Seri của mỗi máy là duy nhất, do đó bạn phải xem seri của máy mình là bn --> thay vào chỗ bôi đỏ :
If sSeri <> "S01JJ40Y233766" And sSeri <> "K12PAK5G" Then ThisWorkbook.Close False

cụ thể hơn bạn phải copy cả đoạn code sau đây mới chuẩn :

Mã:

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

Sub Auto_Open()
  Dim sSeri As String
  sSeri = doc_ma_dia
  If sSeri <> "S01JJ40Y233766" And sSeri <> "K12PAK5G" Then ThisWorkbook.Close False
End Sub

MrTeCong · 7/1/15

Như thế này là nó báo lỗi gì ạ ? +-+-+-+

Hong.Van · 8/1/15

MrTeCong đã viết:
View attachment 135012
Như thế này là nó báo lỗi gì ạ ?

Bạn đưa file demo lên!

MrTeCong · 8/1/15

Đây bạn ! pass đăng nhập admin là 1 - !$@!!

hungpecc1 · 8/1/15

MrTeCong đã viết:
Đây bạn ! pass đăng nhập admin là 1 -

vẫn bình thường có lỗi gì đâu ?
Do các dòng lệnh bạn copy paste nên không đúng về cú pháp ! cú pháp chuẩn phải là :

Mã:

Function doc_ma_dia() ' phải viết xuống dòng'
Dim ObjetoWMI As Object
.......................................

Làm để File XYZ chạy được ở Máy tính A hoặc B , nhưng không cho chạy ở Máy tính khác!

Busy

Thành viên gạo cội

Huyền thoại GPE

VBA & VB.NET for Excel & AutoCad

Busy

Huyền thoại GPE

VBA & VB.NET for Excel & AutoCad

Thành viên gắn bó

Busy

Thành viên gắn bó

Ăn cùng góc phố

Busy

Thành viên gắn bó

Busy

Thành viên mới

Thành viên gắn bó

Thành viên mới

Busy

Thành viên mới

File đính kèm

Thành viên gắn bó

Facebook

Group