form1.frm

冰点BaiDNS动态域名解析系统是基于VB程序开发

'|
'|本代码因为网址接口现在正常使用，所以把网址去掉了，程序是绝对正常使用的
'|
'|本程序的原理就是远程获取网页地址，通过网页来对DNS服务器进行操作。
'|
'|如REG.PHP就是注册接口。
'|
'|网页不能直接对DNS服务器操作,操作有命令。可以通过VB编写DLL来执行命令。
'|
'|其实很简单了。版权的也不要了。嘿嘿。
'|
'|这个版本快被俺丢掉了。要想用免费域名的：）http://www.nouo.com去下载。哇哈哈哈哈
'|
'|嗯嗯。最新的是控制台命令+服务版本。很稳定。。以后有机会公布。


Dim c_c As Boolean

Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

Private Declare Function GetPrivateProfileString Lib "kernel32" _
   Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, _
   ByVal lpKeyName As Any, ByVal lpDefault As String, _
   ByVal lpReturnedString As String, ByVal nSize As Long, _
   ByVal lpFileName As String) As Long

'按钮---start
Dim a As String, b As String, c As String, d As String

Private Sub banner_Click()
Dim e
b = getxml("http://www.nouo.com/nouoxu_ad.html")
If b = "err" Then
Shell Environ("ProgramFiles") & "\Internet Explorer\IEXPLORE.EXE http://www.nouo.com", vbNormalFocus
Else
e = Split(b, "|")
For i = 0 To UBound(e)
Shell Environ("ProgramFiles") & "\Internet Explorer\IEXPLORE.EXE " & e(i), vbNormalFocus
Next
End If
End Sub


Private Sub com_1_Click()

com_1.Picture = myf.i3.Picture
On Error Resume Next
    Dim ret As Long
    Dim buff As String
    
Set WSH = CreateObject("WScript.Shell")


buff = String(255, 0)
ret = GetPrivateProfileString("BinDNS Soft Config", "save", "no", buff, 256, App.Path & "\BinDNS.Bini")
myf.Text1.Text = buff

buff = String(255, 0)
ret = GetPrivateProfileString("BinDNS Soft Config", "autorun", "no", buff, 256, App.Path & "\BinDNS.Bini")
myf.Text2.Text = buff


' 验证域名-------start
If N_yzuser(Text1.Text) = False Then
MsgBox "您的帐户输入错误", 0, "提示：输入出现错误"
Exit Sub
End If

If N_yzpass(Text2.Text) = False Then
MsgBox "您的密码输入错误", 0, "提示：输入出现错误"
Exit Sub
End If

If Text2.Text = "nouoxubindns" Then
md5pass = myf.Text4.Text
Else
md5pass = MD5(Text2.Text)
End If

c = GetIP()
b = "http://@(..网址..)@/free/freedomain.php?username=" & Text1.Text & "&password=" & md5pass & "&update=" & Date & Time
a = getxml(b)
Select Case a
Case "1"

If Check1.Value = 1 And Text2.Text <> "nouoxubindns" Then
Wini "username", Text1.Text
Wini "password", MD5(Text2.Text)
Wini "ipaddr", c
Wini "save", "yes"
End If

If Check1.Value = 0 Then
Wini "username", ""
Wini "password", ""
Wini "ipaddr", ""
Wini "save", "no"
End If

If Check2.Value = 1 And myf.Text2.Text = "no" Then
            Wini "autorun", "yes"
            WSH.regWrite "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\BinDNS", App.Path & "\" & App.EXEName & ".exe", "REG_SZ"
             If Err.Number <> 0 Then
            Wlog ("更改配置：[开机启动]失败，没有权限更改注册表")
            Else
            Wlog ("更改配置：[开机启动]打开")
            End If
End If
If Check2.Value = 0 And myf.Text2.Text = "yes" Then
            Wini "autorun", "no"
            WSH.RegDelete "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\BinDNS"
            If Err.Number <> 0 Then
            Wlog ("更改配置：[开机启动]失败，没有权限更改注册表")
            Else
            Wlog ("更改配置：[开机启动]关闭")
            End If
