程序代码下载地址真的很郁闷哦 师傅帮帮忙下载

解决方案 »

  1.   

    unit Unit1;interfaceuses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, StdCtrls, ExtCtrls,VFW, IdBaseComponent, IdComponent, IdUDPBase,
      IdUDPClient,jpeg, IdUDPServer, IdSocketHandle, ComCtrls, ACMIn,
      ACMConvertor, ACMOut, IdTCPConnection, IdTCPClient;const
     Host = '218.9.85.124';
     LoginPort = 9001;
     Login = 'Login';
     OutLogin = 'OutLogin';
     Status = 'Status';type
      TForm1 = class(TForm)
        Panel1: TPanel;
        Button1: TButton;
        Button2: TButton;
        Panel2: TPanel;
        StatusBar: TStatusBar;
        Button3: TButton;
        ACMConvertor: TACMConvertor;
        ACMIn: TACMIn;
        Panel3: TPanel;
        Image: TImage;
        UDPServer: TIdUDPServer;
        ACMOut: TACMOut;
        TCPClient: TIdTCPClient;
        RadioButton1: TRadioButton;
        RadioButton2: TRadioButton;
        Button4: TButton;
        GroupBox1: TGroupBox;
        Label1: TLabel;
        Timer: TTimer;
        procedure Button1Click(Sender: TObject);
        procedure Button2Click(Sender: TObject);
        procedure Button3Click(Sender: TObject);
        procedure ACMInBufferFull(Sender: TObject; Data: Pointer;
          Size: Integer);
        procedure UDPServerUDPRead(Sender: TObject; AData: TStream;
          ABinding: TIdSocketHandle);
        procedure FormCreate(Sender: TObject);
        procedure FormClose(Sender: TObject; var Action: TCloseAction);
        procedure Button4Click(Sender: TObject);
        procedure TimerTimer(Sender: TObject);
      private
        { Private declarations }
      public
        { Public declarations }
      end;var
      Form1: TForm1;
      CapWnd:THandle;
      CapParms:TcaptureParms;
      BMPINFO:TBitmapInfo;
      AudioFormat:TACMWaveFormat;
      DataPort:Integer=0;
      SelectServer:Integer=1;
    implementation{$R *.dfm}
    function  FrameCallBack(hWnd: HWND; lpVHdr: PVIDEOHDR): LongInt;stdcall;
    var  hd:Thandle;
         jpg:TJpegImage;
         memStream :TMemoryStream;
         Bitmap:TBitmap;
    begin
       Bitmap:=TBitmap.Create;
       Bitmap.Width :=BMPINFO.bmiHeader.biWidth;
       Bitmap.Height:=BMPINFO.bmiHeader.biHeight;
       hd:= DrawDibOpen;
       DrawDibDraw(HD,Bitmap.canvas.handle,0,0,BMPINFO.BmiHeader.biwidth,BMPINFO.bmiheader.biheight,@BMPINFO.bmiHeader,
                       lpVHdr^.lpData,0,0,BMPINFO.bmiHeader.biWidth,BMPINFO.bmiHeader.biheight,0);
       DrawDibClose(hd);
       memStream := TMemoryStream.Create;
       jpg := TJpegImage.Create;
       jpg.Assign(Bitmap);
       jpg.CompressionQuality := 30;
       jpg.JPEGNeeded;
       jpg.Compress;
       jpg.SaveToStream(memStream);
       jpg.Free;
       if memStream.Size>Form1.UDPServer.BufferSize then
            Form1.UDPServer.SendBuffer(Host,DataPort,memStream.Memory^,Form1.UDPServer.BufferSize)
       else
            Form1.UDPServer.SendBuffer(Host,DataPort,memStream.Memory^,memStream.Size);
       memStream.Free;
       Bitmap.Free;
    end;
    procedure TForm1.Button1Click(Sender: TObject);
    var
    RecvInfo:string;
    begin
    try
    TCPClient.Host:=Host;
    with TCPClient do
    begin
    Connect(3000);
    WriteLn('10000');
    RecvInfo:=AllData;
    DataPort:=StrToInt(Copy(RecvInfo,1,Length(RecvInfo)-2));
    TCPClient.Disconnect;
    end;
    except
    StatusBar.Panels[0].Text:='服务器关闭,无法发布';
    exit;
    end;
    Button1.Enabled:=False;
    Button2.Enabled:=True;
    IF DataPort=8001 then StatusBar.Panels[0].Text:='登陆频道1发布视频' else IF DataPort=8002 then StatusBar.Panels[0].Text:='登陆频道2发布视频' else StatusBar.Panels[0].Text:='频道已满,无法发布';
          CapWnd := capCreateCaptureWindow('VIDEO',
                WS_VISIBLE or WS_CHILD,
                1,
                1,
                panel1.Width-1,
                panel1.Height-2,
                panel1.handle,
                0);
          if CapWnd = 0 then exit;
          CapSetCallbackOnFrame(CapWnd,FrameCallBack);
          CapParms.dwRequestMicroSecPerFrame:=1000000 div 25;
          CapParms.fLimitEnabled:=FALSE;
          CapParms.fCaptureAudio:=False;
          CapParms.fMCIControl:=False;
          CapParms.fYield:=TRUE;
          CapParms.vKeyAbort:=VK_ESCAPE;
          CapParms.fAbortLeftMouse:=False;
          CapParms.fAbortRightMouse:=FALSE;
          CapCaptureSetSetup(capWnd,@CapParms,sizeof(TCAPTUREPARMS));
          CapPreviewRate(capWnd,25);
          CapCaptureSequenceNoFile(capWnd);
          CapDriverConnect(CapWnd,0);
          capGetVideoFormat(capWnd, @BMPINFO,sizeof(TBitmapInfo));
          CapPreviewScale(capWnd,TRUE);
          CapOverlay(capWnd,true);
          CapPreview(capWnd,true);
          ACMIn.Open(AudioFormat);
    end;
    procedure TForm1.Button2Click(Sender: TObject);
    begin
    try
    TCPClient.Host:=Host;
    with TCPClient do
    begin
    Connect(3000);
    WriteLn('2'+IntToStr(DataPort));
    TCPClient.Disconnect;
    end;
    except
    end;
    Button1.Enabled:=True;
    Button2.Enabled:=False;
    capCaptureAbort(CapWnd);
    capDriverDisconnect(CapWnd);
    ACMIn.Close;
    end;procedure TForm1.Button3Click(Sender: TObject);
    begin
    Button3.Enabled:=False;
    Button4.Enabled:=True;
    UDPServer.Send(Host,LoginPort,IntToStr(SelectServer)+OutLogin);
    if RadioButton1.Checked then SelectServer:=1 else SelectServer:=2;
    RadioButton1.Enabled:=False;
    RadioButton2.Enabled:=False;
    UDPServer.Send(Host,LoginPort,IntToStr(SelectServer)+Login);
    ACMOut.Open(AudioFormat);
    Label1.Caption:='对方视频';
    Timer.Enabled:=True;
    end;procedure TForm1.ACMInBufferFull(Sender: TObject; Data: Pointer;
      Size: Integer);
    var
    mdata:array[1..2048] of char;
     k:integer;
    begin
    for k:=1 to size do mdata[k]:=pchar(dword(data)+dword(k-1))^;
    UDPServer.SendBuffer(Host,DataPort,mdata,size);
    end;procedure TForm1.UDPServerUDPRead(Sender: TObject; AData: TStream;
      ABinding: TIdSocketHandle);
    var
      Buf:Array[0..9] of byte;
      jpg:TJpegImage;
      memStream:TMemoryStream;
    begin
    AData.Read(Buf,Sizeof(Buf));
    if (Buf[6]=$4A) and (Buf[7]=$46) and (Buf[8]=$49) and (Buf[9]=$46) then
    begin
       try
           AData.Seek(0,0);
           jpg := TJpegImage.Create;
           jpg.LoadFromStream(Adata);
           Image.Picture.Bitmap.Assign(jpg);
           jpg.Free;
        except
        end;
           Image.Refresh;
        end
        else
        begin
    memStream:=TMemoryStream.Create;
    memStream.LoadFromStream(AData);
    ACMOut.Play(memStream.Memory,memStream.Size);
    memStream.Free;
    end;
    end;procedure TForm1.FormCreate(Sender: TObject);
    var
    RC : TRect;
    begin
       with AudioFormat.Format do
       begin
         wFormatTag:=1;
         nChannels:=1;
         wBitsPerSample:=8;
         nSamplesPerSec:=8000;
         nBlockAlign:=1;
         nAvgBytesPerSec:=8000;
         cbSize:=SizeOf(TACMWaveFormat);
       end;  RC := Image.Canvas.ClipRect ;
      Image.Canvas.Brush.Color := clBlack ;
      Image.Canvas.FillRect(RC);end;procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
    begin
    try
    TCPClient.Host:=Host;
    with TCPClient do
    begin
    Connect(3000);
    WriteLn('2'+IntToStr(DataPort));
    TCPClient.Disconnect;
    end;
    except
    end;
    UDPServer.Send(Host,LoginPort,IntToStr(SelectServer)+OutLogin);
    end;procedure TForm1.Button4Click(Sender: TObject);
    var
    RC : TRect;
    begin
    RadioButton1.Enabled:=True;
    RadioButton2.Enabled:=True;
    Button3.Enabled:=True;
    Button4.Enabled:=False;
    UDPServer.Send(Host,LoginPort,IntToStr(SelectServer)+OutLogin);
      RC := Image.Canvas.ClipRect ;
      Image.Canvas.Brush.Color := clBlack ;
      Image.Canvas.FillRect(RC);
      Label1.Caption:='';
    Timer.Enabled:=False;  
    end;procedure TForm1.TimerTimer(Sender: TObject);
    begin
    UDPServer.Send(Host,LoginPort,IntToStr(SelectServer)+Status);
    end;end.