麻省理工/ CETI 团队用机器学习技术分离出抹香鲸发音字母表!高度类似人类语言系统,信息承载能力更强!

在海洋生态学研究中,生物声学是人们获取海洋生物信息的重要途径。顾名思义,生物声学主要是对动物声音的生成、传播与接收进行研究。 随着技术的发展,科研人员目前已经能够通过解码动物发声,了解其物种、性别、个体标识或健康情况。

然而,传统的生物声学在进行种群监测时,需要耗费大量的人力来处理和分析现场录音,耗时且成本高。AI 在声音识别方面的突破为这一挑战提供了理想解决方案。机器学习凭借其自动化处理与自我学习能力,已经在生物声学领域大展拳脚。

如今,机器学习分析海洋生物发声已实现了成熟应用。而在一众海洋生物中,鲸鱼、海豚等鲸目动物具有复杂的社会行为特征与合作行为特征,与人类社会高度相似,具有极高的研究价值。

其中,抹香鲸由于与人类社会高度类似的语言系统而成为被研究的重点。

抹香鲸作为高度社会化的哺乳动物,以家庭为生活单位,社会结构错综复杂。 为了进行群体决策,它们大部分时间通过发出连续的「咔嗒」声来进行交流,其交流的时间可能只有短短 10 秒,也可能持续半小时以上。虽然它们的交流系统看似简单,但却能实现一系列复杂的协调行为,这两者之间的反差成为科研人员想要破解的「谜题」。此前大量的研究已经证明抹香鲸的发声具有复杂性,但对于其尾声的具体特征和结构仍然是未知的。

针对于此,麻省理工学院 Pratyusha Sharma 以及 CETI 的研究者使用机器学习对抹香鲸的录音进行了分析,证实了抹香鲸发出的声音具有结构性,由不同特征组合形成,还通过机器学习技术分离出了抹香鲸发音字母表,发现其语言表达系统与人类高度类似,且信息承载更强。

相关研究以「Contextual and combinatorial structure in sperm whale vocalisations」为题,发表在 Nature Communications 上。

研究亮点:

  • 本研究利用目前最大的抹香鲸数据库多米尼克抹香鲸项目 (DSWP) 中的数据,分析了来自东加勒比抹香鲸部族的约 60 头不同抹香鲸的 8,719 条尾声记录,定义了「抹香鲸发音字母表」

  • 抹香鲸的语言具有组合结构性,即其可以组合和调节不同的「咔嗒」声与节奏,以创造出复杂的发声,与人类的语言具有高度类似性

在这里插入图片描述

论文地址:
https://www.nature.com/articles/s41467-024-47221-8

开源项目「awesome-ai4s」汇集了百余篇 AI4S 论文解读,并提供海量数据集与工具:
https://github.com/hyperai/awesome-ai4s

数据集:数据量大,时间跨度长

本研究所用的数据集来自多米尼克抹香鲸项目 (DSWP),这是当前最大的抹香鲸数据存储库。 研究成员在分析中使用了来自东加勒比抹香鲸部族 (EC-1) 的 60 头不同抹香鲸的录音,这些录音共包括 8,719 个尾声数据。

值得一提的是,该数据集不仅包含了 2005-2018 年间,从各种平台和记录系统中手动标注的尾声数据;还包括 2014-2018 年间,从抹香鲸身上吸附的传感器 (DTags) 中记录的数据。

抹香鲸尾声具有丰富的组合特征

为了清晰地观察抹香鲸在交流过程中尾声的变化以及长期趋势,研究人员使用可视化的方式来描述这些声音。如下图所示:图 A 显示了 DSWP 数据集中,两只鲸鱼在 2 分钟内的交流尾声图,鲸鱼发出的尾声分别用蓝色和橙色表示。

在这里插入图片描述

抹香鲸信息交换图

紧接着,研究人员将这些尾声投射到 time–time plot 上,观察 2 分钟内抹香鲸的尾声变化。如图 B、图 C 所示,其中横轴表示抹香鲸自交流开始经过的时间,纵轴表示自尾声开始以来的时间。在图 C 中,研究人员还将相邻尾声之间的匹配点击 (click) 进行了连接。可以看到,在交流过程中,尾声在持续时间内平稳变化,并且还出现了额外的点击声,揭示了尾声结构中复杂的、语境性的变化,说明了抹香鲸具有比此前研究中所报道的更大的信息承载能力。

此前,人们认为抹香鲸的尾音共有 21 种独立的类型。而本次研究表明,不同的尾音类型均是由两个与语境无关的特征 (Tempo 和 Rhythm) 和两个与语境相关的特征 (Rubato 和 Ornamentation) 构成。