End If
myf.Text6.Text = "login"
        B_body.Timer1.Interval = 1000
        B_body.Timer1.Enabled = True
B_body.act = "成功解析[登录]"
B_body.ip = c
B_body.domain = Text1.Text & ".nouo.com"
B_body.datetime = Date & " " & Time
Me.Hide
Wlog "登录成功，域名[ " & Text1.Text & ".nouo.com ]成功解析到 " & c & " ！"

AddToTray B_body, B_body.mnuTray
SetTrayTip "ざ冰点[BinDNS]免费版"

Case "0"
MsgBox "尝试登录[ " & Text1.Text & ".nouo.com ]域名记录出现错误，帐户或密码与服务器数据不匹配", 0, "警告！"
Wlog "尝试登录[ " & Text1.Text & ".nouo.com ]域名记录出现错误，帐户或密码与服务器数据不匹配"
Case Else
If Check1.Value = 0 And Check2.Value = 0 Then
MsgBox "服务器无法连接", 0, "警告！"
End If
End Select
' 验证域名-------end

End Sub

Private Sub com_2_Click()
com_2.Picture = myf.i3.Picture
B_reg.Show
End Sub

Private Sub com_3_Click()
com_3.Picture = myf.i3.Picture
B_about.Show
End Sub

Private Sub com_4_Click()
com_4.Picture = myf.i3.Picture
B_getpass.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_t1_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_t2_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_t3_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_t4_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 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_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_Load()
    Dim ret As Long
    Dim buff As String
    
buff = String(255, 0)
ret = GetPrivateProfileString("BinDNS Soft Config", "save", "no", buff, 256, App.Path & "\BinDNS.Bini")
myf.Text1.Text = buff

If myf.Text1.Text = "yes" Then
buff = String(255, 0)
ret = GetPrivateProfileString("BinDNS Soft Config", "username", "", buff, 256, App.Path & "\BinDNS.Bini")
myf.Text3.Text = buff
buff = String(255, 0)
ret = GetPrivateProfileString("BinDNS Soft Config", "password", "", buff, 256, App.Path & "\BinDNS.Bini")
myf.Text4.Text = buff

Text1.Text = myf.Text3.Text
Text2.Text = "nouoxubindns"
Check1.Value = 1
End If

Call AutoLoad '调入按钮

downbanner '下载Banner

If Dir(App.Path & "\log", vbDirectory) = "" Then '检查日志目录
MkDir App.Path & "\log"
End If

buff = String(255, 0)
ret = GetPrivateProfileString("BinDNS Soft Config", "autorun", "no", buff, 256, App.Path & "\BinDNS.Bini")
myf.Text2.Text = buff
        
If myf.Text2.Text = "yes" And myf.Text1.Text = "yes" And Check1.Value = 1 Then
Check2.Value = 1
com_1_Click
End If

End Sub

Private Sub downbanner()
Dim lngRetVal As Long

lngRetVal = URLDownloadToFile(0, "http://www.nouo.com/nouologo.gif", Environ("SYSTEMROOT") & "\Temp\bindns.gif", 0, 0)


   
End Sub

Private Sub AutoLoad()
Me.com_1.Picture = myf.i1.Picture
Me.com_2.Picture = myf.i1.Picture
Me.com_3.Picture = myf.i1.Picture
Me.com_4.Picture = myf.i1.Picture

B_body.com_1.Picture = myf.i1.Picture
B_body.com_2.Picture = myf.i1.Picture
B_body.com_3.Picture = myf.i1.Picture
B_body.com_4.Picture = myf.i1.Picture

B_reg.com_1.Picture = myf.i1.Picture
B_reg.com_2.Picture = myf.i1.Picture

B_ini.com_1.Picture = myf.i1.Picture

B_getpass.com_1.Picture = myf.i1.Picture
B_getpass.com_2.Picture = myf.i1.Picture

B_editpass.com_1.Picture = myf.i1.Picture
B_editpass.com_2.Picture = myf.i1.Picture

B_about.com_1.Picture = myf.i1.Picture
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 Text1_GotFocus()
HideK Me, Text1, Shape2
End Sub

Private Sub Text2_GotFocus()
HideK Me, Text2, Shape3
End Sub