历史遗留Pascal项目的架构优化思路：如何重构适配现代应用开发场景

一、为什么老Pascal项目需要"动手术"

1.1 老代码带来的日常困扰

想象一下，你接手了一个运行了十几年的Pascal系统，每天要往里面加新功能、改老bug。你会发现一个很现实的困境：代码像是用胶水粘在一起的大蛋糕，动一块就掉一坨。界面和业务逻辑混在一个大文件里，数据库连接写在全局变量里，一个函数干着五件事。想加个新功能？对不起，你得先读懂两千行没有注释的代码。想改个逻辑？改完这，那边可能就又炸了。

更头疼的是，这种老系统往往跑在一个已经很少人维护的环境上，比如XP系统，或者某个特定版本的Delphi。每次要发版，都得小心翼翼地祈祷别把哪个老功能改坏。开发效率低到让人怀疑人生——本来十分钟能搞定的事，因为要绕开一堆历史包袱，变成了一天的工作量。

1.2 不是重写，而是"微创手术"

很多团队面对这种情况，第一反应就是"推倒重来"。但说实话，推倒重来就像给病人做开胸手术——风险大、恢复慢、还可能留下后遗症。老系统里往往藏着很多业务细节和特殊逻辑，这些"知识"只存在于代码和老员工的脑子里。全部重写，很可能把一些关键业务规则给"翻译"丢了。

更务实的做法是做"微创手术"：在不推翻整体架构的前提下，一层一层地把代码拆解开，把该分离的分离，把该封装的封装，让新代码和老代码能和平共处。就像给房子做装修，不是拆了重建，而是把旧电线换了、旧水管换了，但墙和梁还留着。这样既保住了老系统的稳定性，又能让新功能开发变得顺畅。

二、先给老项目做个"全面体检"

2.1 摸清代码家底

在动手改之前，第一步是把家底摸清楚。你需要知道这个老项目一共有多少个单元文件、每个文件大概做什么、文件之间的依赖关系是怎样的。有些老项目的目录结构混乱，几十个文件堆在一个文件夹里，名字还叫"Unit1.pas"、"Unit2.pas"，根本看不出用途。

一个实用的办法是先画一张简单的模块关系图，不用太专业，手绘都行。把每个主要模块的功能写下来，再画箭头表示调用关系。比如你发现"frmMain.pas"里既画了界面又写了数据库操作，还处理了业务逻辑，那这个文件就是典型的"大杂烩"，是后续重构的重点对象。

{
  ============================================================
  项目依赖检查脚本（辅助工具，非项目核心代码）
  用途：扫描Pascal项目中的uses依赖关系
  技术栈：Pascal (Free Pascal 兼容)
  ============================================================
}
program DependencyChecker;
uses
  SysUtils, Classes,{$IFDEF UNIX}cthreads{$ELSE}Windows{$ENDIF};

{
  函数说明：分析单元文件间的依赖关系
  参数：FileName - 目标文件路径
  返回值：无，结果直接输出到屏幕
}
procedure AnalyzeDependencies(const FileName: string);
var
  F: TextFile;
  Line: string;
  Lines: TStringList;
  UsesSection: boolean;
  UnitName: string;
begin
  Lines := TStringList.Create;
  try
    { 打开文件并逐行读取 }
    Assign(F, FileName);
    {$I-}
    Reset(F);
    {$I+}
    
    if IOResult <> 0 then
    begin
      writeln('无法打开文件: ', FileName);
      exit;
    end;
    
    UsesSection := false;
    UnitName := '';
    
    { 逐行扫描文件内容 }
    while not EOF(F) do
    begin
      ReadLn(F, Line);
      Lines.Add(Line);
      
      { 检查是否进入uses区域 }
      if Pos('uses', LowerCase(Line)) > 0 then
        UsesSection := true;
      
      { 检测procedure/function开始，uses区域结束 }
      if (Pos('procedure', LowerCase(Line)) > 0) or
         (Pos('function', LowerCase(Line)) > 0) then
        UsesSection := false;
    end;
    
    Close(F);
    
    writeln('========== 文件: ', FileName, ' ==========');
    
    { 输出uses区域中引用的模块 }
    if UsesSection then
    begin
      writeln('  依赖的模块:');
      for Line in Lines do
      begin
        if Pos('uses', LowerCase(Line)) > 0 then
        then
          break;
      end;
    end;
    
  finally
    Lines.Free;
  end;
end;

begin
  { 对指定文件进行依赖分析 }
  if ParamCount < 1 then
  begin
    writeln('用法: DependencyChecker <文件路径>');
    exit;
  end;
  
  AnalyzeDependencies(ParamStr(1));
  
  writeln;
  writeln('依赖分析完成。');
end.

2.2 找出性能瓶颈和依赖关系

体检的第二个重点是找性能瓶颈。老Pascal项目常见的问题包括：在循环里做数据库查询、大量使用全局变量、字符串拼接没有用缓冲区等。这些问题不一定会让系统立刻崩掉，但会让系统越跑越慢，到最后用户忍不了就开始抱怨。

还有一种隐蔽的依赖问题需要注意：有些老代码会把数据库连接字符串写死在代码里，或者把配置信息分散在好几个地方。这意味着如果你想把项目部署到测试环境或者生产环境，每次都要手动改代码。这种"硬编码"是重构时必须解决的老大难问题。

三、分层重构：把大坨代码拆成小块

3.1 数据层分离

老Pascal项目最大的毛病之一就是数据操作和业务逻辑混在一起。一个按钮的点击事件里，直接连着SQL语句，连完了又把结果填到界面上，整个过程一气呵成、毫无章法。

重构的第一步就是把数据库操作独立出来，形成一个专门的"数据访问层"。这个层只负责和数据库打交道，不关心界面上长什么样，也不关心业务规则是什么。这样一来，将来如果数据库换了，你只需要改数据层，其他地方不用动。

{
  ============================================================
  数据访问层 - 用户数据操作模块
  技术栈：Pascal (Free Pascal / Delphi 兼容)
  说明：将所有数据库操作集中在此模块，实现数据层分离
  ============================================================
}
unit UserDAL;

interface

uses
  SysUtils, Classes;

{
  类型定义：用户记录
  把数据库表结构映射为Pascal记录类型
}
type
  TUserInfo = record
    UserID: Integer;        { 用户ID，主键 }
    UserName: string;       { 用户名 }
    Email: string;          { 邮箱地址 }
    IsActive: boolean;      { 是否激活状态 }
  end;

{
  类型定义：用户数据访问接口
  通过接口定义数据操作契约，方便测试和替换实现
}
 IUserRepository = interface
  ['{A1B2C3D4-E5F6-7890-ABCD-EF1234567890}']
  function GetUsers: TList;
  procedure SaveUser(const AUserInfo: TUserInfo);
  function FindUserById(AUserId: Integer): TUserInfo;
  procedure DeleteUser(AUserId: Integer);
end;

{
  类定义：用户数据访问实现
  实现IUserRepository接口的具体数据库操作逻辑
}
TUserRepository = class(TInterfacedObject, IUserRepository)
private
  FConnectionString: string;
  {
    私有方法：创建数据库连接
    封装连接逻辑，避免连接代码散落在各处
  }
  function CreateConnection: TObject;
  procedure ExecuteQuery(const ASQL: string);
public
  constructor Create(const AConnectionString: string);
  destructor Destroy; override;
  
  function GetUsers: TList;
  procedure SaveUser(const AUserInfo: TUserInfo);
  function FindUserById(AUserId: Integer): TUserInfo;
  procedure DeleteUser(AUserId: Integer);
