Question

我需要一个程序来覆盖文件，但有时一些进程会锁定它。如何检查哪个进程锁定文件，以及如何解锁？我应该使用哪些功能？

我在互联网上找到了这样的代码，但它对我不起作用。

unit proc;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, ComCtrls, Grids, ValEdit, MTSUtilsUnit, TLHelp32,
  Menus, PsAPI;

type
  TApp = class
    fPID: Integer;
    fPArentPID: Integer;
    fPIDName: string;
    fThread: Integer;
    fDLLName: TStringList;
    fDLLPath: TStringList;
    fDescription: string;
  end;

  TForm2 = class(TForm)
    StatusBar1: TStatusBar;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    Splitter2: TSplitter;
    Edit1: TEdit;
    Button1: TButton;
    Label1: TLabel;
    RichEdit1: TRichEdit;
    PopupMenu1: TPopupMenu;
    kill1: TMenuItem;
    StringGrid1: TStringGrid;
    function GetApps(AppName: string): TStringList;
    function GetInfo(PID: Integer): string;
    function Kill(PID: Integer): Boolean;
    procedure kill1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;
  ApplicationList: TStringList;
  row: Integer;

implementation

{$R *.dfm}

function TForm2.Kill(PID: Integer): Boolean;
var fHandle: THandle;
begin
  fHandle := OpenProcess(PROCESS_TERMINATE, BOOL(0), PID);
  if TerminateProcess(fHandle, 0) then
    Result := True
  else
    Result := False;

  CloseHandle(fHandle);
end;

procedure TForm2.kill1Click(Sender: TObject);
var i: Integer;
  fApp: TApp;
begin
  if Kill(StrToInt(StringGrid1.Cells[1, row])) then
  begin
    ApplicationList.Delete(row);
    StringGrid1.RowCount := ApplicationList.Count;
    for i := 1 to ApplicationList.Count - 1 do
    begin
      fApp := TApp(ApplicationList.Objects[i]);
      Form2.StringGrid1.Cells[0,i] := fApp.fPIDName;
      Form2.StringGrid1.Cells[1,i] := IntToStr(fApp.fPID);
    end;
    MessageBox(0, 'Terminate successfully', 'Kill', MB_ICONINFORMATION or MB_OK);
  end
  else
    MessageBox(0, 'Could not terminate process', 'Kill', MB_ICONINFORMATION or MB_OK);
end;

procedure TForm2.StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
  var CanSelect: Boolean);
var fApp: TApp;
begin
  row := ARow;
  RichEdit1.Lines.Clear();
  if ApplicationList.Count >= row then
  begin
    fApp := TApp(ApplicationList.Objects[row]);
    RichEdit1.Lines.Add(fApp.fDescription);
  end;
end;

procedure TForm2.Button1Click(Sender: TObject);
var i: Integer;
  fApp: TApp;
  sItem: string;
  CanSelect: Boolean;
begin
  for i := 0 to ApplicationList.Count - 1 do
  begin
    fApp := TApp(ApplicationList.Objects[i]);
    FreeAndNil(fApp.fDLLName);
    FreeAndNil(fApp.fDLLPath);
    FreeAndNil(fApp);
  end;
  FreeAndNil(ApplicationList);

  ApplicationList := GetApps(Edit1.Text);
  StringGrid1.RowCount := ApplicationList.Count;
  for i := 0 to ApplicationList.Count - 1 do
  begin
    fApp := TApp(ApplicationList.Objects[i]);
    StringGrid1.Cells[0,i] := fApp.fPIDName;
    StringGrid1.Cells[1,i] := IntToStr(fApp.fPID);
  end;
  StringGrid1.OnSelectCell(Self, 0, 1, CanSelect);
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
  StringGrid1.Cells[0,0] := 'Name';
  StringGrid1.Cells[1,0] := 'PID';
end;

function TForm2.GetInfo(PID: Integer): string;
var fHandle: THandle;
  fModule: TModuleEntry32;
  sInfo: string;
begin
  Result := '';
  sInfo := 'DLL Name: %s'#13#10 +
           'DLL Path: %s'#13#10 +
           'ModuleId: %d'#13#10;

  fHandle := CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, PID);

  if fHandle <> INVALID_HANDLE_VALUE then
  if Module32First(fHandle, fModule) then
  repeat
    if SameText(ExtractFileExt(fModule.szModule), '.dll') then
    begin
      sInfo := Format(sInfo, [fModule.szModule, fModule.szExePath, fModule.th32ModuleID]);
      Result := Result + sInfo;
    end;
  until not Module32Next(fHandle, fModule);
end;

function TForm2.GetApps(AppName: string): TStringList;
var fHandle: THandle;
  fModHandle: THandle;
  fProcess: TProcessEntry32;
  fModule: TMODULEENTRY32;
  App: TApp;
  i: Integer;
  IsDLL: Boolean;
  IsProcess: Boolean;
  fDesc: string;
  sPath: string;
begin
  IsDLL := False;
  IsProcess := False;


  Result := TStringList.Create();
  Result.Clear();
  fDesc := 'DLL Name: %s'#13#10 +
           'DLL Path: %s'#13#10 +
           'ModuleId: %d'#13#10;

  fHandle := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
  fProcess.dwSize := SizeOf(fProcess);

  IsProcess := Process32First(fHandle, fProcess);

  while IsProcess do
  begin
    App := TApp.Create();
    App.fDLLName := TStringList.Create();
    App.fDLLPath := TStringList.Create();
    fModHandle := CreateToolHelp32SnapShot(TH32CS_SNAPMODULE, fProcess.th32ProcessID);
    IsDLL := Module32First(fModHandle, fModule);
    while IsDLL do
    begin
      if Edit1.Text <> '' then
        sPath := fModule.szModule
      else
        sPath := ExtractFileExt(fModule.szModule);
      if SameText(sPath, Edit1.Text + '.dll') then
      begin
        App.fPID := fProcess.th32ProcessID;
        App.fPIDName := fProcess.szExeFile;
        App.fDLLName.Add(fModule.szModule);
        App.fDLLPath.Add(fModule.szExePath);
        App.fDescription := App.fDescription +
          Format(fDesc, [fModule.szModule, fModule.szExePath, fModule.th32ModuleID]);
      end;
      IsDLL := Module32Next(fModHandle, fModule)
    end;
    if App.fDLLName.Count > 0 then
      Result.AddObject(IntToStr(App.fPID), App);
    IsProcess := Process32Next(fHandle, fProcess);
  end;
  CloseHandle(fHandle);
  Result.Count;
end;

end.

Answer 1

您不应该自己解锁文件，这会导致数据丢失！将它留给用户，而是显示错误并解释哪个进程保持打开文件。

此解决方案可以帮助您： http://www.remkoweijnen.nl/blog/2011/01/03/cannot-access-files-but-need-the-origin

Answer 2

结帐Process Explorer。它将显示哪些进程打开了哪些文件，并允许您关闭单个文件。

什么程序锁定文件

2 个答案: