1:
2:

IOHandler.ReadStream(Stream,ByteCount);
IOHandler.Write(Stream,ByteCount);					

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:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
391:
392:
393:
394:
395:
396:
397:
398:
399:
400:
401:
402:
403:
404:
405:
406:
407:
408:
409:
410:
411:
412:
413:
414:
415:
416:
417:
418:
419:
420:
421:
422:
423:
424:
425:
426:
427:
428:
429:
430:
431:
432:
433:
434:
435:
436:
437:
438:
439:
440:
441:
442:
443:
444:
445:
446:
447:
448:
449:
450:
451:
452:
453:
454:
455:
456:
457:
458:
459:
460:
461:
462:
463:
464:
465:
466:
467:
468:
469:
470:
471:
472:
473:
474:
475:
476:
477:
478:
479:
480:
481:
482:
483:
484:
485:
486:
487:
488:
489:
490:
491:
492:
493:
494:
495:
496:
497:
498:
499:
500:
501:
502:
503:
504:
505:
506:
507:
508:
509:
510:
511:
512:
513:
514:
515:
516:
517:
518:
519:
520:
521:
522:
523:
524:
525:
526:
527:
528:
529:
530:
531:
532:
533:
534:
535:
536:
537:
538:
539:
540:
541:
542:
543:
544:
545:
546:
547:
548:
549:
550:
551:
552:
553:
554:
555:
556:
557:
558:
559:
560:
561:
562:
563:
564:
565:
566:
567:
568:
569:
570:
571:
572:
573:
574:
575:
576:
577:
578:
579:
580:
581:
582:
583:
584:
585:
586:
587:
588:
589:
590:
591:
592:
593:
594:
595:
596:
597:
598:
599:
600:
601:
602:
603:
604:
605:
606:
607:
608:
609:
610:
611:
612:
613:
614:
615:
616:
617:
618:
619:
620:
621:
622:
623:
624:
625:
626:
627:
628:
629:
630:
631:
632:
633:
634:
635:
636:
637:
638:
639:
640:
641:
642:
643:
644:
645:
646:
647:
648:
649:
650:
651:
652:
653:
654:
655:
656:
657:
658:
659:
660:
661:
662:
663:
664:
665:
666:
667:
668:
669:
670:
671:
672:
673:
674:
675:
676:
677:
678:
679:
680:
681:
682:
683:
684:
685:
686:
687:
688:
689:
690:
691:
692:
693:
694:
695:
696:
697:
698:
699:
700:
701:
702:
703:
704:
705:
706:
707:
708:
709:
710:
711:
712:
713:
714:
715:
716:
717:
718:
719:
720:
721:
722:
723:
724:
725:
726:
727:
728:
729:
730:
731:
732:
733:
734:
735:
736:
737:
738:
739:
740:
741:
742:
743:
744:
745:
746:
747:
748:
749:
750:
751:
752:
753:
754:
755:
756:
757:
758:
759:
760:
761:
762:
763:
764:
765:
766:
767:
768:
769:
770:
771:
772:
773:
774:
775:
776:
777:
778:
779:
780:
781:
782:
783:
784:
785:
786:
787:
788:
789:
790:
791:
792:
793:
794:
795:
796:
797:
798:
799:
800:
801:
802:
803:
804:
805:
806:
807:
808:
809:
810:
811:
812:
813:
814:
815:
816:
817:
818:
819:
820:
821:
822:
823:
824:
825:
826:
827:
828:
829:
830:
831:
832:
833:
834:
835:
836:
837:
838:
839:
840:
841:
842:
843:
844:
845:
846:
847:
848:
849:
850:
851:
852:
853:
854:
855:
856:
857:
858:
859:
860:
861:
862:
863:
864:
865:
866:
867:
868:
869:
870:
871:
872:
873:
874:
875:
876:
877:
878:
879:
880:
881:
882:
883:
884:
885:
886:
887:
888:
889:
890:
891:
892:
893:
894:
895:
896:
897:
898:
899:
900:
901:
902:
903:
904:
905:
906:
907:
908:
909:
910:
911:
912:
913:
914:
915:
916:
917:
918:
919:
920:
921:
922:
923:
924:
925:
926:
927:
928:
929:
930:
931:
932:
933:
934:
935:
936:
937:
938:
939:
940:
941:
942:
943:
944:
945:
946:
947:
948:
949:
950:
951:
952:
953:
954:
955:
956:
957:
958:
959:
960:
961:
962:
963:
964:
965:
966:
967:
968:
969:
970:
971:
972:
973:
974:
975:
976:
977:
978:
979:
980:
981:
982:
983:
984:
985:
986:
987:
988:
989:
990:
991:
992:
993:
994:
995:
996:
997:
998:
999:
1000:
1001:
1002:
1003:
1004:
1005:
1006:
1007:
1008:
1009:
1010:
1011:
1012:
1013:
1014:
1015:
1016:
1017:
1018:
1019:
1020:
1021:
1022:
1023:
1024:
1025:
1026:
1027:
1028:
1029:
1030:
1031:
1032:
1033:
1034:
1035:
1036:
1037:
1038:
1039:
1040:
1041:
1042:
1043:
1044:
1045:
1046:
1047:
1048:
1049:
1050:
1051:
1052:
1053:
1054:
1055:
1056:
1057:
1058:
1059:
1060:
1061:
1062:
1063:
1064:
1065:
1066:
1067:
1068:
1069:
1070:
1071:
1072:
1073:
1074:
1075:
1076:
1077:
1078:
1079:
1080:
1081:
1082:
1083:
1084:
1085:
1086:
1087:
1088:
1089:
1090:
1091:
1092:
1093:
1094:
1095:
1096:
1097:
1098:
1099:
1100:
1101:
1102:
1103:
1104:
1105:
1106:
1107:
1108:
1109:
1110:
1111:
1112:
1113:
1114:
1115:
1116:
1117:
1118:
1119:
1120:
1121:
1122:
1123:
1124:
1125:
1126:
1127:
1128:
1129:
1130:
1131:
1132:
1133:
1134:
1135:
1136:
1137:
1138:
1139:
1140:
1141:
1142:
1143:
1144:
1145:
1146:
1147:
1148:
1149:
1150:
1151:
1152:
1153:
1154:
1155:
1156:
1157:
1158:
1159:
1160:
1161:
1162:
1163:
1164:
1165:
1166:
1167:
1168:
1169:
1170:
1171:
1172:
1173:
1174:
1175:
1176:
1177:
1178:
1179:
1180:
1181:
1182:
1183:
1184:
1185:
1186:
1187:
1188:
1189:
1190:
1191:
1192:
1193:
1194:
1195:
1196:
1197:
1198:
1199:
1200:
1201:
1202:
1203:
1204:
1205:
1206:
1207:
1208:
1209:
1210:
1211:
1212:
1213:
1214:
1215:
1216:
1217:
1218:
1219:
1220:
1221:
1222:
1223:
1224:
1225:
1226:
1227:
1228:
1229:
1230:
1231:
1232:
1233:
1234:
1235:
1236:
1237:
1238:
1239:
1240:
1241:
1242:
1243:
1244:
1245:
1246:
1247:
1248:
1249:
1250:
1251:
1252:
1253:
1254:
1255:
1256:
1257:
1258:
1259:
1260:
1261:
1262:
1263:
1264:
1265:
1266:
1267:
1268:
1269:
1270:
1271:
1272:
1273:
1274:
1275:
1276:
1277:
1278:
1279:

