hmmm... also ich hab nun n freemem an entsprechender stelle drin, haat aber net wirklich was gebracht
TTCPThread is ne Klasse von mir, die von TThread abgeleited is. Das ganze soll mal ein ProxyServer werden. Dazu brauch ich ein TidTCPServer, der die Verbindungen Browser <-> Mein Programm. Dann brauch ich noch nen TIdTCPClient der die Verbindung Mein Programm <-> Webserver.
Wenn der Browser also ne anfrage schickt springt mein TCPServer ein. Da wird dann die Procedue OnExecute aufgerufen. Die klamausert bei mir dann die daten aauseinander und "bestückt" einen TCPClient damit... so weit so gut.
wenn jetzt der Webserver antwortet, muss mein TCPClient einspringen. Da gibts aber kein Ereignis dazu (OnServerWrite oder sowas), also muss man das mit nem Thread abfangen. Das macht mein TTCPThread. und da gibts dann für jede Instanz von TCPClient einen TCPThread der dann immer diese Verbindung auf neue Nachrichten überprüft. und wie schon gesagt gibts für jeden Thread vom TCPServer (Verbindung Browser <-> mein Programm) (das is der AThread) einen TCPThread und einen TCPClient.
jetzt poste ich hier mal die unit "thread.pas", die bei mir den kompletten TTCPThread beinhaltet (is nun nich auskommentiert und auch nich "schöngemacht [ also auskommentierte Linien entfernt etc.] ).
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; BufSize,SizeToWrite:int64; FTCPClient:TIdTCPClient; FAThreadClient:TIdPeerThread; tolog:string; TerminateOK:boolean; DisconnectOK: boolean; procedure HandleInput; procedure log; procedure DeleteFromList; 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;
end else
begin
try
FTCPClient.ReadBuffer(buf,1);
BufSize:=FTCPClient.InputBuffer.Size;
SizeToWrite:=1;
synchronize(HandleInput);
if BufSize>0 then
begin
if BufSize>10240 then
begin
SizeToWrite:=10240;
repeat
FTCPClient.ReadBuffer(Buf,10240);
Dec(BufSize,10240);
Synchronize(HandleInput); until BufSize<10240;
if BufSize>0 then
begin
SizeToWrite:=BufSize;
FTCPClient.ReadBuffer(Buf,BufSize);
BufSize:=0;
Synchronize(HandleInput);
end;
end else
begin
SizeToWrite:=BufSize;
FTCPClient.ReadBuffer(Buf,BufSize);
BufSize:=0;
Synchronize(HandleInput);
end;
end else SizeToWrite:=0;
except
end;
end;
end;
end;
procedure TTCPThread.log;
begin
FrmMain.log(tolog);
end;
procedure TTCPThread.HandleInput; begin
if SizeToWrite=0 then exit;
AThreadClient.Connection.WriteBuffer(Buf,SizeToWrite);
end;
procedure TTCPThread.DeleteFromList;
var i:integer;
ThreadWorkHelp:PThreadWork;
TCPThreadInList:TTCPThread;
begin
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
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;
except
end;
TerminateOK:=true;
Terminate;
end;
procedure TTCPThread.TCPThreadTerminate(Sender:TObject);
begin
if not TerminateOK then EndWork;
end;
procedure TTCPThread.TCPClientDisconnect(Sender:TObject);
begin
tolog:='TCPClient.Disconnect - ID: TCPThread: '+inttostr(ThreadID);
synchronize(log);
try
AThreadClient.Connection.Disconnect;
except
end;
end;
end. |
Ich hoff, dass das irgendwas hilft...
hab nun bald den kompletten source hier gepostet.-.. könnte demnächst eigentlich auch den ganzen Project-Source ins Netz stellen
MrSaint
Andrew S. Tanenbaum - Modern Operating Systems
