Delphi 2006多线程处理XML达9728个时无报错挂起问题排查

我开发了一款用于筛选指定.xml文件的工具，核心运行逻辑为：加载目标XML文件到TStringList中，检查文件内容是否包含指定编号，将符合匹配规则的文件移动到指定文件夹，供公司其他业务板块上传使用。

故障现象 #

• 程序累计处理移动约9728个文件后，会无任何征兆停止运行
• 故障发生时不弹出任何错误提示，进程始终处于挂起状态
• 程序使用Delphi 2006开发，怀疑是代码长时间运行触发了隐藏的逻辑缺陷

线程处理单元（Unit5） #

unit Unit5;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, DBGrids, dblookup, FileCtrl, ExtDlgs, StrUtils;

type
  FThread = class(TThread)
  private
    { Private declarations }
    arquivo: string;
    Lista3: TStringList;
  protected
    procedure Execute; override;
    procedure UpdateMemo; overload;
  end;

implementation

uses AcharArquivos3;

{ 注意：可视化组件的方法和属性仅能通过Synchronize调用的方法访问，示例：
      Synchronize(UpdateCaption);
  对应UpdateCaption实现：
    procedure FThread.UpdateCaption;
    begin
      Form1.Caption := 'Updated in a thread';
    end; }

{ FThread }

procedure FThread.UpdateMemo;
begin
  Lista3.Add(Arquivo);
end;

procedure FThread.Execute;
var
  SR: TSearchRec;
  Lista2: TStringList;
  Caminho: string;
  CaminhoOriginal: string;
  Origem: string;
  Destino: string;
begin
  inherited;
  Caminho := Form3.Dir;
  CaminhoOriginal := Form3.Edit1.Text;
  Lista2 := TStringList.Create;
  Lista3 := TStringList.Create;
  if FindFirst(IncludeTrailingBackslash(Caminho) + '*.*', faAnyFile or faDirectory, SR) = 0 then
  try
    repeat
      if (SR.Attr and faDirectory) = 0 then
      begin
        if (ExtractFileExt(SR.Name) = '.xml') and not (Pos(Sr.Name, Lista3.Text) > 0) then
          Lista2.LoadFromFile(IncludeTrailingBackslash(Caminho) + SR.name);
          if Pos(Form3.NCM, Lista2.Text) > 0 then
          begin
            Origem := Caminho + '\' + SR.name;
            Destino := CaminhoOriginal + '\' + 'Incluir' + '\' + SR.Name;
            Arquivo := ChangeFileExt(SR.name, '');
            Lista3.Add(Arquivo);
            MoveFile(Pchar(Origem), Pchar(Destino));
            Synchronize(Self.UpdateMemo);
          end;
        end
      else if (SR.Name <> '.') and (SR.Name <> '..') and (Sr.Name <> 'Incluir') then
      begin
        Caminho := (IncludeTrailingBackslash(Caminho) + SR.Name);  // 递归遍历
      end;
    until (FindNext(Sr) <> 0) and (Sr.Name = 'Incluir');
  finally
    FindClose(SR);
    ShowMessage('检索完成!');
    Form3.Button6.Enabled := True;
    Form3.Button5.Enabled := True;
    Form3.Button2.Enabled := True;
    Form3.Memo3.Lines.Add(Lista3.Text);
  end;
end;

end.

VCL窗体单元（AcharArquivos3） #

unit AcharArquivos3;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, DBGrids, dblookup, FileCtrl, ExtDlgs, StrUtils;

type
  TForm3 = class(TForm)
    OpenDialog1: TOpenDialog;
    Button2: TButton;
    OpenPictureDialog1: TOpenPictureDialog;
    SaveDialog1: TSaveDialog;
    Label3: TLabel;
    Memo3: TMemo;
    Button5: TButton;
    Label4: TLabel;
    Button6: TButton;
    ComboBox1: TComboBox;
    Edit1: TEdit;
    Label1: TLabel;
    procedure Button2Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    Path:String;
    NCM: String;
    Origem: string;
    Destino: string;
    Dir: String;
    Lista2: TStringList;
    Lista: TStringList;
  end;

var
  Form3: TForm3;

implementation

{$R *.dfm}

uses Unit5;

// 获取当前系统用户名
function WUserName: String;
var
  nSize: DWord;
begin
  nSize := 1024;
  SetLength(Result, nSize);
  if GetUserName(PChar(Result), nSize) then
    SetLength(Result, nSize-1)
  else
    RaiseLastOSError;
end;

// 选择XML文件存储目录
procedure TForm3.Button2Click(Sender: TObject);
var
  chosenDirectory : string;
begin
  if SelectDirectory('选择目录', 'C:\' + WUserName + 'Documents', chosenDirectory) then
  begin
    Edit1.Text := chosenDirectory;
  end
  else
    ShowMessage('文件夹选择已取消');
end;

// 导出匹配文件列表
procedure TForm3.Button5Click(Sender: TObject);
var
  FileName: String;
begin
  if (Memo3.GetTextLen() > 0) then
  begin
    SaveDialog1.FileName := '匹配文件列表';
    SaveDialog1.DefaultExt := 'txt';
    SaveDialog1.Filter := '文本文件|*.txt|Word文件|*.doc';
    SaveDialog1.Title := '保存匹配文件列表';
    Memo3.Lines.Delete(Memo3.Lines.Count-1);
    if SaveDialog1.Execute then
      Memo3.Lines.SaveToFile(SaveDialog1.FileName);
    SaveDialog1.Free;
    Memo3.Lines.Clear;
  end
  else
    ShowMessage('无已匹配的文件');
end;

// 启动检索线程
procedure TForm3.Button6Click(Sender: TObject);
var
  vThread : FThread;
begin
  if ComboBox1.Text = '' then
  begin
    ShowMessage('请选择需要检索的NCM编号');
    Exit;
  end;
  if Edit1.Text = '' then
  begin
    ShowMessage('请选择或输入目标目录路径');
    Exit;
  end;
  if ComboBox1.Text = '2402 - 香烟类' then
    NCM := '<NCM>2402';
  Dir := Edit1.Text;
  if not DirectoryExists(Dir + '\' + 'Incluir') then
  begin
    CreateDir(Dir + '\' + 'Incluir.');
  end;
  Button6.Enabled := False;
  Button5.Enabled := False;
  Button2.Enabled := False;
  vThread := FThread.Create(True);
  vThread.FreeOnTerminate := True;
  VThread.Resume;
end;

end.

内容的提问来源于stack exchange，提问作者Kelvin Klein