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

Contents of /trunk/lcoretest.dpr

Parent Directory Parent Directory | Revision Log Revision Log


Revision 149 - (show annotations)
Sun Sep 10 20:02:13 2017 UTC (3 months ago) by plugwash
File size: 6325 byte(s)
Replace obsolete/broken lcoregtklaz with new lcorelazarus
Rename lmessages to lcoremessages due to unit name conflict with Lazarus

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

Properties

Name Value
svn:eol-style CRLF

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