/[lcore]/trunk/lcoretest.dpr
ViewVC logotype

Contents of /trunk/lcoretest.dpr

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (show annotations)
Fri Mar 28 02:26:58 2008 UTC (12 years ago) by plugwash
File size: 5303 byte(s)
initial import

1 program lcoretest;
2
3 uses
4 lcore,
5 lsocket,
6 {$ifdef win32}
7 lcorewsaasyncselect in 'lcorewsaasyncselect.pas',
8 {$else}
9 lcoreselect,
10 {$endif}
11 dnsasync,
12 binipstuff,
13 sysutils,
14 dnssync;
15 {$ifdef win32}
16 {$R *.RES}
17 {$endif}
18
19 type
20 tsc=class
21 procedure sessionavailable(sender: tobject;error : word);
22 procedure dataavailable(sender: tobject;error : word);
23 procedure sessionconnected(sender: tobject;error : word);
24 procedure taskrun(wparam,lparam:longint);
25 procedure timehandler(sender:tobject);
26 procedure dnsrequestdone(sender:tobject;error : word);
27 procedure sessionclosed(sender:tobject;error : word);
28 end;
29 var
30 listensocket : tlsocket;
31 serversocket : tlsocket;
32 clientsocket : tlsocket;
33 sc : tsc;
34 task : tltask;
35 procedure tsc.sessionavailable(sender: tobject;error : word);
36 begin
37 writeln('received connection');
38 serversocket.dup(listensocket.accept);
39 end;
40
41 var
42 receivebuf : string;
43 receivecount : integer;
44 procedure tsc.dataavailable(sender: tobject;error : word);
45 var
46 receiveddata : string;
47 receivedon : string;
48 line : string;
49 begin
50 receiveddata := tlsocket(sender).receivestr;
51 if sender=clientsocket then begin
52 receivedon := 'client socket';
53 end else begin
54 receivedon := 'server socket';
55 end;
56 writeln('received data '+receiveddata+' on '+receivedon);
57
58 receivebuf := receivebuf+receiveddata;
59
60 if receivebuf = 'hello world' then begin
61 receivebuf := '';
62 writeln('received hello world creating task');
63 task := tltask.create(sc.taskrun,nil,0,0);
64 end;
65 receivecount := receivecount +1;
66 if receivecount >50 then begin
67 writeln('received over 50 bits of data, pausing to let the operator take a look');
68 readln;
69 receivecount := 0;
70 end;
71 while pos(#10,receivebuf) > 0 do begin
72 line := receivebuf;
73 setlength(line,pos(#10,receivebuf)-1);
74 receivebuf := copy(receivebuf,pos(#10,receivebuf)+1,1000000);
75 if uppercase(copy(line,1,4))='PING' then begin
76 line[2] := 'o';
77 writeln('send pong:'+line);
78 clientsocket.sendstr(line+#10);
79 end;
80 end;
81 end;
82
83 procedure tsc.sessionconnected(sender: tobject;error : word);
84 begin
85 if error=0 then begin
86 writeln('session is connected, local address is'+clientsocket.getxaddr);
87
88 if (clientsocket.addr = '127.0.0.1') or (clientsocket.addr = '::1') then begin
89 clientsocket.sendstr('hello world');
90 end else begin
91 clientsocket.sendstr('nick test'#13#10'user x x x x'#13#10);
92 end;
93 end else begin
94 writeln('connect failed');
95 end;
96 end;
97
98 var
99 das : tdnsasync;
100
101 procedure tsc.taskrun(wparam,lparam:longint);
102 var
103 tempbinip : tbinip;
104 dummy : integer;
105 begin
106 writeln('task ran');
107 writeln('closing client socket');
108 clientsocket.close;
109
110 writeln('looking up irc.ipv6.p10link.net using dnsasync');
111 das := tdnsasync.Create(nil);
112 das.onrequestdone := sc.dnsrequestdone;
113 //das.forwardfamily := af_inet6;
114 das.forwardlookup('irc.ipv6.p10link.net');
115 end;
116
117 procedure tsc.dnsrequestdone(sender:tobject;error : word);
118 begin
119 writeln('irc.ipv6.p10link.net resolved to '+das.dnsresult+' connecting client socket there');
120 clientsocket.addr := das.dnsresult;
121 clientsocket.port := '6667';
122 clientsocket.connect;
123 writeln(clientsocket.getxaddr);
124 das.free;
125 end;
126
127 procedure tsc.timehandler(sender:tobject);
128 begin
129 //writeln('got timer event');
130 end;
131 procedure tsc.sessionclosed(sender:tobject;error : word);
132 begin
133 Writeln('session closed with error ',error);
134 end;
135 var
136 timer : tltimer;
137 ipbin : tbinip;
138 dummy : integer;
139 begin
140 ipbin := forwardlookup('invalid.domain',5);
141 writeln(ipbintostr(ipbin));
142
143 ipbin := forwardlookup('p10link.net',5);
144 writeln(ipbintostr(ipbin));
145
146 ipstrtobin('80.68.89.68',ipbin);
147 writeln('80.68.89.68 reverses to '+reverselookup(ipbin,5));
148
149 ipstrtobin('2001:200::8002:203:47ff:fea5:3085',ipbin);
150 writeln('2001:200::8002:203:47ff:fea5:3085 reverses to '+reverselookup(ipbin,5));
151 writeln('creating and setting up listen socket');
152 listensocket := tlsocket.create(nil);
153 listensocket.addr := '::';
154 listensocket.port := '12345';
155 listensocket.onsessionavailable := sc.sessionavailable;
156 writeln('listening');
157 listensocket.listen;
158 writeln(listensocket.getxport);
159 writeln('listen socket is number ', listensocket.fdhandlein);
160 writeln('creating and setting up server socket');
161 serversocket := tlsocket.create(nil);
162 serversocket.ondataavailable := sc.dataavailable;
163 writeln('creating and setting up client socket');
164 clientsocket := tlsocket.create(nil);
165 clientsocket.addr := '::1';{'127.0.0.1';}
166 clientsocket.port := '12345';
167 clientsocket.onsessionconnected := sc.sessionconnected;
168 clientsocket.ondataAvailable := sc.dataavailable;
169 clientsocket.onsessionclosed := sc.sessionclosed;
170 writeln('connecting');
171 clientsocket.connect;
172 writeln('client socket is number ',clientsocket.fdhandlein);
173 writeln('creating and setting up timer');
174 timer := tltimer.create(nil);
175 timer.interval := 1000;
176 timer.ontimer := sc.timehandler;
177 timer.enabled := true;
178 writeln('entering message loop');
179 messageloop;
180 writeln('exiting cleanly');
181 end.

Properties

Name Value
svn:executable

No admin address has been configured">No admin address has been configured
ViewVC Help
Powered by ViewVC 1.1.22