分类： 编程园地

Public Sub ReplaceWord(ByVal vWord As Variant, ByVal sOld As String, ByVal sNew As String)
Const wdReplaceAll = 2
Const wdFindStop = 0
Dim oRange As Object
Set oRange = vWord.Selection.Range
‘先判断是否有选中区域，没有选中则表示整个文档
If oRange.Start = oRange.End Then
Set oRange = vWord.ActiveDocument.Content
End If
With oRange.Find
‘批量查找替换 sOld 为 sNew
bRet = .Execute(FindText:=sOld, replacewith:=sNew, Replace:=wdReplaceAll)
‘Debug.Print bRet
‘Debug.Print oRange.Words.Count
End With
End Sub

Public Sub InsPageNumber(ByVal vWord As Variant) ‘其实是 vDocument
On Error GoTo ERR_PAGENUMBER
‘设置Word文档第一页页码
Dim oRange As Object
Set oRange = vWord.ActiveDocument.Sections(1).Footers(1).Range ‘wdHeaderFooterPrimary = 1
With oRange
.InsertAfter “第”
‘.Font.Size = 14
.Collapse Direction:=0 ‘wdCollapseEnd = 0
‘插入页码域
.Fields.Add Range:=oRange, Type:=-1, Text:=”PAGE * Arabic “, PreserveFormatting:=True ‘wdFieldEmpty = -1
.Expand Unit:=2 ‘wdWord = 2
.InsertAfter “页”
.InsertAfter “共”
.Collapse Direction:=0 ‘wdCollapseEnd = 0
‘插入页数域
.Fields.Add Range:=oRange, Type:=-1, Text:=”NUMPAGES * Arabic “, PreserveFormatting:=True ‘wdFieldEmpty = -1
.Expand Unit:=2 ‘wdWord = 2
.InsertAfter “页”
‘.InsertAfter “YagerSoft”
.ParagraphFormat.Alignment = 2 ‘wdAlignParagraphRight = 2 ‘右对齐
End With
‘隐藏页眉的横线
vWord.ActiveDocument.Sections(1).Headers(1).Range.Borders(-3).Visible = False ‘wdBorderBottom = -3
‘取得页眉的内容
‘Debug.Print vWord.ActiveDocument.Sections(1).Headers(2).Range.Text ‘wdHeaderFooterFirstPage = 2
Set oRange = Nothing
On Error GoTo 0
Exit Sub
ERR_PAGENUMBER:
On Error GoTo 0
End Sub

Public Sub InsPageBreak(ByVal vWord As Variant)
On Error GoTo ERR_BREAK
‘wdPropertyTitle = 1标题
‘wdPropertySubject = 2主题
‘wdPropertyAuthor = 3作者
‘wdPropertyKeywords = 4关键词
‘wdPropertyComments = 5批注
‘wdPropertyTemplate = 6模板
‘wdPropertyLastAuthor = 7上一个作者
‘wdPropertyRevision = 8修订次数
‘wdPropertyAppName = 9应用程序名
‘wdPropertyTimeLastPrinted = 10上次打印时间
‘wdPropertyTimeCreated = 11创建时间
‘wdPropertyTimeLastSaved = 12上次保存时间
‘wdPropertyVBATotalEdit = 13编辑时间总计
‘wdPropertyPages = 14页数
‘wdPropertyWords = 15字数
‘wdPropertyCharacters = 16字符数
‘wdPropertySecurity = 17安全性
‘wdPropertyCategory = 18类别
‘wdPropertyFormat = 19
‘wdPropertyManager = 20经理
‘wdPropertyCompany = 21公司
‘wdPropertyBytes = 22字节数
‘wdPropertyLines = 23行数
‘wdPropertyParas = 24段数(空白文档 BuiltInDocumentProperties(wdPropertyParas) = 0，而 vWord.ActiveDocument.Paragraphs.Count = 1)
‘wdPropertySlides = 25
‘wdPropertyNotes = 26注释
‘wdPropertyHiddenSlides = 27
‘wdPropertyMMClips = 28
‘wdPropertyHyperlinkBase = 29
‘wdPropertyCharsWSpaces = 30字符数（计空格）
If vWord.ActiveDocument.BuiltInDocumentProperties(15) = 0 Then Exit Sub ‘wdPropertyWords = 15
vWord.Selection.EndKey Unit:=6 ‘wdStory = 6 ‘将光标移到最后
vWord.Selection.InsertBreak Type:=7 ‘wdPageBreak = 7 ‘插入分页符
On Error GoTo 0
Exit Sub
ERR_BREAK:
On Error GoTo 0
End Sub

