vb文章--有实用价值

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 LongByVal  hWndInsertAfter As LongByVal  X As LongByVal  Y As LongByVal  cx As LongByVal  cy As LongByVal  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 LongByVal  X As LongByVal  Y As _ LongByVal  crColor As Long
'设(fillx,filly)为此区域内任一点
'Color为某种颜色
FloodFill Picture1.hDC, fillx, filly, Color

4、如何关闭计算机?
*API函数声明
Declare Function  ExitWindows Lib "User"  (ByVal  dwReturnCode As LongByVal  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 StringByVal  nSize As Long ) As Long
Public  Declare Function  GetSystemDirectory Lib "kernel32"  Alias "GetSystemDirectoryA"  (ByVal  lpBuffer As StringByVal  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 LongByVal  lpOperation As StringByVal  lpFile As StringByVal  lpParameters As StringByVal  lpDirectory As StringByVal  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 LongByVal  wMsg As LongByVal  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 LongByVal  wMsg As LongByVal  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 LongByVal  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 StringByVal  lpstrReturnString As StringByVal  uReturnLength As LongByVal  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 LongByVal  uParam As LongByVal  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 LongByVal  wMsg As LongByVal  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 StringByVal  hwnd As LongByVal  uiReserved1 As LongByVal  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 LongByVal  wMsg
As LongByVal  wParam As LongByVal  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 LongByVal  uParam As LongByVal  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 LongByVal  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通讯程序时 , 服务方的程序应完成以下五个步骤: 
Print  建立一个Socket
Print  监听从客户方发来的连接请求
Print  接受客户方的连接
4 ?开始收?发信息
Print  关闭Socket, 终结会话

在客户方应完成以下五个步骤: 
Print  建立一个Socket
Print  指定服务方IP地址及Service; Port
Print  同服务方建立连接
4 ?开始收?发信息
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协议进行信息交换了。

發表評論
所有評論
還沒有人評論,想成為第一個評論的人麼? 請在上方評論欄輸入並且點擊發布.
相關文章