打开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
''选择拷贝到的文件