📄 msgnetwork.pas

📁 Delphi MsgCommunicator 2-10 component.I ve used, really good job. can be Server-Client message appl
💻 PAS
📖 第 1 页 / 共 2 页
字号:
上一页 12
    raise EMsgException.Create(40033, ErrorRCannotCloseSocket, [SocketError]); 
end; // Close 
 
 
//------------------------------------------------------------------------------ 
// SendBuffer
//------------------------------------------------------------------------------
procedure TMsgapiNetwork.SendBuffer( 
                          Buffer: PChar;
                          Count:  Integer);
var
  Flags:  Integer; 
  Addr: TSockAddr; 
begin
  // set parameters 
  Flags := 0; 
  Addr.sin_family := AF_INET; 
  Addr.sin_addr.s_addr := inet_addr(pchar(LookupHostAddr(FRemoteHost)));
  Addr.sin_port := htons(FRemotePort);
  FillChar(Addr.sin_zero, SizeOf(Addr.sin_zero), 0); 
{$IFDEF DEBUG_LOG_NETWORK_ERRORS} 
 try 
{$ENDIF} 
  // send packet 
  if FDisconnected then 
    Exit
  else 
    if sendto(FSocket, Buffer^, Count, Flags, Addr, sizeof(Addr)) = SOCKET_ERROR then 
      raise EMsgException.Create(40030, ErrorRNetSend, [SocketError]); 
{$IFDEF DEBUG_LOG_NETWORK_ERRORS} 
 except 
  on E: Exception do 
    begin 
aaWriteToLog('**************************************************************'); 
aaWriteToLog('MsgNetwork> TMsgapiNetwork.SendBuffer - Error:'); 
aaWriteToLog(E.Message);
aaWriteToLog('**************************************************************');
    end;
 end;
{$ENDIF} 
end; // SendBuffer
	
 
// TMsgapiNetwork
	
 
 
//////////////////////////////////////////////////////////////////////////////// 
// 
// TMsgListenerThread 
// 
//////////////////////////////////////////////////////////////////////////////// 
	
	
//------------------------------------------------------------------------------ 
// Create
//------------------------------------------------------------------------------ 
constructor TMsgListenerThread.Create(apiNetwork: TMsgapiNetwork); 
{$IFDEF DEBUG_LOG_NETWORK_ERRORS}
var 
  NetworkThreads:     TList;
{$ENDIF} 
begin 
  inherited Create(False);
  Priority := tpNormal; //tpHigher; //tpHighest;
  FapiNetwork := apiNetwork;
{$IFDEF DEBUG_LOG_NETWORK_THREADS}
aaWriteToLog('TMsgListenerThread.Create> Thread #'+IntToStr(Integer(self.ThreadID))+'/'+IntToStr(Integer(self.Handle)));
{$ENDIF}
  FNetworkThreads.Add(Self);
{$IFDEF DEBUG_LOG_NETWORK_ERRORS}
aaWriteToLog('TMsgNetwork> Listener Thread Added');
  NetworkThreads := FNetworkThreads.LockList;
  try
aaWriteToLog('TMsgNetwork> Network Threads Count='+IntToStr(NetworkThreads.Count));
  finally
   FNetworkThreads.UnlockList;
  end;
{$ENDIF}
end; // Create


//------------------------------------------------------------------------------
// Destroy
//------------------------------------------------------------------------------
destructor TMsgListenerThread.Destroy;
{$IFDEF DEBUG_LOG_NETWORK_ERRORS}
var
  NetworkThreads:     TList;
{$ENDIF}
begin
{$IFDEF DEBUG_LOG_NETWORK_THREADS}
aaWriteToLog('TMsgListenerThread.Destroy> Thread #'+IntToStr(Integer(self.ThreadID))+'/'+IntToStr(Integer(self.Handle)));
{$ENDIF}
{$IFDEF MSWINDOWS}
//  TerminateThread(Handle, 0);
{$ENDIF}
{$IFDEF LINUX}
{$ENDIF}
  inherited Destroy;
  FNetworkThreads.Remove(Self);
{$IFDEF DEBUG_LOG_NETWORK_ERRORS}
aaWriteToLog('TMsgNetwork> Listener Thread Removed');
  NetworkThreads := FNetworkThreads.LockList;
  try
