Delphi Google Text To Speech API-木庄网络博客

本文整理自网络，侵删。
 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 Google Text To Speech API

相关推荐

评论
