1:
2:
3:
4:
5:

begin
  Application.Initialize;
  Application.CreateForm(TFrmMain, FrmMain);
  Application.Run;
end.  // <===========                    

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:

procedure TTCPThread.DeleteFromList;
var i:integer;
    ThreadWorkHelp:PThreadWork;
    TCPThreadInList:TTCPThread;
begin
  tolog:='TCPThread.DeleteFromList - ID: TCPThread: '+inttostr(ThreadID)+'; AThread: '+inttostr(AThreadClient.ThreadID);
  Synchronize(log);  // tolog in logdatei schreiben
  i:=-1;
  try
    with ThreadWork.LockList do
    begin
      while (i<Count-1) do
      begin
        inc(i);
        ThreadWorkHelp:=Items[i];
        TCPThreadInList:=ThreadWorkHelp.TCPThread;
        if TCPThreadInList.ThreadID=ThreadID then
        begin
          tolog:='TCPThread.DeleteFromList - Deleted Thread #'+inttostr(i)+'; ID: TCPThread: '+inttostr(ThreadID)+'; AThread: '+inttostr(AthreadClient.ThreadID);
          Synchronize(log);
          Delete(i);
          break;
        end;
      end;
    end;
  finally
    ThreadWork.UnlockList;
  end;
  tolog:='TCPThread.DeleteFromList - ID: TCPThread: '+inttostr(ThreadID)+'; AThread: '+inttostr(AThreadClient.ThreadID)+' DONE';
  Synchronize(log);
end;                    

1:
2:
3:
4:

  TThreadWork=record
    AThread:TIdPeerThread;
    TCPThread:TTCPThread;
  end;                    

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

procedure TFrmMain.FormCreate(Sender: TObject);
begin
  HandleDisconnect:=true;
  TCPServer.Active:=True;
  ThreadWork:=TThreadList.Create;
  Application.OnException:=ErrorHandler;
  path:=extractfilepath(application.exename);
  if path[length(path)]<>'\' then path:=path+'\';
end;                    

1:

TCPServer.Active:=True;                    

1:

  TCPClient.WriteLn(request);                    

1:

    repeat until TCPClient.Connected;                    

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:

  if not exists then
  begin
    TCPClient:=TIdTCPClient.Create(Self);
    TCPClient.Host:=server;
    TCPClient.Port:=Port;

    TCPThread:=TTCPThread.Create(True);
    TCPThread.FreeOnTerminate:=true;
    TCPThread.TCPClient:=TCPClient;
    TCPThread.AThreadClient:=AThread;
//    TCPThread.OnTerminate:=TCPThread.TCPThreadTerminate;

    GetMem(ThreadWorkHelp,sizeof(TThreadWork));
    ThreadWorkHelp.AThread:=AThread;
    ThreadWorkHelp.TCPThread:=TCPThread;
    try
      with ThreadWork.Locklist do
      begin
        Add(ThreadWorkHelp);
        log('Created new thread #'+inttostr(Count-1));
      end;
    finally
      ThreadWork.UnlockList;
    end;

    TCPThread.Resume;
  end else
  begin
    TCPThread:=ThreadWorkHelp.TCPThread;
    TCPClient:=TCPThread.TCPClient;         // Wenn Client <-> Proxy schon existiert, soll die bestehende Verbiundung genutzt werden!
  end;

  log('REQUEST: '+url+' ['+server+':'+inttostr(Port)+']');
  

  if not TCPClient.Connected then
  begin
    TCPClient.Connect;
//    repeat until TCPClient.Connected;
  end;
  TCPClient.WriteLn(request);
end;                    

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:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:

procedure TFrmMain.TCPServerExecute(AThread: TIdPeerThread);
var buf:TStrings;
    server,url,request,hlp:string;
    port,r,i:integer;
    TCPClient:TIdTCPClient;
    TCPThread:TTCPThread;
    ThreadWorkHelp:PThreadWork;
    exists:boolean;
    List:TList;
begin
  if AThread.Terminated or (not AThread.Connection.Connected) then exit;        // wenn Thread beendet -> exit;
  log('TCPServer.Execute');
  buf:=TStringList.Create;
  request:='';
  AThread.Connection.ReadStrings(buf,1);
  repeat
    request:=request+buf[0]+#13+#10;