Public Function FindWord(ByVal vWord As Variant, ByVal sData As String) As Boolean
Dim oSelection As Object
Set oSelection = vWord.ActiveDocument.Content
‘利用FIND查找 sData ，从光标之处开始查找，查找到后选中。
With oSelection.Find
‘查找的方向向下
.Forward = True
‘取消在查找或替换操作中所指定文本的文本格式和段落格式
.ClearFormatting
‘查找操作查找仅完整单词，而不是较长单词的一部分的文本
.MatchWholeWord = True
‘查找时不区分大小写
.MatchCase = False
‘到达文档末尾时，继续从文档开头进行搜索
.Wrap = 1 ‘wdFindContinue
‘运行指定的查找操作。如果查找成功，则返回 True
.Execute FindText:=sData
End With
FindWord = oSelection.Find.Execute
End Function

Public Function GetTextSite(ByVal vWord As Variant, ByVal sText As String) As Integer ‘返回 sText 在 vWord 中首次出现的段号
‘耗时过长不宜用
Dim I As Integer, J As Integer
GetTextSite = 0
If vWord Is Nothing Then Exit Function
If vWord.Documents.Count = 0 Then Exit Function
If sText = “” Then Exit Function
For I = 1 To vWord.ActiveDocument.Paragraphs.Count
DoEvents
‘If vWord.ActiveDocument.Paragraphs(I).Range.Text = sText Then
If InStr(1, vWord.ActiveDocument.Paragraphs(I).Range.Text, sText, vbTextCompare) > 0 Then
GetTextSite = I
Exit For
End If
Next I
End Function

Public Function ReplaceMultiChar(ByVal sData As String, ByVal sChar As String) As String ‘用单字符替换连续字符
sData = Trim(sData)
Dim iBefore, iAfter As Integer
Do
iBefore = Len(sData)
sData = Replace(sData, sChar & sChar, sChar)
iAfter = Len(sData)
Loop Until iBefore = iAfter
ReplaceMultiChar = sData
End Function

Public Function GetExtension(ByVal sName As String) As String ‘扩展名
GetExtension = “”
If InStr(1, sName, “.”, vbTextCompare) = 0 Then Exit Function
Dim TempArray As Variant
TempArray = Split(sName, “.”, -1, vbTextCompare) ‘名字可能会含 .
GetExtension = TempArray(UBound(TempArray)) ‘扩展名
End Function

Public Function GetBare(ByVal sName As String) As String ‘不带扩展名的名
GetBare = “”
If InStr(1, sName, “.”, vbTextCompare) = 0 Then Exit Function
Dim TempArray As Variant
TempArray = Split(sName, “.”, -1, vbTextCompare) ‘名字可能会含 .
ReDim Preserve TempArray(LBound(TempArray) To UBound(TempArray) – 1) ‘去扩展名
GetBare = Join(TempArray, “.”)
End Function

Public Function GetFullName(ByVal sPath As String, ByVal sShortName As String) As String ‘文件全名
‘If Right(sPath, 1) = “\” Then
‘GetFullName = sPath & sShortName
‘Else
‘GetFullName = sPath & “\” & sShortName
‘End If
‘下句等同以上内容
GetFullName = IIf(Right(sPath, 1) = “\” Or Left(sShortName, 1) = “\”, sPath & sShortName, sPath & “\” & sShortName)
GetFullName = ReplaceMultiChar(GetFullName, “\”)
End Function

Public Function GetShortName(ByVal sFullName As String) As String ‘文件短名
If sFullName = “” Then
GetShortName = “”
Else
Dim TempArray As Variant
TempArray = Split(sFullName, “\”, -1, vbTextCompare)
GetShortName = TempArray(UBound(TempArray))
End If
End Function

