TServerSocket und Benutzeranmeldung

[uoeb7gp]

Hallo Schwedenbitter, eine Serverauthentifizierung kannst Du folgendermaßen implementieren.

1. Du definierst Dir einen Protokollheader, dieser Header ist logisch von den Daten getrennt.

Delphi-Quellcode:

{GENERIC HEADER}
  //-- Headeraufbau  MsgID = Byte = 0..255; Msg-Length = DWORD
  //-- +-----------------------------------------------|----------------+
  //-- |             Transport Header                  |  Daten Header  |
  //-- +--------------------|--------------------------|----------------+
  //-- |    Byte-MsgID      |  4Byte-DWORD Msg-Length  |     Daten      |
  //-- +--------------------|--------------------------|----------------+

  MSG_ID_LOGON           : Byte = 0;
  MSG_ID_DATA            : Byte = 1;
  MSG_ID_KEEP_ALLIVE     : Byte = 2;

{MSG_ID_LOGON}
  //-- Aufbau der Datenstruktur [Daten] für MSG_ID_LOGON
  //-- +--------------------+
  //-- |    TLogonRec       |
  //-- +--------------------+

Datenstruktur [Daten Header]

Delphi-Quellcode:

type
  TLogonSVRRec = packed record
    NTUser                : array[0..31] of Char;
    Passwort              : array[0..31] of Char;
    RechnerName           : array[0..31] of Char;
    RechnerIP             : array[0..31] of Char;
    GUID                  : array[0..63] of Char;
    UserFullName          : array[0..128] of Char;
    AnyIntData1           : integer;
    AnyIntData2           : integer;
    ptrClientObj          : pointer;    //-- out
  end;
  PLogonSVRRec = ^TLogonSVRRec;


  TDataRec = packed record
    Socket            : integer;
    ptrData           : Pointer; 
    cbSize            : DWORD;
    Error             : integer; 
    ErrorMsg          : PChar;
    ptrLogonSVRRec    : PLogonSVRRec;
  end;
  PDataRec = ^TDataRec;

2. Im ClientSocket Connect sendest du die Daten an den Server!

Delphi-Quellcode:

procedure TClientObj.ClientSocketConnect(const Sender: TObject;
  Socket: TCustomWinSocket);
begin
  try
    FSocketState := stConnect;
    if Assigned(CBConnect) then begin
       CBConnect('Client-Socket Connected  !');
    end;
    if (ClientObj <> NIL) then
       SendMsg(MSG_ID_LOGON, @MainClass.LogonInfo,
         SizeOf(TLogonSVRRec), ClientSocket.Socket);
  except
    FSocketState:=stError;
  end;
end;

3. Die Procedure SendMsg generiert den 5 Byte Header und fügt die Daten hinzu.

Delphi-Quellcode:

procedure TClientObj.SendMsg(MsgID: Byte; ptrData: Pointer; cbSize: Integer;
  Socket: TCustomWinSocket);
const
  HEADER_SIZE = sizeof(Byte) + sizeof(integer);
var
  ErrorCode:integer;
  fdSet: TFDSet;
Begin
  try
    FSendBuf.Seek(0, 0);
    FSendBuf.Write(MsgID, sizeof(Byte));
    FSendBuf.Write(cbSize, sizeof(integer));
    FSendBuf.Write(ptrData^, cbSize);
    Inc(cbSize, HEADER_SIZE);

    if socket.SendBuf(FSendBuf.memory^, cbSize, ErrorCode) <= 0 then begin
      if ErrorCode = WSAEWOULDBLOCK then begin
        FD_ZERO(fdSet);
        fdSet.fd_count := 1;
        fdSet.fd_array[0] := socket.SocketHandle;

        if (Select(0, nil, @fdSet, nil, nil) <> 1) or
          (socket = NIL) or (not socket.Connected) then EXIT;

        socket.SendBuf(FSendBuf.memory^, cbSize, ErrorCode);
      end;
    end;
    
  except
    FSocketState := stError;
  end;
end;

4. Am server Extrahierst du den Header.

Delphi-Quellcode:

procedure TServerObj.ServerSocketClientConnect(const Sender: TObject;
  const Socket: TCustomWinSocket);
var
  DataRec: TDataRec;
begin
  try
    TCliCon.Create(FIntHash, FStringHash, Socket);
  except
    on e:exception do begin
      if Assigned(@CBClientError) then begin
        FillChar(DataRec, SizeOf(TDataRec), 0);
        DataRec.Socket := Socket.SocketHandle;
        DataRec.Error := wsagetlasterror;
        DataRec.ErrorMsg := PChar(
          'EXCEPTION > TServerObj.ServerSocketClientConnect: ' + e.Message
          );
        CBClientError(@DataRec);
      end;
    end;
  end;
end;

procedure TServerObj.ServerSocketClientRead(const Sender: TObject;
  const Socket: TCustomWinSocket);
var
  cbRcv: integer;
  RcvBuf: array [0..WSOCK_READ_BUFFER_SIZE * 8] of Byte;
  RcvBufItem: TRcvBufItem;
  hMemData: hGlobal;
  hMemStruct: hGlobal;