end;

implementation

{
  构造函数：初始化数据访问对象
  参数：AConnectionString - 数据库连接字符串
}
constructor TUserRepository.Create(const AConnectionString: string);
begin
  inherited Create;
  FConnectionString := AConnectionString;
end;

{
  析构函数：清理资源
}
destructor TUserRepository.Destroy;
begin
  inherited Destroy;
end;

{
  创建数据库连接
  集中管理连接逻辑，便于将来替换数据库驱动
}
function TUserRepository.CreateConnection: TObject;
begin
  {
    注意：此处为示例框架，实际使用时需要引入具体的数据库组件
    比如TADOConnection、TSQLConnection等
    这里用TObject代替以避免依赖特定组件
  }
  Result := TObject.Create;
  { 在实际项目中，这里会执行：
    FConn := TADOConnection.Create(nil);
    FConn.ConnectionString := FConnectionString;
    FConn.Connected := True;
  }
end;

{
  执行SQL查询
  所有SQL语句都通过这个统一方法执行
}
procedure TUserRepository.ExecuteQuery(const ASQL: string);
var
  Conn: TObject;
begin
  Conn := CreateConnection;
  try
    { 实际执行SQL逻辑 }
    { 示例：使用TADOQuery执行查询 }
    { Query.SQL.Text := ASQL; }
    { Query.Open; }
  finally
    Conn.Free;
  end;
end;

{
  获取所有用户列表
  返回TList，每个元素是一个TUserInfo指针
}
function TUserRepository.GetUsers: TList;
var
  Conn: TObject;
  User: TUserInfo;
begin
  Result := TList.Create;
  try
    ExecuteQuery('SELECT UserID, UserName, Email, IsActive FROM Users');
    
    { 在实际项目中，这里会遍历查询结果集 }
    { 示例伪代码：
    while not Query.Eof do
    begin
      User.UserID := Query.Fields['UserID'].AsInteger;
      User.UserName := Query.Fields['UserName'].AsString;
      User.Email := Query.Fields['Email'].AsString;
      User.IsActive := Query.Fields['IsActive'].AsBoolean;
      Result.Add(User);
      Query.Next;
    end;
    }
  except
    on E: Exception do
      writeln('获取用户列表失败: ', E.Message);
  end;
end;

{
  保存用户信息
  处理新增或更新用户的逻辑
}
procedure TUserRepository.SaveUser(const AUserInfo: TUserInfo);
var
  User: TUserInfo;
begin
  User := AUserInfo;
  
  if AUserInfo.UserID = 0 then
  begin
    { 新增用户 }
    ExecuteQuery(Format(
      'INSERT INTO Users (UserName, Email, IsActive) VALUES (''%s'', ''%s'', %d)',
      [AUserInfo.UserName, AUserInfo.Email, Ord(AUserInfo.IsActive)]));
  end
  else
  begin
    { 更新现有用户 }
    ExecuteQuery(Format(
      'UPDATE Users SET UserName = ''%s'', Email = ''%s'', IsActive = %d WHERE UserID = %d',
      [AUserInfo.UserName, AUserInfo.Email, Ord(AUserInfo.IsActive), AUserInfo.UserID]));
  end;
end;

{
  根据ID查找单个用户
  返回TUserInfo记录
}
function TUserRepository.FindUserById(AUserId: Integer): TUserInfo;
begin
  Result := Default(TUserInfo);
  ExecuteQuery(Format('SELECT * FROM Users WHERE UserID = %d', [AUserId]));
  
  { 在实际项目中，这里会从结果集中读取用户信息 }
  { 示例伪代码：
  if not Query.Eof then
  begin
    Result.UserID := Query.Fields['UserID'].AsInteger;
    Result.UserName := Query.Fields['UserName'].AsString;
    Result.Email := Query.Fields['Email'].AsString;
    Result.IsActive := Query.Fields['IsActive'].AsBoolean;
  end;
  }
end;

{
  删除用户
  通过ID删除指定用户记录
}
procedure TUserRepository.DeleteUser(AUserId: Integer);
begin
  ExecuteQuery(Format('DELETE FROM Users WHERE UserID = %d', [AUserId]));
end;

end.

3.2 业务逻辑层提取

数据层分出来了，下一步是提取业务逻辑层。业务逻辑层是"大脑"，它不关心数据从哪里来（可能是数据库，也可能是文件），也不关心怎么展示（可能是Windows界面，也可能是Web页面）。它只关心"应该做什么"：比如校验用户名是否合法、计算用户的权限、处理订单流程。

{
  ============================================================
  业务逻辑层 - 用户管理服务
  技术栈：Pascal (Free Pascal / Delphi 兼容)
  说明：封装业务规则，不直接操作数据库，不直接操作界面
  ============================================================
}
unit UserService;

interface

uses
  Classes, UserDAL;

{
  类定义：用户业务服务
  负责协调数据层，执行业务规则
  不直接访问数据库，通过IUserRepository接口操作
}
TUserService = class
private
  FRepository: IUserRepository;
  {
    私有方法：校验用户数据是否合法
    参数：AUserInfo - 待校验的用户信息
    返回值：校验是否通过
  }
  function ValidateUser(const AUserInfo: TUserInfo): boolean;
public
  constructor Create(ARepository: IUserRepository);
  
  {
    注册新用户
    包含：校验、生成ID、保存到数据库
  }
  function RegisterUser(const AUserName, AEmail: string): boolean;
  
  {
    激活用户账户
    参数：AUserId - 用户ID
    返回值：操作是否成功
  }
  function ActivateUser(AUserId: Integer): boolean;
  
  {
    锁定用户账户
    当用户多次输错密码时调用
    参数：AUserId - 用户ID，AFailCount - 失败次数
  }
  procedure LockUser(AUserId, AFailCount: Integer);
end;

implementation

{
  构造函数：注入数据访问层依赖
  使用依赖注入模式，方便测试
}
constructor TUserService.Create(ARepository: IUserRepository);
begin
  inherited Create;
  FRepository := ARepository;
end;

{
  校验用户数据合法性
  检查：用户名不为空、邮箱格式正确、用户名长度合规
}
function TUserService.ValidateUser(const AUserInfo: TUserInfo): boolean;
var
  AtPos: Integer;
begin
  Result := True;
  
  { 检查用户名是否为空或过短 }
  if Length(AUserInfo.UserName) < 3 then
  begin
    Result := False;
    exit;
  end;
  
  { 检查邮箱格式：必须包含@符号 }
  AtPos := Pos('@', AUserInfo.Email);
  if (AtPos = 0) or (AtPos = Length(AUserInfo.Email)) then
  begin
    Result := False;
    exit;
  end;
  
  { 检查用户名是否包含非法字符 }
  { 注意：此处仅做简单示例，实际项目需要更严格的校验 }
end;

{
  注册新用户
  业务流程：
  1. 校验输入数据
  2. 检查用户名是否已存在
  3. 生成新用户记录
  4. 调用数据层保存
  5. 返回结果
}
function TUserService.RegisterUser(const AUserName, AEmail: string): boolean;
var
  NewUser: TUserInfo;
