专家坐堂-代码有误吗？Foxtable(狐表) - 新一代数据库软件，完美融合Access、Foxpro、Excel、vb.net之优势，人人都能掌握的快速软件开发工具!

以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.com/bbs/index.asp)
--  专家坐堂  (http://foxtable.com/bbs/list.asp?boardid=2)
----  代码有误吗？  (http://foxtable.com/bbs/dispbbs.asp?boardid=2&id=83838)

--  作者：yongxuanchen
--  发布时间：2016/4/18 13:51:00
--  代码有误吗？

你好，请问下面这段实现注册的代码，不知道为什么时间没到就老弹出了窗口提示注册，不知道为什么，分机用开发版发布的项目出现问题。

web.Refresh
Dim data As String = web.Document.Body.InnerText \' 日期对比

\' Dim Count5 As Integer \'将数据写入到注册表中
\' Count5 = Registry.GetValue("HKEY_CURRENT_USER\\Software\\MyApp","Count5",0)
\' Registry.SetValue("HKEY_CURRENT_USER\\Software\\MyApp","Count5",Count5 + 1) \'注册表

\' Dim a As Integer = GetConfigValue("Count1",1)
Dim Code As String = GetConfigValue("Register" & ComputerId,"")
Dim Ok As Boolean
If Code > "" AndAlso DecryptText(Code,"abc","abc") = ComputerId Then \'如果注册码正确
OK = True
Else
If data>"2016-06-30" Then \'
Forms("注册").Open()
Code = GetConfigValue("Register" & ComputerId,"")
If Code > "" AndAlso DecryptText(Code,"abc","abc") = ComputerId Then \'如果注册码正确
OK = True
End If
End If
If data>"2016-06-30" AndAlso Ok = False Then
Messagebox.Show("您正在使用的产品已经超期!")
Syscmd.Project.Exit()
End If
End If

--  作者：大红袍
--  发布时间：2016/4/18 14:21:00
--

web.Refresh
Dim data As Date = web.Document.Body.InnerText   \' 日期对比
Dim d As Date = "2016-06-30"

Dim Code As String = GetConfigValue("Register" & ComputerId,"")
Dim Ok As Boolean
If Code > "" AndAlso DecryptText(Code,"abc","abc") = ComputerId Then \'如果注册码正确
    OK = True
Else
    If data>d Then   \'
        Forms("注册").Open()
        Code = GetConfigValue("Register" & ComputerId,"")
        If Code > "" AndAlso DecryptText(Code,"abc","abc") = ComputerId Then \'如果注册码正确
            OK = True
        End If
    End If
    If data>d AndAlso Ok = False Then
        Messagebox.Show("您正在使用的产品已经超期!")
        Syscmd.Project.Exit()
    End If
End If

--  作者：yongxuanchen
--  发布时间：2016/4/19 12:58:00
--  网址不存在，报错
http://foxtable.sinaapp.com/time/?f=Y-m-d这个网址是不是不存在了，我更改代码后提示网址不存在，我上去也打不开了，你们的网址改了吗？谢谢

代码
Dim url As String = "http://foxtable.sinaapp.com/time/?f=Y-m-d"
Dim web As New System.Windows.Forms.WebBrowser()
web.Navigate(url)
Do Until web.ReadyState = 4
Application.DoEvents
Loop

--  作者：大红袍
--  发布时间：2016/4/19 14:36:00
--

这个无效了。换一种方式

Dim url As String = "http://api.k780.com:88/?app=life.time&appkey=10003&sign=b59bc3ef6191eb9f747dd4e83c99f2a4&format=json"
Dim rqst As System.Net.HttpWebRequest = System.Net.HttpWebRequest.Create(url)
Dim rsps As System.Net.HttpWebResponse = rqst.GetResponse
Dim stm As System.IO.Stream = rsps.GetResponseStream()
Dim reader As New System.IO.StreamReader(stm)
Dim str As String = reader.ReadToEnd
stm.Dispose()
Output.Show(str)

Dim data As object
Dim JscriptCode = "function toObject(json) {eval(""var o=""+json);return o;}"
Dim ScriptControl = CreateObject("MSScriptControl.ScriptControl")
With ScriptControl
    .Language = "Javascript"
    .Timeout = -1
    .AddCode(JscriptCode)
    data = .Run("toObject", str)
End With

Dim d As Date = data.result.datetime_1
msgbox(d)

--  作者：yongxuanchen
--  发布时间：2016/4/19 16:30:00
--  程序报错

我想要实现第二段代码的原来的功能，现在我用你的这两段代码合起来，程序就报错了。
这段代码能代替吗，语句报错。
Dim url As String = "http://api.k780.com:88/?app=life.time&appkey=10003&sign=b59bc3ef6191eb9f747dd4e83c99f2a4&format=json"
Dim rqst As System.Net.HttpWebRequest = System.Net.HttpWebRequest.Create(url)
Dim rsps As System.Net.HttpWebResponse = rqst.GetResponse
Dim stm As System.IO.Stream = rsps.GetResponseStream()
Dim reader As New System.IO.StreamReader(stm)
Dim str As String = reader.ReadToEnd
stm.Dispose()
Output.Show(str)
Dim data As object
Dim JscriptCode = "function toObject(json) {eval(""var o=""+json);return o;}"
Dim ScriptControl = CreateObject("MSScriptControl.ScriptControl")
With ScriptControl
    .Language = "Javascript"
    .Timeout = -1
    .AddCode(JscriptCode)
    data = .Run("toObject", str)
End With
Dim d As Date = data.result.datetime_1
msgbox(d)

web.Refresh
Dim data As Date = web.Document.Body.InnerText \' 日期对比
Dim d As Date = "2016-06-30"
Dim Code As String = GetConfigValue("Register" & ComputerId,"")
Dim Ok As Boolean
If Code > "" AndAlso DecryptText(Code,"abc","abc") = ComputerId Then \'如果注册码正确
OK = True
Else
If data>d Then \'
Forms("注册").Open()
Code = GetConfigValue("Register" & ComputerId,"")
If Code > "" AndAlso DecryptText(Code,"abc","abc") = ComputerId Then \'如果注册码正确
OK = True
End If
End If
If data>d AndAlso Ok = False Then
Messagebox.Show("您正在使用的产品已经超期!")
Syscmd.Project.Exit()
End If
End If
使用注册语句
Dim url As String = "http://foxtable.sinaapp.com/time/?f=Y-m-d"
Dim web As New System.Windows.Forms.WebBrowser()
web.Navigate(url)
Do Until web.ReadyState = 4
Application.DoEvents
Loop

web.Refresh
Dim data As Date = web.Document.Body.InnerText \' 日期对比
Dim d As Date = "2016-06-30"
Dim Code As String = GetConfigValue("Register" & ComputerId,"")
Dim Ok As Boolean
If Code > "" AndAlso DecryptText(Code,"abc","abc") = ComputerId Then \'如果注册码正确
OK = True
Else
If data>d Then \'
Forms("注册").Open()
Code = GetConfigValue("Register" & ComputerId,"")
If Code > "" AndAlso DecryptText(Code,"abc","abc") = ComputerId Then \'如果注册码正确
OK = True
End If
End If
If data>d AndAlso Ok = False Then
Messagebox.Show("您正在使用的产品已经超期!")
Syscmd.Project.Exit()
End If
End If

--  作者：大红袍
--  发布时间：2016/4/19 16:36:00
--

1、做一个内部函数【获取时间】，填入代码

Dim url As String = "http://api.k780.com:88/?app=life.time&appkey=10003&sign=b59bc3ef6191eb9f747dd4e83c99f2a4&format=json"
Dim rqst As System.Net.HttpWebRequest = System.Net.HttpWebRequest.Create(url)
Dim rsps As System.Net.HttpWebResponse = rqst.GetResponse
Dim stm As System.IO.Stream = rsps.GetResponseStream()
Dim reader As New System.IO.StreamReader(stm)
Dim str As String = reader.ReadToEnd
stm.Dispose()
Output.Show(str)

Dim data As object
Dim JscriptCode = "function toObject(json) {eval(""var o=""+json);return o;}"
Dim ScriptControl = CreateObject("MSScriptControl.ScriptControl")
With ScriptControl
    .Language = "Javascript"
    .Timeout = -1
    .AddCode(JscriptCode)
    data = .Run("toObject", str)
End With

return data.result.datetime_1

2、调用

Dim data As Date = Functions.Execute("获取时间")

Dim d As Date = "2016-06-30"

Dim Code As String = GetConfigValue("Register" & ComputerId,"")

Dim Ok As Boolean

If Code > "" AndAlso DecryptText(Code,"abc","abc") = ComputerId Then \'如果注册码正确

OK = True

Else

If data>d Then \'

Forms("注册").Open()

Code = GetConfigValue("Register" & ComputerId,"")

If Code > "" AndAlso DecryptText(Code,"abc","abc") = ComputerId Then \'如果注册码正确

OK = True

End If

End If

If data>d AndAlso Ok = False Then

Messagebox.Show("您正在使用的产品已经超期!")

Syscmd.Project.Exit()

End If

End If