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

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下运行通过。


【企业开源系列】收发一条Twitter推文的背后 在IE11中更快地获得您需要的内容 暴露程序员身份的8个行为 英特尔创新应用大赛大评审!创新也有中国风 苹果面临一问题:正源源不断地失去优秀工程师 初学编程者必知的五个网站 大数据基准测试专题论坛:基准测试是一把尚未完成的尺子 大数据应用(下):应用驱动技术,DaaS创造价值 大数据研究与发展专题论坛:大数据在各领域中的应用及发展策略 雅虎新目标:欲收购照片分享网站Imgur 移动开发工具访谈《近匠》第01期:七牛云存储—BaaS进化论 ShareSDK:A轮融资到位!将推社会化评论SDK 70美元,你也能用Raspberry Pi做个专属iBeacon基站 7个鲜为人知却超实用的PHP函数 从管理远程式团队和分布式团队中所获得的宝贵经验 Netflix开源数据流管理器Suro Google新创意:天花板加麦克风 人脑植芯片 苹果获弯曲屏新专利 可给手机弄个大波浪卷 真正的跨平台硬件测试:3DMark已打通PC、iOS、Android 将Chrome浏览器变成终端工具 【开源推荐】AllJoyn:打造全球物联网的通用开源框架 21张图带你走进Google数据中心 Snapchat C轮融资5000万美元 投资方是Coatue Management 又一个被谷歌寄生的平台,Chrome应用启动器现来到OS X上 雷军遇上刘德华:创业、艺术、移动互联网 为了抗衡Android,传微软开始考虑WP和WinRT免费 维护代码库的五个精华实践 微软发布安全补丁 IE11.0.2随之而来 Qt 5.2正式版发布 全面支持移动平台 如何节约手游制作成本?揭秘CocoStudio编辑器强悍功能 市场竞争白热化:三大云服务商上演双十二“三国杀” 请教真正的高手。 如何用TURBOC 2.0编程检测WINDOWS是否已在运行中? VS.NET能专Windows98中安装吗? 如何创建一个imagelist,用CImageList,可以记录24位色的位图 这个关于树的问题我越想越想不通,请手指点指点:) 用winsock控件设置client/server程序时,server端应怎样设置,请各位大虾帮帮小弟!!谢了! 从MIDI文件转换成简谱的问题? 请问谁有高招??????? SOS ,谁能帮帮我? 如何在一个程序中得知另一个指定的程序是否运行? 很急!!请教高手,这样的思路是否正确?(数据库方面)内有非常详细的说明,谢谢!! 我是处学者 这个关于树的问题我越想越想不通,请手指点指点:) 50小分征集C++的类和VBS的类的区别? hg0001(CoolFish) ,分已给!请发给我! 电脑上的时钟在关机之后就停止走动,下次开机时仍是上次的时间,是怎么回事?请教大家! 如何使用 WRITEFILE 函数将二进制数据写入文件? 我装的是XP,JDK1.3,无法编译程序 电脑上的时钟在关机之后就停止走动,下次开机时仍是上次的时间,是怎么回事?请教大家! 如下的演示光盘要实现的功能用什么软件开发比较好一个新手完成要多长时间? windows如何实现禁用状态文字? 输入不回显 你没有权限删除贴子!!!奇怪 Tc 那为用的是win XP,请进! 我输入的PYTHON怎么编译不出来? 问一个很弱的问题 为什么我的工具栏成了这个样子 哪里有讲MFC的书,Linux下GCC的书? 到底是什么问题啊?昏~~~(一定给分) 若干问题,请解惑。。。。。。 我这里的局域网是用win2000+sygate共享上网的,如何设置才能禁止局域网中其他计算机上OICQ或聊天室之类的网站? 如何遍历select下拉菜单中的内容,并显示在另一个select菜单中? 如何编写文档? 同样的程序连接SQLServer为什么比Access慢了几十倍 sybase12.5 odbc 中文问题 谢谢吃素的狼,但好象没用(FOXBASE问题) 同样的程序连接SQLServer为什么比Access慢了几十倍 htm和html 有什么不同,哪一个好一些,cfm是什么类型的文件? 请问怎么写mciSendString的play,close,open等的参数?如果是想打开wav文件的话。。。 回复数老是不对 谁能给我发一个类似windows资源管理器的例子!及拥有treeview和listview的sdi! delphi的query为什么不能查询nvarchar和ntext的sqlserver数据 win98开始菜单中的“运行”不见了,怎么找回来? 怎样使下载的文件支持中文名?为什么我的下载文件用中文就出错? 谁知道jbuilder5的jDataStore注册码? 很奇怪的问题 asp.net中是否还有RegExp类?? 有什么工具可以把.rm文件合并? 一段关于winsock控件的代码,请各位大虾帮忙找一下错误!! 请问:关于临时文件? ABB×C=DBBC A=3 B=() C=() D=() 染色都用那些化学材料?皮毛的加工 染色? 设1,2,3三台车床加工同一种零件,加工出来的零件混放在一起.已知三台车床加工的零件分别占全部的35%,40%和25%,三台车床的次品率依次为4%,3%和2%.现在从全部零件中任取一件,(1)求它是次品的 汉语拼音中的W应该发什么音?汉语拼音中W发音时是否该应该咬嘴唇呢?比如“为”的读音应该是wei还是vei.(V就是类似英语里V的发音方式) 过了几天,竟然冒出一截小瓜苗.冒可以换成什么字? 两台车床加工同样的零件,第一台·、第二台出现废品的概率依次为0.03,0.02.它们加工出的零件放在一起,又一台加工的零件数是第二台加工的零件数的两倍.现任取一个零件,发现它是废品,求它 急求汉语拼音转罗马音!拼音:ZhuJiaYong,求罗马音. 铜化学热着色技术就是在铜雕塑表面可以着各种颜色.并且颜色自然,和铜融为一体,颜色好像从铜内部透出来的效果. 我想问一下(右)乳腺浸润性导管癌(II-III) 免疫组化:ER(+++)PR(+++)C-erbB-2(2+)ki67(+)>40% p53(+++) 汉语拼音"o",发"凹"的音,还是"窝"的音? 墙角的砖缝中掉进一粒香瓜子过了几天竟然冒出一截小瓜苗为什么用冒字 什么样的西瓜才是算是好瓜? 发不清汉语拼音L这个音怎么办我现在是13岁.我发现自己总是会把l发成re.我发现自己说l时舌头完全没有碰到上牙堂,也没有抬起来.后来我试着像其他人那样碰上牙膛,但是还是发不清.音乐课经 铜化学着色,绿色,兰色,红色,黑色技术 已知二次函数的图像与x轴交于A(-2,0)和B(3,0)2点,且函数有最大值2(1) 求二次函数的函数关系式(2) 设此二次函数图像的顶点为P,求三角形ABP的面积 有什么简单有好记学拼音的方法? 生命,生命 中的“竟然冒出一截小瓜苗”里的“竟然”起什么总用 已知二次函数的图像与x轴交于A(-2,0),B(3,0)两点,且函数有最大值是2求(1)解析式(2)设二次函数的顶点为P,求△ABP的面积 甲、乙、丙三台车床加工方形和圆形的两种零件,已知甲车床每加工3个零件中有2个是圆形的;乙车床每加工4个零件中有3个是圆形的;丙车床每加工5个零件 中有4个是圆形的.这天三台车床共 墙角的砖缝中掉进一粒香瓜子,过了几天,竟然冒出一截小瓜苗.伸、钻、探……为什么没“冒”这个字,用得好?= =别说它长得快、、 已知二次函数的图像与x轴交于A(-2,0)B(3,0)两点,且函数有最大值为2,求二次函数的解析式.一定要给过程 相同字母表示相同的数字,不同字母表示不同的数字.两位数EF等于多少?AB+CD=EE AB×CD=FFF 问:EF等于多少 不等式|x-2| 已知二次函数的图像与x轴交于A(-2,0),B(3,0)两点,且函数有最大值2(1)求二次函数的解析式 (2)设此二次函数图像顶点为P,求△ABP的面积 abcdg乘a等于ggggg做不来 做了特殊染色及酶组织化学染色检查,医生说结果不太好,又做血细胞簇分化抗原的17个项目,可能是什么病结果还没出来 急 西瓜的瓜蒂是屁股还是头带把儿那边是屁股还是头 诊断淋巴瘤为什么要作免疫组化检查? 不等式3分之1(x-m)>2-m的解集为x>2,则m的值为? H.264 CIF、H.263 CIF (10)一个四位数,给它加上小数点后比原数小2003.4 ,这个四位数是( ). 我想做个免疫组化的实验,上海这边哪里有代做免疫组化的公司啊?最好是做过的,技术过硬的. 图中每个字母代表一个数,任何三个相连格中的3个数之和是19,那么A+B+C+D等于几?图 A 9 B C D E 7 我汉语拼音中l的音一直发成n的音? 第三怎么读?(英文,可以发拼音.) 拼音aoeiuü里面的ü见到jqx会变成u,那为什么ü和y在一起的时候也去了两点变成了yu 拼音N和L发音不分,就是N和L能发同一种音我是湖北人.唯独N和L的读法我就是不分..就好比有的时候,我打字都能打错,另(ling)我有的时候都能拼成“ning”怎么样才能矫正啊?这个是南方人的通 十二.二十.三十英语怎么读 用拼音 汉语拼音有句顺口溜:小ü小ü有礼貌,见到jqx就脱帽.可是比如:音乐(yuè)、鱼(yú) 为什么ü也脱帽了希望得到阁下确定的答案.难道说这两个例子里用的都是u(屋)而不是ü吗?正确的解释是什么? 粤语拼音中是n全发l的音么 z全发j的音 j全发y的音么 2010+三位数+两位数+一位数=四位数一位数和两位数的十位一样 然后从0到8,每个都不能重复 好难啊 算了好久了 那位大哥帮帮忙啊 用不等式表示x除以2的商加上2至多为5 广州数控车床加工零件时,怎样较好的控制零件的长度,直径及加工精度? 胃镜碘染色用什么碘液 解不等式组 x-2.≥1 2(x-1) 自动车床能做到多高精度 想象作文 200字我只要200字的(多出来也得50字以下)、明白不?本人只要200字的求你们了、、真求你们了我给你们跪下了 大瓜苗怎样就可以结很多很多的瓜那 ADCDE乘以A等于EEEEEE里面的字母分别代表什么数字 已知二次函数当X=3时,函数有最大值-1,且函数图像与Y轴交于(0,-4)求该二次函数的解析式 已知二次函数F(x),当x=1/2时,有最大值25.当 F(X)=0时,两实数根的立方和为19,求F(X) 在雨中想象作文200字 已知二次函数当x=3 时,函数有最大值-1 ,且函数图象与y轴交于(0,-4),求该二次函数的关系式 要解...已知二次函数当x=3 时,函数有最大值-1 ,且函数图象与y轴交于(0,-4),求该二次函数的关系式 Excel2003问题,根据数字个数改变数字的颜色,如下所示: 细菌真菌有什么作用,麻烦大家相信告知 瓜苗什么下词语 拼音 ǖ 在jqx 后为什么要去掉“两点”?我不要什么儿歌和硬性要求的解释 我要这样做的道理 我记得在大学语言老师讲过,可惜我忘记了,所以现在跪求一种详细的解释说明道理.我隐约记得关 各种细菌与真菌及其作用我们老师要写的,列出书上所讲过的各种细菌与真菌和它们的作用,明天就要了, “隔了几天,竟然冒出了一截小瓜苗." 竟然为什么不能删去生命》中的 Excel2003如何识别数据后转回数据分组后的列标?如A列是1至50的随机数,现把50个数分成2组.把2组数分别填入C列和D列,也就是C2至C26和D2至D26.C1是C列的列标为:1,D1是D列的列标为:2.现在要在B列中识
备案号:鲁ICP备13029499号-2 说三道四 www.s3d4.cn 说三道四技术文摘