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协议进行信息交换了。