unit SimpleTCP;


{*******************************************************************************
 Project       : SimpleTCP
 Filename      : SimpleTCP
 Date          : 2005-08-31
 Version       : 1.0.1.3
 Last modified : 2006-01-24
 Author        : Andreas Kreul a.k.a Udontknow
 URL           : www.xnebula.net
 Copyright     : Copyright (c) 2004-2006 Andreas Kreul
 History       :  
 
*******************************************************************************}  

 

 
{*******************************************************************************  
 
 Copyright (c) 2004, Andreas Kreul ["copyright holder(s)"]  
 Partcopyright : Popov (function "GetTempFile", thx!)  
 All rights reserved.  

 Redistribution and use in source and binary forms, with or without  
 modification, are permitted provided that the following conditions are met:  
 
 1. Redistributions of source code must retain the above copyright notice, this  
    list of conditions and the following disclaimer.  
 2. Redistributions in binary form must reproduce the above copyright notice,
    this list of conditions and the following disclaimer in the documentation  
    and/or other materials provided with the distribution.  
 3. The name(s) of the copyright holder(s) may not be used to endorse or  
    promote products derived from this software without specific prior written
    permission.
 
 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  
 AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE  
 IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
 DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY
 DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
 (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON  
 ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT  
 (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS  
 SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

*******************************************************************************}

 

 
{*******************************************************************************

 The two classes TSimpleTCPClient and TSimpleTCPServer simplify the use of the
 Indy-components TidTCPClient and TidTCPServer, synchronising all events and
 implementing extra "OnInput" and "OnProgress" events.

 *** changes in version 1.0.1.3 ***
 - the connection is now disconnected when an error inside the clientthread
   appears (else the error "connection reset by peer" could make trouble
   checking the connection state).
 2006-01-24  

 *** changes in version 1.0.1.2 ***
 - deactivating TCP-Server may have been resulting in an av or freeze.
 2005-11-10

 *** changes in version 1.0.1.1 ***
 - events are no longer called when componentstate includes csDestroying
   (events called could raise exceptions when other components that are
    used in these events are already freed by the owner).
 2005-08-31

 *** changes in version 1.0.1.0 ***
 - ported to Indy-10.
 - disconnect everything manually before setting FServer.Active:=False,
   else program does not come back from procedure... (Indy bug?)
 - sending a coDisconnect command to clients because they are not notified
   by the Indy server component yet.
 - disconnect on client event now triggers when clientthread is finishing
   execution.
 2005-08-25

 *** changes in version 1.0.0.5 ***
 - implemented "Interceptor" property for interceptor components
   (could be use for example for onthefly data compression)

 *** changes in version 1.0.0.4 ***
 - Boolean var "DisposeStream" implemented to hold stream from
   Input/ProcessCommand for further use (e.g. in other threads)

 *** changes in version 1.0.0.3 ***
 - again one bug using filestreams fixed

 *** changes in version 1.0.0.2 ***
 - some bugs making trouble using a filestream fixed

 *** changes in version 1.0.0.1 ***
 - changed type for "BytesToRead"/"BytesToWrite" from integer to Int64
 - added property "SizeForFileStream" indicating when to use a file stream for
   data buffer instead of a memory stream. It will be created a file in the
   temp folder of windows (thx to popov for his open source function!)

*******************************************************************************}


interface


uses Classes, Windows, SysUtils, SyncObjs, idGlobal, idContext, IdTCPClient,
      IdTCPServer, IdSchedulerOfThread, IdStreamVCL, idIOHandler, Dialogs;

type TCommand=integer;


//bidirectional commands
const coData:TCommand=0;


//Server2Client commands
const coDisconnect:TCommand=-1;

type
  TSimpleTCPConnection=class;
  TSimpleTCPClient=class;
  TSimpleTCPServer=class;
  THandleInputEvent=procedure(Sender:TObject;Stream:TStream; var DisposeStream:Boolean) of object;
  THandleServerInputEvent=procedure(Connection:TSimpleTCPConnection;Stream:TStream; var DisposeStream:Boolean) of object;
  TProgressEvent=procedure(Sender:TObject; BytesTransferred:Int64;BytesToTransfer:Int64) of object;
  TServerEvent=procedure(Connection:TSimpleTCPConnection) of object;
  TServerProcessCommandEvent=procedure(Connection:TSimpleTCPConnection;Command:Integer; Stream:TStream) of object;
  TServerProgressEvent=procedure(Connection:TSimpleTCPConnection; BytesTransferred:Int64;BytesToTransfer:Int64) of object;
  TProcessCommandEvent=procedure(Command:Integer; Stream:TStream; var DisposeStream:Boolean) of object;


  TSimpleTCPInterceptor=class(TComponent)
    public
      procedure BeforeSendCommand(const Stream:TStream); virtual; abstract;
      procedure BeforeProcessCommand(const Stream:TStream); virtual; abstract;
  end;


  TClientThread=class(TThread)
  private
    function GetOnProcessCommand: TProcessCommandEvent;
    procedure SetOnProcessCommand(const Value: TProcessCommandEvent);
    function GetClient: TidTCPClient;
    procedure SetClient(const Value: TidTCPClient);
  protected
    FBytesForProgress:Int64;
    FBytesTransferred,FBytesToTransfer:Int64;
    FCommand:Integer;
    FActive:Boolean;
    FStream:TStream;
    FClient:TidTCPClient;
    FOnProcessCommand:TProcessCommandEvent;
    FOnProgress:TProgressEvent;
    procedure HandleProcessCommand;
    procedure HandleProgress;
  public
    procedure Execute; override;
  published
    property BytesForProgress:Int64 read FBytesForProgress write FBytesForProgress;
    property OnProgress:TProgressEvent read FOnProgress write FOnProgress;
    property OnProcessCommand:TProcessCommandEvent read GetOnProcessCommand Write SetOnProcessCommand;
    property Client:TidTCPClient read GetClient write SetClient;
end;


  TSimpleTCPComponent=class(TComponent)
  protected  
    FSizeForFileStream:Int64;
    FBytesForProgress:Int64;
    FInterceptor:TSimpleTCPInterceptor;
  public
  published
    property BytesForProgress:Int64 read FBytesForProgress write FBytesForProgress;
    property SizeForFileStream:Int64 read FSizeForFileStream write FSizeForFileStream;
    property Interceptor:TSimpleTCPInterceptor read FInterceptor write FInterceptor;
end;


  TSimpleTCPClient=class(TSimpleTCPComponent)
  private
    FThread:TClientThread;
    FOnInput:THandleInputEvent;
    FOnProgress:TProgressEvent;
    FOnConnected:TNotifyEvent;
    FOnDisconnected:TNotifyEvent;
    function GetConnected: Boolean;
    function GetHost: String;
    function GetOnConnected: TNotifyEvent;
    function GetOnDisconnected: TNotifyEvent;
    function GetPort: Integer;
    procedure SetConnected(const Value: Boolean);
    procedure SetHost(const Value: String);
    procedure SetOnConnected(const Value: TNotifyEvent);
    procedure SetOnDisconnected(const Value: TNotifyEvent);
    procedure SetPort(const Value: Integer);
    function GetOnInput: THandleInputEvent;
    procedure SetOnInput(const Value: THandleInputEvent);
    function GetOnProgress: TProgressEvent;
    procedure SetOnProgress(const Value: TProgressEvent);
  protected
    FClient:TIdTCPClient;
    procedure ProcessCommand(Command:Integer; Stream:TStream; var DisposeStream:Boolean); virtual;
    procedure SendCommand(Command:Integer; Stream:TStream); overload; virtual;
    procedure SendCommand(Command:Integer; Streams:Array of TStream); overload; virtual;

    procedure DoConnect(Sender:TObject);
  public
    constructor Create(Aowner:TComponent); override;
    destructor Destroy; override;
    property Connected:Boolean read GetConnected write SetConnected;
    procedure SendStream(AStream:TStream);
    procedure SendStreams(AStreams: Array of TStream);
  published
    property OnProgress:TProgressEvent read GetOnProgress write SetOnProgress;


    property Host:String read GetHost write SetHost;
    property Port:Integer read GetPort write SetPort;
    property OnConnected:TNotifyEvent read GetOnConnected write SetOnConnected;
    property OnDisconnected:TNotifyEvent read GetOnDisconnected write SetOnDisconnected;
    property OnInput:THandleInputEvent read GetOnInput write SetOnInput;


    property SizeForFileStream;
    property BytesForProgress;
  end;


  TSimpleTCPConnection=class(TObject)
  private
    FServer:TSimpleTCPServer;
    FContext: TIDContext;
    FPeerIP:String;
    FPeerPort:Integer;
    FData:TObject;
    function GetPeerIP: String;
    function GetPeerPort: Integer;
  public
    procedure SendStream(AStream:TStream);
    procedure SendStreams(AStreams: Array of TStream);


    procedure Disconnect;
    constructor Create(AContext:TIDContext); reintroduce; virtual;


    property PeerIP:String read GetPeerIP;
    property PeerPort:Integer read GetPeerPort;
    property Data:TObject read FData write FData;
    property Context:TIDContext read FContext;
  end;


  TSimpleTCPConnections=class(TObject)
    private
      FServer:TSimpleTCPServer;
      FItems:TList;
      function Add(AContext:TIDContext):TSimpleTCPConnection;
      function ByContext(AContext:TIDContext):TSimpleTCPConnection;
      procedure Delete(Connection:TSimpleTCPConnection);
      procedure Clear;
      function GetCount: Integer;  
      function GetItems(Index: Integer): TSimpleTCPConnection;  
    public  
      constructor Create; virtual;  
      destructor Destroy; override;

 
      function ByIPAndPort(PeerIP:String;PeerPort:Integer):TSimpleTCPConnection;  


      property Count:Integer read GetCount;  
      property Items[Index:Integer]:TSimpleTCPConnection read GetItems; default;  
  end;  

 
  TSimpleTCPServer=class(TSimpleTCPComponent)
  private
    FOnProgress:TServerProgressEvent;
    FBytesTransferred,FBytesToTransfer:Int64;  
    FCS:TCriticalSection;  
    FOnInput:THandleServerInputEvent;  
    FConnections:TSimpleTCPConnections;
    FServer:TIDTCPServer;
    FOnConnect:TServerEvent;
    FOnDisconnect:TServerEvent;
    procedure ServerExecute(AContext: TIdContext);
    procedure InternalOnconnect(AContext:TIDContext);
    procedure InternalOnDisconnect(AContext:TIDContext);
    function GetActive: Boolean;
    function GetPort: Integer;
    procedure SetActive(const Value: Boolean);
    procedure SetPort(const Value: Integer);
    function GetOnConnect: TServerEvent;
    function GetOnDisconnect: TServerEvent;
    procedure SetOnConnect(const Value: TServerEvent);
    procedure SetOnDisconnect(const Value: TServerEvent);
    procedure HandleOnConnect;
    procedure HandleOnDisconnect;
    procedure HandleProcessCommand;
    procedure HandleProgress;
  protected
    //Fields to be used in synched proc HandleProcessCommand
    FCommand:Integer;
    FConnection:TSimpleTCPConnection;
    FStream:TStream;

    //procs can be overriden to implement more commands
    procedure ProcessCommand(Command:Integer; Connection:TSimpleTCPConnection; Stream:TStream; var DisposeStream:Boolean); virtual;
    procedure SendCommand(Command:Integer; Connection:TSimpleTCPConnection; Stream:TStream); overload; virtual;  
    procedure SendCommand(Command:Integer; Connection:TSimpleTCPConnection; Streams:Array of TStream); overload; virtual;
  public
    constructor Create(Aowner:TComponent); override;  
    destructor Destroy; override;

    property Active:Boolean read GetActive write SetActive;
    property Connections:TSimpleTCPConnections read FConnections;
    procedure SendStream(Connection:TSimpleTCPConnection;Stream:TStream); virtual;
  published
    property Port:Integer read GetPort write SetPort;
    property OnInput:THandleServerInputEvent read FOnInput Write FOnInput;
    property OnConnect:TServerEvent read GetOnConnect write SetOnConnect;
    property OnDisconnect:TServerEvent read GetOnDisconnect write SetOnDisconnect;
    property OnProgress:TServerProgressEvent read FOnProgress write FOnProgress;

    property SizeForFileStream;
    property BytesForProgress;
  end;


function GetTempFile: String;

procedure LoadStrFromStream(const Stream: TStream; var Str: String);  
procedure SaveStrToStream(const Stream: TStream; const Value: String);


procedure Register;


const Max_Path=512;


implementation


uses IdSocketHandle;


procedure Register;
begin
  RegisterComponents('Simple Network',[TSimpleTCPClient,TSimpleTCPServer]);
end;

procedure SaveStrToStream(const Stream: TStream; const Value: String);  
//writes dynamic string into stream
var Len: Word;  
begin  
  Len := Length(Value);  
  Stream.WriteBuffer(Len, SizeOf(Len));  
  if Len > 0 then  
    Stream.WriteBuffer(Pointer(Value)^, Len);  
end;  

 
procedure LoadStrFromStream(const Stream: TStream; var Str: String);  
//reads a dynamic string from a stream  
var Len: Word;  
begin  
  Stream.ReadBuffer(Len, SizeOf(Len));
  SetLength(Str, Len);  
  if Len > 0 then  
    Stream.ReadBuffer(Pointer(Str)^, Len);  
end;

function GetTempFile: String;
var
  TempPath: array[0..MAX_PATH+1] of Char;
  Buffer: array[0..MAX_PATH+1] of Char;
begin
  Result := #0;


  if GetTempPath(MAX_PATH, TempPath) <> 0 then
    if GetTempFileName(TempPath, '~tm', 0, Buffer) <> 0 then
      Result := Buffer;
end; {Popov}

procedure ReadStreamFromIOHandler(IOHandler:TIdIOHandler; Stream:TStream; ByteCount:Integer);
begin
  IOHandler.ReadStream(Stream,ByteCount);
end;

procedure WriteStreamToIOHandler(IOHandler:TIdIOHandler; Stream:TStream; ByteCount:Integer);
begin
  IOHandler.Write(Stream,ByteCount);
end;

procedure WriteInt64ToIOHandler(IOHandler:TIdIOHandler; const Value:Int64);
var Bytes:TIDBytes;
begin
  SetLength(Bytes,8);
  Move(Value,Pointer(@Bytes[0])^,8);
  IOHandler.Write(Bytes);
end;

function ReadInt64FromIOHandler(IOHandler:TIdIOHandler):Int64;
var Bytes:TIDBytes;
begin
  SetLength(Bytes,8);
  IOHandler.ReadBytes(Bytes,8,False);
  Move(Pointer(@Bytes[0])^,Result,8);
end;


{ TClientThread }


procedure TClientThread.Execute;
var BytesToRead:Int64;
var TempFile:String;
begin
  try

    while not Terminated and (FClient<>NIL) and (FClient.Connected) do
    try
      //read command
      FCommand:=FClient.IOHandler.ReadInteger;

      if FCommand=coDisconnect then
      begin
        //FClient.Disconnect;
        exit;
      end;

      //read bytes that follow
      BytesToRead:=ReadInt64FromIOHandler(FClient.IOHandler);

      //if datasize is large, create a file stream,
      // else create faster memory stream
      if BytesToRead>=TSimpleTCPClient(FClient.Owner).SizeForFileStream then
      begin
        TempFile:=GetTempFile;
        FStream:=TFileStream.Create(TempFile,fmCreate);
      end
      else
        FStream:=TMemoryStream.Create;


      //pump data to stream, then call synched proc
      FStream.Size:=BytesToRead;
      FStream.Position:=0;


      FBytesTransferred:=0;
      FBytesToTransfer:=BytesToRead;


      if Assigned(FOnProgress) then
        Synchronize(HandleProgress);

      //Repeat reading and signaling progress
      While BytesToRead>=FBytesForProgress do
      begin
        ReadStreamFromIOHandler(FClient.IOHandler,FStream,FBytesForProgress);

        BytesToRead:=BytesToRead-FBytesForProgress;
        FBytesTransferred:=FBytesTransferred+FBytesForProgress;

        //event assigned?
        if Assigned(FOnProgress) then
          Synchronize(HandleProgress);
      end;

      //read remaining data
      if BytesToRead>0 then
        ReadStreamFromIOHandler(FClient.IOHandler,FStream,BytesToRead);



      //Closing writestream, reopening as readstream
      if FStream is TFileStream then
      begin
        FStream.Free;
        FStream:=TFileStream.Create(TempFile,fmOpenRead);
      end
      else
        FStream.Position:=0;

      if Assigned(FOnProcessCommand) then
        Synchronize(HandleProcessCommand);
    except
      FClient.Disconnect(False);
    end;
  finally
    //trigger Disconnect-Event
    FStream:=NIL;
    FCommand:=coDisconnect;

    if Assigned(FOnProcessCommand) then
      Synchronize(HandleProcessCommand);
  end;
end;


function TClientThread.GetClient: TidTCPClient;
begin
  Result:=FClient;
end;


function TClientThread.GetOnProcessCommand: TProcessCommandEvent;  
begin  
  Result:=FOnProcessCommand;  
end;  


procedure TClientThread.HandleProcessCommand;  
var DisposeStream:Boolean;
begin
  DisposeStream:=True;
  try  
    if Assigned(FOnProcessCommand) then  
      FOnProcessCommand(FCommand,FStream, DisposeStream);
  finally  
    if DisposeStream then  
      FStream.Free;  
  end;      
end;  

 
procedure TClientThread.HandleProgress;  
begin
 if not (csDestroying in FClient.Componentstate)
 and Assigned(FOnProgress) then
    FOnProgress(FClient,FBytesTransferred,FBytesToTransfer);  
end;  

procedure TClientThread.SetClient(const Value: TidTCPClient);
begin  
  FClient:=Value;  
end;  

 
procedure TClientThread.SetOnProcessCommand(const Value: TProcessCommandEvent);  
begin  
  FOnProcessCommand:=Value;  
end;

{ TSimpleTCPServer }

constructor TSimpleTCPServer.Create(Aowner: TComponent);
begin  
  inherited;
  FBytesForProgress:=8192;
  FSizeForFileStream:=1024*1024*8;
  FCS:=TCriticalSection.Create;
  FConnections:=TSimpleTCPConnections.Create;
  FConnections.FServer:=Self;
  FServer:=TIDTCPServer.Create(Self);
  FServer.OnConnect:=InternalOnConnect;
  FServer.OnDisconnect:=InternalOnDisconnect;
  FServer.OnExecute:=ServerExecute;
end;


destructor TSimpleTCPServer.Destroy;
begin
  FServer.Active:=False;
  Sleep(500);
  FServer.Free;
  FConnections.Free;
  FCS.Free;  
  inherited;  
end;  

 
function TSimpleTCPServer.GetActive: Boolean;
begin
  Result:=FServer.Active;
end;


function TSimpleTCPServer.GetOnConnect: TServerEvent;
begin  
  Result:=FOnConnect;  
end;  


function TSimpleTCPServer.GetOnDisconnect: TServerEvent;  
begin  
  Result:=FOnDisconnect;
end;


function TSimpleTCPServer.GetPort: Integer;
begin
  Result:=FServer.DefaultPort;
end;


procedure TSimpleTCPServer.HandleProcessCommand;
var DisposeStream:Boolean;
begin
  DisposeStream:=True;
  try
    //Dont call any events if component will be destroyed soon
    if not (csDestroying in ComponentState) then
      ProcessCommand(FCommand, FConnection, FStream, DisposeStream);
  finally
    if DisposeStream then
      FStream.Free;
  end;
end;


procedure TSimpleTCPServer.ProcessCommand(Command: Integer; Connection:TSimpleTCPConnection;  Stream: TStream; var DisposeStream:Boolean);
begin
  if Assigned(FInterceptor) then
    FInterceptor.BeforeProcessCommand(Stream);


  if (Command=coData) and Assigned(FOnInput) then
    FOnInput(FConnection,Stream,DisposeStream);
end;


procedure TSimpleTCPServer.HandleOnConnect;
begin
  //Dont call any events if component will be destroyed soon
  if not (csDestroying in ComponentState)
  and (Assigned(FOnConnect)) then
    FOnConnect(FConnection);
end;


procedure TSimpleTCPServer.HandleOnDisconnect;
begin
  //Dont call any events if component will be destroyed soon
  if not (csDestroying in ComponentState)
  and (Assigned(FOnDisconnect)) then
    FOnDisconnect(FConnection);
end;


procedure TSimpleTCPServer.InternalOnconnect(AContext: TIDContext);
begin
  FCS.Enter;
  try
    FConnection:=FConnections.Add(AContext);
    (AContext.Yarn as TIdYarnOfThread).Thread.Synchronize(HandleOnConnect);
  finally
    FCS.Leave;
  end;
end;


procedure TSimpleTCPServer.InternalOnDisconnect(AContext: TIdContext);
begin
  FCS.Enter;
  try
    FConnection:=FConnections.ByContext(AContext);
    FConnections.Delete(FConnection);
    (AContext.Yarn as TIdYarnOfThread).Thread.Synchronize(HandleOnDisconnect);
    FConnection.Free;
  finally
    FCS.Leave;
  end;
end;


procedure TSimpleTCPServer.ServerExecute(AContext: TIdContext);
var Command:Integer;
var Stream:TStream;
var TempFile:String;
var BytesToTransfer,BytesTransferred,BytesToRead:Int64;
begin
  if (not (AContext.Yarn as TIdYarnOfThread).Thread.Terminated) and (AContext.Connection.Connected) then
  try
    Command:=AContext.Connection.IOHandler.ReadInteger;

    //bytes to read?
    BytesToRead:=ReadInt64FromIOHandler(AContext.Connection.IOHandler);

    //if datasize is large, create a file stream,
    // else create faster memory stream
    if BytesToRead>=FSizeForFileStream then
    begin
      TempFile:=GetTempFile;
      Stream:=TFileStream.Create(TempFile,fmCreate)
    end
    else
      Stream:=TMemoryStream.Create;

    try
      Stream.Size:=BytesToRead;
      Stream.Position:=0;


      //triggering initial OnProgress event
      BytesTransferred:=0;
      BytesToTransfer:=BytesToRead;

      //OnProgress event
      FCS.Enter;
      try
        FConnection:=FConnections.ByContext(AContext);
        FBytesTransferred:=BytesTransferred;
        FBytesToTransfer:=BytesToTransfer;


        if Assigned(FOnProgress) then
          (AContext.Yarn as TIdYarnOfThread).Thread.Synchronize(HandleProgress);
      finally
        FCS.Leave;
      end;

      While BytesToRead>=FBytesForProgress do
      begin
        //read data and put it into stream
        ReadStreamFromIOHandler(AContext.Connection.IOHandler,Stream,BytesForProgress);

        BytesToRead:=BytesToRead-FBytesForProgress;
        BytesTransferred:=BytesTransferred+FBytesForProgress;


        //triggering OnProgress event
        if (Assigned(FOnProgress)) then
        begin
          FCS.Enter;
          try
            FConnection:=FConnections.ByContext(AContext);
            FBytesTransferred:=BytesTransferred;
            FBytesToTransfer:=BytesToTransfer;

            if Assigned(FOnProgress) then
              (AContext.Yarn as TIdYarnOfThread).Thread.Synchronize(HandleProgress);
          finally
            FCS.Leave;
          end;
        end;
      end;

      if BytesToRead>0 then
      begin
        //read data and put it into stream
        ReadStreamFromIOHandler(AContext.Connection.IOHandler,Stream,BytesToRead);
      end;
      Stream.Position:=0;


      //Closing writestream, reopening as readstream
      if Stream is TFileStream then
      begin
        Stream.Free;
        Stream:=TFileStream.Create(TempFile,fmOpenRead);
      end;


      //commandprocessing
      FCS.Enter;
      try
        FCommand:=Command;
        FConnection:=FConnections.ByContext(AContext);
        FStream:=Stream;
        (AContext.Yarn as TIdYarnOfThread).Thread.Synchronize(HandleProcessCommand);
      finally
        FCS.Leave;
      end;
    finally
      //FStream.Free;
    end;
  except
    //AContext.Connection.Disconnect;
    //(AContext.Yarn as TIdYarnOfThread).Thread.Terminate;
  end;
end;


procedure TSimpleTCPServer.SetActive(const Value: Boolean);
//var Str:String;
var i:integer;
begin
  //Kill all connections manually before deactivating server (Indy bugged?)
  if (not Value) and FServer.Active then
  begin
    FServer.OnDisconnect:=NIL;

    for i:=FConnections.Count-1 downto 0 do
    begin
      FConnection:=FConnections[i];
      HandleOnDisconnect;
    end;
    FConnections.Clear;
  end
  else
    FServer.OnDisconnect:=Self.InternalOnDisconnect;

  FServer.Active:=Value;
end;


procedure TSimpleTCPServer.SetOnConnect(const Value: TServerEvent);
begin
  FOnConnect:=Value;
end;


procedure TSimpleTCPServer.SetOnDisconnect(const Value: TServerEvent);
begin
  FOnDisconnect:=Value;
end;


procedure TSimpleTCPServer.SetPort(const Value: Integer);
begin
  FServer.DefaultPort:=Value;
end;


procedure TSimpleTCPServer.SendCommand(Command: Integer;
  Connection: TSimpleTCPConnection; Stream: TStream);
begin
  if Assigned(FInterceptor) then
    FInterceptor.BeforeSendCommand(Stream);
  Stream.Position:=0;


  //send command
  Connection.FContext.Connection.IOHandler.Write(Command);

  //send size of following content
  WriteInt64ToIOHandler(Connection.Context.Connection.IOHandler,Stream.Size);
  WriteStreamToIOHandler(Connection.Context.Connection.IOHandler,Stream,Stream.Size);
end;


procedure TSimpleTCPServer.SendStream(Connection: TSimpleTCPConnection;
  Stream: TStream);
begin  
  SendCommand(coData,Connection,Stream);  
end;

 
procedure TSimpleTCPServer.HandleProgress;  
begin
  //Dont call any events if component will be destroyed soon
  if not (csDestroying in ComponentState)
  and (Assigned(FOnProgress)) then
    FOnProgress(FConnection,FBytesTransferred,FBytesToTransfer);  
end;  

 
procedure TSimpleTCPServer.SendCommand(Command: Integer;  
  Connection: TSimpleTCPConnection; Streams: array of TStream);  
var BytesToWrite:Int64;  
var i:integer;  
begin
  if Assigned(Interceptor) then
    raise Exception.Create('Sending multiple streams not allowed with interceptor!');
  //calculate size
  BytesToWrite:=0;
  for i:=0 to Length(Streams)-1 do
    if Streams[i]<>NIL then
      BytesToWrite:=BytesToWrite+Streams[i].Size;

  //Sending data command
  Connection.Context.Connection.IOHandler.Write(Command);

  //Sending size
  WriteInt64ToIOHandler(Connection.Context.Connection.IOHandler,BytesToWrite);

  for i:=0 to Length(Streams)-1 do
  begin
    //write stream
    Streams[i].Position:=0;
    WriteStreamToIOHandler(Connection.Context.Connection.IOHandler,Streams[i],Streams[i].Size);
  end;
end;

{ TSimpleTCPClient }

 
constructor TSimpleTCPClient.Create(Aowner: TComponent);  
begin  
  inherited;
  FBytesForProgress:=8192;
  FSizeForFileStream:=1024*1024*8;    
  FClient:=TidTCPClient.Create(Self);
  FCLient.OnConnected:=DoConnect;
end;


destructor TSimpleTCPClient.Destroy;
begin
  FOnProgress:=NIL;
  FOnInput:=NIL;
  FClient.OnConnected:=NIL;
  FClient.OnDisconnected:=NIL;
  Connected:=False;
  FClient.Free;
  inherited;
end;


procedure TSimpleTCPClient.DoConnect(Sender: TObject);
begin
  //Dont call any events if component will be destroyed soon
  if not (csDestroying in Componentstate)
  and Assigned(FOnConnected) then
    FOnConnected(Self);
end;

function TSimpleTCPClient.GetConnected: Boolean;
begin
  Result:=FClient.Connected;
end;

 
function TSimpleTCPClient.GetHost: String;  
begin  
  Result:=FClient.Host;  
end;  

 
function TSimpleTCPClient.GetOnConnected: TNotifyEvent;  
begin
  Result:=FOnConnected;
end;  

 
function TSimpleTCPClient.GetOnDisconnected: TNotifyEvent;  
begin  
  Result:=FOnDisconnected;
end;

 
function TSimpleTCPClient.GetOnInput: THandleInputEvent;  
begin  
  Result:=FOnInput;  
end;  

 
function TSimpleTCPClient.GetOnProgress: TProgressEvent;  
begin  
  Result:=FOnProgress;  
end;  

 
function TSimpleTCPClient.GetPort: Integer;
begin  
  Result:=FClient.Port;  
end;  


procedure TSimpleTCPClient.ProcessCommand(Command: Integer; Stream:TStream; var DisposeStream:Boolean);
begin
  //Dont call any events if component will be destroyed soon
  if (csDestroying in Componentstate) then
    exit;

  if Assigned(FInterceptor) then
    FInterceptor.BeforeProcessCommand(Stream);

  if (Command=coData) and (Assigned(FOnInput)) then  
    FOnInput(Self,Stream,DisposeStream);

  if (Command=coDisconnect) and (Assigned(FOnDisconnected)) then
    FOnDisconnected(Self);
end;

 
procedure TSimpleTCPClient.SendCommand(Command: Integer;
  Stream: TStream);  
var BytesToWrite:Int64;
begin
  //Sending data command
  FClient.IOHandler.Write(Command);

  if Assigned(FInterceptor) then
    FInterceptor.BeforeSendCommand(Stream);

  //Streamsize is 0 if no stream is supplied
  if Stream=NIL then
    BytesToWrite:=0
  else
    BytesToWrite:=Stream.Size;

  //send size
  WriteInt64ToIOHandler(FClient.IOHandler,BytesToWrite);

  //send data stream if supplied
  if Stream<>NIL then
  begin
    //write stream
    Stream.Position:=0;
    WriteStreamToIOHandler(FClient.IOHandler,Stream,Stream.Size);
  end;
end;


procedure TSimpleTCPClient.SendCommand(Command: Integer;
  Streams: array of TStream);
var BytesToWrite:Int64;
var i:integer;
begin
  if Assigned(Interceptor) then
    raise Exception.Create('Sending multiple streams not allowed with interceptor!');

  //calculate size
  BytesToWrite:=0;
  for i:=0 to Length(Streams)-1 do
    if Streams[i]<>NIL then
      BytesToWrite:=BytesToWrite+Streams[i].Size;

  //Sending data command
  FClient.IOHandler.Write(Command);

  //Sending size
  WriteInt64ToIOHandler(FClient.IOHandler,BytesToWrite);

  for i:=0 to Length(Streams)-1 do
  begin
    //write stream
    Streams[i].Position:=0;
    WriteStreamToIOHandler(FClient.IOHandler,Streams[i],Streams[i].Size);
  end;
end;


procedure TSimpleTCPClient.SendStream(AStream: TStream);
begin
  SendCommand(coData,AStream);
end;  

 
procedure TSimpleTCPClient.SendStreams(AStreams: array of TStream);
begin  
  SendCommand(CoData,AStreams);  
end;

 
procedure TSimpleTCPClient.SetConnected(const Value: Boolean);  
begin
    if (FClient.Connected) and not (Value) then
    begin
      FClient.Disconnect;
      FThread.Free;
    end;

    if not (FClient.Connected) and (Value) then
    begin
      FClient.Connect;
      FThread:=TClientThread.Create(True);
      FThread.OnProcessCommand:=ProcessCommand;
      FThread.OnProgress:=FOnProgress;
      FThread.Client:=FClient;
      FThread.BytesForProgress:=BytesForProgress;
      FThread.Resume;
    end;
end;

 
procedure TSimpleTCPClient.SetHost(const Value: String);
begin  
  FClient.Host:=Value;  
end;  

 
procedure TSimpleTCPClient.SetOnConnected(const Value: TNotifyEvent);  
begin
  FOnConnected:=Value;
end;  


procedure TSimpleTCPClient.SetOnDisconnected(const Value: TNotifyEvent);  
begin
  FOnDisconnected:=Value;
end;

 
procedure TSimpleTCPClient.SetOnInput(const Value: THandleInputEvent);
begin
  FOnInput:=Value;
end;  

 
procedure TSimpleTCPClient.SetOnProgress(const Value: TProgressEvent);  
begin
  FonProgress:=Value;
end;  


procedure TSimpleTCPClient.SetPort(const Value: Integer);  
begin
  FClient.Port:=Value;
end;  

 
{ TSimpleTCPConnections }  

 
function TSimpleTCPConnections.Add(
  AContext: TIDContext): TSimpleTCPConnection;
begin
  Result:=TSimpleTCPConnection.Create(AContext);
  Result.FServer:=FServer;    
  FItems.Add(Result);  
end;  

 
function TSimpleTCPConnections.ByIPAndPort(PeerIP: String;  
  PeerPort: Integer): TSimpleTCPConnection;  
var i:integer;  
begin  
  Result:=NIL;  
  for i:=0 to Count-1 do  
    if (Items[i].FPeerIP=PeerIP) and (Items[i].FPeerPort=PeerPort) then  
    begin  
      Result:=Items[i];  
      exit;  
    end;  
end;


function TSimpleTCPConnections.ByContext(AContext: TIDContext): TSimpleTCPConnection;
var i:integer;
begin  
  Result:=NIL;  
  for i:=0 to Count-1 do
    if Items[i].FContext=AContext then
    begin  
      Result:=Items[i];  
      exit;  
    end;  
end;  

 
procedure TSimpleTCPConnections.Clear;
var i:integer;  
begin
  for i:=Count-1 downto 0 do
  begin
    Items[i].Free;
    FItems.Delete(i);  
  end;  
end;

 
constructor TSimpleTCPConnections.Create;  
begin  
  FItems:=TList.Create;  
end;  

 
procedure TSimpleTCPConnections.Delete(Connection: TSimpleTCPConnection);  
var i:integer;  
begin  
  for i:=0 to Count-1 do  
    if Items[i]=Connection then  
    begin
      FItems.Delete(i);  
      exit;  
    end;  
end;  

 
destructor TSimpleTCPConnections.Destroy;  
begin
  Clear;
  FItems.Free;  
  inherited;  
end;

 
function TSimpleTCPConnections.GetCount: Integer;  
begin
  Result:=FItems.Count;  
end;  

 
function TSimpleTCPConnections.GetItems(  
  Index: Integer): TSimpleTCPConnection;  
begin  
  Result:=TSimpleTCPConnection(FItems[Index]);  
end;  

 
{ TSimpleTCPConnection }  


constructor TSimpleTCPConnection.Create(AContext: TIDContext);
begin
  FContext:=AContext;
  FPeerIP:=FContext.Connection.Socket.Binding.PeerIP;
  FPeerPort:=FContext.Connection.Socket.Binding.PeerPort;
end;  

 
procedure TSimpleTCPConnection.Disconnect;  
var Command:integer;  
begin
  if FContext.Connection.Connected then
  begin
    Command:=coDisconnect;
    FContext.Connection.IOHandler.Write(Command);
    FContext.Connection.Disconnect;
  end;
end;  

 
function TSimpleTCPConnection.GetPeerIP: String;  
begin  
  Result:=FPeerIP;  
end;  

 
function TSimpleTCPConnection.GetPeerPort: Integer;  
begin  
  Result:=FPeerPort;  
end;  

 
procedure TSimpleTCPConnection.SendStream(AStream: TStream);  
var BytesToWrite:Int64;  
var Command:Integer;  
begin
  if Assigned(FServer.Interceptor) then  
    FServer.Interceptor.BeforeSendCommand(AStream);

  //send data command
  Command:=coData;
  FContext.Connection.IoHandler.Write(Command);

  //send size of following content
  BytesToWrite:=AStream.Size;
  WriteInt64ToIOHandler(FContext.Connection.IOHandler,BytesToWrite);

  //send content
  WriteStreamToIOHandler(FContext.Connection.IOHandler,AStream,AStream.Size);
end;

 
procedure TSimpleTCPConnection.SendStreams(AStreams: array of TStream);  
var BytesToWrite:Int64;  
var i:integer;  
begin  
  if Assigned(FServer.Interceptor) then
    raise Exception.Create('Sending multiple streams not allowed with interceptor!');


  //calculate size
  BytesToWrite:=0;
  for i:=0 to Length(AStreams)-1 do
    if AStreams[i]<>NIL then
      BytesToWrite:=BytesToWrite+AStreams[i].Size;


  //Sending data command
  FContext.Connection.IOHandler.Write(CoData);


  //Sending size
  WriteInt64ToIOHandler(FContext.Connection.IOHandler,BytesToWrite);

  for i:=0 to Length(AStreams)-1 do
  begin
    //write stream
    AStreams[i].Position:=0;
    WriteStreamToIOHandler(FContext.Connection.IOHandler,Astreams[i],AStreams[i].Size);
  end;
end;

end.