apistuff.bas

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

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

Option Explicit

Public OldWindowProc As Long
Public TheForm As Form
Public TheMenu As Menu

Private Declare Function WritePrivateProfileString Lib "kernel32" _
   Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, _
   ByVal lpKeyName As Any, ByVal lpString As Any, _
   ByVal lpFileName As String) As Long

Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long

Public Const WM_USER = &H400
Public Const WM_LBUTTONUP = &H202
Public Const WM_MBUTTONUP = &H208
Public Const WM_RBUTTONUP = &H205
Public Const TRAY_CALLBACK = (WM_USER + 1001&)
Public Const GWL_WNDPROC = (-4)
Public Const GWL_USERDATA = (-21)
Public Const NIF_ICON = &H2
Public Const NIF_TIP = &H4
Public Const NIM_ADD = &H0
Public Const NIF_MESSAGE = &H1
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2

Public Type NOTIFYICONDATA
    cbSize As Long
    hwnd As Long
    uID As Long
    uFlags As Long
    uCallbackMessage As Long
    hIcon As Long
    szTip As String * 64
End Type

Private TheData As NOTIFYICONDATA
' *********************************************
' The replacement window proc.
' *********************************************
Public Function NewWindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

    If Msg = TRAY_CALLBACK Then
        ' The user clicked on the tray icon.
        ' Look for click events.
        If myf.Text6.Text = "login" Then
        If lParam = WM_LBUTTONUP Then
            ' On left click, show the form.
            If B_body.popupflag.Value = 0 Then
            B_body.Show
            B_body.popupflag.Value = 1
            B_body.mnuTray1.Caption = "※隐藏界面※"
            Else
            B_body.Hide
            B_body.popupflag.Value = 0
            B_body.mnuTray1.Caption = "※显示界面※"
            End If
            Exit Function
        End If
        If lParam = WM_RBUTTONUP Then
            ' On right click, show the menu.
            TheForm.PopupMenu TheMenu
            Exit Function
        End If
        End If
    End If
        If myf.Text6.Text = "login" Then
    ' Send other messages to the original
    ' window proc.
    NewWindowProc = CallWindowProc( _
        OldWindowProc, hwnd, Msg, _
        wParam, lParam)
        End If
End Function
' *********************************************
' Add the form's icon to the tray.
' *********************************************
Public Sub AddToTray(frm As Form, mnu As Menu)
    ' ShowInTaskbar must be set to False at
    ' design time because it is read-only at
    ' run time.

    ' Save the form and menu for later use.
    Set TheForm = frm
    Set TheMenu = mnu
    
    ' Install the new WindowProc.
    OldWindowProc = SetWindowLong(frm.hwnd, _
        GWL_WNDPROC, AddressOf NewWindowProc)
    
    ' Install the form's icon in the tray.
    With TheData
        .uID = 0
        .hwnd = frm.hwnd
        .cbSize = Len(TheData)
        .hIcon = frm.Icon.Handle
        .uFlags = NIF_ICON
        .uCallbackMessage = TRAY_CALLBACK
        .uFlags = .uFlags Or NIF_MESSAGE
        .cbSize = Len(TheData)
    End With
    Shell_NotifyIcon NIM_ADD, TheData
End Sub
' *********************************************
' Remove the icon from the system tray.
' *********************************************
Public Sub RemoveFromTray()
    ' Remove the icon from the tray.
    With TheData
        .uFlags = 0
    End With
    Shell_NotifyIcon NIM_DELETE, TheData
    
    ' Restore the original window proc.
    SetWindowLong TheForm.hwnd, GWL_WNDPROC, _
        OldWindowProc
End Sub

' *********************************************
' Set a new tray tip.
' *********************************************
Public Sub SetTrayTip(tip As String)
    With TheData
        .szTip = tip & vbNullChar
        .uFlags = NIF_TIP
    End With
    Shell_NotifyIcon NIM_MODIFY, TheData
End Sub

Public Function getxml(httpurl As String) As String
On Error Resume Next
Dim sxh
Set sxh = CreateObject("MSXML2.XMLHTTP.3.0")
sxh.Open "GET", httpurl, False
sxh.send
If Err.Number = 0 Then
getxml = sxh.responseText
Else
getxml = "err"
End If
End Function


Sub Wlog(iniw As String)
Dim a As String
Dim b As String
Dim success
a = "BinDNS Log"
b = Time
success = WritePrivateProfileString(a, b, iniw, App.Path & "\log\" & Date & ".Blog")
End Sub

Sub Wini(b As String, iniw As String)
Dim a As String
Dim success
a = "BinDNS Soft Config"
success = WritePrivateProfileString(a, b, iniw, App.Path & "\BinDNS.Bini")
End Sub


Sub HideK(FormName As Form, tet As TextBox, spe As Shape)
SendKeys "{home}+{end}"
Dim oobj As Object
      For Each oobj In FormName.Controls
      If oobj.name <> "Shape1" And TypeName(oobj) = "Shape" Then
            oobj.BorderColor = &H4000&
      End If
      If TypeName(oobj) = "TextBox" Then
            oobj.ForeColor = &H404040
      End If
      Next
tet.ForeColor = &H8000&
spe.BorderColor = &HC000&
End Sub