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

📄 msgconnection.pas

📁 Delphi MsgCommunicator 2-10 component.I ve used, really good job. can be Server-Client message appl
💻 PAS
📖 第 1 页 / 共 5 页
字号:
{$ENDIF}
  CreateNetwork;
{$IFDEF DEBUG_LOG_NETWORK_ONDISCONNECT}
aaWriteToLog('MsgConnection> TMsgNetwork.ReCreateNetwork> Set...');
{$ENDIF}
  LocalPort := lLocalPort;
  RemotePort := lRemotePort;
  RemoteHost := lRemoteHost;
  LeaveCriticalSection(FManager.FCSect);
{$IFDEF DEBUG_LOG_NETWORK_ONDISCONNECT}
aaWriteToLog('MsgConnection> TMsgNetwork.ReCreateNetwork> FINISH');
{$ENDIF}
end; // ReCreateNetwork


//------------------------------------------------------------------------------
// Create
//------------------------------------------------------------------------------
constructor TMsgNetwork.Create(ConnectionManager: TMsgBaseConnectionManager);
begin
{$IFDEF DEBUG_LOG_NETWORK_TIME}
aaWriteToLog('TMsgNetwork.Create');
aaWriteToLog(IntToStr(gettickcount));
{$ENDIF}

  inherited Create;
  FManager := ConnectionManager;
  FLocalClient := RndClientID;
  CreateNetwork;

{$IFDEF DEBUG_LOG_NETWORK_TIME}
aaWriteToLog(IntToStr(gettickcount));
aaWriteToLog('');
{$ENDIF}
end;// Create


//------------------------------------------------------------------------------
// Destroy
//------------------------------------------------------------------------------
destructor TMsgNetwork.Destroy;
begin
{$IFDEF DEBUG_LOG_NETWORK_TIME}
aaWriteToLog('TMsgNetwork.Destroy');
aaWriteToLog(IntToStr(gettickcount));
{$ENDIF}

  FreeNetwork;
  inherited Destroy;

{$IFDEF DEBUG_LOG_NETWORK_TIME}
aaWriteToLog(IntToStr(gettickcount));
aaWriteToLog('');
{$ENDIF}
end;// Destoy


//------------------------------------------------------------------------------
// RndClientID
//------------------------------------------------------------------------------
function TMsgNetwork.RndClientID: TMsgNetworkClientID;
label generate;
begin
  Randomize;
generate:
  Result := Random(MAXINT); // - (MAXINT div 2);
  if (Result >= 0) and (Result < 1024) then // Reserved for ServerID
{ TODO -oAll: Add to DevGuide:
ServerID must be unique for each server working at the one machine.
We recomend to set ServerID from the region 0...1023.
}
   goto generate;
end;// RndClientID


//------------------------------------------------------------------------------
// SetRemoteHost
//------------------------------------------------------------------------------
procedure TMsgNetwork.SetRemoteHost(Host: String);
begin
{$IFDEF API_NETWORK}
  FMsgNetwork.RemoteHost := Host;
{$ELSE}
 {$IFDEF D6H}
  FRemoteHost := Host;
//  FNetworkClient.Host := Host;
 {$ELSE}
  FTransport.RemoteHost := Host;
 {$ENDIF}
{$ENDIF}
end;


//------------------------------------------------------------------------------
// GetRemoteHost
//------------------------------------------------------------------------------
function TMsgNetwork.GetRemoteHost: String;
begin
{$IFDEF API_NETWORK}
  Result := FMsgNetwork.RemoteHost;
{$ELSE}
 {$IFDEF D6H}
  Result := FRemoteHost;
//  Result := FNetworkClient.Host;
 {$ELSE}
  Result := FTransport.RemoteHost;
 {$ENDIF}
{$ENDIF}
end;


//------------------------------------------------------------------------------
// SetRemotePort
//------------------------------------------------------------------------------
procedure TMsgNetwork.SetRemotePort(Port: Integer);
begin
{$IFDEF DEBUG_LOG_NETWORK_TIME}
aaWriteToLog('TMsgNetwork.SetRemotePort');
aaWriteToLog(IntToStr(gettickcount));
{$ENDIF}

{$IFDEF API_NETWORK}
  FMsgNetwork.RemotePort := Port;
{$ELSE}
 {$IFDEF D6H}
  FRemotePort := Port;
