⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 msgconnection.old.pas

📁 Delphi MsgCommunicator 2-10 component.I ve used, really good job. can be Server-Client message appl
💻 PAS
📖 第 1 页 / 共 5 页
字号:
//
////////////////////////////////////////////////////////////////////////////////

//------------------------------------------------------------------------------
// Create
//------------------------------------------------------------------------------
constructor TMsgClientConnectionManager.Create;
begin
  InitializeCriticalSection(FCSect);
  inherited Create;
  FSessions := TThreadList.Create;
  FConnections := TThreadList.Create;
  FSessionID := MAX_INT;
  FConnectionID := -MAX_INT;
  FLiveSessions := 0;
  FApplication := '';
  FApplication := ParamStr(0);
  if FApplication = '' then
    FApplication := 'UNKNOWN';
{$IFDEF CONNECTION_TEST}
//  FOtherManager :=
{$ELSE}
 {$IFDEF NETWORK_TEST}
//  FOtherManager :=
  FClient := True;
 {$ENDIF}
{$ENDIF}
{$IFDEF DEBUG_LOG_NETWORK_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;
  EnterCriticalSection(FCSect);
  FConnections.Free;
  FSessions.Free;
  LeaveCriticalSection(FCSect);
  DeleteCriticalSection(FCSect);
  inherited Destroy;
{$IFDEF DEBUG_LOG_NETWORK_ERRORS}
aaWriteToLog('TMsgClientConnectionManager.Destroy - FINISHED');
{$ENDIF}
end;// Destoy


//------------------------------------------------------------------------------
// 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
    Header.Recepient := Header.Sender;
{$IFDEF DEBUG_LOG_NETWORK_RESENDING}
aaWriteToLog('TMsgClientConnectionManager.PacketResendRequest> asks to resend packet # '+IntToStr(Header.PacketID));
{$ENDIF}
  EnterCriticalSection(FCSect);
  try
   Network.RemoteHost := RemoteHost;
   Network.RemotePort := RemotePort;
   Network.SendBuffer(Buffer, SizeOf(TMsgPacketHeader));
  finally
   LeaveCriticalSection(FCSect);
  end;
end;// PacketResendRequest


//------------------------------------------------------------------------------
// OnDisconnect
//------------------------------------------------------------------------------
procedure TMsgClientConnectionManager.OnDisconnect(
                               FNetwork:      TMsgNetwork;
                               FromHost:      String;
                               FromPort:      Integer
                              );
var
  Sessions:             TList;
  Session:              TMsgComBaseSession;
  ClientSession:        PMsgClntSession;
  Connections:          TList;
  ClientConnection:     PMsgClntConnection;
  i, j:                 Integer;
  Found:                Boolean;
begin
{$IFDEF DEBUG_LOG_NETWORK_ONDISCONNECT}
aaWriteToLog('TMsgClientConnectionManager.OnDisconnect - START');
{$ENDIF}
  Connections:=FConnections.LockList;
  try
   j := Connections.Count-1;
   for i:=0 to j do
    begin
     ClientConnection := Connections.Items[i];
     if ClientConnection.Network = FNetwork then
      begin
       Found := True;
       break;
      end;
    end;
  finally
   FConnections.UnlockList;
  end;
  if not Found then
    raise EMsgException.Create(40021, ErrorRSessionNotConnected, [Integer(FNetwork)]);
  Found := False;
  Sessions:=FSessions.LockList;
  try
   j := Sessions.Count-1;
   for i:=j downto 0 do
    begin
     ClientSession := Sessions.Items[i];
     if ClientSession.ConnectionID = ClientConnection.ConnectionID then
      begin
       Found := True;
       Session := ClientSession.Session;
{$IFDEF DEBUG_LOG_NETWORK_ONDISCONNECT}
aaWriteToLog('TMsgClientConnectionManager.OnDisconnect - DoDisconnect');
{$ENDIF}
       DoDisconnect(Session);
       Session.OnDisconnect;
      end;
    end;
  finally
   FSessions.UnlockList;
  end;
  if not Found then
    raise EMsgException.Create(40021, ErrorRSessionNotConnected, [Integer(ClientConnection.ConnectionID)]);
{$IFDEF DEBUG_LOG_NETWORK_THREADS}
aaWriteToLog('TMsgClientConnectionManager.OnDisconnect - FINISH');
{$ENDIF}
end; // OnDisconnect


//------------------------------------------------------------------------------
// NetworkListener
//------------------------------------------------------------------------------
procedure TMsgClientConnectionManager.NetworkListener(
                               Buffer:        PChar;
                               BufferSize:    Integer;
                               Network:       TMsgNetwork;
                               FromHost:      String;
                               FromPort:      Integer
                              );
begin
  TMsgClientListenerThread.Create(self, Buffer, BufferSize, Network, FromHost, FromPort);
end;// NetworkListener


//------------------------------------------------------------------------------
// ReceiveMessage
//------------------------------------------------------------------------------
procedure TMsgClientConnectionManager.ReceiveMessage(
                          ClientSession:        PMsgClntSession;
                          var Buffer:     PChar;
                          var BufferSize: Integer
                          );
var
  i:                    Integer;
  Packet:               PMsgPacket;
  pBuf:                 PChar;
  StartTime:            DWORD;
begin
 try
{$IFDEF DEBUG_LOG_NETWORK}
aaWriteToLog('==============================================================');
aaWriteToLog('CLIENT has started to receive message');
{$ENDIF}
  EnterCriticalSection(FCSect);
  inc(ClientSession.Status);
  LeaveCriticalSection(FCSect);
  if ClientSession.MsgReceiveStatus<>MsgFullAnswer then
   begin
    while (ClientSession.MsgReceiveStatus<>MsgStartAnswer)
    and (ClientSession.MsgReceiveStatus<>MsgFullAnswer)
    do // Wait for starting answer receive
     begin
      if ClientSession.MsgControlCode = MsgTerminate then
       begin
        EnterCriticalSection(FCSect);
        dec(ClientSession.Status);
        LeaveCriticalSection(FCSect);
        raise EMsgException.Create(40041, ErrorRCannotReceiveFromServer,
                                [ClientSession.Session.ConnectParams.RemoteHost,
                                 ClientSession.Session.ConnectParams.RemotePort,
                                 ClientSession.Session.ConnectParams.LocalPort,
                                 ClientSession.Session.ConnectParams.ServerID]);
       end;
{$IFDEF ProcessMessages}
      Application.ProcessMessages;
{$ENDIF ProcessMessages}
      Sleep(MsgReceiveSleep);
     end;
    StartTime := GetTickCount;
    while ClientSession.MsgReceiveStatus<>MsgFullAnswer do // Wait for all packets to arrive
     begin
      if ClientSession.MsgControlCode = MsgTerminate then
       begin
        EnterCriticalSection(FCSect);
        dec(ClientSession.Status);
        LeaveCriticalSection(FCSect);
        raise EMsgException.Create(40041, ErrorRCannotReceiveFromServer,
                                [ClientSession.Session.ConnectParams.RemoteHost,
                                 ClientSession.Session.ConnectParams.RemotePort,
                                 ClientSession.Session.ConnectParams.LocalPort,
                                 ClientSession.Session.ConnectParams.ServerID]);
       end;
      if (GetTickCount - StartTime) > MsgReceiveTimeOut then
        raise EMsgException.Create(40026, ErrorRTimeoutFullReceive,
                                [ClientSession.ServerSessionID, MsgReceiveTimeOut]);
{$IFDEF ProcessMessages}
      Application.ProcessMessages;
{$ENDIF ProcessMessages}
      Sleep(MsgReceiveSleep);
     end;
   end;
{$IFDEF DEBUG_LOG_NETWORK}
aaWriteToLog('--------------------------------------------------------------');
aaWriteToLog('CLIENT are receiving message from SERVER #'+IntToStr(ClientSession.Session.ConnectParams.ServerID));
aaWriteToLog('--------------------------------------------------------------');
{$ENDIF}
//  TerminateMessageThreads(ClientSession);
  EnterCriticalSection(FCSect);
  BufferSize := 0;
  for i := 0 to ClientSession.MsgPackets.Count - 1 do
   begin
    Packet := ClientSession.MsgPackets.Items[i];
    BufferSize := BufferSize + Packet.BufferSize - SizeOf(TMsgPacketHeader);
   end;
  Buffer := MemoryManager.GetMem(BufferSize);
  pBuf := Buffer;
  for i := 0 to ClientSession.MsgPackets.Count - 1 do
   begin
    Packet := ClientSession.MsgPackets.Items[i];
    if Packet <> nil then
     begin
      if Packet.Buffer <> nil then
       begin
        Move(Pointer(Packet.Buffer+SizeOf(TMsgPacketHeader))^, pBuf^, Packet.BufferSize-SizeOf(TMsgPacketHeader));
        inc(pBuf, Packet.BufferSize-SizeOf(TMsgPacketHeader));
        MemoryManager.FreeAndNilMem(Packet.Buffer);
       end;
      Dispose(Packet);
      ClientSession.MsgPackets.Items[i] := nil;
     end;
   end;
  ClientSession.MsgPackets.Count := 0;
  LeaveCriticalSection(FCSect);
{$IFDEF DEBUG_LOG_NETWORK}
aaWriteToLog('CLIENT HAS RECEIVED Message FROM SERVER #'+IntToStr(ClientSession.Session.ConnectParams.ServerID));
aaWriteToLog('==============================================================');
{$ENDIF}
  ClientSession.MsgReceiveStatus := MsgNoAnswer;
  inc(ClientSession.ServerMessageID);
  EnterCriticalSection(FCSect);
  dec(ClientSession.Status);
  LeaveCriticalSection(FCSect);
 except
{$IFDEF DEBUG_LOG_NETWORK_ERRORS}
  on E: Exception do
    begin
aaWriteToLog('**************************************************************');
aaWriteToLog('MsgConnection> TMsgClientConnectionManager.ReceiveMessage - Error:');
aaWriteToLog(E.Message);
aaWriteToLog('**************************************************************');
    end;
{$ELSE}
  raise;
{$ENDIF}
 end; // except
end; // ReceiveMessage


//------------------------------------------------------------------------------
// ReceiveBuffer
//------------------------------------------------------------------------------
procedure TMsgClientConnectionManager.ReceiveBuffer(
                          Session:        TMsgComBaseSession;
                          var Buffer:     PChar;
                          var BufferSize: Integer
                          );
label
  Loop;
var
  Sessions:             TList;
  ClientSession:        PMsgClntSession;
  SessionFound:         Boolean;
  i:                    Integer;
  Packet:               PMsgPacket;
  pBuf:                 PChar;
  StartTime:            DWORD;
begin
{$IFDEF DEBUG_LOG_NETWORK_ERRORS}
aaWriteToLog('--------------------------------------------------------------');
aaWriteToLog('CLIENT has started to receive answer');
aaWriteToLog('--------------------------------------------------------------');
{$ENDIF}
 try

{$IFDEF DEBUG_LOG_NETWORK}
aaWriteToLog('==============================================================');
aaWriteToLog('CLIENT has started to receive answer');
{$ENDIF}
  SessionFound := False;
  Sessions := FSessions.LockList;
  try
   for i:=0 to Sessions.Count-1 do
    begin
     ClientSession := Sessions.Items[i];
     if (ClientSession.Session = Session)
     then
       begin
        SessionFound := True;
        break;
       end;
    end;
  finally
   FSessions.UnlockList;
  end;
  if not SessionFound then
    raise EMsgException.Create(40021, ErrorRSessionNotConnected, [Integer(Session)]);

  EnterCriticalSection(FCSect);
  inc(ClientSession.Status);
  LeaveCriticalSection(FCSect);

  if ClientSession.AnswerStatus<>MsgFullAnswer then
   begin
    while (ClientSession.AnswerStatus<>MsgStartAnswer)
    and (ClientSession.AnswerStatus<>MsgFullAnswer)
    do // Wait for starting answer receive
     begin
      if ClientSession.ControlCode = MsgTerminate then
       begin
        EnterCriticalSection(FCSect);
        dec(ClientSession.Status);
        LeaveCriticalSection(FCSect);
        raise EMsgException.Create(40041, ErrorRCannotReceiveFromServer,
                                [ClientSession.Session.ConnectParams.RemoteHost,
                                 ClientSession.Session.ConnectParams.RemotePort,
                                 ClientSession.Session.ConnectParams.LocalPort,
                                 ClientSession.Session.ConnectParams.ServerID]);
       end;
{$IFDEF ProcessMessages}
      Application.ProcessMessages;
{$ENDIF ProcessMessages}
      Sleep(MsgReceiveSleep);
     end;
    StartTime := GetTickCount;
    while ClientSession.AnswerStatus<>MsgFullAnswer do // Wait for all packets to arrive
     begin
      if ClientSession.ControlCode = MsgTerminate then
       begin
        EnterCriticalSection(FCSect);
        dec(ClientSession.Status);
        LeaveCriticalSection(FCSect);
        raise EMsgException.Crea

⌨️ 快捷键说明

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