sendstreamthread.pas

局域网VCD影院 用DELPHI 编写的 局域网VCD影院

//服务器端程序:
unit SendStreamThread;
interface

uses
  Windows, Messages, Unit_FrmVideo, StartPlayThread, SysUtils, Mpeg1DataFormat, Classes, CommonUnit, MyDef, WinSock;

type
  TSendStreamThread = class(TThread)
  private
    MyMpeg1: TMpeg1DataFormat;
    iMulticastGroup: integer; //组播组序号
    SendBuf, PlayBuf: PBYTE; //发送缓冲区和播放缓冲区
    iSleepTime: integer; //暂停时间
    IsStart: Boolean;
    VideoParkFrame: array[1..VideoPackSize] of byte;
    DbgPrint: string;
    procedure InitVedioConfig;
    procedure UnitVedioConfig;
    procedure DbgOut;
    procedure DebugOut(DbgInfoStr: string);
    procedure SendMpegHead(const Local: Boolean = False);
  protected
    procedure Execute; override;
  public
    iMaxFram: integer;
    iStartPos: integer;
    constructor Create(const Filename: string; const iPos: integer; const Suspend, Start: Boolean; const MulticastGroup: integer; const MySleep: integer = 8);
    constructor Terminate; //强行结束
    destructor Destroy; override; //正常结束
  end;

implementation
uses
  Unit_FrmMain, Mpeg1DecodeDll, SendMsgSock;
var
  Wsa: TWSAData;
  addr_to: sockaddr_in;
  FSocket: TSocket;
  mreq: ip_mreq;
{ TSendStreamThread }

constructor TSendStreamThread.Create(const Filename: string; const iPos: integer; const Suspend, Start: Boolean; const MulticastGroup: integer; const MySleep: integer = 8);
begin
  inherited Create(Suspend);
  MyMpeg1 := TMpeg1DataFormat.Create(Pchar(Filename));
  iMulticastGroup := MulticastGroup; //组播组序号
  iMaxFram := MyMpeg1.iFramCout;
  iSleepTime := MySleep;
  iStartPos := iPos;
  IsStart := Start;
  Priority := tpHighest;
  FreeOnTerminate := True;
  InitVedioConfig; //初始化配置
end;

destructor TSendStreamThread.Destroy; //正常结束
var
  wOldErrorMode: Word;
begin
//-------------------------
  wOldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
  try
    FrmMain.ThreadActive := False;
    FrmMain.Timer1.Enabled := False;
    UnitVedioConfig; //释放配置资源
    MyMpeg1.Free;
    Mpeg1Decode_StopVideo;
    Mpeg1Decode_CloseVideo;
    Mpeg1Decode_UnInit;
    FrmMain.Mousebar1.Position := 0;
    FrmMain.Mousebar1.Enabled := False;
    FrmMain.btFile.Enabled := True;
    FrmMain.btVcd.Enabled := FrmMain.btFile.Enabled;
  finally
    SetErrorMode(wOldErrorMode);
  end;
//--------------------------------
  inherited destroy;
end;

constructor TSendStreamThread.Terminate; //强行结束
begin
  FrmMain.ThreadActive := False;
  FrmMain.Timer1.Enabled := False;
  MyMpeg1.Free;
  UnitVedioConfig; //释放配置资源
  inherited Terminate;
end;


procedure TSendStreamThread.SendMpegHead(const Local: Boolean = False);
var
  i, iTime: integer;
  iHour, iMinute, iSecond: byte;
begin
  iTime := iStartPos div 75;
  if iTime < 60 then
  begin {小于1分钟}
    iHour := 0;
    iMinute := 0;
    iSecond := iTime;
  end
  else
  begin {大于1分钟}
    if iTime < 3600 then {小于1小时}
    begin
      iHour := 0;
      iMinute := iTime div 60;
      iSecond := iTime mod 60;
    end
    else {大于等于1小时}
    begin
      iHour := iTime div 3600;
      iTime := iTime - iHour * 3600;
      iMinute := iTime div 60;
      iSecond := iTime mod 60;
    end;
  end;
//--------上面为时间计算--------------------------
//SendMpegHeadMark(iMulticastGroup);//发送头标志
  ZeroMemory(@VideoParkFrame, VideoPackSize);
  VideoParkFrame[1] := byte('C');
  VideoParkFrame[2] := byte('J');
  VideoParkFrame[3] := byte('T');
  VideoParkFrame[4] := byte('A');
  VideoParkFrame[5] := iHour;
  VideoParkFrame[6] := iMinute;
  VideoParkFrame[7] := iSecond;