//  FNetworkClient.Port := Port;
 {$ELSE}
  FTransport.RemotePort := Port;
 {$ENDIF}
{$ENDIF}

{$IFDEF DEBUG_LOG_NETWORK_TIME}
aaWriteToLog(IntToStr(gettickcount));
aaWriteToLog('');
{$ENDIF}
end;


//------------------------------------------------------------------------------
// GetRemotePort
//------------------------------------------------------------------------------
function TMsgNetwork.GetRemotePort: Integer;
begin
{$IFDEF API_NETWORK}
  Result := FMsgNetwork.RemotePort;
{$ELSE}
 {$IFDEF D6H}
  Result := FRemotePort;
//  Result := FNetworkClient.Port;
 {$ELSE}
  Result := FTransport.RemotePort;
 {$ENDIF}
{$ENDIF}
end;


//------------------------------------------------------------------------------
// SetLocalPort
//------------------------------------------------------------------------------
procedure TMsgNetwork.SetLocalPort(Port: Integer);
begin
{$IFDEF DEBUG_LOG_NETWORK_TIME}
aaWriteToLog('TMsgNetwork.SetLocalPort');
aaWriteToLog(IntToStr(gettickcount));
{$ENDIF}

{$IFDEF API_NETWORK}
  FMsgNetwork.LocalPort := Port;
{$ELSE}
 {$IFDEF D6H}
  FNetworkServer.Active := False;
  FNetworkServer.DefaultPort := Port;
  FNetworkServer.Active := True;
 {$ELSE}
  FTransport.LocalPort := Port;
 {$ENDIF}
{$ENDIF}

{$IFDEF DEBUG_LOG_NETWORK_TIME}
aaWriteToLog(IntToStr(gettickcount));
aaWriteToLog('');
{$ENDIF}
end;


//------------------------------------------------------------------------------
// SetLocalHost
//------------------------------------------------------------------------------
procedure TMsgNetwork.SetLocalHost(Host: String);
begin
{$IFDEF DEBUG_LOG_NETWORK_TIME}
aaWriteToLog('TMsgNetwork.SetLocalHost');
aaWriteToLog(IntToStr(gettickcount));
{$ENDIF}

{$IFDEF API_NETWORK}
  FMsgNetwork.LocalHost := Host;
{$ELSE}
  FLocalHost := Host;
{$ENDIF}

{$IFDEF DEBUG_LOG_NETWORK_TIME}
aaWriteToLog(IntToStr(gettickcount));
aaWriteToLog('');
{$ENDIF}
end;


//------------------------------------------------------------------------------
// GetLocalHost
//------------------------------------------------------------------------------
function TMsgNetwork.GetLocalHost: String;
begin
{$IFDEF API_NETWORK}
  Result := FMsgNetwork.LocalHost;
{$ELSE}
  Result := FLocalHost;
{$ENDIF}
end;


//------------------------------------------------------------------------------
// GetLocalPort
//------------------------------------------------------------------------------
function TMsgNetwork.GetLocalPort: Integer;
begin
{$IFDEF API_NETWORK}
  Result := FMsgNetwork.LocalPort;
{$ELSE}
 {$IFDEF D6H}
  Result := FNetworkServer.DefaultPort;
 {$ELSE}
  Result := FTransport.LocalPort;
 {$ENDIF}
{$ENDIF}
end;


//------------------------------------------------------------------------------
// SendBuffer
//------------------------------------------------------------------------------
procedure TMsgNetwork.SendBuffer(
                          Buffer: PChar;
                          Count:  Integer);
