[DUG] SocketConnection in D6

[Ross Levis]

I also use these old controls (in D7) and have had an odd AV from 
TSocketConnection when closing the program, but it's been so rare that 
I've never bothered spending any time on it.  Thanks for the fix.

Ross.

----- Original Message ----- 
From: "Chocolate Fish Software" <ChocFish at xtra.co.nz>
To: "'NZ Borland Developers Group - Delphi List'" <delphi at ns3.123.co.nz>
Sent: Monday, December 19, 2005 4:08 PM
Subject: [DUG] SocketConnection in D6


Anyone else run into the TSocketConnection bug in D6 that causes access
violations and/or other errors when you disconnect or free the thing? 
If
you're using TSocketConnections but not explicitly closing them then 
you'll
get intermittent errors when your program ends, so if you sometimes get 
AVs
on exit then this might explain it.  I've encountered them on and off 
but
it's only now that I've tried FastMM that I've been able to pinpoint 
what
was going on.  It's TSocketTransport that's screwed (in D6).

The essence of the error is that when a socketconnection closes, its
transport thread closes its sockettransport (which frees the socket) 
through
its ITransport interface, which then falls out of scope, freeing the
sockettransport (it's an interfaced object) and in doing so, closing the
(now invalid) socket and freeing that... again.  Oops.  This error would
probably have been picked up before if it hadn't been happening within a
destructor in a thread other than the main thread.

To fix the error, create your own descendant of TSocketConnection to use
instead, as follows:

uses
  Windows, Messages, SysUtils, Classes, DB, DBClient, MConnect, 
SConnect,
  MidConst, RTLConsts;

type
  TcfSocketTransport = class(TSocketTransport, ITransport)
  protected
    { ITransport overrides }
    function GetWaitEvent: THandle; stdcall;
    procedure SetConnected(AValue: Boolean); stdcall;
  end;

  TcfSocketConnection = class(TSocketConnection)
  protected
    function CreateTransport: ITransport; override;
  end;

implementation

{ TcfSocketConnection }

function TcfSocketConnection.CreateTransport: ITransport;
var
  LSocketTransport: TcfSocketTransport;
begin
  if SupportCallbacks then
    if not LoadWinSock2 then raise Exception.CreateRes(@SNoWinSock2);
  if (Address = '') and (Host = '') then
    raise ESocketConnectionError.CreateRes(@SNoAddress);
  LSocketTransport := TcfSocketTransport.Create;
  LSocketTransport.Host := Host;
  LSocketTransport.Address := Address;
  LSocketTransport.Port := Port;
  LSocketTransport.InterceptGUID := InterceptGUID;
  Result := LSocketTransport as ITransport;
end;

{ TcfSocketTransport }

function TcfSocketTransport.GetWaitEvent: THandle;
begin
  if Assigned(Socket) then
  begin
    Result := inherited GetWaitEvent;
  end
  else Result := 0;
end;

procedure TcfSocketTransport.SetConnected(AValue: Boolean);
begin
  if not AValue and not Assigned(Socket) then Exit;
  inherited SetConnected(AValue);
  if not AValue then
    Socket := nil;
end;

Cheers,
Carl

_______________________________________________
Delphi mailing list
Delphi at ns3.123.co.nz
http://ns3.123.co.nz/mailman/listinfo/delphi