Q&A

  • 기본소켓사용 Jpeg 전송에 대해서
기본소켓을사용  스트림이용 전송   만들어 보았습니다.

로컬 테스트로는 잘돌아가는 것 처럼보여 문제점을 잡는데 문제가 많습니다.

프로그램이 실행중 예로 델파이 같이 로딩이 오래걸리는경우 작업이 멈추는것

외부 접속시 나타나는 데이타를 잘 못 받는 것. 이것 때문에 나타나는 스트림리드 에러 등의

문제점에 대해서 조언의 말씀좀 부탁드립니다.

약간 정리를 해서  하나로 Vdsl 라인을 사용하고 공유기를 사용하는 곳에서 접속을 해보니

한컷의 이미지만 오고 먹통이 되고   CPU 100 %까지...(들어온 데이타가 계속 쌓이나 쩝)    

서버측에서는 10054    10053   등이 나타나네요


참고로 제컴의 OS  nt2000    델 7    현 IP 는  58.232. 83.77  입니다.

실행화일 Main.Exe 입니다  




unit Main_S;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, OleCtrls, SHDocVw, Menus, StdCtrls, Buttons, ExtCtrls,
  Videocap,Jpeg,RemConMessages,ScktComp,VD_Vfw;
const
   MY_MSG    = WM_USER + 1001;
   MY_TXT    = WM_USER + 1002;
   MY_SEND   = WM_USER + 1005;

