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! (1 người xem)

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
.......................................

MrTeCong · 9/1/15

sao file vẫn cứ vào ào ào, mặc dù mình không để đúng seri của máy nhỉ ?

hungpecc1 · 9/1/15

MrTeCong đã viết:
sao file vẫn cứ vào ào ào, mặc dù mình không để đúng seri của máy nhỉ ?

Cho hỏi seri máy tính bạn đang dùng có thông tin như thế nào ?

MrTeCong · 9/1/15

83DPESTGS

Mình lấy bằng file này !$@!!

huuhien80 · 11/1/15

Nếu lấy mã ổ C thì trường hợp giống nhau sẽ phổ biến, ví dụ lên mạng tải chung 1 bản ghost WIn 7 thì tất cả những máy dùng bản ghost đấy đều có chung mã của ổ C.

Hong.Van · 11/1/15

MrTeCong đã viết:
Mình lấy bằng file này

bạn đâu có add code ở các bài trên vào file đâu!!!
Thử lại với file này!

MrTeCong · 16/1/15

Hong.Van đã viết:
bạn đâu có add code ở các bài trên vào file đâu!!!
Thử lại với file này!

Thanks bạn !
Cho phép mình hỏi thêm có câu này !
Cũng đoạn code trên giờ mình muốn :
- Vẫn như cũ nhưng thêm là " Nếu đăng nhập bằng nick Admin thì dù ở máy tính nào cũng dùng được " có được ko ?

kuldokk · 17/1/15

Theo em nghĩ, việc phân quyền file này chạy được ở máy này nhưng không chạy được ở máy kia là nhu cầu cần thiết. NHƯNG nếu logic để kiểm tra xem máy có đó có được đọc file được hay không lại nằm chính trong file đó thì việc làm này mang ít ý nghĩa và mất thời gian, tuy nhiên cho mục đích làm cho biết, học hỏi thì OK, còn trong thực tế thì không có tác dụng gì nhiều. Có đọc qua thì thấy code check series của ổ cứng và 1 số code nữa sử dụng win api. Chắc mọi người cũng biết, bản excel dành cho Mac OS cũng hỗ trợ VBA, nếu dùng win api thì chắc chắn sẽ không hoạt động, bởi vì win api chỉ hoạt động trên windows.

Và việc như chị chủ topic nói "[...] 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ụ [...]". Vấn đề nằm ở chỗ quản lý file, ai được nhận file, ai được nhìn thấy file, ai có quyền truy cập file ... Nếu vấn đề như thế này mà người đi làm phải tự giải quyết với nhau thì em xin được phép hỏi là không biết công ty chị có bộ phận IT ko

, công ty có sử dụng Active Directory hay SharePoint ko .

iloveit · 19/1/15

Sao mình thay seri của HDD máy mình vào mà file vẫn không chạy vậy mọi người?

Hong.Van · 20/1/15

iloveit đã viết:
Sao mình thay seri của HDD máy mình vào mà file vẫn không chạy vậy mọi người?

Bạn thay Seri = cách nào? có dùng hàm ở dưới kg?

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

iloveit · 20/1/15

Hong.Van đã viết:

Bạn thay Seri = cách nào? có dùng hàm ở dưới kg?

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

Có chứ. Mình copy phần đó vào ThisWorkbook, và insert module
chỗ Sub Aut

pen()
Dim sSeri As String
sSeri = doc_ma_dia
If sSeri <> "mình đã thay số seri của ổ đĩa vào đây" And sSeri <> "K12PAK5G" Then ThisWorkbook.Close False
End Sub

redosolo · 20/1/15

And sSeri <> "K12PAK5G"
Xóa cái khúc này đi. Bạn đọc thì phải đọc từ đầu tới cuối chứ

iloveit · 20/1/15

redosolo đã viết:
And sSeri <> "K12PAK5G"
Xóa cái khúc này đi. Bạn đọc thì phải đọc từ đầu tới cuối chứ

Mình có đọc mà. Như giải thích ở bài 6 thì chỉ cần đúng 1 trong 2 là được rồi.

Mình làm như bạn nói xóa khúc sau luôn cũng không chạy được. Seri của HDD máy mình là SOYXJ10P610780

redosolo · 20/1/15

Bạn đưa file lên cho dễ xem nào.

Hong.Van · 20/1/15

iloveit đã viết:
Có chứ. Mình copy phần đó vào ThisWorkbook, và insert module

Cái màu đo đỏ bỏ vào module

iloveit · 20/1/15

redosolo đã viết:
Bạn đưa file lên cho dễ xem nào.

File này nè bạn. Mở lên là nó đóng lại ngay.

iloveit · 20/1/15

Phần vào ThisWorkbook:

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

Phần vào module:

Sub Aut

pen()
Dim sSeri As String
sSeri = doc_ma_dia
If sSeri <> "SOYXJ10P610780" And sSeri <> "K12PAK5" Then ThisWorkbook.Close False
End Sub

Chỗ bôi đỏ là seri HDD máy mình. Bỏ phần And sSeri <> "K12PAK5" hay để vẫn không chạy.

redosolo · 20/1/15

Mình nghĩ thì có khi bạn lấy seri HDD bị sai rồi, chứ code thì bình thường mà

iloveit · 20/1/15

redosolo đã viết:
Mình nghĩ thì có khi bạn lấy seri HDD bị sai rồi, chứ code thì bình thường mà

Mình dùng nhiều chương trình khác nhau nó cũng chỉ ra một số đó nên mình nghĩ nó không sai. Mình cũng có dùng file ở bài 23 để lấy số seri.

Máy mình xài bản Win Ghost.

Hong.Van · 21/1/15

iloveit đã viết:
Mình dùng nhiều chương trình khác nhau nó cũng chỉ ra một số đó nên mình nghĩ nó không sai. Mình cũng có dùng file ở bài 23 để lấy số seri.

Máy mình xài bản Win Ghost.

Thôi thì dùng thủ cách khác
http://www.giaiphapexcel.com/forum/...àm-nào-trả-về-tên-máy-tính-hay-tên-người-dùng

Mã:

Function GetComputername()
  Application.Volatile
  GetComputername = Environ("COMPUTERNAME")
End Function
Function GetUserName()
  Application.Volatile
  GetUserName = Environ("USERNAME")
End Function
Sub Auto_Open()
  Dim sSeri As String
  sSeri = GetUserName
  If sSeri <> "TH User" Then ThisWorkbook.Close False
End Sub

iloveit · 21/1/15

Hôm nay đã được rồi, do hàm doc_ma_dia () nó đọc ra số seri có trật tự khác với file ở bài 23 nên nó k chạy. Mình gõ =doc_ma_dia () và thay số đó vào thì chạy ok rồi.

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! (1 người xem)

Người dùng đang xem chủ đề này

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ó

Đang đi tìm hòn đá

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ó

Thành viên mới

Thành viên gắn bó

Thành viên mới

File đính kèm

Thành viên chính thức

Busy

File đính kèm

Thành viên mới

Thành viên hoạt động

Thành viên thường trực

Busy

Thành viên thường trực

Thành viên chính thức

Thành viên thường trực

Thành viên chính thức

Busy

Thành viên thường trực

File đính kèm

Thành viên thường trực

Thành viên chính thức

Thành viên thường trực

Busy

File đính kèm

Thành viên thường trực

Thời gian đếm ngược.