如下图所示,研究人员将持续时间内分布在一组有限模式中的尾音特征命名为节奏 (Tempo)。其中,左图揭示了抹香鲸尾音的总持续时间是其点击间距的总和;右图则显示了不同节奏类型的尾音变化。

在这里插入图片描述

抹香鲸尾声产生的组合特征图-Tempo

在图 B 中,研究人员用总时长对 ICI 向量进行归一化处理,得到与时长无关的尾声表示,将其命名为韵律 (Rhythm)。

在这里插入图片描述

抹香鲸尾声产生的组合特征图-Rhythm

在图 C 中,研究人员把抹香鲸在连续的尾声中,缓慢调节尾声的持续时间,称为震颤 (Rubato),并且指出震颤是渐进的,即在抹香鲸交流中相邻的尾声比其他地方同类型尾声的持续时间更接近。

在这里插入图片描述

抹香鲸尾声产生的组合特征图-Rubato

在图 D 中,研究人员将抹香鲸尾声中的最后一次点击定义为装饰音 (Ornamentation) 。装饰音并不是随机分布的,而是在较长的交流中出现在特定的位置。
研究发现,(1) 在单只鲸鱼的叫声序列中,装饰音音序在叫声序列开始时出现的比例,显著高于无装饰音音序;(2) 装饰音音序在呼叫序列结束时出现的比例,也显著高于无装饰音音序。

在这里插入图片描述

抹香鲸尾声产生的组合特征图-Ornamentation

研究人员指出,所有这 4 种特征都能被参与发声交流的鲸鱼感知接收,并采取相应行动,因此它们构成了鲸鱼交流系统的有意识组成部分。节奏、韵律、震颤和装饰音可以自由组合,从而使鲸鱼能够系统地合成大量可区分的尾声。

研究结果:与人类语言库高度类似的抹香鲸发音字母表

通过上述可视化的分析,研究人员用机器学习的方法分离出了抹香鲸发音字母表,与人类语言库高度类似。 如下图所示:

在这里插入图片描述

抹香鲸发音字母表

其中横轴表示尾声韵律类型,竖轴表示尾声节奏类型,每个单元格的颜色表示该节奏/韵律组合在 DSWP 数据集中出现的次数。每个单元格中的饼图提供了关于每种特征组合中,震颤和装饰音在尾音中组合使用的程度:左侧饼图显示了带有震颤尾声与不带震颤的尾声的比例,而右侧饼图显示了所有装饰音在该特征组合中出现的比例。

研究人员指出:虽然并非所有的尾声特征都进行了组合,但抹香鲸尾声丰富的组合结构具有离散和连续参数,其中至少有 143 种组合经常在尾声中组合出现,远超于此前确定的 21 种离散的尾声类型。

Project CETI :致力于用机器学习,实现跨物种对话

此次与麻省理工合作的 CETI 组织在抹香鲸尾声研究方面具有较高的话语权。CETI 是一个非盈利组织,应用先进的机器学习和机器人技术,来聆听和翻译抹香鲸交流。 该组织成立于 2020 年,旨在通过理解和翻译抹香鲸的通信系统,从而有效保护其种群。

CETI 团队由世界领先的人工智能和自然语言处理专家、密码学家、语言学家、海洋生物学家、机器人专家以及来自各个大学的水下声学家组成,团队的重点研究区域主要是在东加勒比海的多米尼加,并且所有研究和发现都将是开源的。

除了上文提到的抹香鲸发音字母表,该团队还有许多关于抹香鲸发声的其他研究。

2019 年 8 月 29 日,CETI 在 Scientific Reports 发表题为「Deep Machine Learning Techniques for the Detection and Classification of Sperm Whale Bioacoustics」的研究成果,证明了机器学习 (ML) 技术应用于抹香鲸生物声学的可行性,并确立了构建神经网络来学习鲸鱼发声有意义表征的有效性。
论文地址:
https://www.nature.com/articles/s41598-019-48909-4

2022 年 6 月 17 日,CETI 又在 IScience 上发表「Toward understanding the communication in sperm whales」,重点介绍了抹香鲸交流的记录和分析方法,具体包括以下关键步骤:

记录:从各种传感器收集鲸鱼通信和行为数据的大规模纵向多模态数据集;

处理:协调和处理多传感器数据;

解码:使用机器学习技术,创建鲸鱼通信模型,表征其结构,并将其与行为联系起来;

编码和回放:进行交互式回放实验,并完善鲸鱼语言模型。

在这里插入图片描述

抹香鲸研究步骤图

论文地址:
https://www.sciencedirect.com/science/article/pii/S2589004222006642

