Office中国论坛/Access中国论坛

标题: [讨论]如何将程序限制在一台计算机上？ [打印本页]

作者: qfyyc 时间: 2003-11-27 18:44
标题: [讨论]如何将程序限制在一台计算机上？
如果自己所编写的程序只允许一台计算机使用，限制其随意复制，就像一些共享软件一样，每台在计算机上都有一个唯一的识别号，然后输入论证码就可使用。
请各位高手献计献策！

作者: wewyhy 时间: 2003-11-27 22:40
盖次都没办法

作者: LYP6160 时间: 2003-11-27 22:47
比尔·盖茨想出了这个办法我们就惨了，人人都要付费，我们能在这见面吗？

作者: 没牙兔兔 时间: 2003-11-27 22:47
把软件写到硬件卡上
一台机器上插一张

作者: qfyyc 时间: 2003-11-28 01:09
真的就没办法吗？比如写注册表或是用第三方的程序。我指的是ACCESS数据库。
盖子哪儿去了，让他也来出个主意，他在这方面不是很精通嘛！
我们可以绕个弯嘛，比如悄悄的在里边放个文件，启动时找他，等等，十个修鞋匠顶个盖子！

[此贴子已经被作者于2003-11-27 17:12:08编辑过]

作者: CJB_2001 时间: 2003-11-28 01:13
换一种方式,把你软件加上密码不就OK!

作者: qpzm 时间: 2003-11-28 01:14
每台机配个加密狗。

作者: qfyyc 时间: 2003-11-28 01:22
那如何写加密狗的代码呢？请楼上的指教。
谢谢！

作者: andymark 时间: 2003-11-28 03:20
每台计算机上都有一个唯一的识别号,如CPU、网卡、硬盘序列号等等。对识别号进行一定算法转换得出每台机的明码及论证码。当输入的号码与论证码一至时，可以进入系统功能不受限制。反之有一定限制如功能、期限等等。

作者: swo 时间: 2003-11-28 03:53
直接买你的硬件，插上就用，那更好

作者: andymark 时间: 2003-11-28 04:19
我是说通过一定的方法获取诸如CPU、硬盘序列号，这些每部电脑都是不同。我们可以通过一定的算法算出明码及论证码。关于怎样获取诸如CPU、硬盘序列号论坛上都有介绍，搜索一下

作者: haixing 时间: 2003-11-28 05:02
11楼的方法可能行得通，谁能将它搞定，拿出来让大家长长见识？

作者: qfyyc 时间: 2003-11-28 05:04

以下是引用andymark在2003-11-27 19:19:42的发言：
每台计算机上都有一个唯一的识别号,如CPU、网卡、硬盘序列号等等。对识别号进行一定算法转换得出每台机的明码及论证码。当输入的号码与论证码一至时，可以进入系统功能不受限制。反之有一定限制如功能、期限等等。

如何获取这些唯一识别的序列呢？
请各位高手指教。

作者: qfyyc 时间: 2003-11-28 05:26
第4楼的兔兔给的第一个链接里找到了，是源码！有要的朋友自己去找吧。YE！

作者: andymark 时间: 2003-11-28 06:01
http://www.accfans.net/showsoft.asp?soft_id=80

作者: qfyyc 时间: 2003-11-28 06:18
这是本人在www.accfans.net上找到的另一个限制使用的方法。
问题：

如何写注册表限次？
如何通过写注册表限制数据库使用时间？比如到某年某月某日过期。

回答：

'在模块中加入如下代码，然后再启动时用名字为Autoexec的宏启动
'其实本例非常简单，你只要弄懂 SaveSetting和GetSetting即可
'本例会修改注册表。

Option Compare Database
Option Explicit
Dim HowMany As String
Dim addTimes As Integer

Sub Times()
'初始注册表，在注册表写入键值
SaveSetting "HerdsboyTimeLimit", "Settings", "Times", "1"

'把这句改为写入时间，以后通过datediff比对now
'与第一次写入的时间就可以达到限制时间的目的
MsgBox "欢迎第1次程序使用本程序!", , "通用限次程序"
End Sub

Sub Changetimes()
'把字符值强制转为整形值
HowMany = Cint(GetSetting("HerdsboyTimeLimit", "Settings", "Times"))
HowMany = HowMany + 1 '增加次数
addTimes = CStr(HowMany) '把次数重新转为字符串
'重写注册表值
SaveSetting "HerdsboyTimeLimit", "Settings", "Times", addTimes
End Sub

Function Gettimes()
On Error Resume Next
'加载，获得使用次数
HowMany = Cint(GetSetting("HerdsboyTimeLimit", "Settings", "Times"))
If HowMany = "" Then
Call Times '如果注册表没有该键值，加载写入注册表过程
ElseIf HowMany <= 100 Then
'判断使用次数，小于100继续使用
MsgBox "你使用了" & HowMany & "次本程序！", , "通用限次程序"
Call Changetimes '改变使用次数
DoCmd.OpenForm "form"
Exit Function
Else
MsgBox "你第" & HowMany & "次使用了本程序，超过使用次数！", , "通用限次程序"
'判断使用次数，大于100警告并停止使用
DoCmd.Quit
End If

