频道分类

Delphi Google Text To Speech API

作者:admin 来源: 日期:2020/2/10 13:59:35 人气: 标签:

 
unit uGTTS;

interface

uses
 Windows, SysUtils, Variants, Classes, StrUtils, IdHTTP, HTTPApp, IdURI,
 ShellAPI, DateUtils, Forms, MPlayer, Controls;

const
 LANG_TR = 'tr';
 LANG_EN = 'en';
 LANG_DE = 'de';
 LANG_RU = 'ru';
 LANG_FR = 'fr';

Type
 /// <summary>
 /// <c>Google Text To Speech API</c> si yardımı ile yazıları sese çeviren kütüphanedir.
 /// Verilen yazıyı MP3 formatında geri gönderir. Ön bellekleme mekanizması ise
 /// daha önce sorgulanmış yazıları google'a yollamadan önce ön bellek klasöründe arar.
 /// Yazının ses karşılığı daha önce oluşturulmuş ise google servislerine istemde bulunmaz.
 /// Bu özellik varsayılan açıktır. İstenirse devre dışı bırakılabilir.
 /// </summary>
 /// <remarks>
 /// Bu sınıf <c>Ahmet ALTAY</c> tarafından <c>Google Text To Speech</c> kullanılarak geliştirilmiştir. Tarih: 16.06.2014
 /// </remarks>
 TGTTS = Class(TComponent)
 private const
   sURL: string = 'http://translate.google.com/translate_tts?ie=utf-8&tl=%s&q=%s';
   sTimeOut: Integer = 3000; // 3 second
 private
 { Private declarations }
   FTempPath: string;
   FUseCache: Boolean;
   FLanguage: string;
   FAppDir: string;
   FSpeechDir: string;
   FLastCalledURL: String;
   FLastConvertedMp3: String;
   FMediaPlayer: TMediaPlayer;
   function DelTree(const ADirName: string): Boolean;
 public
   /// <summary>
   /// Parametre ile verilen yazıyı, ses dosyasına dönüştürür.
   /// </summary>
   /// <param name="AText">Metin (100 karakteri geçmemesi tavsiye edilir.)</param>
   /// <returns>MP3 formatında dosya yolu döner.</returns>
   /// <remarks>
   /// Bu fonskyion Google servisleri aracılığı ile geliştirilmiştir. <seealso>http://translate.google.com</seealso>
   /// </remarks>
   /// <exception cref="EFCreateError">Klasör okuma/yazma izni yok veya dosya yolu hatalı.</exception>
   /// <exception cref="EIdSocketError ">Bağlantı hatası, İnternet erişimi yok veya yasaklı URL.</exception>
   /// <author>Ahmet ALTAY</author>
   function TextToSpeech(const AText: string): TFileName;
   /// <summary>
   /// Parametre ile verilen yazıyı, ses dosyasına dönüştürür ve MediaPlayer ile çalar.
   /// </summary>
   /// <param name="AText">Metin (100 karakteri geçmemesi tavsiye edilir.)</param>
   /// <param name="AMediaPlayer">Ses dosyasının yürütüleceği media player nesnesi.</param>
   /// <param name="ADontStopWhilePlaying">Media player'ın, dosya yürütme işlemini bitirene kadar beklemesi için true gönderin.</param>
   /// <remarks>
   /// Bu fonskyion Google servisleri aracılığı ile geliştirilmiştir. <seealso>http://translate.google.com</seealso>
   /// </remarks>
   /// <exception cref="EFCreateError">Klasör okuma/yazma izni yok veya dosya yolu hatalı.</exception>
   /// <exception cref="EIdSocketError ">Bağlantı hatası, İnternet erişimi yok veya yasaklı URL.</exception>
   /// <exception cref="EMCIDeviceError ">Media Player hatası, codec yok, dosya yolu hatalı veya erişim izni yok.</exception>
   /// <author>Ahmet ALTAY</author>
   procedure SpeechNow(const AText: string; const AMediaPlayer: TMediaPlayer; const ADontStopWhilePlaying: Boolean = True); overload;
   /// <summary>
   /// Parametre ile verilen yazıyı, ses dosyasına dönüştürür ve MediaPlayer ile çalar.
   /// </summary>
   /// <param name="AText">Metin (100 karakteri geçmemesi tavsiye edilir.)</param>
   /// <param name="ADontStopWhilePlaying">Media player'ın, dosya yürütme işlemini bitirene kadar beklemesi için true gönderin.</param>
   /// <remarks>
   /// Bu fonskyion Google servisleri aracılığı ile geliştirilmiştir. <seealso>http://translate.google.com</seealso>
   /// </remarks>
   /// <exception cref="EFCreateError">Klasör okuma/yazma izni yok veya dosya yolu hatalı.</exception>
   /// <exception cref="EIdSocketError ">Bağlantı hatası, İnternet erişimi yok veya yasaklı URL.</exception>
   /// <exception cref="EMCIDeviceError ">Media Player hatası, codec yok, dosya yolu hatalı veya erişim izni yok.</exception>
   /// <author>Ahmet ALTAY</author>
   procedure SpeechNow(const AText: string; const ADontStopWhilePlaying: Boolean = True); overload;
   /// <summary>
   /// Okutulan dosyanın işi bittikten sonra silmek için kullanılabilir.
   /// </summary>
   /// <returns>İşlem başarılı ise True, değilse False döner.</returns>
   /// <author>Ahmet ALTAY</author>
   function DeleteFile(const AFileName: string): Boolean;
   /// <summary>
   /// Ön bellekte biriken dosyaları temizlemek için kullanılır.
   /// </summary>
   /// <returns>İşlem başarılı ise True, değilse False döner.</returns>
   /// <author>Ahmet ALTAY</author>
   function ClearCache(): Boolean;
   /// <param name="ALanguage">Ses çevirisinde kullanılacak olan dil seçeneği.</param>
   /// <param name="AUseCache">Ön bellek kullanımı.</param>
   /// <author>Ahmet ALTAY</author>
   constructor Create(AOwner: TWinControl; const ALanguage: string = LANG_TR; const AUseCache: Boolean = True); overload;
   /// <param name="ATempPath">Dosyaların kayıt edileceği kök klasor yolu.</param>
   /// <param name="ALanguage">Ses çevirisinde kullanılacak olan dil seçeneği.</param>
   /// <param name="AUseCache">Ön bellek kullanımı.</param>
   /// <author>Ahmet ALTAY</author>
   constructor Create(AOwner: TWinControl; const ATempPath: string; const ALanguage: string = LANG_TR; const AUseCache: Boolean = True); overload;
   /// <param name="ATempPath">Dosyaların kayıt edileceği kök klasor yolu.</param>
   /// <param name="AAppDir">Temp içersine açılacak uygulamayı temsil eden klasör adı.</param>
   /// <param name="ASpeechDir">Uygulama klasörü içine açılacak. Ses dosyalarını içeren klasör adı.</param>
   /// <param name="ALanguage">Ses çevirisinde kullanılacak olan dil seçeneği.</param>
   /// <param name="AUseCache">Ön bellek kullanımı.</param>
   /// <author>Ahmet ALTAY</author>
   constructor Create(AOwner: TWinControl; const ATempPath: string; const AAppDir: string; const ASpeechDir: string; const ALanguage: string = LANG_TR; const AUseCache: Boolean = True); overload;
   destructor Destroy; override;
   /// <summary>Son çalıştırılan URL. <c>ReadOnly</c></summary>
   property LastCalledURL: String read FLastCalledURL;
   /// <summary>Son dönüştürülen MP3 dosyası. <c>ReadOnly</c></summary>
   property LastConvertedMp3: String read FLastConvertedMp3;
 end;

