Autor |
Beitrag |
Udontknow
Beiträge: 2596
Win7
D2006 WIN32, .NET (C#)
|
Verfasst: Do 29.07.04 14:26
Diese Unit beinhaltet zwei Komponenten TSimpleTCPClient und TSimpleTCPServer, die als Wrapper der jeweiligen Indy-Pendants fungieren.
Bei dem Client muss nicht mehr explizit nach Inhalt gekuckt werden, stattdessen wird bei Erhalt von Daten ein Event OnInput ausgelöst. TSimpleTCPClient implementiert einen Thread, der auf Daten vom Server wartet, diese dann zunächst empfängt und dann ein synchronisiertes Event auslöst, sodaß Applikationen selbst bei großen Datenmengen nicht blockiert werden.
TSimpleTCPServer funktioniert ähnlich; Er implementiert zusätzlich noch eine Liste der momentan bestehenden Verbindungen, über die dann mit den Clients kommuniziert werden kann.
Beide Komponenten beinhalten ein Event OnProgress, dass bei Datenübertragungen den Fortschritt anzeigt, über die Eigenschaft BytesForProgress kann bestimmt werden, nach wievielen übertragenen Bytes das Event erneut ausgelöst werden soll.
Die momentan einzige Möglichkeit, Daten zu senden, ist mittels der Routine SendStream, die Benutzung von Streams ist daher im Moment obligatorisch (meist aber auch empfehlenswert ).
Zum Empfangen wird auf Empfängerseite entweder ein TMemoryStream- oder ein TFileStream- Objekt aufgebaut, je nach Größe des Datenstroms, sodaß selbst größere Datenmengen kein Problem darstellen.
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:
| unit SimpleTCP;
interface
uses Classes, Windows, SysUtils, SyncObjs, idGlobal, IdTCPClient, IdTCPServer;
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:Integer; 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:Integer 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:Integer; FInterceptor:TSimpleTCPInterceptor; published property SizeForFileStream:Int64 read FSizeForFileStream write FSizeForFileStream; property BytesForProgress:Integer read FBytesForProgress write FBytesForProgress; property Interceptor:TSimpleTCPInterceptor read FInterceptor write FInterceptor; end;
TSimpleTCPClient=class(TSimpleTCPComponent) private FThread:TClientThread; FOnInput:THandleInputEvent; FOnProgress:TProgressEvent; 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; 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; FThread: TIDPeerThread; 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(AThread:TIDPeerThread); reintroduce; virtual;
property PeerIP:String read GetPeerIP; property PeerPort:Integer read GetPeerPort; property Data:TObject read FData write FData; end;
TSimpleTCPConnections=class(TObject) private FServer:TSimpleTCPServer; FItems:TList; function Add(AThread:TIDPeerThread):TSimpleTCPConnection; function ByThread(AThread:TIDPeerThread):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 FActive:Boolean; FOnProgress:TServerProgressEvent; FBytesTransferred,FBytesToTransfer:Int64; FCS:TCriticalSection; FOnInput:THandleServerInputEvent; FConnections:TSimpleTCPConnections; FServer:TIDTCPServer; FOnConnect:TServerEvent; FOnDisconnect:TServerEvent; procedure ServerExecute(AThread: TIdPeerThread); procedure InternalOnconnect(AThread:TIDPeerThread); procedure InternalOnDisconnect(AThread:TIDPeerThread); 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 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 Active:Boolean read GetActive write SetActive;
property SizeForFileStream; property BytesForProgress;
end;
function GetTempFile: String;
procedure Register;
const Max_Path=512;
implementation
uses IdSocketHandle;
procedure Register; begin RegisterComponents('Simple Network',[TSimpleTCPClient,TSimpleTCPServer]); 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 TClientThread.Execute; var BytesToRead:Int64; var TempFile:String; begin while not Terminated and (FClient<>NIL) and (FClient.Connected) do try FClient.ReadBuffer(FCommand, SizeOf (FCommand));
if FCommand=coDisconnect then begin FClient.Disconnect; exit; end;
FClient.ReadBuffer(BytesToRead, SizeOf (BytesToRead));
if BytesToRead>=TSimpleTCPClient(FClient.Owner).SizeForFileStream then begin TempFile:=GetTempFile; FStream:=TFileStream.Create(TempFile,fmCreate); end else FStream:=TMemoryStream.Create;
try FStream.Size:=BytesToRead; FStream.Position:=0;
FBytesTransferred:=0; FBytesToTransfer:=BytesToRead;
if Assigned(FOnProgress) then Synchronize(HandleProgress);
While BytesToRead>=FBytesForProgress do begin FClient.ReadStream(FStream,FBytesForProgress); BytesToRead:=BytesToRead-FBytesForProgress; FBytesTransferred:=FBytesTransferred+FBytesForProgress; if Assigned(FOnProgress) then Synchronize(HandleProgress); end;
if BytesToRead>0 then FClient.ReadStream(FStream,BytesToRead);
FStream.Position:=0;
if FStream is TFileStream then begin FStream.Free; FStream:=TFileStream.Create(TempFile,fmOpenRead); end;
if Assigned(FOnProcessCommand) then Synchronize(HandleProcessCommand); finally end; except 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 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; var i:integer; begin for i:=FConnections.Count-1 downto 0 do FConnections[i].Disconnect; Sleep(500);
FServer.Free; FConnections.Free; FCS.Free; inherited; end;
function TSimpleTCPServer.GetActive: Boolean; begin if (csDesigning in ComponentState) then Result:=FActive else 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 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 Assigned(FOnConnect) then FOnConnect(FConnection); end;
procedure TSimpleTCPServer.HandleOnDisconnect; begin if Assigned(FOnDisconnect) then FOnDisconnect(FConnection); end;
procedure TSimpleTCPServer.InternalOnconnect(AThread: TIDPeerThread); begin FCS.Enter; try FConnection:=FConnections.Add(AThread); AThread.Synchronize(HandleOnConnect); finally FCS.Leave; end; end;
procedure TSimpleTCPServer.InternalOnDisconnect(AThread: TIDPeerThread); begin FCS.Enter; try FConnection:=FConnections.ByThread(AThread); FConnections.Delete(FConnection); AThread.Synchronize(HandleOnDisconnect); FConnection.Free;
finally FCS.Leave; end; end;
procedure TSimpleTCPServer.ServerExecute(AThread: TIdPeerThread); var Command:Integer; var Stream:TStream; var TempFile:String; var BytesToTransfer,BytesTransferred,BytesToRead:Int64; begin if (not AThread.Terminated) and (AThread.Connection.Connected) then try AThread.Connection.ReadBuffer(Command, SizeOf(Command)); AThread.Connection.ReadBuffer(BytesToRead, SizeOf(BytesToRead));
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.ByThread(AThread); FBytesTransferred:=BytesTransferred; FBytesToTransfer:=BytesToTransfer;
if Assigned(FOnProgress) then AThread.Synchronize(HandleProgress); finally FCS.Leave; end;
While BytesToRead>=FBytesForProgress do begin AThread.Connection.ReadStream(Stream,FBytesForProgress); BytesToRead:=BytesToRead-FBytesForProgress; BytesTransferred:=BytesTransferred+FBytesForProgress;
FCS.Enter; try FConnection:=FConnections.ByThread(AThread); FBytesTransferred:=BytesTransferred; FBytesToTransfer:=BytesToTransfer;
if Assigned(FOnProgress) then AThread.Synchronize(HandleProgress); finally FCS.Leave; end; end;
if BytesToRead>0 then AThread.Connection.ReadStream(Stream,BytesToRead); Stream.Position:=0;
if Stream is TFileStream then begin Stream.Free; Stream:=TFileStream.Create(TempFile,fmOpenRead); end;
FCS.Enter; try FCommand:=Command; FConnection:=FConnections.ByThread(AThread); FStream:=Stream; AThread.Synchronize(HandleProcessCommand); finally FCS.Leave; end; finally end; except AThread.Connection.Disconnect; AThread.Terminate; end; end;
procedure TSimpleTCPServer.SetActive(const Value: Boolean); begin if (csDesigning in ComponentState) then FActive:=Value else 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); var BytesToWrite:Int64; begin if Assigned(FInterceptor) then FInterceptor.BeforeSendCommand(Stream); Stream.Position:=0;
Connection.FThread.Connection.WriteBuffer(Command,SizeOf(Command));
BytesToWrite:=Stream.Size; Connection.FThread.Connection.WriteBuffer(BytesToWrite,SizeOf(BytesToWrite));
Connection.FThread.Connection.WriteStream(Stream); end;
procedure TSimpleTCPServer.SendStream(Connection: TSimpleTCPConnection; Stream: TStream); begin SendCommand(coData,Connection,Stream); end;
procedure TSimpleTCPServer.HandleProgress; begin if 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.FThread.Connection.WriteBuffer(Command,SizeOf(Command));
Connection.FThread.Connection.WriteBuffer(BytesToWrite,SizeOf(BytesToWrite));
for i:=0 to Length(Streams)-1 do begin Streams[i].Position:=0; Connection.FThread.Connection.WriteStream(Streams[i]); end; end;
constructor TSimpleTCPClient.Create(Aowner: TComponent); begin inherited; FBytesForProgress:=8192; FSizeForFileStream:=1024*1024*8; FClient:=TidTCPClient.Create(Self); end;
destructor TSimpleTCPClient.Destroy; begin FOnProgress:=NIL; FOnInput:=NIL; FClient.OnConnected:=NIL; FClient.OnDisconnected:=NIL; Connected:=False; FClient.Free; inherited; 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:=FClient.OnConnected; end;
function TSimpleTCPClient.GetOnDisconnected: TNotifyEvent; begin Result:=FClient.OnDisconnected; 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 Assigned(FInterceptor) then FInterceptor.BeforeProcessCommand(Stream);
if (Command=coData) and (Assigned(FOnInput)) then FOnInput(Self,Stream,DisposeStream); end;
procedure TSimpleTCPClient.SendCommand(Command: Integer; Stream: TStream); var BytesToWrite:Int64; begin FClient.WriteBuffer(Command,SizeOf(Command));
if Assigned(FInterceptor) then FInterceptor.BeforeSendCommand(Stream);
if Stream=NIL then begin BytesToWrite:=0; FClient.WriteBuffer(BytesToWrite,SizeOf(BytesToWrite)); end else begin BytesToWrite:=Stream.Size; FClient.WriteBuffer(BytesToWrite,SizeOf(BytesToWrite)); Stream.Position:=0; FClient.WriteStream(Stream); 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.WriteBuffer(Command,SizeOf(Command));
FClient.WriteBuffer(BytesToWrite,SizeOf(BytesToWrite));
for i:=0 to Length(Streams)-1 do begin Streams[i].Position:=0; FClient.WriteStream(Streams[i]); 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 FClient.OnConnected:=Value; end;
procedure TSimpleTCPClient.SetOnDisconnected(const Value: TNotifyEvent); begin FClient.OnDisconnected:=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( AThread: TIDPeerThread): TSimpleTCPConnection; begin Result:=TSimpleTCPConnection.Create(AThread); 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.ByThread( AThread: TIDPeerThread): TSimpleTCPConnection; var i:integer; begin Result:=NIL; for i:=0 to Count-1 do if Items[i].FThread=AThread 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].Disconnect; 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(AThread: TIDPeerThread); begin FThread:=AThread; FPeerIP:=FThread.Connection.Socket.Binding.PeerIP; FPeerPort:=FThread.Connection.Socket.Binding.PeerPort; end;
procedure TSimpleTCPConnection.Disconnect; var Command:integer; begin Command:=coDisconnect; if FThread.Connection.Connected then FThread.Connection.WriteBuffer(Command,SizeOf(Command)); FThread.Connection.Disconnect; 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; FThread.Connection.WriteBuffer(Command,SizeOf(Command));
BytesToWrite:=AStream.Size; FThread.Connection.WriteBuffer(BytesToWrite,SizeOf(BytesToWrite));
FThread.Connection.WriteStream(AStream); 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;
FThread.Connection.WriteBuffer(CoData,SizeOf(coData));
FThread.Connection.WriteBuffer(BytesToWrite,SizeOf(BytesToWrite));
for i:=0 to Length(AStreams)-1 do begin AStreams[i].Position:=0; FThread.Connection.WriteStream(AStreams[i]); end; end; end. |
Zuletzt bearbeitet von Udontknow am Do 14.10.04 12:26, insgesamt 1-mal bearbeitet
|
|
Udontknow
Beiträge: 2596
Win7
D2006 WIN32, .NET (C#)
|
Verfasst: Fr 30.07.04 12:51
So, hier eine kleine Beispiel-Anwendung, bei der Dateien zwischen Client und Server hin- und her geschickt werden können.
Download: download.xnebula.de/SimpleTCP.zip
Cu,
Udontknow
|
|
Udontknow
Beiträge: 2596
Win7
D2006 WIN32, .NET (C#)
|
Verfasst: Do 14.10.04 12:31
So, habe nun ein Update vorgenommen. Nun können sogenannte "Interceptors" mit den SimpleTCP-Komponenten verbunden werden. Damit sind nun auch Sachen wie ZLIB-Komprimierung oder Datenmengen-Prüfung per Hash "onthefly" möglich.
Hier mal die Komponente für Datenkompression.
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:
| unit SimpleTCPCompressor;
interface
uses SysUtils, Classes, ZLib, SimpleTCP;
type TSimpleTCPCompressor=class(TSimpleTCPInterceptor) private FCompressionLevel:TCompressionLevel; public procedure BeforeSendCommand(const Stream:TStream); override; procedure BeforeProcessCommand(const Stream:TStream); override; published constructor Create(AOwner:TComponent); override; property CompressionLevel:TCompressionLevel read FCompressionLevel write FCompressionLevel; end;
procedure Register;
implementation
procedure Register; begin RegisterComponents('Simple Network',[TSimpleTCPCompressor]); end;
procedure TSimpleTCPCompressor.BeforeProcessCommand(const Stream: TStream); var SourceStream:TStream; var DecompressStream:TStream; var L:Cardinal; begin if Stream=NIL then exit; try if Stream.Size<=8*1024*1024 then SourceStream:=TMemoryStream.Create else SourceStream:=TFileStream.Create(GetTempFile,fmCreate); try Stream.Position:=0; SourceStream.CopyFrom(Stream,0); SourceStream.Position:=0; Stream.Position:=0; Stream.Size:=0;
SourceStream.ReadBuffer(L,SizeOf(L)); DecompressStream:=TDeCompressionStream.Create(SourceStream); try Stream.CopyFrom(DecompressStream,L); finally DecompressStream.Free; end; Stream.Position:=0;
finally SourceStream.Free; end; except On E:Exception do raise Exception.Create(Classname+': Could not decompress data! '+E.Message); end; end;
procedure TSimpleTCPCompressor.BeforeSendCommand(const Stream: TStream); var SourceStream:TStream; var CompressStream:TStream; var L:Cardinal; begin if Stream=NIL then exit;
L:=Stream.Size;
if Stream.Size<=8*1024*1024 then SourceStream:=TMemoryStream.Create else SourceStream:=TFileStream.Create(GetTempFile,fmCreate); try Stream.Position:=0; SourceStream.CopyFrom(Stream,0); SourceStream.Position:=0; Stream.Position:=0; Stream.Size:=0;
Stream.WriteBuffer(L,SizeOf(L)); compressStream:=TCompressionStream.Create(clMax,Stream); try CompressStream.CopyFrom(SourceStream,L); finally CompressStream.Free; end; Stream.Position:=0;
finally SourceStream.Free; end; end;
constructor TSimpleTCPCompressor.Create(AOwner:TComponent); begin inherited; FCompressionLevel:=clDefault; end;
end. |
Cu,
Udontknow
|
|
JayEff
Beiträge: 2971
Windows Vista Ultimate
D7 Enterprise
|
Verfasst: Di 24.05.05 16:14
Die sache ist sicherlich sehr schön. Ich dachte es kapiert zu haben, und fand es auch schön einfach, nur: Sobald ich an deinem Beispielprogramm etwas verändere (nur eine kleinigkeit, habe die Clientunit in eine neue form der serverapp gepackt und entsprechend angepasst...) schon kommt beim connect "Sockedfehler #10049: Die angeforderte Adresse kann nicht zugewiesen werden". Und auch als ich eine komplett neue anwendung schreiben wollte geschah das gleiche. (Ob das daran liegt, dass ich kein labeledEdit habe? wohl kaum, oder? oO) ich glaube auch nicht, dass ich "localhost" falsch geschrieben habe... oder 127.0.0.1 ...
alles was ich tun wollte war:
Delphi-Quelltext 1: 2: 3: 4: 5:
| procedure TForm3.Button1Click(Sender: TObject); begin client.Host:='localhost'; client.Connected:=true; end; |
und
Delphi-Quelltext 1: 2: 3: 4:
| procedure TForm2.ServerConnect(Connection: TSimpleTCPConnection); begin Listbox1.Items.Add(Connection.PeerIP); end; |
Warum klappt das nur nicht?
_________________ >+++[>+++[>++++++++<-]<-]<++++[>++++[>>>+++++++<<<-]<-]<<++
[>++[>++[>>++++<<-]<-]<-]>>>>>++++++++++++++++++.+++++++.>++.-.<<.>>--.<+++++..<+.
|
|
Aretures
Beiträge: 20
XP
Delphi 7 Arch. | Delphi 2005 Arch.| Delphi 3 Prof.
|
Verfasst: Di 26.07.05 18:44
hmm sry wenn ich den Thread hoch hole aber ich denke du hast die Server Kommponente nicht auf dem Form oder di hast sie nicht aktiviert und den Port eingegeben ^^
::
Frage von mit ...wie empfange ich die Daten wie z.B. einen String ???
|
|
JayEff
Beiträge: 2971
Windows Vista Ultimate
D7 Enterprise
|
Verfasst: Di 26.07.05 20:43
Danke für deine qualifizierte Hilfe, aber ich glaube du hast nicht gelesen, was ich geschrieben habe, oder du bist Anfänger...
Ich habe geschrieben: Socketfehler soundso. Wie kann es einen Socketfehler ohne Socket geben? Garnicht. Wie kann mein Programm compilieren, client.Host:='localhost';
Klappt das zu compilieren, wenn client nicht existiert? nein. Gibt es eine ServerConnect Methode ohne Server? nein.
Ich habe nicht gesagt, der Compiler gäbe mir eine Fehlermeldung. (Socketfehler im Compiler? Informationstechnisches Wunder!) Nein, der Debugger bzw der Prozess selber gibt den Fehler aus.
"Frage von mit ...wie empfange ich die Daten wie z.B. einen String ???" Was auch immer das heissen soll, neue Fragen solltest du in einen neuen thread stellen, denn ich glaube, dass du damit den Wrapper nicht meinen kannst... der ist ja wohl gut erklärt bzw selbsterklärend...
_________________ >+++[>+++[>++++++++<-]<-]<++++[>++++[>>>+++++++<<<-]<-]<<++
[>++[>++[>>++++<<-]<-]<-]>>>>>++++++++++++++++++.+++++++.>++.-.<<.>>--.<+++++..<+.
|
|
|