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!

4 Responses

1. hands says:

   22/12/2022 at 2:27 pm

   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!

   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

   Reply
2. hands says:

   22/12/2022 at 2:30 pm

   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!

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

   [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!

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

   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

   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 :

   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

   http://www.giaiphapexcel.com/diendan/threads/l%C3%A0m-%C4%91%E1%BB%83-file-xyz-ch%E1%BA%A1y-%C4%91%C6%B0%E1%BB%A3c-%E1%BB%9F-m%C3%A1y-t%C3%ADnh-a-ho%E1%BA%B7c-b-nh%C6%B0ng-kh%C3%B4ng-cho-ch%E1%BA%A1y-%E1%BB%9F-m%C3%A1y-t%C3%ADnh-kh%C3%A1c.77347/post-484531

   Reply
3. hands says:

   22/12/2022 at 2:38 pm

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

   83DPESTGS

   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!

   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 ?

   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 :p, công ty có sử dụng Active Directory hay SharePoint ko .

   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?

   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ỗ

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

   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ứ

   Có chứ. Mình copy phần đó vào ThisWorkbook, và insert moduleMì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

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

   http://www.giaiphapexcel.com/diendan/threads/l%C3%A0m-%C4%91%E1%BB%83-file-xyz-ch%E1%BA%A1y-%C4%91%C6%B0%E1%BB%A3c-%E1%BB%9F-m%C3%A1y-t%C3%ADnh-a-ho%E1%BA%B7c-b-nh%C6%B0ng-kh%C3%B4ng-cho-ch%E1%BA%A1y-%E1%BB%9F-m%C3%A1y-t%C3%ADnh-kh%C3%A1c.77347/post-630075

   Reply
4. hands says:

   22/12/2022 at 2:39 pm

   File này nè bạn. Mở lên là nó đóng lại ngay.
   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 Auto_Open()
     Dim sSeri As String
     sSeri = doc_ma_dia
     If sSeri <> "[COLOR=#ff0000]SOYXJ10P610780[/COLOR]" 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.

   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.

   Thôi thì dùng thủ cách khác
   [URL='https://www.giaiphapexcel.com/forum/showthread.php?99550-Kh%C3%B4ng-bi%E1%BA%BFt-c%C3%B3-h%C3%A0m-n%C3%A0o-tr%E1%BA%A3-v%E1%BB%81-t%C3%AAn-m%C3%A1y-t%C3%ADnh-hay-t%C3%AAn-ng%C6%B0%E1%BB%9Di-d%C3%B9ng']https://www.giaiphapexcel.com/forum/showthread.php?99550-Không-biết-có-hàm-nào-trả-về-tên-máy-tính-hay-tên-người-dùng

   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

   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.

   http://www.giaiphapexcel.com/diendan/threads/l%C3%A0m-%C4%91%E1%BB%83-file-xyz-ch%E1%BA%A1y-%C4%91%C6%B0%E1%BB%A3c-%E1%BB%9F-m%C3%A1y-t%C3%ADnh-a-ho%E1%BA%B7c-b-nh%C6%B0ng-kh%C3%B4ng-cho-ch%E1%BA%A1y-%E1%BB%9F-m%C3%A1y-t%C3%ADnh-kh%C3%A1c.77347/post-630282

   Reply