DELPHI盒子
!实时搜索: 盒子论坛 | 注册用户 | 修改信息 | 退出
检举帖 | 全文检索 | 关闭广告 | 捐赠
技术论坛
 用户名
 密  码
自动登陆(30天有效)
忘了密码
≡技术区≡ ①
DELPHI技术
lazarus/fpc/Free Pascal
移动应用开发
Web应用开发
数据库专区
报表专区
网络通讯
开源项目
论坛精华贴
≡发布区≡ ②
发布代码
发布控件
文档资料
经典工具
≡事务区≡ ③
网站意见
盒子之家
招聘应聘
信息交换
论坛信息
最新加入： wjy13061029975
今日帖子： 1
在线用户： 4
导航： 论坛 -> 文档资料 斑竹:liumazi,ruralboy  
作者：
男 jopher3 (樵夫的马六甲) ▲▲▲▲▲ -
普通会员
2013/10/13 22:23:01
标题：
XE5实现手机上的“互联网语音广播” 浏览:4731
加入我的收藏
楼主： 1、概述
    利用手机端的媒体采集设备加上网络服务器的消息群发功能，可以轻松实现资源即时采集、即时分发功能。这里给出一个Delphi XE5+QuickBurro应用服务器实现的“网联网语音广播”示例，抛砖引玉，希望对大家有所启迪。

2、看设计时界面：
此帖子包含附件:
JPEG 图像
大小:108.7K
----------------------------------------------
樵夫的大马甲
作者：
男 jopher3 (樵夫的马六甲) ▲▲▲▲▲ -
普通会员
2013/10/13 22:25:27
1楼： 3、看主要部分的源码：
//
// 开始录音...
procedure TMainForm.Button2Click(Sender: TObject);
begin
//
// 先停止可能的发声...
  if Assigned(Speaker) then
    if Assigned(Speaker.Media) then
      Speaker.Stop;
//
// 开始录音...
  Microphone := TCaptureDeviceManager.Current.DefaultAudioCaptureDevice;
  if Assigned(Microphone) then
    begin
      Microphone.FileName := TPath.GetHomePath+PathDelim+ 'tmpsend.3GP';
      try
        Microphone.StartCapture;
        Image2.Visible := True;
      except
        Image2.Visible := False;
        ShowMessage('错误：不支持录音！');
      end;
    end
  else
    ShowMessage('错误：麦克风不存在！');
end;

//
// 停止录音...
procedure TMainForm.Button3Click(Sender: TObject);
var
  MailId: string;
  Parcel: TMBParcel;
  Stream: TMemoryStream;
