unit Unit3;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Idhttp,
IdMultipartFormData, IdBaseComponent, IdComponent, IdIOHandler,
IdIOHandlerSocket, IdIOHandlerStack, IdSSL, IdSSLOpenSSL, Httpapp,
System.JSON, NB30, mmsystem;
type
TForm3 = class(TForm)
Label1: TLabel;
Edit1: TEdit;
Edit2: TEdit;
Label2: TLabel;
ComboBox1: TComboBox;
Label3: TLabel;
Label4: TLabel;
ComboBox2: TComboBox;
Label5: TLabel;
ComboBox3: TComboBox;
Label6: TLabel;
ComboBox4: TComboBox;
Label7: TLabel;
ComboBox5: TComboBox;
Edit3: TEdit;
Label8: TLabel;
Button1: TButton;
Button2: TButton;
Memo1: TMemo;
IdSSLIOHandlerSocketOpenSSL1: TIdSSLIOHandlerSocketOpenSSL;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
access_token: String;
session_key: String;
refresh_token: String;
session_secret: String;
expires_in: String;
end;
var
Form3: TForm3;
implementation
{$R *.dfm}
function GetAdaPterInfo(lana: AnsiChar): string;
var
Adapter: TAdapterStatus;
NCB: TNCB;
begin
FillChar(NCB, Sizeof(NCB), 0);
NCB.ncb_command := Char(NCBRESET);
NCB.ncb_lana_num := lana;
if Netbios(@NCB) <> Char(NRC_GOODRET) then
begin
Result := 'mac not found';
exit;
end;
FillChar(NCB, Sizeof(NCB), 0);
NCB.ncb_command := Char(NCBASTAT);
NCB.ncb_lana_num := lana;
NCB.ncb_callname := '*';
FillChar(Adapter, Sizeof(Adapter), 0);
NCB.ncb_buffer := @Adapter;
NCB.ncb_length := Sizeof(Adapter);
if Netbios(@NCB) <> Char(NRC_GOODRET) then
begin
Result := 'mac not found';
exit;
end;
Result := IntToHex(Byte(Adapter.adapter_address[0]), 2) + '_' +
IntToHex(Byte(Adapter.adapter_address[1]), 2) + '_' +
IntToHex(Byte(Adapter.adapter_address[2]), 2) + '_' +
IntToHex(Byte(Adapter.adapter_address[3]), 2) + '_' +
IntToHex(Byte(Adapter.adapter_address[4]), 2) + '_' +
IntToHex(Byte(Adapter.adapter_address[5]), 2);
end;
function GetMACAddress: string;
var
AdapterList: TLanaEnum;
NCB: TNCB;
begin
FillChar(NCB, Sizeof(NCB), 0);
NCB.ncb_command := Char(NCBENUM);
NCB.ncb_buffer := @AdapterList;
NCB.ncb_length := Sizeof(AdapterList);
Netbios(@NCB);
if Byte(AdapterList.length) > 0 then
Result := GetAdaPterInfo(AdapterList.lana[0])
else
Result := 'mac not found';
end;
procedure TForm3.Button1Click(Sender: TObject);
var
HttpClient: TIdHttp;
postStream: TIdMultiPartFormDataStream;
ss: TStringStream;
HttpResult: String;
ConJson: TJSONObject;
begin
if (Edit1.Text = '') or (Edit2.Text = '') then
exit;
HttpClient := TIdHttp.Create();
HttpClient.IOHandler := IdSSLIOHandlerSocketOpenSSL1;
postStream := TIdMultiPartFormDataStream.Create;
ss := TStringStream.Create('', TEncoding.UTF8);
try
postStream.AddFormField('grant_type', 'client_credentials');
postStream.AddFormField('client_id', Edit1.Text);
postStream.AddFormField('client_secret', Edit2.Text);
try
HttpClient.Post('https://openapi.baidu.com/oauth/2.0/token',
postStream, ss);
HttpResult := ss.DataString;
ConJson := TJSONObject.ParseJSONValue(TEncoding.UTF8.GetBytes(HttpResult),
0) as TJSONObject;
if ConJson.GetValue('access_token') <> nil then
begin
access_token := ConJson.GetValue('access_token').Value;
session_key := ConJson.GetValue('session_key').Value;
refresh_token := ConJson.GetValue('refresh_token').Value;
session_secret := ConJson.GetValue('session_secret').Value;
expires_in := ConJson.GetValue('expires_in').Value;
Button2.Enabled := true;
Memo1.Lines.Add('初始化成功');
end;
except
on e: Exception do
begin
Memo1.Lines.Add(e.ToString);
exit;
end;
end;
finally
HttpClient.Free;
postStream.Free;
ss.Free;
end;
end;
procedure TForm3.Button2Click(Sender: TObject);
var
HttpClient: TIdHttp;
PostData: TStringStream;
MyStream: TMemoryStream;
ss: TStringStream;
HttpResult: String;
ConJson: TJSONObject;
str: String;
s: AnsiString;
p: PAnsiChar;
begin
if Edit3.Text = '' then
begin
exit;
end;
str := '';
MyStream := TMemoryStream.Create;
HttpClient := TIdHttp.Create();
HttpClient.IOHandler := IdSSLIOHandlerSocketOpenSSL1;
ss := TStringStream.Create('', TEncoding.UTF8);
try
// 合成的文本,使用UTF-8编码。小于2048个中文字或者英文数字。(文本在百度服务器内转换为GBK后,长度必须小于4096字节)
str := 'tex=' + HttpEncode(HttpEncode(UTF8Encode(Edit3.Text)));
// 开放平台获取到的开发者access_token(见上面的“鉴权认证机制”段落)
str := str + '&tok=' + access_token + '&cuid=' + GetMACAddress + '&ctp=1';
str := str + '&lan=zh&spd=' + ComboBox1.Text + '&pit=' + ComboBox2.Text;
str := str + '&vol=' + ComboBox3.Text + '&per=' +
inttostr(ComboBox4.ItemIndex);
if ComboBox5.ItemIndex = 0 then
begin
str := str + '&aue=3';
end
else
begin
str := str + '&aue=6';
end;
try
// PostData := TStringStream.Create('str', TEncoding.UTF8);
// HttpClient.Post('https://tsn.baidu.com/text2audio', PostData, ss);
HttpClient.Get('https://tsn.baidu.com/text2audio?' + str, MyStream);
HttpResult := HttpClient.Response.ContentType;
if HttpResult.Contains('audio') then
begin
MyStream.SaveToFile('tts_sample.' + ComboBox5.Text);
Memo1.Lines.Add('合成成功');
end
else
begin
GetMem(p, MyStream.Size + 1);
FillChar(p^, MyStream.Size, 0);
Move(MyStream.Memory^, p^, MyStream.Size);
s := p;
FreeMem(p);
Memo1.Lines.Add(s);
end;
except
on e: Exception do
begin
Memo1.Lines.Add(e.ToString);
exit;
end;
end;
finally
if PostData <> nil then
begin
PostData.Free;
end;
HttpClient.Free;
ss.Free;
MyStream.Free;
end;
str := ExtractFilePath(ParamStr(0)) + 'tts_sample.' + ComboBox5.Text;
if (FileExists(str)) and (ComboBox5.Text = 'wav') then
begin
sndPlaySound(Pchar(str), SND_ASYNC OR SND_NOWAIT);
end;
end;
procedure TForm3.FormCreate(Sender: TObject);
var
I: integer;
begin
ComboBox1.Clear;
ComboBox2.Clear;
ComboBox3.Clear;
for I := 0 to 15 do
begin
ComboBox1.Items.Add(inttostr(I));
ComboBox2.Items.Add(inttostr(I));
ComboBox3.Items.Add(inttostr(I));
end;
ComboBox1.ItemIndex := 5;
ComboBox2.ItemIndex := 5;
ComboBox3.ItemIndex := 5;
end;
end.