type
  TForm1 = class(TForm)
    VideoCap1: TVideoCap;
    Image1: TImage;
    btCall: TBitBtn;
    MainMenu1: TMainMenu;
    Call1: TMenuItem;
    btHangUp: TBitBtn;
    StartVideo: TBitBtn;
    BitBtn4: TBitBtn;
    WebBrowser1: TWebBrowser;
    StatusBar1: TStatusBar;
    Image2: TImage;
    Edit1: TEdit;
    ServerSocket: TServerSocket;
    ClientSocket: TClientSocket;
    Bevel1: TBevel;
    Bevel2: TBevel;
    Bevel3: TBevel;
    Edit2: TEdit;
    Call2: TMenuItem;
    N1: TMenuItem;
    N2: TMenuItem;
    Video1: TMenuItem;
    StartVideo1: TMenuItem;
    VideoClose1: TMenuItem;
    ServerOpen: TMenuItem;
    ServerClose: TMenuItem;
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormDestroy(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure ServerSocketClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocketClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocketClientError(Sender: TObject;
      Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
      var ErrorCode: Integer);
    procedure ServerSocketClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure StartVideoClick(Sender: TObject);
    procedure VideoCap1VideoStream(sender: TObject; lpVhdr: PVIDEOHDR);
    procedure ServerSocketListen(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure btCallClick(Sender: TObject);
    procedure ClientSocketConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocketConnecting(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocketDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocketError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure ClientSocketRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure btHangUpClick(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
    procedure ServerOpenClick(Sender: TObject);
  private
    { Private declarations }
    FOnSnap      : TOnSnapEvent;
    SendStream,
    RecvStream,
    ServerRecvStream: TMemoryStream;
    SendText     : string;

    CurBmp       : TBitmap;
    CurJpg       : TJpegImage;
    Size1        : Integer;  //StatusBar1 Panel Size

    procedure  MYSEND(var Msg: TMessage); message MY_SEND;
    procedure  SetStat(i: integer; s: string);
    procedure  ProcessStream(Const Stream:TMemoryStream; Socket: TCustomWinSocket);
    procedure  ServerProcessStream(Const Stream:TMemoryStream; Socket: TCustomWinSocket);
  public
    { Public declarations }
    VideoState   : TVideoState;
    property   Stat[i: integer]: string write SetStat;
  end;

var
  Form1 : TForm1;
  SnapNeed : boolean;
  tSize  : integer=0;
implementation
uses ConnectDlg;
{$R *.dfm}

//  Hang up :  《구어》 일[활동]을 그만두다, 은퇴하다


procedure TForm1.FormCreate(Sender: TObject);
begin
     VideoCap1.Left:= -100;
     WebBrowserInit(WebBrowser1);
     //ImageBox_Black(Image1, 320,240);
     //ImageBox_Black(Image2, 160,120);

     CurBmp := TBitmap.Create;
     CurJpg := TJpegImage.Create;
     SendStream := TMemoryStream.Create;
     RecvStream := TMemoryStream.Create;
     ServerRecvStream:= TMemoryStream.Create;

     WebBrowserInit(WebBrowser1);
     VideoState := vsClosed;


     Size1 :=StatusBar1.Width div 3;
     StatusBar1.Panels[0].Width:= Size1;
     StatusBar1.Panels[1].Width:= Size1;
     StatusBar1.Panels[2].Width:= Size1;

     Edit1.Text:='';
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    if VideoCap1.DriverOpen then
    begin
       VideoState := vsClosing;  //캠닫기준비중
       Cam_OFF(VideoCap1);
       VideoState := vsClosed;  //캠닫기완료
    end;
end;


procedure TForm1.FormActivate(Sender: TObject);
begin
    Caption:= Address_Return;
end;


procedure TForm1.SetStat(i: integer; s: string);
begin
     StatusBar1.Panels[i].Text := s;
end;


procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
   rc : integer;

begin
   if ServerSocket.Socket.ActiveConnections > 0 then begin
      rc := MessageDlg('Clients are still connected, do you want to close?',
         mtWarning, mbYesNoCancel, 0);
      CanClose := (rc = mrYes);
   end;

   if ClientSocket.Active then
   begin
      StrToStream('Application Close',RecvStream);
      SendStreamData(MSG_SOCKETCLOSE,RecvStream,ClientSocket.Socket);
      Application.ProcessMessages;
      ClientSocket.Active:=false;
   end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
    if CurBmp <> Nil then CurBmp.Free;
    if CurJpg <> Nil then CurJpg.Free;
    if SendStream <> nil then SendStream.Free;
    if RecvStream <> nil then RecvStream.Free;
    if ServerRecvStream <> nil then ServerRecvStream.Free;
end;

//------------------------------------------------------------------------------
// 서버소켓을 가동 중지 시킨다.....
//------------------------------------------------------------------------------

procedure TForm1.ServerOpenClick(Sender: TObject);
begin
    if Sender = ServerOpen then begin
       with ServerSocket do begin
            if Not Active then
            begin
                Port   := Port_V;
                Active := True;
            end;
       end;
    if Sender = ServerClose then
       if ServerSocket.Active then ServerSocket.Active := False;
    end;
end;


//------------------------------------------------------------------------------
// 서버소켓 이벤트부분
//------------------------------------------------------------------------------

procedure TForm1.ServerSocketListen(Sender: TObject;
  Socket: TCustomWinSocket);
begin
     Stat[0]:='Server Listen... '+CurTime;
end;


procedure TForm1.ServerSocketClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);

var  S : string;
begin
    if ServerSocket.Socket.ActiveConnections > 1 then
    begin
        S :='통화중입니다. 잠시후 다시 연결하여주시기 바랍니다..';

        SendStream.Clear;
        SendStream.WriteBuffer(Pointer(S)^,Length(S));
        SendStreamData(MSG_READY,SendStream,Socket);

        Socket.Close;
        Exit;
    end;
    AddMsg(ListBox1,'Connect  : '+ CurTime+'  '+Socket.RemoteAddress);
end;

procedure TForm1.ServerSocketClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
    AddMsg(ListBox1,'DisConnect : '+ CurTime+'  '+Socket.RemoteAddress);
end;

procedure TForm1.ServerSocketClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
    AddMsg(ListBox1,'Server ErrorCode : '+ IntToStr(ErrorCode));
    AddMsg(ListBox1,ErrorNo_Disp(ErrorCode));
    ErrorCode:=0;
end;


//3월26일자로 변경해보았습니다.-------------------------------------
procedure TForm1.ServerSocketClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
  rSize : integer;
  MainBuff  : array [0..1024] of Char;
  DataStream:TMemoryStream;
begin
     if Socket.ReceiveLength > 0 then
     begin
         rSize :=Socket.ReceiveBuf(MainBuff,Sizeof(MainBuff));
         ServerRecvStream.Write(MainBuff,rSize);

         while IsValidStream(ServerRecvStream) do  begin
             DataStream:=TMemoryStream.Create;
             try
               ServerRecvStream.Position:=0;
               DataStream.CopyFrom(ServerRecvStream,ServerRecvStream.Size);
               ServerRecvStream.Clear;
               ServerProcessStream(DataStream, Socket);
             finally
               DataStream.Free;
               Application.ProcessMessages;
             end;
         end;
     end;
end;

//------------------------------------------------------------------------------------------------

procedure TForm1.ServerProcessStream(Const Stream :TMemoryStream; Socket: TCustomWinSocket);
var MsgNum: integer;
begin
    Stream.Position:=0;
    Stream.ReadBuffer(MsgNum,Sizeof(Integer));
    try
        if MsgNum = MSG_SOCKETCLOSE then Socket.Close;
    finally
          MsgNum:=0;
    end;
end;

//------------------------------------------------------------------------------
// 비디오 캠 캡쳐 시작 버튼
//------------------------------------------------------------------------------

procedure TForm1.StartVideoClick(Sender: TObject);
var msg : string;
begin
    if Not VideoCap1.DriverOpen then begin
       VideoState := vsOpening;            //캠열기준비중
       Cam_ON(VideoCap1);
       VideoState := vsOpened;             // 캠열기완료

       StartVideo.Caption := '&Stop Video';
       if Not SnapNeed then begin
          SendStream.Clear;
          SnapNeed := True;
       end;
    end else
    if VideoCap1.DriverOpen then
    begin
       SnapNeed := False;
       VideoState := vsClosing;            //캠닫기준비중
       Cam_OFF(VideoCap1);
       VideoState := vsClosed;              //캠닫기완료

       if (Not SnapNeed) and (VideoState= vsClosed ) then Image2.Picture:=nil;
       if ServerSocket.Socket.Connections[0].Connected then
       begin
          msg:='MSG_VIDEOOFF';
          SendStream.Clear;
          SendStream.WriteBuffer(Pointer(msg)^,Length(msg));
          SendStreamData(MSG_VIDEOOFF,SendStream,ServerSocket.Socket.Connections[0]);
       end;
       StartVideo.Caption := 'Start &Video';
    end;
end;


procedure TForm1.MYSEND(var Msg: TMessage);
begin
    if SnapNeed = False then
       if VideoState = vsClosed then Exit;
       if (VideoState = vsOpened) and (SnapNeed = False) then
       begin
           if ServerSocket.Socket.ActiveConnections > 0 then
              if ServerSocket.Socket.Connections[0].Connected then
                 SendStreamData(MSG_VIDEODISP,SendStream,ServerSocket.Socket.Connections[0]);

           Application.ProcessMessages;
       end;
end;

procedure SendAsyncProc(hWnd: HWND; uMsg: UINT; dwData: DWORD; lResult: LRESULT); cdecl;
begin
    with Form1 do begin
        try
           try
             if (SendText <> '') and (ServerSocket.Socket.Connections[0].Connected) then
             begin
                 SendStream.Clear;
                 StrToStream(SendText,SendStream);
                 SendStreamData(MSG_TEXT,SendStream,ServerSocket.Socket.Connections[0]);
                 WebString(WebBrowser1,SendText);
                 Application.ProcessMessages;
             end;
           finally
               SendText:='';
           end;
        finally
           if VideoState = vsOpened then
           begin
             Sleep(10);
             if SendStream <> nil then  SendStream.Clear;
             SnapNeed := True;
           end;
        end;
    end;
end;





procedure TForm1.VideoCap1VideoStream(sender: TObject; lpVhdr: PVIDEOHDR);
var Jpeg : TJpegImage;
begin
    if Application.Terminated or not SnapNeed or (VideoState = vsClosing) then exit;

      if Owner is TForm then (Owner As TForm).Canvas.Lock;
      try
          try
             FrameToBitmap(CurBmp, lpVHdr^.lpData,FBitmapInfo);
          except
             raise Exception.Create('FrameToBitmap Error');
          end;

                      try
                               if Assigned(FOnSnap) then FOnSnap(sender, CurBmp);
                      except
                               raise Exception.Create('FOnSnap Error');
                      end;

          Jpeg := TJpegImage.Create;
          try
             try
                             Jpeg.Assign(CurBmp);
                   except
                             raise Exception.Create('Jpeg.Assign Error');
                   end;

                   try
                             Jpeg.CompressionQuality := 80;
                             Jpeg.Compress;
                   except
                             raise Exception.Create('Compress Error ');
                   end;
             Jpeg.SaveToStream(SendStream);
             Jpeg_Smal(Jpeg,Image2);
          finally
             Jpeg.Free;
          end;
      except
          on E: Exception do
                      begin
                      end;
      end;

      if Owner is TForm then (Owner As TForm).Canvas.Unlock;
             SnapNeed := false;
      SendMessageCallback(Handle, MY_SEND,0,0,@SendAsyncProc,0); //콜백메세지방식
end;


//------------------------------------------------------------------------------
//  텍스트 보내기 부분
//------------------------------------------------------------------------------

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
    if key = #13 then
    begin
        key:=#0;
        if VideoState = vsClosed then
        begin
            ShowMessage('텍스트는 비디오 캠이 가동 되어야만 전송할수 있습니다');
            Edit1.Clear;
            Exit;
        end;

        SendText := '[ '+Edit2.Text+' ] : '+ Edit1.Text;
        Edit1.Clear;
    end;
end;


//------------------------------------------------------------------------------
//  서버에 접속시도
//  클라이언트소켓 이벤트부분
//------------------------------------------------------------------------------

procedure TForm1.btCallClick(Sender: TObject);
var
   f : TForm;
begin
    f := Self;
    with ClientConnectForm do begin
       Left := (f.Left + f.Width div 2) - Width div 2;
       Top  := (f.Top + f.Height div 2) - Height div 2;
       if ShowModal = mrOK then
          if ServerCombo.Text = '' then
          begin
              ShowMessage('접속주소를 입력하시고 다시 접속하세요');
          end else
          begin
              with ClientSocket do begin
                   if IsDotAddress(ServerCombo.Text) then begin
                      Host    := '';
                      Address := ServerCombo.Text;
                   end else begin
                      Address := '';
                      Host    := ServerCombo.Text;
                   end;
                   Port := Port_V;
                   Active := True;
              end; //with
          end;
    end;//with
end;

procedure TForm1.btHangUpClick(Sender: TObject);
begin
    ClientSocket.Active:=False;
    Image1.Picture:=Nil;
end;



procedure TForm1.ClientSocketConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
    if RecvStream.Size > 0 then RecvStream.Clear;
    AddMsg(ListBox1,'서버에 연결완료');
end;

procedure TForm1.ClientSocketConnecting(Sender: TObject;
  Socket: TCustomWinSocket);
begin
    AddMsg(ListBox1,'서버를
1  COMMENTS
  • Profile
    김상호 2007.03.28 01:42
    일단 참고로 몇자 적어 봅니다..
    저도 같은 방식으로 프로그램을 만들어 봤는데요..
    전송되는 프레임수가 많아 지면 클라이언트에서 제대로 표시 하지 못합니다..
    그래서 메모리만 허용한다면. 스트림이나 .jpeg 등은 실행시 한번 생성을 해서 매번 생성되는 시간을 줄였고요..

    그리고 전송프레임 수가 많으면 음성이 끊기다든지. 제대도 전송이 되지 않습니다.
    이것을 해결하려면  프레임수를 줄이든지 압축 코덱을 이용해야 합니다..

    그리고 화면에  스트림으로 받은 것을 좀더 빨리 디스플레이 해 줘야합니다. 그렇지 않으면 화면이 멈춰 있는것 같이 보여요.. 그래서 저는 DirectX의 DirectDraw를 이용해서 화면에 표시해 줬습니다..

    그리고 10053같은 에러가 화면에 표시 되는것 같은데. 이것은 소스의 에러 이벤트에서 AddMsg를 주석처리하시고(서버소켓,클라이언트소켓 모두)

        ErrorCode :=0;

    만 ... 아래와 같이요.. 에러가 생겼다고 소켓을 무조것 닫아 버리면????

    procedure TForm1.ClientSocketError(Sender: TObject;
      Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
      var ErrorCode: Integer);
    begin
    //    AddMsg(ListBox1,'Client ErrorCode : '+ IntToStr(ErrorCode));
    //    AddMsg(ListBox1,ErrorNo_Disp(ErrorCode));
        ErrorCode :=0;
    //    Socket.Close;
    end;