| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145 |
- { $HDR$}
- {**********************************************************************}
- { Unit archived using Team Coherence }
- { Team Coherence is Copyright 2002 by Quality Software Components }
- { }
- { For further information / comments, visit our WEB site at }
- { http://www.TeamCoherence.com }
- {**********************************************************************}
- {}
- { $Log: 14146: IPv6.pas
- {
- { Rev 1.2 9/8/2003 02:54:54 PM JPMugaas
- { IPv6Detection test should work.
- }
- {
- Rev 1.1 4/5/2003 3:39:56 PM BGooijen
- now checks for IPv6 support first
- }
- {
- { Rev 1.0 12-7-2002 12:42:54 BGooijen
- { Tests to check if IPv4 and IPv6 works.
- { This is done by connection a TCPClient to a TCPServer.
- { NOTE: the IPv6 test fails when there is no IPv6 support in the OS.
- }
- unit IPv6;
- interface
- uses
- IndyBox;
- type
- TIdv6Test = class(TIndyBox)
- procedure Test; override;
- end;
- TIPv6Box = class(TIndyBox)
- public
- procedure Test; override;
- end;
- implementation
- uses
- IdComponent, IdStack,
- IdTCPServer, IdTCPClient, IdException, IdServerIOHandlerStack, IdIOHandlerStack, IdCoreGlobal,IdWship6,
- SysUtils;
- function IPv6Supported : Boolean;
- var LCreated : Boolean;
- begin
- LCreated := False;
- if Assigned(GStack)=False then
- begin
- GStack := TIdStack.CreateStack;
- LCreated := True;
- end;
- Result := GStack.SupportsIP6;
- if LCreated then
- begin
- FreeAndNil(GStack);
- end;
- end;
- { TCommandHandlerProc }
- procedure TIPv6Box.Test;
- var
- LServer: TIdTCPServer;
- LServerIO:TIdServerIOHandlerStack;
- LClient: TIdTCPClient;
- LClientIO:TIdIOHandlerStack;
- begin
- LServer:= nil;
- LServerIO:= nil;
- LClient:= nil;
- LClientIO:= nil;
- If IPv6Supported = False then
- begin
- Status('IPv6-support not detected, skipping test');
- exit;
- end;
- //if not IdIPv6Available then begin
- // Status('IPv6-support not detected, skipping test');
- // exit;
- //end;
- try
- LServer:= TIdTCPServer.Create(nil);
- LServerIO:= TIdServerIOHandlerStack.Create(nil);
- LServer.IOHandler:= LServerIO;
- with LServer.Bindings.Add do begin
- IP:='::0';
- Port:=12987;
- IPVersion:=Id_IPv6;
- end;
- try
- LServer.Active:=true;
- except on e: EIdException do
- Check(false, 'The TIdTCPServer failed to start: '+e.message);
- end;
- Check(LServer.Active, 'The TIdTCPServer doesn''t seem to be running, but no exception occured?'); // BGO: Just to be sure
- LClient:= TIdTCPClient.Create(nil);
- LClientIO:= TIdIOHandlerStack.Create(nil);
- LClient.IOHandler:=LClientIO;
- LClientIO.Host:='::1';
- LClientIO.Port:=12987;
- LClientIO.IPVersion:=Id_IPv6;
- try
- LClient.Connect;
- except on e: EIdException do
- Check(false, 'The TIdTCPClient failed to connect: '+e.message);
- end;
- finally
- FreeAndNil( LServer );
- FreeAndNil( LServerIO );
- FreeAndNil( LClient );
- FreeAndNil( LClientIO );
- end;
- end;
- { TIdv6Test }
- procedure TIdv6Test.Test;
- begin
- If IPv6Supported then
- begin
- Status('IPv6-support detected');
- end
- else
- begin
- Status('IPv6-support not detected');
- end;
- end;
- initialization
- TIndyBox.RegisterBox(TIPv6Box, 'IPv6 Support', 'Misc');
- TIndyBox.RegisterBox(TIdv6Test,'IPv6 detection', 'Misc');
- end.
|