begin
  cbRcv := Socket.ReceiveBuf(RcvBuf[0], WSOCK_READ_BUFFER_SIZE * 8);
  if cbRcv <= 0 then EXIT;

  if Socket.SocketHandle <= 0 then EXIT;

  hMemData := GlobalAlloc(GMEM_FIXED, cbRcv);
  move(RcvBuf[0], Pointer(hMemData)^, cbRcv);

  hMemStruct := GlobalAlloc(GMEM_FIXED, SizeOf(TRcvBufItem));

  RcvBufItem.ptrData    := Pointer(hMemData);
  RcvBufItem.cbData     := cbRcv;
  RcvBufItem.Socket     := Socket.SocketHandle;
  RcvBufItem.hMemStruct := hMemStruct;
  RcvBufItem.hMemData   := hMemData;

  move(RcvBufItem, Pointer(hMemStruct)^, SizeOf(TRcvBufItem));

  if FRecvBuffer.Write(Pointer(hMemStruct), SizeOf(TRcvBufItem)) <>
    SizeOf(TRcvBufItem) then
  begin
    FRecvBuffer.SetBufSize((FRecvBuffer.BufSize + cbRcv) * 2);
    FRecvBuffer.Remove(SizeOf(TRcvBufItem));
    if FRecvBuffer.Write(Pointer(hMemStruct), SizeOf(TRcvBufItem)) <>
      SizeOf(TRcvBufItem) then
        raise exception.Create('you should never see this');
  end;

  SetEvent(FMsgDispatchEvent);
end;

5. Das erste Byte des Headers ist die MSG-ID, ist die Msg gültig, dann
solange aus dem Socket lesen, bis die 4Byte-DWORD Msg-Length erreicht ist.

Delphi-Quellcode:

procedure TServerObj.Execute;
const
  HEADER_LENGTH = SizeOf(byte) + SizeOf(DWORD);
var
  cbRcv: integer;
  cbWritten: integer;
  cbRest: integer;
  ptrByte: ^Byte;
  nLen: integer;
  nDataSize: integer;
  cb: integer;
  nMsgID: Byte;
  p: pointer;
  CliCon: TCliCon;
  RcvBuf: array [0..WSOCK_READ_BUFFER_SIZE * 8] of byte;
  RcvBufItem: TRcvBufItem;
begin
  while not terminated  do begin

    if FRecvBuffer.CountBytes > 0 then begin

      RcvBufItem :=  TRcvBufItem(FRecvBuffer.Peek(nLen)^);

      if FRecvBuffer.Remove(SizeOf(TRcvBufItem)) <> SizeOf(TRcvBufItem) then
        raise exception.Create('nLen <> FRecvBuffer.Remove(nLen)');

      cbRcv := RcvBufItem.cbData;
      if cbRcv <= 0 then
        raise exception.create('cbRcv <= 0');

      move(RcvBufItem.ptrData^, RcvBuf[0], cbRcv);

      CliCon := FIntHash.ValueOf(RcvBufItem.Socket);
      if CliCon = nil then begin
        if GlobalFree(RcvBufItem.hMemData) <> 0 then
          raise exception.create('GlobalFree(RcvBufItem.hMemData)) <> 0');

        if GlobalFree(RcvBufItem.hMemStruct) <> 0 then
          raise exception.create('GlobalFree(RcvBufItem.hMemStruct) <> 0');
        Continue;
      end;

      cbWritten := CliCon.FMemBuf.Write(@RcvBuf[0], cbRcv);
      cbRest := cbRcv - cbWritten;
      if cbRest <> 0 then begin
        CliCon.FMemBuf.SetBufSize((CliCon.FMemBuf.BufSize + cbRcv) * 2);

        if CliCon.FMemBuf.Write(@RcvBuf[cbWritten], cbRest) <> cbRest then
          raise exception.Create('you should never see this');
      end;

      while true do begin
        nLen := HEADER_LENGTH;
        ptrByte := CliCon.FMemBuf.Peek(nLen);
        if ptrByte <> nil then
        begin
          move(ptrByte^, nMsgID, SizeOf(Byte));
          inc(ptrByte, SizeOf(Byte));
          move(ptrByte^, nDataSize, SizeOf(DWORD));
        end else begin
          Break;
        end;

        if nMsgID > MSG_ID_KEEP_ALLIVE then begin
          CliCon.FMemBuf.Remove(CliCon.FMemBuf.BufSize);
          raise exception.Create('not (nMsgID in [MSG_ID_LOGON..MSG_ID_KEEP_ALIVE])');
        end;

        if CliCon.FMemBuf.CountBytes >= nDataSize + HEADER_LENGTH then
        begin //-- Mindestens ein Datensatz ist vorhanden
          if CliCon.FMemBuf.Remove(HEADER_LENGTH) = 0 then
            raise exception.Create('Buffer.Remove(HEADER_LENGTH) = 0');

          cb := nDataSize;
          p := CliCon.FMemBuf.Peek(cb);

          CliCon.ProcessMessage(nMsgID, p, nDataSize);

          if CliCon.FMemBuf.Remove(nDataSize) = 0 then
            raise exception.Create('Buffer.Remove(nDataSize) = 0');
        end else //-- if CliCon.FMemBuf.CountBytes >= nDataSize + HEADER_LENGTH
          Break;
      end; //-- while true do begin

      if GlobalFree(RcvBufItem.hMemData) <> 0 then
        raise exception.create('GlobalFreeII(RcvBufItem.hMemData)) <> 0');

      if GlobalFree(RcvBufItem.hMemStruct) <> 0 then
        raise exception.create('GlobalFreeII(RcvBufItem.hMemStruct) <> 0');
    end else begin
      DoGarbageCollection;
      Waitforsingleobject(FMsgDispatchEvent, INFINITE);
    end;
  end;
