虚拟主机教程

'第一种是用winsock控件来获得，对于独立主机独立ip接入的还好，但对于局域网或小区宽带中的电脑就取不到正确ip了
Private Sub Command1_Click()
Dim winIP As Object
Set winIP = CreateObject("MSWinsock.Winsock")
MsgBox "本机IP:" & winIP.LocalIP
End Sub
'一般用下面这种方法来取得，原理就是请求一个网页，网页上会返回ip文本，然后读下来。
'为了能引用正则和XMLHTTP，首先在VB中请先引用 Microsoft VBScript Regular Expressions 5.5和Microsoft XML, v6.0

Private Sub Form_Load()
If App.PrevInstance Then
    msgbox "不能重复运行本程序"
    Unload Me
End if
End Sub
'还有一种方法找到了再发出来。

Option Explicit
Private Declare Function SetWindowPos& Lib "user32" (ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, _
ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)
 
Private Sub Command1_Click()
    Dim l As Long
    l = SetWindowPos(Form1.hwnd, -1, 0, 0, 0, 0, 3)'窗口置前
   'l = SetWindowPos(Form1.hwnd, -2, 0, 0, 0, 0, 3)'窗口正常
   'l = SetWindowPos(Form1.hwnd, 1, 0, 0, 0, 0, 3)'窗口置后
End Sub

'添加模块，输入以下代码
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long   '声明的 API
Public Const WM_SETHOTKEY = &H32
Public Const HOTKEYF_SHIFT = &H1
Public Const HOTKEYF_CONTROL = &H2
Public Const HOTKEYF_ALT = &H4
'在主窗体中添加以下代码
Private Sub Form_Load()
    Dim l As Long, wHotkey As Long
    wHotkey = (HOTKEYF_CONTROL) * 256 + vbKeyB
    l = SendMessage(Me.hwnd, WM_SETHOTKEY, wHotkey, 0)
End Sub
'看上面，我设置的Ctrl + B ，应该看得懂吧，后面是vb的内置常量，如果我要设置Ctrl+Alt+C，那么就是 wHotkey = (HOTKEYF_CONTROL or HOTKEYF_ALT ) * 256 + vbKeyC  ，你会了吗。

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
Const WM_SYSCOMMAND = &H112&
Const SC_MONITORPOWER = &HF170&
 
Private Sub Command1_Click()  '关闭显示器
   SendMessage Me.hwnd, WM_SYSCOMMAND, SC_MONITORPOWER, ByVal 2&
End Sub
Private Sub Command2_Click()  '打开显示器  
   SendMessage Me.hwnd, WM_SYSCOMMAND, SC_MONITORPOWER, ByVal -1& 
End Sub

Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal _
hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_ALPHA = &H2
Private Const GWL_EXSTYLE = (-20)
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal _
hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal _
hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Sub Form_Load()
   Dim rtn As Long
   rtn = GetWindowLong(Me.hwnd, GWL_EXSTYLE)    '取的窗口原先的样式
   rtn = rtn Or WS_EX_LAYERED                   ' 使窗体添加上新的样式WS_EX_LAYERED
   SetWindowLong Me.hwnd, GWL_EXSTYLE, rtn      ' 把新的样式赋给窗体
   SetLayeredWindowAttributes Me.hwnd, 0, 200, LWA_ALPHA
End Sub

Private Declare Function ReleaseCapture Lib "user32" () As Long
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 HTCAPTION = 2
Private Const WM_NCLBUTTONDOWN = &HA1
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
   Dim ncl As Long
   Dim rel As Long
   If Button = 1 Then
   i = ReleaseCapture()
   ncl = SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)
   End If
End Sub

'这个api函数可以使窗口标题栏一闪闪的，要配合定时器控件，对于提醒特别有用。
Option Explicit
Private Declare Function FlashWindow Lib "user32" (ByVal hwnd As Long, ByVal bInvert _   
As Long) As Long   
Private Sub tmrFlash_Timer()   
   Static mFlash As Boolean   
   FlashWindow hwnd, Not mFlash   
End Sub