implementation

{ TGTTS }

constructor TGTTS.Create(AOwner: TWinControl; const ALanguage: string; const AUseCache: Boolean);
var
 lTempPath: array[0..MAX_PATH] of Char;
 lAppDir: String;
begin
 GetTempPath(Length(lTempPath), lTempPath);
 lAppDir := ReplaceStr(ExtractFileName(Application.ExeName),ExtractFileExt(Application.ExeName),'');
 Create(AOwner,lTempPath,lAppDir,'Speech',ALanguage,AUseCache);
end;

constructor TGTTS.Create(AOwner: TWinControl; const ATempPath, ALanguage: string; const AUseCache: Boolean);
var
 lAppDir: String;
begin
 lAppDir := ReplaceStr(ExtractFileName(Application.ExeName),ExtractFileExt(Application.ExeName),'');
 Create(AOwner,ATempPath,ExtractFileName(Application.ExeName),'Speech',ALanguage,AUseCache);
end;

constructor TGTTS.Create(AOwner: TWinControl; const ATempPath, AAppDir, ASpeechDir, ALanguage: string; const AUseCache: Boolean);
begin
 inherited Create(AOwner);
 FTempPath := ATempPath;
 FAppDir := AAppDir;
 FSpeechDir := ASpeechDir;
 FUseCache := AUseCache;
 FLanguage := ALanguage;
 FMediaPlayer := TMediaPlayer.Create(Self);
 FMediaPlayer.Parent := TWinControl(Self.Owner);
 FMediaPlayer.Visible := False;
 FMediaPlayer.Close;
