msgconnection.pas

Delphi MsgCommunicator 2-10 component.I ve used, really good job. can be Server-Client message appl

aaWriteToLog('MsgConnection> TMsgNetwork.OnDisconnect> Manager not exist - FINISH');
{$ENDIF}
    Exit;
   end;
  ReCreateNetwork;
{$IFDEF DEBUG_LOG_NETWORK_ONDISCONNECT}
aaWriteToLog('MsgConnection> TMsgNetwork.OnDisconnect> FManager.OnDisconnect...');
{$ENDIF}
  if not Recv then
    FManager.OnDisconnect(self, FromHost, FromPort);
 except
  on E: Exception do
   begin
{$IFDEF DEBUG_LOG_NETWORK_ONDISCONNECT}
aaWriteToLog('**************************************************************');
aaWriteToLog('MsgConnection> TMsgNetwork.OnDisconnect - Error:');
aaWriteToLog(E.Message);
aaWriteToLog('**************************************************************');
{$ENDIF}
    raise;
   end;
 end;
{$IFDEF DEBUG_LOG_NETWORK_ONDISCONNECT}
aaWriteToLog('MsgConnection> TMsgNetwork.OnDisconnect> FINISH');
{$ENDIF}
end;// OnDisconnect


//------------------------------------------------------------------------------
// OnDataReceived
//------------------------------------------------------------------------------
{$IFDEF API_NETWORK}
procedure TMsgNetwork.OnDataReceived(
                             Buffer:    PChar;
                             Count:     Integer;
                             FromHost:  String;
                             FromPort:  Integer
                             );
{$ELSE}
 {$IFDEF D6H}
procedure TMsgNetwork.OnDataReceived(
                             Sender:   TObject;
                             AData:    TStream;
                             ABinding: TIdSocketHandle
                             );
 {$ELSE}
procedure TMsgNetwork.OnDataReceived(
                             Sender: TComponent;
                             BufferSize: Integer;
                             FromIP: string;
                             Port: integer
                             );
 {$ENDIF D6H}
{$ENDIF API_NETWORK}
var
  Buf: PChar;
  BufSize: Integer;
{$IFDEF API_NETWORK}
{$ELSE}
 {$IFDEF D6H}
  FromHost: String;
  FromPort: Integer;
 {$ELSE}
  Buffer: array [0..MsgMaxPacketSize] of Char;
 {$ENDIF}
{$ENDIF}
  Header: PMsgPacketHeader;
{$IFDEF DEBUG_LOG_NETWORK}
  buff: pchar;
  i: integer;
{$ENDIF}
{$IFDEF DEBUG_LOG_NETWORK_SHORT}
  str: String;
{$ENDIF}
begin
{$IFDEF DEBUG_LOG_NETWORK_TIME}
aaWriteToLog('TMsgNetwork.OnDataReceived');
aaWriteToLog(IntToStr(gettickcount));
{$ENDIF}

//  EnterCriticalSection(FCSect);
{$IFDEF API_NETWORK}
  Buf := MemoryManager.GetMem(Count);
  Move(Buffer^, Buf^, Count);
  BufSize := Count;
{$ELSE}
 {$IFDEF D6H}
  Buf := MemoryManager.GetMem(MsgMaxPacketSize);
  BufSize := AData.Read(Buf^, MsgMaxPacketSize);
  FromHost := ABinding.PeerIP;
  FromPort := ABinding.PeerPort;
 {$ELSE}
  Buf := MemoryManager.GetMem(BufferSize);
  FTransport.ReadBuffer(Buffer, BufferSize);
  Move(Buffer[0], Buf^, BufferSize);
  BufSize := BufferSize;
 {$ENDIF D6H}
{$ENDIF API_NETWORK}
//  LeaveCriticalSection(FCSect);
  Header := PMsgPacketHeader(Buf);
{$IFDEF DEBUG_LOG_NETWORK_SHORT}
if LocalPort = MsgDefaultClientPort then
str := 'Client'
else
if LocalPort = MsgDefaultServerPort then
str := 'Server'
else
str := IntToStr(LocalPort);
str := str + '<<< '
+IntToStr(Header.CurrentRequestID)+' : '
+IntToStr(Header.PacketID)+' / '
+IntToStr(Header.ControlCode)
+' <<< '+FromHost+':'+IntToStr(FromPort)
+' - '+IntToStr(GetTickCount)+' msec'
//+' <'+IntToStr(Header.Recepient)+'>'
;
aaWriteToLog(str);
{$ENDIF}
{$IFDEF DEBUG_LOG_NETWORK}
aaWriteToLog('--------------------------------------------');
aaWriteToLog('MsgConnection>TMsgNetwork.OnDataReceived('+IntToHex(Integer(@Buf),6)+', '+IntToStr(BufSize)+')');
aaWriteToLog('Recepient : '+IntToStr(FLocalClient));
aaWriteToLog('-----------');
 {$IFDEF API_NETWORK}