begin
  { 第一步：校验输入数据 }
  NewUser.UserName := AUserName;
  NewUser.Email := AEmail;
  NewUser.IsActive := True;
  NewUser.UserID := 0;  { 新增用户，ID由数据库生成 }
  
  if not ValidateUser(NewUser) then
  begin
    Result := False;
    writeln('注册失败：用户数据校验不通过');
    exit;
  end;
  
  { 第二步：检查用户名是否已存在 }
  { 在实际项目中，这里需要调用FRepository查询 }
  { 示例：遍历GetUsers检查是否有同名用户 }
  
  { 第三步：保存新用户 }
  FRepository.SaveUser(NewUser);
  
  Result := True;
  writeln('用户注册成功: ', AUserName);
end;

{
  激活用户账户
  业务流程：
  1. 查找用户是否存在
  2. 检查是否已激活
  3. 更新激活状态
}
function TUserService.ActivateUser(AUserId: Integer): boolean;
var
  User: TUserInfo;
begin
  Result := False;
  
  { 查找用户 }
  User := FRepository.FindUserById(AUserId);
  
  if User.UserID = 0 then
  begin
    writeln('激活失败：用户不存在');
    exit;
  end;
  
  if User.IsActive then
  begin
    writeln('激活失败：用户已激活');
    exit;
  end;
  
  { 更新激活状态 }
  User.IsActive := True;
  FRepository.SaveUser(User);
  
  Result := True;
  writeln('用户激活成功: ', User.UserName);
end;

{
  锁定用户账户
  业务流程：
  1. 判断失败次数是否达到阈值
  2. 达到阈值则禁用账户
}
procedure TUserService.LockUser(AUserId, AFailCount: Integer);
const
  MaxFailAttempts = 5;  { 最大允许失败次数 }
var
  User: TUserInfo;
begin
  if AFailCount < MaxFailAttempts then
  begin
    writeln(Format('用户还有 %d 次尝试机会', [MaxFailAttempts - AFailCount]));
    exit;
  end;
  
  { 达到最大失败次数，锁定账户 }
  User := FRepository.FindUserById(AUserId);
  if User.UserID > 0 then
  begin
    User.IsActive := False;
    FRepository.SaveUser(User);
    writeln('用户账户已锁定: ', User.UserName);
  end;
end;

end.

3.3 界面层适配

最后一个层是界面层。重构后的界面层应该变得很"薄"，它只负责显示数据、接收用户输入，然后把输入交给业务逻辑层处理，把返回结果显示出来。它不再直接写SQL，不再直接做业务判断。

{
  ============================================================
  界面层 - 用户管理表单
  技术栈：Pascal (Free Pascal / Delphi 兼容)
  说明：界面层保持"薄"，只负责展示和输入，不写业务逻辑
  ============================================================
}
unit UserForm;

interface

uses
  Classes, Forms, Controls, StdCtrls, UserDAL, UserService;

{
  类定义：用户管理表单
  界面层的核心职责：
  1. 提供输入控件
  2. 调用业务服务
  3. 显示处理结果
}
TUserForm = class(TForm)
private
  FUserService: TUserService;
  { 私有方法：初始化业务服务 }
  procedure InitService;
public
  constructor Create; override;
  
  { 公共方法：处理用户注册按钮点击 }
  procedure DoRegister;
  
  { 公共方法：刷新用户列表 }
  procedure RefreshUserList;
end;

var
  UserForm: TUserForm;

implementation

uses
  SysUtils;

constructor TUserForm.Create;
begin
  inherited Create;
  { 初始化表单基础属性 }
  Caption := '用户管理系统';
  Width := 600;
  Height := 400;
  
  { 初始化业务服务 }
  InitService;
end;

{
  初始化业务服务
  创建数据访问层实例，注入到业务层
}
procedure TUserForm.InitService;
var
  Repository: IUserRepository;
begin
  { 创建数据访问层实例 }
  Repository := TUserRepository.Create('Server=localhost;Database=MyDB');
  
  { 将数据访问层注入到业务服务 }
  FUserService := TUserService.Create(Repository);
  
  {
    注意：这里使用依赖注入模式
    好处：
    1. 业务层不依赖具体的数据库实现
    2. 方便单元测试时替换为Mock对象
    3. 切换数据库时只需改数据访问层
  }
end;

{
  处理用户注册
  流程：
  1. 从输入控件获取数据
  2. 调用业务服务处理
  3. 显示处理结果
}
procedure TUserForm.DoRegister;
var
  UserName, Email: string;
  Success: boolean;
begin
  { 第一步：获取用户输入 }
  { 在实际项目中，这些值从Edit控件获取 }
  { UserName := Edit1.Text; }
  { Email := Edit2.Text; }
  
  { 第二步：调用业务服务 }
  Success := FUserService.RegisterUser(UserName, Email);
  
  { 第三步：显示结果 }
  if Success then
    writeln('注册成功！')
  else
    writeln('注册失败，请检查输入信息');
end;

{
  刷新用户列表
  调用业务服务获取数据，填充到列表控件
}
procedure TUserForm.RefreshUserList;
var
  Users: TList;
  i: Integer;
  User: PUserInfo;
begin
  { 获取用户列表 }
  { 在实际项目中，这里应该通过UserService或Repository获取 }
  { 界面层不应该直接操作数据访问层 }
end;

end.

四、用现代设计模式"包"一层

4.1 单例模式改造

老Pascal项目里到处都是全局变量。比如一个全局的数据库连接对象、一个全局的配置对象。这些全局变量让代码变得难以测试，也难以在多线程环境下使用。

单例模式可以让全局变量变得"有控制"。你不再直接在代码里创建对象，而是通过单例方法获取。这样对象的生命周期变得可控，也能在程序退出时正确释放。

{
  ============================================================
  单例模式 - 全局配置管理器
  技术栈：Pascal (Free Pascal / Delphi 兼容)
  说明：用单例模式替代散乱的全局变量
  ============================================================
}
unit ConfigManager;

interface

{
  类定义：配置管理器（单例）
  用途：统一管理所有配置项，替代散落各处的全局变量
  特点：
  1. 全局只有一个实例
  2. 通过GetInstance方法获取
  3. 支持从文件加载配置
  4. 线程安全
}
TConfigManager = class
private
  class var
    FInstance: TConfigManager;  { 单例实例 }
    
  FAppTitle: string;            { 应用标题 }
  FDBHost: string;              { 数据库主机 }
  FDBPort: Integer;             { 数据库端口 }
  FDBName: string;              { 数据库名称 }
  FLogLevel: string;            { 日志级别 }
  
  {
    私有构造函数
    防止外部直接创建实例
  }
  constructor Create;
public
  class function GetInstance: TConfigManager;
  destructor Destroy; override;
  
  { 公共属性 }
  property AppTitle: string read FAppTitle write FAppTitle;
  property DBHost: string read FDBHost write FDBHost;
  property DBPort: Integer read FDBPort write FDBPort;
  property DBName: string read FDBName write FDBName;
  property LogLevel: string read FLogLevel write FLogLevel;
  
  { 从配置文件加载 }
  procedure LoadFromFile(const AFilePath: string);
  
  { 生成数据库连接字符串 }
  function GetConnectionStr: string;
end;

implementation

uses
  SysUtils;

{
  私有构造函数：初始化默认配置值
  构造函数设为private，确保只能通过GetInstance创建
}
constructor TConfigManager.Create;
begin
  inherited Create;
  { 设置默认值 }
  FAppTitle := '我的应用';
  FDBHost := 'localhost';
  FDBPort := 5432;
  FDBName := 'default_db';
  FLogLevel := 'INFO';
end;

