CSDN首页 空间 新闻 论坛 Blog 下载 读书 网摘 搜索 .NET Java 视频 接项目 求职 在线学习 买书 程序员 通知
不看会后悔的Windows XP之经验谈 简单快捷DIY实用家庭影院
CSDN社区
搜索 收藏 打印 关闭
CSDN社区 >  VB >  基础类

怎样用vb编写程序来扫描文件夹

楼主popgang(西北狼)2002-04-11 10:01:58 在 VB / 基础类 提问

怎样用vb编写程序来扫描文件夹,并吧文件夹里最新日期的文件插入到一张表里 问题点数:1、回复次数:3Top

1 楼tanaya(唐博士http://blog.csdn.net/tanaya)回复于 2002-04-11 10:16:53 得分 1

给你一个完整的示例,用于扫描硬盘的文件  
  ------------------------------------  
   
  '用API函数遍历指定路径的文件  
  '以下代码演示了如何用Windows   API函数遍历指定驱动器、目录的所有文件.  
  '思路是:调出浏览文件夹窗口让用户指定所要搜索的起始路径,然后用查找文件  
  '的API函数遍历该目录下及其包含的子目录下的所有文件.  
  '本例需要:一个按钮,一个TextBox和一个ListBox,其中,TextBox应设置为多行.  
   
  Option   Explicit  
  '查找第一个文件的API  
  Private   Declare   Function   FindFirstFile   Lib   "kernel32"   Alias   "FindFirstFileA"   (ByVal   lpFileName   As   String,   lpFindFileData   As   WIN32_FIND_DATA)   As   Long  
  '查找下一个文件的API  
  Private   Declare   Function   FindNextFile   Lib   "kernel32"   Alias   "FindNextFileA"   (ByVal   hFindFile   As   Long,   lpFindFileData   As   WIN32_FIND_DATA)   As   Long  
  '获取文件属性的API  
  Private   Declare   Function   GetFileAttributes   Lib   "kernel32"   Alias   "GetFileAttributesA"   (ByVal   lpFileName   As   String)   As   Long  
  '关闭查找文件的API  
  Private   Declare   Function   FindClose   Lib   "kernel32"   (ByVal   hFindFile   As   Long)   As   Long  
  '以下为调用浏览文件夹窗口的API  
  Private   Declare   Sub   CoTaskMemFree   Lib   "ole32.dll"   (ByVal   hMem   As   Long)  
  Private   Declare   Function   lstrcat   Lib   "kernel32"   Alias   "lstrcatA"   (ByVal   lpString1   As   String,   ByVal   lpString2   As   String)   As   Long  
  Private   Declare   Function   SHBrowseForFolder   Lib   "shell32"   (lpbi   As   BrowseInfo)   As   Long  
  Private   Declare   Function   SHGetPathFromIDList   Lib   "shell32"   (ByVal   pidList   As   Long,   ByVal   lpBuffer   As   String)   As   Long  
   
  '常量  
  Const   MAX_PATH   =   260  
  Const   MAXDWORD   =   &HFFFF  
  Const   INVALID_HANDLE_VALUE   =   -1  
  Const   FILE_ATTRIBUTE_ARCHIVE   =   &H20  
  Const   FILE_ATTRIBUTE_DIRECTORY   =   &H10  
  Const   FILE_ATTRIBUTE_HIDDEN   =   &H2  
  Const   FILE_ATTRIBUTE_NORMAL   =   &H80  
  Const   FILE_ATTRIBUTE_READONLY   =   &H1  
  Const   FILE_ATTRIBUTE_SYSTEM   =   &H4  
  Const   FILE_ATTRIBUTE_TEMPORARY   =   &H100  
  Const   BIF_RETURNONLYFSDIRS   =   1  
  Private   Type   FILETIME  
  dwLowDateTime   As   Long  
  dwHighDateTime   As   Long  
  End   Type  
     
   
  '定义类(用于查找文件)  
  Private   Type   WIN32_FIND_DATA  
      dwFileAttributes   As   Long  
      ftCreationTime   As   FILETIME  
      ftLastAccessTime   As   FILETIME  
      ftLastWriteTime   As   FILETIME  
      nFileSizeHigh   As   Long  
      nFileSizeLow   As   Long  
      dwReserved0   As   Long  
      dwReserved1   As   Long  
      cFileName   As   String   *   MAX_PATH  
      cAlternate   As   String   *   14  
  End   Type  
   
  '定义类(用于浏览文件夹窗口)  
  Private   Type   BrowseInfo  
      hWndOwner   As   Long  
      pIDLRoot   As   Long  
      pszDisplayName   As   Long  
      lpszTitle   As   Long  
      ulFlags   As   Long  
      lpfnCallback   As   Long  
      lParam   As   Long  
      iImage   As   Long  
  End   Type  
     
  '自定义函数  
  Function   StripNulls(OriginalStr   As   String)   As   String  
      If   (InStr(OriginalStr,   Chr(0))   >   0)   Then  
          OriginalStr   =   Left(OriginalStr,   InStr(OriginalStr,   Chr(0))   -   1)  
      End   If  
      StripNulls   =   OriginalStr  
  End   Function  
     
  '自定义函数  
  Function   FindFilesAPI(path   As   String,   SearchStr   As   String,   FileCount   As   Integer,   _  
  DirCount   As   Integer)  
  Dim   FileName   As   String   '   文件名  
  Dim   DirName   As   String   '   子目录名  
  Dim   dirNames()   As   String   '   目录数组  
  Dim   nDir   As   Integer   '   当前路径的目录数  
  Dim   i   As   Integer   '   循环计数器变量  
  Dim   hSearch   As   Long   '   搜索句柄变量  
  Dim   WFD   As   WIN32_FIND_DATA  
  Dim   Cont   As   Integer  
  If   Right(path,   1)   <>   "\"   Then   path   =   path   &   "\"  
  '搜索子目录  
      nDir   =   0  
      ReDim   dirNames(nDir)  
      Cont   =   True  
      hSearch   =   FindFirstFile(path   &   "*",   WFD)  
      If   hSearch   <>   INVALID_HANDLE_VALUE   Then  
          Do   While   Cont  
              DirName   =   StripNulls(WFD.cFileName)  
              If   (DirName   <>   ".")   And   (DirName   <>   "..")   Then  
                  If   GetFileAttributes(path   &   DirName)   And   FILE_ATTRIBUTE_DIRECTORY   Then  
                      dirNames(nDir)   =   DirName  
                      DirCount   =   DirCount   +   1  
                      nDir   =   nDir   +   1  
                      ReDim   Preserve   dirNames(nDir)  
                  End   If  
              End   If  
              Cont   =   FindNextFile(hSearch,   WFD)   '获取下一个子目录  
          Loop  
          Cont   =   FindClose(hSearch)  
      End   If  
      '   遍历目录并累计文件总数  
      hSearch   =   FindFirstFile(path   &   SearchStr,   WFD)  
      Cont   =   True  
      If   hSearch   <>   INVALID_HANDLE_VALUE   Then  
          While   Cont  
              FileName   =   StripNulls(WFD.cFileName)  
              If   (FileName   <>   ".")   And   (FileName   <>   "..")   Then  
                  FindFilesAPI   =   FindFilesAPI   +   (WFD.nFileSizeHigh   *   MAXDWORD)   +   WFD.nFileSizeLow  
                  FileCount   =   FileCount   +   1  
                  List1.AddItem   path   &   FileName  
              End   If  
              Cont   =   FindNextFile(hSearch,   WFD)   '   获取下一个文件  
          Wend  
          Cont   =   FindClose(hSearch)  
      End   If  
      '如果子目录存在则遍历之  
      If   nDir   >   0   Then  
          For   i   =   0   To   nDir   -   1  
              FindFilesAPI   =   FindFilesAPI   +   FindFilesAPI(path   &   dirNames(i)   &   "\",   _  
  SearchStr,   FileCount,   DirCount)  
          Next   i  
      End   If  
  End   Function  
     
  '查找按钮代码  
  Sub   Command1_Click()  
      Dim   SearchPath   As   String,   FindStr   As   String  
      Dim   FileSize   As   Long  
      Dim   NumFiles   As   Integer,   NumDirs   As   Integer  
      Dim   iNull   As   Integer,   lpIDList   As   Long,   lResult   As   Long  
      Dim   sPath   As   String,   udtBI   As   BrowseInfo  
      With   udtBI  
          '设置浏览窗口  
          .hWndOwner   =   Me.hWnd  
          '返回选中的目录  
          .ulFlags   =   BIF_RETURNONLYFSDIRS  
      End   With  
      '调出浏览窗口  
      lpIDList   =   SHBrowseForFolder(udtBI)  
      If   lpIDList   Then  
          sPath   =   String$(MAX_PATH,   0)  
          '获取路径  
          SHGetPathFromIDList   lpIDList,   sPath  
          '释放内存  
          CoTaskMemFree   lpIDList  
          iNull   =   InStr(sPath,   vbNullChar)  
          If   iNull   Then  
              sPath   =   Left$(sPath,   iNull   -   1)  
          End   If  
      End   If  
      Screen.MousePointer   =   vbHourglass  
      List1.Clear  
      SearchPath   =   sPath   '选中的目录为搜索的起始路径  
      FindStr   =   "*.*"   '搜索所有类型的文件(此处可另作定义)  
      FileSize   =   FindFilesAPI(SearchPath,   FindStr,   NumFiles,   NumDirs)  
      Text1.Text   =   "查找到的文件数:"   &   NumFiles   &   vbCrLf   &   "查找的目录数:"   &   _  
  NumDirs   +   1   &   vbCrLf   &   "文件大小总共为:"   &   vbCrLf   &   _  
  Format(FileSize,   "#,###,###,##0")   &   "字节"  
      Screen.MousePointer   =   vbDefault  
  End   Sub  
     
     
   
   
  Top

2 楼tanaya(唐博士http://blog.csdn.net/tanaya)回复于 2002-04-11 10:18:31 得分 0

文件夹都找到了,文件也找到了,日期那就是小Case了  
  Top

3 楼popgang(西北狼)回复于 2002-04-11 13:12:53 得分 0

谢谢你们,好心人,我是第一次再这里发帖子,每想到得到这么完美的回复,太谢谢了。Top

相关问题

  • 用VB编写添加"文件夹树"的问题!
  • 用vb编写一个对sps的wss创建一个文件夹程序
  • 在vb中的 “文件夹”重命名
  • VB 下怎样新建文件夹?
  • 如何用vb建立文件夹?
  • VB创建文件夹,要求是一个自定义的文件夹!
  • 编写程序求出c:\下有多少个文件夹?
  • vb安装后,听说会有一个文件夹中是示例源码,这个文件夹在何处?
  • 编写过树型结构(CTreeCtrl)浏览文件夹的进来看看
  • 请教,如何编写一个选择系统文件夹路径的窗口?

关键词

  • win32
  • 文件夹
  • 文件
  • 函数
  • hsearch
  • ndir
  • wfd
  • findfilesapi
  • 遍历
  • dirnames

得分解答快速导航

  • 帖主:popgang
  • tanaya

相关链接

  • Visual Basic类图书
  • Visual Basic类源码下载

广告也精彩

反馈

请通过下述方式给我们反馈
反馈
提问
网站简介|广告服务|VIP资费标准|银行汇款帐号|网站地图|帮助|联系方式|诚聘英才|English|问题报告
北京创新乐知广告有限公司 版权所有, 京 ICP 证 070598 号
世纪乐知(北京)网络技术有限公司 提供技术支持
Copyright © 2000-2008, CSDN.NET, All Rights Reserved
GongshangLogo