aaWriteToLog('RemoteHost: '+FromHost);
aaWriteToLog('RemotePort: '+IntToStr(FromPort));
 {$ELSE}
  {$IFDEF D6H}
aaWriteToLog('RemoteHost: '+FromHost);
aaWriteToLog('RemotePort: '+IntToStr(FromPort));
  {$ELSE}
aaWriteToLog('RemoteHost: '+FromIP);
aaWriteToLog('RemotePort: '+IntToStr(Port));
  {$ENDIF D6H}
 {$ENDIF API_NETWORK}
aaWriteToLog('LocalHost : '+LocalHost);
aaWriteToLog('LocalPort : '+IntToStr(LocalPort));
aaWriteToLog('>>> Head:');
aaWriteToLog('CheckSum         '+IntToStr(Header.CheckSum));
aaWriteToLog('Signature        '+Header.Signature);
aaWriteToLog('Recepient        '+IntToStr(Header.Recepient));
aaWriteToLog('Sender           '+IntToStr(Header.Sender));
aaWriteToLog('ConnectionID     '+IntToStr(Header.ConnectionID));
aaWriteToLog('SessionID        '+IntToStr(Header.SessionID));
aaWriteToLog('CurrentRequestID '+IntToStr(Header.CurrentRequestID));
aaWriteToLog('PacketID         '+IntToStr(Header.PacketID));
aaWriteToLog('ControlCode      '+IntToStr(Header.ControlCode));
(*
aaWriteToLog('>>> Data:');
buff:=MemoryManager.GetMem(BufSize-SizeOf(TMsgPacketHeader)+1);
Move(PChar(Integer(Buf)+SizeOf(TMsgPacketHeader))^, buff^, BufSize-SizeOf(TMsgPacketHeader));
for i:= 0 to BufSize-SizeOf(TMsgPacketHeader)-1 do
  if (buff+i)^=#0 then
    (buff+i)^:='0';
(buff+BufSize-SizeOf(TMsgPacketHeader))^:=#0;
aaWriteToLog(buff);
aaWriteToLog('###');
MemoryManager.FreeAndNilMem(buff);
*)
{$ENDIF DEBUG_LOG_NETWORK}

{$IFDEF DEBUG_LOG_NETWORK_TIME}
aaWriteToLog(IntToStr(gettickcount)+ ' - buffer prepared');
{$ENDIF}
  if (Header.Recepient = FLocalClient)
{$IFDEF MsgCommunicator}
  or (
//      (Header.Recepient = Integer(MSG_INVALID_USER_ID)) and
      ((Header.ControlCode = MsgConnect) or (Header.ControlCode = MsgConnect+MsgLastPacket))
      and
      (Header.Signature = MsgClientPacketSign)
      )
{$ENDIF MsgCommunicator}
  then
{$IFDEF API_NETWORK}
    FManager.NetworkListener(Buf, BufSize, Self, FromHost, FromPort);
{$ELSE}
 {$IFDEF D6H}
    FManager.NetworkListener(Buf, BufSize, Self, FromHost, FromPort);
 {$ELSE}
    FManager.NetworkListener(Buf, BufSize, Self, FromIP, Port);
 {$ENDIF D6H}

{$ENDIF API_NETWORK}

{$IFDEF DEBUG_LOG_NETWORK_TIME}
aaWriteToLog(IntToStr(gettickcount)+' - end of parsing');
aaWriteToLog('');
{$ENDIF}
end;
// TMsgNetwork



////////////////////////////////////////////////////////////////////////////////
//
// TMsgBaseConnectionManager
//
////////////////////////////////////////////////////////////////////////////////

//------------------------------------------------------------------------------
// TMsgBaseConnectionManager.IncThreadCount
//------------------------------------------------------------------------------
procedure TMsgBaseConnectionManager.IncThreadCount(Ignore: Boolean);
begin
  if not Ignore then
    EnterCriticalSection(FCSect);
  FThreadCount := FThreadCount+1;
  if not Ignore then
    LeaveCriticalSection(FCSect);
end;// TMsgBaseConnectionManager.IncThreadCount

//------------------------------------------------------------------------------
// TMsgBaseConnectionManager.DecThreadCount
//------------------------------------------------------------------------------
procedure TMsgBaseConnectionManager.DecThreadCount(Ignore: Boolean);
begin
  if not Ignore then
    EnterCriticalSection(FCSect);
  FThreadCount := FThreadCount-1;
  if not Ignore then
    LeaveCriticalSection(FCSect);
end;// TMsgBaseConnectionManager.DecThreadCount

//------------------------------------------------------------------------------
// TMsgBaseConnectionManager.SetThreadCount
//------------------------------------------------------------------------------
procedure TMsgBaseConnectionManager.SetThreadCount(Value: Integer);
begin
  EnterCriticalSection(FCSect);
  FThreadCount := Value;
  LeaveCriticalSection(FCSect);
end;// TMsgBaseConnectionManager.SetThreadCount