{
  获取单例实例
  如果实例不存在则创建
  如果实例已存在则直接返回
}
class function TConfigManager.GetInstance: TConfigManager;
begin
  if FInstance = nil then
  begin
    FInstance := TConfigManager.Create;
    writeln('[Config] 配置管理器已初始化');
  end;
  Result := FInstance;
end;

{
  析构函数：清理资源
}
destructor TConfigManager.Destroy;
begin
  FInstance := nil;
  inherited Destroy;
end;

{
  从配置文件加载配置
  支持从文本文件读取键值对配置
}
procedure TConfigManager.LoadFromFile(const AFilePath: string);
var
  F: TextFile;
  Line, Key, Value: string;
  Pos: Integer;
begin
  Assign(F, AFilePath);
  {$I-}
  Reset(F);
  {$I+}
  
  if IOResult <> 0 then
  begin
    writeln('[Config] 无法打开配置文件: ', AFilePath);
    exit;
  end;
  
  { 逐行读取配置文件 }
  while not EOF(F) do
  begin
    ReadLn(F, Line);
    
    { 跳过空行和注释行 }
    if (Length(Line) = 0) or (Line[1] = '#') then
      continue;
    
    { 解析键值对，格式：Key=Value }
    Pos := Pos('=', Line);
    if Pos = 0 then continue;
    
    Key := Trim(Copy(Line, 1, Pos - 1));
    Value := Trim(Copy(Line, Pos + 1, Length(Line)));
    
    { 根据键名设置对应的属性 }
    if LowerCase(Key) = 'app_title' then
      FAppTitle := Value
    else if LowerCase(Key) = 'db_host' then
      FDBHost := Value
    else if LowerCase(Key) = 'db_port' then
      FDBPort := StrToIntDef(Value, 5432)
    else if LowerCase(Key) = 'db_name' then
      FDBName := Value
    else if LowerCase(Key) = 'log_level' then
      FLogLevel := Value;
  end;
  
  Close(F);
  writeln('[Config] 配置加载完成');
end;

{
  生成数据库连接字符串
  将分散的配置项组合成完整的连接字符串
}
function TConfigManager.GetConnectionStr: string;
begin
  Result := Format('Server=%s;Port=%d;Database=%s',
    [FDBHost, FDBPort, FDBName]);
end;

end.

4.2 观察者模式接入

老代码里经常出现一个现象：数据变了，界面不更新；界面更新了，业务状态不知道。这种"通知"问题在老代码里往往用全局变量或者反复查询数据库来解决，效率低还容易出错。

观察者模式就是为了解决这类问题的。一个对象变了，所有关注它的对象都会收到通知。比如用户列表更新了，所有显示用户列表的地方都会自动刷新。

{
  ============================================================
  观察者模式 - 数据变更通知系统
  技术栈：Pascal (Free Pascal / Delphi 兼容)
  说明：当数据发生变更时，自动通知所有关注方
  ============================================================
}
unit DataChangeNotifier;

interface

uses
  Classes;

{
  类型定义：观察者接口
  任何想要接收数据变更通知的对象都实现这个接口
}
IDataObserver = interface
  ['{B2C3D4E5-F6A7-8901-BCDE-F12345678901}']
  {
    数据变更回调方法
    参数：ASender - 变更来源，AChangeType - 变更类型
  }
  procedure OnDataChanged(ASender: TObject; AChangeType: string);
end;

{
  类型定义：主题类（被观察者）
  负责管理观察者列表，触发通知
}
TDataSubject = class
protected
  FObservers: TList;  { 观察者列表 }
  
  {
    受保护方法：添加观察者
  }
  procedure Attach(AObserver: IDataObserver);
  
  {
    受保护方法：移除观察者
  }
  procedure Detach(AObserver: IDataObserver);
  
  {
    受保护方法：通知所有观察者
  }
  procedure Notify(ASender: TObject; AChangeType: string);
public
  constructor Create;
  destructor Destroy; override;
end;

implementation

constructor TDataSubject.Create;
begin
  inherited Create;
  FObservers := TList.Create;
end;

destructor TDataSubject.Destroy;
begin
  FObservers.Free;
  inherited Destroy;
end;

{
  添加观察者
  将观察者添加到通知列表中
}
procedure TDataSubject.Attach(AObserver: IDataObserver);
begin
  FObservers.Add(Pointer(AObserver));
end;

{
  移除观察者
  从通知列表中删除指定观察者
}
procedure TDataSubject.Detach(AObserver: IDataObserver);
var
  i: Integer;
begin
  for i := FObservers.Count - 1 downto 0 do
  begin
    if Pointer(FObservers[i]) = Pointer(AObserver) then
    begin
      FObservers.Delete(i);
      break;
    end;
  end;
end;

{
  通知所有观察者
  遍历列表，逐个调用OnDataChanged方法
}
procedure TDataSubject.Notify(ASender: TObject; AChangeType: string);
var
  i: Integer;
  Observer: IDataObserver;
begin
  for i := 0 to FObservers.Count - 1 do
  begin
    Observer := IDataObserver(FObservers[i]);
    Observer.OnDataChanged(ASender, AChangeType);
  end;
end;

end.

五、让老代码"说新话"：接口封装与适配

5.1 封装遗留接口

很多老Pascal项目依赖一些已经很少人维护的组件或DLL。比如某个老版本的数据库驱动、某个特定的硬件通信库。这些遗留依赖不能直接替换，但你可以用一个新接口把它们"包"起来，让外部代码只跟新接口打交道，不直接依赖老组件。

{
  ============================================================
  适配层 - 遗留数据库接口封装
  技术栈：Pascal (Free Pascal / Delphi 兼容)
  说明：将老版数据库操作封装到新接口后面
  ============================================================
}
unit LegacyDBAdapter;

interface

uses
  Classes;

{
  类型定义：新数据库接口
  定义现代项目需要的数据库操作契约
  这个接口是"新语言"，外部代码只跟它打交道
}
IModernDBInterface = interface
  ['{C3D4E5F6-A7B8-9012-CDEF-123456789012}']
  procedure Connect;
  procedure Disconnect;
  function ExecuteSQL(const ASQL: string): boolean;
  function QuerySQL(const ASQL: string): TList;
  function GetRowCount: Integer;
end;

{
  类定义：遗留数据库适配器
  实现IModernDBInterface接口
  内部调用老版本的数据库组件
  起到"翻译官"的作用
}
TLegacyDBAdapter = class(TInterfacedObject, IModernDBInterface)
private
  FConnected: boolean;
  FLegacyConn: TObject;  { 老版本数据库连接对象 }
  
  {
    私有方法：初始化老版数据库连接
    封装老版API的初始化逻辑
  }
  procedure InitLegacyConnection;
  
  {
    私有方法：将老版结果集转换为新格式
    桥接老数据结构和现代数据结构
  }
  function ConvertResultSet(ALegacyData: TObject): TList;
public
  constructor Create;
  destructor Destroy; override;
  
  procedure Connect;
  procedure Disconnect;
  function ExecuteSQL(const ASQL: string): boolean;
  function QuerySQL(const ASQL: string): TList;
  function GetRowCount: Integer;
end;

implementation

constructor TLegacyDBAdapter.Create;
begin
  inherited Create;
  FConnected := False;
  FLegacyConn := nil;
end;

destructor TLegacyDBAdapter.Destroy;
begin
  if FConnected then Disconnect;
  inherited Destroy;
end;

