Delphi7 SFTP客户端管道读取输出异常问题求助

API 探路者

2026-7-24

Delphi7 SFTP浏览多次后卡顿/连接中断问题

问题背景

在Delphi7中实现了通过管道调用pscp.exe读取SFTP服务器内容并更新UI的功能，核心过程包括：

UpdateFileList：更新父文件夹内容
UpdateRemoteFile：更新子目录内容

故障现象

进行5-6次文件夹切换或浏览操作后，程序出现以下异常：

ListBox停止更新或无法显示文件夹内容
需等待20-30秒后点击刷新按钮才能恢复，恢复后仅能正常操作5-6次
调试发现操作数次后输出字符串变为Fatal Error，随后抛出Network error: Software caused connection abort错误

已排除网络问题，使用WINSCP快速浏览SFTP服务器无异常。

相关代码（`UpdateFileList`过程）

procedure TForm1.UpdateFileList(NewFile: string = '');
var
  CommandLine: string;
  ListTheFiles: string;
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
  SecurityAttr: TSecurityAttributes;
  ReadPipe, WritePipe: THandle;
  Buffer: array[0..8191] of AnsiChar;
  BytesRead: DWORD;
  OutputString: string;
  FileList: TStringList;
  i: Integer;
  WasOK: Boolean;
  SelectedFolder: string;
