1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:

procedure TtoIFCommServer.OnServerConnect(toThread: TIdPeerThread);
var
  recRequest     : TrecMsgHeader;
  recReply       : TrecMsgLogOn;

  pNewConnection : PrecIFConnection;

  cardMinWait    : Cardinal;

  siCounter      : SmallInt;
begin
  LogEvent(Format(g_astrIFComBase[4], [toThread.Connection.LocalName]),
            IF_CONST_LOGCONNECT,
            etInfo,
           IF_CONST_LOGLEVEL_MIN);

  GetMem(pNewConnection, SizeOf(TrecIFConnection));

  pNewConnection.strDNS       := toThread.Connection.LocalName;
  pNewConnection.dtConnStart  := Now;
  pNewConnection.dtLastAction := pNewConnection.dtConnStart;
  pNewConnection.pConnection  := toThread;

  cardMinWait                 := GetTickCount + IF_CONST_WAITAFTERCONNECT;

  repeat
    pNewConnection.iSessionID  := Random(IF_CONST_SESSIONIDRANGE);
  until F_tolConThreads.SessionIDIsUnique(pNewConnection.iSessionID);

  toThread.Data                := TObject(pNewConnection);

  recRequest                  := F_toComBase.CreateMsgHeader(IF_CONST_TCPIPHOST,
                                                             EmptyStr,
                                                             EmptyStr,
                                                             svctCommSvr,
                                                             mtRequestLogOn,
                                                             pNewConnection.iSessionID);
  ZeroMemory(@recReply, SizeOf(recReply));

  while GetTickCount < cardMinWait do
    g_procProcessMessages;

  if F_toComBase.ExchangeMsgs(toThread.Connection,
                              @recRequest,
                              @recReply,
                              SizeOf(recRequest),
                              SizeOf(recReply)) = frOK then
  begin
    pNewConnection.strName        := recReply.recHeader.strClientname;
    pNewConnection.strTargetname  := recReply.recHeader.strTargetname;
    pNewConnection.secClientType  := recReply.recHeader.secClientType;
    pNewConnection.bLoggedOn      := TRUE;
  end
  else
  begin
    pNewConnection.strName        := g_astrIFComBase[31];
    pNewConnection.strTargetname  := g_astrIFComBase[31];
    pNewConnection.secClientType  := svctUnknown;
    pNewConnection.bLoggedOn      := FALSE;
  end;
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:

function TtoIFComBase.ExchangeMsgs(toConnection: TIdTCPConnection; pSend, pReply: Pointer; iSendLength, iReplyLength: Integer; bExpectMsgHeader: Boolean): TsecFuncResult;
begin
  Result  := frError;

  if Assigned(toConnection) then
  begin
    if Assigned(pSend) then
    begin
      if Assigned(pReply) then
      begin
        try
          if SendData(toConnection, pSend, iSendLength)then
          begin
            Sleep(IF_CONST_MINWAITFORREPLY);
            Result  := ReadData(toConnection, pReply, iReplyLength, bExpectMsgHeader);
          end;
        except
          Result  := frError;
        end;
      end;
    end;
  end;
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:

function TtoIFComBase.SendData(toConnection: TIdTCPConnection; pData: Pointer; cardDataLength: Cardinal): Boolean;
begin
  Result  := TRUE;
  try
    if (Assigned(toConnection)) and
       (toConnection.Connected) then
      toConnection.WriteBuffer(pData^, cardDataLength, TRUE)
    else
      Result  := FALSE;
  except
    Result  := FALSE;
  end;
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:

procedure TService_IFSendMsg.ContactExecute(AThread: TIdPeerThread);
var
  recMsgHeader  : TrecMsgHeader;
begin
  ShowMessage('Execute');  //Debug - bloß nicht vergessen ...

  if AThread.Connection.Socket.Binding <> nil then
  begin
    F_toIFCom.ReadData(AThread.Connection,
                       @recMsgHeader,
                       SizeOf(TrecMsgHeader));

    LogEvent(F_toIFCom.GetMsgInfo(recMsgHeader),
             IF_CONST_LOGEXECUTE,
             etInfo,
             IF_CONST_LOGLEVEL_MED);
.
.
.					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:

procedure g_procProcessMessages;
var
  msgActWinMessage  : TMsg;
begin
  while PeekMessage(msgActWinMessage, 0, 0, 0, PM_REMOVE) do
  begin
    TranslateMessage(msgActWinMessage);
    DispatchMessage(msgActWinMessage);
  end;
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:

procedure TService_IFSendMsg.LogEvent(strMessage, strKey: String; secEventType: TsecEventTypes; byLogLevel: Byte);
var
  csLock  : TCriticalSection;
begin
  csLock  := TCriticalSection.Create;
  try
    csLock.Acquire;

    F_toSvcBase.LogEvent(strMessage,
                         strKey,
                         secEventType,
                         byLogLevel);
  finally
    csLock.Release;
    FreeAndNil(csLock);
  end;
end;