begin
  if Assigned(Microphone) then
    try
      if Microphone.State = TCaptureDeviceState.Capturing then
        begin
          Microphone.StopCapture;
          Image2.Visible := False;
          //
          // 生成音频文件...
          Stream:=TMemoryStream.Create;
          Stream.LoadFromFile(TPath.GetHomePath+PathDelim+ 'tmpsend.3GP');
          if stringgrid2.RowCount=0 then
          stringgrid2.RowCount:=1;
          stringgrid2.Cells[0,0]:='最后发送的语音 - '+inttostr(Stream.Size)+'字节';
          //
          // 分配Id...
          if not MainForm.mba.GenerateId('MailBox','MailId','SUBSTRING(MAILID,1,6)='''+formatdatetime('yymmdd',now)+'''','YYMMDDXXXX','',MailId) then
          begin
          showmessage('无法取消息号，发送失败！');
          exit;
          end;
          //
          // 保存消息到收件箱...
          Parcel:=TMBParcel.Create;
          Parcel.PutStringGoods('MailId',MailId);
          Parcel.PutStringGoods('MailType','9');
          Parcel.PutStringGoods('UserId','');
          Parcel.PutStringGoods('UserName','');
          Parcel.PutStringGoods('FromUserId',MainForm.s_UserId);
          Parcel.PutStringGoods('FromUserName',MainForm.s_username);
          Parcel.PutStringGoods('MailSubject','语音');
          Parcel.PutStreamGoods('MailBody',Stream);
          Parcel.PutStringGoods('PostDateTime',formatdatetime('yymmddhhnnss',now));
          Parcel.PutStringGoods('HasRead','　');
          FreeAndNil(Stream);
          if not mainform.MBA.AppendRecord('MailBox',Parcel) then
          begin
          FreeAndNil(Parcel);
          showmessage('写数据库未成功，发送失败！'+#13#10+'Error: '+MBA.LastError);
          exit;
          end;
          //
          // 向所有连接群发消息...
          Parcel.Clear;
          Parcel.PutStringGoods('MailId',MailId);
          Parcel.PutStringGoods('MailType','9');
          MainForm.Poster.PostToWebAllSessions(Parcel);
          FreeANdNil(Parcel);
          showmessage('您的语音已经发送！');
        end;
    except
      Image2.Visible := False;
      ShowMessage('错误：不支持录音！');
    end;
end;

//
// 重新发送...
procedure TMainForm.Button4Click(Sender: TObject);
var
  MailId: string;
  Parcel: TMBParcel;
  Stream: TMemoryStream;
begin
  if not fileexists(TPath.GetHomePath+PathDelim+ 'tmpsend.3GP') then
     begin
       showmessage('文件不存在，无法重发！');
       exit;
     end;
//
// 生成音频文件...
  Stream:=TMemoryStream.Create;
  Stream.LoadFromFile(TPath.GetHomePath+PathDelim+ 'tmpsend.3GP');
  if stringgrid2.RowCount=0 then
     stringgrid2.RowCount:=1;
  stringgrid2.Cells[0,0]:='最后发送的语音 - '+inttostr(Stream.Size)+'字节';
//
// 分配Id...
  if not MainForm.mba.GenerateId('MailBox','MailId','SUBSTRING(MAILID,1,6)='''+formatdatetime('yymmdd',now)+'''','YYMMDDXXXX','',MailId) then
     begin
        showmessage('无法取消息号，发送失败！');
        exit;
     end;
//
// 生成消息包...
  Parcel:=TMBParcel.Create;
  Parcel.PutStringGoods('MailId',MailId);
  Parcel.PutStringGoods('MailType','9');
  Parcel.PutStringGoods('UserId','');
  Parcel.PutStringGoods('UserName','');
  Parcel.PutStringGoods('FromUserId',MainForm.s_UserId);
  Parcel.PutStringGoods('FromUserName',MainForm.s_username);
  Parcel.PutStringGoods('MailSubject','语音');
  Parcel.PutStreamGoods('MailBody',Stream);
  Parcel.PutStringGoods('PostDateTime',formatdatetime('yymmddhhnnss',now));
  Parcel.PutStringGoods('HasRead','　');
  FreeAndNil(Stream);
  if not mainform.MBA.AppendRecord('MailBox',Parcel) then
     begin
        FreeAndNil(Parcel);
        showmessage('写数据库未成功，发送失败！'+#13#10+'Error: '+MBA.LastError);
        exit;
     end;
//
// 群发消息...
   Parcel.Clear;
   Parcel.PutStringGoods('MailId',MailId);
   Parcel.PutStringGoods('MailType','9');
   MainForm.Poster.PostToWebAllSessions(Parcel);
   FreeANdNil(Parcel);
   showmessage('您的语音已经发送！');
end;
//
// 消息送达时，刷新消息列表...
procedure TMainForm.ReceiverMessageArrives(Sender: TObject;
  NewMsgCount: Integer);
var
   Parcel: TMBParcel;
   mailtype,mailid: string;
   k: integer;
begin
   k:=0;
   while Receiver.PopMessage(Parcel) do
      begin
         mailtype:=parcel.GetStringGoods('MailType');
         MailId:=parcel.GetStringGoods('MailId');
         FreeANdNil(Parcel);
         if MailType='9' then
          begin
          if MBA.ReadDataset('SELECT * FROM MAILBOX WHERE MAILID='''+mailid+'''',Cds) then
          begin
          TBlobField(Cds.FieldByName('MailBody')).SaveToFile(s_defaultdir+'tmpreceived.3GP');
          speaker.FileName:=s_defaultdir+'tmpreceived.3GP';
          if stringgrid1.RowCount=0 then
          stringgrid1.RowCount:=1;
          stringgrid1.Cells[0,0]:='最后收到的语音 - '+inttostr(TBlobField(Cds.FieldByName('MailBody')).BlobSize)+'字节';
          Cds.Close;
          if Assigned(Speaker.Media) then
          MainForm.Speaker.Play;
          end;

          end
         else
          inc(k);
      end;
//
// 普通消息...
   if k>0 then
      begin
         ShowMailList;
         if s_soundprompt then
          MsgArriveSound;
         if s_autopopup then
          SendStatusbarMsg('SysPrompt','收到了['+inttostr(NewMsgCount)+']条新消息！');
      end;
end;
//
// 重播...
procedure TMainForm.Button1Click(Sender: TObject);
begin
   speaker.FileName:=s_defaultdir+'tmpreceived.3GP';
   if Assigned(Speaker.Media) then
     MainForm.Speaker.Play;
end;


4、看运行结果：
此帖子包含附件:
JPEG 图像
大小:42.2K
----------------------------------------------
樵夫的大马甲
作者：
男 jopher3 (樵夫的马六甲) ▲▲▲▲▲ -
普通会员
2013/10/13 22:27:36
2楼： 5、结论
1)、利用此方法不仅可以群发语音，也可以点对点私聊
2）、同理，可以群发照片、广告页面等媒体信息
----------------------------------------------
樵夫的大马甲
作者：
男 hellokino (hello，delphi) ▲▲▲▲▲ -
普通会员
2013/10/13 22:37:50
3楼： GOOD
----------------------------------------------
-
作者：
男 tintin1943 (零输好) ★☆☆☆☆ -
盒子活跃会员
2013/10/13 22:43:07
4楼： 樵夫，你要抢 电信运营商的饭碗啊？
----------------------------------------------
不喧哗 自有声 心静 思远 志行千里
作者：
男 mllxt (番茄≯炒蛋) ★☆☆☆☆ -
普通会员
2013/10/14 1:09:57
5楼： 其实我觉得樵夫的三层挺不错的，目前正在使用中。。
----------------------------------------------
-
作者：
男 nevergrief (孤独骑士) ★☆☆☆☆ -
盒子活跃会员
2013/10/14 5:36:32
6楼： 够牛，留个爪印。
----------------------------------------------
只有偏执狂才能生存！
作者：
男 shileizi (sl) ★☆☆☆☆ -
普通会员
2013/10/14 8:49:57
7楼： mark
----------------------------------------------
-
作者：
女 hecongzhen (令狐**) ★☆☆☆☆ -
普通会员
2013/10/14 9:09:26
8楼： ...mark
----------------------------------------------
-
作者：
男 qiuyan81 (苦恋树) ★☆☆☆☆ -
普通会员
2013/10/14 9:09:54
9楼： 晕死,录音+Socket
----------------------------------------------
作者：
男 bdwzf (bdwzf) ★☆☆☆☆ -
盒子活跃会员
2013/10/14 9:32:36
10楼： 能否给个完整的打包，测试测试！
----------------------------------------------
-
作者：
男 jopher3 (樵夫的马六甲) ▲▲▲▲▲ -
普通会员
2013/10/14 12:02:24
11楼： 哦，程序发不上来
已经发到一些qq群里：

XE5安卓应用（以z3,zs登录）.apk
----------------------------------------------
樵夫的大马甲
作者：
男 patebeng2 (patebeng2) ▲▲△△△ -
普通会员
2022/2/18 10:18:45
12楼： “50万彩礼”真相：两代人择业观的激烈踫撞水泵辽宁新增15例本土确诊泵厂家郑州原市长侯红任河南卫健委副主任

水泵公司王亚平空间站弹古筝送元宵祝福球阀大范围雨雪将上线 超25省份受影响
焊接球阀
全焊接球阀
直埋全焊接球阀
埋地全焊接球阀
泵
水泵
离心泵
上海离心泵
水泵厂
水泵厂家
泵厂家
帕特
上海水泵厂
上海水泵公司
螺杆泵
污泥螺杆泵13
上海螺杆泵
球阀厂10
Fully Welded Ball Valve
all Welded Ball Valve
全焊接阀门
球阀


全焊接球阀
焊接球阀
泵厂家
泵
螺杆泵
帕特
----------------------------------------------
磁力泵
螺杆泵
污泥螺杆泵
离心泵
化工泵
作者：
男 yxsoft (yxsoft) ★☆☆☆☆ -
盒子活跃会员
2022/2/18 12:57:34
13楼： 这是微信群的私有化部署吗
----------------------------------------------
Great!
信息
登陆以后才能回复
Copyright © 2CCC.Com 盒子论坛 v3.0.1 版权所有 页面执行99.60938毫秒 RSS