This article comes from http://blog.csdn.net/hellogv/
/// // The following is the method for locking the folder. Procedure tsysclass. quicklock (dirlist: tstrings); // dirlist is the list of saved folders var unlockdirlist: tstrings; I: integer; islock: Boolean; begin unlockdirlist: = tstringlist. create; unlockdirlist. add ('failed to lock the following directory; check whether a file is in use or an empty folder: '); for I: = 0 to dirlist. count-1 do begin islock: = false; // If getdirsize (dirlist. strings [I], true)> 0 then // If the folder is not empty, run the following statement. If it is empty, islock = f Alse islock: = renamefile (dirlist. strings [I], dirlist. strings [I] + '.. /'); // check whether the folder can be locked by modifying the folder name. If islock = false then begin // If the lock fails, record the directory folder name unlockdirlist. add (dirlist. strings [I]); end; If unlockdirlist. count = 1 then begin // The whole folder is successfully locked. showmessage ('Folder locked successfully! '); Exit; end; If unlockdirlist. count> 1 then // some folders are not locked. showmessage (unlockdirlist. text); unlockdirlist. free; end; //// // The following method is used to unlock a folder: Procedure tsysclass. unlock (dirlist: tstrings); var I, II: integer; filelist: tstrings; label loop; begin filelist: = tstringlist. create; for I: = 0 to dirlist. count-1 do begin // ------------------------------- create the filelist entry to lock the folder first. clear; createdir (dirli St. strings [I] + '. /'); // create the findall (dirlist. strings [I] + '. /', filelist); sysfunctions. filemove (dirlist. strings [I]); // The file is successfully decrypted or directly unlocked without decryption. Loop: end; showmessage ('successfully unlocked the folder! '+ #10 +' If the locked folder has not been deleted '+ #10 +', do not manually delete '+ #10 +'. This program is automatically deleted when it is disabled! '); End; Procedure tsysclass. findall (Path: string; var fileresult: tstrings); // find the file. path does not contain '/' var fpath, S: string; FS: tsearchrec; I: integer; begin fpath: = path + '/*. * '; If findfirst (fpath, faanyfile, FS) = 0 then begin if (FS. name <> '. ') and (FS. name <> '.. ') then if (FS. ATTR and fadirectory) = fadirectory then findall (path + '/' + FS. name, fileresult) else fileresult. add (path + '/' + FS. name); While findnext (FS) = 0 do begin if (FS. name <> '. ') and (FS. name <> '.. ') then if (FS. ATTR and fadirectory) = fadirectory then findall (path + '/' + FS. name, fileresult) else begin fileresult. add (path + '/' + FS. name); end; findclose (FS); end;