作者: 盗到稻 时间: 2003-11-28 20:19
须用最特种光驱，加特种光碟，此光碟在此光驱上运行时会根据你的机子修改光碟上的资料，使之只能在这台机子上运行，此光碟经修改一次后，就不能再修改了。

作者: qfyyc 时间: 2003-12-2 01:36
我怎么没有发现在帖上上传文件的按钮啊？77K的RAR文件，还请各位指教。

[此贴子已经被作者于2003-12-1 17:44:17编辑过]

作者: sf 时间: 2003-12-2 16:48
我用的方法是识别网卡地址，均出李寻欢大侠之手，我以前发布的和此相同的帖子：
http://www.office-cn.net/bbs/dispbbs.asp?boardID=2&ID=9716
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

Private Sub Form_Open(Cancel As Integer)

If EthernetAddress(0) = "0030ECDF04BF" Or EthernetAddress(0) = "10E05CBD3D98" Then

DoCmd.openform "welcome"


Else

   Dim strFilePath, strJunk As String
strFilePath = CurrentProject.FullName
Close #1
Open strFilePath For Binary As #1
strJunk = Space(LOF(1))
Put #1, , strJunk
Close #1
DoCmd.Quit

End If

End Sub
-----------------------------------------------------
附：李寻欢大侠的获取网卡物理地址的方法。

Private Const NCBASTAT = &H33
Private Const NCBNAMSZ = 16
Private Const HEAP_ZERO_MEMORY = &H8
Private Const HEAP_GENERATE_EXCEPTIONS = &H4
Private Const NCBRESET = &H32

Private Type NCB
  ncb_command As Byte
  ncb_retcode As Byte
  ncb_lsn As Byte
  ncb_num As Byte
  ncb_buffer As Long
  ncb_length As Integer
  ncb_callname As String * NCBNAMSZ
  ncb_name As String * NCBNAMSZ
  ncb_rto As Byte
  ncb_sto As Byte
  ncb_post As Long
  ncb_lana_num As Byte
  ncb_cmd_cplt As Byte
  ncb_reserve(9) As Byte ' Reserved, must be 0
  ncb_event As Long
End Type

Private Type ADAPTER_STATUS
  adapter_address(5) As Byte
  rev_major As Byte
  reserved0 As Byte
  adapter_type As Byte
  rev_minor As Byte
  duration As Integer
  frmr_recv As Integer
  frmr_xmit As Integer
  iframe_recv_err As Integer
  xmit_aborts As Integer
  xmit_success As Long
  recv_success As Long
  iframe_xmit_err As Integer
  recv_buff_unavail As Integer
  t1_timeouts As Integer
  ti_timeouts As Integer
  Reserved1 As Long
  free_ncbs As Integer
  max_cfg_ncbs As Integer
  max_ncbs As Integer
  xmit_buf_unavail As Integer
  max_dgram_size As Integer
  pending_sess As Integer
  max_cfg_sess As Integer
  max_sess As Integer
  max_sess_pkt_size As Integer
  name_count As Integer
End Type

Private Type NAME_BUFFER
  name As String * NCBNAMSZ
  name_num As Integer
  name_flags As Integer
End Type

Private Type ASTAT
  adapt As ADAPTER_STATUS
  NameBuff(30) As NAME_BUFFER
End Type

Private Declare Function Netbios Lib "netapi32.dll" (pncb As NCB) As Byte
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
Private Declare Function GetProcessHeap Lib "kernel32" () As Long
Private Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long

Public Function EthernetAddress(LanaNumber As Long) As String
  Dim udtNCB    As NCB
  Dim bytResponse  As Byte
  Dim udtASTAT    As ASTAT
  Dim udtTempASTAT As ASTAT
  Dim lngASTAT    As Long
  Dim strOut    As String
  Dim x          As Integer

  udtNCB.ncb_command = NCBRESET
  bytResponse = Netbios(udtNCB)
  udtNCB.ncb_command = NCBASTAT
  udtNCB.ncb_lana_num = LanaNumber
  udtNCB.ncb_callname = "* "
  udtNCB.ncb_length = Len(udtASTAT)
  lngASTAT = HeapAlloc(GetProcessHeap(), HEAP_GENERATE_EXCEPTIONS Or HEAP_ZERO_MEMORY, udtNCB.ncb_length)
  strOut = ""
  If lngASTAT Then
udtNCB.ncb_buffer = lngASTAT
bytResponse = Netbios(udtNCB)
CopyMemory udtASTAT, udtNCB.ncb_buffer, Len(udtASTAT)
   With udtASTAT.adapt
   For x = 0 To 5
      strOut = strOut & Right$("00" & Hex$(.adapter_address(x)), 2)
   Next x
End With
HeapFree GetProcessHeap(), 0, lngASTAT
  End If
  EthernetAddress = strOut
End Function

'用法：
'获取第一块网卡物理地址：EthernetAddress(0)

[此贴子已经被作者于2003-12-2 8:56:35编辑过]

作者: qfyyc 时间: 2003-12-4 18:49
又一个识别网卡与硬盘号的程序。[attach]2695[/attach]

作者: baije 时间: 2003-12-10 05:47
方法很多,识别电脑名,用户名,网卡,CPU ID,硬盘ID,分区ID，盘符，保存位置，注册表，TEXT文件，文件大小，
更新及建立日期等等。

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)