{
  初始化老版数据库连接
  这里调用老版API，将初始化逻辑封装在此
  外部代码不需要知道老版API的细节
}
procedure TLegacyDBAdapter.InitLegacyConnection;
begin
  {
    示例：老版数据库驱动初始化
    { FLegacyConn := TOldDBConnection.Create(nil); }
    { FLegacyConn.HostName := 'localhost'; }
    { FLegacyConn.Database := 'legacy_db'; }
    { FLegacyConn.Open; }
    
    注意：实际的初始化代码取决于你使用的老版组件
    这里用注释代替以避免依赖特定组件
  }
  FConnected := True;
end;

{
  建立连接
  调用老版连接逻辑
}
procedure TLegacyDBAdapter.Connect;
begin
  if FConnected then exit;
  InitLegacyConnection;
end;

{
  断开连接
  调用老版断开逻辑
}
procedure TLegacyDBAdapter.Disconnect;
begin
  if not FConnected then exit;
  
  {
    示例：老版数据库断开
    { FLegacyConn.Close; }
    { FLegacyConn.Free; }
  }
  
  FConnected := False;
  FLegacyConn := nil;
end;

{
  执行SQL语句（非查询语句）
  将现代接口调用转换为老版API调用
}
function TLegacyDBAdapter.ExecuteSQL(const ASQL: string): boolean;
begin
  Result := False;
  if not FConnected then
  begin
    writeln('[LegacyDB] 数据库未连接');
    exit;
  end;
  
  {
    示例：调用老版执行方法
    { FLegacyConn.ExecSQL(ASQL); }
    Result := True;
  }
  
  Result := True;
end;

{
  执行查询SQL并返回结果列表
  将老版结果集转换为标准TList格式
}
function TLegacyDBAdapter.QuerySQL(const ASQL: string): TList;
begin
  Result := TList.Create;
  if not FConnected then
  begin
    writeln('[LegacyDB] 数据库未连接');
    exit;
  end;
  
  {
    示例：调用老版查询方法并转换结果
    { FLegacyConn.OpenSQL(ASQL); }
    { Result := ConvertResultSet(FLegacyConn.ResultSet); }
    
    实际转换逻辑取决于老版组件返回的数据结构
  }
end;

{
  获取上一次查询的结果行数
}
function TLegacyDBAdapter.GetRowCount: Integer;
begin
  Result := 0;
  {
    示例：从老版组件获取行数
    { Result := FLegacyConn.RecordCount; }
  }
end;

{
  将老版结果集转换为现代列表格式
  这是适配层的核心工作之一
}
function TLegacyDBAdapter.ConvertResultSet(ALegacyData: TObject): TList;
var
  i: Integer;
begin
  Result := TList.Create;
  
  {
    遍历老版结果集，逐行转换为现代数据结构
    具体转换逻辑取决于老版组件的API
  }
  
  { 示例：
  for i := 0 to ALegacyData.RecordCount - 1 do
  begin
    RowData := CreateModernRecord(ALegacyData.FieldNames, ALegacyData);
    Result.Add(RowData);
    ALegacyData.MoveNext;
  end;
  }
end;

end.

5.2 桥接模式适配新框架

有些老Pascal项目需要接入新的UI框架，比如从传统的Windows Forms切换到跨平台的Lazarus。桥接模式可以让"实现"和"抽象"分离，你不需要改老代码就能接入新框架。

{
  ============================================================
  桥接模式 - UI框架适配层
  技术栈：Pascal (Free Pascal / Delphi 兼容)
  说明：分离业务逻辑和UI框架实现，支持切换不同UI框架
  ============================================================
}
unit UIBridge;

interface

uses
  Classes;

{
  类型定义：UI实现接口
  定义UI框架需要提供的操作
}
IUIImplementation = interface
  ['{D4E5F6A7-B8C9-0123-DEF1-234567890123}']
  procedure ShowMessage(const AText: string);
  procedure ShowDialog(ACaption: string);
  function GetInput(const APrompt: string): string;
  procedure ShowProgress(ATitle: string; AMaxValue: Integer);
  procedure UpdateProgress(AValue: Integer);
  procedure CloseProgress;
end;

{
  类型定义：UI抽象基类
  业务代码通过这个类操作UI，不直接依赖具体UI框架
}
TUIAbstract = class
protected
  FImpl: IUIImplementation;
public
  constructor Create(AImpl: IUIImplementation);
  
  procedure DisplayInfo(const AText: string);
  procedure ShowInputDialog;
  procedure ShowProgressBar(ATitle: string; ASteps: Integer);
end;

{
  类定义：Delphi UI实现
  实现IUIImplementation，使用Delphi原生API
}
TDelphiUIImpl = class(TInterfacedObject, IUIImplementation)
public
  procedure ShowMessage(const AText: string);
  procedure ShowDialog(ACaption: string);
  function GetInput(const APrompt: string): string;
  procedure ShowProgress(ATitle: string; AMaxValue: Integer);
  procedure UpdateProgress(AValue: Integer);
  procedure CloseProgress;
end;

{
  类定义：Lazarus UI实现
  实现IUIImplementation，使用Lazarus跨平台API
}
TLazarusUIImpl = class(TInterfacedObject, IUIImplementation)
public
  procedure ShowMessage(const AText: string);
  procedure ShowDialog(ACaption: string);
  function GetInput(const APrompt: string): string;
  procedure ShowProgress(ATitle: string; AMaxValue: Integer);
  procedure UpdateProgress(AValue: Integer);
  procedure CloseProgress;
end;

implementation

{
  UI抽象基类实现
  业务代码使用这个类，不关心底层是Delphi还是Lazarus
}

constructor TUIAbstract.Create(AImpl: IUIImplementation);
begin
  inherited Create;
  FImpl := AImpl;
end;

{
  显示信息消息
  委托给具体的UI实现执行
}
procedure TUIAbstract.DisplayInfo(const AText: string);
begin
  FImpl.ShowMessage(AText);
end;

{
  显示输入对话框
  委托给具体的UI实现
}
procedure TUIAbstract.ShowInputDialog;
var
  Input: string;
begin
  Input := FImpl.GetInput('请输入数据:');
  writeln('用户输入: ', Input);
end;

{
  显示进度条
  委托给具体的UI实现
}
procedure TUIAbstract.ShowProgressBar(ATitle: string; ASteps: Integer);
var
  i: Integer;
begin
  FImpl.ShowProgress(ATitle, ASteps);
  for i := 1 to ASteps do
  begin
    { 模拟工作 }
    Sleep(100);
    FImpl.UpdateProgress(i);
  end;
  FImpl.CloseProgress;
end;

{
  Delphi UI实现
  使用Delphi原生的MessageDlg等API
}

procedure TDelphiUIImpl.ShowMessage(const AText: string);
begin
  { 示例：Delphi原生消息框 }
  { Application.MessageBox(PChar(AText), '提示', 0); }
  writeln('[Delphi UI] ', AText);
end;

procedure TDelphiUIImpl.ShowDialog(ACaption: string);
begin
  { 示例：打开Delphi原生对话框 }
  writeln('[Delphi UI] 打开对话框: ', ACaption);
end;

function TDelphiUIImpl.GetInput(const APrompt: string): string;
begin
  { 示例：Delphi输入对话框 }
  Result := '';
  writeln('[Delphi UI] ', APrompt);
  { 实际实现中会显示输入框并返回用户输入 }
end;

procedure TDelphiUIImpl.ShowProgress(ATitle: string; AMaxValue: Integer);
begin
  writeln('[Delphi UI] 进度条: ', ATitle, ' (共', AMaxValue, '步)');
end;

procedure TDelphiUIImpl.UpdateProgress(AValue: Integer);
begin
  { 示例：更新Delphi进度条 }
  writeln('[Delphi UI] 进度: ', AValue);