aaWriteToLog('TMsgNetwork> Network Threads Count='+IntToStr(NetworkThreads.Count));
  finally
   FNetworkThreads.UnlockList;
  end;
{$ENDIF}
{$IFDEF DEBUG_LOG_NETWORK_THREADS}
aaWriteToLog('TMsgListenerThread.Destroy> Thread #'+IntToStr(Integer(self.ThreadID))+'/'+IntToStr(Integer(self.Handle))+' TERMINATED');
{$ENDIF}
end; // Destroy


//------------------------------------------------------------------------------
// Execute
//------------------------------------------------------------------------------
procedure TMsgListenerThread.Execute;
var
  Buffer:     PChar;
  BufferSize: Integer;
  Count:      Integer;
  FromHost:   String;
  FromPort:   Integer;
  Flags:      Integer;
  Addr:       TSockAddr;
  AddrLen:    Integer;
  Time:       TTimeVal;
  pTime:      PTimeVal;
  State:      TFDSet;
  pState:     PFDSet;
  ErrorCode:  Integer;
label
  Start;
begin
 try
  // set parameters
  Flags := 0;
  AddrLen := sizeof(Addr);
  FillChar(Addr, SizeOf(Addr), 0);
  Addr.sin_family := AF_INET;
Start:
  BufferSize := FapiNetwork.FPacketSize;
  // receive data
  Buffer := MemoryManager.GetMem(BufferSize);
  try
   // wait for incoming packet
   repeat
    if Terminated then
      Exit;
    State.fd_count := 1;
    State.fd_array[0] := FapiNetwork.FSocket;
    pState := @State;
    Time.tv_sec := 0;
    Time.tv_usec := 1;
    pTime := @Time;
    Count := select(0, pState, nil, nil, pTime);
    if Count = SOCKET_ERROR then
     begin
      ErrorCode := SocketError;
{$IFDEF DEBUG_LOG_NETWORK_ERRORS}
aaWriteToLog('**************************************************************');
aaWriteToLog('MsgNetwork> TMsgListenerThread.Execute - "select" returned SOCKET_ERROR='+IntToStr(ErrorCode));
{$ENDIF}
      if (Assigned(FapiNetwork.FOnDisconnect))
      and (ErrorCode=10054)
      then
       begin
        TMsgOnDisconnectThread.Create(FapiNetwork);
        Exit;
       end
      else
        raise EMsgException.Create(40031, ErrorRNetReceive, ['select', ErrorCode]);
     end;
   until (Count > 0) and (State.fd_array[0] = FapiNetwork.FSocket);
   // receive packet
{$IFDEF MSWINDOWS}
   Count := recvfrom(FapiNetwork.FSocket, Buffer^, BufferSize, Flags, Addr, AddrLen);
{$ENDIF}
{$IFDEF LINUX}
   Count := Libc.recvfrom(FapiNetwork.FSocket, Buffer^, BufferSize, Flags, @Addr, @AddrLen);
{$ENDIF}
   if Count = SOCKET_ERROR then
    begin
     ErrorCode := SocketError;
{$IFDEF DEBUG_LOG_NETWORK_ERRORS}
aaWriteToLog('**************************************************************');
aaWriteToLog('MsgNetwork> TMsgListenerThread.Execute - "recvfrom" returned SOCKET_ERROR='+IntToStr(ErrorCode));
{$ENDIF}
      if (Assigned(FapiNetwork.FOnDisconnect))
      and (ErrorCode=10054)
      then
       begin
        TMsgOnDisconnectThread.Create(FapiNetwork, True);
        Exit;
       end
      else
        raise EMsgException.Create(40031, ErrorRNetReceive, ['recvfrom', ErrorCode]);
    end;
   // get parameters
   FromHost := IntToStr(Addr.sin_addr.S_un_b.s_b1)+'.'+
               IntToStr(Addr.sin_addr.S_un_b.s_b2)+'.'+
               IntToStr(Addr.sin_addr.S_un_b.s_b3)+'.'+
               IntToStr(Addr.sin_addr.S_un_b.s_b4);
   FromPort := Integer (ntohs(Addr.sin_port));
   // send event
   if Assigned(FapiNetwork.FOnDataReceived) then
     FapiNetwork.FOnDataReceived(Buffer, Count, FromHost, FromPort);
  finally
   MemoryManager.FreeAndNilMem(Buffer);
  end;
  goto Start;
 except
{$IFDEF DEBUG_LOG_NETWORK_ERRORS}
  on E: Exception do
    begin
