vb文件同步比较程序

急用啊！vb高手们谢谢！！

答案：程序功能描述

以笔者备份生活中的数码照片文件为例，拍摄的照片存放在硬盘“D:\MyPic”文件夹（下称源文件夹）中，并且进行了多项分类，照片需要备份到Ｕ盘的“E:\MyPic”文件夹（下称目的文件夹）中。如果硬盘中某类增加了照片，那么程序能自动搜索出新增加的文件，并实现新增文件从来源文件夹到目的文件夹的自动拷贝；如果新增的文件在新增的文件夹中，那么在拷贝新增文件前会自动在目的文件夹中创建新的同名文件夹。

界面设计

启动VB，新建一工程，设置窗体BorderStyle属性为1，向窗体添加以下控件：两个文本框Text1（存放来源根文件夹名，Enabled=False）、Text2（存放目的根文件夹名，Enabled=False），6个列表框List1（存放来源文件夹中多出的文件名，Sorted=True）、List2（存放目的文件夹中多出的文件名，Sorted=True）、List3和List5（分别存放搜索来源文件夹时的①、②类信息,Visable=False）、List4和List6（分别存放搜索目的文件夹时的①、②类信息,Visable=False），5个命令按钮Command1（设置来源文件夹）、Command2（设置目的文件夹）、Command3（搜索与比较文件）、Command4（复制来源文件夹中多出的文件到目的文件夹）、Command5（复制目的文件夹中多出的文件到来源文件夹），4个标签（仅用于提示）。

编程实现

一、指定文件夹

程序运行的时候，需要指定来源文件夹和目的文件夹，本程序采用了API方法打开“浏览”对话框，让用户指定两个文件夹。用API方法打开“浏览”对话框，需要使用BrowseInfo类型和SHBrowseForFolder、SHGetPathFromIDList两个API函数（它们的定义和声明可以从API浏览器中复制），编程方法和核心代码如下：

Function OpenDir() As String

 Dim BI As BrowseInfo

 ’打开“浏览”对话框

 pIdl = SHBrowseForFolder(BI)

 If pIdl = 0 Then Exit Function

 ’获取文件夹名称

 sPath = String$(260, 0)

 SHGetPathFromIDList ByVal pIdl, ByVal sPath

 t=Left(sPath,InStr(sPath,vbNullChar)-1)

 If Right(t,1)<>"\" Then t=t+"\"

 OpenDir = UCase(t)

End Function

二、搜索文件

程序在备份文件前，先对“来源”和“目的”文件夹（这两个文件夹我们称为根文件夹，即搜索的最高路径）分别进行搜索，搜索时需要保存两个信息：①、完整路径和文件名；②、①中除去根文件夹名剩余的部分，分别保存在两个列表框中，以便下一步进行比较。在VB中，可以用DIR函数获取文件夹或文件的名称，为了实现对文件夹及其子文件夹的全部搜索，我们构造了以下搜索过程：先搜索当前文件夹中的文件，然后搜索当前文件夹中的子文件夹，并保存到动态数组中，最后调用函数本身实现对子文件夹的继续搜索，核心代码如下：

Sub alf(ByVal sdN As String, ByVal fF As String, sList1 As ListBox, sList2 As ListBox)

 ’搜索当前文件夹中的文件

 sF = Dir(sdN+fF, vbArchive+vbNormal+vbReadOnly)

 Do While Len(sF) > 0

  tFn = UCase(sdN + sF)

  ’保存①类信息

  sList1.AddItem tFn

  ’保存②类信息

  sList2.AddItem Mid$(tFn, Len(Root) + 1)

  sF = Dir

 Loop

 ’搜索文件夹中的子文件夹，略

 ’递规调用继续搜索子文件夹，略

End Sub

三、比较文件

当两个文件夹中的文件被搜索到列表框后，接下来就通过列表框项目进行文件名称的比较，并将比较的结果存放到另外的列表框中。假设搜索来源文件夹时的①、②类信息分别保存在列表框L1、sL1中，搜索目的文件夹时的①、②类信息分别保存在列表框L2、sL2中，如果要比较来源文件夹相对于目的文件夹多出的文件，方法为：通过循环逐一检测sL1中的项目名称在sL2中是否存在，不存在则将L1中对应的项目名称保存起来，在检测sL1中的项目名称是否在sL2中存在时，可以通过循环遍历sL2中的每个项目逐一比较，但这样处理的速度相当慢（特别是搜索的文件比较多的时候），所以我们采用SendMessage这个API函数实现列表框项目的检查，核心代码如下：