end;

procedure TDelphiUIImpl.CloseProgress;
begin
  writeln('[Delphi UI] 进度条已关闭');
end;

{
  Lazarus UI实现
  使用Lazarus的LCL跨平台API
}

procedure TLazarusUIImpl.ShowMessage(const AText: string);
begin
  { 示例：Lazarus的ShowMessage函数 }
  { LMessageDlg(AText, mtInformation, [mbOK], 0); }
  writeln('[Lazarus UI] ', AText);
end;

procedure TLazarusUIImpl.ShowDialog(ACaption: string);
begin
  { 示例：打开Lazarus对话框 }
  writeln('[Lazarus UI] 打开对话框: ', ACaption);
end;

function TLazarusUIImpl.GetInput(const APrompt: string): string;
begin
  { 示例：Lazarus输入对话框 }
  { Result := InputQuery(APrompt, '请输入:', ''); }
  Result := '';
  writeln('[Lazarus UI] ', APrompt);
end;

procedure TLazarusUIImpl.ShowProgress(ATitle: string; AMaxValue: Integer);
begin
  writeln('[Lazarus UI] 进度条: ', ATitle, ' (共', AMaxValue, '步)');
end;

procedure TLazarusUIImpl.UpdateProgress(AValue: Integer);
begin
  writeln('[Lazarus UI] 进度: ', AValue);
end;

procedure TLazarusUIImpl.CloseProgress;
begin
  writeln('[Lazarus UI] 进度条已关闭');
end;

end.

六、实战演练：一个完整重构案例

6.1 原始遗留代码

先看一个典型的遗留代码片段。这是一个用户登录模块，所有东西都堆在一个文件里：

{
  ============================================================
  【重构前】原始遗留代码 - 用户登录模块
  技术栈：Pascal (Delphi 7 时代代码风格)
  问题：全局变量、数据库操作和业务逻辑混在一起、硬编码配置
  ============================================================
}
unit LoginUnit;

interface

uses
  Windows, Messages, SysUtils, Classes,
  Controls, Forms, Dialogs, StdCtrls,
  DBAccess, Unit1, Unit2, Unit3, Unit5;  { 大量不必要的依赖 }

var
  { 全局变量：数据库连接、配置信息 }
  GlobalConn: TObject;
  GlobalDBServer: string;
  GlobalDBName: string;
  GlobalDBUser: string;
  GlobalDBPass: string;
  GlobalMaxLoginAttempts: Integer;
  GlobalCurrentAttempts: Integer;

{ 表单声明 }
TLoginForm = class(TForm)
  EditUserName: TEdit;
  EditPassword: TEdit;
  BtnLogin: TButton;
  LblError: TLabel;
  procedure BtnLoginClick(Sender: TObject);
end;

implementation

{
  登录点击事件处理
  问题：
  1. 全局变量到处是
  2. SQL直接写在事件处理里
  3. 错误处理简陋
  4. 没有参数校验
  5. 硬编码配置
}
procedure TLoginForm.BtnLoginClick(Sender: TObject);
var
  SQL: string;
  Result: TObject;
  PasswordHash: string;
  AttemptCount: Integer;