Public Function GetPath(ByVal sFullName As String) As String ‘文件路径
‘Dim I As Integer
‘For I = Len(sFullName) To 1 Step -1
‘If Mid(sFullName, I, 1) = “\” Then
‘GetPath = Left(sFullName, I – 1)
‘Exit Function
‘End If
‘Next I
Dim TempArray As Variant
TempArray = Split(sFullName, “\”, -1, vbTextCompare)
If LBound(TempArray) = UBound(TempArray) Then ‘短名
GetPath = “”
Else
ReDim Preserve TempArray(LBound(TempArray) To UBound(TempArray) – 1) As String
GetPath = Join(TempArray, “\”)
End If
End Function

Public Function GetShortPath(ByVal sFullName As String) As String ‘文件当前文件夹
Dim TempArray As Variant
TempArray = Split(sFullName, “\”, -1, vbTextCompare)
GetShortPath = TempArray(UBound(TempArray) – 1)
End Function

Public Function DirExist(ByVal sData As String) As Boolean ‘(全名)目录存在
DirExist = False
If Trim(sData) = “” Then Exit Function ‘Dir(“”) 出错, 且无声无息
If Dir(sData, vbDirectory) = “” Then Exit Function ‘不存在
If Not (GetAttr(sData) And vbDirectory) = vbDirectory Then Exit Function ‘是文件
DirExist = True
End Function

Public Function FileExist(ByVal sData As String) As Boolean ‘(全名)文件存在
FileExist = False
If Trim(sData) = “” Then Exit Function ‘Dir(“”) 出错, 且无声无息
If Dir(sData) = “” Then Exit Function ‘不存在
If (GetAttr(sData) And vbDirectory) = vbDirectory Then Exit Function ‘是目录
FileExist = True
End Function

