📄 form3.frm
字号:
VERSION 5.00
Begin VB.Form B_body
BackColor = &H00FFE7C6&
BorderStyle = 3 'Fixed Dialog
Caption = "冰点[BinDNS]免费版"
ClientHeight = 6465
ClientLeft = 4050
ClientTop = 3435
ClientWidth = 9765
Icon = "Form3.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6465
ScaleWidth = 9765
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin VB.CheckBox popupflag
Caption = "Check1"
Height = 255
Left = 6840
TabIndex = 12
Top = 480
Width = 255
End
Begin VB.Timer Timer1
Left = 6240
Top = 480
End
Begin VB.Label datetime
AutoSize = -1 'True
BackStyle = 0 'Transparent
ForeColor = &H00008080&
Height = 180
Left = 1200
TabIndex = 11
Top = 960
Width = 90
End
Begin VB.Label Label4
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "活动时间："
ForeColor = &H00004080&
Height = 180
Left = 300
TabIndex = 10
Top = 960
Width = 900
End
Begin VB.Label act
AutoSize = -1 'True
BackStyle = 0 'Transparent
ForeColor = &H002475FF&
Height = 180
Left = 1200
TabIndex = 9
Top = 720
Width = 90
End
Begin VB.Label domain
AutoSize = -1 'True
BackStyle = 0 'Transparent
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFA902&
Height = 225
Left = 1200
TabIndex = 8
Top = 450
Width = 45
End
Begin VB.Label ip
AutoSize = -1 'True
BackStyle = 0 'Transparent
ForeColor = &H000BD501&
Height = 180
Left = 1200
TabIndex = 7
Top = 240
Width = 90
End
Begin VB.Label com_t4
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "修改密码"
ForeColor = &H00000080&
Height = 180
Left = 4725
TabIndex = 6
Top = 915
Width = 720
End
Begin VB.Label Label3
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "域名状态："
ForeColor = &H00004080&
Height = 180
Left = 300
TabIndex = 5
Top = 720
Width = 900
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "我的域名："
ForeColor = &H00004080&
Height = 180
Left = 300
TabIndex = 4
Top = 480
Width = 900
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "ＩＰ地址："
ForeColor = &H00004080&
Height = 180
Left = 300
TabIndex = 3
Top = 240
Width = 900
End
Begin VB.Label com_t1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "手动刷新"
ForeColor = &H00008000&
Height = 180
Left = 3405
TabIndex = 2
Top = 315
Width = 720
End
Begin VB.Label com_t2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "查看日志"
ForeColor = &H00008080&
Height = 180
Left = 4725
TabIndex = 1
Top = 315
Width = 720
End
Begin VB.Label com_t3
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "重新登陆"
ForeColor = &H00800000&
Height = 180
Left = 3405
TabIndex = 0
Top = 915
Width = 720
End
Begin VB.Image com_1
Height = 330
Left = 3240
Top = 240
Width = 1065
End
Begin VB.Image com_2
Height = 330
Left = 4560
Top = 240
Width = 1065
End
Begin VB.Image com_3
Height = 330
Left = 3240
Top = 840
Width = 1065
End
Begin VB.Image com_4
Height = 330
Left = 4560
Top = 840
Width = 1065
End
Begin VB.Shape Shape1
BackColor = &H00FFFBEE&
BackStyle = 1 'Opaque
BorderColor = &H00008000&
Height = 1215
Left = 120
Top = 75
Width = 2895
End
Begin VB.Menu mnuTray
Caption = "popup"
Visible = 0 'False
Begin VB.Menu mnuTray1
Caption = "※显示界面※"
End
Begin VB.Menu l1
Caption = "-"
End
Begin VB.Menu mnuTray2
Caption = "※修改密码※"
End
Begin VB.Menu mnuTray3
Caption = "※查看日志※"
End
Begin VB.Menu l2
Caption = "-"
End
Begin VB.Menu mnuTray4
Caption = "※手动刷新※"
End
Begin VB.Menu mnuTray5
Caption = "※重新登陆※"
End
Begin VB.Menu l3
Caption = "-"
End
Begin VB.Menu mnuTray6
Caption = "※关于我们※"
End
Begin VB.Menu mnuTray0
Caption = "※退出冰点※"
End
End
End
Attribute VB_Name = "B_body"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'|Download by http://www.codefans.net
'|
'|本代码因为网址接口现在正常使用，所以把网址去掉了，程序是绝对正常使用的
'|
'|本程序的原理就是远程获取网页地址，通过网页来对DNS服务器进行操作。
'|
'|如REG.PHP就是注册接口。
'|
'|网页不能直接对DNS服务器操作,操作有命令。可以通过VB编写DLL来执行命令。
'|
'|其实很简单了。版权的也不要了。嘿嘿。
'|
'|这个版本快被俺丢掉了。要想用免费域名的：）http://www.nouo.com去下载。哇哈哈哈哈
'|
'|嗯嗯。最新的是控制台命令+服务版本。很稳定。。以后有机会公布。
Option Explicit
Public LastState As Integer
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_SYSCOMMAND = &H112
Private Const SC_MOVE = &HF010&
Private Const SC_RESTORE = &HF120&
Private Const SC_SIZE = &HF000&
Dim c_c As Boolean
Dim md5pass As String, a As String, b As String, c As String
Dim date1 As Date
'按钮---start
Private Sub com_1_Click()
com_1.Picture = myf.i3.Picture
mnuTray4_Click
End Sub
Private Sub com_2_Click()
com_2.Picture = myf.i3.Picture
B_ini.Text1 = ""
B_ini.Show
End Sub
Private Sub com_3_Click()
com_3.Picture = myf.i3.Picture
If MsgBox("#重新登陆将停止当前域名的持续解析！" & Chr(13) & Chr(13) & "是否重新登陆？", vbYesNo, "友好提醒") = vbYes Then
myf.Text6.Text = "logout"
RemoveFromTray
mnuTray1_Click
B_login.Show
Me.Hide
End If
End Sub
Private Sub com_4_Click()
com_4.Picture = myf.i3.Picture
B_editpass.Show
End Sub
Private Sub com_t1_Click()
com_1_Click
End Sub
Private Sub com_t2_Click()
com_2_Click
End Sub
Private Sub com_t3_Click()
com_3_Click
End Sub
Private Sub com_t4_Click()
com_4_Click
End Sub
Private Sub com_1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If c_c Then
com_1.Picture = myf.i2.Picture
c_c = False
End If
End Sub
Private Sub com_2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If c_c Then
com_2.Picture = myf.i2.Picture
c_c = False
End If
End Sub
Private Sub com_3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If c_c Then
com_3.Picture = myf.i2.Picture
c_c = False
End If
End Sub
Private Sub com_4_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If c_c Then
com_4.Picture = myf.i2.Picture
c_c = False
End If
End Sub
Private Sub Form_Load()
date1 = Now
Timer1.Interval = 1000
Timer1.Enabled = True
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
com_1.Picture = myf.i1.Picture
com_2.Picture = myf.i1.Picture
com_3.Picture = myf.i1.Picture
com_4.Picture = myf.i1.Picture
c_c = True
End Sub
'按钮---end
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If UnloadMode = 0 Then
Cancel = 1
mnuTray1_Click
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim frm As Form
For Each frm In Forms
If frm.name <> "FrmMain" Then
Call Unload(frm)
End If
Next
End Sub
Private Sub mnuTray1_Click()
If popupflag.Value = 1 Then
Me.Hide
popupflag.Value = 0
mnuTray1.Caption = "※显示界面※"
Else
SendMessage hwnd, WM_SYSCOMMAND, _
SC_RESTORE, 0&
popupflag.Value = 1
mnuTray1.Caption = "※隐藏界面※"
End If
End Sub
Private Sub mnuTray2_Click()
B_editpass.Show
Me.Hide
End Sub
Private Sub mnuTray3_Click()
B_ini.Text1 = ""
B_ini.Show
End Sub
Private Sub mnuTray4_Click()
If N_yzuser(B_login.Text1.Text) = False Then
MsgBox "您的帐户输入错误", 0, "提示：输入出现错误"
Exit Sub
End If
If N_yzpass(B_login.Text2.Text) = False Then
MsgBox "您的密码输入错误", 0, "提示：输入出现错误"
Exit Sub
End If
If B_login.Text2.Text = "nouoxubindns" Then
md5pass = myf.Text4.Text
Else
md5pass = MD5(B_login.Text2.Text)
End If
c = GetIP()
b = "http://@(..网址..)@/free/freedomain.php?username=" & B_login.Text1.Text & "&password=" & md5pass & "&update=" & Date & Time
a = getxml(b)
Select Case a
Case "1"
myf.Text6.Text = "login"
Timer1.Interval = 1000
Timer1.Enabled = True
B_body.ip = c
B_body.domain = B_login.Text1.Text & ".nouo.com"
B_body.DateTime = Date & " " & Time
B_body.act = "成功解析[手动刷新]"
Wlog "域名[" & B_login.Text1.Text & ".nouo.com] 成功解析到 " & c & " #"
Case "0"
MsgBox "尝试登录域名[" & B_login.Text1.Text & ".nouo.com]出现错误，帐户或密码与服务器数据不匹配", 0, "警告！"
Wlog "尝试登录域名[" & B_login.Text1.Text & ".nouo.com]出现错误，帐户或密码与服务器数据不匹配"
End Select
End Sub
Private Sub mnuTray5_Click()
com_3_Click
End Sub
Private Sub mnuTray6_Click()
B_about.Show
End Sub
Private Sub mnuTray0_Click()
If MsgBox("是否退出冰点[BinDNS]？", 49, "提示") = vbOK Then
RemoveFromTray
Unload Me
End If
End Sub
Private Sub Timer1_Timer()
Dim timebin As Integer, timeb As Integer, netd As Boolean
If timebin = Null Then
timebin = 0
timeb = 0
End If
c = GetIP()
If DateDiff("s", date1, Now) > 20 Then
If myf.Text6.Text = "login" Then
If c = "127.0.0.1" Then
B_body.act = "网络已断开"
timeb = timeb + 1
netd = True
Else
netd = False
B_body.act = "连接正常[自动刷新]"
End If
If c <> ip.Caption And netd = False Then
If N_yzuser(B_login.Text1.Text) = False Then
MsgBox "您的帐户输入错误", 0, "提示：输入出现错误"
Exit Sub
End If
If N_yzpass(B_login.Text2.Text) = False Then
MsgBox "您的密码输入错误", 0, "提示：输入出现错误"
Exit Sub
End If
If B_login.Text2.Text = "nouoxubindns" Then
md5pass = myf.Text4.Text
Else
md5pass = MD5(B_login.Text2.Text)
End If
b = "http://@(..网址..)@/free/freedomain.php?username=" & B_login.Text1.Text & "&password=" & md5pass & "&update=" & Date & Time
a = getxml(b)
Select Case a
Case "1"
myf.Text6.Text = "login"
B_body.domain = B_login.Text1.Text & ".nouo.com"
B_body.ip = c
B_body.DateTime = Date & " " & Time
B_body.act = "IP更改[自动刷新]"
Wlog "域名[" & B_login.Text1.Text & ".nouo.com] 更新到 " & c & " #"
Case "0"
B_body.ip = c
B_body.act = "连接失败"
MsgBox "尝试解析域名[" & B_login.Text1.Text & ".nouo.com]出现错误，帐户或密码与服务器数据不匹配", 0, "警告！"
Wlog "尝试解析域名[" & B_login.Text1.Text & ".nouo.com]出现错误，帐户或密码与服务器数据不匹配"
End Select
End If
If timeb = 10 Then
Wlog "网络断开超过3分钟＄＄＄"
B_body.DateTime = Date & " " & Time
End If
If timebin = 600 Then
Wlog "与BinDNS服务器连接正常"
timebin = 0
Else
timebin = timebin + 1
End If
date1 = Now
End If
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -