100分送给第一个解决问题的人！
十分郁闷帖子逗留在这几天还是什么人踩，或许分数看不起眼，绝望之中加分到极限（本人剩下几分钱，可怜一下吧）。如题，我的问题看起来简单，可是实现起并不容易，高手们不要太小看这个问题，起码我已经写了N遍代码，别人也提过很多意见，但是到现在还是无法完成我所需要的效果。问题如下：程序第一次运行时，运行注册窗口，此时注册表中没有键值项，在成功登录后往注册表写进信息，所以第二次登录需要验证，如果注册表中的内容符合条件则进入主窗口，否则再次进入注册窗口,现在的问题是验证方面总是不过关，无论注册表的项值如何，总是跳到frmzc这个窗口。 Val(StrReverse(Str(Reg_C)) + 520)我要实现的效果就是这个，注册码的值就是将机器码的值倒过来，再加上520的值。
代码部分参考如下：
注册模块并非自己所写，只看懂七八成，我只是修改了原代码中的一小部分（主要是外观部分）可是如果单独运行可以顺利通过，如果觉得这个模块有问题，可以提出高见。
详细说明
’窗体 frmzc为注册窗口 text1显示硬盘序列号 text2为验证码部分 cmdzc为注册命令按钮 cmdlk为退出命令按钮 frmmain为主窗口（此窗体无内容）
''此模块的作用是检测用程序所在机器C盘序列号并存入一个加密后的文本文件yibao.ini中，
''在每次运行时检测C盘序列号并与加密文本文件中的相应值进行比较如果不符提示用户进行注册
Public Function Jia_Mi_Txt()
Reg_C = Abs(GetSerialNumber("c:\"))
If Dir(App.Path & "\yibao.ini") = "" Then
''建立一个文本文件
Open App.Path & "\yibao.ini" For Output As #1
Print #1, "00000000"
Close #1
End If
Jia_Mi_File = App.Path & "\yibao.ini"
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Ctf = Fso.OpenTextFile(Jia_Mi_File, 1) ''建立 TextStream 对象 CTF
Jia_Mi_Char = ""
Do While Ctf.AtEndOfStream <> True
Jia_Mi_Char = Jia_Mi_Char & Chr(58 Xor Asc(Ctf.Read(1)))
Loop
Ctf.Close
Set Ctf = Nothing
If Jia_Mi_Char <> Int(Reg_C * 18 / 22 * 16 / 19) Then
''显示注册对话框
frmzc.Show
End If
End Function
Function GetSerialNumber(sroot As String) As Long
Dim lserialnum As Long
Dim r As Long
Dim strlabel As String, strtype As String
strlabel = String$(255, Chr$(0))
strtype = String$(255, Chr$(0))
r = GetVolumeInformation(sroot, strlabel, Len(strlabel), lserialnum, 0, 0, strtype, Len(strtype))
GetSerialNumber = lserialnum
''在 strLabel 中为磁盘卷标
''在 strType 中为文件系统类型
End Function
Private Sub cmdlk_Click()
End
End Sub
Private Sub cmdzc_Click()
Dim a As String
a = Val(StrReverse(Str(Reg_C)) + 520)
If Text2.Text = a Then
SaveSetting "wbpjytl", "settings", "key", a
MsgBox "谢谢您的注册！", vbOKOnly, "注册成功"
Unload Me
frmmain.Show
Else
MsgBox "注册码有误，请查证后重新输入！", vbOKOnly, "注册失败"
Text2.SetFocus
End If
End Sub
Private Sub Form_Activate()
Text1.Text = Reg_C
Text2.SetFocus
End Sub
Private Sub Form_Load()
Jia_Mi_Txt
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then cmdzc_Click
End Sub
‘模块
这是我写的其中一个代码，各位可做参考
Public Reg_C As String
Public Reg_Key As Long
Public Jia_Mi_File As String
Public Jia_Mi_Char As String
Public Fso As New FileSystemObject
Public Ctf As TextStream
Public Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Public Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
Sub Main()
On Error Resume Next
Dim key As String
Set wsh = CreateObject("wscript.shell")
key = wsh.RegRead("HKEY_CURRENT_USER\Software\VB and VBA Program Settings\wbpjytl\settings\key")
If Err.Number <> 0 Then
Load frmzc
Else
If key = Val(StrReverse(Str(Reg_C)) + 520) Then
Load frmmain
Else
Load frmzc
End If
End If
End Sub
备注：引用wsh,启动窗口为sub main()。写得很详细，不该说明都说明了，我这么有诚意，希望大家用心帮我写验证方面的代码，最好经过测试后再写出来。谢绝给我发其他注册方面的代码。我是个比较挑剔的人，这个问题得不到解决我总放不下心，况且这个问题也是个常见的问题，一定要弄懂才罢手,期待中。。。 --------------------编程问答-------------------- 又是注册表，又是配置文件。。。好乱。
卷序列号在格式化硬盘后会改变，所以不用这个做序列号。
你想做什么功能？ --------------------编程问答-------------------- ......... --------------------编程问答-------------------- 记得AsiaC对注册表挺熟的，也许他能帮你。 --------------------编程问答-------------------- 為了你這100分，下班回家整整看 --------------------编程问答-------------------- 先说你的问题：
从你的Sub Main中看不到你的Reg_C是从哪里初始化的，所以可能问题出在这里，请检查下。
然后，说说逻辑的问题，If key = Val(StrReverse(Str(Reg_C)) + 520) Then 这个地方逻辑似乎不太好，因为一些时候，如果有反编译你程序的，你这里暴露了有效注册的KEY。另外这里如果出现了组件无法调用的错误，也会要求重新注册，这个不太合理，不能说对方没有通过验证注册。
回到你的问题，如果你要用这种逻辑验证，你可以直接使用GetSetting这个VB默认的函数，也可以直接获得注册表键值。这样就可以不用使用其他组件了，对于程序来说，尽量使用少的技术少的组件会使你的程序更健壮。
祝好运！ --------------------编程问答-------------------- 汗，3楼好像把AC的ID拼错了。 --------------------编程问答--------------------
你拼的那是"亚热"…… --------------------编程问答-------------------- 下回记住了，艾萨C
--------------------编程问答--------------------
key = Val(StrReverse(Str(Reg_C)) + 520) 目前程序运行到这里的时候，KEY的值是什么？
Val(StrReverse(Str(Reg_C)) + 520) 又是什么？
你该先找到问题点，然后再想办法
不然就知道不通过，眉毛胡子一把抓怎么行？
--------------------编程问答-------------------- 顶 --------------------编程问答-------------------- 描述太长咯
浪费时间啊 --------------------编程问答--------------------
谢谢1楼提示，我查了下网上资料，我那个只是逻辑序列号确实可以改，不过我也找到个获取物理序列号那个就是唯一的了。这个加密代码我自己搞定，关键是麻烦大家给个验证的代码，最好注释一下。。。 --------------------编程问答-------------------- 谢谢5楼的高见，确实使我这只菜鸟有所感悟，应该是reg_c初始化的问题。逻辑上的原因确实我没注意到，不过据你所说那种可能性应该不大吧，学习下。。。说到底我最终要实现的目的是可以在验证过后不用再次提示注册窗口，至于方法可以不择手段，但是数据应该保存在注册表比较安全，大家随意发挥得了，不过尽量写得简单点起码我可以学到一些（^-^)。至于被反编译的问题我并不是很担心，因为我的软件并非很高级，加个注册保护是一种手段而已，起码可以起到一些保护版权的作用，随后感谢你给我的一些编程建议。。。 --------------------编程问答-------------------- 按照你的写法，这个可以取得注册表里的key
key = GetSetting("HKEY_CURRENT_USER\Software\VB and VBA Program Settings\wbpjytl\settings\key")
至于REG_C，你自己看着写下如何获得吧。 --------------------编程问答-------------------- 前一个问题号称“绞尽乳汁”了，结果没有讲清楚就无满意答案结帖了。
建议先看看提问的智慧。 --------------------编程问答-------------------- COPY了楼主的代码运行，注册后再次运行可以跳转到frmmain，没有楼主所说的总是验证不过去的情况出现
楼主你的问题是什么？ --------------------编程问答-------------------- 汗！原来楼主加了On Error Resume Next --------------------编程问答-------------------- 飘过 --------------------编程问答--------------------
兄台你不是开玩笑的吧，我试了这么多次都不行就因为on error resume next.
我刚才照你说的试了也是不行，除非你改了代码。
--------------------编程问答-------------------- 我把代碼都給刪了，看樣子還得再在樓主那COPY一次 --------------------编程问答-------------------- frmzc
Option Explicit
Public Function Jia_Mi_Txt()
Reg_C = Abs(GetSerialNumber("c:\"))
If Dir(App.Path & "\yibao.ini") = "" Then
'膘蕾珨跺恅掛恅璃
Open App.Path & "\yibao.ini" For Output As #1
Print #1, "00000000"
Close #1
End If
Jia_Mi_File = App.Path & "\yibao.ini"
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Ctf = Fso.OpenTextFile(Jia_Mi_File, 1) '膘蕾textstream勤砓CTF
Jia_Mi_Char = ""
Do While Ctf.AtEndOfStream <> True
Jia_Mi_Char = Jia_Mi_Char & Chr(58 Xor Asc(Ctf.Read(1)))
Loop
Ctf.Close
Set Ctf = Nothing
If Jia_Mi_Char <> Int(Reg_C * 18 / 22 * 16 / 19) Then
'珆尨蛁聊勤趕遺
frmzc.Show
End If
End Function
Function GetSerialNumber(sroot As String) As Long
Dim lserialnum As Long
Dim r As Long
Dim strlabel As String, strtype As String
strlabel = String$(255, Chr$(0))
strtype = String$(255, Chr$(0))
r = GetVolumeInformation(sroot, strlabel, Len(strlabel), lserialnum, 0, 0, strtype, Len(strtype))
GetSerialNumber = lserialnum
'婓strLabel笢峈棠攫橙梓
'婓strType笢峈恅璃炵苀濬倰
End Function
Private Sub cmdlk_Click()
End
End Sub
Private Sub cmdzc_Click()
Dim a As String
a = Val(StrReverse(Str(Reg_C)) + 520)
If Text2.Text = a Then
SaveSetting "wbpjytl", "settings", "key", a
Call setKey(Reg_C) '加了這一句
MsgBox "郅郅蠟腔蛁聊ㄐ", vbOKOnly, "蛁聊傖髡"
Unload Me
frmmain.Show
Else
MsgBox "蛁聊鎢衄昫ㄛ脤痐綴笭陔怀", vbOKOnly, "蛁聊囮啖"
Text2.SetFocus
End If
End Sub
Private Sub Form_Activate()
Text1.Text = Reg_C
Text2.SetFocus
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then cmdzc_Click
End Sub
Private Sub Form_Load()
Jia_Mi_Txt
End Sub
Module1
--------------------编程问答-------------------- 程序稍微改了一下，隻能說是解決了樓主提出的驗証不能通過的問題
Option Explicit
Public Reg_C As String
Public Reg_Key As Long
Public Jia_Mi_File As String
Public Jia_Mi_Char As String
Public Fso As New FileSystemObject
Public Ctf As TextStream
Public Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Public Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
Sub Main()
'On Error Resume Next
Dim key As String
Dim wsh
Set wsh = CreateObject("wscript.shell")
key = wsh.RegRead("HKEY_CURRENT_USER\Software\VB and VBA Program Settings\wbpjytl\settings\key")
If Err.Number <> 0 Then
Load frmzc
Else
Reg_C = getKey
If Reg_C <> "" Then
If key = Val(StrReverse(Str(Reg_C)) + 520) Then
frmmain.Show
Else
frmzc.Show
End If
Else
frmzc.Show
End If
End If
End Sub
Private Function getKey()
Dim FileNo As Integer
If Dir(App.Path & "\yibao.ini") = "" Then
getKey = ""
Exit Function
End If
FileNo = FreeFile
Open App.Path & "\yibao.ini" For Input As FileNo
Do While Not EOF(FileNo)
Line Input #FileNo, getKey
Exit Do
Loop
Close #FileNo
End Function
Public Sub setKey(strKey As String)
Dim FileNo As Integer
FileNo = FreeFile
Open App.Path & "\yibao.ini" For Output As FileNo
Print #FileNo, strKey
Close #FileNo
End Sub
要想真正用，這代碼還得改，並且要改的地方還不少
還有，既然用到了ini文件，最好能用ini的格式來保存數據，以及用專門的API來讀取 --------------------编程问答--------------------
怎么我试了还是不行，我一字不漏粘贴进去的啊，应该不是我机子的问题吧，另外楼主给的代码中那些中文怎么都是乱码？ --------------------编程问答-------------------- 提示类型不匹配，实时错误13。调试点：If Jia_Mi_Char <> Int(Reg_C * 18 / 22 * 16 / 19) Then --------------------编程问答-------------------- 把出错的这一句改成：If Jia_Mi_Char <> CStr(Reg_C * 18 / 22 * 16 / 19) Then
你的Jia_Mi_Char是定义成String,而int()返回的是int型的
因为我是在繁体系统中改的，所以会是乱码，你照着你原来的代码把乱码改过来就是 --------------------编程问答-------------------- 关注！ --------------------编程问答--------------------
阁下确实厉害，我的问题一击即中，可否告知我的代码为什么验证不过，你添加了什么代码？还有一个问题，你是不是认为不能加on error resume next,我试过不加的话下次登录会报错。 --------------------编程问答--------------------
厉害，学习了 --------------------编程问答-------------------- 嗯，有搞头 --------------------编程问答--------------------
Private Function getKey()
Dim FileNo As Integer
If Dir(App.Path & "\yibao.ini") = "" Then
getKey = ""
Exit Function
End If
FileNo = FreeFile
Open App.Path & "\yibao.ini" For Input As FileNo
Do While Not EOF(FileNo)
Line Input #FileNo, getKey
Exit Do
Loop
Close #FileNo
End Function
Public Sub setKey(strKey As String)
Dim FileNo As Integer
FileNo = FreeFile
Open App.Path & "\yibao.ini" For Output As FileNo
Print #FileNo, strKey
Close #FileNo
End Sub
就是添加了两个函数，一个是从文件中读取，一个是写入
在你的那段代码中是要加on error resume next才行的，要不当机码不存在会报错，
其实VB有专门操作注册表的API，其中就包括验证其个机码是否存在
你的代码为什么验证不过：因为你只取了注册表中的值，而没有取.ini中的值，那你怎么比较？
一个有值一个没值当然是不相等的了 --------------------编程问答-------------------- 顺便说一下，加on error resume next不是一种很好的捕捉错误的方法，虽然程序运行时不会出现错误
但也就看不到错误的所在，存在风险 --------------------编程问答-------------------- 兄台你的原理是说得通 可是我检查后发现你在INI文件中写进了机器码 这样岂非失去了意义，也就是不能够把我的验证代码全部写进注册表，而且把我的加密文件的第一行给覆盖了，难道就没有其他办法把所有验证代码写进注册表吗，这才是我要实现的最终目的。还有一个问题差点忘说了：如果我在SUB MAIN()中的代码直接用key=str(reg_c)可以直接通过验证，就是在前面加上一些其他函数就会导致验证不过。 --------------------编程问答-------------------- 无语中 --------------------编程问答-------------------- 乱 --------------------编程问答-------------------- 那可能是理解错楼主的意思了 --------------------编程问答-------------------- 哎没有高手了么，如果分数不够那我没办法了哦。。。
补充：VB , 基础类
