Unit SocketServerConnections; { This is an implementation of a GenericServerConnection. This is the prefered implementation. Other implementations try to look like a TCP/IP socket. This is a fairly simple wrapper around the TCP/IP component. We use that component, rather than using system calls directly, because this gives us access to the SOCKS proxy. This particular component does a good job with the asynchronous communication. This way we don't have to create a seperate thread to talk to the socket. } Interface Uses GenericServerConnection, OverbyteIcsWSocket; Type TSocketServerConnectionType = (sscNone, sscConnected, sscClosed); TSocketServerConnection = Class(TGenericServerConnection) Private WSocket1: TWSocket; FAddress, FPort : String; FStatus : TSocketServerConnectionType; Procedure WSocket1SessionClosed(Sender: TObject; Error: Word); Procedure WSocket1SessionConnected(Sender: TObject; Error: Word); Procedure WSocket1DataAvailable(Sender: TObject; Error: Word); Procedure WSocket1ChangeState(Sender: TObject; OldState, NewState : TSocketState); Public Constructor Create(Address, Port : String); Destructor Destroy; Override; Function Connect : Boolean; Override; Procedure SendStr(S : String); Override; Function GetAll : String; Override; Procedure Close; Override; End; Implementation Uses MiscDebugWindows, TypInfo, SysUtils, Windows, StrUtils; Var //DebugOut : Text; DebugOutReady : Boolean = False; Procedure DebugWrite(S : String); Begin // Uncomment the following to see a lot of debug output. Keep it // commented most of the time for performance reasons. This can generate // a BIG file. // Note: New code should use MiscDebugWindows.pas. I wrote debug stuff // to a file because MiscDebugWindows.pas didn not exist at the time. {If Not DebugOutReady Then Begin Assign(DebugOut, 'C:\temp\debug.txt'); Rewrite(DebugOut); DebugOutReady := True End; WriteLn(DebugOut, GetCurrentThreadId(), ': ', S); Flush(DebugOut) } End; Procedure TSocketServerConnection.Close; Begin DebugWrite('TSocketServerConnection.Close'); If Assigned(WSocket1) And (FStatus <> sscClosed) Then WSocket1.Close End; Constructor TSocketServerConnection.Create(Address, Port : String); Begin FAddress := Address; FPort := Port; DebugWrite('TSocketServerConnection.Create(''' + Address + ''', ''' + Port + ''')') End; Destructor TSocketServerConnection.Destroy; Begin DebugWrite('TSocketServerConnection.Destroy'); If (FStatus <> sscClosed) And Assigned(OnSessionClosed) Then Begin DebugWrite(' >>OnSessionClosed'); OnSessionClosed(Self); DebugWrite(' < 0) And (Length(SocksPort) > 0) And (Length(SocksLevel) > 0) Then Begin WSocket1.SocksServer := SocksServer; WSocket1.SocksPort := SocksPort; WSocket1.SocksUsercode := SocksUsercode; WSocket1.SocksPassword := SocksPassword; WSocket1.SocksLevel := SocksLevel; If Length(SocksUserCode) > 0 Then WSocket1.SocksAuthentication := socksAuthenticateUsercode End; DebugWrite('TSocketServerConnection.Connect 4'); WSocket1.OnSessionClosed := WSocket1SessionClosed; WSocket1.OnSessionConnected := WSocket1SessionConnected; WSocket1.OnDataAvailable := WSocket1DataAvailable; WSocket1.OnChangeState := WSocket1ChangeState; DebugWrite('Before connect: ' + GetEnumName(TypeInfo(TSocketState), Ord(WSocket1.State))); Try // I don't think I'm doing this right. To do a better job I should // really call DnsLookup first. According to the documentation, this // is the only way to ensure that the DNS lookup is done in the // background. It hasn't been a problem, since we are only going to our // own site, and our DNS almost never fails, but still, we could do // better. WSocket1.Connect; Except // Note: Before I added this exception handler, we had trouble recovering // from some types of errors. In particular if you hibernated, then the // network would go down. It would not come up until after this process // was already running. When we tried to reconnect, there would be an // exception here because of a DNS error. We would not recover from // that as quickly as we should have. Eventually GetAlertData.pas would notice // a timeout, but that would be long after we saw the problem here. On Ex : Exception Do Begin Result := False; If (Ex.ClassName = 'ESocketException') And (LeftBStr(Ex.Message, 56) = 'connect: WSocketResolveHost: Cannot convert host address') Then FConnectionErrorMessage := 'DNS error' Else FConnectionErrorMessage := 'TSocketServerConnection.Connect, ' + Ex.ClassName + ', ' + Ex.Message; DebugWrite('Exception ' + Ex.ClassName + ' ' + Ex.Message); If Assigned(OnSessionClosed) Then OnSessionClosed(Self) End End; DebugWrite('After connect: ' + GetEnumName(TypeInfo(TSocketState), Ord(WSocket1.State))) End; Procedure TSocketServerConnection.WSocket1SessionClosed(Sender: TObject; Error: Word); Begin DebugWrite('TSocketServerConnection.WSocket1SessionClosed'); FStatus := sscClosed; If Assigned(OnSessionClosed) Then OnSessionClosed(Self) End; Procedure TSocketServerConnection.WSocket1SessionConnected(Sender: TObject; Error: Word); Begin DebugWrite('TSocketServerConnection.WSocket1SessionConnected'); If (Error = 0) And (FStatus = sscNone) Then Begin FStatus := sscConnected; If Assigned(OnSessionConnected) Then OnSessionConnected(Self) End End; Procedure TSocketServerConnection.WSocket1DataAvailable(Sender: TObject; Error: Word); Begin If Assigned(OnDataAvailable) Then OnDataAvailable(Self) End; Procedure TSocketServerConnection.WSocket1ChangeState(Sender: TObject; OldState, NewState : TSocketState); Begin DebugWrite('ChangeState ' + GetEnumName(TypeInfo(TSocketState), Ord(OldState)) + ' -> ' + GetEnumName(TypeInfo(TSocketState), Ord(NewState))) End; Procedure TSocketServerConnection.SendStr(S : String); Begin Assert(FStatus <> sscNone); If FStatus = sscConnected Then WSocket1.SendStr(S) End; Function TSocketServerConnection.GetAll : String; Var FilledSoFar, ReadThisTime : Integer; Begin SetLength(Result, 4096); FilledSoFar := 0; Repeat If Length(Result) = FilledSoFar Then SetLength(Result, Length(Result) * 2); ReadThisTime := WSocket1.Receive(PChar(Result) + FilledSoFar, Length(Result) - FilledSoFar); If ReadThisTime <= 0 Then Break; FilledSoFar := FilledSoFar + ReadThisTime Until False; SetLength(Result, FilledSoFar) End; Initialization // This is required to avoid a very nasty bug. The details vary. The most // common and repeatable way to produce the bug was to run TI Pro, then // make my laptop hibernate. A few seconds after the machine comes back to // life, there would be a message box telling us that a serious bug had // occured. (Do you want to tell Microsoft?). The program appeared to work // perfectly, if you ignored that message box, but as soon as you closed the // message box, it would close TI Pro. // // This happened in other forms, and at other times, too. Usually your // initial connection to the net would work perfectly, but sometimes the // first time you tried to reconnect the software would freeze up. // // This bug could change forms slightly based on almost random changes // in the host application. I believe this bug has been around for a long // time, but older versions of TI Pro didn't set it off. The exact details // are too chaotic to describe. // // Note: The same bug happened when you use the HTTP tunnels. It's not // limited to the use of this unit. So maybe this line belongs somewhere // else. // // PDS 6/22/2006 WSocketForceLoadWinsock; End.