从 0 开始编写一段用于通信的程序，必须对相关的网络协议及其他的一些较底层的技术有较深入的了解，这显然有明显的难度。而利用 Winsock 控件，一切就不同了，它已经替你封装了所有烦琐的技术细节，并提供了访问 TCP 和 UDP 网络服务的方便途径。你只需通过设置控件的属性并调用其方法就可轻易连接到一台远程计算机中，并且还可以双向交换数据，而这一切都不需你了解 TCP 的细节或调用低级的Winsock APIs。
　　Winsock 控件可以供 Microsoft Acess、Visual Basic，Visual C++或 Visual Foxpro 的开发人员使用。
　　本文以 Visual Basic 6 企业版为开发环境来向大家介绍一下 Winsock 控件的初步应用。
　　Winsock控件可以使用两种协议：TCP 协议和 UDP 协议，下面来分别介绍。
　　TCP 协议即数据传输协议，它允许创建和维护与远程计算机的连接，使其彼此可以进行数据传输。利用TCP协议通讯必须分别建立客户应用程序和服务器应用程序。
　　在创建客户应用程序时，必须知道服务器计算机名或其 IP 地址(存于 RemoteHost 属性)、及服务器计算机进行侦听的端口(存于 RemotePort 属性），然后调用 Connect 方法。
　　创建服务器应用程序时，就应相应设置一个侦听端口(LocalPort属性)并调用listen方法。当客户机需要连接时(connect)，就会发生ConnectionRequest事件。为了完成连接，你可以在ConnectionRequest事件中调用Accept方法。建立连接后，任何一方计算机都可以发送、接收对方数据。如果你要发送数据，需调用SendData方法。当接收到数据时，会发生DataArrival事件，调用 DataArrival 事件中的 GetData 方法就可以获得对方传送的数据。
　　说了这么多，大家可能还是不太了解，让我用程序来详细说明。
　　如果只有两台计算机，那十分容易。假设甲机为客户机，乙机为服务器，且其 IP 为192.192.192.1，接收端口为1200(任意选一个未被使用的端口即可)。首先在甲机客户端程序中加入一个 Winsock 控件，起名为 sckconnect，并设置其属性：RemoteHost=“192.192.192.1”，（即甲机IP地址）， RemotePort=1200（即甲机侦听端口）；再在乙机服务器程序中加入一个名为sckserver(0)的Winsock控件，其LocalPort=1200。
　　在乙机服务器程序中Form_Load()加入
　　sckserver(0).bind sckserver(0).LocalPort ‘与本地端口绑定
　　sckserver(0).listern ‘ 侦听
　　如果要传输数据，两机必须先建立连接。建立连接的程序如下：
　　甲机客户机要先请求连接
　　sckconnect.connect sckconnect.RemoteHost, sckconnect.RemotePort
　　此句执行时会触发服务器程序中的ConnectRequest事件，在此过程中决定是否建立连接，其代码如下：
　　Private sub sckserver_connectionrequest(index as Integer,Byval requestid as long)
　　if sckserver.count=1 then
　　load sckserver(1)
　　sckserver(1).accept requestId
　　end if
　　end sub
　　连接建立好以后，甲机或乙机都可以应用SendData方法来传送数据。例如，如果是甲机要传送一个叫string的字符串，只需在代码中加入：
　　sckconnect.SendData string
　　甲机传送数据后，会触发乙机的DataArrival事件，在其过程中用GetData方法可以收到传送的数据：
　　Private sub sckserver_DataArrival(Index as integer,Byval BytesTotal as long)
　　dim sdata as string
　　sckserver(1).GetData sdata,vbstring
　　end sub
　　最后别忘了在关闭程序前要先关闭Winsock控件
　　privat sub form_unload(cancel as integer)
　　if sckconnect.state <>sckclosed then
　　sckconnect.close
　　end if
　　end sub
　　这只是最简单的情况，如果有多台计算机，那就稍微复杂一些，客户端程序可以不做改动，而服务器端程序需要略做改动：
　　Private sub sckserver_connectrequest(Index as Integer,Byval requestid as long)
　　dim sip as string
　　dim I as integer
　　sip=sckserver(0).RemoteHostIP ‘获得登录者的IP地址
　　I=1
　　Do while I<=sckserver.ubound ‘检查是否已经有该地址的记录 　　If sckserver(I).RemoteHostIP=sip then ‘如有，不必加载新的控件 　　Sckserver(I).Accept requestid 　　Exit sub 　　End if 　　I=I+1 　　Loop 　　Load sckserver(I) ‘否则，加载新的控件 　　Scksrver(I).accept requestID 　　End sub 　　注意到：以上的信息交谈实际上都发生在客户机与服务器之间，如果要做成聊天室那样，每个人的话都可以被别人“听到”，那就要在服务器端的DataArrival事件中，把接收到的客户机传来的数据，转发给所有客户机即可。 　　其循环转发信息的代码如下： 　　For I=1 to sckserver.count 　　if sckserver(I).state<>sckclosed then
　　sckserver(I).SendData sdata
　　end if
　　next I
　　怎么样，这样我们就作好了自己的通信软件！
　　不过，不知大家注意到没有，上述程序都需要有一台计算机做为服务器，但如果我们的局域网中没有哪台计算机是可以常开的，也就是说，如果服务器端程序没有运行的话，其他客户端程序也没有办法通信。而这种情况却可能是经常出现的!至少，我所用的局域网那就是这样的。难道这样我们就无法享受局域网通信的乐趣了吗？
　　不要急，记得吗，我们的Winsock控件还有另一个主角：UDP协议。
　　UDP协议也称为用户数据报文协议，是一个无连接协议。何谓无连接协议？就是说利用此协议连接时，不必象TCP协议那样：需要服务器端侦听，客户机端请求连接，服务器端建立连接后双方才能通信。另外，UDP应用程序可以是客户机，也可以是服务器程序，而不必向TCP应用程序那样必须分别建立客户机程序和服务器程序。
　　下面，来简述一下UDP协议通信的过程：UDP协议中，为了在甲乙两机中传输数据，必须先分别设置两机的LocalPort属性；再将甲机的RemoteHost属性设置为乙机的IP地址，RemotePort属性设置为乙机的LocalPort属性值，此时甲机调用SendData方法就可以传送数据了，乙机同样使用DataArrival事件中的GetData方法来获取甲机发送给乙机的信息。如想乙机向甲机传送数据，只需仿照上面的过程设置即可。
　　用UDP协议来传输信息较TCP协议来说简单的多，它无须侦听（LISTEN），也无须请求连接（CONNECT），就象我们平时发信一样，只要写好地址及收信人姓名并发送出去即可。我们可以借此来编写一个局域网中的信息传送程序，下面来简单介绍以下程序中想实现的功能及其基本思想：
　　首先，我们一定想让程序的图标显示在system tray中而不显示在任务栏中吧！VB光盘中在common\tools\vb\unsupport\systemTray 中有一个现成的程序，我们只要把它编译成systray.ocx 控件，然后在编写自己的程序时添加此控件即可。其使用方法十分简单，它已经定义好了鼠标单击、双击等事件，你只需编写相应的鼠标事件即可，这里不再多说。如果想自己编写托盘程序，见在系统托盘中显示。
　　程序的关键是：UDP协议在通讯时要知道对方的IP和Port，这要如何实现呢？最简单的方法是建立一个配置文件，里面放置了局域网上每台计算机的名字、IP和Port，在程序初始化时读出所有信息，在程序中只要知道向谁通信，读出其对应的IP和Port即可。
　　我们知道了每台计算机的IP和Port，但我们怎样才能知道其它计算机是否在线呢，否则发出信息别人收不到怎么办？我们可以把此程序放在启动菜单中，让其一开机就自动启动，并最小化，放于窗口右下角的system tray中。在程序刚开始运行时，它会自动向它从配置文件中所知道的所有IP发一条信息：“我来了！”，如果有计算机在线，它会自动返回一条信息：“欢迎！”，如此则两机通信成功，它们会分别把对方的名字加入到自己的可通信人名单中去；如果有计算机关机，程序在退出之前会自动向所有人告别：“再见！”，接收到此信息的计算机会自动把发送信息的计算机的名称从自己的可通信人名单中去除。这样，如果某人不在线，你将无法发送信息给它；如果除了你以外，其他人都没有开机，那你的可发送人名单中将没有任何人。而其它人只要一上线，会自动去你那里“登记”，其他人只要一离线，会自动去你那里“告别”，你可以据此知道他人是否正在使用计算机，你甚至可以以此程序来统计他人的每天上机时间，不错吧！
　　好了，一个局域网通信的程序的基本模型已经有了，并不复杂吧！大家赶快动手吧，来享受用自己的程序来聊天的乐趣！
　　不过，要想编写一个出色的程序，不光是要有良好的创意与功能，更重要的是程序的兼容性与容错性。本例中，对错误处理没有做详细的解释，关于这一点，大家可以在Winsock控件的error事件及其帮助中找到满意的答案。
　　另外，还可以从以下几方面来考虑功能的扩充：如传送图形、声音等多媒体信息、局域网互传文件（主动传送）、历史通话记录、系统日志、个人上机时间统计等等，而所有的这一切仅仅取决于你的想象力与你的聪明才智！下面，笔者以传送文件为例来讲一讲其功能实现的代码。
　　你可以把本地的文件（图形、声音等可以先存成临时文件）以二进制文件的方式来打开它，将其内容全部读入一个byte类型的数组中，本地机代码如下：
　　dim myfile () as byte
　　dim position as long
　　open “filename” for binary as #1
　　position=0
　　do while not eof(1)
　　position=positon+1
　　redim preserve myfile (1 to position)
　　get #1,,myfile(position)
　　loop
　　close #1
　　再向远程机传送这个字节数组
　　sckserver.SendData myfile
　　远程机收到这个数组之后，再以二进制文件的方式打开一个新目标文件，将数组内容写入这个新打开的文件，如果是bmp图片就将其放入picture图片框中，如果是wav文件，就播放。这样，局域网中的两个人就可以通过语言、图片、文字来交流了。
　　远程机代码如下：
　　Private sub sckconnect_DataArrival(byval bytestotal as long)
　　dim receivefile(1 to bytestotal)as byte
　　sckconnect.GetData receivefile,vbarray+vbbyte
　　’告诉Winsock控件收到的是字节数组类型的数据
　　open “c:\temp\文件名” for binary as #1
　　for I=1 to bytestotal
　　put #1,,remotearray(I)
　　next I
　　clost #1
　　end sub

用Windows系统提供的注册表编辑器regedit.exe来认识登录数据库(Registry)。

1、Key和SubKey

注册表编辑器运行时我们可以看到它的窗口结构和资源管理器很像，左边窗格的每个文件夹图标表示一个Key。Key下面还有Subkey。我们习惯上采用文件夹的路径表示法。e.g:HKEY_LOCAL_MACHINE底下的”Software”Subkey表示成HKEY_LOCAL_MACHINE\Software。

2、Value、Value Name、Value Data和Default Value

用Regedit.exe打开HKEY_CLASSES_ROOT\.txt这个Key,在右窗格中显示的是Key的Value,Value可能有很多，对某个特定的Value来将，它有两个属性–Value Name和Value Data,如在此例中，HKEY_CLASSES_ROOT\.txt有一个Value–>”Content Type”,这个Value的Value Name为”Content Type”,Value Data为”text/plain”,某些Key,还有缺省Value–Default Value,如此例中,HKEY_CLASSES_ROOT\.txt这个Key的Default Value就是我们看到的”默认”[Value Name],”txtfile”[Value Data]。

3、存取Registry,先取Key Handle

在了解了Registry的结构之后，接下来的事就是如何存取它了。就像我们存取文件必须指明文件的存取路径[目录]一样，存取Registry必须先指明Key.Key在Regedit.exe中看到的是一长串的字符串，例如: “HKEY_LOCAL_MACHINE\Software\Microsoft\Windows”,

但在Windows内部，每个Key都对应一个Key Handle(等于一个长整数值，程序中通常以hKey表示),Windows之所以要用hkey来代表Key是为了让Registry的存取更有效率，因为整数的操作功能优于字符串，所以我们的首要任务就是取得Key的Key Handle(hKey)取得最上层的hKey。首先是位于最上层的Key,这些Key的hKey是固定不变的，其值如下表所示。

Key hKey(Key Handle)

HKEY_CLASSES_ROOT &H80000000

HKEY_CURRENT_USER &H80000001

HKEY_LOCAL_MACHINE &H80000002

HKEY_USERS &H80000003

HKEY_CURRENT_CONFIG &H80000005

HKEY_DYN_DATA &H80000006

如果想取得上述几个Key的SubKey Handle,可以调用RegOpenKey这个API函数。其详细描述如下：

VB声明 Declare Function RegOpenKey Lib “advapi32.dll” Alias “RegOpenKeyA”

(ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

参数类型及说明:

hKey:Key Handle

lpSubKey:SubKey名称或路径

phkResult:若RegOpenKey执行成功，则这一参数返回Subkey的hKey.

返回值: =0,表示成功；≠0,表示失败。[注意这一点与别的API函数不太一样]

调用例：

Dim ret As Long, hKey As Long, hKey2 As Long

‘取得”HKEY_LOCAL_MACHINE”底下的”SOFTWARE\Microsoft”这个SubKey Handle.

ret = RegOpenKey(HKEY_LOCAL_MACHINE, “SOFTWARE\Microsoft”, hKey)

If ret = 0 Then ‘If Success

MsgBox “HKLM\SOFTWARE\Microsoft = ” & hKey

End If

‘继续以刚才所取得的”HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft”hKey为参数，再取得它的’SubKey”Windows\CurrentVersion”的handle。

ret = RegOpenKey(hKey, “Windows\CurrentVersion”, hKey2)

If ret = 0 Then

MsgBox “HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion = ” & hKey2

End If

相关的两个API函数是：RegCreateKey[建立SubKey]和RegClose[关闭SubKey]

详细说明：

RegCreateKey函数：

VB声明 Declare Function RegCreateKey Lib “advapi32.dll” Alias “RegCreateKeyA”

(ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

它的参数用法与RegOpenKey一样。所不同的是RegOpenKey只能打开已经有的SubKey,而RegCreateKey则可以建立SubKey,比较特别的是，如果调用RegCreateKey所建立的SubKey是一个已经存在的SubKey,则它的功能和RegOpenKey相同。由于RegCreateKey的这种特性，有的程序员干脆不用RegOpenKey，而用RegCreateKey来统一代替RegOpenKey。

RegClose函数：

Declare Function RegCloseKey Lib “advapi32.dll” (ByVal hKey As Long) As Long

当我们不再存取Registry时，将打开或建立的SubKey关闭是一个比较好的习惯，就正如我们在使用C语言的文件打开函数后必须要关闭一样。