//    log('reuqest read: '+buf[0]);
    buf.Clear;
    AThread.Connection.ReadStrings(buf,1);
  until length(buf[0])=0;
  request:=request+#13+#10+#13+#10;  // jetzt hab ich das request und nun wird das verarbeitet -> es wird in verscheidene variablen aufgeteilt... HIER UNINTERESSANT
  buf.Free;
  url:=copy(request,pos(' ',request)+1,length(request));                        // alles vor dem ersten " " (inklusive) wegschneiden
  url:=copy(url,0,pos(' ',url)-1);                                              // alles nach dem ersten " " (inklusive) wegschneiden
  if lowercase(copy(url,0,7))<>'http://' then                                   // wenn Protokoll <> http
  begin
    send_error(AThread,'<b>PROXY ERROR:</b> Es wird nur das HTTP Protokoll unterstützt!');
    AThread.Connection.Disconnect;
    exit;
  end;
  server:=copy(url,8,length(url));                                              // "http://" wegschneiden
  if pos('/',server)<>0 then server:=copy(server,0,pos('/',server)-1);
  if pos(':',server)<>0 then
  begin
    hlp:=copy(server,pos(':',server)+1,length(server));
    val(hlp,port,r);
    log('Port: '+hlp);
    if r<>0 then
    begin
      send_error(AThread,'<b>PROXY ERROR:</b> Port-Fehler!');
      AThread.Connection.Disconnect;
      exit;
    end;
    server:=copy(server,0,pos(':',server)-1);
  end else port:=80;
  if not IsIPAddr(server) then server:=GetIPFromHost(server);
//  log('real REQUEST: '+request);

// HIER WIRDS WIEDER INTERESSANTER. Variablen sind alle ausgelesen und gesetzt

  exists:=false;
  i:=-1;
  try
    with ThreadWork.LockList do
    begin
      while (i<Count-1) do
      begin
        inc(i);
        ThreadWorkHelp:=Items[i];
        if ThreadWorkHelp.AThread=AThread then
        begin
          log('Reusing Thread #'+inttostr(i));
          exists:=true;                 // Verbindung Client <-> Proxy existiert schon...
          break;
        end;
      end;
    end;
  finally
    ThreadWork.UnlockList;
  end;

  if not exists then
  begin
    TCPClient:=TIdTCPClient.Create(Self);
    TCPClient.Host:=server;
    TCPClient.Port:=Port;

    TCPThread:=TTCPThread.Create(True);
    TCPThread.FreeOnTerminate:=true;
    TCPThread.TCPClient:=TCPClient;
    TCPThread.AThreadClient:=AThread;
//    TCPThread.OnTerminate:=TCPThread.TCPThreadTerminate;

    GetMem(ThreadWorkHelp,sizeof(TThreadWork));
    ThreadWorkHelp.AThread:=AThread;
    ThreadWorkHelp.TCPThread:=TCPThread;
    try
      with ThreadWork.Locklist do
      begin
        Add(ThreadWorkHelp);
        log('Created new thread #'+inttostr(Count-1));
      end;
    finally
      ThreadWork.UnlockList;
    end;

    TCPThread.Resume;
  end else
  begin
    TCPThread:=ThreadWorkHelp.TCPThread;
    TCPClient:=TCPThread.TCPClient;         // Wenn Client <-> Proxy schon existiert, soll die bestehende Verbiundung genutzt werden!
  end;

  log('REQUEST: '+url+' ['+server+':'+inttostr(Port)+']');
  

  if not TCPClient.Connected then
  begin
    TCPClient.Connect;
//    repeat until TCPClient.Connected;
  end;
  TCPClient.WriteLn(request);
end;                    

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:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:

unit thread;

interface

uses Classes, IdTCPClient, IdTCPServer;