end;

function TGTTS.ClearCache: Boolean;
begin
 if not DirectoryExists(FTempPath + FAppDir + '\' + FSpeechDir + '\') then
 begin
   Result := True;
   Exit;
 end;
 FMediaPlayer.Close;
 Result := DelTree(FTempPath + FAppDir + '\' + FSpeechDir + '\');
end;

function TGTTS.DeleteFile(const AFileName: string): Boolean;
begin
 Result := False;
 if FileExists(AFileName) then
   Result := SysUtils.DeleteFile(AFileName);
end;

function TGTTS.DelTree(const ADirName: string): Boolean;
var
 lSHFileOpStruct: TSHFileOpStruct;
 lDirBuf: array[0..MAX_PATH] of char;
begin
 try
   Fillchar(lSHFileOpStruct, Sizeof(lSHFileOpStruct), 0);
   FillChar(lDirBuf, Sizeof(lDirBuf), 0);
   StrPCopy(lDirBuf, ADirName);
   with lSHFileOpStruct do
   begin
     Wnd := 0;
     pFrom := @lDirBuf;
     wFunc := FO_DELETE;
     fFlags := FOF_NOCONFIRMATION or FOF_SILENT;
   end;
   Result := SHFileOperation(lSHFileOpStruct) = 0;
 except
   Result := False;
 end;
end;

destructor TGTTS.Destroy;
begin
 FMediaPlayer.Close;
 FreeAndNil(FMediaPlayer);
 inherited Destroy;
end;

procedure TGTTS.SpeechNow(const AText: string; const ADontStopWhilePlaying: Boolean);
begin
 SpeechNow(AText,FMediaPlayer,ADontStopWhilePlaying);
end;

procedure TGTTS.SpeechNow(const AText: string; const AMediaPlayer: TMediaPlayer; const ADontStopWhilePlaying: Boolean);
var
 lFileName: TFileName;
begin
 lFileName := TextToSpeech(AText);
 if not FileExists(lFileName) then
   Exit;
 with AMediaPlayer do
 begin
   Close;
   FileName := lFileName;
   Open;
   Play;
   if ADontStopWhilePlaying then
   begin
     while Mode = mpPlaying do
       Application.ProcessMessages;
     Stop;
     Close;
   end;
 end;
end;

function TGTTS.TextToSpeech(const AText: String): TFileName;
var
 lHttp: TIdHTTP;
 lStream: TMemoryStream;
 lUrl, lFileName: string;
 lTempFile: array[0..MAX_PATH] of Char;
begin
 Result := '';
 if FUseCache then
 begin
   if not DirectoryExists(FTempPath + FAppDir) then
     CreateDirectory(PWideChar(FTempPath + FAppDir), nil);
   if not DirectoryExists(FTempPath + FAppDir + '\' + FSpeechDir) then
     CreateDirectory(PWideChar(FTempPath + FAppDir + '\' + FSpeechDir), nil);
   lFileName := FTempPath + FAppDir + '\' + FSpeechDir + '\' + AText + ' [' +FLanguage+ '].mp3'
 end
 else
 begin
   GetTempFileName(PWideChar(FTempPath), 'tts', 0, lTempFile);
   lFileName := ChangeFileExt(lTempFile, '.mp3');
 end;
 if (not FUseCache) or (not FileExists(lFileName)) then
 begin
   lStream := TMemoryStream.Create;
   try
     lUrl := TIdURI.URLEncode(Format(sURL, [FLanguage, AText]));
     FLastCalledURL := lUrl;
     lHttp := TIdHTTP.Create(nil);
     try
       lHttp.ConnectTimeout := sTimeOut;
       lHttp.ReadTimeout := sTimeOut;
       lHttp.Request.AcceptCharSet := 'UTF-8';
       lHttp.Get(lUrl, lStream);
     finally
       FreeAndNil(lHttp);
     end;
     if lStream.Size > 0 then
     begin
       lStream.Seek(0, 0);
       lStream.SaveToFile(lFileName);
     end;
   finally
     FreeAndNil(lStream);
   end;
 end;
 if FileExists(lFileName) then
 begin
   Result := lFileName;
   FLastConvertedMp3 := lFileName;
 end;
end;

end.

用法:
procedure TForm1.Button1Click(Sender: TObject);<br>
var<br>
 lGtts: TGTTS;<br>
begin<br>
 lGtts := TGTTS.Create(Self);<br>
 try<br>
   lGtts.SpeechNow('www.delphitop.com');<br>
 finally<br>
   FreeAndNil(lGtts);<br>
 end;<br>
end;

上一篇:Delphi 加载Excel 导入数据库下一篇:没有资料