网站导航免费论文 原创论文 论文搜索 原创论文 网学软件 学术大家 资料中心 会员中心 问题解答 原创论文 论文素材 设计下载 最新论文 下载排行 论文上传 在线投稿 联系我们
返回网学首页
网学联系
最新论文 推荐专题 热门论文 素材专题
当前位置: 网学 > 编程文档 > DELPHI > 正文
Delphi实现Windows外壳扩展编程
来源:Http://myeducs.cn 联系QQ:点击这里给我发消息 作者: 用户投稿 来源: 网络 发布时间: 12/10/12
下载{$ArticleTitle}原创论文样式
于同一个目录下。

打开Delphi,选菜单中的 file | open project 打开contextmenu.dpr文件,然后选 Project | build contextmenu菜单项编译连接程序,如果编译成功的话,会建立一个contextmenu.dll的动态连接库文件,这个文件就是服务器动态连接库。

下面来建立文件操作程序。打开VB,建立一个新的工程文件,在Form1中加入一个ListBox控件和三个CommandButton控件,将ListBox的MultiSelect属性设置为2。然后在Form1的代码窗口中加入以下代码:

Option Explicit

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

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

Const FO_COPY = &H2

Const FO_DELETE = &H3

Const FO_MOVE = &H1

Const FO_RENAME = &H4

Const FOF_ALLOWUNDO = &H40

Const BIF_RETURNONLYFSDIRS = 1

Const MAX_PATH = 260

Private Declare Function ShellAbout Lib "shell32.dll" Alias _

ShellAboutA

(ByVal hwnd As Long

ByVal szApp As _

String

ByVal szOtherStuff As String

ByVal hIcon As Long) _

As Long

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

Private Declare Function SHFileOperation Lib "shell32" _

(lpFileOp As SHFILEOPSTRUCT) As Long

Private Declare Function GetWindowsDirectory _

Lib "kernel32" Alias "GetWindowsDirectoryA" _

(ByVal lpBuffer As String

ByVal nSize As _

Long) As Long

Dim DirString As String

Dim sFile As String

Sub UpdateList()

''UpdateList函数检查列表框中的文件是否存在,如果不存在,就将其

''从文件列表中删除

Dim bEndList As Boolean

Dim i As Integer

bEndList = True

i = 0

While bEndList

''检查文件是否存在,如果不存在就删除

If Dir$(List1.List(i)) = "" Then

List1.RemoveItem (i)

Else ''如果文件存在就转移到下一个列表项

i = i + 1

If i > List1.ListCount - 1 Then

bEndList = False

End If

End If

Wend

Command1.Enabled = False

Command2.Enabled = False

Command3.Enabled = False

End Sub

Function BrowseForFolder(hwndOwner As Long

sPrompt As String) As String

Dim iNull As Integer

Dim lpIDList As Long

Dim lResult As Long

Dim sPath As String

Dim udtBI As BrowseInfo

''初试化udtBI结构

With udtBI

.hwndOwner = hwndOwner

.lpszTitle = lstrcat(sPrompt

)

.ulFlags = BIF_RETURNONLYFSDIRS

End With

''弹出文件夹查看窗口

lpIDList = SHBrowseForFolder(udtBI)

If lpIDList Then

sPath = String$(MAX_PATH

0)

lResult = SHGetPathFromIDList(lpIDList

sPath)

Call CoTaskMemFree(lpIDList)

iNull = InStr(sPath

vbNullChar)

If iNull Then sPath = Left$(sPath

iNull - 1)

End If

BrowseForFolder = sPath

End Function

Private Sub Command1_Click() ''执行文件拷贝操作

Dim sPath As String

Dim tCopy As SHFILEOPSTRUCT

Dim i As Integer

''选择拷贝到的文件

  • 下一篇资讯: Delphi编程实现文件关联
  • 网学推荐

    免费论文

    原创论文

    浏览:
    设为首页 | 加入收藏 | 论文首页 | 论文专题 | 设计下载 | 网学软件 | 论文模板 | 论文资源 | 程序设计 | 关于网学 | 站内搜索 | 网学留言 | 友情链接 | 资料中心
    版权所有 QQ:3710167 邮箱:3710167@qq.com 网学网 [Myeducs.cn] 您电脑的分辨率是 像素
    Copyright 2008-2015 myeducs.Cn www.myeducs.Cn All Rights Reserved
    湘ICP备09003080号