vb文章--有實用價值 Post By：2003-1-30 1:15:53
1.API在VB中應用之技巧集錦
------------------------------------------------------------
API函數在VB中得到了充分的運用，同時也讓無數VB愛好者沉溺於其中。以下是筆者幾年來收集整理的幾十個API函數在VB中應用的實例，現在寫出來與大夥分享，希望能對大夥有所幫助。
1、如何讓窗體總在最前面？
*API函數聲明
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 ) As Long
'常量聲明
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
' 在某個form裏寫：
SetWindowPos Me.hwnd, WND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE '或下面
SetWindowPos Me.hwnd, WND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE
2、使用API函數sendmessage，獲得光標所在行和列。
Sub getcaretpos(ByVal TextHwnd&, LineNo&, ColNo&)
'TextHwnd爲TextBox的hWnd屬性值， LineNo爲所在行數，ColNo爲列數
Dim I&, j&, k& '獲取起始位置到光標所在位置字節數 i=SendMessage(TextHwnd,&HB0&,0,0) j=i/2^16 '確定所在行 LineNo=SendMessage(TextHwnd,&HC9&,j,0)+1
'確定所在列
k = SendMessage(TextHwnd, &HBB&, -1, 0)
ColNo = j - k + 1
End Sub
3、如何以某種顏色填充某區域？
*API函數聲明
Private Declare Sub FloodFill Lib "gdi32" _ (ByVal hDC As Long , ByVal X As Long , ByVal Y As _ Long , ByVal crColor As Long
'設(fillx,filly)爲此區域內任一點
'Color爲某種顏色
FloodFill Picture1.hDC, fillx, filly, Color
4、如何關閉計算機？
*API函數聲明
Declare Function ExitWindows Lib "User" (ByVal dwReturnCode As Long , ByVal wReserved As Integer) As Integer
'執行
Dim DUMMY
DUMMY=ExitWindows(0，0)
5、如何獲取Windows目錄和System目錄？
'複製以下代碼到一模塊中
Public Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String , ByVal nSize As Long ) As Long
Public Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String , ByVal nSize As Long ) As Long
'在程序中調用
Dim WindowsDirectory As String , SystemDirectory As String , X As Long
WindowsDirectory = Space (255)
SystemDirectory = Space (255)
X = GetWindowsDirectory(WindowsDirectory, 255)
X = GetSystemDirectory(SystemDirectory, 255)
MsgBox "Windows的安裝目錄是:" + WindowsDirectory + ",系統目錄是:" + SystemDirectory
6、如何建立簡單的超級連接？
*API函數聲明
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecute A" (ByVal hWnd As Long , ByVal lpOperation As String , ByVal lpFile As String , ByVal lpParameters As String , ByVal lpDirectory As String , ByVal nShowCmd A s Long ) As Long
'打開某個網址
ShellExecute 0, "open" , "http://tyvb.126.com" , vbNullString, vbNullString, 3
'給某個信箱發電子郵件
ShellExecute hwnd, "open" , "mailto:[email protected]" , vbNullString, vbNullString, 0
7、如何得知TextBox中文字所有的行數？
*API函數聲明
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long , ByVal wMsg As Long , ByVal wParam As Long , lParam As Any) As Long
Public Const EM_GETLINECOUNT = &HBA
'在程序中調用
LineCnt = SendMessage(ctl.hwnd, EM_GETLINECOUNT, 0, 0)
'LineCnt即爲此TextBox的行數。
8、如何設置ListBox的水平捲動軸的寬度？
*API函數聲明
Const LB_SETHORIZONTALEXTENT = &H194
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
'調用
Call SendMessage(List1.hwnd, LB_SETHORIZONTALEXTENT, 400, ByVal 0&)
'注意400是以象素爲單位，你可以根據情況自行設定。
9、如何交換鼠標按鍵？
*API函數聲明
Declare Function SwapMouseButton& Lib "user32" _ (ByVal bSwap as long )
要交換鼠標按鍵，將bSwap參數設置爲True。要恢復正常設置，將bSwap設置爲False。 然後調用函數就可以交換和恢復鼠標按鍵了。
10、如何讓窗體的標題條閃爍以引起用戶注意？
在窗體中放一個Timer控件Timer1 , 設置其Inteval = 200
*API函數聲明
Private Declare Function FlashWindow Lib "user32" (ByVal hwnd As Long , ByVal bInvert As Long ) As Long
'在窗體中寫下如下代碼:
Private Sub Timer1_Timer()
FlashWindow Me.hwnd, True
End Sub
11、怎樣找到鼠標指針的XY座標？
*API函數聲明
Type POINTAPI
X As Long
Y As Long
End Type
Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
調用:
GetCursorPos z
Print z.X
Print z.Y
12、怎樣獲得和改變雙擊鼠標的時間間隔？
獲得鼠標雙擊間隔時間:
Public Declare Function GetDoubleClickTime Lib "user32" Alias _ "GetDoubleClickTime" () As Long
獲得鼠標雙擊間隔時間:
Declare Function SetDoubleClickTime Lib "user32" (ByVal wCount As Long ) As Long
'注意：這種改變將影響到整個操作系統
以上兩個函數都可精確到毫秒級?
13、在程序中如何打開和關閉光驅門？
*API函數聲明如下:
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String , ByVal lpstrReturnString As String , ByVal uReturnLength As Long , ByVal hwndCallback As Long ) As Long
'調用時的代碼如下
Dim Ret As Long
Dim RetStr As String
'打開光驅門
Ret = mciSendString("set CDAudio door open" , RetStr, 0, 0)
'關閉光驅門
Ret = mciSendString("set CDAudio door closed" , RetStr, 0, 0)
14、如何獲得Windows啓動方式?
在Form1中加入一個CommandButton?一個Label並加入如下代碼:
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long ) As Long
Const SM_CLEANBOOT = 67
Private Sub Command1_Click ()
Select Case GetSystemMetrics(SM_CLEANBOOT)
Case 1
Label1 = "安全模式."
Case 2
Label1 = "支持網絡的安全模式."
Case Else
Label1 = "Windows運行在普通模式."
End Select
End Sub
15、怎樣使Ctrl-Alt-Delete無效？
*API函數聲明
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long , ByVal uParam As Long , ByVal lpvParam As Any, ByVal fuWinIni As Long ) As Long
編寫如下函數:
Sub DisableCtrlAltDelete(bDisabled As Boolean )
Dim X As Long
X = SystemParametersInfo(97, bDisabled, CStr (1), 0)
End Sub
使Ctrl -Alt - Delete無效:
Call DisableCtrlAltDelete(True )
恢復Ctrl -Alt - Delete:
Call DisableCtrlAltDelete(False )
16、如何移動沒有標題欄的窗口？
我們一般是用鼠標按住窗口的標題欄，然後移動窗口，當窗口沒有標題欄時，我們可以用下面的方法來移動窗口：
*API函數聲明：
Declare Function ReleaseCapture Lib "user32" () As Long Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long , ByVal wMsg As Long , ByVal wParam As Long , lParam As Any) As Long
Public Const HTCAPTION = 2
Public Const WM_NCLBUTTONDOWN = &HA1
在 Form _MouseDown 事件中：
Private Sub Form _MouseDown(Button As Integer, ShIft As Integer, X As Single , Y As Single )
ReleaseCapture SendMessage hwnd, WM_NCLBUTTONDOWN, HTCAPTION,0&
End Sub
17、VB中如何使用延時函數？
*API函數聲明：
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long )
調用:
'延時1秒
Call Sleep(1000)
18 ?調用修改屏幕保護口令的窗口:
Private Declare Function PwdChangePassword Lib "mpr" Alias "PwdChangePasswordA" (ByVal lpcRegkeyname As String , ByVal hwnd As Long , ByVal uiReserved1 As Long , ByVal uiReserved2 As Long ) As Long
調用:
Call PwdChangePassword("SCRSAVE" , Me.hwnd, 0, 0)
19 ?使Windows開始屏幕保護:
*API函數聲明
Private Declare Function SendMessage Lib "user32" ()
Alias "SendMessageA" (ByVal hWnd As Long , ByVal wMsg
As Long , ByVal wParam As Long , ByVal lParam As Long )
As Long
Const WM_SYSCOMMAND = &H112&
Const SC_SCREENSAVE = &HF140&
'調用
Dim result As Long
result = SendMessage(Form1.hwnd, WM_SYSCOMMAND, SC_SCREENSAVE, 0&)
20、如何改變Windows桌面背景？
*API函數聲明
Const SPI_SETDESKWALLPAPER = 20
Const SPIF_UPDATEINIFILE = &H1
Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long , ByVal uParam As Long , ByVal lpvParam As Any, ByVal fuWinIni As Long ) As Long
'調用
Call SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, "C:windowsClouds.bmp" , SPIF_UPDATEINIFILE)
21、怎樣確定系統是否安裝了聲卡？
*API函數聲明：
Declare Function waveOutGetNumDevs Lib "winmm.dll" () As Long
代碼如下:
Dim I As Integer
I = waveOutGetNumDevs()
If I > 0 Then MsgBox "你的系統可以播放聲音。" , vbInformation, "聲卡檢測"
Else
MsgBox "你的系統不能播放聲音。" , vbInformation, "聲卡檢測"
End If
22、如何找到CD-ROM驅動器的盤號？
下面的函數將檢查你計算機所有的驅動器看是否是 CD-ROM，如果是就返回驅動器號，如果沒有就返回空字符
Public Function GetCDROMDrive() As String
Dim lType As Long , I As Integer, tmpDrive As String , found As Boolean
On Error GoTo errL
For I = 0 To 25
tmpDrive = Chr (65 + I) & ":"
lType = GetDriveType(tmpDrive) 'Win32 API 函數
If (lType = DRIVE_CDROM) Then 'Win32 API 常數
found = True
Exit For
End If
Next
If Not found Then tmpDrive = ""
BI_GetCDROMDrive = tmpDrive
Exit Function
errL: MsgBox Error $
End Function
23、如何將文件放入回收站？
**API函數聲明
Public Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As Long
End Type
Public Declare Function SHFileOperation Lib _ "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Public Const FO_DELETE = &H3
Public Const FOF_ALLOWUNDO = &H40
'調用
Dim SHop As SHFILEOPSTRUCT, strFile As String
With SHop
.wFunc = FO_DELETE
.pFrom = strFile + Chr (0)
.fFlags = FOF_ALLOWUNDO
End With
24、VB中如何使用未安裝的字體？
Declare Function AddFontResource Lib "gdi32" Alias "AddFontResourceA" (ByVal lpFileName As String ) As Long
Declare Function RemoveFontResource Lib "gdi32" Alias "RemoveFontResourceA" (ByVal lpFileName As String ) As Long
增加字體:
Dim lResult As Long
lResult = AddFontResource("c:myAppmyFont.ttf" )
刪除字體:
Dim lResult As Long
lResult = RemoveFontResource("c:myAppmyFont.ttf" )
2.VB6.0編程"雜耍"
--------------------------------------------------------------------------------
雜耍一?防止自身被多次運行
如果你不希望你的VB應用程序被用戶通過多次雙擊圖標而重複運行，導致內存不足或其它意外，你可以在程序中增加以下幾行,檢查發現如果程序已經被運行過，則給出提示後結束：
Private Sub Form _Load()
If App.PrevInstance Then
MsgBox "嘟....,程序正在運行，請檢查窗口是否被最小化。:-)"
End If
End Sub
◆說明:App是VB內置的應用對象,通過訪問他的屬性可以得到應用程序的標題、版本信息、可執行文件和幫助文件的路徑及名稱等信息，尤其是App.Path很經常用到的。
◆可能的用途:各種不希望被多次運行的程序，例如數據庫應用程序等。
雜耍二?右鍵菜單
Windows的桌面和許多流行軟件都提供右鍵菜單功能，就是在相應控件上單擊鼠標右鍵時彈出菜單實現某些功能，方便快捷，許多編程愛好者也很想實現類似功能吧，方法如下：
1、利用VB的菜單編輯器（Menu Editor）編輯你希望彈出的菜單(子選單)，並將此菜單的Visible屬性設置爲False。
2、在相應控件的MouseDown事件中編寫程序，來調用編輯好的菜單，假設菜單名爲demoMenu，並且相應控件名稱是ListView1,程序源碼如下：
Private Sub ListView1_MouseDown(Button As Integer, ShIft As Integer, X As Single , Y As Single )
If Button = vbRightButton Then
PopupMenu demoMenu
End If
End Sub
◆說明:可以用在包括窗口的任何控件中,關鍵是彈出菜單技術。
◆可能的用途:程序最小化到任務欄右面，縮小爲一個圖標，經常使用這種技巧。
雜耍三?訪問指定的網址和發Email的簡單方法
讓自己的程序打開瀏覽器訪問某個網址或者系統指定的默認郵件服務程序，通常的方法是採用API函數ShellExecute，其實我們還有更簡單的方法，只用一句程序變可完成，免去調用API函數的麻煩：
1 ?訪問指定的網址:
Shell "start http://tyvb.csol.net"
2 ?給指定的電子信箱發Email:
Shell "start mailto:[email protected]?subject=你好"
◆說明:
1、其中的http://tyvb.csol.net你可以根據需要指定,系統會根據默認的瀏覽器打開指定的網頁。
2、其中[email protected]可以變成你自己想要發送郵件的地址,subject後面的是待發送電子郵件的主題，系統會根據默認的電子郵件服務程序，發送郵件。
◆可能的用途:用在"關於" 窗口中，使用戶方便和軟件作者聯繫。
雜耍四?鼠標變臉
爲了使你的程序更專業 , 在需要等待的過程中可做如下處理:
處理過程前:
Screen.MousePointer = vbHourglass
處理過程後
Screen.MousePointer = vbDefault
◆說明:MousePointer還可以取VbArrow等各種系統經常用到的鼠標指針的類型，滿足您不同的應用，甚至還可以自己定製。
◆可能的用途:用在操作時間較長，需要用戶等待的程序中。
雜耍五?播放AVI文件
AVI文件是語音和影像同步組合在一起的文件格式。使用VB6.0中的多媒體控件MMControl設計播放AVI文件的程序方法如下：
在Form1上建立一個多媒體控件MMControl1，並建立一個圖片框Picturer1,並設定MMControl對象的按鈕屬性。在應用程序所在目錄放上自己喜歡的AVI文件，並命名爲demo.avi
在窗口加載的事件裏寫如下代碼:
Private Sub Form _Load()
MMControl1.DeviceType = "AVIVideo"
MMControl1.FileName = App.Path & "demo.avi"
MMControl1.hWndDisplay = Picture1.hwnd
MMControl1.Command = "Open"
End Sub
程序運行後，單擊播放鍵，慢慢欣賞吧。
◆說明:
1、DeviceType="AVIVideo" ，是設定MCI播放媒體的種類。多媒體控件除了可以播放AVI文件還可以播放WAV文件和MID文件和 VCD文件，只要把AVIVIDEO變成WAV、MID、CDaudio和MPEGVideo即可,當然其他語句也要相應改變。
2、HwndDisplay=Picture1.hWnd,是把AVI文件在圖形框中播放，如果沒有這一行，將自動開啓一個窗口播放。
◆可能的用途:
1 ?實現簡單的多媒體教學程序或小遊戲軟件?
2 ?可以放在程序的啓動窗口裏做一個動態的歡迎畫面?
雜耍六?播放Flash文件
Flash是一種矢量格式的動畫文件,可以包含動畫，聲音，超文本鏈接，而文件的體積卻很小,如何用VB播放呢？用MicroMedia公司提供的空間Swflash.ocx就可以,方法如下：
將Flash控件放到窗體上，並調整至適當的大小，設置scale model屬性爲2，在應用程序目錄下放一個Flash文件，假設爲demo.swf，在窗口上添加命令按鈕Command1。
程序代碼如下:
Private Sub Command1_Click ()
ShockwaveFlash1.Movie = App.Path & "demo.swf"
ShockwaveFlash1.Playing = True
End Sub
◆說明：要獲得SwFlash.ocx只要安裝Flash4.0即可，加載的方法是:在工具箱上單擊右鍵，選擇部件，在部件窗口的控件列表中選擇Shockwave flash，然後確定，Flash控件就被加到工具箱上。
◆可能的用途:利用Flash的功能實現漂亮的菜單等趣味程序。
雜耍七?重新啓動計算機
1、API函數ExitWindowsEx，可以用來實現重新啓動計算機或者關閉Windows。
把下面的這段代碼拷貝到模塊得聲明部分:
Public Const EWX_LOGOFF = 0
Public Const EWX_SHUTDOWN = 1
Public Const EWX_REBOOT = 2
Public Const EWX_FORCE = 4
Public Const EWX_POWEROFF = 8
Declare Function ExitWindowsEx Lib "user32" _
(ByVal uFlags As Long , ByVal dwReserved _
As Long ) As Long
如果你想要重新啓動計算機，只需要插入下面的代碼就可以了：
Call ExitWindowsEx(EWX_REBOOT, 0)
◆說明:
參數說明如下:
EWX_FORCE 所有的進程都被強制終止?
EWX_LOGOFF 所有的進程被強制終止,並且用戶退出登錄(logged off)。
EWX_POWEROFF 計算機系統被關機, 並且如果支持節電特性, 則計算機被物理關機?
EWX_REBOOT 計算機系統被關機並重新啓動?
EWX_SHUTDOWN 計算機被物理地安全地關機?
可根據需要使用相應的參數，還可以把這幾個常量加起來作爲組合的功能呢。
◆可能的用途:
在安裝程序修改了系統文件後，需要重新啓動Windows來完成安裝時，這段代碼就顯得特別有用了。 還有就是給朋友一個胡鬧的小東西(啊,我跑.....)
3.用VB編制Tcp/IP程序
--------------------------------------------------------------------------------
隨着Internet 爆炸式的發展及Windows用戶不斷地增多，人們迫切地需要一種在Windows下開發TCP/IP應用程序標準,由包括微軟公司在內的衆多計算機廠家,經共同努力,已經制訂出了這一標準,稱之爲Windows Sockets API(application Program interface)。這使得不同廠家開發的應用程序能夠做到相互兼容。
一、TCP/IP編譯簡介:
當兩臺計算機通過網絡要進行信息交換時 , 需要具備兩個條件: 一是物理配件 , 這包括網卡及連接網卡用的網線, 二是需要一組通訊參數的說明, 即協議?目前最廣泛使用的協議是TCP / IP協議?
當一個主機使用IP協議發送數據時 , 數據被分爲數據包.每個數據包由其包頭及數據組成, 包頭包含對方目的地址?這就象使用信封發信一樣, 信封上含有收方的地址, 但有時發出的信也會丟掉, 這種發送稱爲不可靠的傳輸, 而我們需要的是可靠的傳輸, 這便產生了TCP協議?
TCP是一種面向連接的協議,即:兩個程序在進行數據交換之前,他們必須先建立起連接,一個程序作爲客戶方(client)發出連接請求,另一個程序作爲服務方(server)監聽,並響應其連接請求,一旦連接建立好,雙方便均可收發信息,直到連接斷開。TCP協議使得開發人員不需要去編寫如何處理數據包丟失的過程,而專心於應用程序本身的開發。
爲了同其他計算機進行通信,還需要知道本機及目的機的IP地址,有時爲方便記憶我們將32位的IP地址用主機名來代替,主機名間用"·" 分隔,我們稱之爲域,域是一種樹形結構。如: 最上一層爲政府、商業公司、教育機構、internet服務商等組織,一個完整的域名是由主機及其所有的父名組成(用 '·'分隔),例如mars的完整域名爲mars·olgmpus·com,其表達的含意爲mars是olgmpus域名的一部分,而olgmpus又是com的一部分。IP地址到主機名的轉換有兩種方法,一是使用本地的主機命名錶文件,這個文件通常稱爲hosts文件,表中列出了IP地址及主機名的對應關係；二是使用命名服務器 (DNS),它是一臺主機(或一個應用程序),可以將一主機名轉換爲其IP地址。
此外,除了雙方的IP地址以外,還需要知道對方的服務端口號(Service Port),它是一個16位的標識,每一Service Port同一應用程序相對應,這些對應關係往往存在於名爲Service的一個文件中,一些常用的服務及對應的
Service Port如下:
Service Servicse Port
FTP 21
Telnet 23
SMTP 25
DNS 53
TFTP 69
SNMP 161
TCP 6
UDP 17
有了以上各信息,兩應用程序在進行通訊時,先建立一個Socket(或稱爲通訊端點),建立了Socket本身並不能進行信息交換,你還必須建立 Socket的連接,Socket的地址由三部分組成:協議、IP地址、Service Port號。其協議標識着下一層所使用何種協議,在我們以下的例子中就是指IP協議。
在兩個應用程序進行通訊時,客戶方建立一個Socket並試圖同服務方建立連接,服務方也建立一個Socket等待客戶方發來的連接請求,當收到一個申請後,雙方便形成一條虛電路(即兩個程序之間的一條邏輯通訊鏈路)。在此強調一下:當服務方收到連接請求後,服務方建立一新的Socket,用此新的 Socket同對方建立連接,原來的Socket保持不變,可繼續等待其它連接請求,當服務方不再希望收到其它連接時,它將最早的Socket關閉。
在建立一個TCP通訊程序時 , 服務方的程序應完成以下五個步驟:
1 Print 建立一個Socket
2 Print 監聽從客戶方發來的連接請求
3 Print 接受客戶方的連接
4 ?開始收?發信息
5 Print 關閉Socket, 終結會話
在客戶方應完成以下五個步驟:
1 Print 建立一個Socket
2 Print 指定服務方IP地址及Service; Port
3 Print 同服務方建立連接
4 ?開始收?發信息
5 Print 關閉Socket, 終結會話
由上可以看出服務方和客戶方的第二步和第三步是不同的,另外,在開發應用程序時,你可能會遇到阻塞式和非阻塞式Socket。例如:當你從Socket讀數據時,如果遠方主機還未將數據傳來,你就讀不到數據,這會引發兩種情況:一是程序一直等待,直到數據到達；二是程序立即返回並標識一個讀錯誤。前者我們稱之爲阻塞式Socket,後者爲非阻塞式Socket,在非阻塞式的情況下,程序開發者應當做出適當的處理。一般有兩種處理方法:第一種爲輪詢法,即程序週期的去讀Socket;第二種是較好的一種方法,異步通知法，即當Socket發生事件時,能夠通知應用程序,如:Socket收到遠方主機發來的數據時,Socket會產生一個"讀事件" ,應用程序便可從Socket中讀出數據了。
二、TCP/IP編程實例
1.客戶方軟件的編制:
下面的例子假設讀者對VB編程有一定的瞭解 , 其工作流程是: 客戶方發出的一串信息到服務方 , 服務方收到後將收到的信息全部傳回來?
首先用VB創建一個帶有三個標記、三個文本控件、一個控制按紐及一個SocketWrench控件，當使用時,用戶在Text1中輸入遠端主機IP的地址或主機名,將要發送的信息輸入到Text2中，服務方返回的信息便在Text3中顯示。Text2及Text3的Enable屬性在初始時設爲 False。程序如下:
Sub Form Load()
Socket1.AddressFamily=AF INET
Socket1.Protoco1=IPPROTO IP
Socket1.Type=SOCK STREAM
Socket1.Binary = False
Socket1.BufferSize=1024
Socket1.Blocking = False
End Sub
當點擊Connect後 , 便可建立同遠方主機的連接, 其過程如下:
Sub Command Click ()
Socket1.HostName=Trim＄(Text1.Text )
Socket1.RemotePort=IPPORT ECHO
Socket1.Action=SOCKET CONNECT
End Sub
在初始化的過程中 , 我們已將其Socket定爲非阻塞式的(Socket1.Blocking = Fasle), 因此它不必等待連接建立完, 而是直接返回, 並等待connect事件, 當此事件發生後對其進行響應, 程序如下:
Sub Socket1 Connect()
Text2.Enabled = True
Text3.Enabled = True
End Sub
此時 , Text2, Text3便可進行數據的輸入 / 輸出了?下一步的程序爲真正的收發過程, 在Text2控件中加入KeyPress事件:
Sub Text2 KeyPress(KeyAscii As Integet)
If KeyAscii=13 Then
Socket1.SendLen=Len (Text2.Text )
Socket1.SendData = Text2.Text
KeyAscii=0:Text2.Text =""
End If
End Sub
當按下Enter時(KeyPress=13)數據便會發往遠程主機發送數據,遠程主機接到數據並傳回,並在客戶方產生一個讀事件,處理讀事件的過程如下:
Sub Socket1 Read(DataLength As Integer,IsUrgent As Integer)
Socket1.RecvLen = DataLength
Text3.Text = Socket1.RecvData
End Sub
當終結此連接時,在Form unload事件處加如下過程:
Sub Form Unload(Cancel As Integer)
If Socket1.Connected Then Socket1.Action=SOCKET CLOSE
End If
End Sub
到此 , 一個較爲完整的VB程序已經完成, 但是如果輸入IP的地址或主機名不正確時, 還需要編一個處理程序, 這已超過本篇介紹的目的, 在此就不做介紹了.
2 Print 服務方軟件的編制
服務方軟件的第一件事情就是監聽是否有連接的請求,當SocketWrench收到連接請求時,就會產生一個Accept事件,這時有兩種處理方法:一是將Action屬性設置爲SOCKET ACCEPT;二是對Accept屬性進行設置。前者較爲簡單但有侷限性,因爲它將結束監聽其它的連接請求,只能同第一個客戶建立連接。後者較爲靈活但較爲複雜,其方法是對Accept設置屬性。然而,正在監聽的控件不能設置Accept屬性,必須利用閒置的Socket來對其進行設置,因此就需要一個控件組來處理多個連接。爲方便起見,我們還利用前面使用的Form來編制服務方的應用。首先是再加上一個SocketWrench控件,並使之成爲控件組。開始時此控件組中只有一個控件。稱爲Socket2(0),這個控件組用來監聽連接請求,同客戶方一樣,也需先對其進行初始化:
Sub Form Load()
Socket1.AddressFamily=AF INET
Socket1.Proyocol=IPPROTO IP
Socket1.Type=SOCK STREAM
Socket1.Binary = False
Socket1.BufferSize=1024
Socket1.Blocking = False
Socket2(0) .Addr essFamily=AF INET
Socket2(0) .Proyocol=IPPROTO IP
Socket2(0) .Type=SOCK STREAM
Socket2(0) .Blocking=False
Socket2(0) .Localport=IPPORT ECHO
Socket2(0) .Action=SOCKET LISTEN
LastSocket=0
End Sub
其中local port指明瞭當接到對方數據時, 將其全部傳回的一個TCP系統應用?當服務器收到連接請求時, 就會出現一個Accept事件, 相應的處理過程如下:
Sub Socket2 Accept(Index As Integer,Sockerid As Integer)
Dim I As Integer
For I = 1 To LastSocket
If Not Socket2(I).Connected Then Exit For
Next I
If I>LastSocket Then
LastSocket = LastSocket + 1: I = LastSocket
Load Socket2(I)
End If
Socket2(I).AddressFamily=AF INET
Socket2(I).Protocol=IPPROTO IP
Socket2(I).Type=SOCK STREAM
Socket2(I).Binary = True
Socket2(I).BufferSize=1024
Socket2(I).Blocking = False
Socket2(I).Accept = SocketId
End Sub
以上程序收到一個連接時,產生一個新的SocketWrench控件,在對其進行初始化之後,便可同客戶方通訊了.原Socket繼續監聽是否有新的連接請求。服務方收到數據後,將全部數據再傳回客戶方,其處理過程如下;
Sub Socket2 Read(Index As Integer,DataLength As Integer,IsUrgent As Integer)
Socket2(Index).RecvLen = DataLength
Socket2(Index).SendLen = DataLength
Socket2(Index).SendData = Socket2(Index).RecvData
End Sub
當客戶方關閉連接 , 服務方也關閉相應Socket的控制, 過程如下:
Sub Socket2 Close(Index As Integer)
Socket2(Index).Action=SOCKET CLOSE
End Sub
斷開所有連接的程序如下:
Sub From Unload(Cancel As Integer)
Dim I As Integer
If Socket1.Connected Then Socket1.Action=SOCKET CLOSE
If Socket2(0).Listening Then Socket2(0).Action=SOCKET CLOSE
For I = 1 To LastSocket
If Socket2(0).Connected Then Socket2(0).Action=SOCKET CLOSE
Next I
End
End Sub
到這裏，我們就可以使用這個程序利用TCP/IP協議進行信息交換了。
1.API在VB中應用之技巧集錦
------------------------------------------------------------
API函數在VB中得到了充分的運用，同時也讓無數VB愛好者沉溺於其中。以下是筆者幾年來收集整理的幾十個API函數在VB中應用的實例，現在寫出來與大夥分享，希望能對大夥有所幫助。
1、如何讓窗體總在最前面？
*API函數聲明
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 ) As Long
'常量聲明
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
' 在某個form裏寫：
SetWindowPos Me.hwnd, WND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE '或下面
SetWindowPos Me.hwnd, WND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE
2、使用API函數sendmessage，獲得光標所在行和列。
Sub getcaretpos(ByVal TextHwnd&, LineNo&, ColNo&)
'TextHwnd爲TextBox的hWnd屬性值， LineNo爲所在行數，ColNo爲列數
Dim I&, j&, k& '獲取起始位置到光標所在位置字節數 i=SendMessage(TextHwnd,&HB0&,0,0) j=i/2^16 '確定所在行 LineNo=SendMessage(TextHwnd,&HC9&,j,0)+1
'確定所在列
k = SendMessage(TextHwnd, &HBB&, -1, 0)
ColNo = j - k + 1
End Sub
3、如何以某種顏色填充某區域？
*API函數聲明
Private Declare Sub FloodFill Lib "gdi32" _ (ByVal hDC As Long , ByVal X As Long , ByVal Y As _ Long , ByVal crColor As Long
'設(fillx,filly)爲此區域內任一點
'Color爲某種顏色
FloodFill Picture1.hDC, fillx, filly, Color
4、如何關閉計算機？
*API函數聲明
Declare Function ExitWindows Lib "User" (ByVal dwReturnCode As Long , ByVal wReserved As Integer) As Integer
'執行
Dim DUMMY
DUMMY=ExitWindows(0，0)
5、如何獲取Windows目錄和System目錄？
'複製以下代碼到一模塊中
Public Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String , ByVal nSize As Long ) As Long
Public Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String , ByVal nSize As Long ) As Long
'在程序中調用
Dim WindowsDirectory As String , SystemDirectory As String , X As Long
WindowsDirectory = Space (255)
SystemDirectory = Space (255)
X = GetWindowsDirectory(WindowsDirectory, 255)
X = GetSystemDirectory(SystemDirectory, 255)
MsgBox "Windows的安裝目錄是:" + WindowsDirectory + ",系統目錄是:" + SystemDirectory
6、如何建立簡單的超級連接？
*API函數聲明
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecute A" (ByVal hWnd As Long , ByVal lpOperation As String , ByVal lpFile As String , ByVal lpParameters As String , ByVal lpDirectory As String , ByVal nShowCmd A s Long ) As Long
'打開某個網址
ShellExecute 0, "open" , "http://tyvb.126.com" , vbNullString, vbNullString, 3
'給某個信箱發電子郵件
ShellExecute hwnd, "open" , "mailto:[email protected]" , vbNullString, vbNullString, 0
7、如何得知TextBox中文字所有的行數？
*API函數聲明
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long , ByVal wMsg As Long , ByVal wParam As Long , lParam As Any) As Long
Public Const EM_GETLINECOUNT = &HBA
'在程序中調用
LineCnt = SendMessage(ctl.hwnd, EM_GETLINECOUNT, 0, 0)
'LineCnt即爲此TextBox的行數。
8、如何設置ListBox的水平捲動軸的寬度？
*API函數聲明
Const LB_SETHORIZONTALEXTENT = &H194
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
'調用
Call SendMessage(List1.hwnd, LB_SETHORIZONTALEXTENT, 400, ByVal 0&)
'注意400是以象素爲單位，你可以根據情況自行設定。
9、如何交換鼠標按鍵？
*API函數聲明
Declare Function SwapMouseButton& Lib "user32" _ (ByVal bSwap as long )
要交換鼠標按鍵，將bSwap參數設置爲True。要恢復正常設置，將bSwap設置爲False。 然後調用函數就可以交換和恢復鼠標按鍵了。
10、如何讓窗體的標題條閃爍以引起用戶注意？
在窗體中放一個Timer控件Timer1 , 設置其Inteval = 200
*API函數聲明
Private Declare Function FlashWindow Lib "user32" (ByVal hwnd As Long , ByVal bInvert As Long ) As Long
'在窗體中寫下如下代碼:
Private Sub Timer1_Timer()
FlashWindow Me.hwnd, True
End Sub
11、怎樣找到鼠標指針的XY座標？
*API函數聲明
Type POINTAPI
X As Long
Y As Long
End Type
Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
調用:
GetCursorPos z
Print z.X
Print z.Y
12、怎樣獲得和改變雙擊鼠標的時間間隔？
獲得鼠標雙擊間隔時間:
Public Declare Function GetDoubleClickTime Lib "user32" Alias _ "GetDoubleClickTime" () As Long
獲得鼠標雙擊間隔時間:
Declare Function SetDoubleClickTime Lib "user32" (ByVal wCount As Long ) As Long
'注意：這種改變將影響到整個操作系統
以上兩個函數都可精確到毫秒級?
13、在程序中如何打開和關閉光驅門？
*API函數聲明如下:
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String , ByVal lpstrReturnString As String , ByVal uReturnLength As Long , ByVal hwndCallback As Long ) As Long
'調用時的代碼如下
Dim Ret As Long
Dim RetStr As String
'打開光驅門
Ret = mciSendString("set CDAudio door open" , RetStr, 0, 0)
'關閉光驅門
Ret = mciSendString("set CDAudio door closed" , RetStr, 0, 0)
14、如何獲得Windows啓動方式?
在Form1中加入一個CommandButton?一個Label並加入如下代碼:
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long ) As Long
Const SM_CLEANBOOT = 67
Private Sub Command1_Click ()
Select Case GetSystemMetrics(SM_CLEANBOOT)
Case 1
Label1 = "安全模式."
Case 2
Label1 = "支持網絡的安全模式."
Case Else
Label1 = "Windows運行在普通模式."
End Select
End Sub
15、怎樣使Ctrl-Alt-Delete無效？
*API函數聲明
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long , ByVal uParam As Long , ByVal lpvParam As Any, ByVal fuWinIni As Long ) As Long
編寫如下函數:
Sub DisableCtrlAltDelete(bDisabled As Boolean )
Dim X As Long
X = SystemParametersInfo(97, bDisabled, CStr (1), 0)
End Sub
使Ctrl -Alt - Delete無效:
Call DisableCtrlAltDelete(True )
恢復Ctrl -Alt - Delete:
Call DisableCtrlAltDelete(False )
16、如何移動沒有標題欄的窗口？
我們一般是用鼠標按住窗口的標題欄，然後移動窗口，當窗口沒有標題欄時，我們可以用下面的方法來移動窗口：
*API函數聲明：
Declare Function ReleaseCapture Lib "user32" () As Long Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long , ByVal wMsg As Long , ByVal wParam As Long , lParam As Any) As Long
Public Const HTCAPTION = 2
Public Const WM_NCLBUTTONDOWN = &HA1
在 Form _MouseDown 事件中：
Private Sub Form _MouseDown(Button As Integer, ShIft As Integer, X As Single , Y As Single )
ReleaseCapture SendMessage hwnd, WM_NCLBUTTONDOWN, HTCAPTION,0&
End Sub
17、VB中如何使用延時函數？
*API函數聲明：
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long )
調用:
'延時1秒
Call Sleep(1000)
18 ?調用修改屏幕保護口令的窗口:
Private Declare Function PwdChangePassword Lib "mpr" Alias "PwdChangePasswordA" (ByVal lpcRegkeyname As String , ByVal hwnd As Long , ByVal uiReserved1 As Long , ByVal uiReserved2 As Long ) As Long
調用:
Call PwdChangePassword("SCRSAVE" , Me.hwnd, 0, 0)
19 ?使Windows開始屏幕保護:
*API函數聲明
Private Declare Function SendMessage Lib "user32" ()
Alias "SendMessageA" (ByVal hWnd As Long , ByVal wMsg
As Long , ByVal wParam As Long , ByVal lParam As Long )
As Long
Const WM_SYSCOMMAND = &H112&
Const SC_SCREENSAVE = &HF140&
'調用
Dim result As Long
result = SendMessage(Form1.hwnd, WM_SYSCOMMAND, SC_SCREENSAVE, 0&)
20、如何改變Windows桌面背景？
*API函數聲明
Const SPI_SETDESKWALLPAPER = 20
Const SPIF_UPDATEINIFILE = &H1
Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long , ByVal uParam As Long , ByVal lpvParam As Any, ByVal fuWinIni As Long ) As Long
'調用
Call SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, "C:windowsClouds.bmp" , SPIF_UPDATEINIFILE)
21、怎樣確定系統是否安裝了聲卡？
*API函數聲明：
Declare Function waveOutGetNumDevs Lib "winmm.dll" () As Long
代碼如下:
Dim I As Integer
I = waveOutGetNumDevs()
If I > 0 Then MsgBox "你的系統可以播放聲音。" , vbInformation, "聲卡檢測"
Else
MsgBox "你的系統不能播放聲音。" , vbInformation, "聲卡檢測"
End If
22、如何找到CD-ROM驅動器的盤號？
下面的函數將檢查你計算機所有的驅動器看是否是 CD-ROM，如果是就返回驅動器號，如果沒有就返回空字符
Public Function GetCDROMDrive() As String
Dim lType As Long , I As Integer, tmpDrive As String , found As Boolean
On Error GoTo errL
For I = 0 To 25
tmpDrive = Chr (65 + I) & ":"
lType = GetDriveType(tmpDrive) 'Win32 API 函數
If (lType = DRIVE_CDROM) Then 'Win32 API 常數
found = True
Exit For
End If
Next
If Not found Then tmpDrive = ""
BI_GetCDROMDrive = tmpDrive
Exit Function
errL: MsgBox Error $
End Function
23、如何將文件放入回收站？
**API函數聲明
Public Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As Long
End Type
Public Declare Function SHFileOperation Lib _ "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Public Const FO_DELETE = &H3
Public Const FOF_ALLOWUNDO = &H40
'調用
Dim SHop As SHFILEOPSTRUCT, strFile As String
With SHop
.wFunc = FO_DELETE
.pFrom = strFile + Chr (0)
.fFlags = FOF_ALLOWUNDO
End With
24、VB中如何使用未安裝的字體？
Declare Function AddFontResource Lib "gdi32" Alias "AddFontResourceA" (ByVal lpFileName As String ) As Long
Declare Function RemoveFontResource Lib "gdi32" Alias "RemoveFontResourceA" (ByVal lpFileName As String ) As Long
增加字體:
Dim lResult As Long
lResult = AddFontResource("c:myAppmyFont.ttf" )
刪除字體:
Dim lResult As Long
lResult = RemoveFontResource("c:myAppmyFont.ttf" )
2.VB6.0編程"雜耍"
--------------------------------------------------------------------------------
雜耍一?防止自身被多次運行
如果你不希望你的VB應用程序被用戶通過多次雙擊圖標而重複運行，導致內存不足或其它意外，你可以在程序中增加以下幾行,檢查發現如果程序已經被運行過，則給出提示後結束：
Private Sub Form _Load()
If App.PrevInstance Then
MsgBox "嘟....,程序正在運行，請檢查窗口是否被最小化。:-)"
End If
End Sub
◆說明:App是VB內置的應用對象,通過訪問他的屬性可以得到應用程序的標題、版本信息、可執行文件和幫助文件的路徑及名稱等信息，尤其是App.Path很經常用到的。
◆可能的用途:各種不希望被多次運行的程序，例如數據庫應用程序等。
雜耍二?右鍵菜單
Windows的桌面和許多流行軟件都提供右鍵菜單功能，就是在相應控件上單擊鼠標右鍵時彈出菜單實現某些功能，方便快捷，許多編程愛好者也很想實現類似功能吧，方法如下：
1、利用VB的菜單編輯器（Menu Editor）編輯你希望彈出的菜單(子選單)，並將此菜單的Visible屬性設置爲False。
2、在相應控件的MouseDown事件中編寫程序，來調用編輯好的菜單，假設菜單名爲demoMenu，並且相應控件名稱是ListView1,程序源碼如下：
Private Sub ListView1_MouseDown(Button As Integer, ShIft As Integer, X As Single , Y As Single )
If Button = vbRightButton Then
PopupMenu demoMenu
End If
End Sub
◆說明:可以用在包括窗口的任何控件中,關鍵是彈出菜單技術。
◆可能的用途:程序最小化到任務欄右面，縮小爲一個圖標，經常使用這種技巧。
雜耍三?訪問指定的網址和發Email的簡單方法
讓自己的程序打開瀏覽器訪問某個網址或者系統指定的默認郵件服務程序，通常的方法是採用API函數ShellExecute，其實我們還有更簡單的方法，只用一句程序變可完成，免去調用API函數的麻煩：
1 ?訪問指定的網址:
Shell "start http://tyvb.csol.net"
2 ?給指定的電子信箱發Email:
Shell "start mailto:[email protected]?subject=你好"
◆說明:
1、其中的http://tyvb.csol.net你可以根據需要指定,系統會根據默認的瀏覽器打開指定的網頁。
2、其中[email protected]可以變成你自己想要發送郵件的地址,subject後面的是待發送電子郵件的主題，系統會根據默認的電子郵件服務程序，發送郵件。
◆可能的用途:用在"關於" 窗口中，使用戶方便和軟件作者聯繫。
雜耍四?鼠標變臉
爲了使你的程序更專業 , 在需要等待的過程中可做如下處理:
處理過程前:
Screen.MousePointer = vbHourglass
處理過程後
Screen.MousePointer = vbDefault
◆說明:MousePointer還可以取VbArrow等各種系統經常用到的鼠標指針的類型，滿足您不同的應用，甚至還可以自己定製。
◆可能的用途:用在操作時間較長，需要用戶等待的程序中。
雜耍五?播放AVI文件
AVI文件是語音和影像同步組合在一起的文件格式。使用VB6.0中的多媒體控件MMControl設計播放AVI文件的程序方法如下：
在Form1上建立一個多媒體控件MMControl1，並建立一個圖片框Picturer1,並設定MMControl對象的按鈕屬性。在應用程序所在目錄放上自己喜歡的AVI文件，並命名爲demo.avi
在窗口加載的事件裏寫如下代碼:
Private Sub Form _Load()
MMControl1.DeviceType = "AVIVideo"
MMControl1.FileName = App.Path & "demo.avi"
MMControl1.hWndDisplay = Picture1.hwnd
MMControl1.Command = "Open"
End Sub
程序運行後，單擊播放鍵，慢慢欣賞吧。
◆說明:
1、DeviceType="AVIVideo" ，是設定MCI播放媒體的種類。多媒體控件除了可以播放AVI文件還可以播放WAV文件和MID文件和 VCD文件，只要把AVIVIDEO變成WAV、MID、CDaudio和MPEGVideo即可,當然其他語句也要相應改變。
2、HwndDisplay=Picture1.hWnd,是把AVI文件在圖形框中播放，如果沒有這一行，將自動開啓一個窗口播放。
◆可能的用途:
1 ?實現簡單的多媒體教學程序或小遊戲軟件?
2 ?可以放在程序的啓動窗口裏做一個動態的歡迎畫面?
雜耍六?播放Flash文件
Flash是一種矢量格式的動畫文件,可以包含動畫，聲音，超文本鏈接，而文件的體積卻很小,如何用VB播放呢？用MicroMedia公司提供的空間Swflash.ocx就可以,方法如下：
將Flash控件放到窗體上，並調整至適當的大小，設置scale model屬性爲2，在應用程序目錄下放一個Flash文件，假設爲demo.swf，在窗口上添加命令按鈕Command1。
程序代碼如下:
Private Sub Command1_Click ()
ShockwaveFlash1.Movie = App.Path & "demo.swf"
ShockwaveFlash1.Playing = True
End Sub
◆說明：要獲得SwFlash.ocx只要安裝Flash4.0即可，加載的方法是:在工具箱上單擊右鍵，選擇部件，在部件窗口的控件列表中選擇Shockwave flash，然後確定，Flash控件就被加到工具箱上。
◆可能的用途:利用Flash的功能實現漂亮的菜單等趣味程序。
雜耍七?重新啓動計算機
1、API函數ExitWindowsEx，可以用來實現重新啓動計算機或者關閉Windows。
把下面的這段代碼拷貝到模塊得聲明部分:
Public Const EWX_LOGOFF = 0
Public Const EWX_SHUTDOWN = 1
Public Const EWX_REBOOT = 2
Public Const EWX_FORCE = 4
Public Const EWX_POWEROFF = 8
Declare Function ExitWindowsEx Lib "user32" _
(ByVal uFlags As Long , ByVal dwReserved _
As Long ) As Long
如果你想要重新啓動計算機，只需要插入下面的代碼就可以了：
Call ExitWindowsEx(EWX_REBOOT, 0)
◆說明:
參數說明如下:
EWX_FORCE 所有的進程都被強制終止?
EWX_LOGOFF 所有的進程被強制終止,並且用戶退出登錄(logged off)。
EWX_POWEROFF 計算機系統被關機, 並且如果支持節電特性, 則計算機被物理關機?
EWX_REBOOT 計算機系統被關機並重新啓動?
EWX_SHUTDOWN 計算機被物理地安全地關機?
可根據需要使用相應的參數，還可以把這幾個常量加起來作爲組合的功能呢。
◆可能的用途:
在安裝程序修改了系統文件後，需要重新啓動Windows來完成安裝時，這段代碼就顯得特別有用了。 還有就是給朋友一個胡鬧的小東西(啊,我跑.....)
3.用VB編制Tcp/IP程序
--------------------------------------------------------------------------------
隨着Internet 爆炸式的發展及Windows用戶不斷地增多，人們迫切地需要一種在Windows下開發TCP/IP應用程序標準,由包括微軟公司在內的衆多計算機廠家,經共同努力,已經制訂出了這一標準,稱之爲Windows Sockets API(application Program interface)。這使得不同廠家開發的應用程序能夠做到相互兼容。
一、TCP/IP編譯簡介:
當兩臺計算機通過網絡要進行信息交換時 , 需要具備兩個條件: 一是物理配件 , 這包括網卡及連接網卡用的網線, 二是需要一組通訊參數的說明, 即協議?目前最廣泛使用的協議是TCP / IP協議?
當一個主機使用IP協議發送數據時 , 數據被分爲數據包.每個數據包由其包頭及數據組成, 包頭包含對方目的地址?這就象使用信封發信一樣, 信封上含有收方的地址, 但有時發出的信也會丟掉, 這種發送稱爲不可靠的傳輸, 而我們需要的是可靠的傳輸, 這便產生了TCP協議?
TCP是一種面向連接的協議,即:兩個程序在進行數據交換之前,他們必須先建立起連接,一個程序作爲客戶方(client)發出連接請求,另一個程序作爲服務方(server)監聽,並響應其連接請求,一旦連接建立好,雙方便均可收發信息,直到連接斷開。TCP協議使得開發人員不需要去編寫如何處理數據包丟失的過程,而專心於應用程序本身的開發。
爲了同其他計算機進行通信,還需要知道本機及目的機的IP地址,有時爲方便記憶我們將32位的IP地址用主機名來代替,主機名間用"·" 分隔,我們稱之爲域,域是一種樹形結構。如: 最上一層爲政府、商業公司、教育機構、internet服務商等組織,一個完整的域名是由主機及其所有的父名組成(用 '·'分隔),例如mars的完整域名爲mars·olgmpus·com,其表達的含意爲mars是olgmpus域名的一部分,而olgmpus又是com的一部分。IP地址到主機名的轉換有兩種方法,一是使用本地的主機命名錶文件,這個文件通常稱爲hosts文件,表中列出了IP地址及主機名的對應關係；二是使用命名服務器 (DNS),它是一臺主機(或一個應用程序),可以將一主機名轉換爲其IP地址。
此外,除了雙方的IP地址以外,還需要知道對方的服務端口號(Service Port),它是一個16位的標識,每一Service Port同一應用程序相對應,這些對應關係往往存在於名爲Service的一個文件中,一些常用的服務及對應的
Service Port如下:
Service Servicse Port
FTP 21
Telnet 23
SMTP 25
DNS 53
TFTP 69
SNMP 161
TCP 6
UDP 17
有了以上各信息,兩應用程序在進行通訊時,先建立一個Socket(或稱爲通訊端點),建立了Socket本身並不能進行信息交換,你還必須建立 Socket的連接,Socket的地址由三部分組成:協議、IP地址、Service Port號。其協議標識着下一層所使用何種協議,在我們以下的例子中就是指IP協議。
在兩個應用程序進行通訊時,客戶方建立一個Socket並試圖同服務方建立連接,服務方也建立一個Socket等待客戶方發來的連接請求,當收到一個申請後,雙方便形成一條虛電路(即兩個程序之間的一條邏輯通訊鏈路)。在此強調一下:當服務方收到連接請求後,服務方建立一新的Socket,用此新的 Socket同對方建立連接,原來的Socket保持不變,可繼續等待其它連接請求,當服務方不再希望收到其它連接時,它將最早的Socket關閉。
在建立一個TCP通訊程序時 , 服務方的程序應完成以下五個步驟:
1 Print 建立一個Socket
2 Print 監聽從客戶方發來的連接請求
3 Print 接受客戶方的連接
4 ?開始收?發信息
5 Print 關閉Socket, 終結會話
在客戶方應完成以下五個步驟:
1 Print 建立一個Socket
2 Print 指定服務方IP地址及Service; Port
3 Print 同服務方建立連接
4 ?開始收?發信息
5 Print 關閉Socket, 終結會話
由上可以看出服務方和客戶方的第二步和第三步是不同的,另外,在開發應用程序時,你可能會遇到阻塞式和非阻塞式Socket。例如:當你從Socket讀數據時,如果遠方主機還未將數據傳來,你就讀不到數據,這會引發兩種情況:一是程序一直等待,直到數據到達；二是程序立即返回並標識一個讀錯誤。前者我們稱之爲阻塞式Socket,後者爲非阻塞式Socket,在非阻塞式的情況下,程序開發者應當做出適當的處理。一般有兩種處理方法:第一種爲輪詢法,即程序週期的去讀Socket;第二種是較好的一種方法,異步通知法，即當Socket發生事件時,能夠通知應用程序,如:Socket收到遠方主機發來的數據時,Socket會產生一個"讀事件" ,應用程序便可從Socket中讀出數據了。
二、TCP/IP編程實例
1.客戶方軟件的編制:
下面的例子假設讀者對VB編程有一定的瞭解 , 其工作流程是: 客戶方發出的一串信息到服務方 , 服務方收到後將收到的信息全部傳回來?
首先用VB創建一個帶有三個標記、三個文本控件、一個控制按紐及一個SocketWrench控件，當使用時,用戶在Text1中輸入遠端主機IP的地址或主機名,將要發送的信息輸入到Text2中，服務方返回的信息便在Text3中顯示。Text2及Text3的Enable屬性在初始時設爲 False。程序如下:
Sub Form Load()
Socket1.AddressFamily=AF INET
Socket1.Protoco1=IPPROTO IP
Socket1.Type=SOCK STREAM
Socket1.Binary = False
Socket1.BufferSize=1024
Socket1.Blocking = False
End Sub
當點擊Connect後 , 便可建立同遠方主機的連接, 其過程如下:
Sub Command Click ()
Socket1.HostName=Trim＄(Text1.Text )
Socket1.RemotePort=IPPORT ECHO
Socket1.Action=SOCKET CONNECT
End Sub
在初始化的過程中 , 我們已將其Socket定爲非阻塞式的(Socket1.Blocking = Fasle), 因此它不必等待連接建立完, 而是直接返回, 並等待connect事件, 當此事件發生後對其進行響應, 程序如下:
Sub Socket1 Connect()
Text2.Enabled = True
Text3.Enabled = True
End Sub
此時 , Text2, Text3便可進行數據的輸入 / 輸出了?下一步的程序爲真正的收發過程, 在Text2控件中加入KeyPress事件:
Sub Text2 KeyPress(KeyAscii As Integet)
If KeyAscii=13 Then
Socket1.SendLen=Len (Text2.Text )
Socket1.SendData = Text2.Text
KeyAscii=0:Text2.Text =""
End If
End Sub
當按下Enter時(KeyPress=13)數據便會發往遠程主機發送數據,遠程主機接到數據並傳回,並在客戶方產生一個讀事件,處理讀事件的過程如下:
Sub Socket1 Read(DataLength As Integer,IsUrgent As Integer)
Socket1.RecvLen = DataLength
Text3.Text = Socket1.RecvData
End Sub
當終結此連接時,在Form unload事件處加如下過程:
Sub Form Unload(Cancel As Integer)
If Socket1.Connected Then Socket1.Action=SOCKET CLOSE
End If
End Sub
到此 , 一個較爲完整的VB程序已經完成, 但是如果輸入IP的地址或主機名不正確時, 還需要編一個處理程序, 這已超過本篇介紹的目的, 在此就不做介紹了.
2 Print 服務方軟件的編制
服務方軟件的第一件事情就是監聽是否有連接的請求,當SocketWrench收到連接請求時,就會產生一個Accept事件,這時有兩種處理方法:一是將Action屬性設置爲SOCKET ACCEPT;二是對Accept屬性進行設置。前者較爲簡單但有侷限性,因爲它將結束監聽其它的連接請求,只能同第一個客戶建立連接。後者較爲靈活但較爲複雜,其方法是對Accept設置屬性。然而,正在監聽的控件不能設置Accept屬性,必須利用閒置的Socket來對其進行設置,因此就需要一個控件組來處理多個連接。爲方便起見,我們還利用前面使用的Form來編制服務方的應用。首先是再加上一個SocketWrench控件,並使之成爲控件組。開始時此控件組中只有一個控件。稱爲Socket2(0),這個控件組用來監聽連接請求,同客戶方一樣,也需先對其進行初始化:
Sub Form Load()
Socket1.AddressFamily=AF INET
Socket1.Proyocol=IPPROTO IP
Socket1.Type=SOCK STREAM
Socket1.Binary = False
Socket1.BufferSize=1024
Socket1.Blocking = False
Socket2(0) .Addr essFamily=AF INET
Socket2(0) .Proyocol=IPPROTO IP
Socket2(0) .Type=SOCK STREAM
Socket2(0) .Blocking=False
Socket2(0) .Localport=IPPORT ECHO
Socket2(0) .Action=SOCKET LISTEN
LastSocket=0
End Sub
其中local port指明瞭當接到對方數據時, 將其全部傳回的一個TCP系統應用?當服務器收到連接請求時, 就會出現一個Accept事件, 相應的處理過程如下:
Sub Socket2 Accept(Index As Integer,Sockerid As Integer)
Dim I As Integer
For I = 1 To LastSocket
If Not Socket2(I).Connected Then Exit For
Next I
If I>LastSocket Then
LastSocket = LastSocket + 1: I = LastSocket
Load Socket2(I)
End If
Socket2(I).AddressFamily=AF INET
Socket2(I).Protocol=IPPROTO IP
Socket2(I).Type=SOCK STREAM
Socket2(I).Binary = True
Socket2(I).BufferSize=1024
Socket2(I).Blocking = False
Socket2(I).Accept = SocketId
End Sub
以上程序收到一個連接時,產生一個新的SocketWrench控件,在對其進行初始化之後,便可同客戶方通訊了.原Socket繼續監聽是否有新的連接請求。服務方收到數據後,將全部數據再傳回客戶方,其處理過程如下;
Sub Socket2 Read(Index As Integer,DataLength As Integer,IsUrgent As Integer)
Socket2(Index).RecvLen = DataLength
Socket2(Index).SendLen = DataLength
Socket2(Index).SendData = Socket2(Index).RecvData
End Sub
當客戶方關閉連接 , 服務方也關閉相應Socket的控制, 過程如下:
Sub Socket2 Close(Index As Integer)
Socket2(Index).Action=SOCKET CLOSE
End Sub
斷開所有連接的程序如下:
Sub From Unload(Cancel As Integer)
Dim I As Integer
If Socket1.Connected Then Socket1.Action=SOCKET CLOSE
If Socket2(0).Listening Then Socket2(0).Action=SOCKET CLOSE
For I = 1 To LastSocket
If Socket2(0).Connected Then Socket2(0).Action=SOCKET CLOSE
Next I
End
End Sub
到這裏，我們就可以使用這個程序利用TCP/IP協議進行信息交換了。