1{ %INTERACTIVE } 2{ %TARGET=win32,linux,wince } 3 4{ Source provided for Free Pascal Bug Report 966 } 5{$i-} 6uses 7{$ifdef Unix} 8 linux, 9{$else} 10 crt, 11{$endif} 12 Sockets; 13Var 14 S : Longint ; Sin,Sout: Text; 15 Temp, Temp2 : Char; 16 i : longint; 17 18const 19 isocket: TInetSockAddr= ( 20 Family:AF_INET; 21 Port:$1500; 22 Addr:((93*256+36)*256+161)*256+130); 23 {*** ftp 130.161.36.93 i.e. ftp.freepascal.org } 24 { FIXME: it would be much better to have the number 25 through a name server but I don't know how to do this ! PM } 26 27 procedure perror(const S: string); 28 begin 29 writeln(S,SocketError); 30 halt(100) ; 31 end; 32 33 procedure read_to_eof; 34 var 35 temp2 : char; 36 begin 37{$ifdef Unix} 38 while selecttext(sin,1)>0 do 39 begin 40 read(Sin,Temp2); 41 write(Temp2); 42 end; 43{$else} 44 repeat until not eof(sin); 45 while not eof(sin) do 46 begin 47 read(Sin,Temp2); 48 write(Temp2); 49 delay(1); 50 end; 51{$endif} 52 end; 53 54begin 55 S:=Socket(AF_INET,SOCK_STREAM,0); 56 if SocketError<>0 then Perror('Client : Socket : '); 57 WriteLn('*1'); 58 if not Connect(s,isocket,sin,sout)then Perror('Client : Socket : '); 59 WriteLn('*2'); 60 ReWrite(Sout); Reset(Sin); 61 WriteLn('*3'); 62 read_to_eof; 63 Writeln('Sending "USER anonymous#10"'); 64 Write(Sout,'USER anonymous'#10); 65 read_to_eof; 66 Writeln('Sending "PASS core@freepascal.org#10"'); 67 Write(Sout,'PASS core@freepascal.org'#10); 68 read_to_eof; 69 Writeln('Sending "QUIT#10"'); 70 Write(Sout,'QUIT'#10); 71 read_to_eof; 72 shutdown(s,2); close(sin); close(sout); 73end. 74