type    TTCPThread = class (TThread)
        private
          Buf:array [1..10240] of byte;                 // Puffer
          BufSize,SizeToWrite:int64;                    // Puffergröße, Größe, die an Browser geschrieben werden soll
          FTCPClient:TIdTCPClient;                      // der TCPClient
          FAThreadClient:TIdPeerThread;                 // der TCPServer-Thread (Browser <-> Proxy)
          tolog:string;                                 // Hilfsvariable für's logging
          TerminateOK:boolean;                          // ist das TCPThread.Terminate OK?
          DisconnectOK: boolean;                        // Ist der Disconnect vom Webserver OK?
          procedure HandleInput;                        // schickt daten an Browser
          procedure log;                                // gibt inhalt von tolog aus
          procedure DeleteFromList;                     // löscht einen eintrag aus ThreadWork (den eigenen)
          procedure TCPThreadTerminate(Sender:TObject);
          procedure TCPClientDisconnect(Sender:TObject);
        protected
          procedure Execute; override;
        published
          property AThreadClient: TIdPeerThread read FAThreadClient write FAThreadClient;
          property TCPClient:TIdTCPClient read FTCPClient write FTCPClient;
          procedure EndWork;
        end;

implementation

uses mainFrm, SysUtils;

function ArrToStr(arr: array of byte;high:integer):string;
var i:integer;
begin
  result:='';
  i:=-1;
  while (i<high) do
  begin
    inc(i);
    result:=result+chr(arr[i]);
  end;
end;

procedure TTCPThread.Execute;
begin
  TerminateOK:=false;
  DisconnectOK:=false;
  OnTerminate:=TCPThreadTerminate;
  FTCPClient.OnDisconnected:=TCPClientDisconnect;
  tolog:='New Thread ID: TCPThread: '+inttostr(ThreadID)+'; AThread: '+inttostr(AthreadClient.ThreadID);
  Synchronize(log);
  while not Terminated do
  begin
    if not FTCPClient.Connected then
    begin
      EndWork;
//      FTCPClient.Connect;
    end else
    begin
      try
        FTCPClient.ReadBuffer(buf,1);
        BufSize:=FTCPClient.InputBuffer.Size;
        SizeToWrite:=1;
//        HandleInput;
        synchronize(HandleInput);
        if BufSize>0 then
        begin
          if BufSize>10240 then
          begin
            SizeToWrite:=10240;
            repeat
              FTCPClient.ReadBuffer(Buf,10240);
              Dec(BufSize,10240);
//              HandleInput;
              Synchronize(HandleInput);                                               // verarbeiten
            until BufSize<10240;
            if BufSize>0 then
            begin
              SizeToWrite:=BufSize;
              FTCPClient.ReadBuffer(Buf,BufSize);
              BufSize:=0;
//              HandleInput;
              Synchronize(HandleInput);
            end;
          end else
          begin
            SizeToWrite:=BufSize;
            FTCPClient.ReadBuffer(Buf,BufSize);
            BufSize:=0;
//            HandleInput;
            Synchronize(HandleInput);
          end;
        end else SizeToWrite:=0;
      except
//        EndWork;
      end;
    end;
  end;
end;

procedure TTCPThread.log;
begin
  FrmMain.log(tolog);
end;

procedure TTCPThread.HandleInput;                                               // PUFFER-VERARBEITUNG
begin
  if SizeToWrite=0 then exit;
  AThreadClient.Connection.WriteBuffer(Buf,SizeToWrite);
//  FrmMain.log('Writing: '+ArrToStr(buf,SizeToWrite));
end;

procedure TTCPThread.DeleteFromList;
var i:integer;
    ThreadWorkHelp:PThreadWork;
    TCPThreadInList:TTCPThread;
begin
//  FrmMain.log('TCPThread.DeleteFromList');
  tolog:='TCPThread.DeleteFromList - ID: TCPThread: '+inttostr(ThreadID)+'; AThread: '+inttostr(AThreadClient.ThreadID);
  Synchronize(log);
  i:=-1;
  try
    with ThreadWork.LockList do
    begin
      while (i<Count-1) do
      begin
        inc(i);
        ThreadWorkHelp:=Items[i];
        TCPThreadInList:=ThreadWorkHelp.TCPThread;
        if TCPThreadInList.ThreadID=ThreadID then
        begin
          tolog:='TCPThread.DeleteFromList - Deleted Thread #'+inttostr(i)+'; ID: TCPThread: '+inttostr(ThreadID)+'; AThread: '+inttostr(AthreadClient.ThreadID);
          Synchronize(log);
          FreeMem(ThreadWorkHelp);
          Delete(i);
          break;
        end else
        begin