Function Compare(L1,L2,sL1,sL2,oLst)

 ’函数的参数都为ListBox类型

 If sL1.ListCount=0 Then Exit Function

 For i=0 To sL1.ListCount-1

  idx=SendMessage(sL2.hwnd,&H1A2,-1,ByVal sL1.List(i))

  If idx=-1 Then oLst.AddItem L1.List(i)

 Next

End Function

同样的，如果要比较目的文件夹相对于来源文件夹多出的文件，在调用Compare函数时，只需要改变参数的位置即可。

四、建立多级文件夹

来源文件夹中可能有新增的文件夹，且新增的文件夹中还可能有子文件夹，那么，在复制文件时，就需要在目的文件夹中先建立新的文件夹（而且可能要新建多级文件夹），方法为：通过一个循环，从左到右遍历路径，查找路径分隔符“\”，找到后，取出前面的文件夹路径，检测它是否存在，当不存在时用MkDir函数建立，核心代码如下：

Function MakeTreeDir(nDir As String) As Boolean

 ’确认路径是否合法，代码略

 For k = 1 To Len(nDir)

  If Mid(nDir,k,1)="\" Then

   cDir=Left(nDir,k-1)

   If Dir(cDir,vbDirectory)="" Then MkDir (cDir)

  End If

 Next k

End Function

五、备份文件

备份文件时，需要指定文件名及其完整路径，同时需要知道两个根文件夹的名称，对于某个含路径的文件名，首先从中取出不含路径的独立文件名，然后判断文件是存放在来源文件夹中还是存放在其子文件夹中，根据文件存放位置的不同确定目的文件的含路径的文件名，最后实现文件的复制。核心代码如下：

Function CopyFiles(Lst As ListBox, Root1, Root2)

 For i=0 To Lst.ListCount-1

  N=Lst.List(i) ’完整的文件名

  ’反向查找路径分隔符“\”

  p=InStrRev(N,"\",-1,vbTextCompare)

  ’不含路径的独立文件名

  F1 = Mid$(N, p + 1)

  ’文件存放在来源文件夹中的子文件夹中

  If p > Len(Root1) Then

   ’来源文件夹中的子文件夹名

   D1 = Mid$(N, Len(Root1) + 1, p2 - Len(Root1))

   ’存放目的文件的路径

   D2 = Root2 + D1

   ’如果目的文件夹不存在则建立

   If Dir(D2,vbDirectory)="" Then Call MakeTreeDir(D2)

   ’含路径的目的文件名

   F2 = D2 + F1

  Else 

   ’文件存放在来根文件夹中

   F2 = Root2 + F1

  End If

  CopyFile N, F2, True ’复制文件

 Next

End Function

说明：在复制文件时，本文没有使用VB的文件复制函数FileCopy，而是采用了API函数CopyFile，因为VB中的FileCopy函数无法复制诸如正在使用的数据库文件。

六、根文件夹名的保存

如果用户每次备份的来源文件夹和目的文件夹的名称不变，那么每次设置两个根文件夹就比较麻烦了，所以本程序能将两个根文件夹的名称保存在与程序同名的ini文件中，在程序运行时自动读取上次保存的两个根文件夹名称，保存根文件夹设置的核心代码如下：

Function SaveSet(iFn)

 Open iFn For Output As #1

 Print #1, Text1.Text

 Print #1, Text2.Text

 Close #1

End Function

’读入根文件夹设置

Function OpenSet(iFn)

 ’详细代码参见源码，此处略

End Function

编译运行程序

编译、运行程序，设置来源文件夹和目的文件夹，然后执行搜索与比较，程序很快能找出两个文件夹中分别相对于另外一个文件夹多出的文件，然后可以把一个文件夹中多出的文件备份到另外一个文件夹，备份后，用户指定的两个文件夹下的内容完全一样。程序稍加修改即可实现自动备份。

上一个：如何提高开发VB应用程序的效能
下一个：跪求VB代码解释