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;
interface
uses Classes, Windows, SysUtils, SyncObjs, idGlobal, idContext, IdTCPClient, IdTCPServer, IdSchedulerOfThread, IdStreamVCL, idIOHandler, Dialogs;
type TCommand=integer;
const coData:TCommand=0;
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 FCommand:Integer; FConnection:TSimpleTCPConnection; FStream:TStream;
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); 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); 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;
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;
procedure TClientThread.Execute; var BytesToRead:Int64; var TempFile:String; begin try
while not Terminated and (FClient<>NIL) and (FClient.Connected) do try FCommand:=FClient.IOHandler.ReadInteger;
if FCommand=coDisconnect then begin exit; end;
BytesToRead:=ReadInt64FromIOHandler(FClient.IOHandler);
if BytesToRead>=TSimpleTCPClient(FClient.Owner).SizeForFileStream then begin TempFile:=GetTempFile; FStream:=TFileStream.Create(TempFile,fmCreate); end else FStream:=TMemoryStream.Create;
FStream.Size:=BytesToRead; FStream.Position:=0;
FBytesTransferred:=0; FBytesToTransfer:=BytesToRead;
if Assigned(FOnProgress) then Synchronize(HandleProgress);
While BytesToRead>=FBytesForProgress do begin ReadStreamFromIOHandler(FClient.IOHandler,FStream,FBytesForProgress);
BytesToRead:=BytesToRead-FBytesForProgress; FBytesTransferred:=FBytesTransferred+FBytesForProgress;
if Assigned(FOnProgress) then Synchronize(HandleProgress); end;
if BytesToRead>0 then ReadStreamFromIOHandler(FClient.IOHandler,FStream,BytesToRead);
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 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;
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 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 if not (csDestroying in ComponentState) and (Assigned(FOnConnect)) then FOnConnect(FConnection); end;
procedure TSimpleTCPServer.HandleOnDisconnect; begin 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;
BytesToRead:=ReadInt64FromIOHandler(AContext.Connection.IOHandler);
if BytesToRead>=FSizeForFileStream then begin TempFile:=GetTempFile; Stream:=TFileStream.Create(TempFile,fmCreate) end else Stream:=TMemoryStream.Create;
try Stream.Size:=BytesToRead; Stream.Position:=0;
BytesTransferred:=0; BytesToTransfer:=BytesToRead;
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 ReadStreamFromIOHandler(AContext.Connection.IOHandler,Stream,BytesForProgress);
BytesToRead:=BytesToRead-FBytesForProgress; BytesTransferred:=BytesTransferred+FBytesForProgress;
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 ReadStreamFromIOHandler(AContext.Connection.IOHandler,Stream,BytesToRead); end; Stream.Position:=0;
if Stream is TFileStream then begin Stream.Free; Stream:=TFileStream.Create(TempFile,fmOpenRead); end;
FCS.Enter; try FCommand:=Command; FConnection:=FConnections.ByContext(AContext); FStream:=Stream; (AContext.Yarn as TIdYarnOfThread).Thread.Synchronize(HandleProcessCommand); finally FCS.Leave; end; finally end; except end; end;
procedure TSimpleTCPServer.SetActive(const Value: Boolean); var i:integer; begin 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;
Connection.FContext.Connection.IOHandler.Write(Command);
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 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!'); BytesToWrite:=0; for i:=0 to Length(Streams)-1 do if Streams[i]<>NIL then BytesToWrite:=BytesToWrite+Streams[i].Size;
Connection.Context.Connection.IOHandler.Write(Command);
WriteInt64ToIOHandler(Connection.Context.Connection.IOHandler,BytesToWrite);
for i:=0 to Length(Streams)-1 do begin Streams[i].Position:=0; WriteStreamToIOHandler(Connection.Context.Connection.IOHandler,Streams[i],Streams[i].Size); end; end;
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 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 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 FClient.IOHandler.Write(Command);
if Assigned(FInterceptor) then FInterceptor.BeforeSendCommand(Stream);
if Stream=NIL then BytesToWrite:=0 else BytesToWrite:=Stream.Size;
WriteInt64ToIOHandler(FClient.IOHandler,BytesToWrite);
if Stream<>NIL then begin 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!');
BytesToWrite:=0; for i:=0 to Length(Streams)-1 do if Streams[i]<>NIL then BytesToWrite:=BytesToWrite+Streams[i].Size;
FClient.IOHandler.Write(Command);
WriteInt64ToIOHandler(FClient.IOHandler,BytesToWrite);
for i:=0 to Length(Streams)-1 do begin 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;
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;
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);
Command:=coData; FContext.Connection.IoHandler.Write(Command);
BytesToWrite:=AStream.Size; WriteInt64ToIOHandler(FContext.Connection.IOHandler,BytesToWrite);
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!');
BytesToWrite:=0; for i:=0 to Length(AStreams)-1 do if AStreams[i]<>NIL then BytesToWrite:=BytesToWrite+AStreams[i].Size;
FContext.Connection.IOHandler.Write(CoData);
WriteInt64ToIOHandler(FContext.Connection.IOHandler,BytesToWrite);
for i:=0 to Length(AStreams)-1 do begin AStreams[i].Position:=0; WriteStreamToIOHandler(FContext.Connection.IOHandler,Astreams[i],AStreams[i].Size); end; end;
end. |