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

发布网友发布时间：2022-05-15 21:52

共1个回答

热心网友时间：2023-12-26 04:55

用你的程序独占打开文件夹
下面的代码可以独占一个文件的打开

//=========================================================
procere 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;

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

procere 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;
//=======================================================================
procere TForm1.Button1Click(Sender: TObject);
begin

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

end;