Foxtable(狐表) → 用户栏目 → 专家坐堂 → 代码有误吗？


  共有1990人关注过本帖树形打印复制链接

主题：代码有误吗？
帅哥哟，离线，有人找我吗？
yongxuanchen
 小大  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：童狐 帖子：238 积分：1986 威望：0 精华：0 注册：2015/2/16 13:29:00 		代码有误吗？  发帖心情 Post By：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
 回到顶部
帅哥哟，离线，有人找我吗？
大红袍
 小大  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：贵宾 帖子：39310 积分：196782 威望：0 精华：1 注册：2015/4/25 9:23:00 		  发帖心情 Post By：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
 小大  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：童狐 帖子：238 积分：1986 威望：0 精华：0 注册：2015/2/16 13:29:00 		网址不存在，报错  发帖心情 Post By：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
 回到顶部
帅哥哟，离线，有人找我吗？
大红袍
 小大  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：贵宾 帖子：39310 积分：196782 威望：0 精华：1 注册：2015/4/25 9:23:00 		  发帖心情 Post By：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
 小大  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：童狐 帖子：238 积分：1986 威望：0 精华：0 注册：2015/2/16 13:29:00 		程序报错  发帖心情 Post By：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
 回到顶部
帅哥哟，离线，有人找我吗？
大红袍
 小大  6楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：贵宾 帖子：39310 积分：196782 威望：0 精华：1 注册：2015/4/25 9:23:00 		  发帖心情 Post By：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

 回到顶部
RSS2.0 | Xhtml无图版 | Xslt无图版 Copyright © 2000 - 2018 foxtable.com Tel: 4000-810-820 粤ICP备11091905号
   Powered By Dvbbs Version 8.3.0
页面执行时间 0.04688 秒, 4 次数据查询