end;

6. Die Daten aufbereiten, validieren und gegebenenfalls ungültigen Client disconnecten etc. usw.

Delphi-Quellcode:

procedure TCliCon.ProcessMessage(nMsgID: Byte; ptrData: Pointer; cbSize: DWORD);
var
  nKeepAlive: Byte;
  DataRec: TDataRec;
begin
  try
    if nMsgID = MSG_ID_DATA then begin
      try
        if Assigned(@ServerObj.CBData) then begin
          FillChar(DataRec, SizeOf(TDataRec), 0);
          DataRec.Socket := FSocket.SocketHandle;
          DataRec.ptrData := ptrData;
          DataRec.cbSize := cbSize;
          DataRec.ptrLogonSVRRec := @FLogonRec;
          ServerObj.CBData(@DataRec);
        end;
      except
        on e:exception do begin
           if Assigned(@ServerObj.CBClientError) then begin
             FillChar(DataRec, SizeOf(TDataRec), 0);
             DataRec.Socket := FSocket.SocketHandle;
             DataRec.Error := WSAGetLastError;
             DataRec.ErrorMsg := PChar(
               'EXCEPTION > $0228 [MSG_ID_DATA] : ' + e.Message
               );
             ServerObj.CBClientError(@DataRec);
           end;
           try FSocket.Close except end;
        end;
      end;
    end else
    if nMsgID = MSG_ID_LOGON then begin
      try
        move(ptrData^, FLogonRec, SizeOf(TLogonSVRRec));
        FLogonRec.ptrClientObj := FSocket;
        FStringHash.Add(FLogonRec.GUID, self);

        if Assigned(@ServerObj.CBLogon) then begin
          FillChar(DataRec, SizeOf(TDataRec), 0);
          DataRec.Socket := FSocket.SocketHandle;
          DataRec.ptrData := ptrData;
          DataRec.cbSize := cbSize;
          DataRec.ptrLogonSVRRec := @FLogonRec;
          ServerObj.CBLogon(@DataRec);
        end;
      except
        on e:exception do begin
           if Assigned(@ServerObj.CBClientError) then begin
             FillChar(DataRec, SizeOf(TDataRec), 0);
             DataRec.Socket := FSocket.SocketHandle;
             DataRec.Error := WSAGetLastError;
             DataRec.ErrorMsg := PChar(
               'EXCEPTION > $0227 [MSG_ID_LOGON] : ' + e.Message
               );
             ServerObj.CBClientError(@DataRec);
           end;
           try FSocket.Close except end;
        end;
      end;
    end else
    if nMsgID = MSG_ID_KEEP_ALLIVE then begin
      try
        //-- KeepAllive Retournieren
        SendMsg(MSG_ID_KEEP_ALLIVE, @nKeepAlive, SizeOf(Byte));
      except
        on e:exception do begin
           if Assigned(@ServerObj.CBClientError) then begin
             FillChar(DataRec, SizeOf(TDataRec), 0);
             DataRec.Socket := FSocket.SocketHandle;
             DataRec.Error := WSAGetLastError;
             DataRec.ErrorMsg := PChar(
               'EXCEPTION > $0228 [MSG_ID_KEEP_ALLIVE] : ' + e.Message
               );
             ServerObj.CBClientError(@DataRec);
           end;
           try FSocket.Close except end;
        end;
      end;
    end;
  except
    on e:exception do begin
       if Assigned(@ServerObj.CBClientError) then begin
         FillChar(DataRec, SizeOf(TDataRec), 0);
         DataRec.Socket := FSocket.SocketHandle;
         DataRec.Error := WSAGetLastError;
         DataRec.ErrorMsg := PChar(
           'EXCEPTION > TCliCon.ProcessMessage [GENERAL] : 1449 ' + e.Message
           );
         ServerObj.CBClientError(@DataRec);
       end;
    end;
  end;
end;

Prinzipiell wars das schon!

Beispielprogramm und Sourcen sind unter folgendem Thread verfügbar.

http://www.delphipraxis.net/internal...457&highlight=

Threaded-Buffered Async Socket (Client, Server Library incl. Source mit Demoprogramm)

lg.