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