Spielwiese - SocketTest

[stahli]

Also das Problem war hausgemacht durch die Umstellung auf Streams und einige kritische Zugriffe durch Threads.
Ich habe das jetzt bereinigt und es läuft augenscheinlich perfekt.

Anbei die wesentlichen Auszüge, falls es jemanden hilft.
Das komplette Framework werde ich hier nicht hochladen, da es scheinbar nicht sehr von Interesse ist.

Falls doch, schreibt eine pm.

Delphi-Quellcode:

procedure ...SendSLTo...(aSL: TStringList);
var
  MS: TMemoryStream;
  MSSize: LongInt;
begin
  MS := TMemoryStream.Create;
  aSL.SaveToStream(MS);
  MS.Seek(0, soBeginning);
  MSSize := MS.Size;
  fClientSocket.Socket.SendBuf(MSSize, SizeOf(MSSize));
  fClientSocket.Socket.SendStream(MS);
end;

procedure ...SocketClientRead(Sender: TObject; Socket: TCustomWinSocket);
const
  BufSize = 1024 * 10;
var
  Len: Integer;
  Bfr: Pointer;
begin
  GetMem(Bfr, BufSize);
  repeat
    Len := Socket.ReceiveBuf(Bfr^, BufSize);
    if (Len > 0) then
      fMessageHandlerServer.RegisterInBuffer(Bfr, Len, Socket);
  until (Len <= 0);
  FreeMem(Bfr);
end;

procedure ...RegisterInBuffer(const aBufr: Pointer; const aLen: Integer; const aConnection: TObject);
var
  lMS: TMemoryStream;
  lSL: TStringList;
  BreakFlag: Boolean;
begin
  fCS.Enter;
  try
    if (aLen > 0) then
    begin
      fMS.Seek(0, soEnd);
      fMS.Write(aBufr^, aLen);
    end;

    BreakFlag := False;
    repeat
      if (fBlockSize = 0) then
      begin
        if (fMSPos + SizeOf(fBlockSize) <= fMS.Size) then
        begin
          fMS.Position := fMSPos;
          fMS.Read(fBlockSize, SizeOf(fBlockSize));
          fMSPos := fMS.Position;
        end;
      end;

      if (fBlockSize > 0) then
      begin
        if (fMSPos + fBlockSize <= fMS.Size) then
        begin
          fMS.Position := fMSPos;
            lMS := TMemoryStream.Create;
            lMS.CopyFrom(fMS, fBlockSize);
            fMSPos := fMS.Position;
          lSL := TStringList.Create;
          lMS.Position := 0;
          lSL.LoadFromStream(lMS);
          LogSL('<==', '', lSL);
          RegisterInSL(lSL, aConnection);

          FreeAndNil(lMS);
          fBlockSize := 0;
        end
        else
          BreakFlag := True;
      end
      else
        BreakFlag := True;
    until (BreakFlag);

    if (fBlockSize = 0) then
    begin
      fMS.Clear;
      fMSPos := 0;
    end;
  finally
    fCS.Leave;
  end;
end;

procedure ...DoRegisterInSL(out aDone: Boolean);
var
  lSL: TStringList;
  lMessage: IsoMessage;
  lConnectionStringList: IsoConnectionStringList;
  lConnection: TObject;
begin
  aDone := False;
  lConnectionStringList := fMessageStringList.GetNextConnectionStringList;
  if Assigned(lConnectionStringList) then
  begin
    lConnection := lConnectionStringList.Connection;
    lSL := lConnectionStringList.GetNextSL;
    if Assigned(lSL) then
    begin
      if Assigned(fMessageImporter) then
      begin
        fMessageImporter.ResolveSLToMessage(lSL, lConnection, lMessage);
        if Assigned(lMessage) then
        begin
          fInMessageList.Add(lMessage);
          aDone := True;
        end;
      end;
      FreeAndNil(lSL);
    end;
  end;
end;