├── lazaruspackage ├── lnetbase.opkman ├── INSTALL.md ├── lnetvisual.pas ├── lnetbase.pas ├── LICENSE.ADDON ├── README ├── icons │ ├── TLFtpClientComponent.xpm │ ├── TLHTTPClientComponent.xpm │ ├── TLHTTPServerComponent.xpm │ ├── TLSMTPClientComponent.xpm │ ├── TLTcpComponent.xpm │ ├── TLUdpComponent.xpm │ ├── TLSSLSessionComponent.xpm │ └── TLTelnetClientComponent.xpm ├── CHANGELOG ├── lnetvisualreg.pas ├── lclnet.pas ├── lnetvisual.template ├── lnetvisual.lpk ├── lclgtkeventer.inc ├── lclwineventer.inc ├── lclwinceeventer.inc └── lnetbase.lpk ├── tests ├── stress2 │ ├── stress2.ico │ ├── stress2.res │ ├── stress2.lpr │ ├── umain.lfm │ └── umain.pas ├── linkserver │ ├── linkserver.ico │ ├── linkserver.res │ ├── Makefile │ └── linkserver.pas ├── http │ ├── Makefile │ ├── expected.txt │ └── httptest.pas ├── Makefile └── stress1 │ ├── Makefile │ └── stress1.pas ├── doc └── inheritance_composition.dia ├── lib ├── sys │ ├── lspawnfcgiwin.inc │ ├── osunits.inc │ ├── lkqueueeventerh.inc │ ├── lepolleventerh.inc │ ├── lspawnfcgiunix.inc │ └── lkqueueeventer.inc ├── LICENSE.ADDON ├── lcontainersh.inc ├── lcontainers.inc ├── lspawnfcgi.pp ├── lws2tcpip.pp ├── lws2override.pp ├── ltimer.pp ├── lcontrolstack.pp ├── lmimetypes.pp ├── lstrbuffer.pp ├── fastcgi_base.pp ├── lprocess.pp ├── lthreadevents.pp └── lmimestreams.pp ├── examples ├── Makefile ├── console │ ├── ludp │ │ ├── Makefile │ │ └── ludp.pp │ ├── ltelnet │ │ ├── Makefile │ │ └── ltclient.pp │ ├── lftp │ │ └── Makefile │ ├── lsmtp │ │ └── Makefile │ ├── lhttp │ │ ├── Makefile │ │ ├── README │ │ └── fpget.pp │ ├── ltcp │ │ ├── Makefile │ │ ├── lserver.pp │ │ └── lclient.pp │ └── Makefile ├── visual │ ├── tcpudp │ │ ├── testnet.lpr │ │ ├── cert │ │ ├── pkey │ │ ├── testnet.lpi │ │ ├── main.lrs │ │ └── main.lfm │ ├── telnet │ │ ├── telnet.lpr │ │ ├── main.lrs │ │ ├── main.lfm │ │ ├── main.pas │ │ └── telnet.lpi │ ├── http │ │ ├── httpclienttest.lpr │ │ ├── main.lrs │ │ ├── main.lfm │ │ ├── httpclienttest.lpi │ │ └── main.pas │ ├── ftp │ │ ├── ftptest.lpr │ │ ├── ufeatures.lfm │ │ ├── ufeatures.lrs │ │ ├── images │ │ │ ├── ftp_archive.xpm │ │ │ ├── ftp_dir.xpm │ │ │ ├── ftp_dirup.xpm │ │ │ ├── ftp_error.xpm │ │ │ ├── ftp_file.xpm │ │ │ └── ftp_link.xpm │ │ ├── ufeatures.pas │ │ ├── iconsextra.lrs │ │ ├── ftptest.lpi │ │ ├── icons.lrs │ │ ├── sitesunit.lrs │ │ ├── sitesunit.lfm │ │ └── main.lrs │ └── smtp │ │ ├── smtptest.lpr │ │ ├── logs.pas │ │ ├── logs.lrs │ │ ├── logs.lfm │ │ └── smtptest.lpi └── REQUIREMENTS.txt ├── Makefile ├── .gitignore ├── INSTALL.md ├── README.md └── CHANGELOG /lazaruspackage/lnetbase.opkman: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /tests/stress2/stress2.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/almindor/lnet/HEAD/tests/stress2/stress2.ico -------------------------------------------------------------------------------- /tests/stress2/stress2.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/almindor/lnet/HEAD/tests/stress2/stress2.res -------------------------------------------------------------------------------- /doc/inheritance_composition.dia: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/almindor/lnet/HEAD/doc/inheritance_composition.dia -------------------------------------------------------------------------------- /tests/linkserver/linkserver.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/almindor/lnet/HEAD/tests/linkserver/linkserver.ico -------------------------------------------------------------------------------- /tests/linkserver/linkserver.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/almindor/lnet/HEAD/tests/linkserver/linkserver.res -------------------------------------------------------------------------------- /lib/sys/lspawnfcgiwin.inc: -------------------------------------------------------------------------------- 1 | 2 | 3 | function SpawnFCGIProcess(App, Enviro: string; const aPort: Word): Integer; 4 | begin 5 | Result:=0; // TODO: implement 6 | end; 7 | 8 | -------------------------------------------------------------------------------- /examples/Makefile: -------------------------------------------------------------------------------- 1 | 2 | all: 3 | $(MAKE) -C console OPT=$(OPT) 4 | 5 | argless: 6 | $(MAKE) -C console argless OPT=$(OPT) 7 | 8 | clean: 9 | $(MAKE) -C console clean 10 | rm -f *~ 11 | -------------------------------------------------------------------------------- /tests/http/Makefile: -------------------------------------------------------------------------------- 1 | PP=fpc 2 | DELP=delp 3 | PATHS=-Fu../../lib -Fi../../lib/sys 4 | ARGS=$(PATHS) -O2 -XX -Xs 5 | SRC=httptest.pas 6 | 7 | all: 8 | $(PP) $(ARGS) $(SRC) 9 | 10 | clean: 11 | $(DELP) . -------------------------------------------------------------------------------- /tests/Makefile: -------------------------------------------------------------------------------- 1 | 2 | all: 3 | $(MAKE) -C http 4 | $(MAKE) -C stress1 5 | $(MAKE) -C linkserver 6 | 7 | clean: 8 | $(MAKE) clean -C http 9 | $(MAKE) clean -C stress1 10 | $(MAKE) clean -C linkserver 11 | -------------------------------------------------------------------------------- /tests/stress1/Makefile: -------------------------------------------------------------------------------- 1 | PP=fpc 2 | DELP=delp 3 | PATHS=-Fu../../lib -Fi../../lib/sys 4 | ARGS=$(PATHS) -O2 -XX -Xs 5 | SRC=stress1.pas 6 | 7 | all: 8 | $(PP) $(ARGS) $(SRC) 9 | 10 | clean: 11 | $(DELP) . -------------------------------------------------------------------------------- /tests/linkserver/Makefile: -------------------------------------------------------------------------------- 1 | PP=fpc 2 | DELP=delp 3 | PATHS=-Fu../../lib -Fi../../lib/sys 4 | ARGS=$(PATHS) -O2 -XX -Xs 5 | SRC=linkserver.pas 6 | 7 | all: 8 | $(PP) $(ARGS) $(SRC) 9 | 10 | clean: 11 | $(DELP) . -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | 2 | all: 3 | $(MAKE) -C examples OPT=$(OPT) 4 | 5 | argless: 6 | $(MAKE) -C examples argless OPT=$(OPT) 7 | 8 | clean: 9 | delp . 10 | delp lib 11 | delp lib/sys 12 | delp examples/console/units 13 | $(MAKE) -C examples clean 14 | rm -f *~ 15 | -------------------------------------------------------------------------------- /lib/sys/osunits.inc: -------------------------------------------------------------------------------- 1 | {$ifdef WINDOWS} 2 | Winsock2, 3 | {$endif} 4 | 5 | {$ifdef UNIX} 6 | BaseUnix, NetDB, 7 | {$endif} 8 | 9 | {$ifdef NETWARE} 10 | WinSock, 11 | {$endif} 12 | 13 | {$ifdef OS2} 14 | WinSock, 15 | {$endif} 16 | 17 | SysUtils, Sockets; 18 | 19 | -------------------------------------------------------------------------------- /lazaruspackage/INSTALL.md: -------------------------------------------------------------------------------- 1 | 2 | ## Installing the visual package in Lazarus 3 | 4 | 1. Start Lazarus, go to components/open packaga file (`*.lpk`) 5 | 2. Open lnetvisual.lpk and install 6 | 3. Let Lazarus restart. 7 | 8 | You can learn the basics by using the included examples or from [the lNet homepage](http://wiki.lazarus.freepascal.org/index.php/LNet) 9 | -------------------------------------------------------------------------------- /examples/console/ludp/Makefile: -------------------------------------------------------------------------------- 1 | PP=fpc 2 | BASEARGS=-Fu../../../lib -Fi../../../lib/sys -Sm -FU../units -FE. 3 | ARGS=$(BASEARGS) $(OPT) -O2 -XX -Xs 4 | 5 | all: 6 | $(PP) $(ARGS) ludp 7 | 8 | argless: 9 | $(PP) $(BASEARGS) $(OPT) ludp 10 | 11 | clean: 12 | delp . 13 | rm -f ludp 14 | rm -f *~ 15 | 16 | clear: 17 | $(MAKE) -C . clean 18 | $(MAKE) -C ../../../ clean 19 | -------------------------------------------------------------------------------- /examples/visual/tcpudp/testnet.lpr: -------------------------------------------------------------------------------- 1 | program testnet; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | uses 6 | Interfaces, // this includes the LCL widgetset 7 | Forms 8 | { add your units here }, main; 9 | 10 | begin 11 | Application.Title:='TCP/UDP Test case'; 12 | Application.Initialize; 13 | Application.CreateForm(TFormMain, FormMain); 14 | Application.Run; 15 | end. 16 | 17 | -------------------------------------------------------------------------------- /examples/console/ltelnet/Makefile: -------------------------------------------------------------------------------- 1 | PP=fpc 2 | BASEARGS=-Fu../../../lib -Fi../../../lib/sys -Sm -FU../units -FE. 3 | ARGS=$(BASEARGS) $(OPT) -O2 -XX -Xs 4 | 5 | all: 6 | $(PP) $(ARGS) ltclient 7 | 8 | argless: 9 | $(PP) $(BASEARGS) $(OPT) ltclient 10 | 11 | clean: 12 | delp . 13 | rm -f ltclient 14 | rm -f *~ 15 | 16 | clear: 17 | $(MAKE) -C . clean 18 | $(MAKE) -C ../../../ clean 19 | -------------------------------------------------------------------------------- /examples/console/lftp/Makefile: -------------------------------------------------------------------------------- 1 | PP=fpc 2 | BASEARGS=-Fu../../../lib -Fi../../../lib/sys -Sm -FU../units -FE. 3 | ARGS=$(BASEARGS) $(OPT) -O2 -XX -Xs 4 | 5 | all: 6 | $(PP) $(ARGS) lftpclient 7 | 8 | argless: 9 | $(PP) $(BASEARGS) $(OPT) lftpclient 10 | 11 | clean: 12 | delp . 13 | rm -f lftpclient 14 | rm -f *~ 15 | 16 | clear: 17 | $(MAKE) -C . clean 18 | $(MAKE) -C ../../../ clean 19 | -------------------------------------------------------------------------------- /examples/console/lsmtp/Makefile: -------------------------------------------------------------------------------- 1 | PP=fpc 2 | BASEARGS=-Fu../../../lib -Fi../../../lib/sys -Sm -FU../units -FE. 3 | ARGS=$(BASEARGS) $(OPT) -O2 -XX -Xs 4 | 5 | all: 6 | $(PP) $(ARGS) lsmtpclient 7 | 8 | argless: 9 | $(PP) $(BASEARGS) $(OPT) lsmtpclient 10 | 11 | clean: 12 | delp . 13 | rm -f lsmtpclient 14 | rm -f *~ 15 | 16 | clear: 17 | $(MAKE) -C . clean 18 | $(MAKE) -C ../../../ clean 19 | -------------------------------------------------------------------------------- /examples/REQUIREMENTS.txt: -------------------------------------------------------------------------------- 1 | All visual examples require Lazarus 0.9.26+ (best use latest release) 2 | 3 | The only additional requirements for some examples provided here is OpenSSL (http://www.openssl.org) 4 | 5 | In UNIX/Linux/MacOSX OpenSSL is usually installed by default, however a DEVELOPMENT package may be required (Ubuntu). 6 | 7 | Examples which require OpenSSL: 8 | 9 | console/lhttp 10 | visual/smtp 11 | visual/http -------------------------------------------------------------------------------- /examples/visual/telnet/telnet.lpr: -------------------------------------------------------------------------------- 1 | program telnet; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | uses 6 | {$IFDEF UNIX}{$IFDEF UseCThreads} 7 | cthreads, 8 | {$ENDIF}{$ENDIF} 9 | Interfaces, // this includes the LCL widgetset 10 | Forms 11 | { you can add units after this }, main, lnetvisual; 12 | 13 | begin 14 | Application.Initialize; 15 | Application.CreateForm(TFormMain, FormMain); 16 | Application.Run; 17 | end. 18 | 19 | -------------------------------------------------------------------------------- /examples/visual/http/httpclienttest.lpr: -------------------------------------------------------------------------------- 1 | program httpclienttest; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | uses 6 | {$IFDEF UNIX}{$IFDEF UseCThreads} 7 | cthreads, 8 | {$ENDIF}{$ENDIF} 9 | Interfaces, // this includes the LCL widgetset 10 | Forms 11 | { add your units here }, main, lnetvisual, lnetbase; 12 | 13 | begin 14 | Application.Initialize; 15 | Application.CreateForm(TMainForm, MainForm); 16 | Application.Run; 17 | end. 18 | 19 | -------------------------------------------------------------------------------- /examples/console/lhttp/Makefile: -------------------------------------------------------------------------------- 1 | PP=fpc 2 | BASEARGS=-Fu../../../lib -Fi../../../lib/sys -Sm -FU../units -FE. 3 | ARGS=$(BASEARGS) $(OPT) -O2 -XX -Xs 4 | 5 | all: 6 | $(PP) $(ARGS) fphttpd 7 | $(PP) $(ARGS) fpget 8 | 9 | argless: 10 | $(PP) $(BASEARGS) $(OPT) fphttpd 11 | $(PP) $(BASEARGS) $(OPT) fpget 12 | 13 | clean: 14 | delp . 15 | rm -f fphttpd 16 | rm -f *~ 17 | rm -f fpget 18 | 19 | clear: 20 | $(MAKE) -C . clean 21 | $(MAKE) -C ../../../ clean 22 | -------------------------------------------------------------------------------- /examples/console/ltcp/Makefile: -------------------------------------------------------------------------------- 1 | PP=fpc 2 | BASEARGS=-Fu../../../lib -Fi../../../lib/sys -Sm -FU../units -FE. 3 | ARGS=$(BASEARGS) $(OPT) -O2 -XX -Xs 4 | 5 | all: 6 | $(PP) $(ARGS) lserver 7 | $(PP) $(ARGS) lclient 8 | 9 | argless: 10 | $(PP) $(BASEARGS) $(OPT) lserver 11 | $(PP) $(BASEARGS) $(OPT) lclient 12 | 13 | clean: 14 | delp . 15 | rm -f lserver 16 | rm -f lclient 17 | rm -f *~ 18 | 19 | clear: 20 | $(MAKE) -C . clean 21 | $(MAKE) -C ../../../ clean 22 | -------------------------------------------------------------------------------- /examples/visual/ftp/ftptest.lpr: -------------------------------------------------------------------------------- 1 | program ftptest; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | uses 6 | Interfaces, // this includes the LCL widgetset 7 | Forms 8 | { add your units here }, Main, sitesunit, dleparsers, lnetvisual, uFeatures; 9 | 10 | begin 11 | Application.Title:='FTP Test case'; 12 | Application.Initialize; 13 | Application.CreateForm(TMainForm, MainForm); 14 | Application.CreateForm(TFormFeatures, FormFeatures); 15 | Application.Run; 16 | end. 17 | 18 | -------------------------------------------------------------------------------- /tests/stress2/stress2.lpr: -------------------------------------------------------------------------------- 1 | program stress2; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | uses 6 | {$IFDEF UNIX}{$IFDEF UseCThreads} 7 | cthreads, 8 | {$ENDIF}{$ENDIF} 9 | Interfaces, // this includes the LCL widgetset 10 | Forms, umain, lnetvisual 11 | { you can add units after this }; 12 | 13 | {$R *.res} 14 | 15 | begin 16 | RequireDerivedFormResource := True; 17 | Application.Initialize; 18 | Application.CreateForm(TForm1, Form1); 19 | Application.Run; 20 | end. 21 | 22 | -------------------------------------------------------------------------------- /examples/visual/smtp/smtptest.lpr: -------------------------------------------------------------------------------- 1 | program smtptest; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | uses 6 | {$IFDEF UNIX}{$IFDEF UseCThreads} 7 | cthreads, 8 | {$ENDIF}{$ENDIF} 9 | Interfaces, // this includes the LCL widgetset 10 | Forms 11 | { add your units here }, main, lnetvisual, lnetbase, logs; 12 | 13 | begin 14 | Application.Initialize; 15 | Application.CreateForm(TMainForm, MainForm); 16 | Application.CreateForm(TFormLogs, FormLogs); 17 | Application.Run; 18 | end. 19 | 20 | -------------------------------------------------------------------------------- /tests/linkserver/linkserver.pas: -------------------------------------------------------------------------------- 1 | program linkserver; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | uses 6 | Classes, SysUtils, 7 | uLinkTCP; 8 | 9 | {$R *.res} 10 | 11 | var 12 | ls: TLinkServer; 13 | begin 14 | if Paramcount <> 3 then begin 15 | Writeln('Usage: ', ParamStr(0), ' '); 16 | Exit; 17 | end; 18 | 19 | ls := TLinkServer.Create(ParamStr(1), StrToInt(ParamStr(2)), StrToInt(ParamStr(3))); 20 | ls.Run; 21 | ls.Free; 22 | end. 23 | 24 | -------------------------------------------------------------------------------- /examples/visual/ftp/ufeatures.lfm: -------------------------------------------------------------------------------- 1 | object FormFeatures: TFormFeatures 2 | Left = 400 3 | Height = 300 4 | Top = 202 5 | Width = 400 6 | ActiveControl = ListBoxFeatures 7 | Caption = 'Features' 8 | ClientHeight = 300 9 | ClientWidth = 400 10 | LCLVersion = '0.9.29' 11 | object ListBoxFeatures: TListBox 12 | Left = 0 13 | Height = 300 14 | Top = 0 15 | Width = 400 16 | Align = alClient 17 | ItemHeight = 0 18 | TabOrder = 0 19 | TopIndex = -1 20 | end 21 | end 22 | -------------------------------------------------------------------------------- /lazaruspackage/lnetvisual.pas: -------------------------------------------------------------------------------- 1 | { This file was automatically created by Lazarus. Do not edit! 2 | This source is only used to compile and install the package. 3 | } 4 | 5 | unit lnetvisual; 6 | 7 | interface 8 | 9 | uses 10 | LCLNet, lNetComponents, LNetVisualReg, LazarusPackageIntf; 11 | 12 | implementation 13 | 14 | procedure Register; 15 | begin 16 | RegisterUnit('LNetVisualReg', @LNetVisualReg.Register); 17 | end; 18 | 19 | initialization 20 | RegisterPackage('lnetvisual', @Register); 21 | end. 22 | -------------------------------------------------------------------------------- /lazaruspackage/lnetbase.pas: -------------------------------------------------------------------------------- 1 | { Tento súbor bol automaticky vytvorený Lazarom. Prosím neurpavovať! 2 | Tento zdrojový kód je použitý len na preloženie a nainštalovanie tohoto 3 | balíčka. 4 | } 5 | 6 | unit lnetbase; 7 | 8 | interface 9 | 10 | uses 11 | lNet, lEvents, lCommon, lFTP, lsmtp, lTelnet, lhttp, lwebserver, 12 | lMimeWrapper, lHTTPUtil, lControlStack, lMimeStreams, lMimeTypes, lProcess, 13 | lSpawnFCGI, lStrBuffer, ltimer, lNetSSL, lThreadEvents, fastcgi_base; 14 | 15 | implementation 16 | 17 | end. 18 | -------------------------------------------------------------------------------- /tests/stress1/stress1.pas: -------------------------------------------------------------------------------- 1 | program stress1; 2 | 3 | { Stress test creation/free cycle, as well as server 4 | disconnect/connect on the other end. Use with TCP examples } 5 | 6 | {$mode objfpc}{$H+} 7 | 8 | uses 9 | Classes, Crt, SysUtils, lNet, lEvents; 10 | 11 | var 12 | TCP: TLTCP; 13 | i: Integer; 14 | begin 15 | i := 0; 16 | while true do 17 | begin 18 | TCP := TLTCP.Create(nil); 19 | TCP.Connect('127.0.0.1', 4665); 20 | TCP.Free; 21 | Inc(i); 22 | Writeln(IntToStr(i)); 23 | end; 24 | end. 25 | 26 | -------------------------------------------------------------------------------- /examples/visual/ftp/ufeatures.lrs: -------------------------------------------------------------------------------- 1 | LazarusResources.Add('TFormFeatures','FORMDATA',[ 2 | 'TPF0'#13'TFormFeatures'#12'FormFeatures'#4'Left'#3#144#1#6'Height'#3','#1#3 3 | +'Top'#3#202#0#5'Width'#3#144#1#13'ActiveControl'#7#15'ListBoxFeatures'#7'Cap' 4 | +'tion'#6#8'Features'#12'ClientHeight'#3','#1#11'ClientWidth'#3#144#1#10'LCLV' 5 | +'ersion'#6#6'0.9.29'#0#8'TListBox'#15'ListBoxFeatures'#4'Left'#2#0#6'Height' 6 | +#3','#1#3'Top'#2#0#5'Width'#3#144#1#5'Align'#7#8'alClient'#10'ItemHeight'#2#0 7 | +#8'TabOrder'#2#0#8'TopIndex'#2#255#0#0#0 8 | ]); 9 | -------------------------------------------------------------------------------- /examples/visual/ftp/images/ftp_archive.xpm: -------------------------------------------------------------------------------- 1 | /* XPM */ 2 | static char *ftp_archive[] = { 3 | /* columns rows colors chars-per-pixel */ 4 | "15 13 5 1", 5 | " c black", 6 | ". c red", 7 | "X c yellow", 8 | "o c None", 9 | "O c #808080", 10 | /* pixels */ 11 | "ooooooooooooooo", 12 | "o..oo.ooooooooo", 13 | "o...o.ooOOOoooo", 14 | "oo....oOXXXOOoo", 15 | "ooo...OXXXOXXOo", 16 | "o..... o", 17 | "ooooo XXX XXX o", 18 | "ooooo XXX XXX o", 19 | "ooooo o", 20 | "ooooo XXX XXX o", 21 | "ooooo XXX XXX o", 22 | "ooooo o", 23 | "ooooooooooooooo" 24 | }; 25 | -------------------------------------------------------------------------------- /tests/stress2/umain.lfm: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 738 3 | Height = 240 4 | Top = 278 5 | Width = 320 6 | Caption = 'Form1' 7 | ClientHeight = 240 8 | ClientWidth = 320 9 | LCLVersion = '0.9.31' 10 | object Button1: TButton 11 | Left = 79 12 | Height = 25 13 | Top = 130 14 | Width = 75 15 | Caption = 'Start' 16 | OnClick = Button1Click 17 | TabOrder = 0 18 | end 19 | object Edit1: TEdit 20 | Left = 168 21 | Height = 23 22 | Top = 130 23 | Width = 80 24 | TabOrder = 1 25 | Text = '0' 26 | end 27 | end 28 | -------------------------------------------------------------------------------- /examples/visual/ftp/ufeatures.pas: -------------------------------------------------------------------------------- 1 | unit uFeatures; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | interface 6 | 7 | uses 8 | Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, 9 | StdCtrls; 10 | 11 | type 12 | 13 | { TFormFeatures } 14 | 15 | TFormFeatures = class(TForm) 16 | ListBoxFeatures: TListBox; 17 | private 18 | { private declarations } 19 | public 20 | { public declarations } 21 | end; 22 | 23 | var 24 | FormFeatures: TFormFeatures; 25 | 26 | implementation 27 | 28 | 29 | initialization 30 | {$I ufeatures.lrs} 31 | 32 | end. 33 | 34 | -------------------------------------------------------------------------------- /tests/http/expected.txt: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | Lightweight Networking Unit 6 | 7 | 8 | 9 | 10 | This site is now obsolete, please point your links to: 11 | http://lnet.wordpress.com 12 | 13 | 14 | -------------------------------------------------------------------------------- /examples/visual/ftp/iconsextra.lrs: -------------------------------------------------------------------------------- 1 | LazarusResources.Add('ftp_archive','XPM',[ 2 | '/* XPM */'#10'static char *ftp_archive[] = {'#10'/* columns rows colors char' 3 | +'s-per-pixel */'#10'"15 13 5 1",'#10'" c black",'#10'". c red",'#10'"X c ye' 4 | +'llow",'#10'"o c None",'#10'"O c #808080",'#10'/* pixels */'#10'"ooooooooooo' 5 | +'oooo",'#10'"o..oo.ooooooooo",'#10'"o...o.ooOOOoooo",'#10'"oo....oOXXXOOoo",' 6 | +#10'"ooo...OXXXOXXOo",'#10'"o..... o",'#10'"ooooo XXX XXX o",'#10'"oo' 7 | +'ooo XXX XXX o",'#10'"ooooo o",'#10'"ooooo XXX XXX o",'#10'"ooooo XX' 8 | +'X XXX o",'#10'"ooooo o",'#10'"ooooooooooooooo"'#10'};'#10 9 | ]); 10 | -------------------------------------------------------------------------------- /examples/visual/smtp/logs.pas: -------------------------------------------------------------------------------- 1 | unit Logs; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | interface 6 | 7 | uses 8 | Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls; 9 | 10 | type 11 | 12 | { TFormLogs } 13 | 14 | TFormLogs = class(TForm) 15 | GroupBoxFeatures: TGroupBox; 16 | GroupBoxLog: TGroupBox; 17 | ListBoxFeatures: TListBox; 18 | MemoLogs: TMemo; 19 | private 20 | { private declarations } 21 | public 22 | { public declarations } 23 | end; 24 | 25 | var 26 | FormLogs: TFormLogs; 27 | 28 | implementation 29 | 30 | { TFormLogs } 31 | 32 | initialization 33 | {$I logs.lrs} 34 | 35 | end. 36 | 37 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | **/units 2 | **/*.ppu 3 | **/*.o 4 | **/*.bak 5 | **/*.exe 6 | **/*.or 7 | **/*.compiled 8 | **/*.dbg 9 | **/backup 10 | **/*.lrs 11 | **/*.lps 12 | examples/console/*/*.lpi 13 | 14 | examples/console/lftp/lftpclient 15 | examples/console/lhttp/fpget 16 | examples/console/lhttp/fphttpd 17 | examples/console/lsmtp/lsmtpclient 18 | examples/console/ltcp/lclient 19 | examples/console/ltcp/lserver 20 | examples/console/ltelnet/ltclient 21 | examples/console/ludp/ludp 22 | 23 | examples/visual/http/httpclienttest 24 | examples/visual/telnet/telnet 25 | examples/visual/ftp/ftptest 26 | examples/visual/ftp/log.txt 27 | examples/visual/smtp/smtptest 28 | examples/visual/tcpudp/testnet 29 | -------------------------------------------------------------------------------- /examples/console/Makefile: -------------------------------------------------------------------------------- 1 | 2 | all: 3 | $(MAKE) -C ltcp OPT=$(OPT) 4 | $(MAKE) -C ludp OPT=$(OPT) 5 | $(MAKE) -C lsmtp OPT=$(OPT) 6 | $(MAKE) -C lftp OPT=$(OPT) 7 | $(MAKE) -C lhttp OPT=$(OPT) 8 | $(MAKE) -C ltelnet OPT=$(OPT) 9 | 10 | argless: 11 | $(MAKE) -C ltcp argless OPT=$(OPT) 12 | $(MAKE) -C ludp argless OPT=$(OPT) 13 | $(MAKE) -C lsmtp argless OPT=$(OPT) 14 | $(MAKE) -C lftp argless OPT=$(OPT) 15 | $(MAKE) -C lhttp argless OPT=$(OPT) 16 | $(MAKE) -C ltelnet argless OPT=$(OPT) 17 | 18 | clean: 19 | $(MAKE) -C ltcp clean 20 | $(MAKE) -C ludp clean 21 | $(MAKE) -C lsmtp clean 22 | $(MAKE) -C lftp clean 23 | $(MAKE) -C lhttp clean 24 | $(MAKE) -C ltelnet clean 25 | rm -f *~ 26 | -------------------------------------------------------------------------------- /examples/visual/ftp/images/ftp_dir.xpm: -------------------------------------------------------------------------------- 1 | /* XPM */ 2 | static char *ftp_dir[] = { 3 | /* columns rows colors chars-per-pixel */ 4 | "15 13 16 1", 5 | " c black", 6 | ". c #800000", 7 | "X c #008000", 8 | "o c #808000", 9 | "O c navy", 10 | "+ c #800080", 11 | "@ c #008080", 12 | "# c #808080", 13 | "$ c #C0C0C0", 14 | "% c red", 15 | "& c green", 16 | "* c yellow", 17 | "= c blue", 18 | "- c None", 19 | "; c cyan", 20 | ": c gray100", 21 | /* pixels */ 22 | "--#####--------", 23 | "-#$*$*$#-------", 24 | "#$*$*$*$######-", 25 | "#::::::::::::# ", 26 | "#:*$*$*$*$*$*# ", 27 | "#:$*$*$*$*$*$# ", 28 | "#:*$*$*$*$*$*# ", 29 | "#:$*$*$*$*$*$# ", 30 | "#:*$*$*$*$*$*# ", 31 | "#:$*$*$*$*$*$# ", 32 | "#:*$*$*$*$*$*# ", 33 | "############## ", 34 | "- " 35 | }; 36 | -------------------------------------------------------------------------------- /examples/visual/ftp/images/ftp_dirup.xpm: -------------------------------------------------------------------------------- 1 | /* XPM */ 2 | static char *ftp_dirup[] = { 3 | /* columns rows colors chars-per-pixel */ 4 | "15 13 16 1", 5 | " c black", 6 | ". c #800000", 7 | "X c #008000", 8 | "o c #808000", 9 | "O c navy", 10 | "+ c #800080", 11 | "@ c #008080", 12 | "# c #808080", 13 | "$ c #C0C0C0", 14 | "% c red", 15 | "& c green", 16 | "* c yellow", 17 | "= c blue", 18 | "- c None", 19 | "; c cyan", 20 | ": c gray100", 21 | /* pixels */ 22 | "--#####--------", 23 | "-#$*$*$#-------", 24 | "#$*$*$*$######-", 25 | "#::::::::::::# ", 26 | "#:*$* *$*$*$*# ", 27 | "#:$* *$*$*$# ", 28 | "#:* *$*$*# ", 29 | "#:$*$ $*$*$*$# ", 30 | "#:*$* *$*$*$*# ", 31 | "#:$*$ $*$# ", 32 | "#:*$*$*$*$*$*# ", 33 | "############## ", 34 | "- " 35 | }; 36 | -------------------------------------------------------------------------------- /examples/visual/ftp/images/ftp_error.xpm: -------------------------------------------------------------------------------- 1 | /* XPM */ 2 | static char *ftp_error[] = { 3 | /* columns rows colors chars-per-pixel */ 4 | "15 13 16 1", 5 | " c black", 6 | ". c #800000", 7 | "X c #008000", 8 | "o c #808000", 9 | "O c navy", 10 | "+ c #800080", 11 | "@ c #008080", 12 | "# c #808080", 13 | "$ c #C0C0C0", 14 | "% c red", 15 | "& c green", 16 | "* c yellow", 17 | "= c blue", 18 | "- c None", 19 | "; c cyan", 20 | ": c gray100", 21 | /* pixels */ 22 | "---------------", 23 | "------%%%------", 24 | "----%%%%%%%----", 25 | "---%%%---%%%---", 26 | "---%%---%%%%---", 27 | "--%%---%%%-%%--", 28 | "--%%--%%%--%%--", 29 | "--%%-%%%---%%--", 30 | "---%%%%---%%---", 31 | "---%%%---%%%---", 32 | "----%%%%%%%----", 33 | "------%%%------", 34 | "---------------" 35 | }; 36 | -------------------------------------------------------------------------------- /examples/visual/ftp/images/ftp_file.xpm: -------------------------------------------------------------------------------- 1 | /* XPM */ 2 | static char *ftp_file__[] = { 3 | /* columns rows colors chars-per-pixel */ 4 | "15 13 16 1", 5 | " c black", 6 | ". c #800000", 7 | "X c #008000", 8 | "o c #808000", 9 | "O c navy", 10 | "+ c #800080", 11 | "@ c #008080", 12 | "# c #808080", 13 | "$ c #C0C0C0", 14 | "% c red", 15 | "& c green", 16 | "* c yellow", 17 | "= c blue", 18 | "- c None", 19 | "; c cyan", 20 | ": c gray100", 21 | /* pixels */ 22 | "--########-----", 23 | "--#:::::#:#----", 24 | "--#:::::#::#---", 25 | "--#:::::#:::#--", 26 | "--#::::: --", 27 | "--#::::::::: --", 28 | "--#::::::::: --", 29 | "--#::::::::: --", 30 | "--#::::::::: --", 31 | "--#::::::::: --", 32 | "--#::::::::: --", 33 | "--# --", 34 | "---------------" 35 | }; 36 | -------------------------------------------------------------------------------- /examples/visual/ftp/images/ftp_link.xpm: -------------------------------------------------------------------------------- 1 | /* XPM */ 2 | static char *ftp_link[] = { 3 | /* columns rows colors chars-per-pixel */ 4 | "15 13 16 1", 5 | " c black", 6 | ". c #800000", 7 | "X c #008000", 8 | "o c #808000", 9 | "O c navy", 10 | "+ c #800080", 11 | "@ c #008080", 12 | "# c #808080", 13 | "$ c #C0C0C0", 14 | "% c red", 15 | "& c green", 16 | "* c yellow", 17 | "= c blue", 18 | "- c None", 19 | "; c cyan", 20 | ": c gray100", 21 | /* pixels */ 22 | "---------------", 23 | "-- --", 24 | "-- ::::::::: --", 25 | "-- :: : --", 26 | "-- ::: : --", 27 | "-- :::: : --", 28 | "-- ::: : --", 29 | "-- :: : : --", 30 | "-- : ::: : --", 31 | "-- : :::::: --", 32 | "-- ::::::::: --", 33 | "-- --", 34 | "---------------" 35 | }; 36 | -------------------------------------------------------------------------------- /lib/sys/lkqueueeventerh.inc: -------------------------------------------------------------------------------- 1 | {% lkqueueeventerh.inc included by levents.pas } 2 | 3 | {$ifdef BSD} 4 | 5 | { TLKQueueEventer } 6 | 7 | TLKQueueEventer = class(TLEventer) 8 | protected 9 | FTimeout: TTimeSpec; 10 | FEvents: array of TKEvent; 11 | FChanges: array of TKEvent; 12 | FFreeSlot: Integer; 13 | FQueue: THandle; 14 | function GetTimeout: Integer; override; 15 | procedure SetTimeout(const Value: Integer); override; 16 | procedure HandleIgnoreRead(aHandle: TLHandle); override; 17 | procedure Inflate; 18 | public 19 | constructor Create; override; 20 | destructor Destroy; override; 21 | function AddHandle(aHandle: TLHandle): Boolean; override; 22 | function CallAction: Boolean; override; 23 | end; 24 | 25 | {$endif} // bsd 26 | -------------------------------------------------------------------------------- /lib/LICENSE.ADDON: -------------------------------------------------------------------------------- 1 | This is the file LICENSE.Addon, it applies to the Lighweight Network Library (lnet). 2 | 3 | The source code of the Lightweight Network library are 4 | distributed under the Library GNU General Public License 5 | (see the file LICENSE) with the following modification: 6 | 7 | - object files and libraries linked into an application may be 8 | distributed without source code. 9 | 10 | The unit tomwinsock.pas is EXLUDED from both the GPL and this addon license. 11 | It is distributed under the terms of BSD license as mentioned in the file. 12 | I am NOT the author of tomwinsock.pas 13 | 14 | If you didn't receive a copy of the file LICENSE, contact: 15 | Free Software Foundation, Inc., 16 | 59 Temple Place - Suite 330 17 | Boston, MA 02111 18 | USA 19 | 20 | -------------------------------------------------------------------------------- /lazaruspackage/LICENSE.ADDON: -------------------------------------------------------------------------------- 1 | This is the file LICENSE.Addon, it applies to the Lighweight Network Library (lnet). 2 | 3 | The source code of the Lightweight Network library are 4 | distributed under the Library GNU General Public License 5 | (see the file LICENSE) with the following modification: 6 | 7 | - object files and libraries linked into an application may be 8 | distributed without source code. 9 | 10 | The unit tomwinsock.pas is EXLUDED from both the GPL and this addon license. 11 | It is distributed under the terms of BSD license as mentioned in the file. 12 | Original author of tomwinsock.pas is Thomas Schatzl. 13 | 14 | If you didn't receive a copy of the file LICENSE, contact: 15 | Free Software Foundation, Inc., 16 | 59 Temple Place - Suite 330 17 | Boston, MA 02111 18 | USA 19 | 20 | -------------------------------------------------------------------------------- /lazaruspackage/README: -------------------------------------------------------------------------------- 1 | LightWeight Networking Components 2 | 3 | Copyright (c) 2005-2011 by Ales Katona and Micha Nelissen 4 | 5 | The lNet Lazarus packages have been separated by functionality into 2. 6 | 7 | * lnetbase.lpk 8 | * lnetvisual.lpk 9 | 10 | lnetbase.lpk is used for encapsulation of the basic lnet functionality found in non-visual units. It's a helper package required by lnetvisual, and can be used by anyone who just wants to use non-visual lnet (this not requiring LCL) inside Lazarus without bothering with paths. 11 | 12 | lnetvisual.lpk contains the visual integration code with LCL, and thus depends on it. It should be used by people who already use LCL in some way and have atleast on active window/form to put the components on (they need a window to function). 13 | 14 | All sources in lnet package are released under a modified LGPL license. See files LICENSE and LICENSE.ADDON. 15 | -------------------------------------------------------------------------------- /lazaruspackage/icons/TLFtpClientComponent.xpm: -------------------------------------------------------------------------------- 1 | /* XPM */ 2 | static char *TLFtpClientComponent[]={ 3 | "23 23 5 1", 4 | "c c None", 5 | ". c None", 6 | "# c #000000", 7 | "b c #2050cc", 8 | "a c #ff00ff", 9 | ".......................", 10 | ".######....#####.......", 11 | ".#aaaa#....#aaaa#......", 12 | ".#a#########a##a#......", 13 | ".#a#aaaaaaa#aaaa#...b..", 14 | ".#a####a####a###c.bb...", 15 | ".#aaa##a#..#a#..bbb....", 16 | ".#a####a#..#a#.bb......", 17 | ".#a#..#a#..#a#bb.......", 18 | ".#a#..#a#..#a#b........", 19 | ".#a#..#a#..###b........", 20 | ".###..#a#..bbb.........", 21 | "......###.bbbbbb.......", 22 | "............bbb........", 23 | ".....#.....bb..........", 24 | "...##################..", 25 | "..#aaaaaaaaaaaaaaaaa#..", 26 | "...##################..", 27 | ".....#.b.........#.....", 28 | "..##################...", 29 | "..#aaaaaaaaaaaaaaaaa#..", 30 | "..##################...", 31 | ".................#....."}; 32 | -------------------------------------------------------------------------------- /lazaruspackage/icons/TLHTTPClientComponent.xpm: -------------------------------------------------------------------------------- 1 | /* XPM */ 2 | static char *TLSMTPClientComponent[]={ 3 | "23 23 6 1", 4 | "c c None", 5 | ". c None", 6 | "# c #000000", 7 | "b c #2050cc", 8 | "a c #00ffff", 9 | "d c #ddbb55", 10 | ".#..#.#####.....####...", 11 | "#a##a#aaaaa#####aaaa#..", 12 | "#a##a###a#aaaaa#a###a#.", 13 | "#aaaa#.#a###a###a###a#.", 14 | "#a##a#.#a#.#a#.#aaaa#..", 15 | "#a##a#.#a#.#a#b#a###...", 16 | ".#..#...#..#a#.#a#.....", 17 | "...........b#..#a#.....", 18 | "..........bb....#......", 19 | ".........bbb...........", 20 | "........bbbb...........", 21 | ".........bbbbb.........", 22 | "........bbbb...........", 23 | ".......bbb.............", 24 | "......bb...............", 25 | ".....b.................", 26 | "....#..#.......#..#....", 27 | "...#..#d#.....#d#..#...", 28 | "..#...#d#.....#d#...#..", 29 | ".#....#d#.....#d#....#.", 30 | "..#...#d####..#d#...#..", 31 | "...#..#ddddd#.#d#..#...", 32 | "....#..#####...#..#...."}; 33 | -------------------------------------------------------------------------------- /lazaruspackage/icons/TLHTTPServerComponent.xpm: -------------------------------------------------------------------------------- 1 | /* XPM */ 2 | static char *TLSMTPClientComponent[]={ 3 | "23 23 6 1", 4 | "c c None", 5 | ". c None", 6 | "# c #000000", 7 | "b c #2050cc", 8 | "a c #0000ff", 9 | "d c #ddbb55", 10 | ".#..#.#####.....####...", 11 | "#a##a#aaaaa#####aaaa#..", 12 | "#a##a###a#aaaaa#a###a#.", 13 | "#aaaa#.#a###a###a###a#.", 14 | "#a##a#.#a#.#a#.#aaaa#..", 15 | "#a##a#.#a#.#a#b#a###...", 16 | ".#..#...#..#a#.#a#.....", 17 | "...........b#..#a#.....", 18 | "..........bb....#......", 19 | ".........bbb...........", 20 | "........bbbb...........", 21 | ".........bbbbb.........", 22 | "........bbbb...........", 23 | ".......bbb.............", 24 | "......bb...............", 25 | ".....b.................", 26 | "....#..#.......#..#....", 27 | "...#..#d#.....#d#..#...", 28 | "..#...#d#.....#d#...#..", 29 | ".#....#d#.....#d#....#.", 30 | "..#...#d####..#d#...#..", 31 | "...#..#ddddd#.#d#..#...", 32 | "....#..#####...#..#...."}; 33 | -------------------------------------------------------------------------------- /lazaruspackage/icons/TLSMTPClientComponent.xpm: -------------------------------------------------------------------------------- 1 | /* XPM */ 2 | static char *TLSMTPClientComponent[]={ 3 | "23 23 6 1", 4 | "c c None", 5 | ". c None", 6 | "# c #000000", 7 | "b c #2050cc", 8 | "a c #ffff00", 9 | "d c #ddbb55", 10 | ".............######....", 11 | "..####..#...#aaaaaa#...", 12 | ".#aaaa##a#.#a##a###b...", 13 | "..#a##.#aa#aa##a#.###..", 14 | "..##a#.#a#a#a##a##aaa#.", 15 | ".#aaaa##a###a##a##a##a#", 16 | "..####.#a#.#a##a##aaa#.", 17 | ".......#a#.#a#b#.#a##..", 18 | "........#.bb#....#a#...", 19 | ".........bbb......#a#..", 20 | "........bbbb......#....", 21 | ".........bbbbb.........", 22 | "........bbbb...........", 23 | ".......bbb.............", 24 | "......bb...............", 25 | "..###################..", 26 | "..#dddddd#ddd#dddddd#..", 27 | "..#ddddddd#d#ddddddd#..", 28 | "..#dd####dd#ddd###dd#..", 29 | "..#dd###dddddd####dd#..", 30 | "..#ddddddddddddddddd#..", 31 | "..###################..", 32 | "......................."}; 33 | -------------------------------------------------------------------------------- /lazaruspackage/icons/TLTcpComponent.xpm: -------------------------------------------------------------------------------- 1 | /* XPM */ 2 | static char *tcpicon[] = { 3 | /* columns rows colors chars-per-pixel */ 4 | "23 23 4 1", 5 | " c black", 6 | "z c #2050cc", 7 | ". c #50F841", 8 | "X c None", 9 | /* pixels */ 10 | " XXXXXXXXXXXXXX", 11 | " ....... XXX XXX", 12 | " . ... XX .... XX", 13 | "XXX . .. .. X . . XX", 14 | "XXX . . XX X .... XX", 15 | "XXX . . XXXXXX . XXX", 16 | "XXX . . XX X . zXXXX", 17 | "XXX . .. .. X . XXXXX", 18 | "XXX X .... Xz . XXXXX", 19 | "XXXXXXXX Xzz XXXXX", 20 | "XXXXXXXXXXXXzzzXXXXXXXX", 21 | "XXXXXXXXXXXzzzXXXXXXXXX", 22 | "XXXXXXXXXXzzzzzzXXXXXXX", 23 | "XXXXXXXXXXXXzzzXXXXXXXX", 24 | "XXXXX XXXXXzzXXXXXXXXXX", 25 | "XXX XX", 26 | "XX ................. XX", 27 | "XXX XX", 28 | "XXXXX XzXXXXXXXXX XXXXX", 29 | "XX XXX", 30 | "XX ................. XX", 31 | "XX XXX", 32 | "XXXXXXXXXXXXXXXXX XXXXX" 33 | }; 34 | -------------------------------------------------------------------------------- /lazaruspackage/icons/TLUdpComponent.xpm: -------------------------------------------------------------------------------- 1 | /* XPM */ 2 | static char *udpicon[] = { 3 | /* columns rows colors chars-per-pixel */ 4 | "23 23 4 1", 5 | " c black", 6 | "z c #2050cc", 7 | "X c #ED0723", 8 | "o c None", 9 | /* pixels */ 10 | "ooooooooooooooooooooooo", 11 | "o oo oo o ooo", 12 | "o X oo X oo X o XXXX oo", 13 | "o X oo X oo X o X X oo", 14 | "o X oo X X o XXXX oo", 15 | "o X oo X XXXX o X ooo", 16 | "o X oo X X X o X ooooo", 17 | "o X X X X o X ooooo", 18 | "o XXXXXX XXXX z X ooooo", 19 | "oo z ooooo", 20 | "ooooooooooozzzooooooooo", 21 | "oooooooooozzzoooooooooo", 22 | "ooooooooozzzzzzoooooooo", 23 | "ooooooooooozzzooooooooo", 24 | "oooooooooozzzoooooooooo", 25 | "ooooooooozzzooooooooooo", 26 | "oooooooozzooooooooooooo", 27 | "ooooooozzoooooooooooooo", 28 | "oooooozoooooooooo ooooo", 29 | "oo ooo", 30 | "oo XXXXXXXXXXXXXXXXX oo", 31 | "oo ooo", 32 | "ooooooooooooooooo ooooo" 33 | }; 34 | -------------------------------------------------------------------------------- /lazaruspackage/icons/TLSSLSessionComponent.xpm: -------------------------------------------------------------------------------- 1 | /* XPM */ 2 | static char *udpicon[] = { 3 | /* columns rows colors chars-per-pixel */ 4 | "23 23 4 1", 5 | ". c black", 6 | "x c red", 7 | "z c #CECECE", 8 | "o c None", 9 | /*.pixels.*/ 10 | "ooo....ooo....ooo.ooooo", 11 | "oo.xxxx.o.xxxx.o.x.oooo", 12 | "o.x....o.x....oo.x.oooo", 13 | "oo.xxxx.o.xxxx.o.x.oooo", 14 | "ooo....x.o....x..x...oo", 15 | "oo.xxxx.o.xxxx.o.xxxx.o", 16 | "ooo....ooo....ooo....oo", 17 | "ooooooooooooooooooooooo", 18 | "ooooooooooooooooooooooo", 19 | "ooooooooo.....ooooooooo", 20 | "oooooooo.zzzzz.oooooooo", 21 | "ooooooo.zzzzzzz.ooooooo", 22 | "oooooo.zzz...zzz.oooooo", 23 | "oooooo.zz.....zz.oooooo", 24 | "ooooo.zzzzzzzzzzz.ooooo", 25 | "ooooo.zzzz...zzzz.ooooo", 26 | "ooooo.zzzz...zzzz.ooooo", 27 | "ooooo.zzzzz.zzzzz.ooooo", 28 | "ooooo.zzzzz..zzzz.ooooo", 29 | "ooooo.zzzzzzzzzzz.ooooo", 30 | "oooooo...........oooooo", 31 | "ooooooooooooooooooooooo", 32 | "ooooooooooooooooooooooo" 33 | }; 34 | -------------------------------------------------------------------------------- /lazaruspackage/icons/TLTelnetClientComponent.xpm: -------------------------------------------------------------------------------- 1 | /* XPM */ 2 | static char *TLTelnetClientComponent[] = { 3 | /* columns rows colors chars-per-pixel */ 4 | "23 23 6 1", 5 | " c black", 6 | ". c #2050CC", 7 | "X c #9F9B00", 8 | "o c #CECECE", 9 | "O c gray100", 10 | "+ c None", 11 | /* pixels */ 12 | " +++++++ ++++++++++++ +", 13 | "o +++++ o ++++++++++ o ", 14 | "oo + + o + +++ ooo", 15 | "o + oo o ooo + oo o ", 16 | "o o o o o o o o o ", 17 | "o ooo o o o ooo o ", 18 | "o o + o o o o + o ", 19 | "oo oo oo o o oo oo", 20 | " ++ ++ + +. ++ ", 21 | "++++++++++++...++++++++", 22 | "+++++++++++...+++++++++", 23 | "++++++++++...++++++++++", 24 | "+++++++++......++++++++", 25 | "+++++++++++...+++++++++", 26 | "++++++++++...++++++++++", 27 | "++++++++ . .+ ++++++++", 28 | "+++++++ o o oo +++++++", 29 | "++++++ ooooo oo ++++++", 30 | "++++++. o o ++ oo +++++", 31 | "+++++++ o o ++ oo +++++", 32 | "++++++ ooooo oo ++++++", 33 | "+++++++ o o oo +++++++", 34 | "++++++++ + ++ ++++++++" 35 | }; 36 | -------------------------------------------------------------------------------- /lib/lcontainersh.inc: -------------------------------------------------------------------------------- 1 | { This include is a little a-la-templates hack 2 | 3 | here are all the "default" type defines which you need to 4 | redefine yourself after including this file. You only redefine those 5 | which are used ofcourse } 6 | 7 | {$ifndef __front_type__} 8 | {$ERROR Undefined type for quasi-template!} 9 | {$endif} 10 | 11 | const 12 | MAX_FRONT_ITEMS = 10; 13 | 14 | type 15 | TLFront = class // it's a queue ladies and gents 16 | protected 17 | FEmptyItem: __front_type__; 18 | FItems: array[0..MAX_FRONT_ITEMS-1] of __front_type__; 19 | FTop, FBottom: Integer; 20 | FCount: Integer; 21 | function GetEmpty: Boolean; 22 | public 23 | constructor Create(const DefaultItem: __front_type__); 24 | function First: __front_type__; 25 | function Remove: __front_type__; 26 | function Insert(const Value: __front_type__): Boolean; 27 | procedure Clear; 28 | property Count: Integer read FCount; 29 | property Empty: Boolean read GetEmpty; 30 | end; 31 | 32 | 33 | -------------------------------------------------------------------------------- /examples/console/lhttp/README: -------------------------------------------------------------------------------- 1 | fphttpd is a full-featured HTTP 1.1 server. 2 | 3 | Fast-CGI support enables use of php and other pre-processors. 4 | 5 | fphttpd creates default config files and directories on first run in: 6 | For windows: HOMEDRIVE:\HOMEPATH\fphttpd (usualy Documents and settings\username) 7 | For unix: $HOME/.fphttpd 8 | 9 | The directory consists of: 10 | cgi-bin -- place your cgi scripts and binaries here 11 | http_docs -- place your html files here 12 | fphttpd.ini -- configure file with various settings 13 | mime.types -- mime types file for various file types 14 | 15 | fphttpd tries to automaticly spawn php using the fpfcgi spawner program. 16 | 17 | You can pre-spawn your fCGI apps to get some initial boost. 18 | 19 | On Windows it is REQUIRED to edit fphttpd.ini and set path to "php-cgi.exe" as this one has not got a default install location (in unix it's searched in some default dirs like /usr/bin and so on) 20 | 21 | WARNING: 22 | Currently fastcgi only works in linux and has some known issues. Use only for testing purposes 23 | -------------------------------------------------------------------------------- /tests/stress2/umain.pas: -------------------------------------------------------------------------------- 1 | unit umain; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | interface 6 | 7 | uses 8 | Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, 9 | lNetComponents, lNet; 10 | 11 | type 12 | 13 | { TForm1 } 14 | 15 | TForm1 = class(TForm) 16 | Button1: TButton; 17 | Edit1: TEdit; 18 | procedure Button1Click(Sender: TObject); 19 | private 20 | procedure OnCo(aSocket: TLSocket); 21 | public 22 | { public declarations } 23 | end; 24 | 25 | var 26 | Form1: TForm1; 27 | 28 | implementation 29 | 30 | {$R *.lfm} 31 | 32 | { TForm1 } 33 | 34 | procedure TForm1.Button1Click(Sender: TObject); 35 | var 36 | tcp: TLTCPComponent; 37 | begin 38 | tcp := TLTCPComponent.Create(nil); 39 | tcp.OnConnect := @OnCo; 40 | tcp.Connect('127.0.0.1', 4665); 41 | end; 42 | 43 | procedure TForm1.OnCo(aSocket: TLSocket); 44 | begin 45 | if Assigned(aSocket) then 46 | aSocket.Creator.Free; 47 | 48 | Edit1.Text := IntToStr(StrToInt(Edit1.Text) + 1); 49 | 50 | Button1Click(nil); 51 | end; 52 | 53 | end. 54 | 55 | -------------------------------------------------------------------------------- /lib/lcontainers.inc: -------------------------------------------------------------------------------- 1 | constructor TLFront.Create(const DefaultItem: __front_type__); 2 | begin 3 | FEmptyItem:=DefaultItem; 4 | Clear; 5 | end; 6 | 7 | function TLFront.GetEmpty: Boolean; 8 | begin 9 | Result:=FCount = 0; 10 | end; 11 | 12 | function TLFront.First: __front_type__; 13 | begin 14 | Result:=FEmptyItem; 15 | if FCount > 0 then 16 | Result:=FItems[FBottom]; 17 | end; 18 | 19 | function TLFront.Remove: __front_type__; 20 | begin 21 | Result:=FEmptyItem; 22 | if FCount > 0 then begin 23 | Result:=FItems[FBottom]; 24 | Dec(FCount); 25 | Inc(FBottom); 26 | if FBottom >= MAX_FRONT_ITEMS then 27 | FBottom:=0; 28 | end; 29 | end; 30 | 31 | function TLFront.Insert(const Value: __front_type__): Boolean; 32 | begin 33 | Result:=False; 34 | if FCount < MAX_FRONT_ITEMS then begin 35 | if FTop >= MAX_FRONT_ITEMS then 36 | FTop:=0; 37 | FItems[FTop]:=Value; 38 | Inc(FCount); 39 | Inc(FTop); 40 | Result:=True; 41 | end; 42 | end; 43 | 44 | procedure TLFront.Clear; 45 | begin 46 | FCount:=0; 47 | FBottom:=0; 48 | FTop:=0; 49 | end; 50 | 51 | -------------------------------------------------------------------------------- /lib/sys/lepolleventerh.inc: -------------------------------------------------------------------------------- 1 | {% lepolleventerh.inc included by levents.pas } 2 | 3 | {$ifdef Linux} 4 | 5 | PEpollEvent = ^epoll_event; 6 | TEpollEvent = epoll_event; 7 | PEpollData = ^epoll_data; 8 | TEpollData = epoll_data; 9 | 10 | { TLEpollEventer } 11 | 12 | TLEpollEventer = class(TLEventer) 13 | protected 14 | FTimeout: cInt; 15 | FEvents: array of TEpollEvent; 16 | FEventsRead: array of TEpollEvent; 17 | FEpollReadFD: THandle; // this one monitors LT style for READ 18 | FEpollFD: THandle; // this one monitors ET style for other 19 | FEpollMasterFD: THandle; // this one monitors the first two 20 | FFreeList: TFPObjectList; 21 | function GetTimeout: Integer; override; 22 | procedure SetTimeout(const Value: Integer); override; 23 | procedure HandleIgnoreRead(aHandle: TLHandle); override; 24 | procedure Inflate; 25 | public 26 | constructor Create; override; 27 | destructor Destroy; override; 28 | function AddHandle(aHandle: TLHandle): Boolean; override; 29 | function CallAction: Boolean; override; 30 | end; 31 | 32 | {$endif} // linux 33 | -------------------------------------------------------------------------------- /examples/visual/smtp/logs.lrs: -------------------------------------------------------------------------------- 1 | { This is an automatically generated lazarus resource file } 2 | 3 | LazarusResources.Add('TFormLogs','FORMDATA',[ 4 | 'TPF0'#9'TFormLogs'#8'FormLogs'#4'Left'#3'~'#1#6'Height'#3'&'#1#3'Top'#3#216#0 5 | +#5'Width'#3#130#1#18'HorzScrollBar.Page'#3#129#1#18'VertScrollBar.Page'#3'%' 6 | +#1#11'BorderIcons'#11#12'biSystemMenu'#10'biMinimize'#0#11'BorderStyle'#7#12 7 | +'bsToolWindow'#7'Caption'#6#12'Message Logs'#12'ClientHeight'#3'&'#1#11'Clie' 8 | +'ntWidth'#3#130#1#21'Constraints.MinHeight'#3'&'#1#20'Constraints.MinWidth'#3 9 | +#130#1#10'LCLVersion'#6#6'0.9.25'#0#9'TGroupBox'#11'GroupBoxLog'#4'Left'#3 10 | +#160#0#6'Height'#3'&'#1#5'Width'#3#226#0#5'Align'#7#8'alClient'#7'Caption'#6 11 | +#3'Log'#12'ClientHeight'#3#19#1#11'ClientWidth'#3#222#0#8'TabOrder'#2#0#0#5 12 | +'TMemo'#8'MemoLogs'#6'Height'#3#19#1#5'Width'#3#222#0#5'Align'#7#8'alClient' 13 | +#8'ReadOnly'#9#10'ScrollBars'#7#10'ssAutoBoth'#8'TabOrder'#2#0#0#0#0#9'TGrou' 14 | +'pBox'#16'GroupBoxFeatures'#6'Height'#3'&'#1#5'Width'#3#160#0#5'Align'#7#6'a' 15 | +'lLeft'#7'Caption'#6#8'Features'#12'ClientHeight'#3#19#1#11'ClientWidth'#3 16 | +#156#0#8'TabOrder'#2#1#0#8'TListBox'#15'ListBoxFeatures'#6'Height'#3#19#1#5 17 | +'Width'#3#156#0#5'Align'#7#8'alClient'#8'TabOrder'#2#0#8'TopIndex'#2#255#0#0 18 | +#0#0 19 | ]); 20 | -------------------------------------------------------------------------------- /examples/visual/smtp/logs.lfm: -------------------------------------------------------------------------------- 1 | object FormLogs: TFormLogs 2 | Left = 382 3 | Height = 294 4 | Top = 216 5 | Width = 386 6 | HorzScrollBar.Page = 385 7 | VertScrollBar.Page = 293 8 | BorderIcons = [biSystemMenu, biMinimize] 9 | BorderStyle = bsToolWindow 10 | Caption = 'Message Logs' 11 | ClientHeight = 294 12 | ClientWidth = 386 13 | Constraints.MinHeight = 294 14 | Constraints.MinWidth = 386 15 | LCLVersion = '0.9.25' 16 | object GroupBoxLog: TGroupBox 17 | Left = 160 18 | Height = 294 19 | Width = 226 20 | Align = alClient 21 | Caption = 'Log' 22 | ClientHeight = 275 23 | ClientWidth = 222 24 | TabOrder = 0 25 | object MemoLogs: TMemo 26 | Height = 275 27 | Width = 222 28 | Align = alClient 29 | ReadOnly = True 30 | ScrollBars = ssAutoBoth 31 | TabOrder = 0 32 | end 33 | end 34 | object GroupBoxFeatures: TGroupBox 35 | Height = 294 36 | Width = 160 37 | Align = alLeft 38 | Caption = 'Features' 39 | ClientHeight = 275 40 | ClientWidth = 156 41 | TabOrder = 1 42 | object ListBoxFeatures: TListBox 43 | Height = 275 44 | Width = 156 45 | Align = alClient 46 | TabOrder = 0 47 | TopIndex = -1 48 | end 49 | end 50 | end 51 | -------------------------------------------------------------------------------- /lib/sys/lspawnfcgiunix.inc: -------------------------------------------------------------------------------- 1 | uses 2 | Classes, BaseUnix; 3 | 4 | function SpawnFCGIProcess(App, Enviro: string; const aPort: Word): Integer; 5 | var 6 | TheSocket: TLSocket; 7 | i: Integer; 8 | SL: TStringList; 9 | aNil: Pointer = nil; 10 | ppEnv, ppArgs: ppChar; 11 | begin 12 | Result:=FpFork; 13 | 14 | if Result = 0 then begin 15 | ppArgs:=@aNil; 16 | 17 | for i:=3 to 10000 do 18 | CloseSocket(i); 19 | 20 | if CloseSocket(StdInputHandle) <> 0 then 21 | Exit(LSocketError); 22 | 23 | TheSocket:=TLSocket.Create; 24 | TheSocket.SetState(ssBlocking); 25 | 26 | if not TheSocket.Listen(aPort) then 27 | Exit(LSocketError); 28 | 29 | ppEnv:=@aNil; 30 | 31 | if Length(Enviro) > 0 then begin 32 | SL:=TStringList.Create; 33 | repeat 34 | i:=Pos(':', Enviro); 35 | if i > 0 then begin 36 | SL.Add(Copy(Enviro, 1, i - 1)); 37 | Delete(Enviro, 1, i); 38 | end else 39 | SL.Add(Enviro); 40 | until i = 0; 41 | GetMem(ppEnv, SizeOf(pChar) * (SL.Count + 1)); 42 | for i:=0 to SL.Count-1 do 43 | ppEnv[i]:=pChar(SL[i]); 44 | ppEnv[SL.Count]:=nil; 45 | end; 46 | 47 | FpExecve(pChar(App), ppArgs, ppEnv); 48 | end else if Result > 0 then 49 | Result:=0; // it went ok 50 | end; 51 | 52 | -------------------------------------------------------------------------------- /examples/visual/tcpudp/cert: -------------------------------------------------------------------------------- 1 | -----BEGIN CERTIFICATE----- 2 | MIIDpTCCAo2gAwIBAgIBADANBgkqhkiG9w0BAQQFADBFMQswCQYDVQQGEwJVUzET 3 | MBEGA1UECBMKU29tZS1TdGF0ZTEhMB8GA1UEChMYSW50ZXJuZXQgV2lkZ2l0cyBQ 4 | dHkgTHRkMB4XDTAzMDUyNDE0NTI0MloXDTA2MDUyMzE0NTI0MlowRTELMAkGA1UE 5 | BhMCVVMxEzARBgNVBAgTClNvbWUtU3RhdGUxITAfBgNVBAoTGEludGVybmV0IFdp 6 | ZGdpdHMgUHR5IEx0ZDCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBALr7 7 | vaKNMG9FbtEya2+GIX7NGfzEUU/b7Pmt0SaC5bZn/Fo1JNlEPnAtFPqZyW6zcqM5 8 | SrCNCVS0B4H3n2GygssPppa88IkM2FolKhlWjWi2k4b+MGuYWwRGu/UGhEK//ciC 9 | S+fNTHS20+6U4XXLuPbEIv7TQk/GNF2rSNxTBtL/cp8rpIk+fIY59FymZx6/Gxrp 10 | +5vlrbYZFZMPUUd2JgaAUxOy1schetQhoRzrjlDmX9+fmwqKJYQ+ZLb1aCGZZJuR 11 | W/i29CyxQODm1fUBpb1WwEFjXUZb8j2iicLoS9s9nJaUFvd2fImWic/11iYi+ufF 12 | cMRjakVKMYXF24+GZd8CAwEAAaOBnzCBnDAdBgNVHQ4EFgQU2Ejnhbxwj0yLEdaW 13 | BfSbx+qAj2wwbQYDVR0jBGYwZIAU2Ejnhbxwj0yLEdaWBfSbx+qAj2yhSaRHMEUx 14 | CzAJBgNVBAYTAlVTMRMwEQYDVQQIEwpTb21lLVN0YXRlMSEwHwYDVQQKExhJbnRl 15 | cm5ldCBXaWRnaXRzIFB0eSBMdGSCAQAwDAYDVR0TBAUwAwEB/zANBgkqhkiG9w0B 16 | AQQFAAOCAQEAoYBkFbBwSO+Vn56ilNG+mOl5ryHAwtjCgqdl156N52ysUFq+qar2 17 | WNbmD3ieDm+UrNqX4FcLV/CkZQAXWj3YHLyGbMCekLbpctjbfmCVTD3EQ+a7Rw1s 18 | uQVyrzbLHggzhBuzQrjKflr42MnfNClQAiiM7kOyuo1pwVgWZ4GXIBOfazizG3Yh 19 | If0p+MUKJk7maKgXoiu+NrZIu7jyB4lyqTVGh1fKr1rWrciK5xnC7mxkndGuzcGo 20 | XM/ea0cPl79g8PRHAtgqLoqECP184HC4gR+AVLoonva4Yz3mI6BiRI0lrcjQLWEF 21 | GmLEzRjFsm/tdyMSzH2eM7zp1ibogbSBiA== 22 | -----END CERTIFICATE----- 23 | -------------------------------------------------------------------------------- /lib/lspawnfcgi.pp: -------------------------------------------------------------------------------- 1 | { lNet FastCGI Spawner 2 | 3 | CopyRight (C) 2006-2008 Ales Katona 4 | 5 | This library is Free software; you can rediStribute it and/or modify it 6 | under the terms of the GNU Library General Public License as published by 7 | the Free Software Foundation; either version 2 of the License, or (at your 8 | option) any later version. 9 | 10 | This program is diStributed in the hope that it will be useful, but WITHOUT 11 | ANY WARRANTY; withOut even the implied warranty of MERCHANTABILITY or 12 | FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License 13 | for more details. 14 | 15 | You should have received a Copy of the GNU Library General Public License 16 | along with This library; if not, Write to the Free Software Foundation, 17 | Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 18 | 19 | This license has been modified. See File LICENSE.ADDON for more inFormation. 20 | Should you find these sources without a LICENSE File, please contact 21 | me at ales@chello.sk 22 | } 23 | 24 | unit lSpawnFCGI; 25 | 26 | {$mode objfpc}{$H+} 27 | 28 | interface 29 | 30 | uses 31 | Sockets, lNet, lCommon; 32 | 33 | function SpawnFCGIProcess(App, Enviro: string; const aPort: Word): Integer; 34 | 35 | implementation 36 | 37 | {$ifdef UNIX} 38 | {$i lspawnfcgiunix.inc} 39 | {$else} 40 | {$i lspawnfcgiwin.inc} 41 | {$endif} 42 | 43 | end. 44 | 45 | -------------------------------------------------------------------------------- /lib/lws2tcpip.pp: -------------------------------------------------------------------------------- 1 | unit lws2tcpip; 2 | 3 | {$mode delphi} 4 | 5 | interface 6 | 7 | uses 8 | WinSock2; 9 | 10 | const 11 | ws2tcpip = 'ws2_32.dll'; 12 | 13 | AI_PASSIVE = $1; 14 | AI_CANONNAME = $2; 15 | AI_NUMERICHOST = $4; 16 | 17 | type 18 | LPADDRINFO = ^addrinfo; 19 | addrinfo = record 20 | ai_flags: Integer; 21 | ai_family: Integer; 22 | ai_socktype: Integer; 23 | ai_protocol: Integer; 24 | ai_addrlen: size_t; 25 | ai_canonname: PChar; 26 | ai_addr: PSockAddr; 27 | ai_next: LPADDRINFO; 28 | end; 29 | TAddrInfo = addrinfo; 30 | PAddrInfo = LPADDRINFO; 31 | 32 | function getaddrinfo(nodename, servname: PChar; hints: PAddrInfo; var res: PAddrInfo): Integer; stdcall; 33 | procedure freeaddrinfo(ai: PAddrInfo); stdcall; 34 | 35 | implementation 36 | 37 | uses 38 | dynlibs; 39 | 40 | type 41 | TGetAddrInfoFunc = function (nodename, servname: PChar; hints: PAddrInfo; var res: PAddrInfo): Integer; stdcall; 42 | TFreeAddrInfoProc = procedure (ai: PAddrInfo); stdcall; 43 | 44 | var 45 | _lib: TLibHandle; 46 | _getaddrinfo: TGetAddrInfoFunc; 47 | _freeaddrinfo: TFreeAddrInfoProc; 48 | 49 | function getaddrinfo(nodename, servname: PChar; hints: PAddrInfo; 50 | var res: PAddrInfo): Integer; stdcall; 51 | begin 52 | _getaddrinfo(nodename, servname, hints, res); 53 | end; 54 | 55 | procedure freeaddrinfo(ai: PAddrInfo); stdcall; 56 | begin 57 | 58 | end; 59 | 60 | initialization 61 | _lib := LoadLibrary(ws2tcpip); 62 | _getaddrinfo := GetProcedureAddress(_lib, 'getaddrinfo'); 63 | _freeaddrinfo := GetProcedureAddress(_lib, 'freeaddrinfo'); 64 | 65 | finalization 66 | UnloadLibrary(_lib); 67 | 68 | 69 | end. 70 | 71 | -------------------------------------------------------------------------------- /examples/visual/tcpudp/pkey: -------------------------------------------------------------------------------- 1 | -----BEGIN RSA PRIVATE KEY----- 2 | MIIEpQIBAAKCAQEAuvu9oo0wb0Vu0TJrb4Yhfs0Z/MRRT9vs+a3RJoLltmf8WjUk 3 | 2UQ+cC0U+pnJbrNyozlKsI0JVLQHgfefYbKCyw+mlrzwiQzYWiUqGVaNaLaThv4w 4 | a5hbBEa79QaEQr/9yIJL581MdLbT7pThdcu49sQi/tNCT8Y0XatI3FMG0v9ynyuk 5 | iT58hjn0XKZnHr8bGun7m+WtthkVkw9RR3YmBoBTE7LWxyF61CGhHOuOUOZf35+b 6 | CoolhD5ktvVoIZlkm5Fb+Lb0LLFA4ObV9QGlvVbAQWNdRlvyPaKJwuhL2z2clpQW 7 | 93Z8iZaJz/XWJiL658VwxGNqRUoxhcXbj4Zl3wIDAQABAoIBAAWTL+pCz2jh5xXx 8 | rOZcV29Sai3xJIN/CSfAmPXO/U5c91cxMnIP6NSrY269WxYj340iTinJarfNzlN/ 9 | sI7XJbMsOklQRNOxQFoftYuf2wN+PhPOTF9I4Z3VBhGeKh9bXhO2XtEAfAEW2mbI 10 | pZg/hLpGysxSPC3ouPL6AmgfSZrM2e6Jqgo1OxZnkxsMYG1iLUdyA01P4IwbnIF1 11 | zTEi+cpqBiaX9QR3Q5bkXIhyscmaLCeqvjiAhLZXqy2fRy+VW48T08JWoPjOh/vW 12 | EzFOADYXf3bOEeKw62+iSGvF97J87iiqGn7+aMG3FT4YqZ5luu4D1o++xfPj8om/ 13 | Rjte4GECgYEA4Z2GzYmaldfcxV1vfoUQDlSmdpcJ3UM/gMew4fSH22obpM81krih 14 | H84KMzCIBT1dTJWygSwsNbivhTclRseV/TJ2vN2OQOCk4jwgXjuKyqMVEv7UFVp0 15 | 2Z3KTI9+AOTplSRUUymka0dwLd0B7rhuqIfPWT6cC7pgpJCWR4JR3gkCgYEA1CpP 16 | mwLhTsDhkjkwsEvIYTJPvKg1ch77Ck3RYQ01tAaJ0IMZfBMuVYAzzbgVrsTuxgMP 17 | tAoHTw9fgk+KU0ksIWR3yxrYnFALN9DJvT4nyYjesF1Y83MAwhVE+REJ77efJV7T 18 | IkB4OZgdljn5caPEZMAGQxLWFRaV6HHvYnGtnqcCgYEA3OcIHiclHKIGn5gkmpRe 19 | bCml82dfWS2G9+iN4C809jimaHAZ3Fa6LBHpGsXh6H904o+P/7nob5EtCho8fVje 20 | GtNWPwYPSqapynlkl99kvZOABuFLdrzivFAqy1uT2/xGWKkBh4u2WPPRepZyVfJv 21 | JsQS2SbcUv9hsL+A5PNMhUECgYEAwoCbhB9K0HjxEq1NXoHLDJgkE28duCaAvHyE 22 | s/V5QzYvR7G4PlATTRz/4NufPR6bS3po/gOnmaodRAiJZjsRsvc4/0D4Tazv69aD 23 | 6/K8ZP0OMh8RufW3PzZiifc95b6vroHVC3SRAzPaA+vYK38YP8jutLTjAGg5O+Sf 24 | sd9HbMcCgYEAliEIS+BRsf7Uj6jZj+/n3LIiREbZ0Euhqbfh8ZWnFA6Qs64jMvRs 25 | /XJgfK/4jYvVWyMsnPOBRnTvI83PiC12UV4yJP2SbyJFkynqcmQjU9tXJoxfTg8m 26 | CayJ0aG8qGd2SWmJob8w8WIC+2k7Pt4Otcgfm0KxgJ3jNQ5bwHQ8Udo= 27 | -----END RSA PRIVATE KEY----- 28 | -------------------------------------------------------------------------------- /lazaruspackage/CHANGELOG: -------------------------------------------------------------------------------- 1 | * version 0.6.5 13.03.2011 -- lnetbase fixes, no visual changes 2 | * version 0.6.4 09.05.2010 -- added qt4 interface 3 | * version 0.6.3 12.02.2010 -- lots of small fixes and file movements to avoid conflicts 4 | * version 0.6.2 29.05.2008 -- huge fixes in SMTP, Sessions (visual bugs too, AV on component delete fixed, sharing of sessions fixed etc.) 5 | * version 0.6.1 24.04.2008 -- fix SSL CAFile and KeyFile mandatority 6 | * version 0.6.0 12.02.2008 -- added visual telnet + examples, fixed some telnet bugs, made TCP sending simpler (optional) 7 | * version 0.5.8 04.09.2007 -- fixed problems with windows visual component, fixed SMTP RFC compliance 8 | * version 0.5.7 20.08.2007 -- fixes Darwin MSG_NOSIGNAL to use SO_NOSIGPIPE instead 9 | * version 0.5.6 04.08.2007 -- fixed UFP.Disconnect potential AV bug and loss of error numbers in some situations 10 | * version 0.5.5 15.07.2007 -- fixes TCP.IterReset and documentation, makes Timeout signed for -1 (blocking mode) 11 | * version 0.5.4 08.07.2007 -- fixes some UDP bugs and TCP.Count 12 | * version 0.5.3 25.06.2007 -- fixes FTP bugs, removes Timout from published, fixed default published values 13 | * version 0.5.2 11.06.2007 -- fixes bug in windows and wince LCLEventer 14 | * version 0.5.1 01.06.2007 -- fixes in WinCE (bugged in 0.5.0) 15 | * Version 0.5.0 01.04.2007 -- new major release, removes hacks regarding type reintroduction thanks to new Lazarus fix, fixes windows blocking problem with dialogs and menus. 16 | * Version 0.4.0 25.09.2006 -- added LCLEventer and new http client visual example 17 | * Version 0.4.0 16.02.2006 -- changed internals to support eventer 18 | * Version 0.3.1 03.01.2005 -- removed MT support. fixed lots of bugs and overhauled interface 19 | * Version 0.2.0 29.11.2005 20 | * Version 0.1.0 12.11.2005 -- fixed some minor MT bugs, added ST LCL version 21 | -------------------------------------------------------------------------------- /INSTALL.md: -------------------------------------------------------------------------------- 1 | ## Requirements 2 | 3 | LNET requires FPC 2.0.4 or greater. 4 | 5 | For LNET, LTCP, LUDP, LFTP and LSMTP all you need to do is type "make". (imake can make it too) 6 | Make.exe is shipped in win32 along with Free Pascal. 7 | Possible options are: 8 | 9 | make -- compiles all examples and lib with -XX -Xs -O2 10 | make argless -- compiles everything with no arguments (can be combined with OPT=...) 11 | make clean -- deletes the object files, ppus and binaries (requires delp, part of FPC) 12 | 13 | ## Usage 14 | 15 | If you're using Lazarus, see lazaruspackage/INSTALL, even if you plan to use only non-visual aspect of lNet (eg: not depend on LCL). Otherwise if you want to use lnet in your project, just copy the "lib" directory somewhere and put it in compiler's unit search path with -Fu and -Fi for the "lib/sys" subdir. 16 | 17 | ## Units 18 | 19 | lnet.pas - this is the main workmule of the whole library. Contains all base classes and helper functions 20 | levents.pas - this is the "eventer" unit which holds TLEventer classes. 21 | ltelnet.pas - this is the telnet protocol addition. Currently only the client works. 22 | lftp.pas - this is the FTP protocol addition. Currently only the client works. 23 | lsmtp.pas - this is the SMTP protocol addition. Client only for now. 24 | lhttp.pas - this is a HTTP protocol addition. Both client and server. 25 | 26 | ### Layout 27 | 28 | lnet/ -- this root dir 29 | lnet/lib -- the library dir for all lnet libraries 30 | lnet/lib/sys -- system specific units and include files for lnet libraries 31 | lnet/examples -- console and visual example programs 32 | 33 | The console example programs get compiled if you type "make". 34 | Visual examples can be opened by Lazarus (.lpi files are included). 35 | You need to install the visual lnetpackage.lpk and lnetidepackage.lpk for that. 36 | 37 | Lazarus package installation: 38 | 39 | See [lazaruspackage/INSTALL.md](lazaruspackage/INSTALL.md) 40 | -------------------------------------------------------------------------------- /lazaruspackage/lnetvisualreg.pas: -------------------------------------------------------------------------------- 1 | { 2 | ***************************************************************************** 3 | * * 4 | * See the file LICENSE and LICENSE.ADDON, included in this distribution, * 5 | * for details about the copyright. * 6 | * * 7 | * This program is distributed in the hope that it will be useful, * 8 | * but WITHOUT ANY WARRANTY; without even the implied warranty of * 9 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. * 10 | * * 11 | ***************************************************************************** 12 | 13 | Author: Ales Katona 14 | 15 | This unit registers the lnet components. 16 | } 17 | unit LNetVisualReg; 18 | 19 | interface 20 | 21 | procedure Register; 22 | 23 | implementation 24 | 25 | uses 26 | Classes, LResources, LazarusPackageIntf, PropEdits, 27 | lNetComponents; 28 | 29 | procedure Register; 30 | begin 31 | RegisterComponents('lNet' , [TLTcpComponent, TLUdpComponent, TLTelnetClientComponent, 32 | TLFTPClientComponent, TLSMTPClientComponent, 33 | TLHTTPClientComponent, TLHTTPServerComponent, 34 | TLSSLSessionComponent]); 35 | 36 | RegisterPropertyEditor(TypeInfo(ansistring), TLSSLSessionComponent, 'CAFile', 37 | TFileNamePropertyEditor); 38 | RegisterPropertyEditor(TypeInfo(ansistring), TLSSLSessionComponent, 'KeyFile', 39 | TFileNamePropertyEditor); 40 | end; 41 | 42 | initialization 43 | {$i lnetvisualreg.lrs} 44 | 45 | end. 46 | 47 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Updated to compile on FreeBSD, Linux, macOS and Windows 2 | 3 | Quite a few changes were required, but all the examples now compile with FPC 3.2.2 or 3.3.1 on: 4 | 5 | * FreeBSD (tested on 13.0-RELEASE) 6 | * Linux (tested on Ubuntu 21.10 - Note: TLS does not work) 7 | * macOS 10.12 and later 8 | * Windows (tested on 10 with updated SSL libraries - see OpenSSL.pas for details) 9 | * All insecure TLS/SSL methods have been removed (ie SSL2, SSL3, TLS v1, TLS v1.1) leaving TSL v1.2 and TLS v1.3 10 | 11 | Instructions: 12 | 13 | 0) Compile with FPC 3.2.2 or FPC 3.3.1 14 | 1) Download a ZIP file and unzip 15 | 2) cd to the lnet-master directory 16 | 3) run make (this compiles the library and console examples - there are no Cocoa/Carbon hooks for the visual components, so they do not compile for macOS) 17 | 4) For Lazarus, add the path to lnet-master/lib to the Project Options > Paths - "Other unit files" OR 18 | 5) For FPC, use -Fu to add the path to lnet-master/lib 19 | 20 | # Original ReadMe Content 21 | 22 | ## Lightweight Networking Library 23 | 24 | These units are an asynchronous, TCP/UDP communications classes. 25 | LTCP, LUDP, LTELNET, LFTP and LSMTP are example programs. 26 | 27 | Use the makefile to compile the lib as well as examples. 28 | 29 | All programs are compiled with Free Pascal 2.0.4 (http://www.freepascal.org) 30 | 31 | Copyright (c) 2005-2018 by Ales Katona and Micha Nelissen. 32 | 33 | lNet as of version 0.6+ uses OpenSSL when SSLSession is used. 34 | 35 | ## LICENSING 36 | 37 | lNet units (units in lib and lazaruspackage directories) are licensed under a modified LGPL license. See file [lib/LICENSE](lib/LICENSE) and [lib/LICENSE.ADDON](lib/LICENSE.ADDON). 38 | 39 | The modification allows to static/smart - link lNet libraries into binary applications without providing sources. 40 | 41 | Example programs are provided under unmodified gnu GPL. See [examples/LICENSE](examples/LICENSE) for more information. 42 | 43 | ## INSTALLING 44 | 45 | See file [INSTALL.md](INSTALL.md) for more information. 46 | -------------------------------------------------------------------------------- /lib/lws2override.pp: -------------------------------------------------------------------------------- 1 | { WinSock2 patch for larger TFDSet (1024 instead of 64). 2 | 3 | These types and functions are identical with the ones from WinSock2, the 4 | only difference is the value of FD_SETSIZE and therefore a larger TFDSet 5 | array. Putting this unit *after* the winsock2 unit into your uses clause 6 | will make these new definitions take precedence. 7 | } 8 | unit lws2override; 9 | 10 | {$mode objfpc}{$H+} 11 | 12 | interface 13 | uses 14 | windows, 15 | WinSock2; 16 | 17 | const 18 | // "64 sockets ought to be enough for anybody" 19 | FD_SETSIZE = 1024; // ...except me! 20 | 21 | type 22 | PFDSet = ^TFDSet; 23 | TFDSet = record 24 | fd_count: u_int; 25 | fd_array: array[0..FD_SETSIZE-1] of TSocket; 26 | end; 27 | fdset = TFDSet; 28 | 29 | function select(nfds: Longint; readfds, writefds, exceptfds: PFDSet; timeout: PTimeVal): Longint; stdcall;external WINSOCK2_DLL name 'select'; 30 | function __WSAFDIsSet(s: TSOcket; var FDSet: TFDSet): Bool; stdcall; external WINSOCK2_DLL name '__WSAFDIsSet'; 31 | 32 | procedure FD_CLR(Socket: TSocket; var FDSet: TFDSet); 33 | function FD_ISSET(Socket: TSocket; var FDSet: TFDSet): Boolean; 34 | procedure FD_SET(Socket: TSocket; var FDSet: TFDSet); 35 | procedure FD_ZERO(var FDSet: TFDSet); 36 | 37 | implementation 38 | 39 | procedure FD_CLR(Socket: TSocket; var FDSet: TFDSet); 40 | var 41 | I: cardinal; 42 | begin 43 | I := 0; 44 | while I < FDSet.fd_count do 45 | begin 46 | if FDSet.fd_array[I] = Socket then 47 | begin 48 | while I < FDSet.fd_count - 1 do 49 | begin 50 | FDSet.fd_array[I] := FDSet.fd_array[I + 1]; 51 | Inc(I); 52 | end; 53 | Dec(FDSet.fd_count); 54 | Break; 55 | end; 56 | Inc(I); 57 | end; 58 | end; 59 | 60 | function FD_ISSET(Socket: TSocket; var FDSet: TFDSet): Boolean; 61 | begin 62 | FD_ISSET := __WSAFDIsSet(Socket, FDSet); 63 | end; 64 | 65 | procedure FD_SET(Socket: TSocket; var FDSet: TFDSet); 66 | begin 67 | if FDSet.fd_count < FD_SETSIZE then 68 | begin 69 | FDSet.fd_array[FDSet.fd_count] := Socket; 70 | Inc(FDSet.fd_count); 71 | end; 72 | end; 73 | 74 | procedure FD_ZERO(var FDSet: TFDSet); 75 | begin 76 | FDSet.fd_count := 0; 77 | end; 78 | 79 | end. 80 | 81 | -------------------------------------------------------------------------------- /lib/ltimer.pp: -------------------------------------------------------------------------------- 1 | { lNet Timer 2 | 3 | CopyRight (C) 2006-2008 Micha Nelissen 4 | 5 | This library is Free software; you can rediStribute it and/or modify it 6 | under the terms of the GNU Library General Public License as published by 7 | the Free Software Foundation; either version 2 of the License, or (at your 8 | option) any later version. 9 | 10 | This program is diStributed in the hope that it will be useful, but WITHOUT 11 | ANY WARRANTY; withOut even the implied warranty of MERCHANTABILITY or 12 | FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License 13 | for more details. 14 | 15 | You should have received a Copy of the GNU Library General Public License 16 | along with This library; if not, Write to the Free Software Foundation, 17 | Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 18 | 19 | This license has been modified. See File LICENSE.ADDON for more inFormation. 20 | Should you find these sources without a LICENSE File, please contact 21 | me at ales@chello.sk 22 | } 23 | 24 | unit ltimer; 25 | 26 | {$mode objfpc}{$H+} 27 | 28 | interface 29 | 30 | uses 31 | Classes, SysUtils; 32 | 33 | type 34 | 35 | { TLTimer } 36 | 37 | TLTimer = class(TObject) 38 | protected 39 | FOnTimer: TNotifyEvent; 40 | FInterval: TDateTime; 41 | FStarted: TDateTime; 42 | FOneShot: Boolean; 43 | FEnabled: Boolean; 44 | 45 | function GetInterval: Integer; 46 | procedure SetInterval(const aValue: Integer); 47 | public 48 | procedure CallAction; 49 | property Enabled: Boolean read FEnabled write FEnabled; 50 | property Interval: Integer read GetInterval write SetInterval; 51 | property OneShot: Boolean read FOneShot write FOneShot; 52 | property OnTimer: TNotifyEvent read FOnTimer write FOnTimer; 53 | end; 54 | 55 | implementation 56 | 57 | { TLTimer } 58 | 59 | function TLTimer.GetInterval: Integer; 60 | begin 61 | Result := Round(FInterval * MSecsPerDay); 62 | end; 63 | 64 | procedure TLTimer.SetInterval(const aValue: Integer); 65 | begin 66 | FInterval := AValue / MSecsPerDay; 67 | FStarted := Now; 68 | FEnabled := true; 69 | end; 70 | 71 | procedure TLTimer.CallAction; 72 | begin 73 | if FEnabled and Assigned(FOnTimer) and (Now - FStarted >= FInterval) then 74 | begin 75 | FOnTimer(Self); 76 | if not FOneShot then 77 | FStarted := Now 78 | else 79 | FEnabled := false; 80 | end; 81 | end; 82 | 83 | end. 84 | 85 | -------------------------------------------------------------------------------- /examples/visual/telnet/main.lrs: -------------------------------------------------------------------------------- 1 | LazarusResources.Add('TFormMain','FORMDATA',[ 2 | 'TPF0'#9'TFormMain'#8'FormMain'#4'Left'#3'"'#1#6'Height'#3#207#1#3'Top'#3#190 3 | +#0#5'Width'#3'$'#2#18'HorzScrollBar.Page'#3'#'#2#18'VertScrollBar.Page'#3#181 4 | +#1#13'ActiveControl'#7#8'EditHost'#7'Caption'#6#18'Telnet test client'#12'Cl' 5 | +'ientHeight'#3#182#1#11'ClientWidth'#3'$'#2#4'Menu'#7#9'MainMenu1'#6'OnShow' 6 | +#7#8'FormShow'#0#5'TMemo'#8'MemoText'#6'Height'#3'F'#1#3'Top'#2'Y'#5'Width'#3 7 | +'$'#2#5'Align'#7#8'alClient'#8'ReadOnly'#9#8'TabOrder'#2#0#0#0#5'TEdit'#8'Ed' 8 | +'itSend'#6'Height'#2#23#3'Top'#3#159#1#5'Width'#3'$'#2#5'Align'#7#8'alBottom' 9 | +#10'OnKeyPress'#7#16'EditSendKeyPress'#8'TabOrder'#2#1#0#0#9'TGroupBox'#14'G' 10 | +'roupBoxServer'#6'Height'#2'Y'#5'Width'#3'$'#2#5'Align'#7#5'alTop'#7'Caption' 11 | +#6#6'Server'#12'ClientHeight'#2'F'#11'ClientWidth'#3' '#2#8'TabOrder'#2#2#0#6 12 | +'TLabel'#9'LabelHost'#4'Left'#2#6#6'Height'#2#20#3'Top'#2#10#5'Width'#2'#'#7 13 | +'Caption'#6#5'Host:'#11'ParentColor'#8#0#0#6'TLabel'#9'LabelPort'#4'Left'#2#6 14 | +#6'Height'#2#20#3'Top'#2'*'#5'Width'#2#31#7'Caption'#6#5'Port:'#11'ParentCol' 15 | +'or'#8#0#0#5'TEdit'#8'EditHost'#4'Left'#2'F'#6'Height'#2#23#3'Top'#2#7#5'Wid' 16 | +'th'#3#208#1#8'TabOrder'#2#0#4'Text'#6#9'localhost'#0#0#5'TEdit'#8'EditPort' 17 | +#4'Left'#2'F'#6'Height'#2#23#3'Top'#2''''#5'Width'#2'P'#8'TabOrder'#2#1#4'Te' 18 | +'xt'#6#2'23'#0#0#7'TButton'#13'ButtonConnect'#4'Left'#3#158#0#6'Height'#2#25 19 | +#3'Top'#2'%'#5'Width'#2'K'#7'Caption'#6#7'Connect'#7'OnClick'#7#18'ButtonCon' 20 | +'nectClick'#8'TabOrder'#2#2#0#0#7'TButton'#16'ButtonDisconnect'#4'Left'#3#246 21 | +#0#6'Height'#2#25#3'Top'#2'%'#5'Width'#2'`'#7'Caption'#6#10'Disconnect'#7'On' 22 | +'Click'#7#21'ButtonDisconnectClick'#8'TabOrder'#2#3#0#0#0#23'TLTelnetClientC' 23 | +'omponent'#6'Telnet'#4'Host'#6#9'localhost'#4'Port'#2#23#9'OnConnect'#7#13'T' 24 | +'elnetConnect'#12'OnDisconnect'#7#16'TelnetDisconnect'#9'OnReceive'#7#13'Tel' 25 | +'netReceive'#7'OnError'#7#11'TelnetError'#9'LocalEcho'#9#4'left'#3#0#2#3'top' 26 | +#2'8'#0#0#9'TMainMenu'#9'MainMenu1'#4'left'#3#224#1#3'top'#2'8'#0#9'TMenuIte' 27 | +'m'#12'MenuItemFile'#7'Caption'#6#5'&File'#0#9'TMenuItem'#12'MenuItemExit'#7 28 | +'Caption'#6#5'E&xit'#7'OnClick'#7#17'MenuItemExitClick'#0#0#0#9'TMenuItem'#12 29 | +'MenuItemHelp'#7'Caption'#6#5'&Help'#0#9'TMenuItem'#13'MenuItemAbout'#7'Capt' 30 | +'ion'#6#6'&About'#7'OnClick'#7#18'MenuItemAboutClick'#0#0#0#0#0 31 | ]); 32 | -------------------------------------------------------------------------------- /lazaruspackage/lclnet.pas: -------------------------------------------------------------------------------- 1 | { lNetComponents v0.6.2 2 | 3 | CopyRight (C) 2004-2008 Ales Katona 4 | 5 | This library is Free software; you can rediStribute it and/or modify it 6 | under the terms of the GNU Library General Public License as published by 7 | the Free Software Foundation; either version 2 of the License, or (at your 8 | option) any later version. 9 | 10 | This program is diStributed in the hope that it will be useful, but WITHOUT 11 | ANY WARRANTY; withOut even the implied warranty of MERCHANTABILITY or 12 | FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License 13 | for more details. 14 | 15 | You should have received a Copy of the GNU Library General Public License 16 | along with This library; if not, Write to the Free Software Foundation, 17 | Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 18 | 19 | This license has been modified. See File LICENSE.ADDON for more inFormation. 20 | Should you find these sources without a LICENSE File, please contact 21 | me at ales@chello.sk 22 | } 23 | 24 | unit LCLNet; 25 | 26 | {$mode objfpc}{$H+} 27 | 28 | interface 29 | 30 | uses 31 | InterfaceBase, LCLIntf, lNet, lEvents; 32 | 33 | type 34 | PLCLHandleInfo = ^TLCLHandleInfo; 35 | TLCLHandleInfo = record 36 | Handle: TLHandle; 37 | Flags: DWord; 38 | EventHandle: PEventHandler; 39 | end; 40 | 41 | { TLCLEventer } 42 | 43 | TLCLEventer = class(TLEventer) 44 | protected 45 | procedure HandleIgnoreError(aHandle: TLHandle); override; 46 | procedure HandleIgnoreWrite(aHandle: TLHandle); override; 47 | procedure HandleIgnoreRead(aHandle: TLHandle); override; 48 | procedure InternalUnplugHandle(aHandle: TLHandle); override; 49 | {$ifndef windows} // unix 50 | procedure HandleEvents(aData: PtrInt; aFlags: DWord); 51 | public 52 | {$else} 53 | function HandleEvents(aHandle: THandle; aFlags: DWord): LongInt; 54 | procedure UnregisterHandle(aHandle: TLHandle); override; 55 | public 56 | constructor Create; override; 57 | {$endif} 58 | function AddHandle(aHandle: TLHandle): Boolean; override; 59 | end; 60 | 61 | implementation 62 | 63 | {$ifdef LCLWIN32} 64 | {$i lclwineventer.inc} 65 | {$endif} 66 | 67 | {$ifdef LCLWINCE} 68 | {$i lclwinceeventer.inc} 69 | {$endif} 70 | 71 | {$ifdef LCLGTK} 72 | {$i lclgtkeventer.inc} 73 | {$endif} 74 | 75 | {$ifdef LCLGTK2} 76 | {$i lclgtkeventer.inc} 77 | {$endif} 78 | 79 | {$if Defined(LCLQT) or Defined(LCLQT5) or Defined(LCLQT6)} 80 | // The gtkeventer works also for the QT widgetsets. No need to bring an own one. 81 | {$i lclgtkeventer.inc} 82 | {$endif} 83 | 84 | end. 85 | 86 | -------------------------------------------------------------------------------- /tests/http/httptest.pas: -------------------------------------------------------------------------------- 1 | program httptest; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | uses 6 | SysUtils, Classes, 7 | lNet, lHTTP; 8 | 9 | const 10 | MAX_COUNT = 10000; 11 | 12 | type 13 | 14 | { TTest } 15 | 16 | TTest = class 17 | protected 18 | FHTTP: TLHTTPClient; 19 | FBuffer: string; 20 | FExpected: string; 21 | FQuit: Boolean; 22 | FCount: Integer; 23 | procedure OnEr(const msg: string; aSocket: TLSocket); 24 | procedure OnDs(aSocket: TLSocket); 25 | function OnInput(ASocket: TLHTTPClientSocket; ABuffer: pchar; ASize: integer): integer; 26 | procedure OnDoneInput(aSocket: TLHTTPClientSocket); 27 | public 28 | constructor Create; 29 | destructor Destroy; override; 30 | procedure Get; 31 | end; 32 | 33 | { TTest } 34 | 35 | procedure TTest.OnEr(const msg: string; aSocket: TLSocket); 36 | begin 37 | Writeln(msg); 38 | FQuit := True; 39 | end; 40 | 41 | procedure TTest.OnDs(aSocket: TLSocket); 42 | begin 43 | Writeln('Lost connection'); 44 | FQuit := True; 45 | end; 46 | 47 | function TTest.OnInput(ASocket: TLHTTPClientSocket; ABuffer: pchar; 48 | ASize: integer): integer; 49 | begin 50 | FBuffer := FBuffer + aBuffer; 51 | Result := aSize; 52 | end; 53 | 54 | procedure TTest.OnDoneInput(aSocket: TLHTTPClientSocket); 55 | begin 56 | if FBuffer <> FExpected then 57 | Writeln('ERROR, doesn''t match!') 58 | else 59 | Write('.'); 60 | 61 | Inc(FCount); 62 | 63 | if FCount > MAX_COUNT then begin 64 | FQuit := True; 65 | Writeln('DONE'); 66 | end else begin 67 | FBuffer := ''; 68 | FHTTP.SendRequest; 69 | end; 70 | end; 71 | 72 | constructor TTest.Create; 73 | var 74 | f: TFileStream; 75 | begin 76 | FHTTP := TLHTTPClient.Create(nil); 77 | FHTTP.OnError := @OnEr; 78 | FHTTP.OnInput := @OnInput; 79 | FHTTP.OnDisconnect := @OnDs; 80 | FHTTP.OnDoneInput := @OnDoneInput; 81 | 82 | FHTTP.Timeout := 1000; 83 | 84 | FHTTP.Host := 'members.chello.sk'; 85 | FHTTP.URI := '/ales/index.html'; 86 | 87 | f := TFileStream.Create('expected.txt', fmOpenRead); 88 | SetLength(FExpected, f.Size); 89 | f.Read(FExpected[1], f.Size); 90 | f.Free; 91 | end; 92 | 93 | destructor TTest.Destroy; 94 | begin 95 | FHTTP.Free; 96 | 97 | inherited Destroy; 98 | end; 99 | 100 | procedure TTest.Get; 101 | begin 102 | FHTTP.SendRequest; 103 | 104 | repeat 105 | FHTTP.CallAction; 106 | until FQuit or not FHTTP.Connected; 107 | end; 108 | 109 | var 110 | t: TTest; 111 | begin 112 | t := TTest.Create; 113 | 114 | t.Get; 115 | 116 | t.Free; 117 | end. 118 | 119 | -------------------------------------------------------------------------------- /examples/visual/tcpudp/testnet.lpi: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | </General> 13 | <BuildModes Count="1"> 14 | <Item1 Name="default" Default="True"/> 15 | </BuildModes> 16 | <PublishOptions> 17 | <Version Value="2"/> 18 | <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> 19 | <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> 20 | </PublishOptions> 21 | <RunParams> 22 | <local> 23 | <FormatVersion Value="1"/> 24 | <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> 25 | </local> 26 | </RunParams> 27 | <RequiredPackages Count="3"> 28 | <Item1> 29 | <PackageName Value="LCL"/> 30 | </Item1> 31 | <Item2> 32 | <PackageName Value="lnetbase"/> 33 | </Item2> 34 | <Item3> 35 | <PackageName Value="lnetvisual"/> 36 | <MinVersion Minor="4" Release="1" Valid="True"/> 37 | </Item3> 38 | </RequiredPackages> 39 | <Units Count="2"> 40 | <Unit0> 41 | <Filename Value="testnet.lpr"/> 42 | <IsPartOfProject Value="True"/> 43 | </Unit0> 44 | <Unit1> 45 | <Filename Value="main.pas"/> 46 | <IsPartOfProject Value="True"/> 47 | <ComponentName Value="FormMain"/> 48 | <HasResources Value="True"/> 49 | <ResourceBaseClass Value="Form"/> 50 | <UnitName Value="main"/> 51 | </Unit1> 52 | </Units> 53 | </ProjectOptions> 54 | <CompilerOptions> 55 | <Version Value="10"/> 56 | <SearchPaths> 57 | <SrcPath Value="$(LazarusDir)/lcl;$(LazarusDir)/lcl/interfaces/$(LCLWidgetType)"/> 58 | </SearchPaths> 59 | <Parsing> 60 | <SyntaxOptions> 61 | <UseAnsiStrings Value="False"/> 62 | </SyntaxOptions> 63 | </Parsing> 64 | <CodeGeneration> 65 | <Optimizations> 66 | <OptimizationLevel Value="2"/> 67 | </Optimizations> 68 | </CodeGeneration> 69 | <Linking> 70 | <Debugging> 71 | <UseLineInfoUnit Value="False"/> 72 | <StripSymbols Value="True"/> 73 | </Debugging> 74 | <LinkSmart Value="True"/> 75 | <Options> 76 | <Win32> 77 | <GraphicApplication Value="True"/> 78 | </Win32> 79 | </Options> 80 | </Linking> 81 | <Other> 82 | <CompilerMessages> 83 | <UseMsgFile Value="True"/> 84 | </CompilerMessages> 85 | <CompilerPath Value="$(CompPath)"/> 86 | </Other> 87 | </CompilerOptions> 88 | </CONFIG> 89 | -------------------------------------------------------------------------------- /lib/lcontrolstack.pp: -------------------------------------------------------------------------------- 1 | { Control stack 2 | 3 | CopyRight (C) 2004-2008 Ales Katona 4 | 5 | This library is Free software; you can rediStribute it and/or modify it 6 | under the terms of the GNU Library General Public License as published by 7 | the Free Software Foundation; either version 2 of the License, or (at your 8 | option) any later version. 9 | 10 | This program is diStributed in the hope that it will be useful, but WITHOUT 11 | ANY WARRANTY; withOut even the implied warranty of MERCHANTABILITY or 12 | FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License 13 | for more details. 14 | 15 | You should have received a Copy of the GNU Library General Public License 16 | along with This library; if not, Write to the Free Software Foundation, 17 | Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 18 | 19 | This license has been modified. See File LICENSE for more inFormation. 20 | Should you find these sources withOut a LICENSE File, please contact 21 | me at ales@chello.sk 22 | } 23 | 24 | unit lControlStack; 25 | 26 | {$mode objfpc} 27 | 28 | interface 29 | 30 | const 31 | TL_CSLENGTH = 3; 32 | 33 | type 34 | TLOnFull = procedure of object; 35 | 36 | TLControlStack = class 37 | private 38 | FItems: array of Char; 39 | FIndex: Byte; 40 | FOnFull: TLOnFull; 41 | function GetFull: Boolean; 42 | function GetItem(const i: Byte): Char; 43 | procedure SetItem(const i: Byte; const Value: Char); 44 | public 45 | constructor Create; 46 | procedure Clear; 47 | procedure Push(const Value: Char); 48 | property ItemIndex: Byte read FIndex; 49 | property Items[i: Byte]: Char read GetItem write SetItem; default; 50 | property Full: Boolean read GetFull; 51 | property OnFull: TLOnFull read FOnFull write FOnFull; 52 | end; 53 | 54 | implementation 55 | 56 | uses 57 | lTelnet; 58 | 59 | constructor TLControlStack.Create; 60 | begin 61 | FOnFull:=nil; 62 | FIndex:=0; 63 | SetLength(FItems, TL_CSLENGTH); 64 | end; 65 | 66 | function TLControlStack.GetFull: Boolean; 67 | begin 68 | Result:=False; 69 | if FIndex >= TL_CSLENGTH then 70 | Result:=True; 71 | end; 72 | 73 | function TLControlStack.GetItem(const i: Byte): Char; 74 | begin 75 | Result:=TS_NOP; 76 | if i < TL_CSLENGTH then 77 | Result:=FItems[i]; 78 | end; 79 | 80 | procedure TLControlStack.SetItem(const i: Byte; const Value: Char); 81 | begin 82 | if i < TL_CSLENGTH then 83 | FItems[i]:=Value; 84 | end; 85 | 86 | procedure TLControlStack.Clear; 87 | begin 88 | FIndex:=0; 89 | end; 90 | 91 | procedure TLControlStack.Push(const Value: Char); 92 | begin 93 | if FIndex < TL_CSLENGTH then begin 94 | FItems[FIndex]:=Value; 95 | Inc(FIndex); 96 | if Full and Assigned(FOnFull) then 97 | FOnFull; 98 | end; 99 | end; 100 | 101 | end. 102 | 103 | -------------------------------------------------------------------------------- /CHANGELOG: -------------------------------------------------------------------------------- 1 | 13.03.2011 - 0.6.5 fixed lingering sockets after server-side disconnect, SSL and IPv6 support completed (also server-side), DecodeURL fixes for http 2 | 3 | 09.05.2010 - 0.6.4 fixed a small FTP bug in case of retreiving inaccessible file. Added Qt4 lazarus visual interface integration code 4 | 5 | 12.02.2010 - 0.6.3 lots of small fixes and OpenSSL file rename to avoid conflicts 6 | 7 | 29.05.2008 - 0.6.2 huge fixes in SSL, Sessions and SMTP 8 | 9 | 24.04.2008 - 0.6.1 fix SSL in regards to KeyFile and CAFile (no longer mandatory) 10 | 11 | 03.04.2008 - 0.6.0 reverted TCP sending changes (too bloaty, not modular). Fixed lots of bugs. Added SSL support! 12 | 13 | 12.02.2008 - 0.6.0 made TCP sending more user-friendly (optional), fixed some telnet stuff, added visual telnet + examples 14 | 15 | 04.09.2007 - 0.5.8 fixed Windows visual problems with .Disconnect and .Free, fixed SMTP RFC compliance 16 | 17 | 20.08.2007 - 0.5.7 fixed Darwin's MSG_NOSIGNAL (doesn't exist, but changed it to use SO_NOSIGPIPE). Fixed timeouts to be signed (forgotten commit in 0.5.5?) 18 | 19 | 04.08.2007 - 0.5.6 fixed UDP.Disconnect (AV) and loss of error numbers in TLSocket.Get/Send 20 | 21 | 15.07.2007 - 0.5.5 fixed TCP.IterReset (goes to server socket always now), fixed some doc errata, changed .Timeout to signed, -1 means block until event 22 | 23 | 08.07.2007 - 0.5.4 fixed bugs with UDP.Listen and UDP.Connect as well as some other minor issues 24 | 25 | 25.06.2007 - 0.5.3 fixed bugs with FTP and TCP(iterator with Listen) 26 | 27 | 11.06.2007 - 0.5.2 fixed bug in windows (wince too) LCLEventer (potential memory corruption) 28 | 29 | 01.06.2007 - 0.5.1 added MIME support for SMTP and others. Fixes some potential bugs in FTP and SMTP. Added winCE support (fixed from 0.5.0) 30 | 31 | 01.04.2007 - 0.5.0 new major release due to API changes and Lazarus fixes. And it's not a joke :) 32 | 33 | 25.09.2006 - 0.4.0 now ready for release 34 | 35 | 24.08.2006 - 0.4.0 preparations for 0.4 release, cleanification of examples 36 | 37 | 12.03.2006 - 0.4.0 fixed epoll and kqueue 38 | 39 | 16.02.2006 - 0.4.0 added eventer support with kqueue and epoll for BSDs and Linux. Changed internal layout a bit and added SMTP and PING protocols. Neli added http server class/component and fphttpd daemon. 40 | 41 | 22.01.2006 - 0.3.1 "stable" is out now. Unified handling of events between platforms and visual/non-visual lnet. Added documentation and FAQ to page. Fixed disconnect bug. 42 | 43 | 14.01.2006 - Prerelease has been overhauled. New style of socket event handling permitted simplifications between LCL and Select models. Removed CallConnections and connectionlist. 44 | 45 | 05.01.2006 - Prerelease for "visual" 0.3/2.4.0 version. Lots of API changes (post 2.4.0 will be STABLE, no more changes) and fixed send issues. OnReceive now only informes of possible Receive call. User must use Get<> functions. (saves time and memory because no internal buffer is used) 46 | 47 | 22.12.2005 - Fixed ugly send bug which cause data loss on network overload 48 | -------------------------------------------------------------------------------- /examples/visual/telnet/main.lfm: -------------------------------------------------------------------------------- 1 | object FormMain: TFormMain 2 | Left = 290 3 | Height = 463 4 | Top = 190 5 | Width = 548 6 | HorzScrollBar.Page = 547 7 | VertScrollBar.Page = 437 8 | ActiveControl = EditHost 9 | Caption = 'Telnet test client' 10 | ClientHeight = 438 11 | ClientWidth = 548 12 | Menu = MainMenu1 13 | OnShow = FormShow 14 | object MemoText: TMemo 15 | Height = 326 16 | Top = 89 17 | Width = 548 18 | Align = alClient 19 | ReadOnly = True 20 | TabOrder = 0 21 | end 22 | object EditSend: TEdit 23 | Height = 23 24 | Top = 415 25 | Width = 548 26 | Align = alBottom 27 | OnKeyPress = EditSendKeyPress 28 | TabOrder = 1 29 | end 30 | object GroupBoxServer: TGroupBox 31 | Height = 89 32 | Width = 548 33 | Align = alTop 34 | Caption = 'Server' 35 | ClientHeight = 70 36 | ClientWidth = 544 37 | TabOrder = 2 38 | object LabelHost: TLabel 39 | Left = 6 40 | Height = 20 41 | Top = 10 42 | Width = 35 43 | Caption = 'Host:' 44 | ParentColor = False 45 | end 46 | object LabelPort: TLabel 47 | Left = 6 48 | Height = 20 49 | Top = 42 50 | Width = 31 51 | Caption = 'Port:' 52 | ParentColor = False 53 | end 54 | object EditHost: TEdit 55 | Left = 70 56 | Height = 23 57 | Top = 7 58 | Width = 464 59 | TabOrder = 0 60 | Text = 'localhost' 61 | end 62 | object EditPort: TEdit 63 | Left = 70 64 | Height = 23 65 | Top = 39 66 | Width = 80 67 | TabOrder = 1 68 | Text = '23' 69 | end 70 | object ButtonConnect: TButton 71 | Left = 158 72 | Height = 25 73 | Top = 37 74 | Width = 75 75 | Caption = 'Connect' 76 | OnClick = ButtonConnectClick 77 | TabOrder = 2 78 | end 79 | object ButtonDisconnect: TButton 80 | Left = 246 81 | Height = 25 82 | Top = 37 83 | Width = 96 84 | Caption = 'Disconnect' 85 | OnClick = ButtonDisconnectClick 86 | TabOrder = 3 87 | end 88 | end 89 | object Telnet: TLTelnetClientComponent 90 | Host = 'localhost' 91 | Port = 23 92 | OnConnect = TelnetConnect 93 | OnDisconnect = TelnetDisconnect 94 | OnReceive = TelnetReceive 95 | OnError = TelnetError 96 | LocalEcho = True 97 | left = 512 98 | top = 56 99 | end 100 | object MainMenu1: TMainMenu 101 | left = 480 102 | top = 56 103 | object MenuItemFile: TMenuItem 104 | Caption = '&File' 105 | object MenuItemExit: TMenuItem 106 | Caption = 'E&xit' 107 | OnClick = MenuItemExitClick 108 | end 109 | end 110 | object MenuItemHelp: TMenuItem 111 | Caption = '&Help' 112 | object MenuItemAbout: TMenuItem 113 | Caption = '&About' 114 | OnClick = MenuItemAboutClick 115 | end 116 | end 117 | end 118 | end 119 | -------------------------------------------------------------------------------- /lazaruspackage/lnetvisual.template: -------------------------------------------------------------------------------- 1 | <?xml version="1.0"?> 2 | <CONFIG> 3 | <Package Version="3"> 4 | <Name Value="lnetvisual"/> 5 | <Author Value="Aleš Katona, Micha Nelissen"/> 6 | <CompilerOptions> 7 | <Version Value="10"/> 8 | <SearchPaths> 9 | <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> 10 | </SearchPaths> 11 | <Parsing> 12 | <SyntaxOptions> 13 | <CStyleOperator Value="False"/> 14 | <UseAnsiStrings Value="False"/> 15 | </SyntaxOptions> 16 | </Parsing> 17 | <CodeGeneration> 18 | <SmartLinkUnit Value="True"/> 19 | <Optimizations> 20 | <OptimizationLevel Value="2"/> 21 | </Optimizations> 22 | </CodeGeneration> 23 | <Linking> 24 | <Debugging> 25 | <GenerateDebugInfo Value="True"/> 26 | </Debugging> 27 | </Linking> 28 | <Other> 29 | <Verbosity> 30 | <ShowNotes Value="False"/> 31 | <ShowHints Value="False"/> 32 | <ShowGenInfo Value="False"/> 33 | </Verbosity> 34 | <CustomOptions Value="-dLNET_VISUAL"/> 35 | <CompilerPath Value="$(CompPath)"/> 36 | </Other> 37 | </CompilerOptions> 38 | <Description Value="Lightweight Networking Library, or lNet is a networking suite integrated with Lazarus to provide simple and effective means to use TCP, UDP, FTP, SMTP, Telnet and HTTP protocols over the net. 39 | "/> 40 | <License Value="LGPL with exception, see LICENSE and LICENSE.addon 41 | "/> 42 | <Version Minor="6" Release="4"/> 43 | <Files Count="7"> 44 | <Item1> 45 | <Filename Value="lclnet.pas"/> 46 | <UnitName Value="LCLNet"/> 47 | </Item1> 48 | <Item2> 49 | <Filename Value="lnetcomponents.pas"/> 50 | <UnitName Value="lNetComponents"/> 51 | </Item2> 52 | <Item3> 53 | <Filename Value="lnetvisualreg.lrs"/> 54 | <Type Value="LRS"/> 55 | </Item3> 56 | <Item4> 57 | <Filename Value="lnetvisualreg.pas"/> 58 | <HasRegisterProc Value="True"/> 59 | <UnitName Value="LNetVisualReg"/> 60 | </Item4> 61 | <Item5> 62 | <Filename Value="lclgtkeventer.inc"/> 63 | <Type Value="Include"/> 64 | </Item5> 65 | <Item6> 66 | <Filename Value="lclwinceeventer.inc"/> 67 | <Type Value="Include"/> 68 | </Item6> 69 | <Item7> 70 | <Filename Value="lclwineventer.inc"/> 71 | <Type Value="Include"/> 72 | </Item7> 73 | </Files> 74 | <Type Value="RunAndDesignTime"/> 75 | <RequiredPkgs Count="2"> 76 | <Item1> 77 | <PackageName Value="IDEIntf"/> 78 | </Item1> 79 | <Item2> 80 | <PackageName Value="LCL"/> 81 | </Item2> 82 | </RequiredPkgs> 83 | <UsageOptions> 84 | <UnitPath Value="$(PkgOutDir)/"/> 85 | </UsageOptions> 86 | <PublishOptions> 87 | <Version Value="2"/> 88 | <IgnoreBinaries Value="False"/> 89 | </PublishOptions> 90 | </Package> 91 | </CONFIG> 92 | -------------------------------------------------------------------------------- /examples/visual/smtp/smtptest.lpi: -------------------------------------------------------------------------------- 1 | <?xml version="1.0"?> 2 | <CONFIG> 3 | <ProjectOptions> 4 | <Version Value="9"/> 5 | <PathDelim Value="\"/> 6 | <General> 7 | <Flags> 8 | <LRSInOutputDirectory Value="False"/> 9 | </Flags> 10 | <SessionStorage Value="InProjectDir"/> 11 | <MainUnit Value="0"/> 12 | </General> 13 | <BuildModes Count="1"> 14 | <Item1 Name="default" Default="True"/> 15 | </BuildModes> 16 | <PublishOptions> 17 | <Version Value="2"/> 18 | <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> 19 | <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> 20 | </PublishOptions> 21 | <RunParams> 22 | <local> 23 | <FormatVersion Value="1"/> 24 | <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/> 25 | </local> 26 | </RunParams> 27 | <RequiredPackages Count="3"> 28 | <Item1> 29 | <PackageName Value="lnetvisual"/> 30 | <MinVersion Minor="4" Release="1" Valid="True"/> 31 | </Item1> 32 | <Item2> 33 | <PackageName Value="lnetbase"/> 34 | </Item2> 35 | <Item3> 36 | <PackageName Value="LCL"/> 37 | </Item3> 38 | </RequiredPackages> 39 | <Units Count="3"> 40 | <Unit0> 41 | <Filename Value="smtptest.lpr"/> 42 | <IsPartOfProject Value="True"/> 43 | <UnitName Value="smtptest"/> 44 | </Unit0> 45 | <Unit1> 46 | <Filename Value="main.pas"/> 47 | <IsPartOfProject Value="True"/> 48 | <ComponentName Value="MainForm"/> 49 | <ResourceBaseClass Value="Form"/> 50 | <UnitName Value="Main"/> 51 | </Unit1> 52 | <Unit2> 53 | <Filename Value="logs.pas"/> 54 | <IsPartOfProject Value="True"/> 55 | <ComponentName Value="FormLogs"/> 56 | <ResourceBaseClass Value="Form"/> 57 | <UnitName Value="Logs"/> 58 | </Unit2> 59 | </Units> 60 | </ProjectOptions> 61 | <CompilerOptions> 62 | <Version Value="10"/> 63 | <PathDelim Value="\"/> 64 | <SearchPaths> 65 | <SrcPath Value="$(LazarusDir)\lcl;$(LazarusDir)\lcl\interfaces\$(LCLWidgetType)"/> 66 | </SearchPaths> 67 | <Parsing> 68 | <SyntaxOptions> 69 | <UseAnsiStrings Value="False"/> 70 | </SyntaxOptions> 71 | </Parsing> 72 | <CodeGeneration> 73 | <Optimizations> 74 | <OptimizationLevel Value="2"/> 75 | </Optimizations> 76 | </CodeGeneration> 77 | <Linking> 78 | <Debugging> 79 | <UseLineInfoUnit Value="False"/> 80 | <StripSymbols Value="True"/> 81 | </Debugging> 82 | <LinkSmart Value="True"/> 83 | <Options> 84 | <Win32> 85 | <GraphicApplication Value="True"/> 86 | </Win32> 87 | </Options> 88 | </Linking> 89 | <Other> 90 | <CustomOptions Value="-gw"/> 91 | <CompilerPath Value="$(CompPath)"/> 92 | </Other> 93 | </CompilerOptions> 94 | </CONFIG> 95 | -------------------------------------------------------------------------------- /examples/visual/http/main.lrs: -------------------------------------------------------------------------------- 1 | { This is an automatically generated lazarus resource file } 2 | 3 | LazarusResources.Add('TMainForm','FORMDATA',[ 4 | 'TPF0'#9'TMainForm'#8'MainForm'#4'Left'#3#211#1#6'Height'#3'/'#2#3'Top'#3#177 5 | +#0#5'Width'#3#135#2#18'HorzScrollBar.Page'#3#134#2#18'VertScrollBar.Page'#3 6 | +#19#2#13'ActiveControl'#7#8'MemoHTML'#7'Caption'#6#16'HTTP Client Test'#12'C' 7 | +'lientHeight'#3#22#2#11'ClientWidth'#3#135#2#21'Constraints.MinHeight'#3'/'#2 8 | +#20'Constraints.MinWidth'#3#135#2#4'Menu'#7#9'MainMenu1'#10'LCLVersion'#6#7 9 | +'1.8.4.0'#0#6'TPanel'#9'MenuPanel'#4'Left'#2#0#6'Height'#2'P'#3'Top'#3#198#1 10 | +#5'Width'#3#135#2#5'Align'#7#8'alBottom'#12'ClientHeight'#2'P'#11'ClientWidt' 11 | +'h'#3#135#2#8'TabOrder'#2#0#0#6'TLabel'#8'LabelURI'#4'Left'#2#11#6'Height'#2 12 | +#19#3'Top'#2#8#5'Width'#2#27#7'Caption'#6#3'URL'#11'ParentColor'#8#0#0#5'TEd' 13 | +'it'#7'EditURL'#4'Left'#2'0'#6'Height'#2#29#3'Top'#2#5#5'Width'#3#184#1#10'O' 14 | +'nKeyPress'#7#15'EditURLKeyPress'#8'TabOrder'#2#0#4'Text'#6'''http://www.bis' 15 | +'trecode.com/test file.txt'#0#0#7'TButton'#17'ButtonSendRequest'#4'Left'#3 16 | +#240#1#6'Height'#2#25#3'Top'#2#5#5'Width'#3#144#0#25'BorderSpacing.InnerBord' 17 | +'er'#2#4#7'Caption'#6#12'Send Request'#7'OnClick'#7#22'ButtonSendRequestClic' 18 | +'k'#8'TabOrder'#2#1#0#0#5'TEdit'#8'EditPOST'#4'Left'#2'0'#6'Height'#2#29#3'T' 19 | +'op'#2'('#5'Width'#3#184#1#8'OnChange'#7#14'EditPOSTChange'#8'TabOrder'#2#2#0 20 | +#0#6'TLabel'#9'LabelPOST'#4'Left'#2#1#6'Height'#2#19#3'Top'#2'-'#5'Width'#2 21 | +'&'#7'Caption'#6#4'POST'#11'ParentColor'#8#0#0#9'TCheckBox'#12'CheckBoxPOST' 22 | +#4'Left'#3#240#1#6'Height'#2#22#3'Top'#2','#5'Width'#2'Z'#7'Caption'#6#8'Use' 23 | +' POST'#8'TabOrder'#2#3#0#0#0#5'TMemo'#10'MemoStatus'#4'Left'#2#0#6'Height'#2 24 | +'O'#3'Top'#3'w'#1#5'Width'#3#135#2#5'Align'#7#8'alBottom'#10'ScrollBars'#7#14 25 | +'ssAutoVertical'#8'TabOrder'#2#1#0#0#5'TMemo'#8'MemoHTML'#4'Left'#2#0#6'Heig' 26 | +'ht'#3'm'#1#3'Top'#2#0#5'Width'#3#135#2#5'Align'#7#8'alClient'#10'ScrollBars' 27 | +#7#10'ssAutoBoth'#8'TabOrder'#2#2#0#0#6'TPanel'#8'PanelSep'#4'Left'#2#0#6'He' 28 | +'ight'#2#10#3'Top'#3'm'#1#5'Width'#3#135#2#5'Align'#7#8'alBottom'#8'TabOrder' 29 | +#2#3#0#0#21'TLHTTPClientComponent'#10'HTTPClient'#10'OnCanWrite'#7#18'HTTPCl' 30 | +'ientCanWrite'#11'OnDoneInput'#7#19'HTTPClientDoneInput'#7'OnInput'#7#15'HTT' 31 | +'PClientInput'#16'OnProcessHeaders'#7#24'HTTPClientProcessHeaders'#12'OnDisc' 32 | +'onnect'#7#20'HTTPClientDisconnect'#7'OnError'#7#15'HTTPClientError'#7'Timeo' 33 | +'ut'#2#0#7'Session'#7#3'SSL'#4'left'#3#216#1#3'top'#3'`'#1#0#0#9'TMainMenu'#9 34 | +'MainMenu1'#4'left'#3'H'#2#3'top'#3'`'#1#0#9'TMenuItem'#12'MenuItemFile'#7'C' 35 | +'aption'#6#5'&File'#0#9'TMenuItem'#12'MenuItemExit'#7'Caption'#6#5'E&xit'#7 36 | +'OnClick'#7#17'MenuItemExitClick'#0#0#0#9'TMenuItem'#12'MenuItemHelp'#7'Capt' 37 | +'ion'#6#5'&Help'#0#9'TMenuItem'#13'MenuItemAbout'#7'Caption'#6#6'&About'#7'O' 38 | +'nClick'#7#18'MenuItemAboutClick'#0#0#0#0#21'TLSSLSessionComponent'#3'SSL'#6 39 | +'Method'#7#8'msSslTLS'#9'SSLActive'#8#12'OnSSLConnect'#7#13'SSLSSLConnect'#4 40 | +'left'#3#216#1#3'top'#3#152#1#0#0#0 41 | ]); 42 | -------------------------------------------------------------------------------- /lazaruspackage/lnetvisual.lpk: -------------------------------------------------------------------------------- 1 | <?xml version="1.0"?> 2 | <CONFIG> 3 | <Package Version="3"> 4 | <Name Value="lnetvisual"/> 5 | <Author Value="Aleš Katona, Micha Nelissen"/> 6 | <CompilerOptions> 7 | <Version Value="10"/> 8 | <SearchPaths> 9 | <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> 10 | </SearchPaths> 11 | <Parsing> 12 | <SyntaxOptions> 13 | <CStyleOperator Value="False"/> 14 | <UseAnsiStrings Value="False"/> 15 | </SyntaxOptions> 16 | </Parsing> 17 | <CodeGeneration> 18 | <SmartLinkUnit Value="True"/> 19 | <Optimizations> 20 | <OptimizationLevel Value="2"/> 21 | </Optimizations> 22 | </CodeGeneration> 23 | <Linking> 24 | <Debugging> 25 | <GenerateDebugInfo Value="True"/> 26 | </Debugging> 27 | </Linking> 28 | <Other> 29 | <Verbosity> 30 | <ShowNotes Value="False"/> 31 | <ShowHints Value="False"/> 32 | <ShowGenInfo Value="False"/> 33 | </Verbosity> 34 | <CompilerMessages> 35 | <UseMsgFile Value="True"/> 36 | </CompilerMessages> 37 | <CustomOptions Value="-dLNET_VISUAL"/> 38 | <CompilerPath Value="$(CompPath)"/> 39 | </Other> 40 | </CompilerOptions> 41 | <Description Value="Lightweight Networking Library, or lNet is a networking suite integrated with Lazarus to provide simple and effective means to use TCP, UDP, FTP, SMTP, Telnet and HTTP protocols over the net. 42 | "/> 43 | <License Value="LGPL with exception, see LICENSE and LICENSE.addon 44 | "/> 45 | <Version Minor="6" Release="6"/> 46 | <Files Count="7"> 47 | <Item1> 48 | <Filename Value="lclnet.pas"/> 49 | <UnitName Value="LCLNet"/> 50 | </Item1> 51 | <Item2> 52 | <Filename Value="lnetcomponents.pas"/> 53 | <UnitName Value="lNetComponents"/> 54 | </Item2> 55 | <Item3> 56 | <Filename Value="lnetvisualreg.lrs"/> 57 | <Type Value="LRS"/> 58 | </Item3> 59 | <Item4> 60 | <Filename Value="lnetvisualreg.pas"/> 61 | <HasRegisterProc Value="True"/> 62 | <UnitName Value="LNetVisualReg"/> 63 | </Item4> 64 | <Item5> 65 | <Filename Value="lclgtkeventer.inc"/> 66 | <Type Value="Include"/> 67 | </Item5> 68 | <Item6> 69 | <Filename Value="lclwinceeventer.inc"/> 70 | <Type Value="Include"/> 71 | </Item6> 72 | <Item7> 73 | <Filename Value="lclwineventer.inc"/> 74 | <Type Value="Include"/> 75 | </Item7> 76 | </Files> 77 | <Type Value="RunAndDesignTime"/> 78 | <RequiredPkgs Count="3"> 79 | <Item1> 80 | <PackageName Value="IDEIntf"/> 81 | </Item1> 82 | <Item2> 83 | <PackageName Value="LCL"/> 84 | </Item2> 85 | <Item3> 86 | <PackageName Value="lnetbase"/> 87 | <MinVersion Minor="6" Valid="True"/> 88 | </Item3> 89 | </RequiredPkgs> 90 | <UsageOptions> 91 | <UnitPath Value="$(PkgOutDir)"/> 92 | </UsageOptions> 93 | <PublishOptions> 94 | <Version Value="2"/> 95 | <IgnoreBinaries Value="False"/> 96 | </PublishOptions> 97 | </Package> 98 | </CONFIG> 99 | -------------------------------------------------------------------------------- /lazaruspackage/lclgtkeventer.inc: -------------------------------------------------------------------------------- 1 | 2 | uses 3 | lCommon; 4 | 5 | const 6 | G_IO_IN = 1; 7 | G_IO_OUT = 4; 8 | G_IO_PRI = 2; 9 | G_IO_ERR = 8; 10 | G_IO_HUP = 16; 11 | G_IO_NVAL = 32; 12 | 13 | ALL_FLAGS = G_IO_ERR or G_IO_NVAL or G_IO_HUP or G_IO_PRI or G_IO_IN or G_IO_OUT; 14 | 15 | procedure TLCLEventer.HandleIgnoreError(aHandle: TLHandle); 16 | begin 17 | // TODO fix or remove alltogether 18 | end; 19 | 20 | procedure TLCLEventer.HandleIgnoreWrite(aHandle: TLHandle); 21 | var 22 | LHI: PLCLHandleInfo; 23 | begin 24 | LHI := GetInternalData(aHandle); 25 | if aHandle.IgnoreWrite then 26 | LHI^.Flags := LHI^.Flags and (not G_IO_OUT) 27 | else 28 | LHI^.Flags := LHI^.Flags or G_IO_OUT; 29 | SetEventHandlerFlags(LHI^.EventHandle, LHI^.Flags); 30 | end; 31 | 32 | procedure TLCLEventer.HandleIgnoreRead(aHandle: TLHandle); 33 | var 34 | LHI: PLCLHandleInfo; 35 | begin 36 | LHI := GetInternalData(aHandle); 37 | if aHandle.IgnoreRead then 38 | LHI^.Flags := LHI^.Flags and (not G_IO_IN) 39 | else 40 | LHI^.Flags := LHI^.Flags or G_IO_IN; 41 | SetEventHandlerFlags(LHI^.EventHandle, LHI^.Flags); 42 | end; 43 | 44 | procedure TLCLEventer.HandleEvents(aData: PtrInt; aFlags: DWord); 45 | var 46 | LHI: PLCLHandleInfo; 47 | Temp: TLHandle; 48 | begin 49 | LHI := PLCLHandleInfo(aData); 50 | Temp := LHI^.Handle; 51 | if not FInLoop then begin 52 | FInLoop := True; 53 | 54 | if aFlags and G_IO_OUT = G_IO_OUT then 55 | if not Temp.Dispose and Assigned(Temp.OnWrite) then 56 | Temp.OnWrite(Temp); 57 | 58 | if aFlags and G_IO_IN = G_IO_IN then 59 | if not Temp.Dispose and Assigned(Temp.OnRead) then 60 | Temp.OnRead(Temp); 61 | 62 | if (not Temp.Dispose) 63 | and ((aFlags and G_IO_ERR = G_IO_ERR) 64 | or (aFlags and G_IO_NVAL = G_IO_NVAL) 65 | or (aFlags and G_IO_HUP = G_IO_HUP)) then 66 | if Assigned(Temp.OnError) then 67 | Temp.OnError(Temp, 'Handle error' + LStrError(LSocketError)); 68 | 69 | SetEventHandlerFlags(LHI^.EventHandle, LHI^.Flags); 70 | 71 | if Temp.Dispose then 72 | AddForFree(Temp); 73 | FInLoop := False; 74 | 75 | if Assigned(FFreeRoot) then 76 | FreeHandles; 77 | end else 78 | SetEventHandlerFlags(LHI^.EventHandle, 0); 79 | end; 80 | 81 | function TLCLEventer.AddHandle(aHandle: TLHandle): Boolean; 82 | var 83 | LHI: PLCLHandleInfo; 84 | begin 85 | Result := False; 86 | 87 | SetHandleEventer(aHandle); 88 | 89 | LHI := GetMem(SizeOf(TLCLHandleInfo)); 90 | LHI^.Handle := aHandle; 91 | SetInternalData(aHandle, LHI); 92 | LHI^.EventHandle := AddEventHandler(aHandle.Handle, ALL_FLAGS, 93 | @HandleEvents, PtrUInt(LHI)); 94 | LHI^.Flags := ALL_FLAGS; 95 | if not Assigned(LHI^.EventHandle) then 96 | Bail('Error on handler', -1) 97 | else 98 | Result := True; 99 | end; 100 | 101 | procedure TLCLEventer.InternalUnplugHandle(aHandle: TLHandle); 102 | var 103 | LHI: PLCLHandleInfo; 104 | begin 105 | LHI := GetInternalData(aHandle); 106 | RemoveEventHandler(LHI^.EventHandle); 107 | FreeMem(LHI); 108 | inherited InternalUnplugHandle(aHandle); 109 | end; 110 | 111 | 112 | -------------------------------------------------------------------------------- /lib/lmimetypes.pp: -------------------------------------------------------------------------------- 1 | { Mime types helper 2 | 3 | Copyright (C) 2006-2008 Micha Nelissen 4 | 5 | This library is Free software; you can redistribute it and/or modify it 6 | under the terms of the GNU Library General Public License as published by 7 | the Free Software Foundation; either version 2 of the License, or (at your 8 | option) any later version. 9 | 10 | This program is diStributed in the hope that it will be useful, but WITHOUT 11 | ANY WARRANTY; withOut even the implied warranty of MERCHANTABILITY or 12 | FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License 13 | for more details. 14 | 15 | You should have received a Copy of the GNU Library General Public License 16 | along with This library; if not, Write to the Free Software Foundation, 17 | Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 18 | 19 | This license has been modified. See file LICENSE.ADDON for more information. 20 | Should you find these sources without a LICENSE File, please contact 21 | me at ales@chello.sk 22 | } 23 | 24 | unit lMimeTypes; 25 | 26 | {$mode objfpc}{$h+} 27 | 28 | interface 29 | 30 | uses 31 | classes, sysutils, strutils; 32 | 33 | type 34 | TStringObject = class(TObject) 35 | Str: string; 36 | end; 37 | 38 | procedure InitMimeList(const aFileName: string); 39 | 40 | var 41 | MimeList: TStringList = nil; 42 | 43 | implementation 44 | 45 | var 46 | MimeFileName: string; 47 | 48 | procedure InitMimeList(const aFileName: string); 49 | var 50 | MimeFile: Text; 51 | lPos, lNextPos: integer; 52 | lLine, lName: string; 53 | lStrObj: TStringObject; 54 | lBuffer: array[1..32*1024] of byte; 55 | begin 56 | if not Assigned(MimeList) then begin 57 | MimeFileName := aFileName; 58 | MimeList := TStringList.Create; 59 | if FileExists(MimeFileName) then 60 | begin 61 | Assign(MimeFile, MimeFileName); 62 | Reset(MimeFile); 63 | SetTextBuf(MimeFile, lBuffer); 64 | while not Eof(MimeFile) do 65 | begin 66 | ReadLn(MimeFile, lLine); 67 | if (Length(lLine) = 0) or (lLine[1] = '#') then 68 | continue; 69 | 70 | lPos := Pos(#9, lLine); 71 | if lPos = 0 then 72 | continue; 73 | lName := Copy(lLine, 1, lPos-1); 74 | 75 | while (lPos <= Length(lLine)) and (lLine[lPos] in [#9,' ']) do 76 | Inc(lPos); 77 | if lPos > Length(lLine) then 78 | continue; 79 | repeat 80 | lNextPos := PosEx(' ', lLine, lPos); 81 | if lNextPos = 0 then 82 | lNextPos := Length(lLine)+1; 83 | lStrObj := TStringObject.Create; 84 | lStrObj.Str := lName; 85 | MimeList.AddObject('.'+Copy(lLine, lPos, lNextPos-lPos), lStrObj); 86 | lPos := lNextPos+1; 87 | until lPos > Length(lLine); 88 | end; 89 | close(MimeFile); 90 | end; 91 | MimeList.Sorted := true; 92 | end; 93 | end; 94 | 95 | procedure FreeMimeList; 96 | var 97 | I: integer; 98 | begin 99 | if Assigned(MimeList) then begin 100 | for I := 0 to MimeList.Count - 1 do 101 | MimeList.Objects[I].Free; 102 | FreeAndNil(MimeList); 103 | end; 104 | end; 105 | 106 | finalization 107 | FreeMimeList; 108 | end. 109 | -------------------------------------------------------------------------------- /examples/visual/telnet/main.pas: -------------------------------------------------------------------------------- 1 | unit main; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | interface 6 | 7 | uses 8 | Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, 9 | lNetComponents, StdCtrls, lNet, Menus; 10 | 11 | type 12 | 13 | { TFormMain } 14 | 15 | TFormMain = class(TForm) 16 | ButtonDisconnect: TButton; 17 | ButtonConnect: TButton; 18 | EditSend: TEdit; 19 | EditHost: TEdit; 20 | EditPort: TEdit; 21 | GroupBoxServer: TGroupBox; 22 | LabelPort: TLabel; 23 | LabelHost: TLabel; 24 | MainMenu1: TMainMenu; 25 | MenuItemAbout: TMenuItem; 26 | MenuItemFile: TMenuItem; 27 | MenuItemHelp: TMenuItem; 28 | MenuItemExit: TMenuItem; 29 | Telnet: TLTelnetClientComponent; 30 | MemoText: TMemo; 31 | procedure ButtonConnectClick(Sender: TObject); 32 | procedure ButtonDisconnectClick(Sender: TObject); 33 | procedure EditSendKeyPress(Sender: TObject; var Key: char); 34 | procedure FormShow(Sender: TObject); 35 | procedure MenuItemAboutClick(Sender: TObject); 36 | procedure MenuItemExitClick(Sender: TObject); 37 | procedure TelnetConnect(aSocket: TLSocket); 38 | procedure TelnetDisconnect(aSocket: TLSocket); 39 | procedure TelnetError(const msg: string; aSocket: TLSocket); 40 | procedure TelnetReceive(aSocket: TLSocket); 41 | private 42 | { private declarations } 43 | public 44 | { public declarations } 45 | end; 46 | 47 | var 48 | FormMain: TFormMain; 49 | 50 | implementation 51 | 52 | { TFormMain } 53 | 54 | procedure TFormMain.ButtonConnectClick(Sender: TObject); 55 | begin 56 | Telnet.Connect(EditHost.Text, StrToInt(EditPort.Text)); 57 | end; 58 | 59 | procedure TFormMain.ButtonDisconnectClick(Sender: TObject); 60 | begin 61 | if Telnet.Connected then begin 62 | Telnet.Disconnect; 63 | MemoText.Append('Disconnected from server'); 64 | end; 65 | end; 66 | 67 | procedure TFormMain.EditSendKeyPress(Sender: TObject; var Key: char); 68 | begin 69 | if Key = #13 then begin 70 | Telnet.SendMessage(EditSend.Text + #13#10); // we must send the terminator so the message is considered complete! 71 | EditSend.Text := ''; 72 | end; 73 | end; 74 | 75 | procedure TFormMain.FormShow(Sender: TObject); 76 | begin 77 | EditHost.SetFocus; // for gtk2 so it's not confusing for the memo which is readonly 78 | end; 79 | 80 | procedure TFormMain.MenuItemAboutClick(Sender: TObject); 81 | begin 82 | MessageDlg('Copyright (c) 2008 by Aleš Katona. All rights deserved! :)', mtInformation, [mbOK], 0); 83 | end; 84 | 85 | procedure TFormMain.MenuItemExitClick(Sender: TObject); 86 | begin 87 | Close; 88 | end; 89 | 90 | procedure TFormMain.TelnetConnect(aSocket: TLSocket); 91 | begin 92 | MemoText.Append('Connected!'); 93 | end; 94 | 95 | procedure TFormMain.TelnetDisconnect(aSocket: TLSocket); 96 | begin 97 | MemoText.Append('Disconnected!'); 98 | end; 99 | 100 | procedure TFormMain.TelnetError(const msg: string; aSocket: TLSocket); 101 | begin 102 | MemoText.Append(msg); 103 | end; 104 | 105 | procedure TFormMain.TelnetReceive(aSocket: TLSocket); 106 | var 107 | s: string; 108 | begin 109 | if Telnet.GetMessage(s) > 0 then 110 | MemoText.Append(s); 111 | end; 112 | 113 | initialization 114 | {$I main.lrs} 115 | 116 | end. 117 | 118 | -------------------------------------------------------------------------------- /lazaruspackage/lclwineventer.inc: -------------------------------------------------------------------------------- 1 | 2 | uses 3 | lCommon, WinSock2, Win32Int, Win32Def, avglvltree; // for the guy below 4 | 5 | const 6 | ALL_FLAGS = FD_ACCEPT or FD_READ or FD_CLOSE or FD_CONNECT or FD_WRITE; 7 | 8 | var 9 | WaitSockets: TPointerToPointerTree; 10 | 11 | procedure TLCLEventer.HandleIgnoreError(aHandle: TLHandle); 12 | begin 13 | // don't do anything 14 | end; 15 | 16 | procedure TLCLEventer.HandleIgnoreWrite(aHandle: TLHandle); 17 | begin 18 | // don't do anything 19 | end; 20 | 21 | procedure TLCLEventer.HandleIgnoreRead(aHandle: TLHandle); 22 | begin 23 | // don't do anything 24 | end; 25 | 26 | function TLCLEventer.HandleEvents(aHandle: THandle; aFlags: DWord): LongInt; 27 | var 28 | Temp: TLHandle; 29 | buf: Byte; 30 | begin 31 | Result := 0; 32 | 33 | if WaitSockets.Contains(Pointer(aHandle)) then 34 | Temp := TLHandle(WaitSockets[Pointer(aHandle)]) 35 | else 36 | Exit; 37 | 38 | if not FInLoop then begin 39 | FInLoop := True; 40 | 41 | if aFlags and FD_CONNECT = FD_CONNECT then 42 | if not Temp.Dispose and Assigned(Temp.OnWrite) then 43 | Temp.OnWrite(Temp); 44 | 45 | if aFlags and FD_READ = FD_READ then 46 | if not Temp.Dispose and Assigned(Temp.OnRead) then begin 47 | Temp.OnRead(Temp); 48 | recv(Temp.Handle, @buf, SizeOf(buf), MSG_PEEK); 49 | end; 50 | 51 | if aFlags and FD_CLOSE = FD_CLOSE then 52 | if not Temp.Dispose and Assigned(Temp.OnRead) then 53 | Temp.OnRead(Temp); 54 | 55 | if aFlags and FD_ACCEPT = FD_ACCEPT then 56 | if not Temp.Dispose and Assigned(Temp.OnRead) then 57 | Temp.OnRead(Temp); 58 | 59 | if aFlags and FD_WRITE = FD_WRITE then 60 | if not Temp.Dispose and Assigned(Temp.OnWrite) then 61 | Temp.OnWrite(Temp); 62 | 63 | if Temp.Dispose then 64 | AddForFree(Temp); 65 | 66 | FInLoop := False; 67 | 68 | if Assigned(FFreeRoot) then 69 | FreeHandles; 70 | end; 71 | end; 72 | 73 | constructor TLCLEventer.Create; 74 | begin 75 | inherited; 76 | TWin32WidgetSet(WidgetSet).OnAsyncSocketMsg := @HandleEvents; 77 | end; 78 | 79 | function TLCLEventer.AddHandle(aHandle: TLHandle): Boolean; 80 | begin 81 | Result := True; 82 | SetHandleEventer(aHandle); 83 | WaitSockets.Values[Pointer(aHandle.Handle)] := aHandle; 84 | if WSAAsyncSelect(aHandle.Handle, TWin32WidgetSet(WidgetSet).AppHandle, 85 | WM_LCL_SOCK_ASYNC, ALL_FLAGS) <> 0 then 86 | Bail('Error on AsyncSelect', WSAGetLastError); 87 | end; 88 | 89 | procedure TLCLEventer.UnregisterHandle(aHandle: TLHandle); 90 | begin 91 | if WaitSockets.Contains(Pointer(aHandle.Handle)) then begin 92 | WaitSockets.Remove(Pointer(aHandle.Handle)); 93 | 94 | if WSAAsyncSelect(aHandle.Handle, TWin32WidgetSet(WidgetSet).AppHandle, 95 | 0, 0) <> 0 then 96 | Bail('Error on AsyncSelect', WSAGetLastError); 97 | end; 98 | end; 99 | 100 | procedure TLCLEventer.InternalUnplugHandle(aHandle: TLHandle); 101 | begin 102 | UnregisterHandle(aHandle); 103 | inherited InternalUnplugHandle(aHandle); 104 | end; 105 | 106 | initialization 107 | WaitSockets := TPointerToPointerTree.Create; 108 | 109 | finalization 110 | WaitSockets.Free; 111 | 112 | 113 | -------------------------------------------------------------------------------- /lib/lstrbuffer.pp: -------------------------------------------------------------------------------- 1 | { Efficient string buffer helper 2 | 3 | Copyright (C) 2006-2008 Micha Nelissen 4 | 5 | This library is Free software; you can redistribute it and/or modify it 6 | under the terms of the GNU Library General Public License as published by 7 | the Free Software Foundation; either version 2 of the License, or (at your 8 | option) any later version. 9 | 10 | This program is diStributed in the hope that it will be useful, but WITHOUT 11 | ANY WARRANTY; withOut even the implied warranty of MERCHANTABILITY or 12 | FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License 13 | for more details. 14 | 15 | You should have received a Copy of the GNU Library General Public License 16 | along with This library; if not, Write to the Free Software Foundation, 17 | Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 18 | 19 | This license has been modified. See file LICENSE.ADDON for more information. 20 | Should you find these sources without a LICENSE File, please contact 21 | me at ales@chello.sk 22 | } 23 | 24 | unit lStrBuffer; 25 | 26 | {$mode objfpc}{$h+} 27 | 28 | interface 29 | 30 | type 31 | PStringBuffer = ^TStringBuffer; 32 | TStringBuffer = record 33 | Memory: pchar; 34 | Pos: pchar; 35 | end; 36 | 37 | function InitStringBuffer(InitialSize: integer): TStringBuffer; 38 | procedure AppendString(var ABuffer: TStringBuffer; const ASource: string); overload; 39 | procedure AppendString(var ABuffer: TStringBuffer; const ASource: shortstring); overload; 40 | procedure AppendString(var ABuffer: TStringBuffer; ASource: pointer; ALength: PtrUInt); overload; 41 | procedure AppendString(var ABuffer: TStringBuffer; ASource: pchar); overload; 42 | procedure AppendChar(var ABuffer: TStringBuffer; AChar: char); 43 | procedure ClearStringBuffer(var ABuffer: TStringBuffer); 44 | 45 | implementation 46 | 47 | function InitStringBuffer(InitialSize: integer): TStringBuffer; 48 | begin 49 | Result.Memory := GetMem(InitialSize); 50 | Result.Pos := Result.Memory; 51 | end; 52 | 53 | procedure AppendString(var ABuffer: TStringBuffer; ASource: pointer; ALength: PtrUInt); 54 | var 55 | lPos, lSize: PtrUInt; 56 | begin 57 | if ALength = 0 then exit; 58 | lPos := PtrUInt(ABuffer.Pos - ABuffer.Memory); 59 | lSize := PtrUInt(MemSize(ABuffer.Memory)); 60 | { reserve 2 extra spaces } 61 | if lPos + ALength + 2 >= lSize then 62 | begin 63 | ReallocMem(ABuffer.Memory, lPos + ALength + lSize); 64 | ABuffer.Pos := ABuffer.Memory + lPos; 65 | end; 66 | Move(ASource^, ABuffer.Pos^, ALength); 67 | Inc(ABuffer.Pos, ALength); 68 | end; 69 | 70 | procedure AppendString(var ABuffer: TStringBuffer; ASource: pchar); 71 | begin 72 | if ASource = nil then exit; 73 | AppendString(ABuffer, ASource, StrLen(ASource)); 74 | end; 75 | 76 | procedure AppendString(var ABuffer: TStringBuffer; const ASource: shortstring); 77 | begin 78 | AppendString(ABuffer, @ASource[1], Length(ASource)); 79 | end; 80 | 81 | procedure AppendString(var ABuffer: TStringBuffer; const ASource: string); 82 | begin 83 | AppendString(ABuffer, PChar(ASource), Length(ASource)); 84 | end; 85 | 86 | procedure AppendChar(var ABuffer: TStringBuffer; AChar: char); 87 | begin 88 | ABuffer.Pos^ := AChar; 89 | Inc(ABuffer.Pos); 90 | end; 91 | 92 | procedure ClearStringBuffer(var ABuffer: TStringBuffer); 93 | begin 94 | ABuffer.Pos := ABuffer.Memory; 95 | end; 96 | 97 | end. 98 | -------------------------------------------------------------------------------- /lazaruspackage/lclwinceeventer.inc: -------------------------------------------------------------------------------- 1 | 2 | uses 3 | lCommon, WinSock2, WinCEInt, WinCEDef, avglvltree; // for the guy below 4 | 5 | const 6 | ALL_FLAGS = FD_ACCEPT or FD_READ or FD_CLOSE or FD_CONNECT or FD_WRITE; 7 | 8 | var 9 | WaitSockets: TPointerToPointerTree; 10 | 11 | procedure TLCLEventer.HandleIgnoreError(aHandle: TLHandle); 12 | begin 13 | // don't do anything 14 | end; 15 | 16 | procedure TLCLEventer.HandleIgnoreWrite(aHandle: TLHandle); 17 | begin 18 | // don't do anything 19 | end; 20 | 21 | procedure TLCLEventer.HandleIgnoreRead(aHandle: TLHandle); 22 | begin 23 | // don't do anything 24 | end; 25 | 26 | function TLCLEventer.HandleEvents(aHandle: THandle; aFlags: DWord): LongInt; 27 | var 28 | Temp: TLHandle; 29 | begin 30 | Result := 0; 31 | 32 | if WaitSockets.Contains(Pointer(aHandle)) then 33 | Temp := TLHandle(WaitSockets[Pointer(aHandle)]) 34 | else 35 | Exit; 36 | 37 | if not FInLoop then begin 38 | FInLoop := True; 39 | 40 | if aFlags and FD_CONNECT = FD_CONNECT then 41 | if not Temp.Dispose and Assigned(Temp.OnWrite) then 42 | Temp.OnWrite(Temp); 43 | 44 | if aFlags and FD_READ = FD_READ then 45 | if not Temp.Dispose and Assigned(Temp.OnRead) then 46 | Temp.OnRead(Temp); 47 | 48 | if aFlags and FD_CLOSE = FD_CLOSE then 49 | if not Temp.Dispose and Assigned(Temp.OnRead) then 50 | Temp.OnRead(Temp); 51 | 52 | if aFlags and FD_ACCEPT = FD_ACCEPT then 53 | if not Temp.Dispose and Assigned(Temp.OnRead) then 54 | Temp.OnRead(Temp); 55 | 56 | if aFlags and FD_WRITE = FD_WRITE then 57 | if not Temp.Dispose and Assigned(Temp.OnWrite) then 58 | Temp.OnWrite(Temp); 59 | 60 | if Temp.Dispose then 61 | AddForFree(Temp); 62 | 63 | FInLoop := False; 64 | 65 | if Assigned(FFreeRoot) then 66 | FreeHandles; 67 | end; 68 | end; 69 | 70 | constructor TLCLEventer.Create; 71 | begin 72 | inherited; 73 | TWinCEWidgetSet(WidgetSet).OnAsyncSocketMsg := @HandleEvents; 74 | end; 75 | 76 | function TLCLEventer.AddHandle(aHandle: TLHandle): Boolean; 77 | begin 78 | Result := True; 79 | SetHandleEventer(aHandle); 80 | WaitSockets.Values[Pointer(aHandle.Handle)] := aHandle; 81 | if WSAAsyncSelect(aHandle.Handle, TWinCEWidgetSet(WidgetSet).AppHandle, 82 | WM_LCL_SOCK_ASYNC, ALL_FLAGS) <> 0 then 83 | Bail('Error on AsyncSelect', WSAGetLastError); 84 | end; 85 | 86 | procedure TLCLEventer.UnregisterHandle(aHandle: TLHandle); 87 | begin 88 | if WaitSockets.Contains(Pointer(aHandle.Handle)) then begin 89 | WaitSockets.Remove(Pointer(aHandle.Handle)); 90 | 91 | if WSAAsyncSelect(aHandle.Handle, TWinCEWidgetSet(WidgetSet).AppHandle, 92 | 0, 0) <> 0 then 93 | Bail('Error on AsyncSelect', WSAGetLastError); 94 | end; 95 | end; 96 | 97 | procedure TLCLEventer.InternalUnplugHandle(aHandle: TLHandle); 98 | begin 99 | WaitSockets.Remove(Pointer(aHandle.Handle)); 100 | 101 | if WSAAsyncSelect(aHandle.Handle, TWinCEWidgetSet(WidgetSet).AppHandle, 102 | WM_LCL_SOCK_ASYNC, ALL_FLAGS) <> 0 then 103 | Bail('Error on AsyncSelect', WSAGetLastError); 104 | 105 | inherited InternalUnplugHandle(aHandle); 106 | end; 107 | 108 | initialization 109 | WaitSockets := TPointerToPointerTree.Create; 110 | 111 | finalization 112 | WaitSockets.Free; 113 | 114 | 115 | -------------------------------------------------------------------------------- /lib/fastcgi_base.pp: -------------------------------------------------------------------------------- 1 | unit fastcgi_base; 2 | 3 | interface 4 | 5 | { 6 | Automatically converted by H2Pas 0.99.16 from fastcgi.h 7 | The following command line parameters were used: 8 | fastcgi.h 9 | } 10 | 11 | {$IFDEF FPC} 12 | {$PACKRECORDS C} 13 | {$ENDIF} 14 | 15 | 16 | { 17 | * Listening socket file number 18 | } 19 | 20 | const 21 | FCGI_LISTENSOCK_FILENO = 0; 22 | 23 | type 24 | 25 | PFCGI_Header = ^FCGI_Header; 26 | FCGI_Header = record 27 | version : byte; 28 | reqtype : byte; 29 | requestIdB1 : byte; 30 | requestIdB0 : byte; 31 | contentLengthB1 : byte; 32 | contentLengthB0 : byte; 33 | paddingLength : byte; 34 | reserved : byte; 35 | end; 36 | { 37 | * Number of bytes in a FCGI_Header. Future versions of the protocol 38 | * will not reduce this number. 39 | } 40 | 41 | const 42 | FCGI_HEADER_LEN = 8; 43 | 44 | { 45 | * Value for version component of FCGI_Header 46 | } 47 | FCGI_VERSION_1 = 1; 48 | 49 | { 50 | * Values for type component of FCGI_Header 51 | } 52 | FCGI_BEGIN_REQUEST = 1; 53 | FCGI_ABORT_REQUEST = 2; 54 | FCGI_END_REQUEST = 3; 55 | FCGI_PARAMS = 4; 56 | FCGI_STDIN = 5; 57 | FCGI_STDOUT = 6; 58 | FCGI_STDERR = 7; 59 | FCGI_DATA = 8; 60 | FCGI_GET_VALUES = 9; 61 | FCGI_GET_VALUES_RESULT = 10; 62 | FCGI_UNKNOWN_TYPE = 11; 63 | FCGI_MAXTYPE = FCGI_UNKNOWN_TYPE; 64 | 65 | { 66 | * Value for requestId component of FCGI_Header 67 | } 68 | FCGI_NULL_REQUEST_ID = 0; 69 | 70 | type 71 | FCGI_BeginRequestBody = record 72 | roleB1 : byte; 73 | roleB0 : byte; 74 | flags : byte; 75 | reserved : array[0..4] of byte; 76 | end; 77 | 78 | FCGI_BeginRequestRecord = record 79 | header : FCGI_Header; 80 | body : FCGI_BeginRequestBody; 81 | end; 82 | 83 | { 84 | * Mask for flags component of FCGI_BeginRequestBody 85 | } 86 | 87 | const 88 | FCGI_KEEP_CONN = 1; 89 | 90 | { 91 | * Values for role component of FCGI_BeginRequestBody 92 | } 93 | 94 | FCGI_RESPONDER = 1; 95 | FCGI_AUTHORIZER = 2; 96 | FCGI_FILTER = 3; 97 | 98 | type 99 | 100 | FCGI_EndRequestBody = record 101 | appStatusB3 : byte; 102 | appStatusB2 : byte; 103 | appStatusB1 : byte; 104 | appStatusB0 : byte; 105 | protocolStatus : byte; 106 | reserved : array[0..2] of byte; 107 | end; 108 | 109 | FCGI_EndRequestRecord = record 110 | header : FCGI_Header; 111 | body : FCGI_EndRequestBody; 112 | end; 113 | 114 | { 115 | * Values for protocolStatus component of FCGI_EndRequestBody 116 | } 117 | 118 | const 119 | FCGI_REQUEST_COMPLETE = 0; 120 | FCGI_CANT_MPX_CONN = 1; 121 | FCGI_OVERLOADED = 2; 122 | FCGI_UNKNOWN_ROLE = 3; 123 | 124 | { 125 | * Variable names for FCGI_GET_VALUES / FCGI_GET_VALUES_RESULT records 126 | } 127 | 128 | FCGI_MAX_CONNS = 'FCGI_MAX_CONNS'; 129 | FCGI_MAX_REQS = 'FCGI_MAX_REQS'; 130 | FCGI_MPXS_CONNS = 'FCGI_MPXS_CONNS'; 131 | 132 | type 133 | 134 | FCGI_UnknownTypeBody = record 135 | _type : byte; 136 | reserved : array[0..6] of byte; 137 | end; 138 | 139 | FCGI_UnknownTypeRecord = record 140 | header : FCGI_Header; 141 | body : FCGI_UnknownTypeBody; 142 | end; 143 | 144 | implementation 145 | 146 | end. 147 | -------------------------------------------------------------------------------- /examples/visual/http/main.lfm: -------------------------------------------------------------------------------- 1 | object MainForm: TMainForm 2 | Left = 467 3 | Height = 559 4 | Top = 177 5 | Width = 647 6 | HorzScrollBar.Page = 646 7 | VertScrollBar.Page = 531 8 | ActiveControl = MemoHTML 9 | Caption = 'HTTP Client Test' 10 | ClientHeight = 534 11 | ClientWidth = 647 12 | Constraints.MinHeight = 559 13 | Constraints.MinWidth = 647 14 | Menu = MainMenu1 15 | LCLVersion = '1.8.4.0' 16 | object MenuPanel: TPanel 17 | Left = 0 18 | Height = 80 19 | Top = 454 20 | Width = 647 21 | Align = alBottom 22 | ClientHeight = 80 23 | ClientWidth = 647 24 | TabOrder = 0 25 | object LabelURI: TLabel 26 | Left = 11 27 | Height = 19 28 | Top = 8 29 | Width = 27 30 | Caption = 'URL' 31 | ParentColor = False 32 | end 33 | object EditURL: TEdit 34 | Left = 48 35 | Height = 29 36 | Top = 5 37 | Width = 440 38 | OnKeyPress = EditURLKeyPress 39 | TabOrder = 0 40 | Text = 'http://www.bistrecode.com/test file.txt' 41 | end 42 | object ButtonSendRequest: TButton 43 | Left = 496 44 | Height = 25 45 | Top = 5 46 | Width = 144 47 | BorderSpacing.InnerBorder = 4 48 | Caption = 'Send Request' 49 | OnClick = ButtonSendRequestClick 50 | TabOrder = 1 51 | end 52 | object EditPOST: TEdit 53 | Left = 48 54 | Height = 29 55 | Top = 40 56 | Width = 440 57 | OnChange = EditPOSTChange 58 | TabOrder = 2 59 | end 60 | object LabelPOST: TLabel 61 | Left = 1 62 | Height = 19 63 | Top = 45 64 | Width = 38 65 | Caption = 'POST' 66 | ParentColor = False 67 | end 68 | object CheckBoxPOST: TCheckBox 69 | Left = 496 70 | Height = 22 71 | Top = 44 72 | Width = 90 73 | Caption = 'Use POST' 74 | TabOrder = 3 75 | end 76 | end 77 | object MemoStatus: TMemo 78 | Left = 0 79 | Height = 79 80 | Top = 375 81 | Width = 647 82 | Align = alBottom 83 | ScrollBars = ssAutoVertical 84 | TabOrder = 1 85 | end 86 | object MemoHTML: TMemo 87 | Left = 0 88 | Height = 365 89 | Top = 0 90 | Width = 647 91 | Align = alClient 92 | ScrollBars = ssAutoBoth 93 | TabOrder = 2 94 | end 95 | object PanelSep: TPanel 96 | Left = 0 97 | Height = 10 98 | Top = 365 99 | Width = 647 100 | Align = alBottom 101 | TabOrder = 3 102 | end 103 | object HTTPClient: TLHTTPClientComponent 104 | OnCanWrite = HTTPClientCanWrite 105 | OnDoneInput = HTTPClientDoneInput 106 | OnInput = HTTPClientInput 107 | OnProcessHeaders = HTTPClientProcessHeaders 108 | OnDisconnect = HTTPClientDisconnect 109 | OnError = HTTPClientError 110 | Timeout = 0 111 | Session = SSL 112 | left = 472 113 | top = 352 114 | end 115 | object MainMenu1: TMainMenu 116 | left = 584 117 | top = 352 118 | object MenuItemFile: TMenuItem 119 | Caption = '&File' 120 | object MenuItemExit: TMenuItem 121 | Caption = 'E&xit' 122 | OnClick = MenuItemExitClick 123 | end 124 | end 125 | object MenuItemHelp: TMenuItem 126 | Caption = '&Help' 127 | object MenuItemAbout: TMenuItem 128 | Caption = '&About' 129 | OnClick = MenuItemAboutClick 130 | end 131 | end 132 | end 133 | object SSL: TLSSLSessionComponent 134 | Method = msSslTLS 135 | SSLActive = False 136 | OnSSLConnect = SSLSSLConnect 137 | left = 472 138 | top = 408 139 | end 140 | end 141 | -------------------------------------------------------------------------------- /examples/console/lhttp/fpget.pp: -------------------------------------------------------------------------------- 1 | program fpget; 2 | 3 | {$mode objfpc} 4 | {$h+} 5 | 6 | uses 7 | sysutils, strutils, lnet, lhttp, lHTTPUtil, lnetSSL, URIParser; 8 | 9 | var 10 | HttpClient: TLHTTPClient; 11 | OutputFile: file; 12 | Done: boolean; 13 | 14 | type 15 | THTTPHandler = class 16 | public 17 | procedure ClientDisconnect(ASocket: TLSocket); 18 | procedure ClientDoneInput(ASocket: TLHTTPClientSocket); 19 | procedure ClientError(const Msg: string; aSocket: TLSocket); 20 | function ClientInput(ASocket: TLHTTPClientSocket; ABuffer: pchar; 21 | ASize: Integer): Integer; 22 | procedure ClientProcessHeaders(ASocket: TLHTTPClientSocket); 23 | end; 24 | 25 | procedure THTTPHandler.ClientError(const Msg: string; aSocket: TLSocket); 26 | begin 27 | writeln('Error: ', Msg); 28 | end; 29 | 30 | procedure THTTPHandler.ClientDisconnect(ASocket: TLSocket); 31 | begin 32 | writeln('Disconnected.'); 33 | done := true; 34 | end; 35 | 36 | procedure THTTPHandler.ClientDoneInput(ASocket: TLHTTPClientSocket); 37 | begin 38 | writeln('done.'); 39 | close(OutputFile); 40 | ASocket.Disconnect; 41 | end; 42 | 43 | function THTTPHandler.ClientInput(ASocket: TLHTTPClientSocket; 44 | ABuffer: pchar; ASize: Integer): Integer; 45 | begin 46 | blockwrite(outputfile, ABuffer^, ASize, Result); 47 | write(IntToStr(ASize) + '...'); 48 | Result := ASize; 49 | end; 50 | 51 | procedure THTTPHandler.ClientProcessHeaders(ASocket: TLHTTPClientSocket); 52 | begin 53 | write('Response: ', HTTPStatusCodes[ASocket.ResponseStatus], ' ', 54 | ASocket.ResponseReason, ', data...'); 55 | end; 56 | 57 | var 58 | URL, Host, URI, FileName, AltFileName: string; 59 | Port: Word; 60 | dummy: THTTPHandler; 61 | index: Integer; 62 | UseSSL: Boolean; 63 | SSLSession: TLSSLSession; 64 | begin 65 | if ParamCount = 0 then 66 | begin 67 | writeln('Specify URL (and optionally, filename).'); 68 | exit; 69 | end; 70 | 71 | { parse URL } 72 | URL := ParamStr(1); 73 | 74 | UseSSL := DecomposeURL(URL, Host, URI, Port); 75 | Writeln('Host: ', Host, ' URI: ', URI, ' Port: ', Port); 76 | 77 | if ParamCount >= 2 then 78 | FileName := ParamStr(2) 79 | else begin 80 | index := RPos('/', URI); 81 | if index > 0 then 82 | FileName := Copy(URI, index+1, Length(URI)-index); 83 | if Length(FileName) = 0 then 84 | FileName := 'index.html'; 85 | end; 86 | 87 | if FileExists(FileName) then 88 | begin 89 | index := 1; 90 | repeat 91 | AltFileName := FileName + '.' + IntToStr(index); 92 | inc(index); 93 | until not FileExists(AltFileName); 94 | writeln('"', FileName, '" exists, writing to "', AltFileName, '"'); 95 | FileName := AltFileName; 96 | end; 97 | 98 | assign(OutputFile, FileName); 99 | rewrite(OutputFile, 1); 100 | 101 | HttpClient := TLHTTPClient.Create(nil); 102 | 103 | SSLSession := TLSSLSession.Create(HttpClient); 104 | SSLSession.SSLActive := UseSSL; 105 | 106 | HttpClient.Session := SSLSession; 107 | HttpClient.Host := Host; 108 | HttpClient.Method := hmGet; 109 | HttpClient.Port := Port; 110 | HttpClient.URI := URI; 111 | HttpClient.Timeout := -1; 112 | HttpClient.OnDisconnect := @dummy.ClientDisconnect; 113 | HttpClient.OnDoneInput := @dummy.ClientDoneInput; 114 | HttpClient.OnError := @dummy.ClientError; 115 | HttpClient.OnInput := @dummy.ClientInput; 116 | HttpClient.OnProcessHeaders := @dummy.ClientProcessHeaders; 117 | HttpClient.SendRequest; 118 | Done := false; 119 | 120 | while not Done do 121 | HttpClient.CallAction; 122 | HttpClient.Free; 123 | end. 124 | -------------------------------------------------------------------------------- /examples/visual/ftp/ftptest.lpi: -------------------------------------------------------------------------------- 1 | <?xml version="1.0"?> 2 | <CONFIG> 3 | <ProjectOptions> 4 | <Version Value="7"/> 5 | <General> 6 | <Flags> 7 | <SaveClosedFiles Value="False"/> 8 | <SaveOnlyProjectUnits Value="True"/> 9 | <LRSInOutputDirectory Value="False"/> 10 | </Flags> 11 | <SessionStorage Value="InProjectDir"/> 12 | <MainUnit Value="0"/> 13 | <TargetFileExt Value=""/> 14 | <Title Value="FTP Test case"/> 15 | </General> 16 | <VersionInfo> 17 | <StringTable Comments="" CompanyName="" FileDescription="" FileVersion="0.0.0.0" InternalName="" LegalCopyright="" LegalTrademarks="" OriginalFilename="" ProductName="" ProductVersion="0.0.0.0"/> 18 | </VersionInfo> 19 | <PublishOptions> 20 | <Version Value="2"/> 21 | <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> 22 | <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> 23 | </PublishOptions> 24 | <RunParams> 25 | <local> 26 | <FormatVersion Value="1"/> 27 | <LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> 28 | </local> 29 | </RunParams> 30 | <RequiredPackages Count="3"> 31 | <Item1> 32 | <PackageName Value="LCL"/> 33 | </Item1> 34 | <Item2> 35 | <PackageName Value="lnetbase"/> 36 | </Item2> 37 | <Item3> 38 | <PackageName Value="lnetvisual"/> 39 | <MinVersion Minor="4" Release="1" Valid="True"/> 40 | </Item3> 41 | </RequiredPackages> 42 | <Units Count="5"> 43 | <Unit0> 44 | <Filename Value="ftptest.lpr"/> 45 | <IsPartOfProject Value="True"/> 46 | <UnitName Value="ftptest"/> 47 | </Unit0> 48 | <Unit1> 49 | <Filename Value="main.pas"/> 50 | <IsPartOfProject Value="True"/> 51 | <ComponentName Value="MainForm"/> 52 | <HasResources Value="True"/> 53 | <ResourceBaseClass Value="Form"/> 54 | <UnitName Value="main"/> 55 | </Unit1> 56 | <Unit2> 57 | <Filename Value="sitesunit.pas"/> 58 | <IsPartOfProject Value="True"/> 59 | <ComponentName Value="frmSites"/> 60 | <ResourceBaseClass Value="Form"/> 61 | <UnitName Value="sitesunit"/> 62 | </Unit2> 63 | <Unit3> 64 | <Filename Value="dleparsers.pas"/> 65 | <IsPartOfProject Value="True"/> 66 | <UnitName Value="dleparsers"/> 67 | </Unit3> 68 | <Unit4> 69 | <Filename Value="ufeatures.pas"/> 70 | <IsPartOfProject Value="True"/> 71 | <ComponentName Value="FormFeatures"/> 72 | <ResourceBaseClass Value="Form"/> 73 | <UnitName Value="uFeatures"/> 74 | </Unit4> 75 | </Units> 76 | </ProjectOptions> 77 | <CompilerOptions> 78 | <Version Value="8"/> 79 | <SearchPaths> 80 | <SrcPath Value="$(LazarusDir)/lcl/;$(LazarusDir)/lcl/interfaces/$(LCLWidgetType)/"/> 81 | </SearchPaths> 82 | <Parsing> 83 | <SyntaxOptions> 84 | <CStyleOperator Value="False"/> 85 | </SyntaxOptions> 86 | </Parsing> 87 | <CodeGeneration> 88 | <Optimizations> 89 | <OptimizationLevel Value="2"/> 90 | </Optimizations> 91 | </CodeGeneration> 92 | <Linking> 93 | <Debugging> 94 | <UseLineInfoUnit Value="False"/> 95 | <StripSymbols Value="True"/> 96 | </Debugging> 97 | <LinkSmart Value="True"/> 98 | </Linking> 99 | <Other> 100 | <CompilerPath Value="$(CompPath)"/> 101 | </Other> 102 | </CompilerOptions> 103 | </CONFIG> 104 | -------------------------------------------------------------------------------- /examples/visual/telnet/telnet.lpi: -------------------------------------------------------------------------------- 1 | <?xml version="1.0"?> 2 | <CONFIG> 3 | <ProjectOptions> 4 | <Version Value="7"/> 5 | <General> 6 | <Flags> 7 | <LRSInOutputDirectory Value="False"/> 8 | </Flags> 9 | <MainUnit Value="0"/> 10 | <TargetFileExt Value=""/> 11 | <ActiveWindowIndexAtStart Value="0"/> 12 | </General> 13 | <VersionInfo> 14 | <Language Value=""/> 15 | <CharSet Value=""/> 16 | <StringTable Comments="" CompanyName="" FileDescription="" FileVersion="0.0.0.0" InternalName="" LegalCopyright="" LegalTrademarks="" OriginalFilename="" ProductName="" ProductVersion=""/> 17 | </VersionInfo> 18 | <PublishOptions> 19 | <Version Value="2"/> 20 | <IgnoreBinaries Value="False"/> 21 | <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> 22 | <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> 23 | </PublishOptions> 24 | <RunParams> 25 | <local> 26 | <FormatVersion Value="1"/> 27 | <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> 28 | </local> 29 | </RunParams> 30 | <RequiredPackages Count="2"> 31 | <Item1> 32 | <PackageName Value="lnetvisual"/> 33 | <MinVersion Minor="6" Valid="True"/> 34 | </Item1> 35 | <Item2> 36 | <PackageName Value="LCL"/> 37 | </Item2> 38 | </RequiredPackages> 39 | <Units Count="5"> 40 | <Unit0> 41 | <Filename Value="telnet.lpr"/> 42 | <IsPartOfProject Value="True"/> 43 | <UnitName Value="telnet"/> 44 | <TopLine Value="1"/> 45 | <CursorPos X="47" Y="15"/> 46 | <UsageCount Value="20"/> 47 | </Unit0> 48 | <Unit1> 49 | <Filename Value="main.pas"/> 50 | <IsPartOfProject Value="True"/> 51 | <ComponentName Value="FormMain"/> 52 | <ResourceBaseClass Value="Form"/> 53 | <UnitName Value="main"/> 54 | <IsVisibleTab Value="True"/> 55 | <EditorIndex Value="0"/> 56 | <WindowIndex Value="0"/> 57 | <TopLine Value="72"/> 58 | <CursorPos X="1" Y="87"/> 59 | <UsageCount Value="20"/> 60 | <Loaded Value="True"/> 61 | </Unit1> 62 | <Unit2> 63 | <Filename Value="../../console/ltelnet/ltclient.pp"/> 64 | <UnitName Value="ltclient"/> 65 | <TopLine Value="1"/> 66 | <CursorPos X="27" Y="6"/> 67 | <UsageCount Value="10"/> 68 | </Unit2> 69 | <Unit3> 70 | <Filename Value="../../../lazaruspackage/lnetcomponents.pas"/> 71 | <UnitName Value="lNetComponents"/> 72 | <TopLine Value="56"/> 73 | <CursorPos X="38" Y="69"/> 74 | <UsageCount Value="10"/> 75 | </Unit3> 76 | <Unit4> 77 | <Filename Value="../../../lib/ltelnet.pp"/> 78 | <UnitName Value="lTelnet"/> 79 | <TopLine Value="101"/> 80 | <CursorPos X="16" Y="114"/> 81 | <UsageCount Value="10"/> 82 | </Unit4> 83 | </Units> 84 | <JumpHistory Count="0" HistoryIndex="-1"/> 85 | </ProjectOptions> 86 | <CompilerOptions> 87 | <Version Value="8"/> 88 | <CodeGeneration> 89 | <Optimizations> 90 | <OptimizationLevel Value="2"/> 91 | </Optimizations> 92 | </CodeGeneration> 93 | <Linking> 94 | <Debugging> 95 | <UseLineInfoUnit Value="False"/> 96 | <StripSymbols Value="True"/> 97 | </Debugging> 98 | <LinkSmart Value="True"/> 99 | <Options> 100 | <Win32> 101 | <GraphicApplication Value="True"/> 102 | </Win32> 103 | </Options> 104 | </Linking> 105 | <Other> 106 | <CompilerPath Value="$(CompPath)"/> 107 | </Other> 108 | </CompilerOptions> 109 | </CONFIG> 110 | -------------------------------------------------------------------------------- /examples/console/ludp/ludp.pp: -------------------------------------------------------------------------------- 1 | program ludp; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | uses 6 | SysUtils, lNet, lCommon, Crt; 7 | 8 | type 9 | 10 | { TLUDPTest 11 | - This class serves as an example on how to use basic UDP. 12 | It merely acts as server or client. 13 | Clients send messages and server is simple echo, no checks. } 14 | 15 | TLUDPTest = class 16 | private 17 | FCon: TLUDP; // the lNet connection to use 18 | FServer: Boolean; // are we the server? 19 | FQuit: Boolean; // the main loop control 20 | procedure OnEr(const msg: string; aSocket: TLSocket); // OnError callback 21 | procedure OnRe(aSocket: TLSocket); // OnReceive callback 22 | public 23 | constructor Create; 24 | destructor Destroy; override; 25 | procedure Run; // this is the main loop 26 | end; 27 | 28 | { TLUDPTest } 29 | 30 | constructor TLUDPTest.Create; 31 | begin 32 | FCon := TLUdp.Create(nil); // create a new TLUDP component with no parent coponent 33 | FCon.OnError := @OnEr; // assign callbacks 34 | FCon.OnReceive := @OnRe; 35 | FCon.Timeout := 100; // responsive enough, but won't hog CPU 36 | end; 37 | 38 | destructor TLUDPTest.Destroy; 39 | begin 40 | FCon.Free; // free the UDP connection 41 | inherited Destroy; 42 | end; 43 | 44 | procedure TLUDPTest.OnEr(const msg: string; aSocket: TLSocket); 45 | begin 46 | Writeln(msg); // write the error message 47 | FQuit := true; // and quit ASAP 48 | end; 49 | 50 | procedure TLUDPTest.OnRe(aSocket: TLSocket); 51 | var 52 | s: string; 53 | begin 54 | if aSocket.GetMessage(s) > 0 then begin // if we received anything (will be in s) 55 | Writeln(s); // write the message received 56 | Writeln('Host at: ', aSocket.PeerAddress); // and the address of sender 57 | if FServer then // if we act as server 58 | FCon.SendMessage('Welcome'); // echo the message "Welcome" back to the client 59 | end; 60 | end; 61 | 62 | procedure TLUDPTest.Run; 63 | var 64 | Result: Boolean; // result of connect or listen functions 65 | Port: Word; // port to connect to 66 | Address: string; // address to connect to 67 | begin 68 | if ParamCount > 1 then begin // we need atleast one argument 69 | Result := False; 70 | FQuit := False; // initialize loop variables 71 | 72 | try 73 | Port := Word(StrToInt(ParamStr(2))); // try to get port from argument if possible 74 | except 75 | on e: Exception do begin // write error and quit if not 76 | Writeln(e.message); 77 | Halt; 78 | end; 79 | end; 80 | 81 | if ParamCount > 2 then // if we got additional argument, then parse it as address 82 | Address := ParamStr(3) 83 | else 84 | Address := LADDR_BR; // else use broadcast address 85 | 86 | if ParamStr(1) = '-s' then begin // if we're supposed to be the server 87 | Result := FCon.Listen(port); // start listening 88 | Writeln('Starting server...'); 89 | FServer := True; // and remember the descision 90 | end else begin 91 | Result := FCon.Connect(Address, port); // otherwise connect 92 | Writeln('Starting client...'); 93 | end; 94 | 95 | if Result then repeat // if listen/connect was successful 96 | FCon.CallAction; // "eventize" the event loop in lNet 97 | if KeyPressed then // if user provided input 98 | if ReadKey <> #27 then // and he didn't pres "escape" 99 | FCon.SendMessage('Hello') // send the "Hello" message to other side 100 | else 101 | FQuit := true; // otherwise (if he pressed "escape") quit 102 | until FQuit; // repeat this cycle until FQuit = true, due to error or user input 103 | 104 | Writeln; // write additional line to clarify stuff 105 | end else Writeln('Usage: ', ParamStr(0), ' <-s/-c> <port> [address]'); 106 | end; 107 | 108 | var 109 | UDP: TLUDPTest; 110 | begin 111 | UDP := TLUDPTest.Create; 112 | UDP.Run; 113 | UDP.Free; 114 | end. 115 | 116 | -------------------------------------------------------------------------------- /examples/console/ltelnet/ltclient.pp: -------------------------------------------------------------------------------- 1 | program ltclient; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | uses 6 | SysUtils, Crt, lTelnet, lNet; 7 | 8 | { This is a rather simple Telnet client, 9 | it accepts IP/url and port as arguments 10 | See file ltelnet.pas if you want to know 11 | how it works. } 12 | 13 | type 14 | 15 | { TLTelnetTest } 16 | 17 | TLTelnetTest = class 18 | private 19 | FCon: TLTelnetClient; // THE telnet connection 20 | FQuit: Boolean; 21 | // the old known event, only Error is checked in this basic telnet client 22 | procedure OnError(const msg: string; aSocket: TLSocket); 23 | public 24 | constructor Create; 25 | destructor Destroy; override; 26 | procedure Run; 27 | end; 28 | 29 | { TLTelnetTest } 30 | 31 | constructor TLTelnetTest.Create; 32 | begin 33 | FCon := TLTelnetClient.Create(nil); 34 | FCon.OnError := @OnError; // assign callbacks 35 | FCon.Timeout := 100; // responsive enough but won't hog cpu 36 | end; 37 | 38 | destructor TLTelnetTest.Destroy; 39 | begin 40 | FCon.Free; 41 | inherited Destroy; 42 | end; 43 | 44 | procedure TLTelnetTest.OnError(const msg: string; aSocket: TLSocket); 45 | begin 46 | Writeln(msg); 47 | FQuit := True; 48 | end; 49 | 50 | procedure TLTelnetTest.Run; 51 | var 52 | s, SendStr: string; 53 | c: Char; 54 | AD: string; 55 | PORT: Word; 56 | begin 57 | if ParamCount > 1 then // get some info regarding host from commandline 58 | try 59 | AD := Paramstr(1); 60 | PORT := Word(StrToInt(Paramstr(2))); 61 | except 62 | Writeln('Invalid command line parameters'); 63 | Exit; 64 | end else begin 65 | Writeln('Usage: ', ExtractFileName(ParamStr(0)), ' IP PORT'); 66 | Exit; 67 | end; 68 | 69 | FQuit := False; 70 | 71 | if FCon.Connect(AD, PORT) then begin // try connecting to other side 72 | Writeln('Connecting... press any key to cancel'); // if initial connect worked, inform user and wait 73 | repeat 74 | FCon.CallAction; // repeat this to get info 75 | if KeyPressed then 76 | Halt; 77 | until FCon.Connected; // wait until timeout or we actualy connected 78 | 79 | Writeln('Connected'); 80 | SendStr := ''; 81 | 82 | while not FQuit do begin // if we connected, do main loop 83 | if KeyPressed then begin 84 | c := ReadKey; 85 | case c of 86 | #27: FQuit := True; // user wants to quit 87 | #8: if Length(SendStr) > 0 then begin // delete last char 88 | GotoXY(WhereX-1, WhereY); 89 | Write(' '); 90 | GotoXY(WhereX-1, WhereY); 91 | SetLength(SendStr, Length(SendStr) - 1); 92 | end; 93 | else if c = #13 then begin // if it's enter, send the message 94 | Writeln; 95 | FCon.SendMessage(SendStr + #13#10); // don't forget terminator 96 | SendStr := ''; 97 | end else begin 98 | SendStr := SendStr + c; 99 | if not FCon.OptionIsSet(TS_ECHO) then // if echo is not on, we need to do echo locally 100 | Write(c); 101 | end; 102 | end; 103 | end; 104 | { Always see if we got new messages, this is somewhat different from others (EG: TLTcp). 105 | Instead of callbacks/events, we check this, because in telnet, the library needs to check for 106 | special sequences containing telnet info and process them before giving the data to user. 107 | So telnet has it's own internal buffer, unlike most other lNet protocols/connections } 108 | if FCon.GetMessage(s) > 0 then 109 | Write(s); 110 | FCon.CallAction; // don't forget to make the clock tick :) 111 | end; 112 | end; 113 | 114 | if FCon.GetMessage(s) > 0 then 115 | Write(s); 116 | end; 117 | 118 | var 119 | Telnet: TLTelnetTest; 120 | begin 121 | Telnet := TLTelnetTest.Create; 122 | Telnet.Run; 123 | Telnet.Free; 124 | end. 125 | 126 | -------------------------------------------------------------------------------- /examples/console/ltcp/lserver.pp: -------------------------------------------------------------------------------- 1 | program lserver; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | uses 6 | Classes, Crt, SysUtils, lNet; 7 | 8 | type 9 | 10 | { TLTCPTest } 11 | 12 | TLTCPTest = class 13 | private 14 | FCon: TLTCP; // THE server connection 15 | { these are all events which happen on our server connection. They are called inside CallAction 16 | OnEr gets fired when a network error occurs. 17 | OnAc gets fired when a new connection is accepted on the server socket. 18 | OnRe gets fired when any of the server sockets receives new data. 19 | OnDs gets fired when any of the server sockets disconnects gracefully. 20 | } 21 | procedure OnEr(const msg: string; aSocket: TLSocket); 22 | procedure OnAc(aSocket: TLSocket); 23 | procedure OnRe(aSocket: TLSocket); 24 | procedure OnDs(aSocket: TLSocket); 25 | public 26 | constructor Create; 27 | destructor Destroy; override; 28 | procedure Run; // main loop with CallAction 29 | end; 30 | 31 | procedure TLTCPTest.OnEr(const msg: string; aSocket: TLSocket); 32 | begin 33 | Writeln(msg); // if error occured, write it explicitly 34 | end; 35 | 36 | procedure TLTCPTest.OnAc(aSocket: TLSocket); 37 | begin 38 | Writeln('Connection accepted from ', aSocket.PeerAddress); // on accept, write whom we accepted 39 | end; 40 | 41 | procedure TLTCPTest.OnRe(aSocket: TLSocket); 42 | var 43 | s: string; 44 | n: Integer; 45 | begin 46 | if aSocket.GetMessage(s) > 0 then begin // if we received anything (result is in s) 47 | Writeln('Got: "', s, '" with length: ', Length(s)); // write message and it's length 48 | FCon.IterReset; // now it points to server socket 49 | while FCon.IterNext do begin // while we have clients to echo to 50 | n := FCon.SendMessage(s, FCon.Iterator); 51 | if n < Length(s) then // try to send to each of them 52 | Writeln('Unsuccessful send, wanted: ', Length(s), ' got: ', n); // if send fails write error 53 | end; 54 | end; 55 | end; 56 | 57 | procedure TLTCPTest.OnDs(aSocket: TLSocket); 58 | begin 59 | Writeln('Lost connection'); // write info if connection was lost 60 | end; 61 | 62 | constructor TLTCPTest.Create; 63 | begin 64 | FCon := TLTCP.Create(nil); // create new TCP connection 65 | FCon.OnError := @OnEr; // assign all callbacks 66 | FCon.OnReceive := @OnRe; 67 | FCon.OnDisconnect := @OnDs; 68 | FCon.OnAccept := @OnAc; 69 | FCon.Timeout := 100; // responsive enough, but won't hog cpu 70 | FCon.ReuseAddress := True; 71 | end; 72 | 73 | destructor TLTCPTest.Destroy; 74 | begin 75 | FCon.Free; // free the TCP connection 76 | inherited Destroy; 77 | end; 78 | 79 | procedure TLTCPTest.Run; 80 | var 81 | Quit: Boolean; // main loop control 82 | Port: Word; // the port to connect to 83 | begin 84 | if ParamCount > 0 then begin // we need one argument 85 | try 86 | Port := Word(StrToInt(ParamStr(1))); // try to parse port from argument 87 | except 88 | on e: Exception do begin 89 | Writeln(e.message); 90 | Halt; 91 | end; 92 | end; 93 | Quit := false; 94 | 95 | if FCon.Listen(Port) then begin // if listen went ok 96 | Writeln('Server running!'); 97 | Writeln('Press ''escape'' to quit, ''r'' to restart'); 98 | repeat 99 | FCon.Callaction; // eventize the lNet 100 | if Keypressed then // if user provided input 101 | case readkey of 102 | #27: quit := true; // if he pressed "escape" then quit 103 | 'r': begin // if he pressed 'r' then restart the server 104 | Writeln('Restarting...'); 105 | FCon.Disconnect; 106 | FCon.Listen(Port); 107 | Quit := false; 108 | end; 109 | end; 110 | until Quit; // until user quit 111 | end; // listen 112 | end else Writeln('Usage: ', ParamStr(0), ' <port>'); 113 | end; 114 | 115 | var 116 | TCP: TLTCPTest; 117 | begin 118 | TCP := TLTCPTest.Create; 119 | TCP.Run; 120 | TCP.Free; 121 | end. 122 | 123 | -------------------------------------------------------------------------------- /examples/visual/ftp/icons.lrs: -------------------------------------------------------------------------------- 1 | LazarusResources.Add('ftp_dir','XPM',[ 2 | '/* XPM */'#10'static char *ftp_dir[] = {'#10'/* columns rows colors chars-pe' 3 | +'r-pixel */'#10'"15 13 16 1",'#10'" c black",'#10'". c #800000",'#10'"X c #' 4 | +'008000",'#10'"o c #808000",'#10'"O c navy",'#10'"+ c #800080",'#10'"@ c #00' 5 | +'8080",'#10'"# c #808080",'#10'"$ c #C0C0C0",'#10'"% c red",'#10'"& c green"' 6 | +','#10'"* c yellow",'#10'"= c blue",'#10'"- c None",'#10'"; c cyan",'#10'": ' 7 | +'c gray100",'#10'/* pixels */'#10'"--#####--------",'#10'"-#$*$*$#-------",' 8 | +#10'"#$*$*$*$######-",'#10'"#::::::::::::# ",'#10'"#:*$*$*$*$*$*# ",'#10'"#:' 9 | +'$*$*$*$*$*$# ",'#10'"#:*$*$*$*$*$*# ",'#10'"#:$*$*$*$*$*$# ",'#10'"#:*$*$*$' 10 | +'*$*$*# ",'#10'"#:$*$*$*$*$*$# ",'#10'"#:*$*$*$*$*$*# ",'#10'"##############' 11 | +' ",'#10'"- "'#10'};'#10 12 | ]); 13 | LazarusResources.Add('ftp_dirup','XPM',[ 14 | '/* XPM */'#10'static char *ftp_dirup[] = {'#10'/* columns rows colors chars-' 15 | +'per-pixel */'#10'"15 13 16 1",'#10'" c black",'#10'". c #800000",'#10'"X c' 16 | +' #008000",'#10'"o c #808000",'#10'"O c navy",'#10'"+ c #800080",'#10'"@ c #' 17 | +'008080",'#10'"# c #808080",'#10'"$ c #C0C0C0",'#10'"% c red",'#10'"& c gree' 18 | +'n",'#10'"* c yellow",'#10'"= c blue",'#10'"- c None",'#10'"; c cyan",'#10'"' 19 | +': c gray100",'#10'/* pixels */'#10'"--#####--------",'#10'"-#$*$*$#-------"' 20 | +','#10'"#$*$*$*$######-",'#10'"#::::::::::::# ",'#10'"#:*$* *$*$*$*# ",'#10 21 | +'"#:$* *$*$*$# ",'#10'"#:* *$*$*# ",'#10'"#:$*$ $*$*$*$# ",'#10'"#:*$*' 22 | +' *$*$*$*# ",'#10'"#:$*$ $*$# ",'#10'"#:*$*$*$*$*$*# ",'#10'"###########' 23 | +'### ",'#10'"- "'#10'};'#10 24 | ]); 25 | LazarusResources.Add('ftp_error','XPM',[ 26 | '/* XPM */'#10'static char *ftp_error[] = {'#10'/* columns rows colors chars-' 27 | +'per-pixel */'#10'"15 13 16 1",'#10'" c black",'#10'". c #800000",'#10'"X c' 28 | +' #008000",'#10'"o c #808000",'#10'"O c navy",'#10'"+ c #800080",'#10'"@ c #' 29 | +'008080",'#10'"# c #808080",'#10'"$ c #C0C0C0",'#10'"% c red",'#10'"& c gree' 30 | +'n",'#10'"* c yellow",'#10'"= c blue",'#10'"- c None",'#10'"; c cyan",'#10'"' 31 | +': c gray100",'#10'/* pixels */'#10'"---------------",'#10'"------%%%------"' 32 | +','#10'"----%%%%%%%----",'#10'"---%%%---%%%---",'#10'"---%%---%%%%---",'#10 33 | +'"--%%---%%%-%%--",'#10'"--%%--%%%--%%--",'#10'"--%%-%%%---%%--",'#10'"---%%' 34 | +'%%---%%---",'#10'"---%%%---%%%---",'#10'"----%%%%%%%----",'#10'"------%%%--' 35 | +'----",'#10'"---------------"'#10'};'#10 36 | ]); 37 | LazarusResources.Add('ftp_file','XPM',[ 38 | '/* XPM */'#10'static char *ftp_file__[] = {'#10'/* columns rows colors chars' 39 | +'-per-pixel */'#10'"15 13 16 1",'#10'" c black",'#10'". c #800000",'#10'"X ' 40 | +'c #008000",'#10'"o c #808000",'#10'"O c navy",'#10'"+ c #800080",'#10'"@ c ' 41 | +'#008080",'#10'"# c #808080",'#10'"$ c #C0C0C0",'#10'"% c red",'#10'"& c gre' 42 | +'en",'#10'"* c yellow",'#10'"= c blue",'#10'"- c None",'#10'"; c cyan",'#10 43 | +'": c gray100",'#10'/* pixels */'#10'"--########-----",'#10'"--#:::::#:#----' 44 | +'",'#10'"--#:::::#::#---",'#10'"--#:::::#:::#--",'#10'"--#::::: --",'#10 45 | +'"--#::::::::: --",'#10'"--#::::::::: --",'#10'"--#::::::::: --",'#10'"--#::' 46 | +'::::::: --",'#10'"--#::::::::: --",'#10'"--#::::::::: --",'#10'"--# ' 47 | +' --",'#10'"---------------"'#10'};'#10 48 | ]); 49 | LazarusResources.Add('ftp_link','XPM',[ 50 | '/* XPM */'#10'static char *ftp_link[] = {'#10'/* columns rows colors chars-p' 51 | +'er-pixel */'#10'"15 13 16 1",'#10'" c black",'#10'". c #800000",'#10'"X c ' 52 | +'#008000",'#10'"o c #808000",'#10'"O c navy",'#10'"+ c #800080",'#10'"@ c #0' 53 | +'08080",'#10'"# c #808080",'#10'"$ c #C0C0C0",'#10'"% c red",'#10'"& c green' 54 | +'",'#10'"* c yellow",'#10'"= c blue",'#10'"- c None",'#10'"; c cyan",'#10'":' 55 | +' c gray100",'#10'/* pixels */'#10'"---------------",'#10'"-- --",' 56 | +#10'"-- ::::::::: --",'#10'"-- :: : --",'#10'"-- ::: : --",'#10'"--' 57 | +' :::: : --",'#10'"-- ::: : --",'#10'"-- :: : : --",'#10'"-- : :' 58 | +':: : --",'#10'"-- : :::::: --",'#10'"-- ::::::::: --",'#10'"-- -' 59 | +'-",'#10'"---------------"'#10'};'#10 60 | ]); 61 | -------------------------------------------------------------------------------- /lib/sys/lkqueueeventer.inc: -------------------------------------------------------------------------------- 1 | {% lkqueueeventer.inc included by levents.pas } 2 | 3 | {$ifdef BSD} 4 | 5 | { TLKQueueEventer } 6 | 7 | constructor TLKQueueEventer.Create; 8 | begin 9 | inherited Create; 10 | Inflate; 11 | FFreeSlot := 0; 12 | FTimeout.tv_sec := 0; 13 | FTimeout.tv_nsec := 0; 14 | FQueue := KQueue; 15 | if FQueue < 0 then 16 | raise Exception.Create('Unable to create kqueue: ' + StrError(fpGetErrno)); 17 | end; 18 | 19 | destructor TLKQueueEventer.Destroy; 20 | begin 21 | fpClose(FQueue); 22 | inherited Destroy; 23 | end; 24 | 25 | function TLKQueueEventer.GetTimeout: Integer; 26 | begin 27 | Result := FTimeout.tv_sec + FTimeout.tv_nsec * 1000 * 1000; 28 | end; 29 | 30 | procedure TLKQueueEventer.SetTimeout(const Value: Integer); 31 | begin 32 | if Value >= 0 then begin 33 | FTimeout.tv_sec := Value div 1000; 34 | FTimeout.tv_nsec := (Value mod 1000) * 1000; 35 | end else begin 36 | FTimeout.tv_sec := -1; 37 | FTimeout.tv_nsec := 0; 38 | end; 39 | end; 40 | 41 | procedure TLKQueueEventer.HandleIgnoreRead(aHandle: TLHandle); 42 | const 43 | INBOOL: array[Boolean] of Integer = (EV_ENABLE, EV_DISABLE); 44 | begin 45 | EV_SET(@FChanges[FFreeSlot], aHandle.FHandle, EVFILT_READ, 46 | INBOOL[aHandle.IgnoreRead], 0, 0, Pointer(aHandle)); 47 | 48 | Inc(FFreeSlot); 49 | if FFreeSlot > Length(FChanges) then 50 | Inflate; 51 | end; 52 | 53 | procedure TLKQueueEventer.Inflate; 54 | const 55 | BASE_SIZE = 100; 56 | var 57 | OldLength: Integer; 58 | begin 59 | OldLength := Length(FChanges); 60 | if OldLength > 1 then begin 61 | SetLength(FChanges, Sqr(OldLength)); 62 | SetLength(FEvents, Sqr(OldLength)); 63 | end else begin 64 | SetLength(FChanges, BASE_SIZE); 65 | SetLength(FEvents, BASE_SIZE); 66 | end; 67 | end; 68 | 69 | function TLKQueueEventer.AddHandle(aHandle: TLHandle): Boolean; 70 | begin 71 | Result := inherited AddHandle(aHandle); 72 | 73 | if FFreeSlot > Length(FChanges) then 74 | Inflate; 75 | EV_SET(@FChanges[FFreeSlot], aHandle.FHandle, EVFILT_WRITE, 76 | EV_ADD or EV_CLEAR, 0, 0, Pointer(aHandle)); 77 | Inc(FFreeSlot); 78 | 79 | if FFreeSlot > Length(FChanges) then 80 | Inflate; 81 | if not aHandle.FIgnoreRead then begin 82 | EV_SET(@FChanges[FFreeSlot], aHandle.FHandle, EVFILT_READ, 83 | EV_ADD, 0, 0, Pointer(aHandle)); 84 | Inc(FFreeSlot); 85 | end; 86 | end; 87 | 88 | function TLKQueueEventer.CallAction: Boolean; 89 | var 90 | i, n: Integer; 91 | Temp: TLHandle; 92 | begin 93 | Result := False; 94 | if FInLoop then 95 | Exit; 96 | 97 | if FTimeout.tv_sec >= 0 then 98 | n := KEvent(FQueue, @FChanges[0], FFreeSlot, 99 | @FEvents[0], Length(FEvents), @FTimeout) 100 | else 101 | n := KEvent(FQueue, @FChanges[0], FFreeSlot, 102 | @FEvents[0], Length(FEvents), nil); 103 | 104 | FFreeSlot := 0; 105 | if n < 0 then 106 | Bail('Error on kqueue', LSocketError); 107 | Result := n > 0; 108 | if Result then begin 109 | FInLoop := True; 110 | for i := 0 to n-1 do begin 111 | Temp := TLHandle(FEvents[i].uData); 112 | 113 | if (not Temp.FDispose) 114 | and (FEvents[i].Filter = EVFILT_WRITE) then 115 | if Assigned(Temp.FOnWrite) and not Temp.IgnoreWrite then 116 | Temp.FOnWrite(Temp); 117 | 118 | if (not Temp.FDispose) 119 | and (FEvents[i].Filter = EVFILT_READ) then 120 | if Assigned(Temp.FOnRead) and not Temp.IgnoreRead then 121 | Temp.FOnRead(Temp); 122 | 123 | if (not Temp.FDispose) 124 | and ((FEvents[i].Flags and EV_ERROR) > 0) then 125 | if Assigned(Temp.FOnError) and not Temp.IgnoreError then 126 | Temp.FOnError(Temp, 'Handle error' + LStrError(LSocketError)); 127 | 128 | if Temp.FDispose then 129 | AddForFree(Temp); 130 | end; 131 | FInLoop := False; 132 | if Assigned(FFreeRoot) then 133 | FreeHandles; 134 | end; 135 | end; 136 | 137 | function BestEventerClass: TLEventerClass; 138 | begin 139 | {$IFNDEF FORCE_SELECT} 140 | Result := TLKQueueEventer; 141 | {$ELSE} 142 | Result := TLSelectEventer; 143 | {$ENDIF} 144 | end; 145 | 146 | {$endif} // BSD 147 | 148 | -------------------------------------------------------------------------------- /examples/visual/http/httpclienttest.lpi: -------------------------------------------------------------------------------- 1 | <?xml version="1.0" encoding="UTF-8"?> 2 | <CONFIG> 3 | <ProjectOptions> 4 | <Version Value="10"/> 5 | <General> 6 | <Flags> 7 | <LRSInOutputDirectory Value="False"/> 8 | </Flags> 9 | <SessionStorage Value="InProjectDir"/> 10 | <MainUnit Value="0"/> 11 | </General> 12 | <BuildModes Count="2"> 13 | <Item1 Name="Debug" Default="True"/> 14 | <Item2 Name="Release"> 15 | <CompilerOptions> 16 | <Version Value="11"/> 17 | <SearchPaths> 18 | <SrcPath Value="$(LazarusDir)/lcl;$(LazarusDir)/lcl/interfaces/$(LCLWidgetType)"/> 19 | </SearchPaths> 20 | <Parsing> 21 | <SyntaxOptions> 22 | <UseAnsiStrings Value="False"/> 23 | </SyntaxOptions> 24 | </Parsing> 25 | <CodeGeneration> 26 | <SmartLinkUnit Value="True"/> 27 | <Optimizations> 28 | <OptimizationLevel Value="3"/> 29 | </Optimizations> 30 | </CodeGeneration> 31 | <Linking> 32 | <Debugging> 33 | <GenerateDebugInfo Value="False"/> 34 | <UseLineInfoUnit Value="False"/> 35 | <StripSymbols Value="True"/> 36 | </Debugging> 37 | <LinkSmart Value="True"/> 38 | <Options> 39 | <Win32> 40 | <GraphicApplication Value="True"/> 41 | </Win32> 42 | </Options> 43 | </Linking> 44 | </CompilerOptions> 45 | </Item2> 46 | </BuildModes> 47 | <PublishOptions> 48 | <Version Value="2"/> 49 | <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> 50 | <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> 51 | </PublishOptions> 52 | <RunParams> 53 | <local> 54 | <FormatVersion Value="1"/> 55 | <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> 56 | </local> 57 | </RunParams> 58 | <RequiredPackages Count="4"> 59 | <Item1> 60 | <PackageName Value="LCLBase"/> 61 | <MinVersion Major="1" Release="1" Valid="True"/> 62 | </Item1> 63 | <Item2> 64 | <PackageName Value="LCL"/> 65 | </Item2> 66 | <Item3> 67 | <PackageName Value="lnetbase"/> 68 | </Item3> 69 | <Item4> 70 | <PackageName Value="lnetvisual"/> 71 | <MinVersion Minor="4" Release="1" Valid="True"/> 72 | </Item4> 73 | </RequiredPackages> 74 | <Units Count="2"> 75 | <Unit0> 76 | <Filename Value="httpclienttest.lpr"/> 77 | <IsPartOfProject Value="True"/> 78 | </Unit0> 79 | <Unit1> 80 | <Filename Value="main.pas"/> 81 | <IsPartOfProject Value="True"/> 82 | <ComponentName Value="MainForm"/> 83 | <HasResources Value="True"/> 84 | <ResourceBaseClass Value="Form"/> 85 | </Unit1> 86 | </Units> 87 | </ProjectOptions> 88 | <CompilerOptions> 89 | <Version Value="11"/> 90 | <SearchPaths> 91 | <SrcPath Value="$(LazarusDir)/lcl;$(LazarusDir)/lcl/interfaces/$(LCLWidgetType)"/> 92 | </SearchPaths> 93 | <Parsing> 94 | <SyntaxOptions> 95 | <IncludeAssertionCode Value="True"/> 96 | <UseAnsiStrings Value="False"/> 97 | </SyntaxOptions> 98 | </Parsing> 99 | <CodeGeneration> 100 | <Checks> 101 | <IOChecks Value="True"/> 102 | <RangeChecks Value="True"/> 103 | <OverflowChecks Value="True"/> 104 | <StackChecks Value="True"/> 105 | </Checks> 106 | <VerifyObjMethodCallValidity Value="True"/> 107 | </CodeGeneration> 108 | <Linking> 109 | <Debugging> 110 | <DebugInfoType Value="dsDwarf2Set"/> 111 | <UseLineInfoUnit Value="False"/> 112 | <UseHeaptrc Value="True"/> 113 | <TrashVariables Value="True"/> 114 | <StripSymbols Value="True"/> 115 | <UseExternalDbgSyms Value="True"/> 116 | </Debugging> 117 | <Options> 118 | <Win32> 119 | <GraphicApplication Value="True"/> 120 | </Win32> 121 | </Options> 122 | </Linking> 123 | </CompilerOptions> 124 | </CONFIG> 125 | -------------------------------------------------------------------------------- /examples/console/ltcp/lclient.pp: -------------------------------------------------------------------------------- 1 | program lclient; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | uses 6 | Classes, Crt, SysUtils, lNet; 7 | 8 | type 9 | 10 | { TLTCPTest } 11 | 12 | TLTCPTest = class 13 | private 14 | FQuit: boolean; 15 | FCon: TLTcp; // the connection 16 | { these are all events which happen on our server connection. They are called inside CallAction 17 | OnEr gets fired when a network error occurs. 18 | OnRe gets fired when any of the server sockets receives new data. 19 | OnDs gets fired when any of the server sockets disconnects gracefully. 20 | } 21 | procedure OnDs(aSocket: TLSocket); 22 | procedure OnRe(aSocket: TLSocket); 23 | procedure OnEr(const msg: string; aSocket: TLSocket); 24 | public 25 | constructor Create; 26 | destructor Destroy; override; 27 | procedure Run; 28 | end; 29 | 30 | // implementation 31 | 32 | procedure TLTCPTest.OnDs(aSocket: TLSocket); 33 | begin 34 | Writeln('Lost connection'); 35 | end; 36 | 37 | procedure TLTCPTest.OnRe(aSocket: TLSocket); 38 | var 39 | s: string; 40 | begin 41 | if aSocket.GetMessage(s) > 0 then 42 | Writeln(s); 43 | end; 44 | 45 | procedure TLTCPTest.OnEr(const msg: string; aSocket: TLSocket); 46 | begin 47 | Writeln(msg); // if error occured, write it 48 | FQuit := true; // and quit ASAP 49 | end; 50 | 51 | constructor TLTCPTest.Create; 52 | begin 53 | FCon := TLTCP.Create(nil); // create new TCP connection with no parent component 54 | FCon.OnError := @OnEr; // assign callbacks 55 | FCon.OnReceive := @OnRe; 56 | FCOn.OnDisconnect := @OnDs; 57 | FCon.Timeout := 100; // responsive enough, but won't hog cpu 58 | end; 59 | 60 | destructor TLTCPTest.Destroy; 61 | begin 62 | FCon.Free; // free the connection 63 | inherited Destroy; 64 | end; 65 | 66 | procedure TLTCPTest.Run; 67 | var 68 | s, Address: string; // message-to-send and address 69 | c: char; 70 | Port: Word; 71 | 72 | begin 73 | if ParamCount > 1 then begin // we need atleast one parameter 74 | try 75 | Address := ParamStr(1); // get address from argument 76 | Port := Word(StrToInt(ParamStr(2))); // try to parse port from argument 77 | except 78 | on e: Exception do begin 79 | Writeln(e.message); // write error on failure 80 | Halt; 81 | end; 82 | end; 83 | 84 | s := ''; 85 | 86 | if FCon.Connect(Address, Port) then begin // if connect went ok 87 | Writeln('Connecting... [press any key to cancel] '); 88 | FQuit := False; 89 | repeat 90 | FCon.CallAction; // wait for "OnConnect" 91 | if KeyPressed then // if user pressed anything, quit waiting 92 | FQuit := True; 93 | until FCon.Connected or FQuit; 94 | 95 | if not FQuit then begin // if we connected succesfuly 96 | Writeln('Connected, write your messages, send with ''return'' or press ''escape'' to quit'); 97 | repeat 98 | if Keypressed then begin // if user provided inpur 99 | c := Readkey; // get key pressed 100 | case c of 101 | #8: begin // backspace deletes from message-to-send 102 | if Length(s) > 1 then 103 | Delete(s, Length(s)-1, 1) 104 | else 105 | s := ''; 106 | GotoXY(WhereX-1, WhereY); 107 | Write(' '); 108 | GotoXY(WhereX-1, WhereY); 109 | end; 110 | #10, 111 | #13: begin // both "return" and "enter" send the message 112 | FCon.SendMessage(s); 113 | s := ''; 114 | Writeln; 115 | end; 116 | #27: FQuit := true; // "escape" quits 117 | else begin 118 | s := s + c; // other chars get added to "message-to-send" 119 | Write(c); // and written so we know what we want to send 120 | end; 121 | end; 122 | end; 123 | FCon.Callaction; // eventize lNet loop 124 | until FQuit; // repeat until user quit or error happened 125 | end; // if not FQuit 126 | end; // if Connect 127 | end else Writeln('Usage: ', ParamStr(0), ' <address> <port>'); 128 | end; 129 | 130 | var 131 | TCP: TLTCPTest; 132 | begin 133 | TCP := TLTCPTest.Create; 134 | TCP.Run; 135 | TCP.Free; 136 | end. 137 | -------------------------------------------------------------------------------- /examples/visual/tcpudp/main.lrs: -------------------------------------------------------------------------------- 1 | { This is an automatically generated lazarus resource file } 2 | 3 | LazarusResources.Add('TFormMain','FORMDATA',[ 4 | 'TPF0'#9'TFormMain'#8'FormMain'#4'Left'#3'F'#2#6'Height'#3#195#1#3'Top'#3'L'#1 5 | +#5'Width'#3#134#1#13'ActiveControl'#7#8'EditPort'#7'Caption'#6#19'lNet Compo' 6 | +'nent Test'#12'ClientHeight'#3#170#1#11'ClientWidth'#3#134#1#20'Constraints.' 7 | +'MaxWidth'#3#134#1#21'Constraints.MinHeight'#3#144#1#20'Constraints.MinWidth' 8 | +#3#134#1#4'Menu'#7#9'MainMenu1'#7'OnClose'#7#9'FormClose'#8'OnCreate'#7#10'F' 9 | +'ormCreate'#10'LCLVersion'#6#7'1.8.4.0'#0#6'TLabel'#9'LabelPort'#4'Left'#3 10 | +#216#0#6'Height'#2#19#3'Top'#2#13#5'Width'#2' '#7'Caption'#6#5'Port:'#11'Par' 11 | +'entColor'#8#0#0#6'TLabel'#13'LabelHostName'#4'Left'#3#176#0#6'Height'#2#19#3 12 | +'Top'#2'$'#5'Width'#2'H'#7'Caption'#6#9'Hostname:'#11'ParentColor'#8#0#0#5'T' 13 | +'Memo'#8'MemoText'#4'Left'#2'0'#6'Height'#3#176#0#3'Top'#3#160#0#5'Width'#3 14 | +#24#1#8'ReadOnly'#9#10'ScrollBars'#7#10'ssAutoBoth'#8'TabOrder'#2#0#0#0#7'TB' 15 | +'utton'#10'ButtonSend'#4'Left'#3#253#0#6'Height'#2#25#3'Top'#3'V'#1#5'Width' 16 | +#2'K'#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#4'Send'#7'OnClick'#7#15 17 | +'SendButtonClick'#8'TabOrder'#2#1#0#0#5'TEdit'#8'EditSend'#4'Left'#2'0'#6'He' 18 | +'ight'#2#29#3'Top'#3'X'#1#5'Width'#3#200#0#10'OnKeyPress'#7#16'SendEditKeyPr' 19 | +'ess'#8'TabOrder'#2#2#0#0#7'TButton'#13'ButtonConnect'#4'Left'#2'0'#6'Height' 20 | +#2#25#3'Top'#3'x'#1#5'Width'#2'K'#25'BorderSpacing.InnerBorder'#2#4#7'Captio' 21 | +'n'#6#7'Connect'#7'OnClick'#7#18'ConnectButtonClick'#8'TabOrder'#2#3#0#0#7'T' 22 | +'Button'#12'ButtonListen'#4'Left'#3#136#0#6'Height'#2#25#3'Top'#3'x'#1#5'Wid' 23 | +'th'#2'K'#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#4'Host'#7'OnClick'#7 24 | +#17'ListenButtonClick'#8'TabOrder'#2#4#0#0#7'TButton'#15'ButtonDiconnect'#4 25 | +'Left'#3#224#0#6'Height'#2#25#3'Top'#3'x'#1#5'Width'#2'h'#25'BorderSpacing.I' 26 | +'nnerBorder'#2#4#7'Caption'#6#9'Diconnect'#7'OnClick'#7#20'DiconnectButtonCl' 27 | +'ick'#8'TabOrder'#2#5#0#0#11'TRadioGroup'#12'GBConnection'#4'Left'#2#24#6'He' 28 | +'ight'#3#152#0#3'Top'#2#0#5'Width'#3#144#0#8'AutoFill'#9#7'Caption'#6#15'Con' 29 | +'nection Type'#28'ChildSizing.LeftRightSpacing'#2#6#28'ChildSizing.TopBottom' 30 | +'Spacing'#2#6#29'ChildSizing.EnlargeHorizontal'#7#24'crsHomogenousChildResiz' 31 | +'e'#27'ChildSizing.EnlargeVertical'#7#24'crsHomogenousChildResize'#28'ChildS' 32 | +'izing.ShrinkHorizontal'#7#14'crsScaleChilds'#26'ChildSizing.ShrinkVertical' 33 | +#7#14'crsScaleChilds'#18'ChildSizing.Layout'#7#29'cclLeftToRightThenTopToBot' 34 | +'tom'#27'ChildSizing.ControlsPerLine'#2#1#12'ClientHeight'#3#131#0#11'Client' 35 | +'Width'#3#140#0#8'TabOrder'#2#6#0#12'TRadioButton'#5'RBTCP'#4'Left'#2#6#6'He' 36 | +'ight'#2#30#3'Top'#2#6#5'Width'#3#128#0#7'Caption'#6#8'TCP/IPv4'#7'Checked'#9 37 | +#8'OnChange'#7#11'RBTCPChange'#8'TabOrder'#2#0#7'TabStop'#9#0#0#12'TRadioBut' 38 | +'ton'#6'RBUDP4'#4'Left'#2#6#6'Height'#2#30#3'Top'#2'$'#5'Width'#3#128#0#7'Ca' 39 | +'ption'#6#8'UDP/IPv4'#8'OnChange'#7#12'RBUDP4Change'#7'OnClick'#7#11'RBUDP4C' 40 | +'lick'#8'TabOrder'#2#1#0#0#12'TRadioButton'#6'RBTCP6'#4'Left'#2#6#6'Height'#2 41 | +#30#3'Top'#2'B'#5'Width'#3#128#0#7'Caption'#6#8'TCP/IPv6'#8'OnChange'#7#12'R' 42 | +'BTCP6Change'#8'TabOrder'#2#2#0#0#12'TRadioButton'#6'RBUDP6'#4'Left'#2#6#6'H' 43 | +'eight'#2#29#3'Top'#2'`'#5'Width'#3#128#0#7'Caption'#6#8'UDP/IPv6'#8'TabOrde' 44 | +'r'#2#3#0#0#0#5'TEdit'#8'EditPort'#4'Left'#3#5#1#6'Height'#2#29#3'Top'#2#8#5 45 | +'Width'#2';'#8'TabOrder'#2#7#4'Text'#6#4'4665'#0#0#5'TEdit'#6'EditIP'#4'Left' 46 | +#3#5#1#6'Height'#2#29#3'Top'#2'!'#5'Width'#2'{'#8'TabOrder'#2#8#4'Text'#6#9 47 | +'localhost'#0#0#9'TCheckBox'#11'CheckBoxSSL'#4'Left'#3#5#1#6'Height'#2#22#3 48 | +'Top'#2'@'#5'Width'#2'N'#7'Caption'#6#7'Use SSL'#8'TabOrder'#2#9#0#0#14'TLTC' 49 | +'PComponent'#4'LTCP'#4'Port'#2#0#9'OnReceive'#7#20'LTCPComponentReceive'#7'O' 50 | +'nError'#7#18'LTCPComponentError'#12'OnDisconnect'#7#23'LTCPComponentDisconn' 51 | +'ect'#9'OnConnect'#7#20'LTCPComponentConnect'#8'OnAccept'#7#19'LTCPComponent' 52 | +'Accept'#7'Timeout'#2#0#12'ReuseAddress'#9#7'Session'#7#3'SSL'#4'left'#3'X'#1 53 | +#3'top'#3#232#0#0#0#14'TLUDPComponent'#4'LUDP'#4'Port'#2#0#9'OnReceive'#7#20 54 | +'LTCPComponentReceive'#7'OnError'#7#18'LTCPComponentError'#7'Timeout'#2#0#4 55 | +'left'#3'X'#1#3'top'#3#24#1#0#0#9'TMainMenu'#9'MainMenu1'#4'left'#3'X'#1#3't' 56 | +'op'#3#192#0#0#9'TMenuItem'#12'MenuItemFile'#7'Caption'#6#5'&File'#0#9'TMenu' 57 | +'Item'#12'MenuItemExit'#7'Caption'#6#5'E&xit'#7'OnClick'#7#17'MenuItemExitCl' 58 | +'ick'#0#0#0#9'TMenuItem'#12'MenuItemHelp'#7'Caption'#6#5'&Help'#0#9'TMenuIte' 59 | +'m'#13'MenuItemAbout'#7'Caption'#6#6'&About'#7'OnClick'#7#18'MenuItemAboutCl' 60 | +'ick'#0#0#0#0#21'TLSSLSessionComponent'#3'SSL'#6'CAFile'#6#4'cert'#7'KeyFile' 61 | +#6#4'pkey'#6'Method'#7#8'msSslTLS'#9'SSLActive'#8#4'left'#3'X'#1#3'top'#3#144 62 | +#0#0#0#6'TTimer'#9'TimerQuit'#7'Enabled'#8#8'Interval'#3#200#0#7'OnTimer'#7 63 | +#14'TimerQuitTimer'#4'left'#3'X'#1#3'top'#2'_'#0#0#0 64 | ]); 65 | -------------------------------------------------------------------------------- /examples/visual/ftp/sitesunit.lrs: -------------------------------------------------------------------------------- 1 | LazarusResources.Add('TfrmSites','FORMDATA',[ 2 | 'TPF0'#9'TfrmSites'#8'frmSites'#4'Left'#3'K'#1#6'Height'#3'A'#1#3'Top'#3#226#0 3 | +#5'Width'#3')'#2#13'ActiveControl'#7#7'txtSite'#7'Caption'#6#16'Registered S' 4 | +'ites'#12'ClientHeight'#3'A'#1#11'ClientWidth'#3')'#2#12'OnCloseQuery'#7#14 5 | +'FormCloseQuery'#6'OnShow'#7#8'FormShow'#10'LCLVersion'#6#6'0.9.29'#0#6'TLab' 6 | +'el'#6'Label1'#4'Left'#2#8#6'Height'#2#16#3'Top'#2#8#5'Width'#2'"'#7'Caption' 7 | +#6#6'Sites:'#11'ParentColor'#8#0#0#6'TLabel'#6'Label2'#4'Left'#3#172#0#6'Hei' 8 | +'ght'#2#16#3'Top'#3#208#0#5'Width'#2'>'#7'Caption'#6#10'Local Path'#11'Paren' 9 | +'tColor'#8#0#0#8'TListBox'#7'lbSites'#4'Left'#2#8#6'Height'#3#31#1#3'Top'#2 10 | +#24#5'Width'#3#156#0#7'Anchors'#11#5'akTop'#6'akLeft'#8'akBottom'#0#10'ItemH' 11 | +'eight'#2#0#7'OnClick'#7#12'lbSitesClick'#9'PopupMenu'#7#14'PopupMenuSites'#8 12 | +'TabOrder'#2#0#8'TopIndex'#2#255#0#0#12'TLabeledEdit'#7'txtHost'#4'Left'#3 13 | +#172#0#6'Height'#2#25#3'Top'#2'H'#5'Width'#3#241#0#7'Anchors'#11#5'akTop'#6 14 | +'akLeft'#7'akRight'#0' EditLabel.AnchorSideLeft.Control'#7#7'txtHost"EditLab' 15 | +'el.AnchorSideBottom.Control'#7#7'txtHost'#14'EditLabel.Left'#3#172#0#16'Edi' 16 | +'tLabel.Height'#2#16#13'EditLabel.Top'#2'5'#15'EditLabel.Width'#2#28#17'Edit' 17 | +'Label.Caption'#6#4'Host'#21'EditLabel.ParentColor'#8#8'TabOrder'#2#2#8'OnCh' 18 | +'ange'#7#13'txtSiteChange'#0#0#12'TLabeledEdit'#7'txtPath'#4'Left'#3#172#0#6 19 | +'Height'#2#25#3'Top'#2'x'#5'Width'#3'q'#1#7'Anchors'#11#5'akTop'#6'akLeft'#7 20 | +'akRight'#0' EditLabel.AnchorSideLeft.Control'#7#7'txtPath"EditLabel.AnchorS' 21 | +'ideBottom.Control'#7#7'txtPath'#14'EditLabel.Left'#3#172#0#16'EditLabel.Hei' 22 | +'ght'#2#16#13'EditLabel.Top'#2'e'#15'EditLabel.Width'#2#27#17'EditLabel.Capt' 23 | +'ion'#6#4'Path'#21'EditLabel.ParentColor'#8#8'TabOrder'#2#4#8'OnChange'#7#13 24 | +'txtSiteChange'#0#0#12'TLabeledEdit'#7'txtUser'#4'Left'#3#172#0#6'Height'#2 25 | +#25#3'Top'#3#169#0#5'Width'#3#185#0#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRig' 26 | +'ht'#0' EditLabel.AnchorSideLeft.Control'#7#7'txtUser"EditLabel.AnchorSideBo' 27 | +'ttom.Control'#7#7'txtUser'#14'EditLabel.Left'#3#172#0#16'EditLabel.Height'#2 28 | +#16#13'EditLabel.Top'#3#150#0#15'EditLabel.Width'#2#28#17'EditLabel.Caption' 29 | +#6#4'User'#21'EditLabel.ParentColor'#8#8'TabOrder'#2#5#8'OnChange'#7#13'txtS' 30 | +'iteChange'#0#0#12'TLabeledEdit'#7'txtPass'#4'Left'#3'u'#1#6'Height'#2#25#3 31 | +'Top'#3#169#0#5'Width'#3#168#0#7'Anchors'#11#5'akTop'#7'akRight'#0#8'EchoMod' 32 | +'e'#7#10'emPassword EditLabel.AnchorSideLeft.Control'#7#7'txtPass"EditLabel.' 33 | +'AnchorSideBottom.Control'#7#7'txtPass'#14'EditLabel.Left'#3'u'#1#16'EditLab' 34 | +'el.Height'#2#16#13'EditLabel.Top'#3#150#0#15'EditLabel.Width'#2#26#17'EditL' 35 | +'abel.Caption'#6#4'Pass'#21'EditLabel.ParentColor'#8#12'PasswordChar'#6#1'+' 36 | +#8'TabOrder'#2#6#8'OnChange'#7#13'txtSiteChange'#0#0#12'TLabeledEdit'#7'txtS' 37 | +'ite'#4'Left'#3#172#0#6'Height'#2#25#3'Top'#2#24#5'Width'#3'q'#1#7'Anchors' 38 | +#11#5'akTop'#6'akLeft'#7'akRight'#0' EditLabel.AnchorSideLeft.Control'#7#7't' 39 | +'xtSite"EditLabel.AnchorSideBottom.Control'#7#7'txtSite'#14'EditLabel.Left'#3 40 | +#172#0#16'EditLabel.Height'#2#16#13'EditLabel.Top'#2#5#15'EditLabel.Width'#2 41 | +#24#17'EditLabel.Caption'#6#4'Site'#21'EditLabel.ParentColor'#8#8'TabOrder'#2 42 | +#1#8'OnChange'#7#13'txtSiteChange'#0#0#7'TBitBtn'#7'btnSave'#4'Left'#3#20#1#6 43 | +'Height'#2'.'#3'Top'#3#9#1#5'Width'#2'_'#7'Anchors'#11#7'akRight'#8'akBottom' 44 | +#0#7'Caption'#6#9'Save Site'#9'NumGlyphs'#2#0#7'OnClick'#7#12'btnSaveClick'#8 45 | +'TabOrder'#2#8#0#0#7'TBitBtn'#8'btnClose'#4'Left'#3#214#1#6'Height'#2'.'#3'T' 46 | +'op'#3#9#1#5'Width'#2'G'#7'Anchors'#11#7'akRight'#8'akBottom'#0#7'Caption'#6 47 | +#5'Close'#9'NumGlyphs'#2#0#7'OnClick'#7#13'btnCloseClick'#8'TabOrder'#2#10#0 48 | +#0#7'TBitBtn'#10'btnConnect'#4'Left'#3'x'#1#6'Height'#2'.'#3'Top'#3#9#1#5'Wi' 49 | +'dth'#2'Z'#7'Anchors'#11#7'akRight'#8'akBottom'#0#7'Caption'#6#7'Connect'#9 50 | +'NumGlyphs'#2#0#7'OnClick'#7#15'btnConnectClick'#8'TabOrder'#2#9#0#0#7'TBitB' 51 | +'tn'#10'btnAddSite'#4'Left'#3#172#0#6'Height'#2'.'#3'Top'#3#9#1#5'Width'#2'c' 52 | +#7'Anchors'#11#7'akRight'#8'akBottom'#0#7'Caption'#6#8'Add Site'#9'NumGlyphs' 53 | +#2#0#7'OnClick'#7#15'btnAddSiteClick'#8'TabOrder'#2#7#0#0#12'TLabeledEdit'#7 54 | +'txtPort'#4'Left'#3#165#1#6'Height'#2#25#3'Top'#2'H'#5'Width'#2'x'#7'Anchors' 55 | +#11#5'akTop'#7'akRight'#0' EditLabel.AnchorSideLeft.Control'#7#7'txtPort"Edi' 56 | +'tLabel.AnchorSideBottom.Control'#7#7'txtPort'#14'EditLabel.Left'#3#165#1#16 57 | +'EditLabel.Height'#2#16#13'EditLabel.Top'#2'5'#15'EditLabel.Width'#2#25#17'E' 58 | +'ditLabel.Caption'#6#4'Port'#21'EditLabel.ParentColor'#8#8'TabOrder'#2#3#4'T' 59 | +'ext'#6#2'21'#0#0#14'TDirectoryEdit'#7'txtLDir'#4'Left'#3#172#0#6'Height'#2 60 | +#25#3'Top'#3#224#0#5'Width'#3'Y'#1#10'ShowHidden'#8#11'ButtonWidth'#2#23#9'N' 61 | +'umGlyphs'#2#0#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#9'MaxLength'#2#0 62 | +#8'TabOrder'#2#11#8'OnChange'#7#13'txtSiteChange'#0#0#10'TPopupMenu'#14'Popu' 63 | +'pMenuSites'#4'left'#3#251#1#0#9'TMenuItem'#18'MenuItemSiteDelete'#7'Caption' 64 | +#6#7'&Delete'#7'OnClick'#7#23'MenuItemSiteDeleteClick'#0#0#0#0 65 | ]); 66 | -------------------------------------------------------------------------------- /lib/lprocess.pp: -------------------------------------------------------------------------------- 1 | { Asynchronous process support 2 | 3 | Copyright (C) 2006-2008 Micha Nelissen 4 | 5 | This library is Free software; you can redistribute it and/or modify it 6 | under the terms of the GNU Library General Public License as published by 7 | the Free Software Foundation; either version 2 of the License, or (at your 8 | option) any later version. 9 | 10 | This program is diStributed in the hope that it will be useful, but WITHOUT 11 | ANY WARRANTY; withOut even the implied warranty of MERCHANTABILITY or 12 | FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License 13 | for more details. 14 | 15 | You should have received a Copy of the GNU Library General Public License 16 | along with This library; if not, Write to the Free Software Foundation, 17 | Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 18 | 19 | This license has been modified. See file LICENSE.ADDON for more information. 20 | Should you find these sources without a LICENSE File, please contact 21 | me at ales@chello.sk 22 | } 23 | 24 | unit lProcess; 25 | 26 | {$mode objfpc}{$h+} 27 | 28 | interface 29 | 30 | uses 31 | sysutils, classes, process, levents, pipes; 32 | 33 | type 34 | TLInputPipeStream = class(TInputPipeStream) 35 | protected 36 | FEvent: TLHandle; 37 | public 38 | function Read(var Buffer; Count: longint): longint; override; 39 | end; 40 | 41 | TLOutputPipeStream = class(TOutputPipeStream) 42 | protected 43 | FEvent: TLHandle; 44 | public 45 | function Write(const Buffer; Count: longint): longint; override; 46 | end; 47 | 48 | TLProcess = class(TProcess) 49 | protected 50 | FInputEvent: TLHandle; 51 | FOutputEvent: TLHandle; 52 | FStderrEvent: TLHandle; 53 | FEventer: TLEventer; 54 | 55 | function GetOnNeedInput: TLHandleEvent; 56 | function GetOnHasOutput: TLHandleEvent; 57 | function GetOnHasStderr: TLHandleEvent; 58 | procedure SetOnNeedInput(NewOnInput: TLHandleEvent); 59 | procedure SetOnHasOutput(NewOnOutput: TLHandleEvent); 60 | procedure SetOnHasStderr(NewOnStderr: TLHandleEvent); 61 | public 62 | constructor Create(AOwner: TComponent); override; 63 | destructor Destroy; override; 64 | 65 | procedure CloseInput; override; 66 | procedure CloseOutput; override; 67 | procedure CloseStderr; override; 68 | procedure Execute; override; 69 | 70 | property InputEvent: TLHandle read FInputEvent; 71 | property OutputEvent: TLHandle read FOutputEvent; 72 | property StderrEvent: TLHandle read FStderrEvent; 73 | property Eventer: TLEventer read FEventer write FEventer; 74 | property OnNeedInput: TLHandleEvent read GetOnNeedInput write SetOnNeedInput; 75 | property OnHasOutput: TLHandleEvent read GetOnHasOutput write SetOnHasOutput; 76 | property OnHasStderr: TLHandleEvent read GetOnHasStderr write SetOnHasStderr; 77 | end; 78 | 79 | implementation 80 | 81 | function TLInputPipeStream.Read(var Buffer; Count: longint): longint; 82 | begin 83 | Result := inherited; 84 | FEvent.IgnoreRead := false; 85 | end; 86 | 87 | function TLOutputPipeStream.Write(const Buffer; Count: longint): longint; 88 | begin 89 | Result := inherited; 90 | FEvent.IgnoreWrite := false; 91 | end; 92 | 93 | constructor TLProcess.Create(AOwner: TComponent); 94 | begin 95 | inherited; 96 | 97 | FInputEvent := TLHandle.Create; 98 | FOutputEvent := TLHandle.Create; 99 | FStderrEvent := TLHandle.Create; 100 | end; 101 | 102 | destructor TLProcess.Destroy; 103 | begin 104 | inherited; 105 | FInputEvent.Free; 106 | FOutputEvent.Free; 107 | FStderrEvent.Free; 108 | end; 109 | 110 | procedure TLProcess.CloseInput; 111 | begin 112 | FEventer.UnplugHandle(FInputEvent); 113 | inherited; 114 | end; 115 | 116 | procedure TLProcess.CloseOutput; 117 | begin 118 | FEventer.UnplugHandle(FOutputEvent); 119 | inherited; 120 | end; 121 | 122 | procedure TLProcess.CloseStderr; 123 | begin 124 | FEventer.UnplugHandle(FStderrEvent); 125 | inherited; 126 | end; 127 | 128 | procedure TLProcess.Execute; 129 | begin 130 | inherited; 131 | 132 | if (poUsePipes in Options) and (FEventer <> nil) then 133 | begin 134 | if Input <> nil then 135 | begin 136 | FInputEvent.Handle := Input.Handle; 137 | FInputEvent.IgnoreRead := true; 138 | FEventer.AddHandle(FInputEvent); 139 | end; 140 | if Output <> nil then 141 | begin 142 | FOutputEvent.Handle := Output.Handle; 143 | FOutputEvent.IgnoreWrite := true; 144 | FEventer.AddHandle(FOutputEvent); 145 | end; 146 | if Stderr <> nil then 147 | begin 148 | FStderrEvent.Handle := Stderr.Handle; 149 | FStderrEvent.IgnoreWrite := true; 150 | FEventer.AddHandle(FStderrEvent); 151 | end; 152 | end; 153 | end; 154 | 155 | function TLProcess.GetOnNeedInput: TLHandleEvent; 156 | begin 157 | Result := FInputEvent.OnWrite; 158 | end; 159 | 160 | function TLProcess.GetOnHasOutput: TLHandleEvent; 161 | begin 162 | Result := FOutputEvent.OnRead; 163 | end; 164 | 165 | function TLProcess.GetOnHasStderr: TLHandleEvent; 166 | begin 167 | Result := FStderrEvent.OnRead; 168 | end; 169 | 170 | procedure TLProcess.SetOnNeedInput(NewOnInput: TLHandleEvent); 171 | begin 172 | FInputEvent.OnWrite := NewOnInput; 173 | end; 174 | 175 | procedure TLProcess.SetOnHasOutput(NewOnOutput: TLHandleEvent); 176 | begin 177 | FOutputEvent.OnRead := NewOnOutput; 178 | end; 179 | 180 | procedure TLProcess.SetOnHasStderr(NewOnStderr: TLHandleEvent); 181 | begin 182 | FStderrEvent.OnRead := NewOnStderr; 183 | end; 184 | 185 | end. 186 | -------------------------------------------------------------------------------- /lazaruspackage/lnetbase.lpk: -------------------------------------------------------------------------------- 1 | <?xml version="1.0"?> 2 | <CONFIG> 3 | <Package Version="3"> 4 | <Name Value="lnetbase"/> 5 | <Author Value="Aleš Katona, Micha Nelissen"/> 6 | <CompilerOptions> 7 | <Version Value="10"/> 8 | <SearchPaths> 9 | <IncludeFiles Value="../lib/sys"/> 10 | <OtherUnitFiles Value="../lib"/> 11 | <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> 12 | <SrcPath Value="../lib;../lib/sys"/> 13 | </SearchPaths> 14 | <Parsing> 15 | <SyntaxOptions> 16 | <CStyleOperator Value="False"/> 17 | <CStyleMacros Value="True"/> 18 | <UseAnsiStrings Value="False"/> 19 | </SyntaxOptions> 20 | </Parsing> 21 | <CodeGeneration> 22 | <SmartLinkUnit Value="True"/> 23 | <Optimizations> 24 | <OptimizationLevel Value="2"/> 25 | </Optimizations> 26 | </CodeGeneration> 27 | <Linking> 28 | <Debugging> 29 | <GenerateDebugInfo Value="True"/> 30 | </Debugging> 31 | </Linking> 32 | <Other> 33 | <Verbosity> 34 | <ShowNotes Value="False"/> 35 | <ShowHints Value="False"/> 36 | <ShowGenInfo Value="False"/> 37 | </Verbosity> 38 | <CompilerMessages> 39 | <UseMsgFile Value="True"/> 40 | </CompilerMessages> 41 | <CustomOptions Value="-dLNET_BASE"/> 42 | <CompilerPath Value="$(CompPath)"/> 43 | </Other> 44 | </CompilerOptions> 45 | <Description Value="Lightweight Networking Library, or lNet is a networking suite providing simple and effective means to use TCP, UDP, FTP, SMTP, Telnet and HTTP protocols over the net. 46 | "/> 47 | <License Value="LGPL with exception, see LICENSE and LICENSE.addon 48 | "/> 49 | <Version Minor="6" Release="6"/> 50 | <Files Count="27"> 51 | <Item1> 52 | <Filename Value="../lib/lnet.pp"/> 53 | <UnitName Value="lNet"/> 54 | </Item1> 55 | <Item2> 56 | <Filename Value="../lib/levents.pp"/> 57 | <UnitName Value="lEvents"/> 58 | </Item2> 59 | <Item3> 60 | <Filename Value="../lib/lcommon.pp"/> 61 | <UnitName Value="lCommon"/> 62 | </Item3> 63 | <Item4> 64 | <Filename Value="../lib/lftp.pp"/> 65 | <UnitName Value="lFTP"/> 66 | </Item4> 67 | <Item5> 68 | <Filename Value="../lib/lsmtp.pp"/> 69 | <UnitName Value="lsmtp"/> 70 | </Item5> 71 | <Item6> 72 | <Filename Value="../lib/ltelnet.pp"/> 73 | <UnitName Value="lTelnet"/> 74 | </Item6> 75 | <Item7> 76 | <Filename Value="../lib/lhttp.pp"/> 77 | <UnitName Value="lhttp"/> 78 | </Item7> 79 | <Item8> 80 | <Filename Value="../lib/lwebserver.pp"/> 81 | <UnitName Value="lwebserver"/> 82 | </Item8> 83 | <Item9> 84 | <Filename Value="../lib/lmimewrapper.pp"/> 85 | <UnitName Value="lMimeWrapper"/> 86 | </Item9> 87 | <Item10> 88 | <Filename Value="../lib/lhttputil.pp"/> 89 | <UnitName Value="lHTTPUtil"/> 90 | </Item10> 91 | <Item11> 92 | <Filename Value="../lib/lcontrolstack.pp"/> 93 | <UnitName Value="lControlStack"/> 94 | </Item11> 95 | <Item12> 96 | <Filename Value="../lib/lmimestreams.pp"/> 97 | <UnitName Value="lMimeStreams"/> 98 | </Item12> 99 | <Item13> 100 | <Filename Value="../lib/lmimetypes.pp"/> 101 | <UnitName Value="lMimeTypes"/> 102 | </Item13> 103 | <Item14> 104 | <Filename Value="../lib/lprocess.pp"/> 105 | <UnitName Value="lProcess"/> 106 | </Item14> 107 | <Item15> 108 | <Filename Value="../lib/lspawnfcgi.pp"/> 109 | <UnitName Value="lSpawnFCGI"/> 110 | </Item15> 111 | <Item16> 112 | <Filename Value="../lib/lstrbuffer.pp"/> 113 | <UnitName Value="lStrBuffer"/> 114 | </Item16> 115 | <Item17> 116 | <Filename Value="../lib/ltimer.pp"/> 117 | <UnitName Value="ltimer"/> 118 | </Item17> 119 | <Item18> 120 | <Filename Value="../lib/sys/osunits.inc"/> 121 | <Type Value="Include"/> 122 | </Item18> 123 | <Item19> 124 | <Filename Value="../lib/sys/lspawnfcgiunix.inc"/> 125 | <Type Value="Include"/> 126 | </Item19> 127 | <Item20> 128 | <Filename Value="../lib/sys/lspawnfcgiwin.inc"/> 129 | <Type Value="Include"/> 130 | </Item20> 131 | <Item21> 132 | <Filename Value="../lib/sys/lepolleventerh.inc"/> 133 | <Type Value="Include"/> 134 | </Item21> 135 | <Item22> 136 | <Filename Value="../lib/sys/lepolleventer.inc"/> 137 | <Type Value="Include"/> 138 | </Item22> 139 | <Item23> 140 | <Filename Value="../lib/sys/lkqueueeventerh.inc"/> 141 | <Type Value="Include"/> 142 | </Item23> 143 | <Item24> 144 | <Filename Value="../lib/sys/lkqueueeventer.inc"/> 145 | <Type Value="Include"/> 146 | </Item24> 147 | <Item25> 148 | <Filename Value="../lib/lnetssl.pp"/> 149 | <UnitName Value="lNetSSL"/> 150 | </Item25> 151 | <Item26> 152 | <Filename Value="../lib/lthreadevents.pp"/> 153 | <UnitName Value="lThreadEvents"/> 154 | </Item26> 155 | <Item27> 156 | <Filename Value="../lib/fastcgi_base.pp"/> 157 | <UnitName Value="fastcgi_base"/> 158 | </Item27> 159 | </Files> 160 | <UsageOptions> 161 | <UnitPath Value="$(PkgOutDir)"/> 162 | </UsageOptions> 163 | <PublishOptions> 164 | <Version Value="2"/> 165 | <IgnoreBinaries Value="False"/> 166 | </PublishOptions> 167 | </Package> 168 | </CONFIG> 169 | -------------------------------------------------------------------------------- /examples/visual/ftp/sitesunit.lfm: -------------------------------------------------------------------------------- 1 | object frmSites: TfrmSites 2 | Left = 331 3 | Height = 321 4 | Top = 226 5 | Width = 553 6 | ActiveControl = txtSite 7 | Caption = 'Registered Sites' 8 | ClientHeight = 321 9 | ClientWidth = 553 10 | OnCloseQuery = FormCloseQuery 11 | OnShow = FormShow 12 | LCLVersion = '0.9.29' 13 | object Label1: TLabel 14 | Left = 8 15 | Height = 16 16 | Top = 8 17 | Width = 34 18 | Caption = 'Sites:' 19 | ParentColor = False 20 | end 21 | object Label2: TLabel 22 | Left = 172 23 | Height = 16 24 | Top = 208 25 | Width = 62 26 | Caption = 'Local Path' 27 | ParentColor = False 28 | end 29 | object lbSites: TListBox 30 | Left = 8 31 | Height = 287 32 | Top = 24 33 | Width = 156 34 | Anchors = [akTop, akLeft, akBottom] 35 | ItemHeight = 0 36 | OnClick = lbSitesClick 37 | PopupMenu = PopupMenuSites 38 | TabOrder = 0 39 | TopIndex = -1 40 | end 41 | object txtHost: TLabeledEdit 42 | Left = 172 43 | Height = 25 44 | Top = 72 45 | Width = 241 46 | Anchors = [akTop, akLeft, akRight] 47 | EditLabel.AnchorSideLeft.Control = txtHost 48 | EditLabel.AnchorSideBottom.Control = txtHost 49 | EditLabel.Left = 172 50 | EditLabel.Height = 16 51 | EditLabel.Top = 53 52 | EditLabel.Width = 28 53 | EditLabel.Caption = 'Host' 54 | EditLabel.ParentColor = False 55 | TabOrder = 2 56 | OnChange = txtSiteChange 57 | end 58 | object txtPath: TLabeledEdit 59 | Left = 172 60 | Height = 25 61 | Top = 120 62 | Width = 369 63 | Anchors = [akTop, akLeft, akRight] 64 | EditLabel.AnchorSideLeft.Control = txtPath 65 | EditLabel.AnchorSideBottom.Control = txtPath 66 | EditLabel.Left = 172 67 | EditLabel.Height = 16 68 | EditLabel.Top = 101 69 | EditLabel.Width = 27 70 | EditLabel.Caption = 'Path' 71 | EditLabel.ParentColor = False 72 | TabOrder = 4 73 | OnChange = txtSiteChange 74 | end 75 | object txtUser: TLabeledEdit 76 | Left = 172 77 | Height = 25 78 | Top = 169 79 | Width = 185 80 | Anchors = [akTop, akLeft, akRight] 81 | EditLabel.AnchorSideLeft.Control = txtUser 82 | EditLabel.AnchorSideBottom.Control = txtUser 83 | EditLabel.Left = 172 84 | EditLabel.Height = 16 85 | EditLabel.Top = 150 86 | EditLabel.Width = 28 87 | EditLabel.Caption = 'User' 88 | EditLabel.ParentColor = False 89 | TabOrder = 5 90 | OnChange = txtSiteChange 91 | end 92 | object txtPass: TLabeledEdit 93 | Left = 373 94 | Height = 25 95 | Top = 169 96 | Width = 168 97 | Anchors = [akTop, akRight] 98 | EchoMode = emPassword 99 | EditLabel.AnchorSideLeft.Control = txtPass 100 | EditLabel.AnchorSideBottom.Control = txtPass 101 | EditLabel.Left = 373 102 | EditLabel.Height = 16 103 | EditLabel.Top = 150 104 | EditLabel.Width = 26 105 | EditLabel.Caption = 'Pass' 106 | EditLabel.ParentColor = False 107 | PasswordChar = '+' 108 | TabOrder = 6 109 | OnChange = txtSiteChange 110 | end 111 | object txtSite: TLabeledEdit 112 | Left = 172 113 | Height = 25 114 | Top = 24 115 | Width = 369 116 | Anchors = [akTop, akLeft, akRight] 117 | EditLabel.AnchorSideLeft.Control = txtSite 118 | EditLabel.AnchorSideBottom.Control = txtSite 119 | EditLabel.Left = 172 120 | EditLabel.Height = 16 121 | EditLabel.Top = 5 122 | EditLabel.Width = 24 123 | EditLabel.Caption = 'Site' 124 | EditLabel.ParentColor = False 125 | TabOrder = 1 126 | OnChange = txtSiteChange 127 | end 128 | object btnSave: TBitBtn 129 | Left = 276 130 | Height = 46 131 | Top = 265 132 | Width = 95 133 | Anchors = [akRight, akBottom] 134 | Caption = 'Save Site' 135 | NumGlyphs = 0 136 | OnClick = btnSaveClick 137 | TabOrder = 8 138 | end 139 | object btnClose: TBitBtn 140 | Left = 470 141 | Height = 46 142 | Top = 265 143 | Width = 71 144 | Anchors = [akRight, akBottom] 145 | Caption = 'Close' 146 | NumGlyphs = 0 147 | OnClick = btnCloseClick 148 | TabOrder = 10 149 | end 150 | object btnConnect: TBitBtn 151 | Left = 376 152 | Height = 46 153 | Top = 265 154 | Width = 90 155 | Anchors = [akRight, akBottom] 156 | Caption = 'Connect' 157 | NumGlyphs = 0 158 | OnClick = btnConnectClick 159 | TabOrder = 9 160 | end 161 | object btnAddSite: TBitBtn 162 | Left = 172 163 | Height = 46 164 | Top = 265 165 | Width = 99 166 | Anchors = [akRight, akBottom] 167 | Caption = 'Add Site' 168 | NumGlyphs = 0 169 | OnClick = btnAddSiteClick 170 | TabOrder = 7 171 | end 172 | object txtPort: TLabeledEdit 173 | Left = 421 174 | Height = 25 175 | Top = 72 176 | Width = 120 177 | Anchors = [akTop, akRight] 178 | EditLabel.AnchorSideLeft.Control = txtPort 179 | EditLabel.AnchorSideBottom.Control = txtPort 180 | EditLabel.Left = 421 181 | EditLabel.Height = 16 182 | EditLabel.Top = 53 183 | EditLabel.Width = 25 184 | EditLabel.Caption = 'Port' 185 | EditLabel.ParentColor = False 186 | TabOrder = 3 187 | Text = '21' 188 | end 189 | object txtLDir: TDirectoryEdit 190 | Left = 172 191 | Height = 25 192 | Top = 224 193 | Width = 345 194 | ShowHidden = False 195 | ButtonWidth = 23 196 | NumGlyphs = 0 197 | Anchors = [akTop, akLeft, akRight] 198 | MaxLength = 0 199 | TabOrder = 11 200 | OnChange = txtSiteChange 201 | end 202 | object PopupMenuSites: TPopupMenu 203 | left = 507 204 | object MenuItemSiteDelete: TMenuItem 205 | Caption = '&Delete' 206 | OnClick = MenuItemSiteDeleteClick 207 | end 208 | end 209 | end 210 | -------------------------------------------------------------------------------- /lib/lthreadevents.pp: -------------------------------------------------------------------------------- 1 | unit lThreadEvents; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | interface 6 | 7 | uses 8 | Classes, SysUtils, 9 | lNet, lEvents; 10 | 11 | type 12 | 13 | { TWorkThread } 14 | 15 | TLWorkThread = class(TThread) 16 | private 17 | FEventer: TLEventer; 18 | FWorking: Boolean; 19 | FQuit: Boolean; 20 | public 21 | constructor Create(CreateSuspended: Boolean; const StackSize: SizeUInt= 22 | DefaultStackSize); 23 | destructor Destroy; override; 24 | procedure Execute; override; 25 | property Working: Boolean read FWorking; 26 | property Quit: Boolean read FQuit write FQuit; 27 | property Eventer: TLEventer read FEventer; 28 | end; 29 | 30 | { TLThreadedEventer } 31 | 32 | TLThreadedEventer = class(TLEventer) 33 | protected 34 | FWorkThread: array of TLWorkThread; 35 | FThreadCount: Integer; 36 | FThreadsCreated: Boolean; 37 | FTimeout: Integer; 38 | procedure CreateWorkThreads(aEventerClass: TLEventerClass); 39 | 40 | function GetWorkThread(const i: Integer): TLWorkThread; 41 | function GetCount: Integer; override; 42 | function GetTimeout: Integer; override; 43 | procedure SetTimeout(const aValue: Integer); override; 44 | procedure SetThreadCount(const aValue: Integer); 45 | public 46 | constructor Create(const aThreadCount: Integer); 47 | constructor Create; override; 48 | destructor Destroy; override; 49 | { AddHandle is called from within lNet unit as FEventer.AddHandle 50 | base on TLConnection's eventer, which means this eventer } 51 | function AddHandle(aHandle: TLHandle): Boolean; override; 52 | function CallAction: Boolean; override; 53 | public 54 | property WorkThreads[i: Integer]: TLWorkThread read GetWorkThread; 55 | property ThreadCount: Integer read FThreadCount write SetThreadCount; 56 | end; 57 | TLThreadedEventerClass = class of TLThreadedEventer; 58 | 59 | implementation 60 | 61 | { TLWorkThread } 62 | 63 | constructor TLWorkThread.Create(CreateSuspended: Boolean; 64 | const StackSize: SizeUInt); 65 | begin 66 | FWorking := True; // needed for special case 67 | 68 | inherited Create(CreateSuspended, StackSize); 69 | end; 70 | 71 | destructor TLWorkThread.Destroy; 72 | begin 73 | FEventer.Free; 74 | 75 | inherited Destroy; 76 | end; 77 | 78 | procedure TLWorkThread.Execute; 79 | begin 80 | FWorking := True; 81 | 82 | while not FQuit do 83 | FEventer.CallAction; 84 | 85 | FWorking := False; 86 | FQuit := False; // auto-flip 87 | end; 88 | 89 | { TLThreadedEventer } 90 | 91 | procedure TLThreadedEventer.CreateWorkThreads(aEventerClass: TLEventerClass); 92 | var 93 | i: Integer; 94 | begin 95 | SetLength(FWorkThread, FThreadCount); 96 | 97 | for i := 0 to FThreadCount - 1 do begin 98 | FWorkThread[i] := TLWorkThread.Create(True); 99 | FWorkThread[i].FEventer := aEventerClass.Create; 100 | FWorkThread[i].FEventer.Timeout := FTimeout; 101 | FWorkThread[i].Start; 102 | end; 103 | 104 | FThreadsCreated := True; 105 | end; 106 | 107 | function TLThreadedEventer.GetWorkThread(const i: Integer): TLWorkThread; 108 | begin 109 | Result := FWorkThread[i]; 110 | end; 111 | 112 | function TLThreadedEventer.GetCount: Integer; 113 | var 114 | i: Integer; 115 | begin 116 | Result := 0; 117 | for i := 0 to FThreadCount - 1 do 118 | Result := Result + FWorkThread[i].Eventer.Count; 119 | end; 120 | 121 | function TLThreadedEventer.GetTimeout: Integer; 122 | begin 123 | Result := FTimeout; 124 | end; 125 | 126 | procedure TLThreadedEventer.SetTimeout(const aValue: Integer); 127 | var 128 | i: Integer; 129 | begin 130 | if aValue < 0 then 131 | raise Exception.Create('TThreadedEventer must have Timeout >= 0'); 132 | 133 | FTimeout := aValue; 134 | if FThreadsCreated then 135 | for i := 0 to FThreadCount - 1 do 136 | FWorkThread[i].Eventer.Timeout := aValue; 137 | end; 138 | 139 | procedure TLThreadedEventer.SetThreadCount(const aValue: Integer); 140 | begin 141 | if aValue > 0 then 142 | FThreadCount := aValue 143 | else 144 | FThreadCount := 1; 145 | end; 146 | 147 | constructor TLThreadedEventer.Create(const aThreadCount: Integer); 148 | begin 149 | inherited Create; 150 | 151 | FTimeout := 50; // default, good enough 152 | SetThreadCount(aThreadCount); 153 | end; 154 | 155 | constructor TLThreadedEventer.Create; 156 | begin 157 | Create(1); 158 | end; 159 | 160 | destructor TLThreadedEventer.Destroy; 161 | var 162 | i: Integer; 163 | begin 164 | if FThreadsCreated then begin 165 | for i := 0 to FThreadCount - 1 do // tell them all to quit at once, so we wait max DEF_TIMEOUT ms 166 | if FWorkThread[i].Working then 167 | FWorkThread[i].Quit := True; 168 | 169 | for i := 0 to FThreadCount - 1 do begin 170 | FWorkThread[i].WaitFor; 171 | FWorkThread[i].Free; 172 | end; 173 | end; 174 | 175 | inherited Destroy; 176 | end; 177 | 178 | function TLThreadedEventer.AddHandle(aHandle: TLHandle): Boolean; 179 | var 180 | i, j, c: Integer; 181 | begin 182 | if not FThreadsCreated then 183 | CreateWorkThreads(BestEventerClass); 184 | 185 | if aHandle is TLSocket then 186 | TLSocket(aHandle).SetState(ssBlocking, True); 187 | 188 | { Find the thread with lowest count } 189 | c := FWorkThread[0].Eventer.Count; 190 | j := 0; 191 | for i := 0 to FThreadCount - 1 do 192 | if FWorkThread[i].Eventer.Count < c then begin 193 | c := FWorkThread[i].Eventer.Count; 194 | j := i; 195 | end; 196 | { And add the new handle to it } 197 | Result := FWorkThread[j].Eventer.AddHandle(aHandle); 198 | end; 199 | 200 | function TLThreadedEventer.CallAction: Boolean; 201 | begin 202 | Result := inherited; 203 | 204 | Sleep(FTimeout); 205 | end; 206 | 207 | end. 208 | 209 | -------------------------------------------------------------------------------- /examples/visual/tcpudp/main.lfm: -------------------------------------------------------------------------------- 1 | object FormMain: TFormMain 2 | Left = 582 3 | Height = 451 4 | Top = 332 5 | Width = 390 6 | ActiveControl = EditPort 7 | Caption = 'lNet Component Test' 8 | ClientHeight = 426 9 | ClientWidth = 390 10 | Constraints.MaxWidth = 390 11 | Constraints.MinHeight = 400 12 | Constraints.MinWidth = 390 13 | Menu = MainMenu1 14 | OnClose = FormClose 15 | OnCreate = FormCreate 16 | LCLVersion = '1.8.4.0' 17 | object LabelPort: TLabel 18 | Left = 216 19 | Height = 19 20 | Top = 13 21 | Width = 32 22 | Caption = 'Port:' 23 | ParentColor = False 24 | end 25 | object LabelHostName: TLabel 26 | Left = 176 27 | Height = 19 28 | Top = 36 29 | Width = 72 30 | Caption = 'Hostname:' 31 | ParentColor = False 32 | end 33 | object MemoText: TMemo 34 | Left = 48 35 | Height = 176 36 | Top = 160 37 | Width = 280 38 | ReadOnly = True 39 | ScrollBars = ssAutoBoth 40 | TabOrder = 0 41 | end 42 | object ButtonSend: TButton 43 | Left = 253 44 | Height = 25 45 | Top = 342 46 | Width = 75 47 | BorderSpacing.InnerBorder = 4 48 | Caption = 'Send' 49 | OnClick = SendButtonClick 50 | TabOrder = 1 51 | end 52 | object EditSend: TEdit 53 | Left = 48 54 | Height = 29 55 | Top = 344 56 | Width = 200 57 | OnKeyPress = SendEditKeyPress 58 | TabOrder = 2 59 | end 60 | object ButtonConnect: TButton 61 | Left = 48 62 | Height = 25 63 | Top = 376 64 | Width = 75 65 | BorderSpacing.InnerBorder = 4 66 | Caption = 'Connect' 67 | OnClick = ConnectButtonClick 68 | TabOrder = 3 69 | end 70 | object ButtonListen: TButton 71 | Left = 136 72 | Height = 25 73 | Top = 376 74 | Width = 75 75 | BorderSpacing.InnerBorder = 4 76 | Caption = 'Host' 77 | OnClick = ListenButtonClick 78 | TabOrder = 4 79 | end 80 | object ButtonDiconnect: TButton 81 | Left = 224 82 | Height = 25 83 | Top = 376 84 | Width = 104 85 | BorderSpacing.InnerBorder = 4 86 | Caption = 'Diconnect' 87 | OnClick = DiconnectButtonClick 88 | TabOrder = 5 89 | end 90 | object GBConnection: TRadioGroup 91 | Left = 24 92 | Height = 152 93 | Top = 0 94 | Width = 144 95 | AutoFill = True 96 | Caption = 'Connection Type' 97 | ChildSizing.LeftRightSpacing = 6 98 | ChildSizing.TopBottomSpacing = 6 99 | ChildSizing.EnlargeHorizontal = crsHomogenousChildResize 100 | ChildSizing.EnlargeVertical = crsHomogenousChildResize 101 | ChildSizing.ShrinkHorizontal = crsScaleChilds 102 | ChildSizing.ShrinkVertical = crsScaleChilds 103 | ChildSizing.Layout = cclLeftToRightThenTopToBottom 104 | ChildSizing.ControlsPerLine = 1 105 | ClientHeight = 131 106 | ClientWidth = 140 107 | TabOrder = 6 108 | object RBTCP: TRadioButton 109 | Left = 6 110 | Height = 30 111 | Top = 6 112 | Width = 128 113 | Caption = 'TCP/IPv4' 114 | Checked = True 115 | OnChange = RBTCPChange 116 | TabOrder = 0 117 | TabStop = True 118 | end 119 | object RBUDP4: TRadioButton 120 | Left = 6 121 | Height = 30 122 | Top = 36 123 | Width = 128 124 | Caption = 'UDP/IPv4' 125 | OnChange = RBUDP4Change 126 | OnClick = RBUDP4Click 127 | TabOrder = 1 128 | end 129 | object RBTCP6: TRadioButton 130 | Left = 6 131 | Height = 30 132 | Top = 66 133 | Width = 128 134 | Caption = 'TCP/IPv6' 135 | OnChange = RBTCP6Change 136 | TabOrder = 2 137 | end 138 | object RBUDP6: TRadioButton 139 | Left = 6 140 | Height = 29 141 | Top = 96 142 | Width = 128 143 | Caption = 'UDP/IPv6' 144 | TabOrder = 3 145 | end 146 | end 147 | object EditPort: TEdit 148 | Left = 261 149 | Height = 29 150 | Top = 8 151 | Width = 59 152 | TabOrder = 7 153 | Text = '4665' 154 | end 155 | object EditIP: TEdit 156 | Left = 261 157 | Height = 29 158 | Top = 33 159 | Width = 123 160 | TabOrder = 8 161 | Text = 'localhost' 162 | end 163 | object CheckBoxSSL: TCheckBox 164 | Left = 261 165 | Height = 22 166 | Top = 64 167 | Width = 78 168 | Caption = 'Use SSL' 169 | TabOrder = 9 170 | end 171 | object LTCP: TLTCPComponent 172 | Port = 0 173 | OnReceive = LTCPComponentReceive 174 | OnError = LTCPComponentError 175 | OnDisconnect = LTCPComponentDisconnect 176 | OnConnect = LTCPComponentConnect 177 | OnAccept = LTCPComponentAccept 178 | Timeout = 0 179 | ReuseAddress = True 180 | Session = SSL 181 | left = 344 182 | top = 232 183 | end 184 | object LUDP: TLUDPComponent 185 | Port = 0 186 | OnReceive = LTCPComponentReceive 187 | OnError = LTCPComponentError 188 | Timeout = 0 189 | left = 344 190 | top = 280 191 | end 192 | object MainMenu1: TMainMenu 193 | left = 344 194 | top = 192 195 | object MenuItemFile: TMenuItem 196 | Caption = '&File' 197 | object MenuItemExit: TMenuItem 198 | Caption = 'E&xit' 199 | OnClick = MenuItemExitClick 200 | end 201 | end 202 | object MenuItemHelp: TMenuItem 203 | Caption = '&Help' 204 | object MenuItemAbout: TMenuItem 205 | Caption = '&About' 206 | OnClick = MenuItemAboutClick 207 | end 208 | end 209 | end 210 | object SSL: TLSSLSessionComponent 211 | CAFile = 'cert' 212 | KeyFile = 'pkey' 213 | Method = msSslTLS 214 | SSLActive = False 215 | left = 344 216 | top = 144 217 | end 218 | object TimerQuit: TTimer 219 | Enabled = False 220 | Interval = 200 221 | OnTimer = TimerQuitTimer 222 | left = 344 223 | top = 95 224 | end 225 | end 226 | -------------------------------------------------------------------------------- /examples/visual/http/main.pas: -------------------------------------------------------------------------------- 1 | unit main; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | interface 6 | 7 | uses 8 | Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, lNet, lHTTP, 9 | lNetComponents, ExtCtrls, StdCtrls, Buttons, Menus, lHTTPUtil; 10 | 11 | type 12 | 13 | { TMainForm } 14 | 15 | TMainForm = class(TForm) 16 | ButtonSendRequest: TButton; 17 | CheckBoxPOST: TCheckBox; 18 | EditPOST: TEdit; 19 | EditURL: TEdit; 20 | HTTPClient: TLHTTPClientComponent; 21 | LabelPOST: TLabel; 22 | LabelURI: TLabel; 23 | SSL: TLSSLSessionComponent; 24 | MainMenu1: TMainMenu; 25 | MemoHTML: TMemo; 26 | MemoStatus: TMemo; 27 | MenuItemExit: TMenuItem; 28 | MenuItemAbout: TMenuItem; 29 | MenuItemHelp: TMenuItem; 30 | MenuItemFile: TMenuItem; 31 | MenuPanel: TPanel; 32 | PanelSep: TPanel; 33 | procedure ButtonSendRequestClick(Sender: TObject); 34 | procedure EditPOSTChange(Sender: TObject); 35 | procedure EditURLKeyPress(Sender: TObject; var Key: char); 36 | procedure HTTPClientCanWrite(ASocket: TLHTTPClientSocket; 37 | var OutputEof: TWriteBlockStatus); 38 | procedure HTTPClientDisconnect(aSocket: TLSocket); 39 | procedure HTTPClientDoneInput(ASocket: TLHTTPClientSocket); 40 | procedure HTTPClientError(const msg: string; aSocket: TLSocket); 41 | function HTTPClientInput(ASocket: TLHTTPClientSocket; ABuffer: pchar; 42 | ASize: dword): dword; 43 | procedure HTTPClientProcessHeaders(ASocket: TLHTTPClientSocket); 44 | procedure MenuItemAboutClick(Sender: TObject); 45 | procedure MenuItemExitClick(Sender: TObject); 46 | procedure SSLSSLConnect(aSocket: TLSocket); 47 | private 48 | HTTPBuffer: string; 49 | POSTBuffer: string; 50 | procedure AppendToMemo(aMemo: TMemo; const aText: string); 51 | { private declarations } 52 | public 53 | { public declarations } 54 | end; 55 | 56 | var 57 | MainForm: TMainForm; 58 | 59 | implementation 60 | 61 | { TMainForm } 62 | 63 | procedure TMainForm.HTTPClientError(const msg: string; aSocket: TLSocket); 64 | begin 65 | MessageDlg(msg, mtError, [mbOK], 0); 66 | end; 67 | 68 | procedure TMainForm.HTTPClientDisconnect(aSocket: TLSocket); 69 | begin 70 | AppendToMemo(MemoStatus, 'Disconnected.'); 71 | end; 72 | 73 | procedure TMainForm.ButtonSendRequestClick(Sender: TObject); 74 | var 75 | URL, aHost, aURI: string; 76 | aPort: Word; 77 | begin 78 | HTTPClient.Method := hmGet; 79 | if CheckBoxPOST.Checked then begin 80 | POSTBuffer := URLEncode(EditPOST.Text, True); // url-encode the string for in query usage 81 | HTTPClient.Method := hmPost; // obviously 82 | HTTPClient.ContentLength := Length(POSTBuffer); // specify POST data size 83 | HTTPClient.AddExtraHeader('Content-Type: application/x-www-form-urlencoded'); // specify POST data content-type, usual urlencoded this time 84 | end; 85 | 86 | URL := EditURL.Text; 87 | if Pos('http', URL) <= 0 then // HTTP[S] is required 88 | URL := 'http://' + URL; 89 | 90 | HTTPBuffer := ''; 91 | SSL.SSLActive := DecomposeURL(URL, aHost, aURI, aPort); 92 | HTTPClient.Host := aHost; 93 | HTTPClient.URI := aURI; 94 | HTTPClient.Port := aPort; 95 | 96 | HTTPClient.SendRequest; 97 | end; 98 | 99 | procedure TMainForm.EditPOSTChange(Sender: TObject); 100 | begin 101 | CheckBoxPOST.Checked := True; 102 | end; 103 | 104 | procedure TMainForm.EditURLKeyPress(Sender: TObject; var Key: char); 105 | begin 106 | if Key = #13 then 107 | ButtonSendRequestClick(Sender); 108 | end; 109 | 110 | procedure TMainForm.HTTPClientCanWrite(ASocket: TLHTTPClientSocket; 111 | var OutputEof: TWriteBlockStatus); 112 | var 113 | n: Integer; 114 | begin 115 | if (HTTPClient.Method <> hmPost) 116 | or (Length(POSTBuffer) = 0) then 117 | Exit; // nothing to be done 118 | 119 | n := aSocket.SendMessage(POSTBuffer); // try to send the POST data 120 | 121 | if n = Length(POSTBuffer) then begin // if we've sent it all, mark finished 122 | OutputEof := wsDone; 123 | POSTBuffer := ''; // for clarity 124 | end else begin 125 | OutputEof := wsPendingData; // we've still got pending data 126 | Delete(POSTBuffer, 1, n); // make sure to "remove sent" from the "buffer" 127 | end; 128 | end; 129 | 130 | procedure TMainForm.HTTPClientDoneInput(ASocket: TLHTTPClientSocket); 131 | begin 132 | aSocket.Disconnect; 133 | AppendToMemo(MemoStatus, 'Finished.'); 134 | end; 135 | 136 | function TMainForm.HTTPClientInput(ASocket: TLHTTPClientSocket; ABuffer: pchar; 137 | ASize: dword): dword; 138 | var 139 | oldLength: dword; 140 | begin 141 | oldLength := Length(HTTPBuffer); 142 | setlength(HTTPBuffer,oldLength + ASize); 143 | move(ABuffer^,HTTPBuffer[oldLength + 1], ASize); 144 | MemoHTML.Text := UTF8Encode(HTTPBuffer); 145 | MemoHTML.SelStart := Length(HTTPBuffer); 146 | AppendToMemo(MemoStatus, IntToStr(ASize) + '...'); 147 | Result := aSize; // tell the http buffer we read it all 148 | end; 149 | 150 | procedure TMainForm.HTTPClientProcessHeaders(ASocket: TLHTTPClientSocket); 151 | begin 152 | AppendToMemo(MemoStatus, 'Response: ' + IntToStr(HTTPStatusCodes[ASocket.ResponseStatus]) + 153 | ' ' + ASocket.ResponseReason + ', data...'); 154 | end; 155 | 156 | procedure TMainForm.MenuItemAboutClick(Sender: TObject); 157 | begin 158 | MessageDlg('Copyright (c) 2006-2008 by Ales Katona and Micha Nelissen. All rights deserved :)', 159 | mtInformation, [mbOK], 0); 160 | end; 161 | 162 | procedure TMainForm.MenuItemExitClick(Sender: TObject); 163 | begin 164 | Close; 165 | end; 166 | 167 | procedure TMainForm.SSLSSLConnect(aSocket: TLSocket); 168 | begin 169 | MemoStatus.Append('TLS handshake successful'); 170 | end; 171 | 172 | procedure TMainForm.AppendToMemo(aMemo: TMemo; const aText: string); 173 | begin 174 | aMemo.Append(aText); 175 | aMemo.SelStart := Length(aMemo.Text); 176 | end; 177 | 178 | initialization 179 | {$I main.lrs} 180 | 181 | end. 182 | 183 | -------------------------------------------------------------------------------- /lib/lmimestreams.pp: -------------------------------------------------------------------------------- 1 | { MIME Streams 2 | 3 | CopyRight (C) 2006-2008 Micha Nelissen 4 | 5 | This library is Free software; you can rediStribute it and/or modify it 6 | under the terms of the GNU Library General Public License as published by 7 | the Free Software Foundation; either version 2 of the License, or (at your 8 | option) any later version. 9 | 10 | This program is diStributed in the hope that it will be useful, but WITHOUT 11 | ANY WARRANTY; withOut even the implied warranty of MERCHANTABILITY or 12 | FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License 13 | for more details. 14 | 15 | You should have received a Copy of the GNU Library General Public License 16 | along with This library; if not, Write to the Free Software Foundation, 17 | Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 18 | 19 | This license has been modified. See File LICENSE.ADDON for more inFormation. 20 | Should you find these sources without a LICENSE File, please contact 21 | me at ales@chello.sk 22 | } 23 | 24 | unit lMimeStreams; 25 | 26 | {$mode objfpc}{$H+} 27 | 28 | interface 29 | 30 | uses 31 | Classes; 32 | 33 | const 34 | CRLF = #13#10; 35 | 36 | type 37 | TStreamNotificationEvent = procedure(const aSize: Integer) of object; 38 | 39 | { TMimeOutputStream } 40 | 41 | TMimeOutputStream = class(TStream) 42 | protected 43 | FInputData: string; 44 | FNotificationEvent: TStreamNotificationEvent; 45 | function GetSize: Int64; override; 46 | procedure AddInputData(const s: string); 47 | public 48 | constructor Create(aNotificationEvent: TStreamNotificationEvent); 49 | function Read(var Buffer; Count: Longint): Longint; override; 50 | function Write(const Buffer; Count: Longint): Longint; override; 51 | function Seek(Offset: Longint; Origin: Word): Longint; overload; override; 52 | function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; overload; override; 53 | procedure Reset; 54 | end; 55 | 56 | { TBogusStream } 57 | 58 | TBogusStream = class(TStream) 59 | protected 60 | FData: string; 61 | function GetSize: Int64; override; 62 | public 63 | function Read(var Buffer; Count: Longint): Longint; override; 64 | function Write(const Buffer; Count: Longint): Longint; override; 65 | function Seek(Offset: Longint; Origin: Word): Longint; overload; override; 66 | function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; overload; override; 67 | procedure Reset; 68 | end; 69 | 70 | function EncodeMimeHeaderText(const s: string): string; 71 | 72 | implementation 73 | 74 | uses 75 | Math; 76 | 77 | type 78 | TByteArray = array of Byte; 79 | 80 | function EncodeMimeHeaderText(const s: string): string; 81 | begin 82 | Result := s; 83 | end; 84 | 85 | { TMimeOutputStream } 86 | 87 | function TMimeOutputStream.GetSize: Int64; 88 | begin 89 | Result := Length(FInputData); 90 | end; 91 | 92 | procedure TMimeOutputStream.AddInputData(const s: string); 93 | 94 | { function RightPos(const What, Where: string): Integer; 95 | var 96 | i, j: Integer; 97 | begin 98 | Result := 0; 99 | 100 | j := Length(What); 101 | for i := Length(Where) downto 1 do 102 | if Where[i] = What[j] then begin 103 | Dec(j); 104 | if j = 0 then Exit(i); 105 | end else 106 | j := Length(What); 107 | end; 108 | 109 | var 110 | n: Integer;} 111 | begin 112 | { n := RightPos(CRLF, s); 113 | if n > 0 then 114 | Inc(FLastCRLF, (Length(FInputData) - FLastCRLF) + n);} 115 | 116 | FInputData := FInputData + s; 117 | 118 | { while Length(FInputData) - FLastCRLF >= 74 do begin 119 | Insert(CRLF, FInputData, FLastCRLF + 75); 120 | Inc(FLastCRLF, 77); 121 | end;} 122 | end; 123 | 124 | constructor TMimeOutputStream.Create(aNotificationEvent: TStreamNotificationEvent); 125 | begin 126 | inherited Create; 127 | 128 | FNotificationEvent := aNotificationEvent; 129 | end; 130 | 131 | function TMimeOutputStream.Read(var Buffer; Count: Longint): Longint; 132 | begin 133 | if Assigned(FNotificationEvent) then 134 | FNotificationEvent(Count); 135 | 136 | Result := Min(Count, Length(FInputData)); 137 | 138 | if Result <= 0 then 139 | Exit(0); 140 | 141 | Move(FInputData[1], Buffer, Result); 142 | Delete(FInputData, 1, Result); 143 | end; 144 | 145 | function TMimeOutputStream.Write(const Buffer; Count: Longint): Longint; 146 | var 147 | s: string; 148 | begin 149 | SetLength(s, Count); 150 | Move(Buffer, s[1], Count); 151 | AddInputData(s); 152 | Result := Count; 153 | end; 154 | 155 | function TMimeOutputStream.Seek(Offset: Longint; Origin: Word): Longint; 156 | begin 157 | Result := Offset; 158 | end; 159 | 160 | function TMimeOutputStream.Seek(const Offset: Int64; Origin: TSeekOrigin 161 | ): Int64; 162 | begin 163 | Result := Offset; 164 | end; 165 | 166 | procedure TMimeOutputStream.Reset; 167 | begin 168 | FInputData := ''; 169 | end; 170 | 171 | { TBogusStream } 172 | 173 | function TBogusStream.GetSize: Int64; 174 | begin 175 | Result := Length(FData); 176 | end; 177 | 178 | function TBogusStream.Read(var Buffer; Count: Longint): Longint; 179 | begin 180 | Result := Min(Count, Length(FData)); 181 | 182 | Move(FData[1], Buffer, Result); 183 | Delete(FData, 1, Result); 184 | end; 185 | 186 | function TBogusStream.Write(const Buffer; Count: Longint): Longint; 187 | var 188 | l: Integer; 189 | begin 190 | l := Length(FData); 191 | Result := Count; 192 | SetLength(FData, l + Count); 193 | Inc(l); 194 | Move(Buffer, FData[l], Count); 195 | end; 196 | 197 | function TBogusStream.Seek(Offset: Longint; Origin: Word): Longint; 198 | begin 199 | Result := Offset; 200 | end; 201 | 202 | function TBogusStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; 203 | begin 204 | Result := Offset; 205 | end; 206 | 207 | procedure TBogusStream.Reset; 208 | begin 209 | FData := ''; 210 | end; 211 | 212 | end. 213 | 214 | -------------------------------------------------------------------------------- /examples/visual/ftp/main.lrs: -------------------------------------------------------------------------------- 1 | LazarusResources.Add('TMainForm','FORMDATA',[ 2 | 'TPF0'#9'TMainForm'#8'MainForm'#4'Left'#3'|'#1#6'Height'#3#249#1#3'Top'#3#129 3 | +#0#5'Width'#3#213#2#13'ActiveControl'#7#6'Panel1'#11'BorderIcons'#11#12'biSy' 4 | +'stemMenu'#10'biMinimize'#10'biMaximize'#6'biHelp'#0#7'Caption'#6#15'FTP Tes' 5 | +'t Client'#12'ClientHeight'#3#228#1#11'ClientWidth'#3#213#2#21'Constraints.M' 6 | +'inHeight'#3#144#1#20'Constraints.MinWidth'#3#213#2#4'Menu'#7#8'MainMenu'#7 7 | +'OnClose'#7#9'FormClose'#8'OnCreate'#7#10'FormCreate'#9'OnDestroy'#7#11'Form' 8 | +'Destroy'#9'OnKeyDown'#7#11'FormKeyDown'#10'LCLVersion'#6#6'0.9.29'#0#5'TMem' 9 | +'o'#8'MemoText'#4'Left'#2#0#6'Height'#2'b'#3'Top'#3's'#1#5'Width'#3#213#2#5 10 | +'Align'#7#8'alBottom'#8'ReadOnly'#9#10'ScrollBars'#7#14'ssAutoVertical'#8'Ta' 11 | +'bOrder'#2#0#0#0#6'TPanel'#6'Panel1'#4'Left'#2#0#6'Height'#3'B'#1#3'Top'#2#24 12 | +#5'Width'#3#213#2#5'Align'#7#8'alClient'#12'ClientHeight'#3'B'#1#11'ClientWi' 13 | +'dth'#3#213#2#8'TabOrder'#2#1#0#12'TFileListBox'#8'LeftView'#4'Left'#2#1#6'H' 14 | +'eight'#3'@'#1#3'Top'#2#1#5'Width'#3#183#0#5'Align'#7#6'alLeft'#9'Directory' 15 | +#6#10'C:\lazarus'#14'ExtendedSelect'#8#8'FileType'#11#10'ftReadOnly'#8'ftHid' 16 | +'den'#8'ftSystem'#10'ftVolumeID'#11'ftDirectory'#9'ftArchive'#8'ftNormal'#0 17 | +#10'ItemHeight'#2#0#10'OnDblClick'#7#16'LeftViewDblClick'#9'PopupMenu'#7#9'P' 18 | +'opupLeft'#6'Sorted'#8#5'Style'#7#16'lbOwnerDrawFixed'#8'TabOrder'#2#0#8'Top' 19 | +'Index'#2#255#0#0#9'TSplitter'#9'Splitter2'#4'Left'#3#184#0#6'Height'#3'@'#1 20 | +#3'Top'#2#1#5'Width'#2#5#0#0#11'TStringGrid'#7'rmtGrid'#4'Left'#3#189#0#6'He' 21 | +'ight'#3'@'#1#3'Top'#2#1#5'Width'#3#23#2#5'Align'#7#8'alClient'#8'ColCount'#2 22 | +#6#7'Columns'#14#1#13'Title.Caption'#6#1' '#5'Width'#2#25#0#1#13'Title.Capti' 23 | +'on'#6#4'File'#5'Width'#3#249#0#0#1#13'Title.Caption'#6#4'Size'#5'Width'#2'^' 24 | +#0#1#13'Title.Caption'#6#4'Date'#5'Width'#2'H'#0#1#13'Title.Caption'#6#10'At' 25 | +'tributes'#5'Width'#2'G'#0#1#13'Title.Caption'#6#5'Links'#5'Width'#2#0#0#0#16 26 | +'DefaultRowHeight'#2#16#9'FixedCols'#2#0#13'GridLineWidth'#2#0#7'Options'#11 27 | +#15'goFixedVertLine'#15'goFixedHorzLine'#11'goColSizing'#11'goRowSelect'#19 28 | +'goHeaderHotTracking'#18'goHeaderPushedLook'#0#9'PopupMenu'#7#10'PopupRight' 29 | +#8'RowCount'#2#1#8'TabOrder'#2#1#10'TitleStyle'#7#8'tsNative'#14'OnCompareCe' 30 | +'lls'#7#19'rmtGridCompareCells'#10'OnDblClick'#7#15'rmtGridDblClick'#10'OnDr' 31 | +'awCell'#7#15'rmtGridDrawCell'#13'OnHeaderClick'#7#18'rmtGridHeaderClick'#9 32 | +'OnKeyDown'#7#14'rmtGridKeyDown'#0#0#0#9'TSplitter'#9'Splitter1'#6'Cursor'#7 33 | +#8'crVSplit'#4'Left'#2#0#6'Height'#2#5#3'Top'#3'n'#1#5'Width'#3#213#2#5'Alig' 34 | +'n'#7#8'alBottom'#12'ResizeAnchor'#7#8'akBottom'#0#0#10'TStatusBar'#4'SBar'#4 35 | +'Left'#2#0#6'Height'#2#15#3'Top'#3#213#1#5'Width'#3#213#2#6'Panels'#14#1#5'W' 36 | +'idth'#3#150#0#0#1#5'Width'#2'd'#0#1#5'Width'#3#250#0#0#1#5'Width'#2'2'#0#0 37 | +#11'SimplePanel'#8#0#0#8'TToolBar'#8'ToolBar1'#4'Left'#2#0#6'Height'#2#24#3 38 | +'Top'#2#0#5'Width'#3#213#2#7'Caption'#6#8'ToolBar1'#12'ShowCaptions'#9#8'Tab' 39 | +'Order'#2#2#0#11'TToolButton'#11'ToolButton1'#4'Left'#2#1#3'Top'#2#2#6'Actio' 40 | +'n'#7#14'accSiteManager'#0#0#11'TToolButton'#11'ToolButton3'#4'Left'#2'X'#3 41 | +'Top'#2#2#5'Width'#2#13#7'Caption'#6#11'ToolButton3'#5'Style'#7#10'tbsDivide' 42 | +'r'#0#0#11'TToolButton'#11'ToolButton4'#4'Left'#2'e'#3'Top'#2#2#6'Action'#7 43 | +#10'accConnect'#7'Grouped'#9#5'Style'#7#8'tbsCheck'#0#0#11'TToolButton'#11'T' 44 | +'oolButton2'#4'Left'#3#159#0#3'Top'#2#2#6'Action'#7#13'accDisconnect'#4'Down' 45 | +#9#7'Grouped'#9#5'Style'#7#8'tbsCheck'#0#0#0#12'TProgressBar'#12'ProgressBar' 46 | +'1'#4'Left'#2#0#6'Height'#2#20#3'Top'#3'Z'#1#5'Width'#3#213#2#5'Align'#7#8'a' 47 | +'lBottom'#4'Step'#2#1#8'TabOrder'#2#5#0#0#9'TMainMenu'#8'MainMenu'#4'left'#3 48 | +#128#1#3'top'#3'p'#1#0#9'TMenuItem'#12'MenuItemFile'#7'Caption'#6#5'&File'#0 49 | +#9'TMenuItem'#15'MenuSiteManager'#6'Action'#7#14'accSiteManager'#7'OnClick'#7 50 | +#21'accSiteManagerExecute'#0#0#9'TMenuItem'#9'MenuItem1'#7'Caption'#6#1'-'#0 51 | +#0#9'TMenuItem'#12'MenuItemExit'#7'Caption'#6#5'E&xit'#7'OnClick'#7#17'ExitM' 52 | +'enuItemClick'#0#0#0#9'TMenuItem'#12'MenuItemHelp'#7'Caption'#6#5'&Help'#0#9 53 | +'TMenuItem'#16'MenuItemFeatures'#7'Caption'#6#9'&Features'#7'OnClick'#7#21'M' 54 | +'enuItemFeaturesClick'#0#0#9'TMenuItem'#13'MenuItemAbout'#7'Caption'#6#6'&Ab' 55 | +'out'#7'OnClick'#7#18'AboutMenuItemClick'#0#0#0#0#10'TPopupMenu'#10'PopupRig' 56 | +'ht'#4'left'#3'8'#2#3'top'#3'p'#1#0#9'TMenuItem'#8'PupupGet'#7'Caption'#6#3 57 | +'Get'#7'OnClick'#7#15'rmtGridDblClick'#0#0#9'TMenuItem'#11'PopupDelete'#7'Ca' 58 | +'ption'#6#6'Delete'#7'OnClick'#7#16'DeletePopupClick'#0#0#9'TMenuItem'#13'Me' 59 | +'nuItemMkdir'#7'Caption'#6#13'New directory'#7'OnClick'#7#18'MenuItemMkdirCl' 60 | +'ick'#0#0#9'TMenuItem'#11'PopupRename'#7'Caption'#6#6'Rename'#7'OnClick'#7#16 61 | +'RenamePopupClick'#0#0#0#20'TLFTPClientComponent'#3'FTP'#9'OnConnect'#7#10'F' 62 | +'TPConnect'#6'OnSent'#7#7'FTPSent'#9'OnReceive'#7#10'FTPReceive'#9'OnControl' 63 | +#7#10'FTPControl'#7'OnError'#7#8'FTPError'#9'OnSuccess'#7#10'FTPSuccess'#9'O' 64 | +'nFailure'#7#10'FTPSuccess'#8'PipeLine'#8#7'Timeout'#2#0#4'left'#3#200#0#3't' 65 | +'op'#3'p'#1#0#0#10'TPopupMenu'#9'PopupLeft'#4'left'#3#208#1#3'top'#3'p'#1#0#9 66 | ,'TMenuItem'#10'PopupLInfo'#7'Caption'#6#4'Info'#7'OnClick'#7#15'LInfoPopupCl' 67 | +'ick'#0#0#9'TMenuItem'#12'PopupLDelete'#7'Caption'#6#6'Delete'#7'OnClick'#7 68 | +#17'LDeletePopupClick'#0#0#9'TMenuItem'#12'PopupLRename'#7'Caption'#6#6'Rena' 69 | +'me'#7'OnClick'#7#17'LRenamePopupClick'#0#0#0#11'TActionList'#11'ActionList1' 70 | +#4'left'#3' '#1#3'top'#3'p'#1#0#7'TAction'#14'accSiteManager'#7'Caption'#6#12 71 | +'Site Manager'#9'OnExecute'#7#21'accSiteManagerExecute'#0#0#7'TAction'#10'ac' 72 | +'cConnect'#7'Caption'#6#7'Connect'#9'OnExecute'#7#17'accConnectExecute'#0#0#7 73 | +'TAction'#13'accDisconnect'#7'Caption'#6#10'Disconnect'#9'OnExecute'#7#20'ac' 74 | +'cDisconnectExecute'#0#0#0#0 75 | ]); 76 | --------------------------------------------------------------------------------