虚拟主机教程

Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long
 
Private Const WM_CHAR = &H102
Private Const WM_KEYDOWN = &H100
Private Const WM_KEYUP = &H101
 
'按Y键
PostMessage Handle, WM_CHAR, vbKeyY, 0
'按y键
PostMessage Handle, WM_KEYDOWN, vbKeyY, 0
'或
PostMessage Handle, WM_CHAR, vbKeyS, MakeKeyLparam(vbKeyS, WM_KEYDOWN)
 
Function MakeKeyLparam(ByVal VirtualKey As Long, ByVal flag As Long) As Long
     Dim s As String
     Dim Firstbyte As String    'lparam参数的24-31位
     If flag = WM_KEYDOWN Then  '如果是按下键
         Firstbyte = "00"
     Else
         Firstbyte = "C0"       '如果是释放键
     End If
     Dim Scancode As Long
     '获得键的扫描码
     Scancode = MapVirtualKey(VirtualKey, 0)
     Dim Secondbyte As String   'lparam参数的16-23位，即虚拟键扫描码
     Secondbyte = Right("00" & Hex(Scancode), 2)
     s = Firstbyte & Secondbyte & "0001"  '0001为lparam参数的0-15位，即发送次数和其它扩展信息
     MakeKeyLparam = Val("&H" & s)
 End Function

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal Hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal Hwnd As Long) As Long
Private Declare Function GetWindow Lib "user32" (ByVal Hwnd As Long, ByVal wCmd As Long) As Long
 
Public Function InstanceToWnd(ByVal target_pid As Long) As Long
    Dim test_hwnd As Long, test_pid As Long, test_thread_id As Long
    InstanceToWnd = 0
    test_hwnd = FindWindow(vbNullString, vbNullString)
    Do While test_hwnd <> 0
        If GetParent(test_hwnd) = 0 Then
            test_thread_id = GetWindowThreadProcessId(test_hwnd, test_pid)
            If test_pid = target_pid Then InstanceToWnd = test_hwnd: Exit Do
        End If
        test_hwnd = GetWindow(test_hwnd, GW_HWNDNEXT)
    Loop
End Function

Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Sub delay(HaoMiao As Double)
    Dim t1 As Long
    t1 = timeGetTime
    While (timeGetTime - t1) < HaoMiao: DoEvents: Wend
End Sub

Private Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) 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 WM_SETICON = &H80
Private Const ICON_SMALL = 0
Private Const ICON_BIG = 1
 
Private Sub Form_Load()
    SetWindowIcon Me.hWnd, App.Path & "\test.ico", 0
End Sub
 
Public Sub SetWindowIcon(hWnd As Long, Optional FileName As String, Optional IconIndex As Integer)
    Dim m_Icon As Long
    Dim hmodule As Long
    hmodule = GetModuleHandle(FileName)
    m_Icon = ExtractIcon(hmodule, FileName, IconIndex)
    SendMessage hWnd, WM_SETICON, 0, ByVal m_Icon
End Sub

'只需要下面简单的一句：
Environ("computername")
'或者 
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Function getPCName() As String
    Dim l1 As String, l2 As Long, l3 As Long
    l2 = 255: l1 = String$(l2, " ")
    l3 = GetComputerName(l1, l2)
    If l3 <> 0 Then
        getPCName = Left(l1, l2)
    End If
End Function