//------------------------------------------------------------------------------
// compresses and encrypts buffer
//------------------------------------------------------------------------------
procedure TMsgBaseConnectionManager.CompressAndEncryptBuffer(
                        Session:              TMsgComBaseSession;
                        InBuffer:             PChar;
                        InBufferSize:         Integer;
                        var OutBuffer:        PChar;
                        var OutBufferSize:    Integer
                                                              );
begin
 try
  MsgBaseEngine.CompressAndEncryptBuffer(Session.ConnectParams.CryptoInfo,
                                         Session.ConnectParams.CompressionAlgorithm,
                                         Session.ConnectParams.CompressionMode,
                                         InBuffer,  InBufferSize,
                                         OutBuffer, OutBufferSize);
 except
  on E: Exception do
   begin
{$IFDEF DEBUG_LOG_NETWORK_ERRORS}
aaWriteToLog('**************************************************************');
aaWriteToLog('MsgConnection> CompressAndEncryptBuffer - Error:');
aaWriteToLog(E.Message);
aaWriteToLog('**************************************************************');
{$ENDIF}
    raise;
   end;
 end;
end; // CompressAndEncryptBuffer


//------------------------------------------------------------------------------
// decompresses and decrypts buffer
//------------------------------------------------------------------------------
function TMsgBaseConnectionManager.DecompressAndDecryptBuffer(
                        Session:              TMsgComBaseSession;
                        var Buffer:           PChar;
                        var BufferSize:       Integer
                                                              ): Boolean;
begin
 try
  Result := MsgBaseEngine.DecompressAndDecryptBuffer(
                                Session.ConnectParams.CryptoInfo,
                                Session.ConnectParams.CompressionAlgorithm,
                                Session.ConnectParams.CompressionMode,
                                Buffer,
                                BufferSize);
 except
  on E: Exception do
   begin
    Result := False;
{$IFDEF DEBUG_LOG_NETWORK_ERRORS}
aaWriteToLog('**************************************************************');
aaWriteToLog('MsgConnection> DecompressAndDecryptBuffer - Error:');
aaWriteToLog(E.Message);
aaWriteToLog('**************************************************************');
{$ENDIF}
   end;
 end;
end; // DecompressAndDecryptBuffer



{$IFDEF CLIENT_VERSION}

////////////////////////////////////////////////////////////////////////////////
//
// TMsgClientConnectionManager
//
////////////////////////////////////////////////////////////////////////////////

//------------------------------------------------------------------------------
// Create
//------------------------------------------------------------------------------
constructor TMsgClientConnectionManager.Create;
begin
  InitializeCriticalSection(FCSect);
  inherited Create;
  FListenerStoped := False;
  FSessions := TThreadList.Create;
  FConnections := TThreadList.Create;
  FSessionID := MAXINT;
  FConnectionID := -MAXINT;
  FApplication := '';
  FApplication := ParamStr(0);
  if FApplication = '' then
    FApplication := 'UNKNOWN';
  ThreadCount := 0;
{$IFDEF CONNECTION_TEST}
//  FOtherManager :=
{$ELSE}
 {$IFDEF NETWORK_TEST}
//  FOtherManager :=
  FClient := True;
 {$ENDIF}
{$ENDIF}
  FMaxThreadCount := MsgMaxThreadCount;
  FReceiveTimeOut := MsgReceiveTimeOut; 
{$IFDEF LOG_CLIENT_THREADS}
aaWriteToLog('TMsgClientConnectionManager.Create> Application: '+FApplication);
{$ENDIF}
end;// Create


//------------------------------------------------------------------------------
// Destroy
//------------------------------------------------------------------------------
destructor TMsgClientConnectionManager.Destroy;
begin
{$IFDEF DEBUG_LOG_NETWORK_ERRORS}
aaWriteToLog('TMsgClientConnectionManager.Destroy> Application: '+FApplication);
{$ENDIF}
  DisconnectAll;
  FListenerStoped := True;
  EnterCriticalSection(FCSect);
  FConnections.Free;
  FSessions.Free;
  FSessions := nil;
  LeaveCriticalSection(FCSect);
{ TODO -oAlex : Write ThreadCount to ErrorLog }
  DeleteCriticalSection(FCSect);
  inherited Destroy;
{$IFDEF DEBUG_LOG_NETWORK_ERRORS}
aaWriteToLog('TMsgClientConnectionManager.Destroy - FINISHED');
{$ENDIF}
end;// Destroy


//------------------------------------------------------------------------------
// PacketResendRequest
//------------------------------------------------------------------------------
procedure TMsgClientConnectionManager.PacketResendRequest(
                               Buffer:        PChar;
                               Network:       TMsgNetwork;
                               RemoteHost:    String;
                               RemotePort:    Integer;
                               PacketID:      Integer = -1;
                               Msg:           Boolean = False
                                 );
var
  Header:          PMsgPacketHeader;
begin
  Header := Pointer(Buffer);
  if Msg then
    Header.ControlCode := MsgMessagePacketResendRequest
  else
    Header.ControlCode := MsgPacketResendRequest;
  Header.Signature := MsgClientPacketSign;
  if (PacketID >= 0) then
    Header.PacketID := PacketID
  else