2023 年 12 月 4 日,CETI 利用机器学习技术发现了抹香鲸尾声中存在的元音和双元音,并且两种尾声都可以出现在不同的传统尾声类型上

2024 年 3 月 24 日,团队研究人员发现抹香鲸在水下航行时会发出一系列冲动的、类似「咔嗒」的点击声音,并把它命名为回声定位点击声,还在嘈杂的环境中检测到了抹香鲸的回声定位点击声的存在。

抹香鲸作为智力高度发达的哺乳动物,其语言系统被证明与人类语言系统具有高度类似性。在机器学习技术飞跃发展的时代,越来越多的专业人员加入到抹香鲸发声研究项目中,随着研究的不断深入,人-鲸对话有望成为现实。

参考资料:

1.https://www.projectceti.org/news-research-insights#publications

2.https://36kr.com/p/146986007629

unit main; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, DB, PostgreSQLUniProvider, Uni, MemDS, DBAccess, GridsEh, DBGridEh, DBGridEhGrouping, ToolCtrlsEh, DBGridEhToolCtrls, DynVarsEh, EhLibVCL, Vcl.Buttons, Vcl.ComCtrls, Vcl.Menus, Vcl.DBCtrls, Vcl.Mask, IdTCPClient, DBAxisGridsEh, DBGridEhImpExp, DBCtrlsEh, DataSetImpExpEh, System.UITypes, ShellAPI,Vcl.Clipbrd, SynEditHighlighter, SynHighlighterSQL, SynAutoCorrect, SynCompletionProposal, SynEdit, SynMemo,SynEditTypes; type TForm1 = class(TForm) Panel1: TPanel; Label1: TLabel; cbConnections: TComboBox; Label2: TLabel; btnExecute: TButton; Panel2: TPanel; DBGridEh0: TDBGridEh; UniConnection0: TUniConnection; UniQuery1: TUniQuery; btnUpdate: TButton; btnExportExcel: TButton; SaveDialog1: TSaveDialog; StatusBar1: TStatusBar; btnExit1: TButton; UniDataSource0: TUniDataSource; lstTables: TListBox; // 新增列表控件 // DBGridEh1: TDBGridEh; // 新增DBGridEh控件 UniQueryTables: TUniQuery; // 用于获取表信息的查询 UniQueryFields: TUniQuery; // 用于获取字段信息的查询 UniDataSource1: TUniDataSource; DBGridEh1: TDBGridEh; pmTables: TPopupMenu; SynCompletionProposal1: TSynCompletionProposal; SynAutoComplete1: TSynAutoComplete; SynAutoCorrect1: TSynAutoCorrect; SynEdit1: TSynEdit; SynSQLSyn1: TSynSQLSyn; // 新增数据源 procedure FormCreate(Sender: TObject); procedure btnExecuteClick(Sender: TObject); procedure btnUpdateClick(Sender: TObject); procedure btnExportExcelClick(Sender: TObject); procedure cbConnectionsChange(Sender: TObject); procedure btnExit1Click(Sender: TObject); procedure lstTablesClick(Sender: TObject); procedure SynCompletionProposal1Execute(Kind: SynCompletionType; Sender: TObject; var CurrentInput: string; var x, y: Integer; var CanExecute: Boolean); procedure SynEdit1DblClick(Sender: TObject); procedure SynEdit1KeyPress(Sender: TObject; var Key: Char); private { Private declarations } procedure LoadConnections; procedure ConnectToDatabase(Index: Integer); procedure LoadTables; // 加载所有表 procedure LoadFields(const TableFullName: string); // 加载选定表的所有字段 function TestNetworkConnection(const Server: string; Port: Integer): Boolean; procedure lstTablesContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean); procedure DBGridEh1ContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean); procedure CopyTableNameToClipboard(Sender: TObject); procedure CopyFieldNameToClipboard(Sender: TObject); procedure InitHighlighter; procedure LoadDatabaseSchema; public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} uses ExcelXP, ComObj; function TForm1.TestNetworkConnection(const Server: string; Port: Integer): Boolean; var Client: TIdTCPClient; begin Result := False; Client := TIdTCPClient.Create(nil); try Client.Host := Server; Client.Port := Port; try Client.Connect; Result := Client.Connected; Client.Disconnect; except Result := False; end; finally Client.Free; end; end; procedure TForm1.lstTablesContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean); var ItemIndex: Integer; TableName: string; MenuItem: TMenuItem; begin // 获取当前鼠标位置对应的项索引 ItemIndex := lstTables.ItemAtPos(MousePos, True); if ItemIndex >= 0 then begin lstTables.ItemIndex := ItemIndex; TableName := lstTables.Items[ItemIndex]; // 清空现有菜单项 pmTables.Items.Clear; // 创建新的菜单项 MenuItem := TMenuItem.Create(pmTables); MenuItem.Caption := '复制表名: ' + TableName; MenuItem.OnClick := CopyTableNameToClipboard; pmTables.Items.Add(MenuItem); // 显示弹出菜单 pmTables.Popup(MousePos.X + lstTables.Left, MousePos.Y + lstTables.Top); Handled := True; // 阻止默认的弹出菜单 end; end; procedure TForm1.SynCompletionProposal1Execute(Kind: SynCompletionType; Sender: TObject; var CurrentInput: string; var x, y: Integer; var CanExecute: Boolean); var FieldsQuery: TUniQuery; SchemaName, TableName, CurrentWord, FullTableName: string; DotPos, LastDotPos: Integer; CaretPos: TBufferCoord; LineText: string; StartPos: Integer; begin CanExecute := UniConnection0.Connected; if not CanExecute then Exit; try // 获取当前光标位置 CaretPos := SynEdit1.CaretXY; // 获取当前行的文本 if CaretPos.Line > 0 then LineText := SynEdit1.Lines[CaretPos.Line - 1] else LineText := ''; // 从光标位置向前查找,获取完整的单词(包括点号) StartPos := CaretPos.Char; while (StartPos > 1) and (StartPos <= Length(LineText)) and (LineText[StartPos - 1] in ['a'..'z', 'A'..'Z', '0'..'9', '_', '.']) do Dec(StartPos); if StartPos <= Length(LineText) then CurrentWord := Copy(LineText, StartPos, CaretPos.Char - StartPos) else CurrentWord := ''; // 查找最后一个点号的位置 LastDotPos := LastDelimiter('.', CurrentWord); if LastDotPos = 0 then begin // 没有点号,显示所有表名 SynCompletionProposal1.ItemList.BeginUpdate; try SynCompletionProposal1.ItemList.Clear; LoadDatabaseSchema; finally SynCompletionProposal1.ItemList.EndUpdate; end; end else begin // 有点号,检查点号是否在末尾(表示需要字段提示) if LastDotPos = Length(CurrentWord) then begin // 点号在末尾,获取模式名和表名 FullTableName := Copy(CurrentWord, 1, LastDotPos - 1); // 解析模式名和表名 DotPos := LastDelimiter('.', FullTableName); if DotPos > 0 then begin SchemaName := Copy(FullTableName, 1, DotPos - 1); TableName := Copy(FullTableName, DotPos + 1, Length(FullTableName) - DotPos); end else begin SchemaName := 'public'; // 默认模式 TableName := FullTableName; end; // 验证表名和模式名不为空 if (Trim(TableName) = '') or (Trim(SchemaName) = '') then begin SynCompletionProposal1.ItemList.Clear; Exit; end; FieldsQuery := TUniQuery.Create(nil); try FieldsQuery.Connection := UniConnection0; FieldsQuery.SQL.Text := 'SELECT column_name ' + 'FROM information_schema.columns ' + 'WHERE table_name = :table_name ' + 'AND table_schema = :schema_name ' + 'ORDER BY ordinal_position'; FieldsQuery.ParamByName('table_name').AsString := TableName; FieldsQuery.ParamByName('schema_name').AsString := SchemaName; FieldsQuery.Open; SynCompletionProposal1.ItemList.BeginUpdate; try SynCompletionProposal1.ItemList.Clear; if FieldsQuery.RecordCount = 0 then begin // 尝试不区分大小写查询 FieldsQuery.Close; FieldsQuery.SQL.Text := 'SELECT column_name ' + 'FROM information_schema.columns ' + 'WHERE LOWER(table_name) = LOWER(:table_name) ' + 'AND LOWER(table_schema) = LOWER(:schema_name) ' + 'ORDER BY ordinal_position'; FieldsQuery.ParamByName('table_name').AsString := TableName; FieldsQuery.ParamByName('schema_name').AsString := SchemaName; FieldsQuery.Open; end; if FieldsQuery.RecordCount = 0 then begin SynCompletionProposal1.ItemList.Add('未找到字段 - 检查表名: ' + SchemaName + '.' + TableName); Exit; end; while not FieldsQuery.Eof do begin SynCompletionProposal1.ItemList.Add( FieldsQuery.FieldByName('column_name').AsString ); FieldsQuery.Next; end; finally SynCompletionProposal1.ItemList.EndUpdate; end; finally FieldsQuery.Free; end; end else begin // 点号不在末尾,显示表名提示 SynCompletionProposal1.ItemList.BeginUpdate; try SynCompletionProposal1.ItemList.Clear; LoadDatabaseSchema; finally SynCompletionProposal1.ItemList.EndUpdate; end; end; end; except on E: Exception do begin SynCompletionProposal1.ItemList.Clear; SynCompletionProposal1.ItemList.Add('错误: ' + E.Message); // 记录详细错误信息 OutputDebugString(PChar('自动完成错误: ' + E.Message + ' Class: ' + E.ClassName)); end; end; end; procedure TForm1.SynEdit1DblClick(Sender: TObject); begin SynEdit1.SelectAll; end; procedure TForm1.SynEdit1KeyPress(Sender: TObject; var Key: Char); begin // 当输入点号时触发自动完成 if Key = '.' then begin // 先插入点号 SynEdit1.SelText := '.'; // 立即触发自动完成 SynCompletionProposal1.ActivateCompletion; Key := #0; // 阻止默认处理 end // Ctrl+Space 触发自动完成 else if (Key = ' ') and (GetKeyState(VK_CONTROL) < 0) then begin Key := #0; SynCompletionProposal1.ActivateCompletion; end; end; procedure TForm1.InitHighlighter; begin SynSQLSyn1.SQLDialect := sqlPostgres; SynSQLSyn1.KeyAttri.Foreground := clNavy; SynSQLSyn1.CommentAttri.Foreground := clGreen; SynSQLSyn1.StringAttri.Foreground := clMaroon; SynEdit1.Highlighter := SynSQLSyn1; SynEdit1.Options := SynEdit1.Options + [eoAutoIndent, eoScrollPastEol]; end; procedure TForm1.DBGridEh1ContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean); var AHitTest: TGridCoord; // 使用 TGridCoord 替代 TGridHitTestInfoEh FieldName: string; MenuItem: TMenuItem; Cell: TGridCoord; begin // 获取鼠标点击位置的单元格坐标 Cell := DBGridEh1.MouseCoord(MousePos.X, MousePos.Y); if (Cell.X >= 0) and (Cell.Y >= 0) and (UniQueryFields.Active) and (not UniQueryFields.IsEmpty) and (Cell.X = 0) then // column_name 列 begin // 定位到对应行 UniQueryFields.RecNo := Cell.Y + 1; FieldName := UniQueryFields.FieldByName('column_name').AsString; // 清空现有菜单项 pmTables.Items.Clear; // 创建新的菜单项 MenuItem := TMenuItem.Create(pmTables); MenuItem.Caption := '复制字段名: ' + FieldName; MenuItem.OnClick := CopyFieldNameToClipboard; pmTables.Items.Add(MenuItem); // 显示弹出菜单 pmTables.Popup(MousePos.X + DBGridEh1.Left, MousePos.Y + DBGridEh1.Top); Handled := True; // 阻止默认的弹出菜单 end; end; procedure TForm1.LoadDatabaseSchema; var TablesQuery: TUniQuery; begin if not UniConnection0.Connected then begin OutputDebugString('数据库未连接'); Exit; end; try TablesQuery := TUniQuery.Create(nil); try TablesQuery.Connection := UniConnection0; TablesQuery.SQL.Text := 'SELECT table_schema, table_name ' + 'FROM information_schema.tables ' + 'WHERE table_catalog = current_database() ' + 'AND table_schema NOT IN (''information_schema'', ''pg_catalog'') ' + 'AND table_type = ''BASE TABLE'' ' + 'ORDER BY table_schema, table_name'; TablesQuery.Open; SynCompletionProposal1.ItemList.BeginUpdate; try SynCompletionProposal1.ItemList.Clear; while not TablesQuery.Eof do begin SynCompletionProposal1.ItemList.Add( TablesQuery.FieldByName('table_schema').AsString + '.' + TablesQuery.FieldByName('table_name').AsString ); TablesQuery.Next; end; finally SynCompletionProposal1.ItemList.EndUpdate; end; finally TablesQuery.Free; end; except on E: Exception do begin SynCompletionProposal1.ItemList.Clear; SynCompletionProposal1.ItemList.Add('加载架构失败: ' + E.Message); OutputDebugString(PChar('加载架构错误: ' + E.Message)); end; end; end; procedure TForm1.CopyTableNameToClipboard(Sender: TObject); var TableName: string; begin if lstTables.ItemIndex >= 0 then begin TableName := lstTables.Items[lstTables.ItemIndex]; Clipboard.AsText := TableName; StatusBar1.Panels[0].Text := '已复制表名: ' + TableName; end; end; procedure TForm1.CopyFieldNameToClipboard(Sender: TObject); var FieldName: string; begin if UniQueryFields.Active and not UniQueryFields.IsEmpty then begin FieldName := UniQueryFields.FieldByName('column_name').AsString; Clipboard.AsText := FieldName; StatusBar1.Panels[0].Text := '已复制字段名: ' + FieldName; end; end; procedure TForm1.FormCreate(Sender: TObject); begin LoadConnections; if cbConnections.Items.Count > 0 then begin cbConnections.ItemIndex := 0; // 尝试连接 ConnectToDatabase(0); end; // 修改自动完成设置 SynCompletionProposal1.Options := [scoLimitToMatchedText, scoUseInsertList, scoEndCharCompletion]; SynCompletionProposal1.EndOfTokenChr := ' .()=,;'; SynCompletionProposal1.TriggerChars := '.'; // 点号触发 SynCompletionProposal1.ShortCut := 16416; // Ctrl+Space LoadTables; // 加载所有表 // 创建弹出菜单实例(如果设计时没有创建) if not Assigned(pmTables) then pmTables := TPopupMenu.Create(Self); // 关联右键菜单事件 lstTables.OnContextPopup := lstTablesContextPopup; DBGridEh1.OnContextPopup := DBGridEh1ContextPopup; InitHighlighter; //在FormCreate中添加键盘事件 SynEdit1.OnKeyPress := SynEdit1KeyPress; end; procedure TForm1.LoadConnections; begin cbConnections.Items.Clear; cbConnections.Items.Add('连接1: 21 gy_zh_hy_cp_aq_jf_yw_yy_nl_dt_dz_auth_td_gz'); cbConnections.Items.Add('连接2: 22 sc_fz_wd_sz_bi_jk_hl_ys_tj'); cbConnections.Items.Add('连接3: 23 jy_jc_bl_zj'); cbConnections.Items.Add('连接4: 24 jz_br_yj'); cbConnections.Items.Add('连接5: 25 yz_lj_hz_zz_yx'); cbConnections.Items.Add('连接6: 26 fy_yg_hg_wm'); cbConnections.Items.Add('连接7: 27 yp_zl_sm_jh_wl'); cbConnections.Items.Add('连接8: 28 聚合库'); end; procedure TForm1.LoadTables; begin lstTables.Items.Clear; if not UniConnection0.Connected then Exit; try UniQueryTables.Close; // 修改SQL查询,获取lyradb数据库中除public模式外的所有表 UniQueryTables.SQL.Text := 'SELECT table_schema, table_name ' + 'FROM information_schema.tables ' + 'WHERE table_catalog = ''lyradb'' ' + // 指定数据库名 'AND table_schema NOT IN (''public'', ''information_schema'', ''pg_catalog'',''hint_plan'',''lyra'',''profile'',''repack'',''util'') ' + // 排除系统模式 'AND table_schema NOT LIKE ''ceti%'' ' +// 排除系统模式 'AND table_schema NOT LIKE ''grus%'' ' +// 排除系统模式 'AND table_type = ''BASE TABLE'' ' + // 只获取基本表 'ORDER BY table_schema, table_name'; UniQueryTables.Open; while not UniQueryTables.Eof do begin // 显示格式:模式名.表名 lstTables.Items.Add( UniQueryTables.FieldByName('table_schema').AsString + '.' + UniQueryTables.FieldByName('table_name').AsString ); UniQueryTables.Next; end; UniQueryTables.Close; except on E: Exception do ShowMessage('加载表列表失败: ' + E.Message); end; end; procedure TForm1.lstTablesClick(Sender: TObject); begin if lstTables.ItemIndex >= 0 then begin // 加载选定表的所有字段 LoadFields(lstTables.Items[lstTables.ItemIndex]); end; end; procedure TForm1.LoadFields(const TableFullName: string); var SchemaName, TableName: string; DotPos,i: Integer; begin // 解析模式名和表名 DotPos := Pos('.', TableFullName); if DotPos > 0 then begin SchemaName := Copy(TableFullName, 1, DotPos - 1); TableName := Copy(TableFullName, DotPos + 1, Length(TableFullName)); end else begin SchemaName := 'public'; // 默认模式 TableName := TableFullName; end; // 清空字段信息 DBGridEh1.Columns.Clear; // 获取选定表的所有字段信息(包含注释) UniQueryFields.Close; UniQueryFields.SQL.Text := 'SELECT ' + ' c.column_name, ' + ' c.data_type, ' + ' c.column_default, ' + ' c.is_nullable, ' + ' col_description((c.table_schema||''.''||c.table_name)::regclass::oid, c.ordinal_position) as column_comment ' + 'FROM information_schema.columns c ' + 'WHERE c.table_schema = :schema_name ' + 'AND c.table_name = :table_name ' + 'ORDER BY c.ordinal_position'; UniQueryFields.ParamByName('schema_name').AsString := SchemaName; UniQueryFields.ParamByName('table_name').AsString := TableName; UniQueryFields.Open; // 设置数据源 UniDataSource1.DataSet := UniQueryFields; // 自动添加所有列到DBGridEh DBGridEh1.Columns.AddAllColumns(True); // 然后再限制最大宽度 for i := 0 to DBGridEh1.Columns.Count - 1 do begin DBGridEh1.Columns[i].OptimizeWidth; if DBGridEh1.Columns[i].Width > 200 then DBGridEh1.Columns[i].Width := 200; end; end; procedure TForm1.ConnectToDatabase(Index: Integer); var ConnStr: string; begin UniConnection0.Disconnect; // 设置 Provider 名称 UniConnection0.ProviderName := 'PostgreSQL'; case Index of 0: begin // 连接1 UniConnection0.Server := '192.168.129.21'; UniConnection0.Database := 'lyradb'; UniConnection0.Username := 'lyra_ops'; UniConnection0.Password := 'i48VF69KXwgP'; UniConnection0.Port := 5432; // 明确指定端口 end; 1: begin // 连接2 UniConnection0.Server := '192.168.129.22'; UniConnection0.Database := 'lyradb'; UniConnection0.Username := 'lyra_ops'; UniConnection0.Password := 'i48VF69KXwgP'; UniConnection0.Port := 5432; // 明确指定端口 end; // 其他连接配置... 2: begin // 连接3 UniConnection0.Server := '192.168.129.23'; UniConnection0.Database := 'lyradb'; UniConnection0.Username := 'lyra_ops'; UniConnection0.Password := 'i48VF69KXwgP'; UniConnection0.Port := 5432; // 明确指定端口 end; 3: begin // 连接4 UniConnection0.Server := '192.168.129.24'; UniConnection0.Database := 'lyradb'; UniConnection0.Username := 'lyra_ops'; UniConnection0.Password := 'i48VF69KXwgP'; UniConnection0.Port := 5432; // 明确指定端口 end; 4: begin // 连接5 UniConnection0.Server := '192.168.129.25'; UniConnection0.Database := 'lyradb'; UniConnection0.Username := 'lyra_ops'; UniConnection0.Password := 'i48VF69KXwgP'; UniConnection0.Port := 5432; // 明确指定端口 end; 5: begin // 连接6 UniConnection0.Server := '192.168.129.26'; UniConnection0.Database := 'lyradb'; UniConnection0.Username := 'lyra_ops'; UniConnection0.Password := 'i48VF69KXwgP'; UniConnection0.Port := 5432; // 明确指定端口 end; 6: begin // 连接7 UniConnection0.Server := '192.168.129.27'; UniConnection0.Database := 'lyradb'; UniConnection0.Username := 'lyra_ops'; UniConnection0.Password := 'i48VF69KXwgP'; UniConnection0.Port := 5432; // 明确指定端口 end; 7: begin // 连接8 UniConnection0.Server := '192.168.129.28'; UniConnection0.Database := 'lyradb'; UniConnection0.Username := 'lyra_ops'; UniConnection0.Password := 'i48VF69KXwgP'; UniConnection0.Port := 5432; // 明确指定端口 end; end; // 显示连接字符串用于调试 ConnStr := Format('Server=%s;Database=%s;User_ID=%s;Port=%d', [UniConnection0.Server, UniConnection0.Database, UniConnection0.Username, UniConnection0.Port]); StatusBar1.Panels[0].Text := '正在连接: ' + ConnStr; try if not TestNetworkConnection(UniConnection0.Server, 5432) then begin ShowMessage('无法连接到数据库服务器,请检查网络连接'); Exit; end; UniConnection0.Connect; StatusBar1.Panels[0].Text := '已连接到: ' + cbConnections.Items[Index]; // 连接成功后加载表 // 连接成功后重新加载 LoadTables; SynCompletionProposal1.ItemList.Clear; // 清空之前的缓存 LoadDatabaseSchema; except on E: Exception do // ShowMessage('连接失败: ' + E.Message); begin ShowMessage(Format('连接失败:'#13#10'错误: %s'#13#10'连接字符串: %s', [E.Message, ConnStr])); StatusBar1.Panels[0].Text := '连接失败'; end; end; end; procedure TForm1.btnExecuteClick(Sender: TObject); var i: Integer; SQLToExecute: string; begin if not UniConnection0.Connected then begin ShowMessage('请先连接到数据库'); Exit; end; // 判断是否有选中文本 if SynEdit1.SelText <> '' then SQLToExecute := SynEdit1.SelText // 执行选中的SQL else SQLToExecute := SynEdit1.Text; // 执行全部SQL if Trim(SQLToExecute) = '' then begin ShowMessage('请输入SQL语句'); Exit; end; try UniQuery1.Close; UniQuery1.SQL.Text := SQLToExecute; // 判断SQL类型(查询或新) if (Pos('SELECT', UpperCase(SQLToExecute)) = 1) or (Pos('WITH', UpperCase(SQLToExecute)) = 1) or (Pos('SHOW', UpperCase(SQLToExecute)) = 1) then begin UniQuery1.Open; StatusBar1.Panels[1].Text := '记录数: ' + IntToStr(UniQuery1.RecordCount); // 自动调整列宽 DBGridEh0.Columns.Clear; DBGridEh0.Columns.AddAllColumns(True); for i := 0 to DBGridEh0.Columns.Count - 1 do begin DBGridEh0.Columns[i].OptimizeWidth; if DBGridEh0.Columns[i].Width > 200 then DBGridEh0.Columns[i].Width := 200; end; end else begin // 执行非查询语句 UniQuery1.ExecSQL; StatusBar1.Panels[1].Text := '执行成功,影响行数: ' + IntToStr(UniQuery1.RowsAffected); end; except on E: Exception do ShowMessage('执行SQL失败: ' + E.Message); end; end; procedure TForm1.btnUpdateClick(Sender: TObject); begin if UniQuery1.State in [dsEdit, dsInsert] then UniQuery1.Post; try UniQuery1.ApplyUpdates; ShowMessage('新成功'); except on E: Exception do ShowMessage('新失败: ' + E.Message); end; end; procedure TForm1.btnExportExcelClick(Sender: TObject); var // ExpClass: TDBGridEhExportClass; Exp: TDBGridEhExportAsXLSX; Ext: string; i: Integer; SaveDialog1: TSaveDialog; begin if UniQuery1.IsEmpty then begin ShowMessage('没有数据可导出'); Exit; end; SaveDialog1 := TSaveDialog.Create(nil); try SaveDialog1.Filter := 'Excel文件(*.xls)|*.xls|Excel 2007+(*.xlsx)|*.xlsx'; SaveDialog1.DefaultExt := 'xls'; SaveDialog1.InitialDir := '\Desktop\'; SaveDialog1.FileName := '导出数据_' + FormatDateTime('yyyymmddhhnnss', Now); if SaveDialog1.Execute then begin // ExpClass := TDBGridEhExportAsXLS; Exp := TDBGridEhExportAsXLSX.Create; Ext := 'xls'; if Pos('.xlsx', LowerCase(SaveDialog1.FileName)) > 0 then Ext := 'xlsx'; if UpperCase(ExtractFileExt(SaveDialog1.FileName)) <> '.' + UpperCase(Ext) then SaveDialog1.FileName := SaveDialog1.FileName + '.' + Ext; // 执行导出 try // 设置DBGridEh的样式 Exp.DBGridEh := DBGridEh0; Exp.DBGridEh.TitleFont := DBGridEh0.TitleFont; Exp.DBGridEh.TitleFont.Name := '宋体'; Exp.DBGridEh.TitleFont.Style := [fsBold]; Exp.DBGridEh.TitleFont.Size := 12; Exp.DBGridEh.TitleParams.Color := clSkyBlue; for i := 0 to Exp.DBGridEh.Columns.Count - 1 do begin Exp.DBGridEh.Columns[i].OptimizeWidth; if Exp.DBGridEh.Columns[i].Width > 200 then Exp.DBGridEh.Columns[i].Width := 200; end; if SameText(Ext, 'xlsx') then begin Exp.ExportToFile(SaveDialog1.FileName, True); end else begin Exp.ExportToFile(SaveDialog1.FileName, True); end; finally Exp.Free; end; // ShowMessage('导出成功: ' + SaveDialog1.FileName); // 假设导出操作已经完成 if MessageDlg('导出成功: ' + SaveDialog1.FileName + #13#10'是否要打开文件?', mtInformation, [mbYes, mbNo], 0, mbNo) = mrYes then begin // 用户点击了"是"(打开文件) ShellExecute(0, 'open', PChar(SaveDialog1.FileName), nil, nil, SW_SHOWNORMAL); end; end; finally SaveDialog1.Free; end; end; procedure TForm1.btnExit1Click(Sender: TObject); begin Form1.Close; end; procedure TForm1.cbConnectionsChange(Sender: TObject); begin ConnectToDatabase(cbConnections.ItemIndex); end; end.
08-28
评论
成就一亿技术人!
拼手气红包6.0元
还能输入1000个字符
 
红包 添加红包
表情包 插入表情
 条评论被折叠 查看
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值