aaWriteToLog('**************************************************************');
aaWriteToLog('MsgNetwork> TMsgListenerThread.Execute - Error:');
aaWriteToLog(E.Message);
aaWriteToLog('Thread # '+IntToStr(Integer(self.ThreadID))+'/'+IntToStr(Integer(self.Handle)));
aaWriteToLog('**************************************************************');
    end;
{$ENDIF}
 end;
end; // Execute

// TMsgListenerThread



////////////////////////////////////////////////////////////////////////////////
//
// TMsgOnDisconnectThread
//
////////////////////////////////////////////////////////////////////////////////


//------------------------------------------------------------------------------
// Create
//------------------------------------------------------------------------------
constructor TMsgOnDisconnectThread.Create(
                        apiNetwork:     TMsgapiNetwork;
                        Recv:           Boolean = False

                                          );
{$IFDEF DEBUG_LOG_NETWORK_ERRORS}
var
  NetworkThreads:     TList;
{$ENDIF}
begin
  inherited Create(False);
  Priority := tpNormal;
  FreeOnTerminate := True;
  FapiNetwork := apiNetwork;
  FRecv := Recv;
  FNetworkThreads.Add(Self);
{$IFDEF DEBUG_LOG_NETWORK_ERRORS}
aaWriteToLog('TMsgNetwork> OnDisconnect Thread Added');
  NetworkThreads := FNetworkThreads.LockList;
  try
aaWriteToLog('TMsgNetwork> Network Threads Count='+IntToStr(NetworkThreads.Count));
  finally
   FNetworkThreads.UnlockList;
  end;
{$ENDIF}
end; // Create


//------------------------------------------------------------------------------
// Destroy
//------------------------------------------------------------------------------
destructor TMsgOnDisconnectThread.Destroy;
{$IFDEF DEBUG_LOG_NETWORK_ERRORS}
var
  NetworkThreads:     TList;
{$ENDIF}
begin
{$IFDEF DEBUG_LOG_NETWORK_ERRORS}
aaWriteToLog('MsgNetwork> TMsgOnDisconnectThread.Destroy - START');
{$ENDIF}
{$IFDEF DEBUG_LOG_NETWORK_THREADS}
aaWriteToLog('TMsgOnDisconnectThread.Destroy> Thread #'+IntToStr(Integer(self.ThreadID))+'/'+IntToStr(Integer(self.Handle)));
{$ENDIF}
  inherited Destroy;
  FNetworkThreads.Remove(Self);
{$IFDEF DEBUG_LOG_NETWORK_ERRORS}
aaWriteToLog('TMsgNetwork> OnDisconnect Thread Removed');
  NetworkThreads := FNetworkThreads.LockList;
  try
aaWriteToLog('TMsgNetwork> Network Threads Count='+IntToStr(NetworkThreads.Count));
  finally
   FNetworkThreads.UnlockList;
  end;
{$ENDIF}
{$IFDEF DEBUG_LOG_NETWORK_THREADS}
aaWriteToLog('TMsgOnDisconnectThread.Destroy> Thread #'+IntToStr(Integer(self.ThreadID))+'/'+IntToStr(Integer(self.Handle))+' TERMINATED');
{$ENDIF}
{$IFDEF DEBUG_LOG_NETWORK_ERRORS}
aaWriteToLog('MsgNetwork> TMsgOnDisconnectThread.Destroy - FINISH');
{$ENDIF}
end; // Destroy


//------------------------------------------------------------------------------
// Execute
//------------------------------------------------------------------------------
procedure TMsgOnDisconnectThread.Execute;
begin
  FapiNetwork.FDisconnected := True;
  FapiNetwork.FOnDisconnect(FapiNetwork.RemoteHost, FapiNetwork.RemotePort, FRecv);
end; // Execute

// TMsgOnDisconnectThread



////////////////////////////////////////////////////////////////////////////////
//
// Procedures
//
////////////////////////////////////////////////////////////////////////////////

function SocketError: Integer;
begin
 {$IFDEF MSWINDOWS}
  Result := WSAGetLastError;
 {$ENDIF}
 {$IFDEF LINUX}
  Result := errno;
 {$ENDIF}

{$IFNDEF MSWINDOWS}
 {$IFNDEF LINUX}
  Result := 0;
 {$ENDIF}
{$ENDIF}
end;


function LookupHostAddr(const hn: string): string;
var
  h: PHostEnt;