//          tolog:='TCPThread.DeleteFromList - Checking Thread #'+inttostr(i)+' - no match';
//          Synchronize(log);
//          FrmMain.log('TCPThread.DeleteFromList - Checking Thread #'+inttostr(i)+' - No match');
        end;
      end;
    end;
  finally
    ThreadWork.UnlockList;
  end;
  tolog:='TCPThread.DeleteFromList - ID: TCPThread: '+inttostr(ThreadID)+'; AThread: '+inttostr(AThreadClient.ThreadID)+' DONE';
  Synchronize(log);
end;

procedure TTCPThread.EndWork;
begin
  tolog:='TCPThread.EndWork - ID: TCPThread: '+inttostr(ThreadID)+'; AThread: '+inttostr(AthreadClient.ThreadID);
  Synchronize(log);
  try
//    Synchronize(DeleteFromList);
    DeleteFromList;
  except
  end;
  try
    FTCPClient.Free;
{    DisconnectOK:=true;
    try
      FTCPClient.Disconnect;
    except
    end;
    repeat until not FTCPClient.Connected;
    try
      FTCPClient.Free;
    except
    end;
{    if AThreadClient.Data<>nil then
    try                     // damit nicht beide Seiten sich gegenseitig disconnecten!
      tolog:='TCPThread.EndWork - AThread.Connection.Disconnect';
      Synchronize(log);
      AThreadClient.Connection.Disconnect;
    except
    end;}
  except
  end;
  TerminateOK:=true;
  Terminate;
end;

procedure TTCPThread.TCPThreadTerminate(Sender:TObject);
begin
  //Dummy
  if not TerminateOK then EndWork;
end;

procedure TTCPThread.TCPClientDisconnect(Sender:TObject);
begin
  //dummy
{  if not DisconnectOK then
  begin}
    tolog:='TCPClient.Disconnect - ID: TCPThread: '+inttostr(ThreadID);
    synchronize(log);
    try
      AThreadClient.Connection.Disconnect;
    except
    end;
//  end;
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:
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:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:

unit thread;

interface

uses
  Classes, IdTCPClient, IdTCPServer;

const
  MAX_COUNT = 10240;

type
  TTCPThread = class (TThread)
    private
      Buf: array [1..MAX_COUNT] of Byte;   // Puffer
      SizeToWrite: Int64;                  // Puffergröße, Größe, die an Browser geschrieben werden soll
      FTCPClient: TIdTCPClient;            // der TCPClient
      FAThreadClient: TIdPeerThread;       // der TCPServer-Thread (Browser <-> Proxy)
      ToLog: String;                       // Hilfsvariable für's logging
      TerminateOK: Boolean;                // ist das TCPThread.Terminate OK?
      DisconnectOK: Boolean;               // Ist der Disconnect vom Webserver OK?
      procedure HandleInput;               // schickt daten an Browser
      procedure log;                       // gibt inhalt von tolog aus
      procedure DeleteFromList;            // löscht einen eintrag aus ThreadWork (den eigenen)
      procedure TCPThreadTerminate(Sender: TObject);
      procedure TCPClientDisconnect(Sender: TObject);
    protected
      procedure Execute; override;
    published
      property AThreadClient: TIdPeerThread read FAThreadClient write FAThreadClient;
      property TCPClient:TIdTCPClient read FTCPClient write FTCPClient;
      procedure EndWork;
    end;

implementation

uses
  mainFrm, SysUtils;

function ArrToStr(arr: array of byte; high: Integer): String;
var
  i: Integer;
begin
  Result := '';
  i := -1;
  while (i < high) do
  begin
    inc(i);
    Result := Result + Chr(arr[i]);
  end;
end;

procedure TTCPThread.Execute;
var
  BufSize: Int64;
begin
  TerminateOK := False;
  DisconnectOK := False;
  OnTerminate := TCPThreadTerminate;
  FTCPClient.OnDisconnected := TCPClientDisconnect;
  ToLog := 'New Thread ID: TCPThread: ' + IntToStr(ThreadID) +
           '; AThread: ' + IntToStr(AthreadClient.ThreadID);
  Synchronize(log);

  while not Terminated do
  begin
    if not FTCPClient.Connected then
    begin
      Terminate;
//      FTCPClient.Connect;
    end else
    begin
      try
        FTCPClient.ReadBuffer(Buf, 1);
        BufSize := FTCPClient.InputBuffer.Size;
        SizeToWrite := 1;
        Synchronize(HandleInput);

        SizeToWrite := 0;
        if BufSize > 0 then
        begin
          if BufSize > MAX_COUNT then
          begin
            SizeToWrite := MAX_COUNT;
            repeat
              FTCPClient.ReadBuffer(Buf, MAX_COUNT);
              Dec(BufSize, MAX_COUNT);
              Synchronize(HandleInput); // verarbeiten
            until BufSize < MAX_COUNT;
          end;

          if BufSize > 0 then
          begin
            SizeToWrite := BufSize;
            FTCPClient.ReadBuffer(Buf, BufSize);
            BufSize := 0;
            Synchronize(HandleInput);
          end;
        end;
      except
//        EndWork;
      end;
    end;
  end;
end;

procedure TTCPThread.log;
begin
  FrmMain.log(ToLog);
end;

procedure TTCPThread.HandleInput; // PUFFER-VERARBEITUNG
begin
  if SizeToWrite <> 0 then
    AThreadClient.Connection.WriteBuffer(Buf, SizeToWrite);
//  FrmMain.log('Writing: '+ArrToStr(buf,SizeToWrite));
end;

procedure TTCPThread.DeleteFromList;
var
  i: Integer;
  ThreadWorkHelp: PThreadWork;
  TCPThreadInList: TTCPThread;
begin
//  FrmMain.log('TCPThread.DeleteFromList');
  ToLog := 'TCPThread.DeleteFromList - ID: TCPThread: ' + IntToStr(ThreadID) +
           '; AThread: ' + IntToStr(AThreadClient.ThreadID);
  Synchronize(log);

  i := -1;
  try
    with ThreadWork.LockList do
    begin
      while (i < Count-1) do
      begin
        Inc(i);
        ThreadWorkHelp := Items[i];
        TCPThreadInList := ThreadWorkHelp.TCPThread;
        if TCPThreadInList.ThreadID = ThreadID then
        begin
          ToLog := 'TCPThread.DeleteFromList - Deleted Thread #' + IntToStr(i) +
                   '; ID: TCPThread: '+ IntToStr(ThreadID) +
                   '; AThread: ' + IntToStr(AthreadClient.ThreadID);
          Synchronize(log);
          FreeMem(ThreadWorkHelp);
          Delete(i);
          break;
        end else
        begin
//          tolog:='TCPThread.DeleteFromList - Checking Thread #'+inttostr(i)+' - no match';
//          Synchronize(log);
//          FrmMain.log('TCPThread.DeleteFromList - Checking Thread #'+inttostr(i)+' - No match');
        end;
      end;
    end;
  finally
    ThreadWork.UnlockList;
  end;
  ToLog := 'TCPThread.DeleteFromList - ID: TCPThread: ' + IntToStr(ThreadID) +
           '; AThread: ' + IntToStr(AThreadClient.ThreadID) + ' DONE';
  Synchronize(log);
end;

procedure TTCPThread.EndWork;
begin
  ToLog := 'TCPThread.EndWork - ID: TCPThread: ' + IntToStr(ThreadID) +
           '; AThread: ' + IntToStr(AthreadClient.ThreadID);
  Synchronize(log);
  try
    DeleteFromList;
  except
  end;
  try
    FTCPClient.Free;
{    DisconnectOK:=true;
    try
      FTCPClient.Disconnect;
    except
    end;
    repeat until not FTCPClient.Connected;
    try
      FTCPClient.Free;
    except
    end;
{    if AThreadClient.Data<>nil then
    try                     // damit nicht beide Seiten sich gegenseitig disconnecten!
      tolog:='TCPThread.EndWork - AThread.Connection.Disconnect';
      Synchronize(log);
      AThreadClient.Connection.Disconnect;
    except
    end;}
  except
  end;
  TerminateOK := True;
  Terminate;
end;

procedure TTCPThread.TCPThreadTerminate(Sender:TObject);
begin
  //Dummy
  if not TerminateOK then
    EndWork;
end;

procedure TTCPThread.TCPClientDisconnect(Sender:TObject);
begin
  //dummy
{  if not DisconnectOK then
  begin}
    ToLog := 'TCPClient.Disconnect - ID: TCPThread: ' + IntToStr(ThreadID);
    Synchronize(log);
    try
      AThreadClient.Connection.Disconnect;
    except
    end;
//  end;
end;

end.