begin
  if ListRemote.ItemIndex >= 0 then
  begin
    SelectedFolder := ListRemote.Items[ListRemote.ItemIndex];
    if Pos('Directory:', SelectedFolder) > 0 then
    begin
      SelectedFolder := Copy(SelectedFolder, 12, MaxInt);
      SelectedFolder := Trim(SelectedFolder);
    end;
  end;

  ListRemote.Items.BeginUpdate;
  listRemote.Items.Clear;
  CommandLine := 'C:\Program Files (x86)\PuTTY\pscp.exe';
  ListTheFiles := '-sftp -P ' + lblPort.Text + ' -pw ' + lblPassword.Text + ' -ls ' + lblUserName.Text + '@' + lblHostName.Text + ':/home/' + lblUserName.Text + '/' + SelectedFolder;
  CommandLine := CommandLine + ' ' + ListTheFiles;

  listRemote.Items.Add('Directory: ' + 'home/' + lblUserName.Text);

  if FProcessInfo.hProcess <> 0 then
  begin
    TerminateProcess(FProcessInfo.hProcess, 0);
    CloseHandle(FProcessInfo.hProcess);
    CloseHandle(FProcessInfo.hThread);
    FProcessInfo.hProcess := 0;
  end;

  // Create pipes for reading the output of the command
  SecurityAttr.nLength := SizeOf(TSecurityAttributes);
  SecurityAttr.lpSecurityDescriptor := nil;
  SecurityAttr.bInheritHandle := True;
  if not CreatePipe(ReadPipe, WritePipe, @SecurityAttr, 0) then
  begin
    ShowMessage('Failed to create pipe: ' + SysErrorMessage(GetLastError));
    Exit;
  end;

  FillChar(StartupInfo, SizeOf(StartupInfo), 0);
  StartupInfo.cb := SizeOf(StartupInfo);
  StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
  StartupInfo.wShowWindow := SW_HIDE;
  StartupInfo.hStdInput := GetStdHandle(STD_INPUT_HANDLE);
  StartupInfo.hStdOutput := WritePipe;
  StartupInfo.hStdError := WritePipe;

  if CreateProcess(nil, PChar(CommandLine), nil, nil, True, CREATE_NO_WINDOW, nil, nil, StartupInfo, ProcessInfo) then
  begin
    CloseHandle(WritePipe);

    // Read the output of the command
    repeat
      WasOK := ReadFile(ReadPipe, Buffer, SizeOf(Buffer), BytesRead, nil);
      if BytesRead > 0 then
      begin
        Buffer[BytesRead] := #0;
        OutputString := OutputString + StringReplace(Buffer, #13#10, #10, [rfReplaceAll]); // replace Windows-style line endings with Unix-style
      end;
    until not WasOK or (BytesRead = 0);

    WaitForSingleObject(ProcessInfo.hProcess, INFINITE);

    // Process the OutputString for folders and files
    FileList := TStringList.Create;
    try
      FileList.Text := OutputString;

      for i := 0 to FileList.Count - 1 do
      begin
       // if (FileList[i][1] = 'd') or (FileList[i][1] = '-') then // check if the line contains a file or folder
       // begin
          ListRemote.Items.Add(ExtractFileName(Trim(Copy(FileList[i], 56, Length(FileList[i]) - 55))));// extract the file or folder name
          ListRemote.Update;
          Application.ProcessMessages;
      //  end;
      end;
    finally
      FileList.Free;
    end;

    CloseHandle(ProcessInfo.hProcess);
    CloseHandle(ProcessInfo.hThread);
    CloseHandle(ReadPipe);
  end;

  ListRemote.Items.EndUpdate;
end;

问题根源分析

资源泄漏：
- 未检查FProcessInfo.hThread是否有效就直接关闭，可能触发无效句柄操作
- CreateProcess失败时，未关闭已创建的管道句柄，造成句柄泄漏
- OutputString未初始化，多次调用后累积旧数据干扰解析
管道读取逻辑缺陷：未处理管道另一端关闭的ERROR_BROKEN_PIPE错误，可能导致循环阻塞
频繁创建连接：每次操作都启动新pscp.exe进程建立SFTP连接，服务器可能因短时间内过多请求触发限流
UI更新不当：BeginUpdate/EndUpdate区间内调用Application.ProcessMessages，易引发UI重入问题

修复方案

1. 修复资源泄漏与管道逻辑

procedure TForm1.UpdateFileList(NewFile: string = '');
var
  CommandLine: string;
  ListTheFiles: string;
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
  SecurityAttr: TSecurityAttributes;
  ReadPipe, WritePipe: THandle;
  Buffer: array[0..8191] of AnsiChar;
  BytesRead: DWORD;
  OutputString: string;
  FileList: TStringList;
  i: Integer;
  WasOK: Boolean;
  SelectedFolder: string;
begin
  if ListRemote.ItemIndex >= 0 then
  begin
    SelectedFolder := ListRemote.Items[ListRemote.ItemIndex];
    if Pos('Directory:', SelectedFolder) > 0 then
    begin
      SelectedFolder := Copy(SelectedFolder, 12, MaxInt);
      SelectedFolder := Trim(SelectedFolder);
    end;
  end;

  ListRemote.Items.BeginUpdate;
  try
    listRemote.Items.Clear;
    listRemote.Items.Add('Directory: ' + 'home/' + lblUserName.Text);

    // 初始化输出字符串
    OutputString := '';

    // 安全终止旧进程
    if FProcessInfo.hProcess <> 0 then
    begin
      TerminateProcess(FProcessInfo.hProcess, 0);
      WaitForSingleObject(FProcessInfo.hProcess, 1000);
      CloseHandle(FProcessInfo.hProcess);
      FProcessInfo.hProcess := 0;
    end;
    if FProcessInfo.hThread <> 0 then
    begin
      CloseHandle(FProcessInfo.hThread);
      FProcessInfo.hThread := 0;
    end;

    // 创建管道并包裹在try-finally中确保资源释放
    SecurityAttr.nLength := SizeOf(TSecurityAttributes);
    SecurityAttr.lpSecurityDescriptor := nil;
    SecurityAttr.bInheritHandle := True;
    if not CreatePipe(ReadPipe, WritePipe, @SecurityAttr, 0) then
    begin
      ShowMessage('Failed to create pipe: ' + SysErrorMessage(GetLastError));
      Exit;
    end;

    try
      FillChar(StartupInfo, SizeOf(StartupInfo), 0);
      StartupInfo.cb := SizeOf(StartupInfo);
      StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
      StartupInfo.wShowWindow := SW_HIDE;
      StartupInfo.hStdInput := GetStdHandle(STD_INPUT_HANDLE);
      StartupInfo.hStdOutput := WritePipe;
      StartupInfo.hStdError := WritePipe;

      CommandLine := 'C:\Program Files (x86)\PuTTY\pscp.exe';
      ListTheFiles := '-sftp -P ' + lblPort.Text + ' -pw ' + lblPassword.Text + ' -ls ' + lblUserName.Text + '@' + lblHostName.Text + ':/home/' + lblUserName.Text + '/' + SelectedFolder;
      CommandLine := CommandLine + ' ' + ListTheFiles;

      if CreateProcess(nil, PChar(CommandLine), nil, nil, True, CREATE_NO_WINDOW, nil, nil, StartupInfo, ProcessInfo) then
      begin
        try
          CloseHandle(WritePipe);
          WritePipe := 0;

          // 改进管道读取逻辑，处理管道断开情况
          repeat
            WasOK := ReadFile(ReadPipe, Buffer, SizeOf(Buffer)-1, BytesRead, nil);
            if WasOK or (GetLastError = ERROR_BROKEN_PIPE) then
            begin
              if BytesRead > 0 then
              begin
                Buffer[BytesRead] := #0;
                OutputString := OutputString + StringReplace(Buffer, #13#10, #10, [rfReplaceAll]);
              end;
            end
            else
              Break;
          until (BytesRead = 0);

          WaitForSingleObject(ProcessInfo.hProcess, INFINITE);

          // 解析输出并更新UI
          FileList := TStringList.Create;
          try
            FileList.Text := OutputString;
            for i := 0 to FileList.Count - 1 do
            begin
              // 恢复文件/目录判断逻辑
              if (FileList[i] <> '') and (FileList[i][1] in ['d', '-']) then
              begin
                ListRemote.Items.Add(ExtractFileName(Trim(Copy(FileList[i], 56, Length(FileList[i]) - 55))));
              end;
            end;
          finally
            FileList.Free;
          end;
        finally
          CloseHandle(ProcessInfo.hProcess);
          CloseHandle(ProcessInfo.hThread);
        end;
      end
      else
      begin
        ShowMessage('Failed to start process: ' + SysErrorMessage(GetLastError));
      end;
    finally
      if ReadPipe <> 0 then CloseHandle(ReadPipe);
      if WritePipe <> 0 then CloseHandle(WritePipe);
    end;
  finally
    ListRemote.Items.EndUpdate;
  end;
end;

2. 优化SFTP连接方式

替换pscp.exe为原生SFTP组件（如Indy的TIdSFTP或SecureBlackbox），直接在程序内维护持久化SFTP连接，避免频繁启动外部进程，大幅提升稳定性和性能。

3. 改进UI更新逻辑

移除BeginUpdate/EndUpdate区间内的Application.ProcessMessages，若需实时更新UI，将SFTP操作放到独立线程中，通过Synchronize方法同步更新UI，避免阻塞主线程。

内容的提问来源于stack exchange，提问作者Иван Ралев

Delphi7 SFTP客户端管道读取输出异常问题求助

问题背景 #

故障现象 #

相关代码（UpdateFileList过程） #

问题根源分析 #

修复方案 #

1. 修复资源泄漏与管道逻辑 #

2. 优化SFTP连接方式 #

3. 改进UI更新逻辑 #