begin
  Result := '';
  if hn <> '' then
  begin
    if hn[1] in ['0'..'9'] then
    begin
      if inet_addr(pchar(hn)) <> INADDR_NONE then
        Result := hn;
    end
    else
    begin
      h := gethostbyname(pchar(hn));
      if h <> nil then
        with h^ do
        Result := format('%d.%d.%d.%d', [ord(h_addr^[0]), ord(h_addr^[1]),
      		  ord(h_addr^[2]), ord(h_addr^[3])]);
    end;
  end
  else Result := '0.0.0.0';
end;

{$IFDEF MSWINDOWS}
function socket;            external    winsocket name 'socket';
function bind;              external    winsocket name 'bind';
function sendto;            external    winsocket name 'sendto';
function select;            external    winsocket name 'select';
function recvfrom;          external    winsocket name 'recvfrom';
function inet_addr;         external    winsocket name 'inet_addr';
function gethostbyname;     external    winsocket name 'gethostbyname';
function htons;             external    winsocket name 'htons';
function ntohs;             external    winsocket name 'ntohs';
function closesocket;       external    winsocket name 'closesocket';
function WSAStartup;        external    winsocket name 'WSAStartup';
function WSACleanup;        external    winsocket name 'WSACleanup';
function WSAGetLastError;   external    winsocket name 'WSAGetLastError';
function TerminateThread;   external    kernel32  name 'TerminateThread';
{$ENDIF}

var
{$IFDEF MSWINDOWS}
  WSAData:            TWSAData;
{$ENDIF}
  NetworkThreads:     TList;
  i:                  Integer;
  Err:                Boolean;

initialization

{$IFDEF DEBUG_LOG_INIT}
aaWriteToLog('MsgNetwork> initialized');
{$ENDIF}
  FNetworkThreads := TThreadList.Create;

{$IFDEF MSWINDOWS}
  if WSAStartup($0101, WSAData) = SOCKET_ERROR then
    raise EMsgException.Create(40034, ErrorRWSAStartup, [SocketError]);
{$ENDIF}

finalization

// Terminate all network threads...
{$IFDEF DEBUG_LOG_NETWORK_ERRORS}
aaWriteToLog('TMsgNetwork> Terminate all network threads...');
{$ENDIF}
  NetworkThreads := FNetworkThreads.LockList;
{$IFDEF DEBUG_LOG_NETWORK_ERRORS}
aaWriteToLog('TMsgNetwork> Hang Count='+IntToStr(NetworkThreads.Count));
{$ENDIF}
  try
   for i:= NetworkThreads.Count-1 downto 0 do
    begin
     Err := TerminateThread(TThread(NetworkThreads[i]).Handle, 0);
     if not Err then
      begin
{$IFDEF DEBUG_LOG_NETWORK_ERRORS}
aaWriteToLog('TMsgNetwork> TerminateThread failed. '+ErrorRCannotKillThread+IntToStr(Integer(Err)));
{$ENDIF}
      end;
     if TThread(NetworkThreads[i]).Handle <> 0 then
       Err := CloseHandle(TThread(NetworkThreads[i]).Handle);
     if not Err then
      begin
{$IFDEF DEBUG_LOG_NETWORK_ERRORS}
aaWriteToLog('TMsgNetwork> TerminateThread failed. '+ErrorRCannotKillThread+IntToStr(Integer(Err)));
{$ENDIF}
      end;
{$IFDEF DEBUG_LOG_NETWORK_ERRORS}
aaWriteToLog('TMsgNetwork> Count='+IntToStr(NetworkThreads.Count));
{$ENDIF}
    end;
  finally
   FNetworkThreads.UnlockList;
  end;
{$IFDEF DEBUG_LOG_NETWORK_ERRORS}
  sleep(1000);
  NetworkThreads := FNetworkThreads.LockList;
  try
aaWriteToLog('TMsgNetwork> Rest Count='+IntToStr(NetworkThreads.Count));
  finally
   FNetworkThreads.UnlockList;
  end;
{$ENDIF}

{$IFDEF MSWINDOWS}
{$IFDEF DEBUG_LOG_NETWORK_ERRORS}
aaWriteToLog('TMsgNetwork> WSACleanup...');
{$ENDIF}
  if WSACleanup = SOCKET_ERROR then
    raise EMsgException.Create(40035, ErrorRWSACleanup, [SocketError]);
{$ENDIF}

  FNetworkThreads.Free;

{$IFDEF DEBUG_LOG_NETWORK_ERRORS}
aaWriteToLog('TMsgNetwork> FINISH');
{$ENDIF}

end.
上一页 12
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -