说三道四技术文摘-感悟人生的经典句子
说三道四 > 文档快照

VB与Windows资源管理器互拷文件

HTML文档下载 WORD文档下载 PDF文档下载
VB与Windows资源管理器互拷文件
作者:长沙 陈锐


   通过VB编程来拷贝或移动文件的原理可能大家都十分清楚,可以利用Windows APISHFileOperation来进行操作,也可以利用VB内置的函数来操作。但是利用这些方法编写的程序只能在程序内部执行文件的操作。这里我要向大家介绍如何通过VB编程将程序中的文件操作同Windows的资源管理器中的拷贝、剪切操作连接起来。
   在Windows的资源管理器中,选中一个或多个文件,在文件上单击鼠标右键,在弹出菜单中选复制。再切换到另外的目录,单击鼠标右键,点粘贴。就这样执行了一次文件的拷贝操作,那么Windows在拷贝过程中执行了什么操作,是否将整个文件拷贝到剪贴板上了呢?当然没有。实际上,Windows只是将一个文件结构拷贝到了剪贴版,这个结构如下:
   tDropFile+文件1文件名+vbNullChar+文件2文件名+vbNullChar……+文件N文件名+vbNullChar,其中tDropFile是一个DROPFILES结构,这个结构在Windows API中有定义。在粘贴文件时,利用API函数 DragQueryFile 就可以获得拷贝到剪贴板的文件全路径名,然后就可以根据获得的文件名执行文件拷贝函数,实现对文件的粘贴操作。
   下面通过具体的程序来介绍:
   1、在工程文件中加入一个Module,然后在Module中加入如下代码:
  Option Explicit
  Private Type POINTAPI
   x As Long
   y As Long
  End Type
  Private 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 String
  End Type
  Private Declare Function SHFileOperation Lib “shell32.dll" Alias _
   “SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
  '剪贴板处理函数
  Private Declare Function EmptyClipboard Lib “user32" () As Long
  Private Declare Function OpenClipboard Lib “user32" (ByVal hwnd _
   As Long) As Long
  Private Declare Function CloseClipboard Lib “user32" () As Long
  Private Declare Function SetClipboardData Lib “user32" (ByVal wFormat _
   As Long, ByVal hMem As Long) As Long
  Private Declare Function GetClipboardData Lib “user32" (ByVal wFormat _
   As Long) As Long
  Private Declare Function IsClipboardFormatAvailable Lib “user32" _
   (ByVal wFormat As Long) As Long
  Private Declare Function DragQueryFile Lib “shell32.dll" Alias _
   “DragQueryFileA" (ByVal hDrop As Long, ByVal UINT As Long, _
   ByVal lpStr As String, ByVal ch As Long) As Long
  Private Declare Function DragQueryPoint Lib “shell32.dll" (ByVal _
   hDrop As Long, lpPoint As POINTAPI) As Long
  Private Declare Function GlobalAlloc Lib “kernel32" (ByVal wFlags _
   As Long, ByVal dwBytes As Long) As Long
  Private Declare Function GlobalFree Lib “kernel32" (ByVal hMem As _
   Long) As Long
  Private Declare Function GlobalLock Lib “kernel32" (ByVal hMem As _
   Long) As Long
  Private Declare Function GlobalUnlock Lib “kernel32" (ByVal hMem As _
   Long) As Long
  Private Declare Sub CopyMem Lib“kernel32" Alias “RtlMoveMemory" _
   (Destination As Any, Source As Any, ByVal Length As Long)
  '剪贴板数据格式定义
  Private Const CF_TEXT = 1
  Private Const CF_BITMAP = 2
  Private Const CF_METAFILEPICT = 3
  Private Const CF_SYLK = 4
  Private Const CF_DIF = 5
  Private Const CF_TIFF = 6
  Private Const CF_OEMTEXT = 7
  Private Const CF_DIB = 8
  Private Const CF_PALETTE = 9
  Private Const CF_PENDATA = 10
  Private Const CF_RIFF = 11
  Private Const CF_WAVE = 12
  Private Const CF_UNICODETEXT = 13
  Private Const CF_ENHMETAFILE = 14
  Private Const CF_HDROP = 15
  Private Const CF_LOCALE = 16
  Private Const CF_MAX = 17
  ' 内存操作定义
  Private Const GMEM_FIXED = &H0
  Private Const GMEM_MOVEABLE = &H2
  Private Const GMEM_NOCOMPACT = &H10
  Private Const GMEM_NODISCARD = &H20
  Private Const GMEM_ZEROINIT = &H40
  Private Const GMEM_MODIFY = &H80
  Private Const GMEM_DISCARDABLE = &H100
  Private Const GMEM_NOT_BANKED = &H1000
  Private Const GMEM_SHARE = &H2000
  Private Const GMEM_DDESHARE = &H2000
  Private Const GMEM_NOTIFY = &H4000
  Private Const GMEM_LOWER = GMEM_NOT_BANKED
  Private Const GMEM_VALID_FLAGS = &H7F72
  Private Const GMEM_INVALID_HANDLE = &H8000
  Private Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT)
  Private Const GPTR = (GMEM_FIXED Or GMEM_ZEROINIT)
  Private Const FO_COPY = &H2
  Private Type DROPFILES
   pFiles As Long
   pt As POINTAPI
   fNC As Long
   fWide As Long
  End Type
  Public Function clipCopyFiles(Files() As String) As Boolean
   Dim data As String
   Dim df As DROPFILES
   Dim hGlobal As Long
   Dim lpGlobal As Long
   Dim i As Long
   '清除剪贴板中现存的数据
   If OpenClipboard(0&) Then
   Call EmptyClipboard
   For i = LBound(Files) To UBound(Files)
   data = data & Files(i) & vbNullChar
   Next i
   data = data & vbNullChar
   '为剪贴板拷贝操作分配相应大小的内存
   hGlobal = GlobalAlloc(GHND, Len(df) + Len(data))
   If hGlobal Then
   lpGlobal = GlobalLock(hGlobal)
   df.pFiles = Len(df)
   '将DropFiles结构拷贝到内存中
   Call CopyMem(ByVal lpGlobal, df, Len(df))
   '将文件全路径名拷贝到分配的内存中。
   Call CopyMem(ByVal (lpGlobal + Len(df)), ByVal data, _
   Len(data))
   Call GlobalUnlock(hGlobal)
   '将数据拷贝到剪贴板上
   If SetClipboardData(CF_HDROP, hGlobal) Then
   clipCopyFiles = True
   End If
   End If
   Call CloseClipboard
   End If
  End Function
  Public Function clipPasteFiles(Files() As String) As Long
   Dim hDrop As Long
   Dim nFiles As Long
   Dim i As Long
   Dim desc As String
   Dim filename As String
   Dim pt As POINTAPI
   Dim tfStr As SHFILEOPSTRUCT
   Const MAX_PATH As Long = 260
   '确定剪贴板的数据格式是文件,并打开剪贴板
   If IsClipboardFormatAvailable(CF_HDROP) Then
   If OpenClipboard(0&) Then
   hDrop = GetClipboardData(CF_HDROP)
   '获得文件数
   nFiles = DragQueryFile(hDrop, -1&, “", 0)
   ReDim Files(0 To nFiles - 1) As String
   filename = Space(MAX_PATH)
   '确定执行的操作类型为拷贝操作
   tfStr.wFunc = FO_COPY
   '目的路径设置为File1指定的路径
   tfStr.pTo = Form1.File1.Path
   For i = 0 To nFiles - 1
   '根据获取的每一个文件执行文件拷贝操作
   Call DragQueryFile(hDrop, i, filename, Len(filename))
   Files(i) = TrimNull(filename)
   tfStr.pFrom = Files(i)
   SHFileOperation tfStr
   Next i
   Form1.File1.Refresh
   Form1.Dir1.Refresh
   Call CloseClipboard
   End If
   clipPasteFiles = nFiles
   End If
  End Function
  Private Function TrimNull(ByVal StrIn As String) As String
   Dim nul As Long
   nul = InStr(StrIn, vbNullChar)
   Select Case nul
   Case Is > 1
   TrimNull = Left(StrIn, nul - 1)
   Case 1
   TrimNull = “"
   Case 0
   TrimNull = Trim(StrIn)
   End Select
  End Function
   2、在Form1中加入一个FileListBox,Name属性设置为File1。加入一个DirListBox,Name属性设置为Dir1,在Dir1的Change事件中加入如下代码:
  Private Sub Dir1_Change()
  File1.Path = Dir1.Path
  End Sub
  加入一个DriveListBox,Name属性设置为Drive1,在Drive1的Change事件中加入如下代码:
  Private Sub Drive1_Change()
  Dir1.Path = Drive1.Drive
  End Sub
  加入一个CommandButton,Name属性设置为cmdCopy,在cmdCopy的Click事件中加入如下代码:
  Private Sub cmdCopy_Click()
   Dim Files() As String
   Dim Path As String
   Dim i As Long, n As Long
   Path = Dir1.Path
   If Right(Path, 1) <> “\" Then
   Path = Path & “\"
   End If
   '根据在List1上的选择建立拷贝文件的列表
   With File1
   For i = 0 To .ListCount - 1
   If .Selected(i) Then
   ReDim Preserve Files(0 To n) As String
   Files(n) = Path & .List(i)
   n = n + 1
   End If
   Next i
   End With
   '拷贝文件到Clipboard
   If clipCopyFiles(Files) Then
   MsgBox “拷贝文件成功.", , “Success"
   Else
   MsgBox “无法拷贝文件……", , “Failure"
   End If
  End Sub
  加入一个CommandButton,Name属性设置为cmdPaste,在cmdPaste的Click事件中加入如
  下代码:
  Private Sub cmdPaste_Click()
   Dim Files() As String
   Dim nRet As Long
   Dim i As Long
   Dim msg As String
   nRet = clipPasteFiles(Files)
   If nRet Then
   For i = 0 To nRet - 1
   msg = msg & Files(i) & vbCrLf
   Next i
   MsgBox msg, , “共粘贴" & nRet & “个文件"
   Else
   MsgBox“从剪贴版粘贴文件错误", , “Failure"
   End If
  End Sub
  运行文件,在Windows 资源管理器中,选择文件,再在资源管理器菜单中选 编辑 | 复制然后在Form1中点击cmdPaste,从资源管理器中复制的文件就拷贝到Dir1所在的目录中。从File1中选择文件,按cmdCopy复制,再在资源管理器中选 编辑 | 粘贴 ,选择的文件就被拷贝到Windows 资源管理器的当前目录下。
  上面的程序在Windows98 VB6.0下运行通过。


提升网站知名度的十大方法 IBM移动平台首席架构师Greg Truty:MobileFirst从底层架构开始 Hallo.js:一款所见即所得的Web编辑器 数据分析≠Hadoop+NoSQL,不妨先看完善现有技术的10条捷径 移动周报:百度收购91,19亿美金背后的博弈 植物大战僵尸2:“免费+内付费”模式引发争论 [CTO俱乐部第103期] 高德和四维图新技术高管谈地图导航的发展与挑战 Java 7爆最新漏洞,10年前的攻击手法仍有效 Twitter联合创始人Biz Stone谈Facebook用户体验 提倡零广告 英雄会:企业的人才漏斗 开发者的武林大会 一次错误估算带来的启示 苹果开发者中心被黑:开发者信息或被窃取 SIM卡加密存漏洞 将影响数亿计的手机用户 搜狗茹立云:探索引擎产品落地 浏览器+搜索模式会成主流吗? 大势所趋,IBM Acme Air至少使用Netflix的5个开源工具 【观察】跨越“朦胧期”的云计算:产业、核心技术、生态圈以及突破点 Rovio Account:平台化之路修成正果 甲骨文总裁马克•赫德采访实录:用软硬件集成一体机打垮对手 如何一步一步打造高可扩展性的应用程序? 用Java编程,请保持简洁! 从安全隐患带来的商机来看,Hadoop同样很美 三年增四倍:如今谷歌服务占北美互联网流量四分之一 决战低功耗?Intel明年推低功耗Xeon处理器 在软件架构上增加新功能的注意事项 90后的代码界“女神”李雪:在编程中找到自己的“灵魂” 大数据之路不乏荆棘,然则其中的机遇却高于一切 iPhone销量令人意外:苹果Q3财季净利69亿美元 同比下滑 励志:12位早起的IT大佬们让小伙伴们都惊呆了 独家:苹果5周年限免神作,BADLAND开发者访谈 10亿次订阅!苹果Podcast的里程碑 免费利器Unity 4.2正式发布 支持WP8、Win8和BB10 windows下的网络编程的c库函数有什么?怎么用? 为什么我的机器加入域的时候会出现“提供的凭据与已存在的凭据集冲突”的错误? 一个简单但很迷惑地问题!请指教! 分发高手睇过来 请求帮助 [转帖·放分]恶毒女人的情书 如果自己创建一个类,在这个类中想调用当前CXXVIEW类中的函数该如何办? P:Pointer? 数据库连接问题? 如何在菜单中显示图片?谢谢! 在线等待!急,tomcat中文问题 工作很非常特别烦心,散分 如何监控网络中的打印 请问在COMCAT中如何更改根目录的路径 java 中的double类型,在Oracle数据库中应该对应的是什么类型? 怎样作才能不让用户随意更改系统时间和日期? 关于单击和双击的问题 请问一个关于GB要转换成日文的Shift-JIS内码的问题 请问一下这个字符串什么意思? 在ASP.NET中怎樣讀取通過用XMLHTTP Send過來的XML數據包(一個問題50) 关于IrDA在WINDOWS/NT/XP下的编程实现 一定给分啊,快点进来看看阿 ! 帮忙写个SQL语句。 静态文本框里的文字如何调整其大小? store procedure类型 数据窗口问题 编译器参数,在线等待 求sql 如何用BUTTON按钮,将一个窗体文件关闭? 非常简单的付值问题.火急,再线等待,马上送份 调用RasDia();第一次拨号成功断线后再拨就返回错误字符终止连接为何代码如下: 怎样能编写用于用ie注册邮箱、论坛账号时自动填表的软件 资源文件的问题! 一个挑战斑竹的问题!!50分 如何把压缩文件(*.rar或则*.zip)和word文档存到Acess数据库啊??? 如何可以知道访问我的网站的用户来自哪里? 关于SQL的问题 这对话框我如何去掉 asp.net 能否运行在Solaris系统下,参与者有分 c#请求援助 int a 除以 int b 取他们的余数用C#该怎么写啊?谢谢 求救!显示后台数据,在线等待!等…… jsp中的数据库问题,求教!!急 刚学数据库,弱智问题,高分赠送! 这个查询怎么写? 关于表生成文本文件遇到的事情,急 InstallShield Professional Standard Edition 6.30 英文版的下载(高分:200) 寻一男友:发展方向——>老公 我用serv-u,客户端访问为什么没有用户登陆窗口啊? 脚本验证datetime要准确点的 请问,想做出象Protel(Tango)作图效果的程序,如何下手呢? win API函数的区别(win xp 和win 2000)高难度!! 加工一批零件,甲独做20天完成,乙独做15天完成,乙每天比甲每天多加工零件12个,这批零件有多少个?有心人来帮帮 《长征》一诗中写到的红军在长征途中遇到的事件有 为什么别人总抄我的作业,却不给我抄 一批零件,甲单独做要12天完成,乙独做要15天完成,丙独做要20天完成.(1)三人合作一天完成这批零件的( )(2)三人合作3天完成这批零件的( )(3)三人合作( )天可以完成任务(4)三 长方形纸折两次,怎样折出一个30度角?只能折两次哦 谁知道抄作业的速度和做作业的速度是几倍关系? 母爱细节描写,要简洁,越简洁越好.300字足够. 把铁丝和铜丝区别开来,下列方法中不可行的是( )A导电实验B颜色C磁铁D加入稀盐酸 成了写成比喻句 与人的基因相同的动物是什么?老鼠 关于雅思听力和写作要考第二次了,第一次听力和写作不好,同志们给推荐点好材料吧,第一次就做了剑雅那几本书Listen to this(junior) 买了,听了点,大家都推荐那个,但是不喜欢,可能题目设置的 自动扶梯每个台阶的轮子是怎样的? 细节描写母爱的一个瞬间200字,一定要一个瞬间,瞬间起码要100字(回答的好, 雅思听力.写作词汇我准备一个半月后去考雅思。近期准备冲刺下。哪位大大给我雅思的听力写作的词汇啊、之前考过一次才3.目标是6。55555 如何解决家长和孩子之间的矛盾冲突? 有没有好的推荐,哪种空气加湿器好用? 一周内如何提高雅思听力和写作我还有一周就要考雅思了.但是写作和听力都挺成问题的.麻烦大家如果一周内能提高写作和听力~我要单科5.5, 你和老师之间发生过矛盾冲突吗?事情是怎样的?事情是怎样解决的? 空气加湿器哪种好 雅思听力简单但写作却很难!上次的雅思成绩:听力:8阅读:5.5写作:4口语:5怎样提高雅思写作?12月10号要再考. 如何拒绝别人借作业 请大家帮忙修改下我的作文,写离别母校的.离别母校“小小少年,很少烦恼,眼望四周阳光照.小小少年,很少烦恼,但愿永远这样好.”眨眼间,小学六年级的生活也即将结束了.我们也由小小少年变 人的基因主要存在于1.下列关于常染色体和性染色体的叙述,不正确的是:A 性染色体与性别决定有关 B 性染色体只存于性细胞中 C 常染色体与性别决定无关 D 常染色体也存在于性细胞中2.下 咖啡杯有哪些种类 像梅花一样有气节的中国人 人火化后,基因还存在吗? 雅思听力,写作,口语预测,那里的比较准?我12月12日考雅思,想问下谁的听力和写作预测比较准?可以是各个老师的,不一定非要是听力写作在一起的,希望有经验的烤鸭给点参考! 里面带铁丝,这个发带怎么扎 关于感恩党 感恩祖国的诗歌 要独创 不要太多! 淘淘有一些邮票要装在集邮册里,如果每页要装12页要装15页.如果每页装18页,要装多少页用比例解 我还有两个月就要摘牙套了,不知道牙套摘后是不是都要带戴铁丝保持器,那要戴多久 以突围为话题的作文 咖啡杯的类别像卡布奇诺咖啡用卡布奇诺杯装蓝山咖啡用单品咖啡杯装但卡布奇诺杯和单品咖啡杯怎么认识分类,有什么区别! 一双运动鞋的进价是200元,标价400元,商场要获得不低于120元的利润最低可以打几折 加湿器什么样的好 小华的集邮册每页贴十四枚邮票贴了六页张力又给了他一些现在小华共有92张邮票张力送给他都少张邮票 跪求中外名人轶事.200——300字,急. 妈妈今年42岁,女儿今年18岁,几年前妈妈的年龄是女儿的4倍? 用一张矩形的纸,折成一个直角三角形,使其中有一个角是30度,请问如何折? 刺绳就是铁丝刺绳吗? 世界上存在基因完全相同的两个人吗?基因不同又会导致什么不同呢?性格是由基因决定吗? 用矩形纸折出一个直角三角形并使它的一个锐角是30度画出折痕,给证明 店庆期间,所有的商品一律打6折,这款运动鞋商品打出的广告是 直降200元,但没有直接标出价格,请你来算算原价. 世界上有和基因跟自己一样的人么我记得在本书上看到,在一个人死后,少则几百年多则几万年或几十万年,在人的基因重组中会碰到跟你生前一模一样的基因,那是你就会复活,是真的么? 如何将A4纸折成一个角为三十度的直角三角形 车带里面的铁丝怎么好弄出来啊较快的办法 描写母爱的作文(100字) 充电电池充电的时候是将什么转化为什么,工作的时候是将什么转化为什么? 和家人分离的作文摆脱 小明住在学校的东面,小强住在学校的西面.小明和小强同时从各自家里出发到学校,小明每分钟走64.5米,小强每分钟走75.5米,21分钟后两个人同时到达学校.小明家与小强家相距多少米? 幼教怎么样就可以成为早教 人和动物细胞中dna存在叶绿体吗 要考托福 每天背多少单词合适啊? 如何解决幼儿教育小学化问题? 哪款加湿器比较好?有谁用过么? 七侓·长征整句诗表现了红军的什么我会给财富的,要快啊 做幼教好还是早教好呢? 加湿器是什么 好用吗 求一段描写植物的文字,100字以上,能体现母爱或父爱. 如何让别人不抄你的作业?我是班里的英语课代表,英语成绩又名列前茅,就经常有人来问问题,我也告诉他们,但有一个人,经常找我要英语作业,我说没写完,他仍然找我要,没办法,我心肠软,没有 \"歼20\"战斗机现身沪昆高速?路刘恺威《喋血孤岛》11月1日浙江教育浙江临海户外休闲用品业节俭办展 小投宁波住博会盛行低碳环保风 市民“凑热安永:中国矿企面临海外并购“机会之窗土库曼斯坦货币20年 发行金银纪念币老司机雾中迷路高速逆行 交警支招大雾温州关停淘汰159家电镀企业 10人美新书爆料奥巴马怕应酬克林顿 难独自肯尼亚少女遭多人强奸 嫌犯仅被罚剪草摩根大通:今明两年中国跨境并购将非常美国务卿回应监听活动:某些方面“太过王毅强调:一定要打造好海外民生工程美使馆神秘“白盒”遍布全球 德媒称其澳大利亚警方追捕偷车贼 造成路过少年日本政府拟制定相关措施援助海外核爆受巴西副总统特梅尔将于11月4日至10马来西亚移民局前总监被判处贪污罪名成以色列军方与武装分子在加沙地带交火 卜拉希米:日内瓦会议不能缺少叙反对派韩政府再次敦促日方删除主张争议岛屿主中国国家话剧院庆祝建院14周年 韩童周琦22+8新疆32分大胜重回榜首 壹并购财经网第三期“旅商思想汇”在京她的儿子成功回收了第一枚火箭,这才是打啵儿 | 范冰冰居然跟他有一场禁忌外媒:尼日利亚天然气厂火灾造成至少8深圳滑坡灾害定性安全事故 市委书记:日本男子操控无人机坠落首相官邸 检方葛根茶汤大唐带什么法宝好 大唐法宝选择推荐锤子T2手机真机图遭曝光:细节提升但据说可战 810,三星A9首发骁龙6梦幻西游手游嘉年华详细介绍 年度狂欢炒股赔光600万公款潜逃14年 “清重庆一武警银行卡意外多了近3万元 寻“平安果”身价高消费者不买账:啥样苹一消费者称吃药无效 代言汤臣倍健的姚证监会回应宝能举牌万科一事:高度关注明星维权:邓超“出轨门”将开庭 琼瑶游宠物胚子选择攻略 选择原理分享你“共计”这门课考的真不错~
备案号:鲁ICP备13029499号-2 说三道四 www.s3d4.cn 说三道四技术文摘