//Move(VideoParkFrame,SendBuf^,VideoPackSize); //效率比CopyMemory高,但是占用Cpu
  CopyMemory(SendBuf, @VideoParkFrame, VideoPackSize);
  Sendto(FSocket, SendBuf^, VideoPackSize, 0, addr_to, sizeof(addr_to));
  Sleep(iSleepTime);
//------------上面为发送头标记---------------------

  for i := 0 to 27 do
  begin
    if not MyMpeg1.GetMpegDateToByte(PlayBuf, i) then Break;
    VideoParkFrame[1] := byte('C');
    VideoParkFrame[2] := byte('J');
    VideoParkFrame[3] := byte('T');
    VideoParkFrame[4] := byte('H');
{
如果play是pchar
   Move(PlayBuf   这是错的，而必须是
   Move(PlayBuf^

如果play是array[..]of char
   Move(PlayBuf
}
//Move(PlayBuf^,VideoParkFrame[5],MpegFrameSize); //效率比CopyMemory高,但是占用Cpu
//Move(VideoParkFrame,SendBuf^,VideoPackSize);
    CopyMemory(@VideoParkFrame[5], PlayBuf, MpegFrameSize);
    CopyMemory(SendBuf, @VideoParkFrame, VideoPackSize);
    Sendto(FSocket, SendBuf^, VideoPackSize, 0, addr_to, sizeof(addr_to));
    Sleep(iSleepTime);
  end;
end;

procedure TSendStreamThread.Execute;
var
  SendBytes: LONGLONG;
  i, iPackCount: integer;
  nIndex: integer;
  StartPlayThread: TStartPlayThread;
begin
  FrmMain.ThreadActive := True;
  iPackCount := 0;
  nIndex := 0;
  for i := 0 to 27 do
  begin
    MyMpeg1.GetMpegDateToByte(PlayBuf, i);
    SendBytes := Mpeg1Decode_SendBuf(PlayBuf, MpegFrameSize);
  end;


  while (not Terminated) and (iStartPos < iMaxFram) do
  begin
    if not MyMpeg1.GetMpegDateToByte(PlayBuf, iStartPos) then ; // Terminate;
    VideoParkFrame[1] := byte('C');
    VideoParkFrame[2] := byte('J');
    VideoParkFrame[3] := byte('T');
    VideoParkFrame[4] := byte('P');
       //Move(PlayBuf^,VideoParkFrame[5],MpegFrameSize); //效率比CopyMemory高,但是占用Cpu
       //Move(VideoParkFrame,SendBuf^,VideoPackSize);
       {Pchar(SendBuf)[0]:='C';Pchar(SendBuf)[1]:='J';// plongword(SendBuf)^:=...
       Pchar(SendBuf)[2]:='T';Pchar(SendBuf)[3]:='P';
       //Move(Playbuf^,Pchar(SendBuf)[4],MpegFrameSize);//这样一来就可以放弃VideoParkFrame了
       CopyMemory(@(Pchar(SendBuf)[4]),Playbuf,MpegFrameSize); }
    CopyMemory(@VideoParkFrame[5], PlayBuf, MpegFrameSize); //复制内存PlayBuf->VideoParkFrame
    CopyMemory(SendBuf, @VideoParkFrame, VideoPackSize);
    SendBytes := Mpeg1Decode_SendBuf(PlayBuf, MpegFrameSize); //发送数据到本地视屏缓冲区

           //当发送失败的时候
    while (SendBytes <= 0) and (not Terminated) do begin
      SendBytes := Mpeg1Decode_SendBuf(PlayBuf, MpegFrameSize);
      DebugOut('SendByte Error');
      Sleep(iSleepTime + 2);
    end;
    Sendto(FSocket, SendBuf^, VideoPackSize, 0, addr_to, sizeof(addr_to));
    Inc(nIndex);
    if (nIndex mod 75 * 2 = 0) then
    begin
      SendMpegHead;
      nIndex := 0;
    end;
    Sleep(iSleepTime);
    Inc(iStartPos);

//----------循环播放---------------------------
    if iStartPos + 30 >= MyMpeg1.iFramCout then
      if FrmMain.btLoop.Down then
      begin
   //FrmMain.UdpBroadSender.BroadStr(ResultTState);
        iStartPos := 0;
        iPackCount := 0;
        IsStart := False;
        Mpeg1Decode_StopVideo;
        Mpeg1Decode_CloseVideo;
        Mpeg1Decode_UnInit;
        Mpeg1Decode_Init;
        for i := 0 to 27 do
        begin
          MyMpeg1.GetMpegDateToByte(PlayBuf, i);
          SendBytes := Mpeg1Decode_SendBuf(PlayBuf, MpegFrameSize);
        end;
      end
      else
      begin
        SendMsg_Stop(iMulticastGroup); Sleep(10);
        SendMsg_Stop(iMulticastGroup); Sleep(10);
        SendMsg_Stop(iMulticastGroup); Sleep(10);
//Terminate;
  //closesocket(FSocket);
        PostMessage(FrmMain.Handle, WM_ThreadMsg, Msg_ThreadDone, 0); //发送消息
      end;
//---------------------------------------------
    if iPackCount = 10 then
    begin
      StartPlayThread := TStartPlayThread.Create(MpegFrameSize * 28, True, IsStart);
      StartPlayThread.FreeOnTerminate := True;
      StartPlayThread.Priority := tpHighest;
      StartPlayThread.Resume;
    end;

    Inc(iPackCount);

  end;

// PostMessage(FrmMain.Handle,WM_ThreadMsg,Msg_ThreadDone,0); //发送消息
end;

procedure TSendStreamThread.InitVedioConfig;
var
  t: linger;
begin
  PlayBuf := GetMemory(MpegFrameSize); //分配读文件块要保存的内存
  SendBuf := GetMemory(VideoPackSize); //分配向网络发包的内存
  FSocket := Socket(AF_INET, SOCK_DGRAM, 0); //初始化socket
  if FSocket = SOCKET_ERROR then MessageBox(0, 'Socket() Failed', MpgServerName, MB_ICONERROR);
    { BroadCast:=True; //广播
     if setsockopt(FSocket,SOL_SOCKET,SO_BROADCAST, @BroadCast,sizeof(BroadCast))=SOCKET_ERROR
     then MessageBox(0,'set sock option failed',MpgServerName,MB_ICONERROR);  }

  mreq.imr_multiaddr.S_addr := inet_addr(TMulticastIp[iMulticastGroup]); //htonl(INADDR_ALLHOSTS_GROUP);
  mreq.imr_interface.S_addr := htonl(INADDR_ANY);
  if setsockopt(FSocket, IPPROTO_IP, IP_ADD_MEMBERSHIP, pchar(@mreq), sizeof(mreq)) = SOCKET_ERROR then
  begin
   //MessageBox(0,'无法进行UDP组播','',0);
  end;
     //绑定要发送的Udp包的socketaddr_in结构
  ZeroMemory(@addr_to, sizeof(sockaddr_in));
  addr_to.sin_family := AF_INET;
  addr_to.sin_port := htons(TMulticastPort[iMulticastGroup]);
  addr_to.sin_addr.S_addr := inet_addr(TMulticastIp[iMulticastGroup]); //INADDR_BROADCAST;
  t.l_onoff := 1;
  t.l_linger := 0;
  setsockopt(FSocket, SOL_SOCKET, SO_LINGER, @t, sizeof(t));
     // addr_to.SIn_Addr.S_addr := inet_addr(pchar('234.5.6.7'));
end;

procedure TSendStreamThread.UnitVedioConfig;
begin
   //释放内存
  if PlayBuf <> nil then FreeMemory(PlayBuf);
  if SendBuf <> nil then FreeMemory(SendBuf);
   //关闭Socket句柄
  setsockopt(FSocket, IPPROTO_IP, IP_DROP_MEMBERSHIP, pchar(@mreq), sizeof(mreq)); //离开组播组
  if FSocket <> Invalid_SOCKET then CloseSocket(FSocket);
end;

procedure TSendStreamThread.DbgOut;
begin
  FrmMain.DbgMemo.Lines.Add(DbgPrint);
end;

procedure TSendStreamThread.DebugOut(DbgInfoStr: string);
begin
   //输出调试信息
  DbgPrint := DbgInfoStr;
  Synchronize(dbgout);
end;
var
  Re: integer;
initialization
  Re := WSAStartup($101, Wsa); //初始化Wsock32.dll,MakeWord(2,2),
  if Re <> 0 then MessageBox(0, 'WSAStartup Failed', MpgServerName, MB_ICONERROR);
finalization
  WSACleanup; //结束对WSocket32.dll调用
end.