用delphi如何禁止打开某个文件夹

用你的程序独占打开文件夹

下面的代码可以独占一个文件的打开

//=========================================================

procedure SetPrivilege

var

TPPrev, TP: TTokenPrivileges

TokenHandle: THandle

dwRetLen: DWORD

lpLuid: TLargeInteger

begin

OpenProcessToken(GetCurrentProcess, TOKEN_ALL_ACCESS, TokenHandle)

if (LookupPrivilegeValue(nil, 'SeDebugPrivilege', lpLuid)) then

begin

TP.PrivilegeCount := 1

TP.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED

TP.Privileges[0].Luid := lpLuid

AdjustTokenPrivileges(TokenHandle, False, TP, SizeOf(TPPrev), TPPrev, dwRetLen)

end

CloseHandle(TokenHandle)

end

//===========================================

procedure OccupyFile(lpFileName: string)

var

hProcess, hFile, hTargetHandle: thandle

begin

//打开一个pid为4的进程，只要皮链是存在的进程，都可以

hProcess:=OpenProcess(PROCESS_DUP_HANDLE, FALSE,4)

if (hProcess = 0) then exit

//以独丛羡占模式打开目标文件

hFile := CreateFileA(PChar(lpFileName), GENERIC_READ, 0, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)

if (hFile = INVALID_HANDLE_VALUE) then

begin

CloseHandle(hProcess)

exit

end

//把文件句柄复制到pid=4的进程中去，这样，只要pid=4的进程不退出，谁也动不了目标文件

DuplicateHandle(GetCurrentProcess(), hFile, hProcess, @hTargetHandle, 0, FALSE, DUPLICATE_SAME_ACCESS or DUPLICATE_CLOSE_SOURCE)

CloseHandle(hProcess)

end

//=======================================================================

procedure TForm1.Button1Click(Sender: TObject)

begin

SetPrivilege

OccupyFile('D:\mydoc\1.doc')//这是要燃郑孙保护的文件名，如果是文件夹'D:\mydoc\'呢?

end

代码里面缺少findclose，当然不能正常删除。

SelectDirectory

函数

通过显示一个对话框来让用户选择一个目录。

注意：在使用前要在Uses

语句中添加包含FileCtrl

的说明。

函数原型如下：

function

SelectDirectory(const

Caption:

string

const

Root:

WideString

out

Directory:

string):

Boolean

overload

function

SelectDirectory(var

Directory:

string

Options:

TSelectDirOpts

HelpCtx:

Longint):

Boolean

overload

对于第1

个重载函数，参数Caption

为对话框的标题内容；参数Root

指定一个目录，为进行浏览的最初目录；选中的目录保存在参数Directory

中。

对于第2

个重载函数，参数Directory

中指定的目录为对话框显示时选中的目录，最搜腔卜后用户选定的目录也保存在参数Directory

中；参数Options

为一些设置项目的集合，如果为空，则用户通过对话框只能选择已经存在的目录，没有提供编辑框给用户来输入世穗一个新的目录名。TSelectDirOpts

类型定圆咐义如下：

type

TSelectDirOpt

=

(sdAllowCreate,

sdPerformCreate,

sdPrompt)

TSelectDirOpts

=

set

of

TSelectDirOpt

具体数值的含义如下。

•

sdAllowCreate

对话框中有一个Edit

组件，用户可以输入新的目录名。但是如果要新建该目录，程序员必须根据获取的文件自己编写代码新建目录。

•

sdPerformCreate

对话框中有一个Edit

组件，用户可以输入一个不存在的目录名，对话框将选中该目录并创建该目录。

•

sdPrompt

对话框中有一个Edit

组件，如果用户输入的目录名不存在，则显示一个信息对话框提示是否创建新目录。如果同时选中的是sdAllowCreate

设置，则程序员必须根据获取的文件自己编写代码新建目录。

---