begin
  { 直接用全局变量，没有封装 }
  GlobalConn.Connected := False;
  GlobalConn.HostName := GlobalDBServer;
  GlobalConn.Database := GlobalDBName;
  GlobalConn.UserName := GlobalDBUser;
  GlobalConn.Password := GlobalDBPass;
  GlobalConn.Connected := True;
  
  { 在循环里校验，逻辑混乱 }
  if EditUserName.Text = '' then
  begin
    LblError.Caption := '用户名不能为空';
    Exit;
  end;
  
  if EditPassword.Text = '' then
  begin
    LblError.Caption := '密码不能为空';
    Exit;
  end;
  
  { SQL硬编码在事件处理里 }
  SQL := 'SELECT * FROM Users WHERE Username = ''' + EditUserName.Text + '''';
  GlobalConn.OpenSQL(SQL);
  
  if GlobalConn.EOF then
  begin
    LblError.Caption := '用户名或密码错误';
    GlobalCurrentAttempts := GlobalCurrentAttempts + 1;
    Exit;
  end;
  
  { 密码校验逻辑也在这里 }
  PasswordHash := GlobalConn.GetField('Password');
  if PasswordHash <> EditPassword.Text then
  begin
    LblError.Caption := '用户名或密码错误';
    GlobalCurrentAttempts := GlobalCurrentAttempts + 1;
    
    { 简单的锁定逻辑 }
    if GlobalCurrentAttempts >= 5 then
    begin
      SQL := 'UPDATE Users SET Active = 0 WHERE Username = ''' + EditUserName.Text + '''';
      GlobalConn.ExecSQL(SQL);
      LblError.Caption := '账户已被锁定，请联系管理员';
    end;
    Exit;
  end;
  
  { 登录成功，打开主界面 }
  LblError.Caption := '';
  Application.CreateForm(TMainForm, MainForm);
  Application.Run;
end;

end.

6.2 重构后的架构

现在我们把这段代码重构为三层结构：

{
  ============================================================
  【重构后】用户登录模块 - 完整三层架构
  技术栈：Pascal (Free Pascal / Delphi 兼容)
  架构：数据访问层 + 业务逻辑层 + 界面层 + 适配层
  ============================================================
}

{
  第一层：数据访问层
  只负责和数据库打交道
}
unit LoginDAL;

interface

uses
  Classes;

{ 登录凭证类型 }
type
  TLoginCred = record
    UserName: string;
    Password: string;
  end;

{ 登录结果类型 }
type
  TLoginResult = record
    Success: boolean;
    Message: string;
    UserID: Integer;
  end;

{ 登录数据访问接口 }
ILoginRepository = interface
  ['{E5F6A7B8-C9D0-1234-EF12-345678901234}']
  function VerifyCredentials(const ACred: TLoginCred): TLoginResult;
  procedure RecordFailedAttempt(AUserName: string);
  procedure ResetFailedAttempts(AUserName: string);
  procedure DeactivateUser(AUserName: string);
  function GetFailedAttempts(AUserName: string): Integer;
end;

{ 登录数据访问实现 }
TLoginRepository = class(TInterfacedObject, ILoginRepository)
private
  FConnectionStr: string;
  FMaxAttempts: Integer;
public
  constructor Create(const AConnectionStr: string; AMaxAttempts: Integer);
  
  function VerifyCredentials(const ACred: TLoginCred): TLoginResult;
  procedure RecordFailedAttempt(AUserName: string);
  procedure ResetFailedAttempts(AUserName: string);
  procedure DeactivateUser(AUserName: string);
  function GetFailedAttempts(AUserName: string): Integer;
end;

implementation

constructor TLoginRepository.Create(const AConnectionStr: string; AMaxAttempts: Integer);
begin
  inherited Create;
  FConnectionStr := AConnectionStr;
  FMaxAttempts := AMaxAttempts;
end;

{
  验证登录凭证
  从数据库查询用户信息，校验密码
}
function TLoginRepository.VerifyCredentials(const ACred: TLoginCred): TLoginResult;
begin
  Result.Success := False;
  Result.UserID := 0;
  Result.Message := '';
  
  {
    构建安全的SQL查询
    使用参数化查询防止SQL注入
  }
  
  {
    示例（使用参数化查询）：
    Query.SQL.Clear;
    Query.SQL.Add('SELECT UserID, Password, IsActive FROM Users');
    Query.SQL.Add('WHERE UserName = :UserName');
    Query.ParamByName('UserName').AsString := ACred.UserName;
    Query.Open;
    
    if not Query.EOF then
    begin
      if Query.Fields['IsActive'].AsBoolean then
      begin
        { 校验密码（实际应使用哈希比对） }
        if Query.Fields['Password'].AsString = ACred.Password then
        begin
          Result.Success := True;
          Result.UserID := Query.Fields['UserID'].AsInteger;
          Result.Message := '登录成功';
        end
        else
        begin
          Result.Message := '用户名或密码错误';
        end;
      end
      else
      begin
        Result.Message := '账户已被停用';
      end;
    end
    else
    begin
      Result.Message := '用户名或密码错误';
    end;
  }
end;

{
  记录失败登录次数
}
procedure TLoginRepository.RecordFailedAttempt(AUserName: string);
begin
  { 更新数据库中的失败次数计数器 }
  { 示例：
    Query.SQL.Clear;
    Query.SQL.Add('UPDATE LoginAttempts SET Count = Count + 1');
    Query.SQL.Add('WHERE UserName = :UserName');
    Query.ParamByName('UserName').AsString := AUserName;
    Query.ExecSQL;
  }
end;

{
  重置失败次数
}
procedure TLoginRepository.ResetFailedAttempts(AUserName: string);
begin
  { 示例：
    Query.SQL.Clear;
    Query.SQL.Add('UPDATE LoginAttempts SET Count = 0');
    Query.SQL.Add('WHERE UserName = :UserName');
    Query.ParamByName('UserName').AsString := AUserName;
    Query.ExecSQL;
  }
end;

{
  停用用户
}
procedure TLoginRepository.DeactivateUser(AUserName: string);
begin
  { 示例：
    Query.SQL.Clear;
    Query.SQL.Add('UPDATE Users SET IsActive = 0 WHERE UserName = :UserName');
    Query.ParamByName('UserName').AsString := AUserName;
    Query.ExecSQL;
  }
end;

{
  获取失败次数
}
function TLoginRepository.GetFailedAttempts(AUserName: string): Integer;
begin
  Result := 0;
  { 示例：
    Query.SQL.Clear;
    Query.SQL.Add('SELECT Count FROM LoginAttempts WHERE UserName = :UserName');
    Query.ParamByName('UserName').AsString := AUserName;
    Query.Open;
    if not Query.EOF then
      Result := Query.Fields['Count'].AsInteger;
  }
end;

end.

{
  第二层：业务逻辑层
  处理登录业务规则
}
unit LoginService;

interface

uses
  LoginDAL;

{ 登录业务服务 }
TLoginService = class
private
  FRepository: ILoginRepository;
  FMaxAttempts: Integer;
  
  { 私有方法：检查账户是否被锁定 }
  function IsAccountLocked(AUserName: string): boolean;
public
  constructor Create(ARepository: ILoginRepository);
  
  { 执行登录 }
  function DoLogin(const ACred: TLoginCred): TLoginResult;
  
  { 退出登录 }
  procedure DoLogout;
end;

implementation

constructor TLoginService.Create(ARepository: ILoginRepository);
begin
  inherited Create;
  FRepository := ARepository;
  FMaxAttempts := 5;  { 最大尝试次数，可从配置读取 }
end;

{
  检查账户是否被锁定
  当失败次数达到阈值时返回True
}
function TLoginService.IsAccountLocked(AUserName: string): boolean;
begin
  Result := FRepository.GetFailedAttempts(AUserName) >= FMaxAttempts;
end;

{
  执行登录
  完整业务流程：
  1. 检查账户是否被锁定
  2. 验证凭证
  3. 成功则重置失败计数
  4. 失败则记录失败次数
  5. 达到阈值则锁定账户
}
function TLoginService.DoLogin(const ACred: TLoginCred): TLoginResult;
begin
  { 第一步：检查账户是否已被锁定 }
  if IsAccountLocked(ACred.UserName) then
  begin
    Result.Success := False;
    Result.Message := '账户已被锁定，请联系管理员';
    exit;
  end;
  
  { 第二步：验证凭证 }
  Result := FRepository.VerifyCredentials(ACred);
  
  if Result.Success then
  begin
    { 第三步：登录成功，重置失败计数 }
    FRepository.ResetFailedAttempts(ACred.UserName);
    writeln('[LoginService] 登录成功: ', ACred.UserName);
  end
  else
  begin
    { 第四步：登录失败，记录失败次数 }
    FRepository.RecordFailedAttempt(ACred.UserName);
    
    { 检查是否需要锁定账户 }
    if IsAccountLocked(ACred.UserName) then
    begin
      FRepository.DeactivateUser(ACred.UserName);
      Result.Message := '账户已被锁定，请联系管理员';
    end;
    
    writeln('[LoginService] 登录失败: ', ACred.UserName);
  end;
end;

{
  退出登录
  清理会话状态
}
procedure TLoginService.DoLogout;
begin
  writeln('[LoginService] 已退出登录');
  { 在实际项目中，这里会清理会话Token、关闭数据库连接等 }
end;

end.

{
  第三层：界面层
  只负责展示和输入
}
unit LoginView;

interface

uses
  Classes, Controls, Forms, StdCtrls, Dialogs,
  LoginDAL, LoginService;

{ 登录表单 }
TLoginForm = class(TForm)
private
  FService: TLoginService;
  FRepository: ILoginRepository;
  
  { 初始化服务层 }
  procedure InitServices;
  
  { 清理资源 }
  procedure CleanupServices;
public
  constructor Create; override;
  destructor Destroy; override;
  
  { 处理登录按钮点击 }
  procedure DoLoginClick;
end;

implementation

uses
  SysUtils, ConfigManager;

{
  构造函数：初始化表单和服务
}
constructor TLoginForm.Create;
begin
  inherited Create;
  
  { 设置表单属性 }
  Caption := '系统登录';
  Width := 400;
  Height := 300;
  
  { 初始化服务层 }
  InitServices;
end;

{
  析构函数：清理资源
  确保数据库连接和资源被正确释放
}
destructor TLoginForm.Destroy;
begin
  CleanupServices;
  inherited Destroy;
end;

{
  初始化服务层
  通过依赖注入创建业务服务
}
procedure TLoginForm.InitServices;
var
  Config: TConfigManager;
  ConnStr: string;
begin
  { 获取全局配置 }
  Config := TConfigManager.GetInstance;
  Config.LoadFromFile('app_config.ini');
  
  { 从配置读取数据库连接字符串 }
  ConnStr := Config.GetConnectionStr;
  
  { 创建数据访问层 }
  FRepository := TLoginRepository.Create(ConnStr, 5);
  
  { 将数据访问层注入到业务服务 }
  FService := TLoginService.Create(FRepository);
  
  writeln('[LoginView] 服务初始化完成');
end;

{
  清理服务层资源
}
procedure TLoginForm.CleanupServices;
begin
  { 释放资源，避免内存泄漏 }
  { 注意：接口引用需要显式释放 }
  writeln('[LoginView] 资源已清理');
end;

{
  处理登录按钮点击
  流程简洁清晰：
  1. 从界面控件获取输入
  2. 调用业务服务
  3. 根据结果显示结果
}
procedure TLoginForm.DoLoginClick;
var
  Cred: TLoginCred;
  Result: TLoginResult;
begin
  { 第一步：从界面控件获取输入 }
  { 在实际项目中，这里从控件获取 }
  { Cred.UserName := EditUserName.Text; }
  { Cred.Password := EditPassword.Text; }
  
  { 第二步：调用业务服务处理登录 }
  Result := FService.DoLogin(Cred);
  
  { 第三步：根据结果显示结果 }
  if Result.Success then
  begin
    { 登录成功，打开主界面 }
    { Application.CreateForm(TMainForm, MainForm); }
    writeln('欢迎回来, ', Cred.UserName);
  end
  else
  begin
    { 登录失败，显示错误信息 }
    ShowMessage(Result.Message);
    { 在实际项目中：LblError.Caption := Result.Message; }
  end;
end;

end.

6.3 运行效果对比

重构前后的对比可以用一个简单的测试程序来展示：

{
  ============================================================
  重构效果验证程序
  技术栈：Pascal (Free Pascal / Delphi 兼容)
  说明：对比重构前后的功能一致性
  ============================================================
}
program LoginRebuildTest;

uses
  SysUtils, Classes,
  LoginDAL, LoginService, LoginView;

{
  测试函数：验证登录流程
  确认重构后功能与重构前一致
}
procedure TestLoginFlow;
var
  Repository: ILoginRepository;
  Service: TLoginService;
  Cred: TLoginCred;
  Result: TLoginResult;
  ConnStr: string;
begin
  writeln('===== 登录流程重构测试 =====');
  writeln;
  
  { 初始化数据访问层 }
  ConnStr := 'Server=localhost;Database=TestDB';
  Repository := TLoginRepository.Create(ConnStr, 5);
  
  { 初始化业务服务 }
  Service := TLoginService.Create(Repository);
  
  { 测试1：正常登录 }
  writeln('[测试1] 正常登录...');
  Cred.UserName := 'testuser';
  Cred.Password := 'correct_password';
  Result := Service.DoLogin(Cred);
  if Result.Success then
    writeln('  结果: 通过 ✓')
  else
    writeln('  结果: 失败 ✗');
  writeln;
  
  { 测试2：错误密码登录 }
  writeln('[测试2] 错误密码登录...');
  Cred.UserName := 'testuser';
  Cred.Password := 'wrong_password';
  Result := Service.DoLogin(Cred);
  if not Result.Success then
    writeln('  结果: 通过 ✓ (正确拒绝了错误密码)')
  else
    writeln('  结果: 失败 ✗ (错误密码居然通过了)');
  writeln;
  
  { 测试3：连续失败锁定 }
  writeln('[测试3] 连续失败锁定...');
  Cred.UserName := 'locktest';
  Cred.Password := 'wrong';
  for i := 1 to 6 do
  begin
    Result := Service.DoLogin(Cred);
    writeln(Format('  第%d次尝试: %s', [i, Result.Message]));
  end;
  writeln;
  
  { 测试4：空用户名 }
  writeln('[测试4] 空用户名...');
  Cred.UserName := '';
  Cred.Password := 'any';
  Result := Service.DoLogin(Cred);
  writeln('  结果: ', Result.Message);
  writeln;
  
  writeln('===== 测试完成 =====');
end;

begin
  TestLoginFlow;
  writeln;
  writeln('按任意键退出...');
  Readln;
end.

七、应用场景分析

这种分层重构的方法最适合以下几类场景。

第一类是老旧的企业管理系统。很多公司还在用十几前的Pascal写的ERP、财务系统、库存系统。这些系统跑在特定版本的Delphi或者Windows版本上，不能随便换平台。用分层重构的方式，可以先把数据库操作和业务逻辑拆出来，让后续维护变得容易，同时不影响系统当前的运行。

第二类是硬件集成类项目。很多工控系统用Pascal写，里面有大量硬件通信代码。这些硬件库往往已经停止维护，不能直接替换。用适配层把它们包起来，外面的代码就可以慢慢迁移到新的框架上。

第三类是需要跨平台迁移的项目。原来跑在Windows上的Pascal应用，现在需要适配Linux或macOS。通过桥接模式，可以在不修改业务代码的情况下切换到新的UI框架，比如Lazarus。

第四类是团队能力升级的项目。原来团队只懂Pascal，现在新来了Python或Java的开发者。分层重构可以把业务逻辑独立出来，让新语言团队通过接口调用来参与开发，不需要完全读懂Pascal。

八、技术优缺点

优点

分层重构最大的好处是风险可控。你不是在推倒重建，而是一层一层地拆，每一步都可以验证，出了问题可以回退。老系统跑得好好的，你不会突然把它搞崩。

第二是团队效率提升。重构之后，新成员接手项目不需要同时理解界面、业务和数据库。他只需要关注自己负责的那一层。改界面的人不用管SQL，改数据库的人不用管按钮长什么样。

第三是测试变得可行。老代码因为全局变量和硬编码，根本没法写单元测试。分层之后，业务逻辑层不依赖界面和数据库，可以直接在测试代码里创建实例来验证逻辑。

第四是未来迁移的灵活性。今天你用Delphi，明天想换Free Pascal或者Lazarus，业务逻辑层一行不改。今天你用MySQL，明天想换PostgreSQL，数据访问层改一下就行。

缺点

分层重构不是没有代价的。首先是时间成本，拆层需要理解老代码的结构和逻辑，这个过程本身就需要不少时间。如果项目特别大、代码特别烂，光梳理阶段就可能花上几周。

其次是学习成本。团队里的人需要理解分层架构、依赖注入、接口设计这些概念。如果团队之前一直写"大泥球"风格的代码，接受新架构需要时间。

还有一个实际问题是过渡期的复杂度。重构不是一天完成的，中间会有很长一段时间，一部分代码是老风格，一部分是新风格，两者交织在一起。这种"新旧共存"的状态可能比原来的大泥球更让人困惑。

九、注意事项

第一，不要一次改太多。重构应该小步快跑，一次只改一个模块，改完就测试，确认没问题再改下一个。不要试图一次把整个项目重构完。

第二，始终保留回退能力。每改完一个模块，确保老代码还能跑。万一新代码有问题，随时可以切回老版本。

第三，配置文件不要硬编码。在重构过程中，把所有配置项（数据库连接、文件路径、第三方服务地址等）提取到配置文件中，用配置管理器统一加载。

第四，注意内存管理。Pascal是手动内存管理的语言，重构时很容易因为对象生命周期管理不当导致内存泄漏。特别注意接口引用和对象引用，确保在合适的时候释放。

第五，做好文档记录。重构的过程中，把每个模块的职责、接口定义、依赖关系都记录下来。不要改完就忘，过几天自己都记不清为什么这么拆了。

第六，保持向后兼容。在重构过程中，老接口尽量保留，可以在内部用新代码实现。不要让外部调用者因为你内部重构了而不得不改代码。

十、文章总结

历史遗留Pascal项目的重构，本质上是一场"外科手术"。核心思路是分层：把数据访问、业务逻辑、界面展示拆成独立的层，每层只关心自己的事。通过接口定义契约，通过依赖注入管理对象关系，通过适配层桥接新旧代码。

这个过程中，你不需要推翻重建，也不需要推倒一切。你只需要一层一层地拆，拆完一层就验证一层，确保功能不丢、性能不降。最终你得到的是一套结构清晰、易于维护、方便测试的现代化代码，而老系统的所有业务逻辑都完整地保留了下来。

记住几个关键原则：小步快跑、保留回退、做好文档、保持兼容。重构不是一次性的壮举，而是一个持续的演进过程。只要你愿意一点一点地改善，老项目终会焕发出新的活力。