var
  Header: PMsgPacketHeader;
{$IFNDEF D6H}
  Buff: array [0..MsgMaxPacketSize] of Char;
{$ENDIF}
{$IFDEF DEBUG_LOG_NETWORK}
  buf: PChar;
  i: Integer;
{$ENDIF}
{$IFDEF NETWORK_TEST}
  Connections: TList;
  Connection:  PMsgClntConnection;
{$ENDIF}
{$IFDEF DEBUG_LOG_NETWORK_SHORT}
  str: String;
{$ENDIF}
begin
{$IFDEF DEBUG_LOG_NETWORK_TIME}
aaWriteToLog('TMsgNetwork.SendBuffer');
aaWriteToLog(IntToStr(gettickcount));
{$ENDIF}

  Header := PMsgPacketHeader(Buffer);
  Header.Sender := FLocalClient;
  Header.CheckSum := CheckSum(Buffer, Count);
{$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)
+' >>> '+RemoteHost+':'+IntToStr(RemotePort)
+' - '+IntToStr(GetTickCount)+' msec'
//+' <'+IntToStr(Header.Recepient)+'>'
;
aaWriteToLog(str);
{$ENDIF}
{$IFDEF DEBUG_LOG_NETWORK}
aaWriteToLog('--------------------------------------------');
aaWriteToLog('MsgConnection>TMsgNetwork.SendBuffer('+IntToHex(Integer(@Buffer),6)+', '+IntToStr(Count)+')');
aaWriteToLog('Sender    : '+IntToStr(FLocalClient));
aaWriteToLog('-----------');
aaWriteToLog('RemoteHost: '+RemoteHost);
aaWriteToLog('RemotePort: '+IntToStr(RemotePort));
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:');
buf:=MemoryManager.GetMem(Count-SizeOf(TMsgPacketHeader)+1);
Move(PChar(Integer(Buffer)+SizeOf(TMsgPacketHeader))^, buf^, Count-SizeOf(TMsgPacketHeader));
for i:= 0 to Count-SizeOf(TMsgPacketHeader)-1 do
  if (buf+i)^=#0 then
    (buf+i)^:='0';
(buf+Count-SizeOf(TMsgPacketHeader))^:=#0;
aaWriteToLog(buf);
aaWriteToLog('###');
MemoryManager.FreeAndNilMem(buf);
*)
{$ENDIF}

{******************************************************************************}
// Send Buffer
{******************************************************************************}
//  EnterCriticalSection(FCSect);
{$IFDEF NETWORK_TEST}
  if FManager.FClient then
   if Assigned(TMsgServerConnectionManager(FManager.FOtherManager).FNetwork.OnDataReceived) then
    TMsgServerConnectionManager(FManager.FOtherManager).FNetwork.OnDataReceived(Buffer, Count, LocalHost, LocalPort)
  else
   begin
    Connections:=TMsgClientConnectionManager(FManager.FOtherManager).FConnections.LockList;
    try
     Connection := Connections.Items[0];
    finally
     TMsgClientConnectionManager(FManager.FOtherManager).FConnections.UnlockList;
    end;
    Connection.Network.OnDataReceived(Buffer, Count, LocalHost, LocalPort);
   end;
{$ELSE}
 {$IFDEF API_NETWORK}
  FMsgNetwork.SendBuffer(Buffer, Count);
//  sleep(0); // TRY TO REMOVE!!!
 {$ELSE}
  {$IFDEF D6H}
  FNetworkServer.SendBuffer(FRemoteHost, FRemotePort, Buffer^, Count);
//  FNetworkClient.SendBuffer(Buffer^, Count);
  {$ELSE}
  Move(Buffer^, Buff[0], Count);
  FTransport.SendBuffer(Buff, Count);
  {$ENDIF D6H}
 {$ENDIF API_NETWORK}
{$ENDIF NETWORK_TEST}
//  LeaveCriticalSection(FCSect);
{******************************************************************************}

{$IFDEF DEBUG_LOG_NETWORK_TIME}
aaWriteToLog(IntToStr(gettickcount));
aaWriteToLog('');
{$ENDIF}
end; // SendBuffer


//------------------------------------------------------------------------------
// OnDisconnect
//------------------------------------------------------------------------------
procedure TMsgNetwork.OnDisconnect(
                             FromHost:  String;
                             FromPort:  Integer;
                             Recv:      Boolean = False
                             );
begin
{$IFDEF DEBUG_LOG_NETWORK_ONDISCONNECT}
aaWriteToLog('MsgConnection> TMsgNetwork.OnDisconnect> START - '+IntToStr(GetTickCount)+' msec');
aaWriteToLog('MsgConnection> TMsgNetwork.OnDisconnect> socket error from '+FromHost+':'+IntToStr(FromPort));
if Recv then
aaWriteToLog('MsgConnection> TMsgNetwork.OnDisconnect> recv error')
else
aaWriteToLog('MsgConnection> TMsgNetwork.OnDisconnect> send error');
{$ENDIF}
 try
  if (FManager = nil)
  or FManager.FListenerStoped
  then
   begin
{$IFDEF DEBUG_LOG_NETWORK_ONDISCONNECT}

⌨️ 快捷键说明

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