多线程致内存泄漏：Delphi API请求应用故障排查求助

首先，我帮你梳理下代码里的几个核心问题，这些正是导致内存泄漏和程序不稳定的原因：

1. 线程直接操作VCL控件（最关键问题） #

VCL控件不是线程安全的，你在线程的Execute方法里直接修改frmMain的Label属性（比如frmMain.lblBid.Caption := ...），会导致工作线程和UI主线程同时访问控件资源，引发竞态条件——这不仅会造成内存泄漏，还可能导致程序崩溃、界面错乱等问题。

2. TIdSSLIOHandlerSocketOpenSSL未正确释放 #

在TGetBinance线程中，你创建了SocketOpenSSL并赋值给httpclient.IOHandler，但因为创建时指定的Owner是nil，httpclient.Free并不会自动释放这个IOHandler，导致每次线程执行都会泄漏一份TIdSSLIOHandlerSocketOpenSSL资源。

3. 缺少错误处理 #

HTTP请求可能因为网络问题、API返回错误失败，但你的代码没有捕获异常，一旦请求失败，后续的JSON解析和资源释放都会出问题，进一步加剧内存泄漏。

修复后的完整代码 #

下面是修复后的代码，我标注了关键修改点：

unit uMain;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, IdSSLOpenSSL,
  IdIOHandler, IdIOHandlerSocket, IdIOHandlerStack, IdSSL;

type
  TfrmMain = class(TForm)
    grpLuno: TGroupBox;
    lblBid: TLabel;
    lblRolling24HourVolume: TLabel;
    grpBinance: TGroupBox;
    tmrRefresh: TTimer;
    lblPrice: TLabel;
    lblBinanceVolume: TLabel;
    lbl1: TLabel;
    lbl24hChange: TLabel;
    procedure tmrRefreshTimer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    procedure Refresh;
  public
    { Public declarations }
  end;

type
  TGetLuno = class(TThread)
  protected
    procedure Execute; override;
  end;

type
  TGetBinance = class(TThread)
  protected
    procedure Execute; override;
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

uses djson, DateUtils, Math;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NoMove or SWP_NoSize);
  Refresh;
end;

procedure TfrmMain.Refresh;
begin
  with TGetLuno.Create do
    FreeOnTerminate := True;
  with TGetBinance.Create do
    FreeOnTerminate := True;
end;

procedure TfrmMain.tmrRefreshTimer(Sender: TObject);
begin
  Refresh;
end;

{ TGetLuno }
procedure TGetLuno.Execute;
var
  httpclient: TIdHTTP;
  sdata: string;
  jdata: TJSON;
  bidStr, volumeStr: string;
begin
  httpclient := TIdHTTP.Create(nil);
  try
    try
      sdata := httpclient.Get('https://api.mybitx.com/api/1/ticker?pair=XBTZAR');
    except
      on E: Exception do
      begin
        // 捕获HTTP请求异常，避免线程崩溃
        Synchronize(procedure
        begin
          frmMain.lblBid.Caption := 'Request failed';
        end);
        Exit;
      end;
    end;

    jdata := TJSON.Parse(sdata);
    try
      // 先把需要的UI数据提取到局部变量，避免在同步块里持有JSON资源
      bidStr := 'Price: R ' + jdata['bid'].AsString;
      volumeStr := 'Volume: ' + jdata['rolling_24_hour_volume'].AsString;
    finally
      jdata.Free; // 及时释放JSON资源
    end;

    // 使用Synchronize在主线程更新UI（保证线程安全）
    Synchronize(procedure
    begin
      frmMain.lblBid.Caption := bidStr;
      frmMain.lblRolling24HourVolume.Caption := volumeStr;
    end);
  finally
    httpclient.Free; // 释放HTTP客户端
  end;
end;

{ TGetBinance }
procedure TGetBinance.Execute;
var
  httpclient: TIdHTTP;
  sdata: string;
  jdata: TJSON;
  SocketOpenSSL: TIdSSLIOHandlerSocketOpenSSL;
  priceStr, volumeStr, changeStr: string;
  changeColor: TColor;
begin
  httpclient := TIdHTTP.Create(nil);
  try
    // 把httpclient作为IOHandler的Owner，这样httpclient释放时会自动清理它
    SocketOpenSSL := TIdSSLIOHandlerSocketOpenSSL.Create(httpclient);
    SocketOpenSSL.SSLOptions.SSLVersions := [sslvTLSv1, sslvTLSv1_1, sslvTLSv1_2];
    httpclient.IOHandler := SocketOpenSSL;

    try
      sdata := httpclient.Get('https://api.binance.com/api/v1/ticker/24hr?symbol=BTCUSDT');
    except
      on E: Exception do
      begin
        Synchronize(procedure
        begin
          frmMain.lblPrice.Caption := 'Request failed';
        end);
        Exit;
      end;
    end;

    jdata := TJSON.Parse(sdata);
    try
      // 提取UI所需数据到局部变量
      priceStr := 'Price: $ ' + jdata['lastPrice'].AsString;
      volumeStr := 'Volume: ' + jdata['volume'].AsString;

      // 计算涨跌幅和颜色，提前处理避免在同步块里做复杂逻辑
      if StrToFloat(StringReplace(jdata['priceChangePercent'].AsString, '.', ',', [rfReplaceAll, rfIgnoreCase])) > 0 then
        changeColor := clLime
      else
        changeColor := clRed;
      changeStr := StringReplace(FloatToStr(RoundTo(StrToFloat(StringReplace(jdata['priceChangePercent'].AsString, '.', ',', [rfReplaceAll, rfIgnoreCase])), -2)), ',', '.', [rfReplaceAll, rfIgnoreCase]) + ' %';
    finally
      jdata.Free;
    end;

    // 同步更新UI
    Synchronize(procedure
    begin
      frmMain.lblPrice.Caption := priceStr;
      frmMain.lblBinanceVolume.Caption := volumeStr;
      frmMain.lbl24hChange.Font.Color := changeColor;
      frmMain.lbl24hChange.Caption := changeStr;
    end);
  finally
    httpclient.Free; // 自动释放SocketOpenSSL（因为Owner是httpclient）
  end;
end;

initialization
  ReportMemoryLeaksOnShutdown := True;

end.

关键优化点说明 #

1. 线程安全的UI更新：用Synchronize方法把UI更新逻辑包装起来，确保这些代码在主线程执行，彻底避免线程直接操作VCL控件的问题。
2. 修复IOHandler泄漏：创建TIdSSLIOHandlerSocketOpenSSL时把httpclient作为Owner，这样释放httpclient时会自动清理IOHandler资源。
3. 提前释放资源：在同步UI之前就释放JSON对象，避免长时间持有不必要的资源。
4. 增加异常处理：捕获HTTP请求异常，避免线程崩溃，同时给用户反馈请求状态。

额外优化建议 #

• 如果你的刷新频率比较高（每10秒一次），可以考虑复用HTTP客户端对象，而不是每次线程创建都新建——比如在主线程创建全局的TIdHTTP和TIdSSLIOHandlerSocketOpenSSL，线程里直接使用（注意要加锁保证线程安全），减少资源创建销毁的开销。
• 如果不需要等待UI更新完成再继续线程工作，可以用Queue代替Synchronize，Queue是非阻塞的，不会让工作线程等待主线程，性能更好。

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