ADDED lib/synapse/README.txt
Index: lib/synapse/README.txt
==================================================================
--- /dev/null
+++ lib/synapse/README.txt
@@ -0,0 +1,45 @@
+Synapse
+The synchronyous socket library.
+
+File content:
+
+1.) About Synapse
+2.) Distribution package
+3.) Installation instructions
+4.) Usage notes
+
+Synapse homesite is at http://synapse.ararat.cz/
+On homesite is Wiki documentation system and other informations.
+
+1.) About Synapse
+
+SYNAPSE library aims to create complete library of classes and functions
+that would markedly simplify application programming of network communication
+using Winsock.
+
+2.) Distribution package
+
+Package must be unpacked with subdirectories.
+There are these derectories:
+
+\Html - Off-line version of Synapse support WEB
+\Source - Synapse source code
+\Source\Lib - shared units
+\Source\Demo - Synapse demo applications
+
+
+3.) Installation instructions
+
+There aren't any difficulties with current distribution other than add
+\Source\Lib directory to library or search path. (...or you can simply put all
+required Synapse files into your project directory.)
+
+4.) Usage notes
+
+Simply write BLCKSOCK to USES section in your source code
+(or any other unit from package, when you need it).
+To read documentation, simply open INDEX.HTM file (in HTML subdirectory)
+on your HTML browser.
+
+Last update 2006-09-12
+
ADDED lib/synapse/Release.txt
Index: lib/synapse/Release.txt
==================================================================
--- /dev/null
+++ lib/synapse/Release.txt
@@ -0,0 +1,2 @@
+Release 40
+2012-04-23
ADDED lib/synapse/docs/ChangeLog.html
Index: lib/synapse/docs/ChangeLog.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/ChangeLog.html
@@ -0,0 +1,659 @@
+
+
+
+
+ChangeLog
+
+
+
+
+ChangeLog
+
+
+2012-03-13 geby
+
+
+
+[r149]
+ imapsend.pas Fix ImapSend crash. https://sourceforge.net/tracker/?func=detail&aid=3487916&group_id=125224&atid=701386
+
+
+
+[r148]
+ ssl_openssl.pas Fix SNI on unicode Delphi: https://sourceforge.net/tracker/?func=detail&atid=701386&aid=3464355&group_id=125224
+
+
+
+[r147]
+ blcksock.pas, ftpsend.pas, mimemess.pas, mimepart.pas, smtpsend.pas, ssl_cryptlib.pas, ssl_openssl.pas, ssl_openssl_lib.pas, synacode.pas, synamisc.pas, synautil.pas Bugfixes in OpenSSL, enhanced OpenSSL support, enhanced binary MIME (all by Petr Fejfar)
+
+
+2011-05-31 geby
+
+
+
+[r146]
+ ftpsend.pas ftpsend - support for large streams
+
+
+
+[r145]
+ snmpsend.pas snmpsend.pas - small fix of V3 synchronization
+
+
+2011-05-18 geby
+
+
+
+[r144]
+ sswin32.inc Delphi Pulsar fixes for WIN64 target.
+
+
+
+[r143]
+ ssdotnet.inc, ssdotnet.pas, ssfpc.inc, ssfpc.pas, sslinux.inc, sslinux.pas, sswin32.inc, sswin32.pas, synsock.pas SynSock modules are renamed from PAS extension to INC. Newer Delphi editors have a problem with editing non-unit pas files. INC working fine.
+
+
+2011-05-05 geby
+
+
+
+[r142]
+ snmpsend.pas, synacrypt.pas, synautil.pas snmpsend.pas - added Privacy encryption support. Supported are DES, 3DES and AES.
+
+
+2011-04-28 geby
+
+
+
+[r141]
+ synacrypt.pas synacrypt.pas - Added TSynaAes as implementation of AES encryption.
+
+
+
+[r140]
+ synacrypt.pas TSynaBlockCipher knows any block size now. (was hardwired 64-bit block)
+
+
+2011-04-13 geby
+
+
+
+[r139]
+ blcksock.pas, httpsend.pas, ssl_cryptlib.pas, ssl_openssl.pas, ssl_openssl_lib.pas - new support for TLS SNI in OpenSSL. - improved certificate verification - improved Cryptlib support
+
+
+
+[r138]
+ synadbg.pas, synafpc.pas, synaser.pas Improved 64bit compatibility.
+
+
+2011-02-03 geby
+
+
+
+[r137]
+ nntpsend.pas nntpsend - fixed cleared error result after failed login. (Amos)
+
+
+
+[r136]
+ synaser.pas synaser - fixed typo error
+
+
+2011-01-20 geby
+
+
+
+[r135]
+ blcksock.pas core: fixed compile errors when directive ONCEWINSOCK is not used
+
+
+
+[r134]
+ httpsend.pas HTTP: fix - added URL decoding for credentials from the URL.
+
+
+2011-01-19 geby
+
+
+
+[r133]
+ ssl_openssl_lib.pas OpenSSL: fixed correct library naming for MacOSX (Yury Sidorov)
+
+
+
+[r132]
+ ssfpc.pas Freepascal: use Hosts file for name resolution on Unix. (Yury Sidorov)
+
+
+
+[r131]
+ httpsend.pas HTTP: another D2009+ fix
+
+
+
+[r130]
+ ftpsend.pas FTP: EPSV and EPRT commands are used for IPv6 only.
+
+
+2010-07-02 geby
+
+
+
+[r129]
+ laz_synapse.lpk, laz_synapse.pas, ssfpc.pas, ssl_openssl_lib.pas, synamisc.pas, synaser.pas - improved MACOS compatibility - workaround for some broken virtual serial ports - Added Lazarus package
+
+
+2010-05-03 geby
+
+
+
+[r128]
+ httpsend.pas, synamisc.pas some typo errors
+
+
+2010-04-15 geby
+
+
+
+[r127]
+ blcksock.pas Fixed byte order of stream size in TBlockSocket.InternalSendStream.
+
+
+
+[r126]
+ httpsend.pas Next D2009 fixes in THTTPSend by SergeyL.
+
+
+2010-02-19 geby
+
+
+
+[r125]
+ ssfpc.pas Fixed SetVarSin for IPv6 on the FreePascal.
+
+
+2010-02-05 geby
+
+
+
+[r124]
+ ldapsend.pas new method Get of TLDAPAttributeList
+
+
+2010-02-03 geby
+
+
+
+[r123]
+ asn1util.pas, blcksock.pas, clamsend.pas, dnssend.pas, ftpsend.pas, ftptsend.pas, httpsend.pas, imapsend.pas, ldapsend.pas, mimeinln.pas, mimepart.pas, nntpsend.pas, pingsend.pas, pop3send.pas, smtpsend.pas, snmpsend.pas, sntpsend.pas, ssl_openssl.pas, synacode.pas, synacrypt.pas, synadbg.pas, synachar.pas, synaip.pas, synamisc.pas, synaser.pas, synautil.pas, tlntsend.pas Large set of D2009 compatibility fixes. (mostly cosmetics only, like suppress unwanted warnings, etc.)
+
+
+
+[r122]
+ sswin32.pas sswin32.pas - improved D2009 compatibility
+
+
+2010-01-28 geby
+
+
+
+[r121]
+ synaser.pas synaser.pas - handling of FHandle is capable to use 64-bit based handlers.
+
+
+
+[r120]
+ synaser.pas synaser.pas - fixed D2009+ compatibility
+
+
+2010-01-27 geby
+
+
+
+[r119]
+ synaser.pas synaser.pas - fixed compiler defines for WIN64 support
+
+
+2010-01-24 geby
+
+
+
+[r118]
+ blcksock.pas Published TBlockSocket.FDset for debugging purposes.
+
+
+
+[r117]
+ pingsend.pas pingsend.pas - WIN64 data align fixes.
+
+
+
+[r116]
+ sswin32.pas WIN64 data align fixes.
+
+
+2010-01-22 geby
+
+
+
+[r115]
+ sswin32.pas Fixed TSocket size on WIN64.
+
+
+
+[r114]
+ ssl_openssl.pas Fixed TSSLOpenSSL.RecvBuffer condition on connection close.
+
+
+
+[r113]
+ sswin32.pas Fixed port assign by SetVarSin on old Winsock API.
+
+
+
+[r112]
+ blcksock.pas, httpsend.pas, pingsend.pas, ssl_openssl_lib.pas, sswin32.pas, synafpc.pas, synaicnv.pas, synautil.pas, synsock.pas Modified compiler defines for windows (For better compatibility with non-WIN32 systems.)
+
+
+
+[r111]
+ ssl_openssl_lib.pas Added SSL_CTX_ctrl into OpenSSL plugin.
+
+
+2010-01-06 geby
+
+
+
+[r110]
+ blcksock.pas Added support for PGM protocol (message and stream mode).
+
+
+
+[r109]
+ ssfpc.pas, sslinux.pas, sswin32.pas Synsock - added IPPROTO_RM value.
+
+
+2010-01-04 geby
+
+
+
+[r108]
+ blcksock.pas, clamsend.pas, dnssend.pas, ftpsend.pas, ftptsend.pas, httpsend.pas, imapsend.pas, ldapsend.pas, nntpsend.pas, pingsend.pas, pop3send.pas, slogsend.pas, smtpsend.pas, snmpsend.pas, sntpsend.pas, tlntsend.pas New TBlockSocket.Owner property. You know what protocol class own this socket now.
+
+
+
+[r107]
+ ssl_openssl_lib.pas Fixed D2009 compatibility in ssl_openssl_lib.pas
+
+
+2009-10-26 geby
+
+
+
+[r106]
+ smtpsend.pas added TSMTPSend AUTH PLAIN support
+
+
+2009-10-25 geby
+
+
+
+[r105]
+ smtpsend.pas Liberalized return code handling.
+
+
+2009-10-15 geby
+
+
+
+[r104]
+ ldapsend.pas TLdapSend.BindSasl fix
+
+
+2009-09-30 geby
+
+
+
+[r102]
+ ssfpc.pas Next fixes for FPC...
+
+
+2009-09-29 geby
+
+
+
+[r101]
+ ssfpc.pas Fixed fpBind call.
+
+
+
+[r100]
+ ssfpc.pas Improved compatibility with FPC 2.x.x
+
+
+
+[r99]
+ ldapsend.pas D2009 compatibility fix
+
+
+2009-06-08 geby
+
+
+
+[r98]
+ blcksock.pas Enabled socket options for send and receive timeout at Linux platform.
+
+
+2009-06-05 geby
+
+
+
+[r97]
+ synaip.pas Added ExpandIP6 and fixed StrToIp6.
+
+
+2009-04-03 geby
+
+
+
+[r96]
+ clamsend.pas Updated ClamD support for compatibility with ClamAV 0.95. (new set of scan functions for new API - old functions are broken in this ClamAV version!
+
+
+2008-10-02 geby
+
+
+
+[r95]
+ blcksock.pas, httpsend.pas, ssl_openssl.pas, ssl_openssl_lib.pas, sswin32.pas, synadbg.pas, synaicnv.pas, synaip.pas, synamisc.pas, synaser.pas, synautil.pas, tlntsend.pas Changes for Delphi 2009 compatibility.
+
+
+2008-06-11 geby
+
+
+
+[r94]
+ ftpsend.pas Using TStream.Position instead of TStream.Seek. Better compatibility with large streams.
+
+
+
+[r93]
+ blcksock.pas TBlockSocket.SendStreamRaw is capable to work with large streams (>2GB)
+
+
+2008-04-29 geby
+
+
+
+[r92]
+ synamisc.pas Added GetLocalIPs helper function, fixed GetDNS function for DNS assigned by DHCP.
+
+
+
+[r91]
+ httpsend.pas, mimepart.pas, synautil.pas THTTPSend can handle folded headers in HTTP reply
+
+
+
+[r90]
+ synadbg.pas Added synadbg.pas unit.
+
+
+2008-04-26 geby
+
+
+
+[r89]
+ httpsend.pas Better handling of KeepAlives.
+
+
+
+[r88]
+ httpsend.pas fixed endless loop when unexpected 100 response is readed in THTTPSend
+
+
+2008-04-25 geby
+
+
+
+[r87]
+ mimepart.pas Changed defaults for MIME part. (8-bit encoding as default and current system charset as default encoding.)
+
+
+
+[r86]
+ mimepart.pas filename in 'content-disposition' header have higher priority then filename in 'mime-type' header
+
+
+
+[r85]
+ ldapsend.pas Added TLDAPAttributeList.Find
+
+
+
+[r84]
+ synaser.pas Added synaser.pas
+
+
+2008-04-24 geby
+
+
+
+[r82]
+ blcksock.pas, dnssend.pas, ftpsend.pas, httpsend.pas, imapsend.pas, mimeinln.pas, mimemess.pas, mimepart.pas, nntpsend.pas, pingsend.pas, pop3send.pas, smtpsend.pas, snmpsend.pas, sntpsend.pas, ssfpc.pas, ssl_sbb.pas, ssl_streamsec.pas, sslinux.pas, sswin32.pas, synacode.pas, synacrypt.pas, synafpc.pas, synachar.pas, synaicnv.pas, synaip.pas, synautil.pas, tlntsend.pas Release 38
+
+
+
+[r80]
+ blcksock.pas, clamsend.pas, dnssend.pas, ftpsend.pas, httpsend.pas, ldapsend.pas, mimepart.pas, pingsend.pas, pop3send.pas, snmpsend.pas, ssdotnet.pas, ssfpc.pas, ssl_cryptlib.pas, ssl_openssl.pas, ssl_openssl_lib.pas, ssl_sbb.pas, sslinux.pas, sswin32.pas, synafpc.pas, synachar.pas, synaicnv.pas, synaip.pas, synamisc.pas, synautil.pas, synsock.pas, winver.pp Release 37
+
+
+
+[r78]
+ asn1util.pas, blcksock.pas, dnssend.pas, ftpsend.pas, httpsend.pas, imapsend.pas, ldapsend.pas, mimeinln.pas, mimemess.pas, mimepart.pas, nntpsend.pas, pop3send.pas, slogsend.pas, smtpsend.pas, snmpsend.pas, sntpsend.pas, ssl_cryptlib.pas, ssl_openssl.pas, ssl_openssl_lib.pas, ssl_streamsec.pas, sslinux.pas, synacode.pas, synachar.pas, synaicnv.pas, synassl.pas, synautil.pas, tlntsend.pas Release 36
+
+
+
+[r76]
+ blcksock.pas, ftpsend.pas, httpsend.pas, ldapsend.pas, mimepart.pas, nntpsend.pas, sslinux.pas, synacode.pas, synachar.pas, synaicnv.pas, synautil.pas, winver.pp Release 35
+
+
+
+[r74]
+ blcksock.pas, dnssend.pas, ftpsend.pas, httpsend.pas, synacode.pas, synassl.pas Release 34
+
+
+
+[r72]
+ asn1util.pas, blcksock.pas, dnssend.pas, ftpsend.pas, ftptsend.pas, httpsend.pas, imapsend.pas, ldapsend.pas, mimeinln.pas, mimemess.pas, mimepart.pas, nntpsend.pas, pingsend.pas, pop3send.pas, slogsend.pas, smtpsend.pas, snmpsend.pas, snmptrap.pas, sntpsend.pas, ssdotnet.pas, sslinux.pas, sswin32.pas, synacode.pas, synafpc.pas, synachar.pas, synaicnv.pas, synamisc.pas, synassl.pas, synautil.pas, synsock.pas, tlntsend.pas Release 33
+
+
+
+[r70]
+ asn1util.pas, blcksock.pas, dnssend.pas, ftpsend.pas, ftptsend.pas, httpsend.pas, imapsend.pas, ldapsend.pas, mimeinln.pas, mimemess.pas, mimepart.pas, nntpsend.pas, pingsend.pas, pop3send.pas, slogsend.pas, smtpsend.pas, snmpsend.pas, snmptrap.pas, sntpsend.pas, synacode.pas, synafpc.pas, synachar.pas, synamisc.pas, synassl.pas, synautil.pas, synsock.pas, tlntsend.pas Release 32
+
+
+
+[r68]
+ asn1util.pas, blcksock.pas, dnssend.pas, ftpsend.pas, httpsend.pas, imapsend.pas, mimeinln.pas, mimemess.pas, mimepart.pas, nntpsend.pas, pingsend.pas, pop3send.pas, slogsend.pas, smtpsend.pas, snmpsend.pas, snmptrap.pas, sntpsend.pas, synacode.pas, synachar.pas, synamisc.pas, synassl.pas, synautil.pas, synsock.pas, tlntsend.pas Release 31
+
+
+
+[r66]
+ asn1util.pas, blcksock.pas, dnssend.pas, ftpsend.pas, httpsend.pas, imapsend.pas, mimeinln.pas, mimemess.pas, mimepart.pas, nntpsend.pas, pingsend.pas, pop3send.pas, slogsend.pas, smtpsend.pas, snmpsend.pas, snmptrap.pas, sntpsend.pas, synacode.pas, synachar.pas, synamisc.pas, synassl.pas, synautil.pas, synsock.pas, tlntsend.pas Release 30
+
+
+
+[r64]
+ asn1util.pas, blcksock.pas, dnssend.pas, ftpsend.pas, httpsend.pas, imapsend.pas, mimeinln.pas, mimemess.pas, mimepart.pas, nntpsend.pas, pingsend.pas, pop3send.pas, slogsend.pas, smtpsend.pas, snmpsend.pas, snmptrap.pas, sntpsend.pas, synacode.pas, synachar.pas, synassl.pas, synautil.pas, synsock.pas Release 29
+
+
+
+[r62]
+ synassl.pas, synassl.pas.x Release 28
+
+
+
+[r61]
+ blcksock.pas, ftpsend.pas, httpsend.pas, imapsend.pas, mimemess.pas, mimepart.pas, pop3send.pas, smtpsend.pas, synacode.pas, SynaSSL.pas, synassl.pas.x, synautil.pas
+
+
+
+[r60]
+ imapsend.pas, imapsend.pas.x, nntpsend.pas, nntpsend.pas.x
+
+
+
+[r59]
+ IMAPsend.pas, imapsend.pas.x, NNTPsend.pas, nntpsend.pas.x
+
+
+
+[r57]
+ blcksock.pas, ftpsend.pas, httpsend.pas, mimemess.pas, mimepart.pas, smtpsend.pas, synacode.pas, SynaSSL.pas, synautil.pas Release 27
+
+
+
+[r55]
+ asn1util.pas, blcksock.pas, IMAPsend.pas, mimeinln.pas, mimemess.pas, mimepart.pas, NNTPsend.pas, pingsend.pas, pop3send.pas, slogsend.pas, snmpsend.pas, sntpsend.pas, synacode.pas, synachar.pas, synautil.pas Release 26
+
+
+
+[r53]
+ asn1util.pas, blcksock.pas, dnssend.pas, ftpsend.pas, httpsend.pas, mimepart.pas, pingsend.pas, slogsend.pas, snmpsend.pas, snmptrap.pas, synachar.pas, synautil.pas Release 25
+
+
+
+[r51]
+ blcksock.pas, dnssend.pas, ftpsend.pas, httpsend.pas, mimemess.pas, mimepart.pas, pingsend.pas, pop3send.pas, smtpsend.pas, snmpsend.pas, snmptrap.pas, sntpsend.pas, synacode.pas, synahook.pas, synachar.pas, synautil.pas, synsock.pas Release 24
+
+
+
+[r49]
+ asn1util.pas, blcksck2.pas, blcksock.pas, dnssend.pas, httpsend.pas, mimechar.pas, mimeinln.pas, mimemess.pas, mimepart.pas, pingsend.pas, pop3send.pas, smtpsend.pas, snmpsend.pas, snmptrap.pas, sntpsend.pas, synacode.pas, synahook.pas, synachar.pas, synautil.pas, synsock.pas Release 23
+
+
+
+[r47]
+ asn1util.pas, dnssend.pas, httpsend.pas, mimechar.pas, mimemess.pas, pingsend.pas, snmpsend.pas, snmptrap.pas, sntpsend.pas, synacode.pas, synautil.pas, synsock.pas Release 22
+
+
+
+[r45]
+ blcksck2.pas, blcksock.pas, dnssend.pas, httpsend.pas, mimechar.pas, mimeinln.pas, mimemess.pas, mimepart.pas, pingsend.pas, pop3send.pas, smtpsend.pas, sntpsend.pas, synautil.pas, synsock.pas Release 21
+
+
+
+[r43]
+ pop3send.pas, smtpsend.pas, synacode.pas Release 20
+
+
+
+[r41]
+ blcksock.pas, mimemess.pas, mimepart.pas, pop3send.pas Release 19
+
+
+
+[r39]
+ blcksock.pas, httpsend.pas, smtpsend.pas, synacode.pas, synautil.pas Release 18
+
+
+
+[r37]
+ asn1util.pas, blcksock.pas, snmpsend.pas, snmptrap.pas Release 17
+
+
+
+[r35]
+ httpsend.pas, smtpsend.pas, synacode.pas, synautil.pas Release 16
+
+
+
+[r33]
+ mimechar.pas, mimemess.pas, mimepart.pas, synacode.pas, synautil.pas Release 15
+
+
+2008-04-23 geby
+
+
+
+[r31]
+ asn1util.pas, mimeinln.pas, mimemess.pas, mimepart.pas, synacode.pas, synautil.pas Release 14
+
+
+
+[r29]
+ asn1util.pas, mimechar.pas, mimepart.pas, pingsend.pas, snmpsend.pas, snmptrap.pas, synacode.pas, synautil.pas Release 13
+
+
+
+[r27]
+ asn1util.pas, blcksck2.pas, blcksock.pas, dnssend.pas, httpsend.pas, mimechar.pas, mimemess.pas, mimepart.pas, pingsend.pas, smtpsend.pas, snmpsend.pas, snmptrap.pas, sntpsend.pas, synacode.pas, synautil.pas Release 12
+
+
+
+[r25]
+ asn1util.pas, blcksck2.pas, blcksock.pas, dnssend.pas, httpsend.pas, pingsend.pas, smtpsend.pas, snmpsend.pas, snmptrap.pas, sntpsend.pas, synautil.pas Release 11
+
+
+
+[r21]
+ asn1util.pas, snmpsend.pas, snmptrap.pas, sntpsend.pas Release 10
+
+
+
+[r19]
+ smtpsend.pas Release 9
+
+
+
+[r17]
+ blcksock.pas, smtpsend.pas, sntpsend.pas Release 8
+
+
+
+[r15]
+ blcksck2.pas, blcksock.pas, pingsend.pas Release 7
+
+
+
+[r13]
+ asn1util.pas, httpsend.pas, snmpsend.pas, snmptrap.pas, synautil.pas Release 6
+
+
+
+[r11]
+ dnssend.pas, snmpsend.pas Release 5
+
+
+
+[r9]
+ snmpsend.pas, synautil.pas Release 4
+
+
+
+[r7]
+ blcksock.pas, httpsend.pas, smtpsend.pas, synautil.pas Release 3
+
+
+
+[r5]
+ blcksock.pas, smtpsend.pas Release 2
+
+
+
+[r2]
+ blcksock.pas Release 1
+
+
+
+[r1]
+ . Created folder remotely
+
+
+
+
+
ADDED lib/synapse/docs/Synapse_history.htm
Index: lib/synapse/docs/Synapse_history.htm
==================================================================
--- /dev/null
+++ lib/synapse/docs/Synapse_history.htm
@@ -0,0 +1,8899 @@
+
+
+
+Changelog
+
+
+
+
+
+
+
+
+ChangeLog
+
+
+
+asn1util
+
+blcksock
+
+clamsend
+
+dnssend
+
+ftpsend
+
+ftptsend
+
+httpsend
+
+imapsend
+
+ldapsend
+
+mimeinln
+
+mimemess
+
+mimepart
+
+nntpsend
+
+pingsend
+
+pop3send
+
+slogsend
+
+smtpsend
+
+snmpsend
+
+snmptrap
+
+ - Obsoleted!
+
+
+sntpsend
+
+ssl_cryptlib
+
+ssl_openssl
+
+ssl_streamsec
+
+synachar
+
+synacode
+
+synacrypt
+
+synafpc
+
+synaip
+
+synamisc
+
+synautil
+
+tlntsend
+
+
+
+
+
+
+
+asn1util
+
+
+
+
+Release 38
+2007-12-21
+
+
+
+
+Release 37
+2006-09-12
+
+
+
+
+Release 36
+2005-10-23
+
+
+
+
+Release 35
+2005-01-23
+
+
+
+
+Release 34
+2004-09-18
+
+
+
+
+Release 33
+2004-08-23
+
+
+
+
+1.4.3
+2004-08-23
+modified
+ASNdump function supports binary values
+
+
+Release 32
+2003-07-21
+
+
+
+
+1.4.2
+2003-07-21
+added
+FPC compatibility
+
+
+1.4.2
+2003-07-21
+added
+new ASN.1 types BOOL, ENUM and SETOF
+
+
+1.4.2
+2003-07-21
+added
+ASNdump function
+
+
+Release 31
+2003-03-24
+
+
+
+
+1.3.6
+2003-03-24
+removed
+weakpackageunit
+
+
+Release 30
+2003-01-01
+
+
+
+
+1.3.5
+2003-01-01
+fixed
+ASNItem
+
+
+Release 29
+2002-08-20
+
+
+
+
+Release 28
+2002-05-08
+
+
+
+
+Release 27
+2002-02-10
+
+
+
+
+Release 26
+2001-12-10
+
+
+
+
+Release 25
+2001-09-24
+
+
+
+
+1.3.4
+2001-09-24
+removed
+IptoID function moved to SynaUtil.pas
+
+
+Release 24
+2001-08-27
+
+
+
+
+Release 23
+2001-07-28
+
+
+
+
+1.3.3
+2001-07-22
+modified
+some optimalizations. ASN.1 support utilities
+
+
+Release 22
+2001-06-17
+
+
+
+
+Release 21
+2001-05-13
+
+
+
+
+Release 20
+2001-04-22
+
+
+
+
+Release 19
+2001-04-07
+
+
+
+
+Release 18
+2001-03-11
+
+
+
+
+Release 17
+2001-02-10
+
+
+
+
+1.3.1
+2001-02-10
+modified
+decoding of ASN1 packet is checked for consistency.
+
+
+Release 16
+2001-01-22
+
+
+
+
+Release 15
+2000-12-10
+
+
+
+
+Release 14
+2000-11-27
+
+
+
+
+1.3.0
+2000-11-27
+added
+all ASN functions from SynaUtil unit
+
+
+Release 13
+2000-10-24
+
+
+
+
+1.2.0
+2000-10-24
+modified
+ASNItem support for decoding signed and unsigned integers
+
+
+1.2.0
+2000-10-24
+added
+ASNEncUInt support for correctly unsigned integers
+
+
+1.2.0
+2000-10-24
+modified
+ASNEncInt supported correctly signed integers
+
+
+1.2.0
+2000-10-24
+added
+support for ASN1_OPAQUE type
+
+
+Release 12
+2000-10-15
+
+
+
+
+Release 11
+2000-09-18
+
+
+
+
+1.1.0
+2000-09-18
+added
+ASNItem have VAR parameter with returned value type
+
+
+1.1.0
+2000-09-18
+modified
+ASNEncInt rewrited
+
+
+1.1.0
+2000-09-18
+modified
+ASNDecLen now support length bigger then 65535
+
+
+1.1.0
+2000-09-18
+added
+ASNEncLen now support length bigger then 65535
+
+
+1.1.0
+2000-09-18
+added
+ASNdecOIDitem for decoding OID item
+
+
+1.1.0
+2000-09-18
+added
+ASNencOIDitem for encoding OID item
+
+
+Release 10
+2000-08-20
+
+
+
+
+Release 09
+2000-06-14
+
+
+
+
+Release 08
+2000-03-15
+
+
+
+
+Release 07
+2000-02-13
+
+
+
+
+1.0.0
+2000-02-01
+added
+many misc. ASN.1 utils. See documentation.
+
+
+Jump to top
+
+
+
+
+blcksock
+
+
+
+
+Release 38
+2007-12-21
+
+
+
+
+9.4.1
+2007-11-22
+added
+ResetLastError procedure for reseting of socket error state.
+
+
+9.4.1
+2007-11-22
+fixed
+AbortSocket not reseting LastError.
+
+
+9.4.1
+2007-11-22
+fixed
+Do not call gracefull TCP socket close on socket in error state. (socket error state was hidden by this procedure before)
+
+
+9.4.0
+2007-05-18
+added
+Heartbeat feature. Heartbeats can be called periodically during long socket operations with rate defined by new HeartbeatRate property.
+
+
+9.3.2
+2007-02-14
+fixed
+made bandwidth limitation for reading on SSL mode too.
+
+
+9.3.1
+2007-01-23
+modified
+bandwidth limitation code to be more responsible if you want to abort pending transfer.
+
+
+9.3.0
+2007-01-14
+modified
+SendBuffer should work with non-blocking sockets too. For this support exists new property NonblockSendTimeout.
+
+
+9.2.1
+2007-01-08
+fixed
+adding and dropping of IPv4 multicast address
+
+
+9.2.0
+2006-12-27
+added
+TTCPBlockSocket.OnAfterConnect event
+
+
+Release 37
+2006-09-12
+
+
+
+
+9.1.3
+2006-07-25
+fixed
+problem with ConvertLineEnd mode when you are mixing RecvString and other high-level receiving functions.
+
+
+9.1.2
+2006-07-19
+modified
+optimized SendBlock and stream sending functions for speed (removed 'delayed ACK' issue).
+
+
+9.1.1
+2006-06-11
+modified
+'do not drain CPU' hack in RecvPacket is just for Windows platform now.
+
+
+9.1.0
+2006-03-31
+removed
+StrToIP6 and IP6toStr moved into Synautil.
+
+
+9.1.0
+2006-03-31
+modified
+Name/IP resolving code is internally moved into SynSock.
+
+
+9.1.0
+2006-03-31
+modified
+sending data into socket with MSG_NOSIGNAL flag.
+
+
+9.0.13
+2006-03-17
+modified
+removed dependency on windows/libc unit
+
+
+9.0.12
+2006-02-03
+modified
+TBlockSocket.Waitingdata have upper limit for returned value. It made major speedup when you are talking with some integrated firewalls or antiviruses.
+
+
+9.0.11
+2005-12-10
+modified
+Call hooks in RecvBuffer only when was received some datas
+
+
+9.0.11
+2005-12-10
+modified
+TBlockSocket.waitingdata check for closed socket is not necessary.
+
+
+9.0.11
+2005-12-10
+fixed
+Loop in TBlockSocket.Purge can be breaked on socket error.
+
+
+9.0.10
+2005-12-08
+modified
+TTCPBlockSocket.Waitingdata not call SSL plugin when socket is closed.
+
+
+9.0.9
+2005-12-06
+fixed
+TBlockSocket.RecvBufferEx do nothink when requested lenght is zero.
+
+
+9.0.8
+2005-11-30
+fixed
+TBlockSocket.WaitingData return 0 when you call it on closed socket
+
+
+Release 36
+2005-10-23
+
+
+
+
+9.0.7
+2005-10-23
+removed
+OnWrite event
+
+
+9.0.7
+2005-10-23
+added
+OnMonitor event for monitoring communication
+
+
+9.0.7
+2005-10-23
+modified
+All SSL related stuffs are changed to new SSL plugin architecture. See Wiki pages for more details!
+
+
+9.0.7
+2005-10-23
+fixed
+errorchecks in SendStreamRaw
+
+
+9.0.7
+2005-10-23
+modified
+Purge never call internal socket error
+
+
+9.0.7
+2005-10-23
+fixed
+resolving functions not crashing system (workaround to windows bug)
+
+
+Release 35
+2005-01-23
+
+
+
+
+8.3.7
+2005-01-23
+fixed
+false exception on closing of TCP cocket (when raiseexcept is true)
+
+
+8.3.7
+2005-01-23
+modified
+on closing of TCP SSL socket do only unidirectional shutdown
+
+
+Release 34
+2004-09-18
+
+
+
+
+8.3.5
+2004-09-18
+fixed
+SSL errors
+
+
+8.3.5
+2004-09-18
+fixed
+loading CA-budle file
+
+
+Release 33
+2004-08-23
+
+
+
+
+8.3.4
+2004-08-23
+added
+Tag property
+
+
+8.3.4
+2004-08-23
+added
+TSynaClient holds Username and Password property
+
+
+8.3.4
+2004-08-23
+modified
+new code for address resolving.
+
+
+8.3.4
+2004-08-23
+added
+StopFlag propety for easy stoppong of data transfers.
+
+
+8.3.4
+2004-08-23
+modified
+Sendbuffer splitting large datas before sending.
+
+
+8.3.4
+2004-08-23
+added
+new SendInteger, SendStreamRaw and SendStreamIndy.
+
+
+8.3.4
+2004-08-23
+added
+new RecvInteger, RecvStreamRaw, RecvStreamSize and RecvStreamIndy.
+
+
+8.3.4
+2004-08-23
+added
+SSLverifycert for client too. (it verifying server certificate on SSLDoConnect)
+
+
+8.3.4
+2004-08-23
+fixed
+Fixed shutdown of SSL socket
+
+
+Release 32
+2003-07-21
+
+
+
+
+7.9.1
+2003-07-21
+added
+FPC compatibility
+
+
+7.9.1
+2003-07-21
+added
+New OnStatus event HR_Error
+
+
+7.9.1
+2003-07-21
+modified
+TSynaSin is replaced by TVarSin
+
+
+7.9.1
+2003-07-21
+added
+byte counters for received and sended bytes.
+
+
+7.9.1
+2003-07-21
+added
+AbortSocket function
+
+
+7.9.1
+2003-07-21
+added
+RecvBlock and SendBlock functions
+
+
+7.9.1
+2003-07-21
+added
+RecvStream and SendStream functions
+
+
+7.9.1
+2003-07-21
+added
+Purge function
+
+
+7.9.1
+2003-07-21
+added
+SSLGetPeerName function
+
+
+7.9.1
+2003-07-21
+added
+SSLGetCertInfo function
+
+
+7.9.1
+2003-07-21
+added
+SSLGetCiphername function
+
+
+7.9.1
+2003-07-21
+added
+SSLGetCipherBits function
+
+
+7.9.1
+2003-07-21
+added
+SSLGetCipherAlgBits function
+
+
+7.9.1
+2003-07-21
+added
+SSLGetVerifyCert function
+
+
+7.9.1
+2003-07-21
+added
+SSLType for specify SSL/TLS protocol version.
+
+
+7.9.1
+2003-07-21
+added
+SSLLoaded property
+
+
+7.9.1
+2003-07-21
+added
+HTTPTunnelTimeout
+
+
+7.9.1
+2003-07-21
+added
+New TDgramBlockSocket class with implememntation of datagram communication style instead stream based style.
+
+
+7.9.1
+2003-07-21
+added
+TICMPBlockSocket is now based on datagram communication.
+
+
+7.9.1
+2003-07-21
+fixed
+RaiseExcept allways fill LastErrorDesc property
+
+
+7.9.1
+2003-07-21
+fixed
+Waitingdata fix for avoid 'Out of memory' errors
+
+
+7.9.1
+2003-07-21
+fixed
+ResolvePort
+
+
+7.9.1
+2003-07-21
+added
+Timeout for SOCKS
+
+
+7.9.1
+2003-07-21
+fixed
+Fixed SOCKS4 code
+
+
+7.9.1
+2003-07-21
+fixed
+UDP on SOCKS5 authenticification
+
+
+7.9.1
+2003-07-21
+modified
+Better error handling on SSL connect
+
+
+7.9.1
+2003-07-21
+fixed
+Correct SSL shudown sequence
+
+
+Release 31
+2003-03-24
+
+
+
+
+7.2.14
+2003-03-24
+modified
+Better support for C++Builder
+
+
+7.2.14
+2003-03-24
+removed
+weakpackageunit
+
+
+7.2.14
+2003-03-24
+added
+Constatnt SynapseRelease with idetifier of current release
+
+
+7.2.14
+2003-03-24
+added
+Support for IPv6
+
+
+7.2.14
+2003-03-24
+added
+Hook called after Socket creation
+
+
+7.2.14
+2003-03-24
+added
+Support for Socks4 and Socks4a
+
+
+7.2.14
+2003-03-24
+modified
+If available new socket API, then use it! (improve performance!)
+
+
+7.2.14
+2003-03-24
+modified
+can switch timeout from 'interpacket' to 'overall'
+
+
+7.2.14
+2003-03-24
+added
+CreateSocketByname
+
+
+7.2.14
+2003-03-24
+added
+GetSinLocal
+
+
+7.2.14
+2003-03-24
+added
+GetSinRemote
+
+
+7.2.14
+2003-03-24
+removed
+property protocol. Use getSocketprotocol function instead!
+
+
+7.2.14
+2003-03-24
+added
+Lot of stuff for IPv6 support!
+
+
+7.2.14
+2003-03-24
+modified
+Minimize calls of Synsock.select in RecvPacket
+
+
+7.2.14
+2003-03-24
+added
+ResolveIPToName
+
+
+7.2.14
+2003-03-24
+modified
+Optimised work with TFDSet
+
+
+7.2.14
+2003-03-24
+modified
+Call GetSins after assigning new value to Socket property
+
+
+7.2.14
+2003-03-24
+added
+StrToIP6 and IP6ToStr
+
+
+7.2.14
+2003-03-24
+fixed
+decoding port number from SOCKS response
+
+
+7.2.14
+2003-03-24
+added
+IPv6 support in SOCKS5
+
+
+7.2.14
+2003-03-24
+fixed
+Call SSLDoShutdown properly inside CloseSocket (from Destroy too)
+
+
+7.2.14
+2003-03-24
+fixed
+Do proper shutdown of TCP socket
+
+
+7.2.14
+2003-03-24
+fixed
+resolve symbolic port names in HTTP tunnel requests
+
+
+7.2.14
+2003-03-24
+added
+support for IPv6 URLs inside HTTP tunnel requests
+
+
+Release 30
+2003-01-01
+
+
+
+
+6.6.1
+2003-01-01
+modified
+Socket interface is initialised only once per application by default
+
+
+6.6.1
+2003-01-01
+added
+new Event 'wait' if sending or receiving is stopped by bandwidth limitation
+
+
+6.6.1
+2003-01-01
+added
+Can filter readed or sended data
+
+
+6.6.1
+2003-01-01
+added
+RecvBufferStr
+
+
+6.6.1
+2003-01-01
+added
+can set TTL
+
+
+6.6.1
+2003-01-01
+added
+can set TTL for multicasts packets
+
+
+6.6.1
+2003-01-01
+added
+can set multicast loop
+
+
+6.6.1
+2003-01-01
+fixed
+name resolving functions is thread safe. (on some system s is problems with this!)
+
+
+6.6.1
+2003-01-01
+modified
+Optimised RecvBufferEx.
+
+
+6.6.1
+2003-01-01
+fixed
+do not call explicit socket shutdown.
+
+
+6.6.1
+2003-01-01
+fixed
+RecvPacket call error when connection terminates.
+
+
+6.6.1
+2003-01-01
+fixed
+recvterminated working correctly when Convertlineend is true and packets is splited inside line terminator.
+
+
+6.6.1
+2003-01-01
+fixed
+SOCKS5 handshake working correctly with splitted packets.
+
+
+6.6.1
+2003-01-01
+fixed
+SOCKS5 UDP support working correctly with unbinded socket
+
+
+Release 29
+2002-08-20
+
+
+
+
+6.1.4
+2002-08-20
+added
+Property LastErrorDesc with human readable description of lastError
+
+
+6.1.4
+2002-08-20
+added
+Limiting of bandwidth for both, reading and sending
+
+
+6.1.4
+2002-08-20
+added
+ConvertLineEbnd property for RecvString with any line terminator
+
+
+6.1.4
+2002-08-20
+added
+SSLLastError and SSLLastErrorDesc
+
+
+6.1.4
+2002-08-20
+added
+handling of verify client SSL certificate
+
+
+6.1.4
+2002-08-20
+added
+TSynaClient class as parent of any other client protocol classes
+
+
+6.1.4
+2002-08-20
+fixed
+Recvpacket not allocate huge memory in some cases
+
+
+6.1.4
+2002-08-20
+fixed
+SocksDecode
+
+
+6.1.4
+2002-08-20
+fixed
+setting SSL certificate password
+
+
+6.1.4
+2002-08-20
+fixed
+WaitigData working properly in SSL mode
+
+
+6.1.4
+2002-08-20
+added
+Error checking of SSL code
+
+
+Release 28
+2002-05-08
+
+
+
+
+5.7.0
+2002-05-05
+added
+AutoCreate socket capability. If you call Bind or Connect on non-created socket, then is socket created
+
+
+5.7.0
+2002-05-05
+added
+Support for setting keys and certificates for SSL/TLS
+
+
+5.7.0
+2002-05-05
+added
+Support for setting ciphers for SSL/TLS
+
+
+5.7.0
+2002-05-05
+added
+Support for SSL/TLS server mode
+
+
+5.7.0
+2002-05-05
+fixed
+LimitBandwidth
+
+
+5.7.0
+2002-05-05
+modified
+Optimized RecvPacket
+
+
+5.7.0
+2002-05-05
+modified
+RecvByte now using LineBuffer
+
+
+5.7.0
+2002-05-05
+modified
+Optimized RecvTerminated
+
+
+5.7.0
+2002-05-05
+fixed
+HTTP tunnel mode
+
+
+Release 27
+2002-02-10
+
+
+
+
+5.2.0
+2002-02-10
+added
+WaitingDataEx
+
+
+5.2.0
+2002-02-10
+added
+CanReadEx
+
+
+5.2.0
+2002-02-10
+added
+TCP HTTP Tunneling support
+
+
+5.2.0
+2002-02-10
+added
+TCP SSL/TLS support
+
+
+Release 26
+2001-12-10
+
+
+
+
+4.4.0
+2001-12-10
+added
+Limited support for non-blocking mode.
+
+
+4.4.0
+2001-12-10
+added
+Can limit outgoing bandwidth.
+
+
+4.4.0
+2001-12-10
+added
+RecvTerminated for receiving string with defined terminator.
+
+
+4.4.0
+2001-12-10
+added
+Local address bind can be reused.
+
+
+4.4.0
+2001-12-10
+added
+Can limit maximum length of received string.
+
+
+4.4.0
+2001-12-10
+added
+Support for UDP multicast.
+
+
+4.4.0
+2001-12-10
+fixed
+UDP now support status monitoring.
+
+
+4.4.0
+2001-12-10
+fixed
+TCP under SOCKS5 now works fine with all SOCKS5 servers.
+
+
+Release 25
+2001-09-24
+
+
+
+
+4.0.0
+2001-09-24
+added
+Support for SOCKS5 proxy on TCP and UDP sockets.
+
+
+4.0.0
+2001-09-24
+added
+RecvPacket
+
+
+4.0.0
+2001-09-24
+added
+ResolveName
+
+
+4.0.0
+2001-09-24
+added
+ResolvePort
+
+
+4.0.0
+2001-09-24
+added
+SetRemoteSin
+
+
+4.0.0
+2001-09-24
+added
+SetSendTimeout
+
+
+4.0.0
+2001-09-24
+added
+SetRecvTimeout
+
+
+4.0.0
+2001-09-24
+modified
+all send methods use internally SendBuffer - you may use all send method for sending datagrams.
+
+
+4.0.0
+2001-09-24
+fixed
+UDP not working on all systems
+
+
+4.0.0
+2001-09-24
+modified
+Response UDP may income from different IP then where previously UDP is sended.
+
+
+Release 24
+2001-08-27
+
+
+
+
+3.3.0
+2001-08-27
+added
+OnStatus event for monitoring status od socket or for monitoring how much data is reading or sending.
+
+
+3.3.0
+2001-08-27
+fixed
+Winsock is correctly closed on destructor.
+
+
+3.3.0
+2001-08-27
+modified
+Default is used static mapping of Winsock.
+
+
+3.3.0
+2001-08-27
+fixed
+Dynamic loading of Winsock (under Windows) is now thread safe!
+
+
+Release 23
+2001-07-28
+
+
+
+
+3.2.0
+2001-07-23
+fixed
+CloseSocket on TCP socket do graceful disconnect.
+
+
+3.2.0
+2001-07-23
+modified
+GetErrorDesc is now class function.
+
+
+3.2.0
+2001-07-23
+added
+GroupCanRead method is as CanRead method on set of sockets.
+
+
+3.2.0
+2001-07-23
+added
+SetTimeout method for setting timeout on Winsock2 or Linux systems.
+
+
+3.2.0
+2001-07-23
+modified
+optimalizations.
+
+
+3.2.0
+2001-07-23
+added
+merged with blcksck2.pas unit.
+
+
+Release 22
+2001-06-17
+
+
+
+
+Release 21
+2001-05-13
+
+
+
+
+3.1.0
+2001-05-13
+fixed
+Fixed RecvString for bug in Win2000
+
+
+3.1.0
+2001-05-13
+modified
+RecvString now correctly strip CRLF sequence under Linux
+
+
+3.0.0
+2001-05-13
+added
+Compatibility with Kylix
+
+
+3.0.0
+2001-05-13
+added
+New constructor CreateAlternate. It allows under Windows use another DLL then wsock32.dll
+
+
+3.0.0
+2001-05-13
+added
+method ResolveNameToIP for resolve computer name to set of their IPs.
+
+
+Release 20
+2001-04-22
+
+
+
+
+Release 19
+2001-04-07
+
+
+
+
+2.1.1
+2001-04-07
+fixed
+fixed result on RecvBufferEx.
+
+
+2.1.0
+2001-03-12
+added
+SizerecvBuff and SizeSendBuff Property for control winsock buffers. Usable for performance tuning.
+
+
+2.1.0
+2001-03-12
+fixed
+improved compatibily with C++ Builder.
+
+
+2.1.0
+2001-03-12
+added
+RecvBuffEx for very powerful receive any size of data. Only this function may be freely combined with RecvString!
+
+
+Release 18
+2001-03-11
+
+
+
+
+Release 17
+2001-02-10
+
+
+
+
+2.0.1
+2001-02-10
+added
+Property LineBuffer contains prebufferred data after Recvstring. it usefull when you need swith between line and binary mode.
+
+
+2.0.1
+2001-02-10
+modified
+Recvstring uses better dynamic buffer for better performance and robust solution when you try reading binary data.
+
+
+Release 16
+2001-01-22
+
+
+
+
+Release 15
+2000-12-10
+
+
+
+
+Release 14
+2000-11-27
+
+
+
+
+Release 13
+2000-10-24
+
+
+
+
+Release 12
+2000-10-15
+
+
+
+
+Release 11
+2000-09-18
+
+
+
+
+2.0.0
+2000-09-18
+modified
+all times is now in millisecond!
+
+
+2.0.0
+2000-09-18
+modified
+SendBufferTo is now function
+
+
+2.0.0
+2000-09-18
+modified
+SendBuffer is now function
+
+
+2.0.0
+2000-09-18
+added
+optional exception handling
+
+
+Release 10
+2000-08-20
+
+
+
+
+Release 09
+2000-06-14
+
+
+
+
+1.1.1
+2000-03-17
+fixed
+reading by RecvBuffer from unconnected socket cause WSAENOTCONN error.
+
+
+Release 08
+2000-03-15
+
+
+
+
+1.1.0
+2000-02-14
+added
+support for broadcast on UDP socket.
+
+
+1.1.0
+2000-02-14
+fixed
+name resolving work OK on Delphi 4 and more.
+
+
+Release 07
+2000-02-13
+
+
+
+
+Release 06
+2000-01-31
+
+
+
+
+Release 05
+2000-01-23
+
+
+
+
+Release 04
+2000-01-08
+
+
+
+
+Release 03
+1999-11-14
+
+
+
+
+1.0.2
+1999-11-08
+fixed
+method RecvString - fixed reading from unconnected socket.
+
+
+Release 02
+1999-10-16
+
+
+
+
+1.0.1
+1999-10-16
+modified
+only any descriptions
+
+
+Release 01
+1999-09-19
+
+
+
+
+1.0.0
+1999-09-19
+added
+Class TTCPBlockSocket (ancestor of TBlockSocket) implementing TCP protocol.
+
+
+1.0.0
+1999-09-19
+added
+Class TUDPBlockSocket (ancestor of TBlockSocket) implementing UDP protocol.
+
+
+1.0.0
+1999-09-19
+added
+Class TBlockSocket wrapping Winsock socket.
+
+
+Jump to top
+
+
+
+
+clamsend
+
+
+
+
+Release 38
+2007-12-21
+
+
+
+
+Release 37
+2006-09-12
+
+
+
+
+1.0.0
+2005-11-01
+added
+Initial implementation of ClamAV-Daemon TCP client
+
+
+Jump to top
+
+
+
+
+dnssend
+
+
+
+
+Release 38
+2007-12-21
+
+
+
+
+2.7.4
+2007-01-11
+modified
+using port numbers instead symbolic names
+
+
+Release 37
+2006-09-12
+
+
+
+
+2.7.3
+2006-08-03
+fixed
+typo error AnsferInfo -> AnswerInfo
+
+
+2.7.2
+2006-06-29
+removed
+ReverseIP and ReverseIP6 moved to new unit synaip.
+
+
+2.7.1
+2006-03-31
+modified
+Queries for IPv6 addreses not depending on IPv6 support in OS.
+
+
+Release 36
+2005-10-23
+
+
+
+
+2.7.0
+2005-10-23
+added
+Support for QTYPE_SPF
+
+
+Release 35
+2005-01-23
+
+
+
+
+Release 34
+2004-09-18
+
+
+
+
+2.6.0
+2004-09-18
+added
+Truncated property
+
+
+2.6.0
+2004-09-18
+fixed
+Multiline TXT records
+
+
+Release 33
+2004-08-23
+
+
+
+
+2.5.1
+2004-08-23
+modified
+IPv6 reverse queries to ip6.arpa domain
+
+
+Release 32
+2003-07-21
+
+
+
+
+2.3.4
+2003-07-21
+added
+FPC compatibility
+
+
+2.3.4
+2003-07-21
+fixed
+parsing of packet
+
+
+2.3.4
+2003-07-21
+added
+SRV record support
+
+
+Release 31
+2003-03-24
+
+
+
+
+2.2.2
+2003-03-24
+removed
+weakpackageunit
+
+
+2.2.2
+2003-03-24
+added
+AAAA query
+
+
+2.2.2
+2003-03-24
+added
+Reverse queries for IPv6 addresses by ip6.int domain
+
+
+2.2.2
+2003-03-24
+fixed
+better support for bad reply
+
+
+Release 30
+2003-01-01
+
+
+
+
+2.1.1
+2003-01-01
+added
+TCP queries
+
+
+2.1.1
+2003-01-01
+added
+zone transfers
+
+
+2.1.1
+2003-01-01
+added
+full info about all fields in DNS reply. (include TTL)
+
+
+2.1.1
+2003-01-01
+fixed
+decoding string resources
+
+
+2.1.1
+2003-01-01
+added
+detecting authoritative ansfers
+
+
+Release 29
+2002-08-20
+
+
+
+
+1.2.0
+2002-08-20
+modified
+adaption to TSynaClient
+
+
+1.2.0
+2002-08-20
+added
+can specify outgoing IP interface
+
+
+Release 28
+2002-05-08
+
+
+
+
+Release 27
+2002-02-10
+
+
+
+
+Release 26
+2001-12-10
+
+
+
+
+Release 25
+2001-09-24
+
+
+
+
+1.1.4
+2001-09-24
+modified
+optimalisations
+
+
+Release 24
+2001-08-27
+
+
+
+
+1.1.3
+2001-08-27
+modified
+published sock property
+
+
+Release 23
+2001-07-28
+
+
+
+
+1.1.1
+2001-07-23
+modified
+optimalizations
+
+
+Release 22
+2001-06-17
+
+
+
+
+Release 21
+2001-05-13
+
+
+
+
+Release 20
+2001-04-22
+
+
+
+
+Release 19
+2001-04-07
+
+
+
+
+Release 18
+2001-03-11
+
+
+
+
+Release 17
+2001-02-10
+
+
+
+
+Release 16
+2001-01-22
+
+
+
+
+Release 15
+2000-12-10
+
+
+
+
+Release 14
+2000-11-27
+
+
+
+
+Release 13
+2000-10-24
+
+
+
+
+Release 12
+2000-10-15
+
+
+
+
+Release 11
+2000-09-18
+
+
+
+
+1.1.0
+2000-09-18
+modified
+all times is now in millisecond!
+
+
+Release 10
+2000-08-20
+
+
+
+
+Release 09
+2000-06-14
+
+
+
+
+Release 08
+2000-03-15
+
+
+
+
+Release 07
+2000-02-13
+
+
+
+
+Release 06
+2000-01-31
+
+
+
+
+Release 05
+2000-01-23
+
+
+
+
+1.0.0
+2000-01-23
+added
+Class TDNSSend implementing DNS protocol
+
+
+Jump to top
+
+
+
+
+ftpsend
+
+
+
+
+Release 38
+2007-12-21
+
+
+
+
+3.5.0
+2007-01-23
+modified
+ChangeToRootDir was renamed to ChangeToParentDir.
+
+
+3.5.0
+2007-01-23
+added
+new ChangeToRootDir method what really doing change to root directory.
+
+
+3.4.10
+2007-01-23
+fixed
+Linger setting for active data connection.
+
+
+3.4.9
+2007-01-11
+modified
+using port numbers instead symbolic names
+
+
+Release 37
+2006-09-12
+
+
+
+
+3.4.8
+2006-07-18
+fixed
+directory mask for MVS (IBM framework).
+
+
+3.4.8
+2006-07-18
+added
+next directory mask for VMS
+
+
+3.4.7
+2006-01-26
+fixed
+decoding of some long filenames in EPLF format
+
+
+3.4.6
+2005-12-22
+fixed
+firts element in EPLF directory format is not parsed
+
+
+Release 36
+2005-10-23
+
+
+
+
+3.4.5
+2005-10-23
+modified
+new SSL plugin model
+
+
+3.4.5
+2005-10-23
+added
+TelnetAbort - do ABOR command with telnet breaks codes
+
+
+3.4.5
+2005-10-23
+modified
+Before each FTP command is called purge. It never goes out of sync.
+
+
+3.4.5
+2005-10-23
+modified
+if SSL/TLS is used for data transfers, then use passive transfer.
+
+
+3.4.5
+2005-10-23
+fixed
+better errorcheck in DataWrite
+
+
+3.4.5
+2005-10-23
+modified
+Abort call ABOR FTP command too.
+
+
+3.4.5
+2005-10-23
+fixed
+'t' permission is parsed correctly
+
+
+Release 35
+2005-01-23
+
+
+
+
+Release 34
+2004-09-18
+
+
+
+
+3.1.0
+2004-09-18
+added
+directory listing contains permission string
+
+
+Release 33
+2004-08-23
+
+
+
+
+3.0.3
+2004-08-23
+added
+ForceOldport property for disabling new EPRT and EPSV commands
+
+
+3.0.3
+2004-08-23
+modified
+DoStatus can report multiline replyes
+
+
+3.0.3
+2004-08-23
+fixed
+ReadResult
+
+
+3.0.3
+2004-08-23
+fixed
+Server can reply by 100 based reply before welcomme string
+
+
+3.0.3
+2004-08-23
+fixed
+Call PBSZ before PROT command
+
+
+3.0.3
+2004-08-23
+fixed
+data connection usinfg same interface as control connection.
+
+
+3.0.3
+2004-08-23
+modified
+Totally new directory list parsing!
+
+
+3.0.3
+2004-08-23
+fixed
+uploading of zero-lenght files
+
+
+Release 32
+2003-07-21
+
+
+
+
+2.7.0
+2003-07-21
+added
+FPC compatibility
+
+
+2.7.0
+2003-07-21
+added
+StreamSecII support
+
+
+2.7.0
+2003-07-21
+added
+can turn off SSL/TLS on data channel
+
+
+2.7.0
+2003-07-21
+fixed
+correct handling of date 2-29 in FTP directory parsing
+
+
+Release 31
+2003-03-24
+
+
+
+
+2.6.6
+2003-03-24
+removed
+weakpackageunit
+
+
+2.6.6
+2003-03-24
+modified
+DataRead and datawrite moved to public section for your special functions
+
+
+2.6.6
+2003-03-24
+modified
+typo error in name of RetrieveFile method
+
+
+2.6.6
+2003-03-24
+added
+If it is possible, then use EPSV or EPRT instead PASV or PORT
+
+
+Release 30
+2003-01-01
+
+
+
+
+2.5.4
+2003-01-01
+added
+SSL/TLS support
+
+
+2.5.4
+2003-01-01
+added
+ASCII transfers
+
+
+2.5.4
+2003-01-01
+fixed
+parsing of long file names
+
+
+2.5.4
+2003-01-01
+added
+FtpInterServerTransfer
+
+
+Release 29
+2002-08-20
+
+
+
+
+2.3.1
+2002-08-20
+modified
+adaption to TSynaClient
+
+
+2.3.1
+2002-08-20
+added
+can specify outgoing IP interface
+
+
+2.3.1
+2002-08-20
+added
+aborting of data transfers
+
+
+2.3.1
+2002-08-20
+modified
+test only class of return code from FTP server
+
+
+2.3.1
+2002-08-20
+fixed
+closing of datareading channel
+
+
+2.3.1
+2002-08-20
+fixed
+unix style listing decoding
+
+
+2.3.1
+2002-08-20
+added
+parsing of long names from directory listing
+
+
+Release 28
+2002-05-08
+
+
+
+
+2.0.0
+2002-05-05
+added
+parsing of directory list
+
+
+2.0.0
+2002-05-05
+modified
+better autodetection of REST support
+
+
+Release 27
+2002-02-10
+
+
+
+
+1.2.2
+2002-02-10
+fixed
+LIST
+
+
+Release 26
+2001-12-10
+
+
+
+
+Release 25
+2001-09-24
+
+
+
+
+1.2.0
+2001-09-24
+added
+hook for FTP status
+
+
+1.2.0
+2001-09-24
+added
+can be used on SOCKS5
+
+
+Release 24
+2001-08-27
+
+
+
+
+1.0.0
+2001-08-27
+added
+Class TFTPSend implementing FTP protocol.
+
+
+Jump to top
+
+
+
+
+ftptsend
+
+
+
+
+Release 38
+2007-12-21
+
+
+
+
+Release 37
+2006-09-12
+
+
+
+
+Release 36
+2005-10-23
+
+
+
+
+Release 35
+2005-01-23
+
+
+
+
+Release 34
+2004-09-18
+
+
+
+
+Release 33
+2004-08-23
+
+
+
+
+1.1.0
+2004-08-23
+modified
+Some minor changes
+
+
+Release 32
+2003-07-21
+
+
+
+
+1.0.2
+2003-07-21
+added
+Class TTFTPSend implementing client of TrivialFTP protocol
+
+
+Jump to top
+
+
+
+
+httpsend
+
+
+
+
+Release 38
+2007-12-21
+
+
+
+
+3.11.3
+2007-11-22
+modified
+ReadUnknown hide 'connection reset by peer' socket error, because it is nature end of data transfer here.
+
+
+3.11.3
+2007-11-22
+fixed
+can work with unexpected status-100
+
+
+3.11.2
+2007-11-19
+fixed
+ignore content-length if chunked transfer is detected
+
+
+3.11.0
+2007-05-18
+added
+AddPortNumberToHost property
+
+
+3.10.7
+2007-01-23
+fixed
+usage of ranges 0-x
+
+
+3.10.6
+2007-01-09
+fixed
+sock.lasterror returning correct error code for unknown host in URL.
+
+
+Release 37
+2006-09-12
+
+
+
+
+3.10.5
+2006-02-25
+modified
+restructualized code for connecting
+
+
+3.10.4
+2006-02-03
+modified
+Sending of HTTP query not causing delay by 'delayed ACK issue'.
+
+
+3.10.3
+2005-12-07
+fixed
+When failed reading of response header, never try to read document body too.
+
+
+3.10.3
+2005-12-07
+modified
+ReadUnknown returns true only when connection is grecefully closed on end
+
+
+3.10.2
+2005-12-06
+fixed
+content-length header is added to request when some document is sended only.
+
+
+Release 36
+2005-10-23
+
+
+
+
+3.10.1
+2005-10-23
+modified
+new SSL plugin model
+
+
+Release 35
+2005-01-23
+
+
+
+
+3.9.5
+2005-01-23
+added
+Range support for getting document from position to end.
+
+
+3.9.5
+2005-01-23
+fixed
+keep-alives after socket errors
+
+
+Release 34
+2004-09-18
+
+
+
+
+Release 33
+2004-08-23
+
+
+
+
+3.9.3
+2004-08-23
+added
+Username and password properties for default authorisation values
+
+
+3.9.3
+2004-08-23
+fixed
+Content-length is sended in all cases.
+
+
+3.9.3
+2004-08-23
+fixed
+Cookies are sended all in one header.
+
+
+3.9.3
+2004-08-23
+fixed
+Reading of Chunks
+
+
+Release 32
+2003-07-21
+
+
+
+
+3.6.7
+2003-07-21
+added
+FPC support
+
+
+Release 31
+2003-03-24
+
+
+
+
+3.6.4
+2003-03-24
+removed
+weakpackageunit
+
+
+3.6.4
+2003-03-24
+added
+Support for StreamSec
+
+
+3.6.4
+2003-03-24
+modified
+Status100 is now optional feature (turned off by default)
+
+
+3.6.4
+2003-03-24
+modified
+Default timeout is now 90 seconds
+
+
+3.6.4
+2003-03-24
+fixed
+not silently falldown from SSL/TLS to non-secure connection when SLL support fails!
+
+
+3.6.4
+2003-03-24
+added
+IPv6 support in URLs
+
+
+Release 30
+2003-01-01
+
+
+
+
+3.4.4
+2003-01-01
+added
+Cookies
+
+
+3.4.4
+2003-01-01
+added
+UserAgent support
+
+
+3.4.4
+2003-01-01
+added
+Ranges of documents
+
+
+3.4.4
+2003-01-01
+added
+support for easy draw progress bars
+
+
+3.4.4
+2003-01-01
+modified
+speed and memory optimalisations
+
+
+3.4.4
+2003-01-01
+fixed
+HttpPostFile boundary
+
+
+Release 29
+2002-08-20
+
+
+
+
+3.2.0
+2002-08-20
+modified
+adaption to TSynaClient
+
+
+3.2.0
+2002-08-20
+added
+can specify outgoing IP interface
+
+
+3.2.0
+2002-08-20
+added
+resistent for any version of incorrect line terminators
+
+
+3.2.0
+2002-08-20
+fixed
+headers sending under linux
+
+
+Release 28
+2002-05-08
+
+
+
+
+3.0.3
+2002-05-05
+modified
+optimalized sending
+
+
+3.0.3
+2002-05-05
+fixed
+HttpPostUrl
+
+
+3.0.3
+2002-05-05
+fixed
+HttpPostFile
+
+
+3.0.3
+2002-05-05
+modified
+default HTTP protocol version is now 1.0
+
+
+Release 27
+2002-02-10
+
+
+
+
+3.0.0
+2002-02-10
+added
+SSL support
+
+
+Release 26
+2001-12-10
+
+
+
+
+Release 25
+2001-09-24
+
+
+
+
+2.3.0
+2001-09-24
+fixed
+Better receive of unknown data
+
+
+Release 24
+2001-08-27
+
+
+
+
+2.2.0
+2001-08-27
+added
+HTTPPostFile procedure for simulating posting file by HTML form
+
+
+2.2.0
+2001-08-27
+modified
+published sock property
+
+
+Release 23
+2001-07-28
+
+
+
+
+2.1.1
+2001-07-23
+modified
+optimalizations
+
+
+Release 22
+2001-06-17
+
+
+
+
+2.1.0
+2001-06-17
+added
+function HttpPostURL
+
+
+Release 21
+2001-05-13
+
+
+
+
+Release 20
+2001-04-22
+
+
+
+
+Release 19
+2001-04-07
+
+
+
+
+2.0.0
+2001-03-12
+added
+new major release!
+
+
+Release 18
+2001-03-11
+
+
+
+
+Release 17
+2001-02-10
+
+
+
+
+Release 16
+2001-01-22
+
+
+
+
+1.2.0
+2001-01-22
+modified
+HTTPport is now string
+
+
+1.2.0
+2001-01-22
+added
+New high level method DoMethod for handling any HTTP 1.0 method
+
+
+1.2.0
+2001-01-22
+added
+DoMethod handling proxy support
+
+
+1.2.0
+2001-01-22
+modified
+GET function now use DoRequest and use URL insted host and URI
+
+
+1.2.0
+2001-01-22
+added
+POST function
+
+
+1.2.0
+2001-01-22
+added
+SimpleGet for simple requesting GET method by HTTP 0.9
+
+
+Release 15
+2000-12-10
+
+
+
+
+Release 14
+2000-11-27
+
+
+
+
+Release 13
+2000-10-24
+
+
+
+
+Release 12
+2000-10-15
+
+
+
+
+Release 11
+2000-09-18
+
+
+
+
+1.1.0
+2000-09-18
+modified
+all times is now in millisecond!
+
+
+Release 10
+2000-08-20
+
+
+
+
+Release 09
+2000-06-14
+
+
+
+
+Release 08
+2000-03-15
+
+
+
+
+Release 07
+2000-02-13
+
+
+
+
+Release 06
+2000-01-31
+
+
+
+
+Release 05
+2000-01-23
+
+
+
+
+Release 04
+2000-01-08
+
+
+
+
+Release 03
+1999-11-14
+
+
+
+
+1.0.0
+1999-11-13
+added
+Class THTTPSend implementing HTTP protocol
+
+
+Jump to top
+
+
+
+
+imapsend
+
+
+
+
+Release 38
+2007-12-21
+
+
+
+
+Release 37
+2006-09-12
+
+
+
+
+Release 36
+2005-10-23
+
+
+
+
+2.5.1
+2005-10-23
+modified
+new SSL plugin model
+
+
+2.5.1
+2005-10-23
+fixed
+parsing of MessageSize result
+
+
+Release 35
+2005-01-23
+
+
+
+
+Release 34
+2004-09-18
+
+
+
+
+Release 33
+2004-08-23
+
+
+
+
+2.5.0
+2004-08-23
+added
+ListSearch and ListSearchSubscribed
+
+
+Release 32
+2003-07-21
+
+
+
+
+2.4.2
+2003-07-21
+added
+FPC compatibility
+
+
+2.4.2
+2003-07-21
+added
+AddFlagsMess function
+
+
+2.4.2
+2003-07-21
+added
+DelFlagsmess function
+
+
+2.4.2
+2003-07-21
+fixed
+StatusFolder
+
+
+Release 31
+2003-03-24
+
+
+
+
+2.3.5
+2003-03-24
+removed
+weakpackageunit
+
+
+2.3.5
+2003-03-24
+added
+Support for StreamSec
+
+
+2.3.5
+2003-03-24
+modified
+default timeout is now 60 seconds
+
+
+2.3.5
+2003-03-24
+fixed
+process all literals in IMAP server reply
+
+
+2.3.5
+2003-03-24
+fixed
+proper decode result of StatusFolder
+
+
+Release 30
+2003-01-01
+
+
+
+
+2.2.1
+2003-01-01
+fixed
+IMAP upload
+
+
+2.2.1
+2003-01-01
+fixed
+parse folder list
+
+
+2.2.1
+2003-01-01
+fixed
+getting IMAP flags
+
+
+2.2.1
+2003-01-01
+added
+GetUID
+
+
+2.2.1
+2003-01-01
+fixed
+IMAP status
+
+
+Release 29
+2002-08-20
+
+
+
+
+2.1.0
+2002-08-20
+modified
+adaption to TSynaClient
+
+
+2.1.0
+2002-08-20
+added
+can specify outgoing IP interface
+
+
+2.1.0
+2002-08-20
+added
+resistent for any version of incorrect line terminators.
+
+
+Release 28
+2002-05-08
+
+
+
+
+2.0.0
+2002-05-05
+added
+SSL/TLS support
+
+
+Release 27
+2002-02-10
+
+
+
+
+Release 26
+2001-12-10
+
+
+
+
+1.0.0
+2001-12-10
+added
+Class TIMAPSend implementing client of IMAP4rev1 protocol
+
+
+Jump to top
+
+
+
+
+ldapsend
+
+
+
+
+Release 38
+2007-12-21
+
+
+
+
+Release 37
+2006-09-12
+
+
+
+
+1.4.1
+2005-12-10
+fixed
+Do not unquote binary datas in search result.
+
+
+Release 36
+2005-10-23
+
+
+
+
+1.4.0
+2005-10-23
+modified
+new SSL plugin model
+
+
+Release 35
+2005-01-23
+
+
+
+
+1.3.0
+2005-01-23
+added
+Added TLDAPAttributeList.Del
+
+
+Release 34
+2004-09-18
+
+
+
+
+Release 33
+2004-08-23
+
+
+
+
+1.2.1
+2004-08-23
+fixed
+search filter '!'
+
+
+Release 32
+2003-07-21
+
+
+
+
+1.0.11
+2003-07-21
+added
+Class TLDAPSend implementing client of LDAP protocol.
+
+
+Jump to top
+
+
+
+
+mimeinln
+
+
+
+
+Release 38
+2007-12-21
+
+
+
+
+1.1.11
+2006-12-26
+modified
+Beter formating in InlineEmailEx.
+
+
+1.1.10
+2006-11-05
+modified
+function InlineCodeEx using IdealCharsets variable
+
+
+Release 37
+2006-09-12
+
+
+
+
+Release 36
+2005-10-23
+
+
+
+
+1.1.9
+2005-10-23
+fixed
+Needinline not return true by '_'
+
+
+Release 35
+2005-01-23
+
+
+
+
+Release 34
+2004-09-18
+
+
+
+
+Release 33
+2004-08-23
+
+
+
+
+1.1.8
+2004-08-23
+fixed
+fixed charset decoding in InlineDecode
+
+
+1.1.8
+2004-08-23
+modified
+InlineEncode splitting large values
+
+
+Release 32
+2003-07-21
+
+
+
+
+1.1.2
+2003-07-21
+added
+FPC compatibility
+
+
+1.1.2
+2003-07-21
+added
+InlineCodeEx function
+
+
+1.1.2
+2003-07-21
+added
+InlineEmailEx function
+
+
+Release 31
+2003-03-24
+
+
+
+
+1.0.7
+2003-03-24
+removed
+weakpackageunit
+
+
+1.0.7
+2003-03-24
+fixed
+InlineDecode have workaround for broken inline coding without proper ending
+
+
+Release 30
+2003-01-01
+
+
+
+
+1.0.5
+2003-01-01
+fixed
+InlineDecode
+
+
+Release 29
+2002-08-20
+
+
+
+
+Release 28
+2002-05-08
+
+
+
+
+Release 27
+2002-02-10
+
+
+
+
+Release 26
+2001-12-10
+
+
+
+
+1.0.3
+2001-12-10
+fixed
+decode now works with broken codings
+
+
+Release 25
+2001-09-24
+
+
+
+
+Release 24
+2001-08-27
+
+
+
+
+Release 23
+2001-07-28
+
+
+
+
+1.0.2
+2001-07-23
+modified
+optimalizations
+
+
+Release 22
+2001-06-17
+
+
+
+
+Release 21
+2001-05-13
+
+
+
+
+Release 20
+2001-04-22
+
+
+
+
+Release 19
+2001-04-07
+
+
+
+
+Release 18
+2001-03-11
+
+
+
+
+Release 17
+2001-02-10
+
+
+
+
+Release 16
+2001-01-22
+
+
+
+
+Release 15
+2000-12-10
+
+
+
+
+Release 14
+2000-11-27
+
+
+
+
+1.0.0
+2000-11-27
+added
+functions for inline MIME from MIMEpart unit
+
+
+Jump to top
+
+
+
+
+mimemess
+
+
+
+
+Release 38
+2007-12-21
+
+
+
+
+2.5.2
+2006-12-26
+modified
+TMessHeader.EncodeHeaders better formating of generated receivers list.
+
+
+2.5.1
+2006-11-05
+modified
+AddPartEx using IdealCharsets variable
+
+
+Release 37
+2006-09-12
+
+
+
+
+Release 36
+2005-10-23
+
+
+
+
+2.5.0
+2005-10-23
+added
+AddPartTextEx for adding text part with desired encoding
+
+
+Release 35
+2005-01-23
+
+
+
+
+Release 34
+2004-09-18
+
+
+
+
+Release 33
+2004-08-23
+
+
+
+
+2.4.3
+2004-08-23
+added
+Reply-to header support
+
+
+2.4.3
+2004-08-23
+added
+Message-id header support
+
+
+2.4.3
+2004-08-23
+added
+Unified support for various headers for setting message priorities
+
+
+2.4.3
+2004-08-23
+modified
+header class restructured for easy enhancing
+
+
+2.4.3
+2004-08-23
+added
+AddPartMess and AddpartmessfromFile for adding another message as attachment.
+
+
+Release 32
+2003-07-21
+
+
+
+
+2.2.3
+2003-07-21
+added
+FPC compatibility
+
+
+2.2.3
+2003-07-21
+added
+CharsetCode property
+
+
+2.2.3
+2003-07-21
+fixed
+Correct parsing list of e-mail addresses in headers
+
+
+Release 31
+2003-03-24
+
+
+
+
+2.1.3
+2003-03-24
+removed
+weakpackageunit
+
+
+Release 30
+2003-01-01
+
+
+
+
+Release 29
+2002-08-20
+
+
+
+
+2.1.2
+2002-08-20
+modified
+totaly reworked for use with new TMimePart class
+
+
+2.1.2
+2002-08-20
+added
+can handle any multipart tree structure
+
+
+2.1.2
+2002-08-20
+added
+loading new parts from stream of file
+
+
+Release 28
+2002-05-08
+
+
+
+
+1.7.4
+2002-05-05
+modified
+CustomHeaders not contains automaticly created headers by EncodeMessage
+
+
+1.7.4
+2002-05-05
+modified
+Finding headers is nor case insensitive
+
+
+1.7.4
+2002-05-05
+fixed
+EmcodeMessage now do encode of each part
+
+
+Release 27
+2002-02-10
+
+
+
+
+1.7.2
+2002-02-10
+added
+parse x-mailer header
+
+
+Release 26
+2001-12-10
+
+
+
+
+1.7.0
+2001-12-10
+added
+support for easy finding unparsed headers
+
+
+1.7.0
+2001-12-10
+added
+parsing CarbonCopy headers
+
+
+1.7.0
+2001-12-10
+added
+parsing Date of message
+
+
+1.7.0
+2001-12-10
+fixed
+parsing list of receivers and CCs is now one address per line
+
+
+1.7.0
+2001-12-10
+fixed
+memory hole
+
+
+Release 25
+2001-09-24
+
+
+
+
+Release 24
+2001-08-27
+
+
+
+
+1.5.0
+2001-08-27
+added
+can handle any custom message headers
+
+
+1.5.0
+2001-08-27
+added
+can specify secondary type of multipart message
+
+
+1.5.0
+2001-08-27
+fixed
+correctly ended multipart message
+
+
+Release 23
+2001-07-28
+
+
+
+
+1.4.0
+2001-07-23
+modified
+optimalizations
+
+
+1.4.0
+2001-07-23
+modified
+message header is now object, not record
+
+
+Release 22
+2001-06-17
+
+
+
+
+Release 21
+2001-05-13
+
+
+
+
+1.3.0
+2001-05-13
+added
+AddPartHTMLBinary for including binary binaries (i.e. pictures) to HTML e-mails.
+
+
+Release 20
+2001-04-22
+
+
+
+
+Release 19
+2001-04-07
+
+
+
+
+1.2.0
+2001-04-07
+added
+support for content-disposition
+
+
+1.2.0
+2001-04-07
+added
+support for easy handle HTML mails
+
+
+Release 18
+2001-03-11
+
+
+
+
+Release 17
+2001-02-10
+
+
+
+
+Release 16
+2001-01-22
+
+
+
+
+Release 15
+2000-12-10
+
+
+
+
+1.1.0
+2000-12-10
+modified
+change in 'normalize' in part
+
+
+Release 14
+2000-11-27
+
+
+
+
+1.0.1
+2000-11-27
+modified
+cleanup code
+
+
+Release 13
+2000-10-24
+
+
+
+
+Release 12
+2000-10-15
+
+
+
+
+1.0.0
+2000-10-15
+added
+unit started
+
+
+Jump to top
+
+
+
+
+mimepart
+
+
+
+
+Release 38
+2007-12-21
+
+
+
+
+2.7.7
+2007-11-22
+fixed
+workaround for buggy HMLP mails produced by Outlook 11.
+
+
+2.7.6
+2007-05-17
+fixed
+Do not overwrite CharsetCode by empty charset, because it invalidate DefaultCharset capability.
+
+
+Release 37
+2006-09-12
+
+
+
+
+2.7.5
+2006-08-09
+fixed
+MaxSubLevel is propagated to subparts.
+
+
+2.7.4
+2006-07-27
+modified
+Do not find META header in HTML part if no HTML HEAD part is present.
+
+
+2.7.3
+2006-03-17
+modified
+dependency on synafpc unit
+
+
+Release 36
+2005-10-23
+
+
+
+
+2.7.2
+2005-10-23
+added
+ConvertCharset property for turn-off internal charset translations
+
+
+2.7.2
+2005-10-23
+added
+ForcedHTMLConvert property for force charset translations on HTML parts.
+
+
+2.7.2
+2005-10-23
+modified
+Encodepart - optimalised
+
+
+Release 35
+2005-01-23
+
+
+
+
+2.6.3
+2005-01-23
+fixed
+headers are splited correctly
+
+
+Release 34
+2004-09-18
+
+
+
+
+Release 33
+2004-08-23
+
+
+
+
+2.6.2
+2004-08-23
+fixed
+Normalizeheader can process badly splitted lines
+
+
+2.6.2
+2004-08-23
+fixed
+Fix for HTML parts with included meta header with encoding
+
+
+2.6.2
+2004-08-23
+fixed
+Add BOM for unicode based parts on encoding
+
+
+Release 32
+2003-07-21
+
+
+
+
+2.4.8
+2003-07-21
+added
+FPC compatibility
+
+
+2.4.8
+2003-07-21
+added
+Limit for nesting of subparts
+
+
+2.4.8
+2003-07-21
+added
+AttachInside property
+
+
+2.4.8
+2003-07-21
+modified
+much faster and better DecodePart
+
+
+2.4.8
+2003-07-21
+modified
+Filename is filled when exists
+
+
+2.4.8
+2003-07-21
+fixed
+EncodePart
+
+
+2.4.8
+2003-07-21
+fixed
+GenerateBoundary is more unique
+
+
+Release 31
+2003-03-24
+
+
+
+
+2.3.4
+2003-03-24
+modified
+Encode only needed characters in QuotedPrintable part
+
+
+2.3.4
+2003-03-24
+fixed
+MimeTypeFromExt return as default secondary type 'Octet-Stream'
+
+
+Release 30
+2003-01-01
+
+
+
+
+2.3.2
+2003-01-01
+added
+Assign part (without subparts)
+
+
+2.3.2
+2003-01-01
+added
+assign part (with subparts)
+
+
+2.3.2
+2003-01-01
+added
+DeleteSubPart
+
+
+2.3.2
+2003-01-01
+fixed
+lines of part is not trimmed
+
+
+2.3.2
+2003-01-01
+fixed
+Filename of attachment is MIME encoded
+
+
+Release 29
+2002-08-20
+
+
+
+
+2.1.2
+2002-08-20
+modified
+totaly reworked. Now it more flexible, faster and more comaptible.
+
+
+Release 28
+2002-05-08
+
+
+
+
+1.8.4
+2002-05-05
+fixed
+splitting of long lines in Quoted-printable encoding is now only between words
+
+
+Release 27
+2002-02-10
+
+
+
+
+1.8.1
+2002-02-10
+added
+option for handle mime post-part as mime part
+
+
+Release 26
+2001-12-10
+
+
+
+
+1.7.0
+2001-12-10
+added
+default charset (workaround fot Outlook bug)
+
+
+1.7.0
+2001-12-10
+fixed
+detection of end of multipart message
+
+
+1.7.0
+2001-12-10
+modified
+encoded text is breaked to lines with maximum 76 chars
+
+
+1.7.0
+2001-12-10
+modified
+increased speed of encoding
+
+
+Release 25
+2001-09-24
+
+
+
+
+1.5.2
+2001-09-24
+fixed
+bug in detection end of message
+
+
+1.5.2
+2001-09-24
+added
+can detect filename in text part
+
+
+1.5.2
+2001-09-24
+fixed
+correct end of base64 encoded part
+
+
+Release 24
+2001-08-27
+
+
+
+
+1.5.0
+2001-08-27
+fixed
+part of message between last boundary and end of message is not reported as Mime part.
+
+
+Release 23
+2001-07-28
+
+
+
+
+1.4.1
+2001-07-23
+modified
+optimalizations
+
+
+Release 22
+2001-06-17
+
+
+
+
+Release 21
+2001-05-13
+
+
+
+
+1.4.0
+2001-05-13
+added
+support for content-ID
+
+
+Release 20
+2001-04-22
+
+
+
+
+Release 19
+2001-04-07
+
+
+
+
+1.3.0
+2001-04-07
+added
+support for content-disposition
+
+
+Release 18
+2001-03-11
+
+
+
+
+Release 17
+2001-02-10
+
+
+
+
+Release 16
+2001-01-22
+
+
+
+
+Release 15
+2000-12-10
+
+
+
+
+1.2.0
+2000-12-10
+added
+decode UU code and XXcode
+
+
+1.2.0
+2000-12-10
+removed
+function NormalizePart
+
+
+1.2.0
+2000-12-10
+added
+function NormalizeHeader
+
+
+1.2.0
+2000-12-10
+fixed
+decode filename is more robust (now support MIME inline code)
+
+
+Release 14
+2000-11-27
+
+
+
+
+1.1.0
+2000-11-27
+added
+new 10 mime types
+
+
+1.1.0
+2000-11-27
+removed
+functions for inline MIME moved to separate unit
+
+
+Release 13
+2000-10-24
+
+
+
+
+1.0.1
+2000-10-24
+fixed
+empty secondary MIME type
+
+
+1.0.1
+2000-10-24
+fixed
+better decoding filename in attachment
+
+
+Release 12
+2000-10-15
+
+
+
+
+1.0.0
+2000-10-15
+added
+unit started
+
+
+Jump to top
+
+
+
+
+nntpsend
+
+
+
+
+Release 38
+2007-12-21
+
+
+
+
+1.5.1
+2007-01-11
+modified
+using port numbers instead symbolic names
+
+
+Release 37
+2006-09-12
+
+
+
+
+Release 36
+2005-10-23
+
+
+
+
+1.5.0
+2005-10-23
+modified
+new SSL plugin model
+
+
+Release 35
+2005-01-23
+
+
+
+
+1.4.1
+2005-01-23
+fixed
+GetStat
+
+
+Release 34
+2004-09-18
+
+
+
+
+Release 33
+2004-08-23
+
+
+
+
+1.4.0
+2004-08-23
+modified
+Logout is function
+
+
+Release 32
+2003-07-21
+
+
+
+
+1.3.3
+2003-07-21
+added
+FPC compatibility
+
+
+Release 31
+2003-03-24
+
+
+
+
+1.3.1
+2003-03-24
+removed
+weakpackageunit
+
+
+1.3.1
+2003-03-24
+added
+Support for StreamSec
+
+
+1.3.1
+2003-03-24
+added
+Support for SSL/TLS
+
+
+1.3.1
+2003-03-24
+added
+ListExtensions
+
+
+1.3.1
+2003-03-24
+modified
+default timeout is 60 seconds
+
+
+Release 30
+2003-01-01
+
+
+
+
+1.2.3
+2003-01-01
+fixed
+message upload
+
+
+1.2.3
+2003-01-01
+added
+user login (if needed)
+
+
+1.2.3
+2003-01-01
+added
+universal command for any NNTP command (include command for download or upload datas)
+
+
+1.2.3
+2003-01-01
+added
+XOVER command
+
+
+Release 29
+2002-08-20
+
+
+
+
+1.1.0
+2002-08-20
+modified
+adaption to TSynaClient
+
+
+1.1.0
+2002-08-20
+added
+can specify outgoing IP interface
+
+
+1.1.0
+2002-08-20
+added
+resistent for any version of incorrect line terminators
+
+
+Release 28
+2002-05-08
+
+
+
+
+Release 27
+2002-02-10
+
+
+
+
+Release 26
+2001-12-10
+
+
+
+
+1.0.0
+2001-12-10
+added
+Class TNNTPSend implementing client of NNTP protocol
+
+
+Jump to top
+
+
+
+
+pingsend
+
+
+
+
+Release 38
+2007-12-21
+
+
+
+
+4.0.0
+2007-03-30
+added
+TTL property
+
+
+4.0.0
+2007-03-30
+added
+Trying to use IPhlpAPI support on WinXP and better. It opens Ping and Traceroute support for non-admin users on these systems.
+
+
+Release 37
+2006-09-12
+
+
+
+
+3.1.8
+2006-07-20
+fixed
+checking for timeout (on systems where are lot of other ICMP packets...)
+
+
+3.1.7
+2006-03-17
+modified
+Removed dependency on widnows/libc unit
+
+
+Release 36
+2005-10-23
+
+
+
+
+Release 35
+2005-01-23
+
+
+
+
+Release 34
+2004-09-18
+
+
+
+
+Release 33
+2004-08-23
+
+
+
+
+3.1.6
+2004-08-23
+fixed
+Support for WinXP SP1
+
+
+3.1.6
+2004-08-23
+fixed
+Better detection of unwanted query echo
+
+
+Release 32
+2003-07-21
+
+
+
+
+3.1.5
+2003-07-21
+added
+FPC compatibility
+
+
+3.1.5
+2003-07-21
+added
+can handle ICMP errors
+
+
+3.1.5
+2003-07-21
+added
+TraceRoute
+
+
+Release 31
+2003-03-24
+
+
+
+
+3.0.2
+2003-03-24
+removed
+weakpackageunit
+
+
+3.0.2
+2003-03-24
+added
+support for ICMPv6 ping
+
+
+Release 30
+2003-01-01
+
+
+
+
+Release 29
+2002-08-20
+
+
+
+
+2.3.1
+2002-08-20
+modified
+adaption to TSynaClient
+
+
+2.3.1
+2002-08-20
+added
+can specify outgoing IP interface
+
+
+2.3.1
+2002-08-20
+fixed
+receiving of reply check ID of packet
+
+
+Release 28
+2002-05-08
+
+
+
+
+Release 27
+2002-02-10
+
+
+
+
+Release 26
+2001-12-10
+
+
+
+
+Release 25
+2001-09-24
+
+
+
+
+2.1.2
+2001-09-24
+modified
+optimalisations of receive packet
+
+
+Release 24
+2001-08-27
+
+
+
+
+2.1.1
+2001-08-27
+modified
+published sock property
+
+
+Release 23
+2001-07-28
+
+
+
+
+2.1.0
+2001-07-23
+fixed
+correct time measurement on Linux
+
+
+2.1.0
+2001-07-23
+modified
+on some systems is sended packet copied as received
+
+
+Release 22
+2001-06-17
+
+
+
+
+Release 21
+2001-05-13
+
+
+
+
+2.0.0
+2001-05-13
+added
+support for Kylix
+
+
+Release 20
+2001-04-22
+
+
+
+
+Release 19
+2001-04-07
+
+
+
+
+Release 18
+2001-03-11
+
+
+
+
+Release 17
+2001-02-10
+
+
+
+
+Release 16
+2001-01-22
+
+
+
+
+Release 15
+2000-12-10
+
+
+
+
+Release 14
+2000-11-27
+
+
+
+
+Release 13
+2000-10-24
+
+
+
+
+Release 12
+2000-10-15
+
+
+
+
+Release 11
+2000-09-18
+
+
+
+
+1.1.0
+2000-09-18
+modified
+all times is now in millisecond!
+
+
+Release 10
+2000-08-20
+
+
+
+
+Release 09
+2000-06-14
+
+
+
+
+Release 08
+2000-03-15
+
+
+
+
+1.0.0
+2000-02-14
+added
+Class TPINGSend implementing ICMP PING
+
+
+Jump to top
+
+
+
+
+pop3send
+
+
+
+
+Release 38
+2007-12-21
+
+
+
+
+2.6.0
+2007-01-25
+added
+CustomCommand method for calling any custom POP3 command.
+
+
+2.5.2
+2007-01-11
+modified
+using port numbers instead symbolic names
+
+
+2.5.1
+2007-01-09
+fixed
+Connection error was not detected during reading of multiline response.
+
+
+2.5.1
+2007-01-09
+modified
+One-line response is added to FullResult too.
+
+
+Release 37
+2006-09-12
+
+
+
+
+2.5.0
+2005-12-09
+added
+ListSize property for size of listed message or for size of all listed messages. (after List method)
+
+
+2.5.0
+2005-12-09
+added
+RetrStream for dowloading message dirrectly to some TStream
+
+
+Release 36
+2005-10-23
+
+
+
+
+2.4.0
+2005-10-23
+modified
+new SSL plugin model
+
+
+Release 35
+2005-01-23
+
+
+
+
+Release 34
+2004-09-18
+
+
+
+
+Release 33
+2004-08-23
+
+
+
+
+2.3.0
+2004-08-23
+fixed
+If requested SSL, then not fallback to non-SSL if server not supporting safe connections
+
+
+Release 32
+2003-07-21
+
+
+
+
+2.1.10
+2003-07-21
+added
+FPC compatibility
+
+
+Release 31
+2003-03-24
+
+
+
+
+2.1.8
+2003-03-24
+removed
+weakpackageunit
+
+
+2.1.8
+2003-03-24
+added
+Support for StreamSec
+
+
+2.1.8
+2003-03-24
+modified
+default timeout is 60 seconds
+
+
+Release 30
+2003-01-01
+
+
+
+
+2.1.4
+2003-01-01
+fixed
+omit '.' from begin of download line
+
+
+Release 29
+2002-08-20
+
+
+
+
+2.1.0
+2002-08-20
+modified
+adaption to TSynaClient
+
+
+2.1.0
+2002-08-20
+added
+can specify outgoing IP interface
+
+
+2.1.0
+2002-08-20
+added
+resistent for any version of incorrect line terminators
+
+
+Release 28
+2002-05-08
+
+
+
+
+2.0.0
+2002-05-05
+added
+SSL/TLS support
+
+
+2.0.0
+2002-05-05
+added
+CAPA command
+
+
+Release 27
+2002-02-10
+
+
+
+
+Release 26
+2001-12-10
+
+
+
+
+Release 25
+2001-09-24
+
+
+
+
+Release 24
+2001-08-27
+
+
+
+
+Release 23
+2001-07-28
+
+
+
+
+Release 22
+2001-06-17
+
+
+
+
+Release 21
+2001-05-13
+
+
+
+
+Release 20
+2001-04-22
+
+
+
+
+Release 19
+2001-04-07
+
+
+
+
+Release 18
+2001-03-11
+
+
+
+
+Release 17
+2001-02-10
+
+
+
+
+Release 16
+2001-01-22
+
+
+
+
+Release 15
+2000-12-10
+
+
+
+
+Release 14
+2000-11-27
+
+
+
+
+Release 13
+2000-10-24
+
+
+
+
+Release 12
+2000-10-15
+
+
+
+
+1.2.0
+2000-10-12
+modified
+workaround for servers what closing connection after unsuccessful login.
+
+
+Release 11
+2000-09-18
+
+
+
+
+1.1.2
+2000-08-27
+modified
+published sock property
+
+
+Release 10
+2000-08-20
+
+
+
+
+1.1.1
+2000-07-23
+modified
+optimalizations
+
+
+Release 09
+2000-06-14
+
+
+
+
+1.1.0
+2000-05-13
+added
+property AuthType for control authorisation to POP3 server
+
+
+1.0.0
+2000-04-07
+added
+Class TPOP3Send implementing POP3 protocol
+
+
+Jump to top
+
+
+
+
+slogsend
+
+
+
+
+Release 38
+2007-12-21
+
+
+
+
+Release 37
+2006-09-12
+
+
+
+
+Release 36
+2005-10-23
+
+
+
+
+1.2.2
+2005-10-23
+fixed
+syslog message parser
+
+
+1.2.2
+2005-10-23
+modified
+outgoing messages goes from random UDP port
+
+
+Release 35
+2005-01-23
+
+
+
+
+Release 34
+2004-09-18
+
+
+
+
+Release 33
+2004-08-23
+
+
+
+
+1.2.0
+2004-08-23
+added
+TSysLogMessage class for abstraction of Syslog message. It is good for writing of Syslog servers!
+
+
+Release 32
+2003-07-21
+
+
+
+
+1.1.6
+2003-07-21
+added
+FPC compatibility
+
+
+Release 31
+2003-03-24
+
+
+
+
+1.1.4
+2003-03-24
+removed
+weakpackageunit
+
+
+Release 30
+2003-01-01
+
+
+
+
+Release 29
+2002-08-20
+
+
+
+
+1.1.1
+2002-08-20
+modified
+adaption to TSynaClient
+
+
+1.1.1
+2002-08-20
+added
+can specify outgoing IP interface
+
+
+Release 28
+2002-05-08
+
+
+
+
+Release 27
+2002-02-10
+
+
+
+
+Release 26
+2001-12-10
+
+
+
+
+Release 25
+2001-09-24
+
+
+
+
+1.0.0
+2001-09-24
+added
+Class TSyslogSend implementing client of BSD Syslog protocol.
+
+
+Jump to top
+
+
+
+
+smtpsend
+
+
+
+
+Release 38
+2007-12-21
+
+
+
+
+3.4.3
+2007-01-11
+modified
+using port numbers instead symbolic names
+
+
+Release 37
+2006-09-12
+
+
+
+
+Release 36
+2005-10-23
+
+
+
+
+3.4.2
+2005-10-23
+modified
+new SSL plugin model
+
+
+3.4.2
+2005-10-23
+modified
+optimalised message sending for speed
+
+
+Release 35
+2005-01-23
+
+
+
+
+Release 34
+2004-09-18
+
+
+
+
+Release 33
+2004-08-23
+
+
+
+
+3.3.1
+2004-08-23
+fixed
+Fixed fallback from SSL, when server not supporting SSL.
+
+
+Release 32
+2003-07-21
+
+
+
+
+3.2.10
+2003-07-21
+added
+FPC compatibility
+
+
+3.2.10
+2003-07-21
+fixed
+SendToRaw parsing e-mail addresses from list
+
+
+Release 31
+2003-03-24
+
+
+
+
+3.2.8
+2003-03-24
+removed
+weakpackageunit
+
+
+3.2.8
+2003-03-24
+added
+Support for StreamSec
+
+
+3.2.8
+2003-03-24
+modified
+default timeout is 60 seconds
+
+
+Release 30
+2003-01-01
+
+
+
+
+Release 29
+2002-08-20
+
+
+
+
+3.2.4
+2002-08-20
+modified
+adaption to TSynaClient
+
+
+3.2.4
+2002-08-20
+added
+can specify outgoing IP interface
+
+
+3.2.4
+2002-08-20
+added
+resistent for any version of incorrect line terminators.
+
+
+3.2.4
+2002-08-20
+fixed
+cannot send EHLO twice after successful AUTH
+
+
+Release 28
+2002-05-08
+
+
+
+
+3.1.0
+2002-05-05
+added
+SSL/TLS support
+
+
+Release 27
+2002-02-10
+
+
+
+
+2.2.0
+2002-02-10
+modified
+sample function can handle specifycationb of non-standard port in SMTP address.
+
+
+2.2.0
+2002-02-10
+modified
+sample function can handle multiple receivers divided by comma.
+
+
+Release 26
+2001-12-10
+
+
+
+
+Release 25
+2001-09-24
+
+
+
+
+Release 24
+2001-08-27
+
+
+
+
+2.1.4
+2001-08-27
+modified
+published sock property
+
+
+Release 23
+2001-07-28
+
+
+
+
+2.1.3
+2001-07-23
+modified
+optimalizations
+
+
+Release 22
+2001-06-17
+
+
+
+
+Release 21
+2001-05-13
+
+
+
+
+Release 20
+2001-04-22
+
+
+
+
+Release 19
+2001-04-07
+
+
+
+
+2.1.0
+2001-03-12
+added
+property SMTPport
+
+
+2.1.0
+2001-03-12
+added
+property SystemName
+
+
+2.1.0
+2001-03-12
+fixed
+can reuse SMTP object after disconnect without derstroying object.
+
+
+2.1.0
+2001-03-12
+modified
+try EHLO after success authorisation
+
+
+2.1.0
+2001-03-12
+added
+Findcap method for easy serach ESMTP capability
+
+
+2.1.0
+2001-03-12
+fixed
+some SMTP command waiting for more result then is receive... it cause hang.
+
+
+2.1.0
+2001-03-12
+modified
+If 'AUTH' parameter not found, try find 'AUTH='
+
+
+Release 18
+2001-03-11
+
+
+
+
+Release 17
+2001-02-10
+
+
+
+
+Release 16
+2001-01-22
+
+
+
+
+2.0.0
+2001-01-22
+added
+handling Enhanced Result Codes (codes like: '250 2.0.0 OK')
+
+
+2.0.0
+2001-01-22
+added
+FullResult contains all multiline result of previous command
+
+
+2.0.0
+2001-01-22
+added
+ESMTPcap contains list of ESMPT capabilites after login
+
+
+2.0.0
+2001-01-22
+added
+ESMTP indicates successful ligin to ESMTP server
+
+
+2.0.0
+2001-01-22
+added
+Support for ESMTP AUTH command (LOGIN and CRAM-MD5 login method)
+
+
+2.0.0
+2001-01-22
+added
+Support for SIZE parameter
+
+
+2.0.0
+2001-01-22
+added
+Support for ETRN command
+
+
+2.0.0
+2001-01-22
+added
+Support for VRFY command
+
+
+Release 15
+2000-12-10
+
+
+
+
+Release 14
+2000-11-27
+
+
+
+
+Release 13
+2000-10-24
+
+
+
+
+Release 12
+2000-10-15
+
+
+
+
+1.3.0
+2000-10-09
+added
+function SendToRaw
+
+
+Release 11
+2000-09-18
+
+
+
+
+1.2.0
+2000-09-18
+modified
+all times is now in millisecond!
+
+
+Release 10
+2000-08-20
+
+
+
+
+1.1.1
+2000-06-18
+fixed
+method MailData correct duplicate dot on line beginning dotted.
+
+
+Release 09
+2000-06-14
+
+
+
+
+1.1.0
+2000-03-17
+added
+property Resultcode of last SMTP command.
+
+
+1.1.0
+2000-03-17
+added
+property ResultString of last SMTP command.
+
+
+Release 08
+2000-03-15
+
+
+
+
+Release 07
+2000-02-13
+
+
+
+
+Release 06
+2000-01-31
+
+
+
+
+Release 05
+2000-01-23
+
+
+
+
+Release 04
+2000-01-08
+
+
+
+
+Release 03
+1999-11-14
+
+
+
+
+1.0.1
+1999-11-14
+removed
+Function TimeZone moved to SynaUtil unit.
+
+
+1.0.1
+1999-11-14
+removed
+Function Rfc822DateTime moved to SynaUtil unit.
+
+
+Release 02
+1999-10-16
+
+
+
+
+1.0.0
+1999-10-16
+added
+Class TSMTPSend implementing SMTP protocol
+
+
+Jump to top
+
+
+
+
+snmpsend
+
+
+
+
+Release 38
+2007-12-21
+
+
+
+
+3.0.9
+2007-02-14
+modified
+ID is incremented intarnally.
+
+
+Release 37
+2006-09-12
+
+
+
+
+Release 36
+2005-10-23
+
+
+
+
+3.0.8
+2005-10-23
+fixed
+RecvTrap function allways returns 0
+
+
+Release 35
+2005-01-23
+
+
+
+
+Release 34
+2004-09-18
+
+
+
+
+Release 33
+2004-08-23
+
+
+
+
+3.0.7
+2004-08-23
+modified
+merged with SnmpTrap unit
+
+
+3.0.7
+2004-08-23
+added
+Added support for SNMPv2c and SNMPv3
+
+
+Release 32
+2003-07-21
+
+
+
+
+2.6.4
+2003-07-21
+added
+FPC compatibility
+
+
+Release 31
+2003-03-24
+
+
+
+
+2.6.2
+2003-03-24
+removed
+weakpackageunit
+
+
+Release 30
+2003-01-01
+
+
+
+
+2.6.0
+2003-01-01
+added
+MibCount
+
+
+2.6.0
+2003-01-01
+added
+MibByIndex
+
+
+2.6.0
+2003-01-01
+modified
+better SNMGetTable
+
+
+Release 29
+2002-08-20
+
+
+
+
+2.5.0
+2002-08-20
+modified
+adaption to TSynaClient
+
+
+2.5.0
+2002-08-20
+added
+can specify outgoing IP interface
+
+
+2.5.0
+2002-08-20
+added
+function SNMPGetNext
+
+
+2.5.0
+2002-08-20
+added
+function SNMPGetTable for very easy reading of SNMP tables
+
+
+2.5.0
+2002-08-20
+added
+function SNMPGetTableElement for very easy reading of SNMP table cell
+
+
+Release 28
+2002-05-08
+
+
+
+
+Release 27
+2002-02-10
+
+
+
+
+Release 26
+2001-12-10
+
+
+
+
+Release 25
+2001-09-24
+
+
+
+
+Release 24
+2001-08-27
+
+
+
+
+2.3.3
+2001-08-27
+modified
+published sock property
+
+
+Release 23
+2001-07-28
+
+
+
+
+2.3.2
+2001-07-23
+modified
+optimalizations
+
+
+Release 22
+2001-06-17
+
+
+
+
+2.3.1
+2001-06-17
+fixed
+encoding of SNMP packet
+
+
+Release 21
+2001-05-13
+
+
+
+
+Release 20
+2001-04-22
+
+
+
+
+Release 19
+2001-04-07
+
+
+
+
+Release 18
+2001-03-11
+
+
+
+
+Release 17
+2001-02-10
+
+
+
+
+2.3.0
+2001-02-10
+modified
+chceck for consistency of decoded data. More robust when reply data is incomplete or broken.
+
+
+2.3.0
+2001-02-10
+fixed
+small memory leak
+
+
+Release 16
+2001-01-22
+
+
+
+
+Release 15
+2000-12-10
+
+
+
+
+Release 14
+2000-11-27
+
+
+
+
+Release 13
+2000-10-24
+
+
+
+
+2.2.0
+2000-10-24
+fixed
+handling signed and unsigned integer values
+
+
+2.2.0
+2000-10-24
+modified
+Clear not reset ID
+
+
+Release 12
+2000-10-15
+
+
+
+
+Release 11
+2000-09-18
+
+
+
+
+2.1.0
+2000-09-18
+modified
+all times is now in millisecond!
+
+
+2.1.0
+2000-09-18
+removed
+TSNMPMIBValueType
+
+
+2.1.0
+2000-09-18
+removed
+ConvertvalueType
+
+
+2.1.0
+2000-09-18
+modified
+All MIB type uses ASN1_* constants (before uses TSNMPMIBValueType)
+
+
+2.1.0
+2000-09-18
+added
+TSNMPRec.DecodeBuf automaticly detect value type
+
+
+2.1.0
+2000-09-18
+added
+TSNMPRec.EncodeBuf now support all possible value types
+
+
+Release 10
+2000-08-20
+
+
+
+
+2.0.0
+2000-08-20
+added
+Major update: full support of SNMP protocol (reading and writing values).
+
+
+Release 09
+2000-06-14
+
+
+
+
+Release 08
+2000-03-15
+
+
+
+
+Release 07
+2000-02-13
+
+
+
+
+1.1.0
+2000-02-01
+removed
+ASN.1 support routines moved to separate unit.
+
+
+Release 06
+2000-01-31
+
+
+
+
+Release 05
+2000-01-23
+
+
+
+
+1.0.0
+2000-01-10
+added
+Class TSNMPSend implementing SNMP protocol.
+
+
+Jump to top
+
+
+
+
+snmptrap
+
+
+Obsoleted!
+
+
+
+
+Obsoleted
+2004-08-23
+
+
+
+
+2.3.4
+2004-08-23
+removed
+moved to snmpsend
+
+
+Release 32
+2003-07-21
+
+
+
+
+2.3.4
+2003-07-21
+added
+FPC compatibility
+
+
+Release 31
+2003-03-24
+
+
+
+
+2.3.2
+2003-03-24
+removed
+weakpackageunit
+
+
+Release 30
+2003-01-01
+
+
+
+
+Release 29
+2002-08-20
+
+
+
+
+2.3.0
+2002-08-20
+modified
+adaption to TSynaClient
+
+
+2.3.0
+2002-08-20
+added
+can specify outgoing IP interface
+
+
+Release 28
+2002-05-08
+
+
+
+
+Release 27
+2002-02-10
+
+
+
+
+Release 26
+2001-12-10
+
+
+
+
+Release 25
+2001-09-24
+
+
+
+
+Release 24
+2001-08-27
+
+
+
+
+2.2.3
+2001-08-17
+modified
+published sock property
+
+
+Release 23
+2001-07-28
+
+
+
+
+2.2.2
+2001-07-23
+modified
+optimalizations
+
+
+Release 22
+2001-06-17
+
+
+
+
+2.2.1
+2001-06-17
+fixed
+encoding of SNMP packet
+
+
+Release 21
+2001-05-13
+
+
+
+
+Release 20
+2001-04-22
+
+
+
+
+Release 19
+2001-04-07
+
+
+
+
+Release 18
+2001-03-11
+
+
+
+
+Release 17
+2001-02-10
+
+
+
+
+2.2.0
+2001-02-10
+modified
+check for consistency of decoded data. More robust when reply data is incomplete or broken.
+
+
+2.2.0
+2001-02-10
+fixed
+small memory leak
+
+
+Release 16
+2001-01-22
+
+
+
+
+Release 15
+2000-12-10
+
+
+
+
+Release 14
+2000-11-27
+
+
+
+
+Release 13
+2000-10-24
+
+
+
+
+2.1.0
+2000-10-24
+fixed
+handling signed and unsigned integer values
+
+
+Release 12
+2000-10-15
+
+
+
+
+2.0.1
+2000-10-15
+fixed
+Decodetrap correctly decode Enterprise property.
+
+
+Release 11
+2000-09-18
+
+
+
+
+2.0.0
+2000-09-18
+modified
+all times is now in millisecond!
+
+
+2.0.0
+2000-09-18
+added
+Major update: full support for all type of MIB types.
+
+
+Release 10
+2000-08-20
+
+
+
+
+1.2.1
+2000-08-20
+fixed
+method Recv not receive trap packet.
+
+
+Release 09
+2000-06-14
+
+
+
+
+Release 08
+2000-03-15
+
+
+
+
+Release 07
+2000-02-13
+
+
+
+
+1.2.0
+2000-02-01
+added
+Class TSNMPTrap implementing SNMP TRAPs.
+
+
+Jump to top
+
+
+
+
+sntpsend
+
+
+
+
+Release 38
+2007-12-21
+
+
+
+
+3.0.2
+2007-01-11
+modified
+using port numbers instead symbolic names
+
+
+Release 37
+2006-09-12
+
+
+
+
+Release 36
+2005-10-23
+
+
+
+
+3.0.1
+2005-10-23
+fixed
+protection for late incomming replies
+
+
+Release 35
+2005-01-23
+
+
+
+
+Release 34
+2004-09-18
+
+
+
+
+Release 33
+2004-08-23
+
+
+
+
+3.0.0
+2004-08-23
+modified
+rewrited handling of NTP message
+
+
+Release 32
+2003-07-21
+
+
+
+
+2.2.7
+2003-07-21
+added
+FPC compatibility
+
+
+2.2.7
+2003-07-21
+fixed
+GetBroadcastNTP
+
+
+Release 31
+2003-03-24
+
+
+
+
+2.2.3
+2003-03-24
+removed
+weakpackageunit
+
+
+Release 30
+2003-01-01
+
+
+
+
+2.2.1
+2003-01-01
+fixed
+EncodeTS not causing EInvalidOP exception
+
+
+Release 29
+2002-08-20
+
+
+
+
+2.2.0
+2002-08-20
+modified
+adaption to TSynaClient
+
+
+2.2.0
+2002-08-20
+added
+can specify outgoing IP interface
+
+
+Release 28
+2002-05-08
+
+
+
+
+Release 27
+2002-02-10
+
+
+
+
+Release 26
+2001-12-10
+
+
+
+
+2.1.0
+2001-12-10
+added
+better precizion
+
+
+2.1.0
+2001-12-10
+added
+can synchronize your local clock
+
+
+Release 25
+2001-09-24
+
+
+
+
+Release 24
+2001-08-27
+
+
+
+
+1.1.2
+2001-08-27
+modified
+published sock property
+
+
+Release 23
+2001-07-28
+
+
+
+
+1.1.1
+2001-07-23
+modified
+optimalizations
+
+
+Release 22
+2001-06-17
+
+
+
+
+Release 21
+2001-05-13
+
+
+
+
+Release 20
+2001-04-22
+
+
+
+
+Release 19
+2001-04-07
+
+
+
+
+Release 18
+2001-03-11
+
+
+
+
+Release 17
+2001-02-10
+
+
+
+
+Release 16
+2001-01-22
+
+
+
+
+Release 15
+2000-12-10
+
+
+
+
+Release 14
+2000-11-27
+
+
+
+
+Release 13
+2000-10-24
+
+
+
+
+Release 12
+2000-10-15
+
+
+
+
+Release 11
+2000-09-18
+
+
+
+
+1.1.0
+2000-09-18
+modified
+all times is now in millisecond!
+
+
+Release 10
+2000-08-20
+
+
+
+
+Release 09
+2000-06-14
+
+
+
+
+1.0.0
+2000-03-17
+added
+Class TSNTPSend implementing client of SNTP protocol
+
+
+Jump to top
+
+
+
+
+ssl_cryptlib
+
+
+
+
+Release 38
+2007-12-21
+
+
+
+
+Release 37
+2006-09-12
+
+
+
+
+1.1.0
+2006-07-18
+fixed
+data fetching from CryptLib working with large packets. (made by internal buffering in plugin)
+
+
+Release 36
+2005-10-23
+
+
+
+
+1.0.2
+2005-07-19
+added
+Initial implementation of CryptLib SSL/TLS/SSH plugin
+
+
+Jump to top
+
+
+
+
+ssl_openssl
+
+
+
+
+Release 38
+2007-12-21
+
+
+
+
+Release 37
+2006-09-12
+
+
+
+
+1.0.4
+2005-11-28
+fixed
+added checks for returned valid remote peer certificate
+
+
+Release 36
+2005-10-23
+
+
+
+
+1.0.3
+2005-07-20
+added
+Initial implementation of OpenSSL SSL/TLS plugin
+
+
+Jump to top
+
+
+
+
+ssl_streamsec
+
+
+
+
+Release 38
+2007-12-21
+
+
+
+
+Release 37
+2006-09-12
+
+
+
+
+Release 36
+2005-10-23
+
+
+
+
+1.0.5
+2005-07-20
+added
+Initial implementation of StreamSecII/OpenStreamSecII SSL/TLS plugin
+
+
+Jump to top
+
+
+
+
+synachar
+
+
+
+
+Release 38
+2007-12-21
+
+
+
+
+5.2.2
+2006-12-26
+modified
+Removed LIBC dependency for non-libc targets in freepascal. (but GetCurCP allways returning UTF_8 in this case!)
+
+
+5.2.1
+2006-12-26
+modified
+made 'ISO-8859-8' as canonical for this kind of encoding. (was: ISO_8859-8)
+
+
+5.2.0
+2006-11-05
+added
+IdealCharsets variable with default set of encodings for IdealCharsetCoding function.
+
+
+5.1.4
+2006-10-01
+added
+Support for ISO-8859-8-i charset
+
+
+Release 37
+2006-09-12
+
+
+
+
+Release 36
+2005-10-23
+
+
+
+
+5.1.3
+2005-10-23
+fixed
+ReadMulti is better protected for ilformed sequences
+
+
+Release 35
+2005-01-23
+
+
+
+
+5.1.0
+2005-01-23
+added
+StringToWide and WideToString
+
+
+Release 34
+2004-09-18
+
+
+
+
+Release 33
+2004-08-23
+
+
+
+
+5.0.1
+2004-08-23
+added
+Optional support for ICONV library
+
+
+5.0.1
+2004-08-23
+added
+When is used ICONV library, then is supported much more charsets!
+
+
+5.0.1
+2004-08-23
+added
+Support for littleendian unicodes
+
+
+5.0.1
+2004-08-23
+added
+CharsetConversionTrans method for handling trabscriptions of unhandled chars.
+
+
+5.0.1
+2004-08-23
+added
+GetCurOEMCP
+
+
+5.0.1
+2004-08-23
+modified
+IdealCharsetencoding is much more effective.
+
+
+5.0.1
+2004-08-23
+added
+GetBOM
+
+
+Release 32
+2003-07-21
+
+
+
+
+4.0.8
+2003-07-21
+added
+FPC compatibility
+
+
+4.0.8
+2003-07-21
+fixed
+Replace_Czech table
+
+
+Release 31
+2003-03-24
+
+
+
+
+4.0.5
+2003-03-24
+removed
+weakpackageunit
+
+
+4.0.5
+2003-03-24
+modified
+optimised readmulti and writemulti
+
+
+Release 30
+2003-01-01
+
+
+
+
+4.0.3
+2003-01-01
+fixed
+reading of wrong multibytes
+
+
+4.0.3
+2003-01-01
+fixed
+UTF7toUCS2 on ill coded UTF7
+
+
+Release 29
+2002-08-20
+
+
+
+
+Release 28
+2002-05-08
+
+
+
+
+Release 27
+2002-02-10
+
+
+
+
+Release 26
+2001-12-10
+
+
+
+
+4.0.1
+2001-12-10
+fixed
+decoding of UTF7
+
+
+Release 25
+2001-09-24
+
+
+
+
+4.0.0
+2001-09-24
+added
+added support for character replacing in charset transformations.
+
+
+Release 24
+2001-08-27
+
+
+
+
+3.2.0
+2001-08-27
+added
+added support for ISO-8859-13, ISO-8859-14 and ISO-8859-15.
+
+
+Release 23
+2001-07-28
+
+
+
+
+3.1.0
+2001-07-23
+modified
+optimalizations
+
+
+3.1.0
+2001-07-23
+modified
+rename unit from MimeChar to SynaChar
+
+
+3.1.0
+2001-07-23
+added
+added support for CP-895 (Kamenickych code)
+
+
+3.1.0
+2001-07-23
+added
+added support for CP-852 (PC-Latin-2)
+
+
+Release 22
+2001-06-17
+
+
+
+
+Release 21
+2001-05-13
+
+
+
+
+3.0.0
+2001-05-13
+added
+Support for Kylix
+
+
+Release 20
+2001-04-22
+
+
+
+
+Release 19
+2001-04-07
+
+
+
+
+Release 18
+2001-03-11
+
+
+
+
+Release 17
+2001-02-10
+
+
+
+
+Release 16
+2001-01-22
+
+
+
+
+Release 15
+2000-12-10
+
+
+
+
+2.0.0
+2000-12-10
+added
+Support for UNICODE (UCS-2, UCS-4, UTF-7 and UTF-8)
+
+
+Release 14
+2000-11-27
+
+
+
+
+Release 13
+2000-10-24
+
+
+
+
+1.1.0
+2000-10-24
+added
+KOI8-R coding
+
+
+Release 12
+2000-10-15
+
+
+
+
+1.0.0
+2000-10-15
+added
+unit started
+
+
+Jump to top
+
+
+
+
+synacode
+
+
+
+
+Release 38
+2007-12-21
+
+
+
+
+2.2.0
+2007-01-04
+added
+MD4
+
+
+Release 37
+2006-09-12
+
+
+
+
+Release 36
+2005-10-23
+
+
+
+
+2.1.4
+2005-10-23
+fixed
+added '+' to URL special chars
+
+
+Release 35
+2005-01-23
+
+
+
+
+Release 34
+2004-09-18
+
+
+
+
+Release 33
+2004-08-23
+
+
+
+
+2.1.1
+2004-08-23
+modified
+EncodeQuotedprintable encode only really necessary chars
+
+
+2.1.1
+2004-08-23
+added
+EncodeSafeQuotedprintable encode all potencionally unwanted chars
+
+
+2.1.1
+2004-08-23
+added
+Encodebase64mod and decodebase64mod for modified base64 encoding used in UTF-7 for IMAP.
+
+
+2.1.1
+2004-08-23
+fixed
+MD5
+
+
+2.1.1
+2004-08-23
+added
+MD5LongHash
+
+
+2.1.1
+2004-08-23
+added
+SHA1, HMAC_SHA1 and SHA1LongHash
+
+
+Release 32
+2003-07-21
+
+
+
+
+1.8.7
+2003-07-21
+added
+FPC compatibility
+
+
+1.8.7
+2003-07-21
+modified
+DecodeTripet is much faster
+
+
+1.8.7
+2003-07-21
+fixed
+EncodeQuotedPrintable
+
+
+1.8.7
+2003-07-21
+fixed
+Decode4to3
+
+
+1.8.7
+2003-07-21
+modified
+Decode4to3ex is much faster
+
+
+1.8.7
+2003-07-21
+fixed
+MD5
+
+
+Release 31
+2003-03-24
+
+
+
+
+1.7.1
+2003-03-24
+removed
+weakpackageunit
+
+
+1.7.1
+2003-03-24
+added
+DecodeYenc
+
+
+Release 30
+2003-01-01
+
+
+
+
+1.6.1
+2003-01-01
+added
+EncodeUU
+
+
+1.6.1
+2003-01-01
+fixed
+line length decoding in DecodeUU (and decodeXX)
+
+
+Release 29
+2002-08-20
+
+
+
+
+Release 28
+2002-05-08
+
+
+
+
+1.5.5
+2002-05-05
+fixed
+DecodeTriplet
+
+
+1.5.5
+2002-05-05
+fixed
+decoding of UUcode for compatibility with wrong Outlook coding
+
+
+Release 27
+2002-02-10
+
+
+
+
+Release 26
+2001-12-10
+
+
+
+
+1.5.2
+2001-12-10
+modified
+massive increased speed
+
+
+Release 25
+2001-09-24
+
+
+
+
+Release 24
+2001-08-27
+
+
+
+
+Release 23
+2001-07-28
+
+
+
+
+1.4.1
+2001-07-23
+modified
+optimalizations
+
+
+1.4.1
+2001-07-23
+fixed
+Decodetriplet now better handle end of lines.
+
+
+Release 22
+2001-06-17
+
+
+
+
+1.4.0
+2001-06-17
+added
+encode and decode URL codings
+
+
+Release 21
+2001-05-13
+
+
+
+
+Release 20
+2001-04-22
+
+
+
+
+Release 19
+2001-04-07
+
+
+
+
+Release 18
+2001-03-11
+
+
+
+
+Release 17
+2001-02-10
+
+
+
+
+Release 16
+2001-01-22
+
+
+
+
+1.3.0
+2001-01-22
+added
+CRAM-MD5
+
+
+Release 15
+2000-12-10
+
+
+
+
+1.2.0
+2000-12-10
+added
+decode UUcode
+
+
+1.2.0
+2000-12-10
+added
+decode XXcode
+
+
+Release 14
+2000-11-27
+
+
+
+
+Release 13
+2000-10-24
+
+
+
+
+1.1.1
+2000-10-24
+fixed
+decoding Quoted-pritable
+
+
+1.1.0
+2000-10-24
+added
+CRC16 support
+
+
+1.1.0
+2000-10-24
+added
+CRC32 support
+
+
+1.1.0
+2000-10-24
+added
+MD5 support
+
+
+Release 12
+2000-10-15
+
+
+
+
+1.0.0
+2000-10-15
+added
+unit started
+
+
+Jump to top
+
+
+
+
+synacrypt
+
+
+
+
+Release 38
+2007-12-21
+
+
+
+
+1.0.0
+2007-01-08
+added
+Initial implementation of DES and 3DES.
+
+
+Jump to top
+
+
+
+
+synafpc
+
+
+
+
+Release 38
+2007-12-21
+
+
+
+
+7.1.1
+2007-05-17
+fixed
+Case in uses clausule for Kylix compatibility.
+
+
+Release 37
+2006-09-12
+
+
+
+
+1.1.0
+2006-03-17
+added
+provide two sided compatibility between FreePascal nad Borland.
+
+
+Jump to top
+
+
+
+
+synaip
+
+
+
+
+Release 38
+2007-12-21
+
+
+
+
+1.0.2
+2007-03-30
+fixed
+IpToStr
+
+
+1.0.1
+2006-11-10
+fixed
+ReverseIP6 (previous version has been incomplete...)
+
+
+Release 37
+2006-09-12
+
+
+
+
+1.0.0
+2006-06-29
+added
+Unit started with IP related routines from synautil and dnssend.
+
+
+Jump to top
+
+
+
+
+synamisc
+
+
+
+
+Release 38
+2007-12-21
+
+
+
+
+Release 37
+2006-09-12
+
+
+
+
+1.1.4
+2006-08-09
+modified
+removed dependency on winver.pp
+
+
+Release 36
+2005-10-23
+
+
+
+
+Release 35
+2005-01-23
+
+
+
+
+Release 34
+2004-09-18
+
+
+
+
+Release 33
+2004-08-23
+
+
+
+
+Release 32
+2003-07-21
+
+
+
+
+1.1.2
+2003-07-21
+added
+FPC compatibility
+
+
+Release 31
+2003-03-24
+
+
+
+
+1.0.6
+2003-03-24
+added
+support for C++Builder
+
+
+Release 30
+2003-01-01
+
+
+
+
+1.0.3
+2003-01-01
+added
+unit started
+
+
+Jump to top
+
+
+
+
+synautil
+
+
+
+
+Release 38
+2007-12-21
+
+
+
+
+4.11.3
+2007-01-31
+fixed
+PadString with short strings.
+
+
+4.11.2
+2007-01-27
+modified
+IsBinaryString ignoring null terminator on end of string.
+
+
+4.11.1
+2007-01-14
+modified
+DecodeRfcDateTime have better date validity checks.
+
+
+4.11.0
+2007-01-06
+added
+PadString function
+
+
+Release 37
+2006-09-12
+
+
+
+
+4.10.1
+2006-08-03
+modified
+HeadersToList failsafe check, because Theo calling it twice. ;-)
+
+
+4.10.0
+2006-06-29
+removed
+IP address related functions moved to new unit Synaip. (IsIp, IsIP6, IPtoID, StrToIP6, IP6toStr, StrToIP, IPtoStr)
+
+
+4.9.2
+2006-06-11
+fixed
+TrimSPleft and TrimSPright can work with empty string
+
+
+4.9.2
+2006-06-11
+fixed
+IsIP6 not mark 'just one number' as IPv6 address
+
+
+4.9.2
+2006-06-11
+fixed
+IsIP6 mark '::' as valid IPv6 address
+
+
+4.9.1
+2006-05-14
+modified
+removed LIBC dependency for FreePascal
+
+
+4.9.0
+2006-03-31
+added
+StrToIP6 and IP6ToStr (independent on OS)
+
+
+4.9.0
+2006-03-31
+added
+StrToIP and IPToStr
+
+
+4.8.4
+2006-03-04
+modified
+IncPoint is compatible with 64-bit pointers too.
+
+
+4.8.3
+2006-02-02
+modified
+PosCRLF rewriten for better performance
+
+
+4.8.2
+2005-12-20
+modified
+GetTick trying to use high-performance system counters on Windows platform
+
+
+Release 36
+2005-10-23
+
+
+
+
+4.8.1
+2005-10-23
+added
+GetTempFile
+
+
+4.8.1
+2005-10-23
+added
+QuoteStr
+
+
+4.8.1
+2005-10-23
+fixed
+UnquoteStr never using system functions (it is buggy and can crash your program). It using my new routine instead
+
+
+4.6.9
+2005-09-23
+fixed
+UnquoteStr can unquote empty quoted string
+
+
+4.6.9
+2005-09-23
+added
+Added compatibility with FPC-1.9.7
+
+
+4.6.9
+2005-09-23
+modified
+improvments of decodeRFCdateTime
+
+
+4.6.9
+2005-09-23
+fixed
+functions generating formated strings from time using right time separators.
+
+
+Release 35
+2005-01-23
+
+
+
+
+Release 34
+2004-09-18
+
+
+
+
+Release 33
+2004-08-23
+
+
+
+
+4.6.4
+2004-08-23
+added
+WriteStrToStream
+
+
+4.6.4
+2004-08-23
+added
+ReadStrFromStream
+
+
+4.6.4
+2004-08-23
+added
+SwapBytes
+
+
+4.6.4
+2004-08-23
+added
+ListToHeaders
+
+
+4.6.4
+2004-08-23
+added
+HeadersToList
+
+
+4.6.4
+2004-08-23
+fixed
+UnquoteStr with workaround for bug in AnsiExtractQuotedStr
+
+
+4.6.4
+2004-08-23
+added
+FetchBin
+
+
+4.6.4
+2004-08-23
+fixed
+Better GetParameter function
+
+
+4.6.4
+2004-08-23
+fixed
+TrimSP, TrimSPleft and TrimSPRight for trimming spaces only
+
+
+4.6.4
+2004-08-23
+added
+CodeLongint and DecodeLongint
+
+
+4.6.4
+2004-08-23
+modified
+GetTimeFromstr return -1 when string is invalid!
+
+
+4.6.4
+2004-08-23
+modified
+GetMonthNummer supporting English, German, French, Czech and custom month names
+
+
+Release 32
+2003-07-21
+
+
+
+
+4.0.2
+2003-07-21
+added
+UnquoteStr function
+
+
+4.0.2
+2003-07-21
+added
+CountOfChar function
+
+
+4.0.2
+2003-07-21
+added
+GetBetween function
+
+
+4.0.2
+2003-07-21
+added
+FetchEx function
+
+
+4.0.2
+2003-07-21
+added
+ParseParameterEx function
+
+
+4.0.2
+2003-07-21
+added
+DumpStrEx function
+
+
+4.0.2
+2003-07-21
+added
+DumpStr function
+
+
+4.0.2
+2003-07-21
+added
+FPC compatibility
+
+
+Release 31
+2003-03-24
+
+
+
+
+3.5.1
+2003-03-24
+added
+IsIP6
+
+
+3.5.1
+2003-03-24
+removed
+ReverseIP (moved directly to DNSSend)
+
+
+3.5.1
+2003-03-24
+added
+TickDelta for compute time differencies
+
+
+3.5.1
+2003-03-24
+modified
+GetTick return ULong
+
+
+Release 30
+2003-01-01
+
+
+
+
+3.3.0
+2003-01-01
+modified
+Stringreplace is renamed do replaceStrig (because name conflict with same named function in newer delphi)
+
+
+3.3.0
+2003-01-01
+added
+IncPoint
+
+
+3.3.0
+2003-01-01
+modified
+DecodeRfcDateTime using default year 1980
+
+
+3.3.0
+2003-01-01
+fixed
+ParseURL
+
+
+Release 29
+2002-08-20
+
+
+
+
+3.2.1
+2002-08-20
+added
+ParseParameters
+
+
+3.2.1
+2002-08-20
+added
+IndexByBegin
+
+
+3.2.1
+2002-08-20
+added
+IsBinaryString
+
+
+3.2.1
+2002-08-20
+added
+PosCRLF
+
+
+3.2.1
+2002-08-20
+added
+StringsTrim
+
+
+3.2.1
+2002-08-20
+added
+PosFrom
+
+
+3.2.1
+2002-08-20
+fixed
+date and time functions now thread safe
+
+
+3.2.1
+2002-08-20
+fixed
+DecodeRFCDateTime now more resistent for broken input
+
+
+3.2.1
+2002-08-20
+modified
+IsIP
+
+
+Release 28
+2002-05-08
+
+
+
+
+2.11.1
+2002-05-05
+added
+AnsiCDateTime
+
+
+2.11.1
+2002-05-05
+added
+GetMonthNumber
+
+
+2.11.1
+2002-05-05
+added
+GetTimeFromStr
+
+
+2.11.1
+2002-05-05
+added
+GetDateMDYFromStr
+
+
+2.11.1
+2002-05-05
+added
+RposEx
+
+
+Release 27
+2002-02-10
+
+
+
+
+2.8.0
+2002-02-10
+fixed
+Better implementation of IsIP
+
+
+2.8.0
+2002-02-10
+modified
+ParseURL respect new https protocol
+
+
+Release 26
+2001-12-10
+
+
+
+
+2.7.1
+2001-12-10
+added
+TimeZoneBias
+
+
+2.7.1
+2001-12-10
+added
+DecodeRFCDateTime for decoding various textual date and time formats
+
+
+2.7.1
+2001-12-10
+added
+GetUTCTime and SetUTCTime
+
+
+2.7.1
+2001-12-10
+fixed
+Fetch
+
+
+Release 25
+2001-09-24
+
+
+
+
+2.3.0
+2001-09-24
+added
+CDateTime
+
+
+2.3.0
+2001-09-24
+added
+IPtoID
+
+
+Release 24
+2001-08-27
+
+
+
+
+2.1.0
+2001-08-27
+added
+Fetch function for fetching string from left
+
+
+2.1.0
+2001-08-27
+added
+RPos function (like Pos, but from right side of string)
+
+
+Release 23
+2001-07-28
+
+
+
+
+2.0.1
+2001-07-23
+modified
+optimalizations
+
+
+Release 22
+2001-06-17
+
+
+
+
+Release 21
+2001-05-13
+
+
+
+
+2.0.0
+2001-05-13
+added
+Compatibility with Kylix
+
+
+Release 20
+2001-04-22
+
+
+
+
+Release 19
+2001-04-07
+
+
+
+
+1.8.0
+2001-03-12
+added
+function StringReplace
+
+
+Release 18
+2001-03-11
+
+
+
+
+Release 17
+2001-02-10
+
+
+
+
+Release 16
+2001-01-22
+
+
+
+
+1.7.0
+2001-01-22
+added
+function ParseURL
+
+
+Release 15
+2000-12-10
+
+
+
+
+1.6.0
+2000-12-10
+added
+function IntToBin
+
+
+1.6.0
+2000-12-10
+added
+function BinToInt
+
+
+Release 14
+2000-11-27
+
+
+
+
+1.5.0
+2000-11-27
+modified
+Separateright work with any separator lenght
+
+
+1.5.0
+2000-11-27
+removed
+all ASN functions moved to ASN1util unit
+
+
+Release 13
+2000-10-24
+
+
+
+
+1.4.0
+2000-10-24
+added
+Function StrToHex
+
+
+Release 12
+2000-10-15
+
+
+
+
+1.3.0
+2000-10-09
+added
+function GetEmailDesc
+
+
+1.3.0
+2000-10-09
+added
+function GetEmailAddr
+
+
+1.3.0
+2000-10-09
+added
+function getparameter
+
+
+1.3.0
+2000-10-09
+added
+function SeparateRight
+
+
+1.3.0
+2000-10-09
+added
+function SeparateLeft
+
+
+Release 11
+2000-09-18
+
+
+
+
+1.2.1
+2000-09-18
+fixed
+TimeZone not work correctly with daylight saving
+
+
+1.2.1
+2000-09-18
+fixed
+MIBtoID now works with element grater then 255
+
+
+1.2.1
+2000-09-18
+fixed
+IDtoMIB now works with element grater then 255
+
+
+Release 10
+2000-08-20
+
+
+
+
+Release 09
+2000-06-14
+
+
+
+
+Release 08
+2000-03-15
+
+
+
+
+Release 07
+2000-02-13
+
+
+
+
+1.2.0
+2000-02-01
+added
+Function IPToId
+
+
+Release 06
+2000-01-31
+
+
+
+
+Release 05
+2000-01-23
+
+
+
+
+1.1.0
+2000-01-10
+added
+Function IsIP
+
+
+1.1.0
+2000-01-10
+added
+Function ReverseIP
+
+
+1.1.0
+2000-01-10
+added
+Function MibToId
+
+
+1.1.0
+2000-01-10
+added
+Function IdToMib
+
+
+1.1.0
+2000-01-10
+added
+Function IntMibToStr
+
+
+Release 04
+2000-01-08
+
+
+
+
+Release 03
+1999-11-14
+
+
+
+
+1.0.0
+1999-10-30
+added
+many misc. utils. See documentation.
+
+
+Jump to top
+
+
+
+
+tlntsend
+
+
+
+
+Release 38
+2007-12-21
+
+
+
+
+1.2.1
+2007-01-11
+modified
+using port numbers instead symbolic names
+
+
+Release 37
+2006-09-12
+
+
+
+
+Release 36
+2005-10-23
+
+
+
+
+1.2.0
+2005-10-23
+added
+SSHlogin for connect to SSH server (CryptLib plugin required!)
+
+
+Release 35
+2005-01-23
+
+
+
+
+Release 34
+2004-09-18
+
+
+
+
+Release 33
+2004-08-23
+
+
+
+
+Release 32
+2003-07-21
+
+
+
+
+1.1.3
+2003-07-21
+added
+FPC compatibility
+
+
+Release 31
+2003-03-24
+
+
+
+
+1.1.1
+2003-03-24
+removed
+weakpackageunit
+
+
+1.1.1
+2003-03-24
+modified
+default timeout is 60 seconds
+
+
+1.1.1
+2003-03-24
+added
+TermType property
+
+
+Release 30
+2003-01-01
+
+
+
+
+1.0.2
+2003-01-01
+added
+Class TTelnetSend implementing client of Telnet protocol.
+
+
+Jump to top
+
+
+Generated by Trackar 1.1 (c)2005 Lukas Gebauer
+
+
+
+
ADDED lib/synapse/docs/help/AllClasses.html
Index: lib/synapse/docs/help/AllClasses.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/AllClasses.html
@@ -0,0 +1,314 @@
+
+
+
+
+
+All Classes, Interfaces, Objects and Records
+
+
+
+All Classes, Interfaces, Objects and Records
+
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:52
+
+
ADDED lib/synapse/docs/help/AllConstants.html
Index: lib/synapse/docs/help/AllConstants.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/AllConstants.html
@@ -0,0 +1,1605 @@
+
+
+
+
+
+All Constants
+
+
+
+All Constants
+
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:53
+
+
ADDED lib/synapse/docs/help/AllFunctions.html
Index: lib/synapse/docs/help/AllFunctions.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/AllFunctions.html
@@ -0,0 +1,1459 @@
+
+
+
+
+
+All Functions and Procedures
+
+
+
+All Functions and Procedures
+
+
+
+AnsiCDateTime
+synautil
+Returns date and time in format defined in ANSI C compilers in format "ddd mmm d hh:nn:ss yyyy"
+
+
+AppendToLog
+synadbg
+
+
+
+Asn1IntegerGet
+ssl_openssl_lib
+
+
+
+Asn1IntegerSet
+ssl_openssl_lib
+
+
+
+Asn1UtctimeFree
+ssl_openssl_lib
+
+
+
+Asn1UtctimeNew
+ssl_openssl_lib
+
+
+
+ASNDecLen
+asn1util
+Decodes length of next element in "Buffer" from the "Start" position.
+
+
+ASNDecOIDItem
+asn1util
+Decodes an OID item of the next element in the "Buffer" from the "Start" position.
+
+
+ASNdump
+asn1util
+Convert ASN.1 BER encoded buffer to human readable form for debugging.
+
+
+ASNEncInt
+asn1util
+Encodes a signed integer to ASN.1 binary
+
+
+ASNEncLen
+asn1util
+Encodes the length of ASN.1 element to binary.
+
+
+ASNEncOIDItem
+asn1util
+Encodes OID item to binary form.
+
+
+ASNEncUInt
+asn1util
+Encodes unsigned integer into ASN.1 binary
+
+
+ASNItem
+asn1util
+Beginning with the "Start" position, decode the ASN.1 item of the next element in "Buffer". Type of item is stored in "ValueType."
+
+
+ASNObject
+asn1util
+Encodes ASN.1 object to binary form.
+
+
+BinToInt
+synautil
+Returns an integer equivalent of the binary string in "Value". (i.e. ('10001010') returns 138)
+
+
+BioCtrlPending
+ssl_openssl_lib
+
+
+
+BioFreeAll
+ssl_openssl_lib
+
+
+
+BioNew
+ssl_openssl_lib
+
+
+
+BioRead
+ssl_openssl_lib
+
+
+
+BioSMem
+ssl_openssl_lib
+
+
+
+BioWrite
+ssl_openssl_lib
+
+
+
+BuildStringFromBuffer
+synautil
+Copy data from a buffer starting at position APtr and delimited by AEtx position into ANSIString.
+
+
+CDateTime
+synautil
+Returns date and time in format defined in C compilers in format "mmm dd hh:nn:ss"
+
+
+CharsetConversion
+synachar
+Convert Value from one charset to another. See: CharsetConversionEx
+
+
+CharsetConversionEx
+synachar
+Convert Value from one charset to another with additional character conversion. see: Replace_None and Replace_Czech
+
+
+CharsetConversionTrans
+synachar
+Convert Value from one charset to another with additional character conversion. This funtion is similar to CharsetConversionEx , but you can disable transliteration of unconvertible characters.
+
+
+CodeInt
+synautil
+Return two characters, which ordinal values represents the value in byte format. (High-endian)
+
+
+CodeLongInt
+synautil
+Return four characters, which ordinal values represents the value in byte format. (High-endian)
+
+
+CopyLinesFromStreamUntilBoundary
+synautil
+Copy all lines from a buffer starting at APtr to ALines until ABoundary or end of the buffer is reached. Move APtr position forward).
+
+
+CopyLinesFromStreamUntilNullLine
+synautil
+Copy all lines from a buffer starting at APtr to ALines until empty line or end of the buffer is reached. Move APtr position forward).
+
+
+CountOfChar
+synautil
+Return count of Chr in Value string.
+
+
+Crc16
+synacode
+return CRC16 from a value string.
+
+
+Crc32
+synacode
+return CRC32 from a value string.
+
+
+CRYPTOcleanupAllExData
+ssl_openssl_lib
+
+
+
+d2iPKCS12bio
+ssl_openssl_lib
+
+
+
+d2iX509bio
+ssl_openssl_lib
+
+
+
+Decode4to3
+synacode
+Decode 4to3 encoding with given table. If some element is not found in table, first item from table is used. This is good for buggy coded items by Microsoft Outlook. This software sometimes using wrong table for UUcode, where is used ' ' instead '`'.
+
+
+Decode4to3Ex
+synacode
+Decode 4to3 encoding with given REVERSE table. Using this function with reverse table is much faster then Decode4to3 . This function is used internally for Base64, UU or XX decoding.
+
+
+DecodeBase64
+synacode
+Decode string from base64 format.
+
+
+DecodeBase64mod
+synacode
+Decode string from modified base64 format. (used in IMAP, for example.)
+
+
+DecodeInt
+synautil
+Decodes two characters located at "Index" offset position of the "Value" string to Word values.
+
+
+DecodeLongInt
+synautil
+Decodes four characters located at "Index" offset position of the "Value" string to LongInt values.
+
+
+DecodeQuotedPrintable
+synacode
+Decodes a string from quoted printable form. (also decodes triplet sequences like '=7F')
+
+
+DecodeRfcDateTime
+synautil
+Decode various string representations of date and time to Tdatetime type. This function do all timezone corrections too! This function can decode lot of formats like:
+
+
+ ddd, d mmm yyyy hh:mm:ss
+ ddd, d mmm yy hh:mm:ss
+ ddd, mmm d yyyy hh:mm:ss
+ ddd mmm dd hh:mm:ss yyyy
+
+
+
+
and more with lot of modifications, include:
+
+
+Sun, 06 Nov 1994 08:49 :37 GMT ; RFC 822 , updated by RFC 1123
+Sunday, 06 -Nov-94 08:49 :37 GMT ; RFC 850 , obsoleted by RFC 1036
+Sun Nov 6 08:49 :37 1994 ; ANSI C
+
+ Timezone corrections known lot of symbolic timezone names (like CEST, EDT, etc.) or numeric representation (like +0200). By convention defined in RFC timezone +0000 is GMT and -0000 is current your system timezone.
+
+
+DecodeTriplet
+synacode
+Decodes triplet encoding with a given character delimiter. It is used for decoding quoted-printable or URL encoding.
+
+
+DecodeURL
+synacode
+Decodes a string of URL encoding. (also decodes triplet sequences like '%7F')
+
+
+DecodeUU
+synacode
+Decodes a string from UUcode format.
+
+
+DecodeXX
+synacode
+Decodes a string from XXcode format.
+
+
+DecodeYEnc
+synacode
+decode line with Yenc code. This code is sometimes used in newsgroups.
+
+
+DESecbencrypt
+ssl_openssl_lib
+
+
+
+DESsetkeychecked
+ssl_openssl_lib
+
+
+
+DESsetoddparity
+ssl_openssl_lib
+
+
+
+DestroyIconvInterface
+synaicnv
+
+
+
+DestroySSLInterface
+ssl_openssl_lib
+
+
+
+Dump
+synautil
+Dump binary buffer stored in a string to a file with DumpFile filename.
+
+
+DumpEx
+synautil
+Dump binary buffer stored in a string to a file with DumpFile filename. All bytes with code of character is written as character, not as hexadecimal value.
+
+
+DumpExStr
+synautil
+Dump binary buffer stored in a string to a result string. All bytes with code of character is written as character, not as hexadecimal value.
+
+
+DumpStr
+synautil
+Dump binary buffer stored in a string to a result string.
+
+
+Encode3to4
+synacode
+Encode by system 3to4 (used by Base64, UU coding, etc) by given table.
+
+
+EncodeBase64
+synacode
+Encodes a string to base64 format.
+
+
+EncodeBase64mod
+synacode
+Encodes a string to modified base64 format. (used in IMAP, for example.)
+
+
+EncodeQuotedPrintable
+synacode
+Encodes a string to triplet quoted printable form. All NonAsciiChar are encoded.
+
+
+EncodeSafeQuotedPrintable
+synacode
+Encodes a string to triplet quoted printable form. All NonAsciiChar and SpecialChar are encoded.
+
+
+EncodeTriplet
+synacode
+Performs triplet encoding with a given character delimiter. Used for encoding quoted-printable or URL encoding.
+
+
+EncodeURL
+synacode
+Encodes a string to URL format. Used to encode critical characters in all URLs.
+
+
+EncodeURLElement
+synacode
+Encodes a string to URL format. Used for encoding data from a form field in HTTP, etc. (Encodes all critical characters including characters used as URL delimiters ('/',':', etc.)
+
+
+EncodeUU
+synacode
+encode UUcode. it encode only datas, you must also add header and footer for proper encode.
+
+
+ErrClearError
+ssl_openssl_lib
+
+
+
+ErrErrorString
+ssl_openssl_lib
+
+
+
+ErrFreeStrings
+ssl_openssl_lib
+
+
+
+ErrGetError
+ssl_openssl_lib
+
+
+
+ErrRemoveState
+ssl_openssl_lib
+
+
+
+EVPcleanup
+ssl_openssl_lib
+
+
+
+EvpGetDigestByName
+ssl_openssl_lib
+
+
+
+EvpPkeyAssign
+ssl_openssl_lib
+
+
+
+EvpPkeyFree
+ssl_openssl_lib
+
+
+
+EvpPkeyNew
+ssl_openssl_lib
+
+
+
+ExpandIP6
+synaip
+Expand short form of IPv6 address to long form.
+
+
+Fetch
+synautil
+Fetch string from left of Value string.
+
+
+FetchBin
+synautil
+Like Fetch , but working with binary strings, not with text.
+
+
+FetchEx
+synautil
+Fetch string from left of Value string. This function ignore delimitesr inside quotations.
+
+
+FtpGetFile
+ftpsend
+A very useful function, and example of use can be found in the TFtpSend object. Dowload specified file from FTP server to LocalFile.
+
+
+FtpInterServerTransfer
+ftpsend
+A very useful function, and example of use can be found in the TFtpSend object. Initiate transfer of file between two FTP servers.
+
+
+FtpPutFile
+ftpsend
+A very useful function, and example of use can be found in the TFtpSend object. Upload specified LocalFile to FTP server.
+
+
+GenerateBoundary
+mimepart
+Generates a unique boundary string.
+
+
+GetBetween
+synautil
+Get string between PairBegin and PairEnd. This function respect nesting. For example:
+
+
+ Value is : 'Hi! (hello(yes!))'
+ pairbegin is : '('
+ pairend is : ')'
+ In this case result is : 'hello(yes!)'
+
+
+
+
+GetBOM
+synachar
+Return BOM (Byte Order Mark) for given unicode charset.
+
+
+GetCPFromID
+synachar
+Converting string with charset name to TMimeChar.
+
+
+GetCurCP
+synachar
+Returns charset used by operating system.
+
+
+GetCurOEMCP
+synachar
+Returns charset used by operating system as OEM charset. (in Windows DOS box, for example)
+
+
+GetDateMDYFromStr
+synautil
+Decode string in format "m-d-y" to TDateTime type.
+
+
+GetDNS
+synamisc
+Autodetect current DNS servers used by system. If is defined more then one DNS server, then result is comma-delimited.
+
+
+GetEmailAddr
+synautil
+Returns only the e-mail portion of an address from the full address format. i.e. returns 'nobody@somewhere.com' from '"someone" <nobody@somewhere.com>'
+
+
+GetEmailDesc
+synautil
+Returns only the description part from a full address format. i.e. returns 'someone' from '"someone" <nobody@somewhere.com>'
+
+
+GetIDFromCP
+synachar
+Converting TMimeChar to string with name of charset.
+
+
+GetIEProxy
+synamisc
+Autodetect InternetExplorer proxy setting for given protocol. This function working only on windows!
+
+
+GetLocalIPs
+synamisc
+Return all known IP addresses on local system. Addresses are divided by comma.
+
+
+GetMailServers
+dnssend
+A very useful function, and example of it's use is found in the TDNSSend object. This function is used to get mail servers for a domain and sort them by preference numbers. "Servers" contains only the domain names of the mail servers in the right order (without preference number!). The first domain name will always be the highest preferenced mail server. Returns boolean True
if all went well.
+
+
+GetMonthNumber
+synautil
+Decode three-letter string with name of month to their month number. If string not match any month name, then is returned 0. For parsing are used predefined names for English, French and German and names from system locale too.
+
+
+GetParameter
+synautil
+Returns parameter value from string in format: parameter1="value1"; parameter2=value2
+
+
+GetSerialPortNames
+synaser
+Returns list of existing computer serial ports. Working properly only in Windows!
+
+
+GetTempFile
+synautil
+Return filename of new temporary file in Dir (if empty, then default temporary directory is used) and with optional filename prefix.
+
+
+GetTick
+synautil
+Return current value of system timer with precizion 1 millisecond. Good for measure time difference.
+
+
+GetTimeFromStr
+synautil
+Return decoded time from given string. Time must be witch separator ':'. You can use "hh:mm" or "hh:mm:ss".
+
+
+GetUTTime
+synautil
+Return current system date and time in UTC timezone.
+
+
+HeadersToList
+synautil
+Convert lines in stringlist from 'name: value' form to 'name=value' form.
+
+
+HMAC_MD5
+synacode
+Returns a binary string with HMAC-MD5 hash.
+
+
+HMAC_SHA1
+synacode
+Returns a binary string with HMAC-SHA1 hash.
+
+
+HttpGetBinary
+httpsend
+A very usefull function, and example of use can be found in the THTTPSend object. It implements the GET method of the HTTP protocol. This function sends the GET method for URL document to an HTTP server. Returned document is in the "Response" stream. Returns boolean TRUE if all went well.
+
+
+HttpGetText
+httpsend
+A very usefull function, and example of use can be found in the THTTPSend object. It implements the GET method of the HTTP protocol. This function sends the GET method for URL document to an HTTP server. Returned document is in the "Response" stringlist (without any headers). Returns boolean TRUE if all went well.
+
+
+HttpPostBinary
+httpsend
+A very useful function, and example of use can be found in the THTTPSend object. It implements the POST method of the HTTP protocol. This function sends the SEND method for a URL document to an HTTP server. The document to be sent is located in "Data" stream. The returned document is in the "Data" stream. Returns boolean TRUE if all went well.
+
+
+HttpPostFile
+httpsend
+A very useful function, and example of use can be found in the THTTPSend object. It implements the POST method of the HTTP protocol. This function sends the POST method for a URL document to an HTTP server. This function simulate posting of file by HTML form used method 'multipart/form-data'. Posting file is in DATA stream. Its name is Filename string. Fieldname is for name of formular field with file. (simulate HTML INPUT FILE) The returned document is in the ResultData Stringlist. Returns boolean TRUE if all went well.
+
+
+HttpPostURL
+httpsend
+A very useful function, and example of use can be found in the THTTPSend object. It implements the POST method of the HTTP protocol. This function is good for POSTing form data. It sends the POST method for a URL document to an HTTP server. You must prepare the form data in the same manner as you would the URL data, and pass this prepared data to "URLdata". The following is a sample of how the data would appear: 'name=Lukas&field1=some%20data'. The information in the field must be encoded by EncodeURLElement function. The returned document is in the "Data" stream. Returns boolean TRUE if all went well.
+
+
+i2dPrivateKeyBio
+ssl_openssl_lib
+
+
+
+i2dX509bio
+ssl_openssl_lib
+
+
+
+IdealCharsetCoding
+synachar
+Finding best target charset from set of TMimeChars with minimal count of unconvertible characters.
+
+
+IdToMib
+asn1util
+Decodes MIB OID from binary form to string form.
+
+
+IncPoint
+synautil
+Increase pointer by value.
+
+
+IndexByBegin
+synautil
+Index of string in stringlist with same beginning as Value is returned.
+
+
+InitIconvInterface
+synaicnv
+
+
+
+InitSSLInterface
+ssl_openssl_lib
+
+
+
+InlineCode
+mimeinln
+Inline MIME encoding similar to InlineEncode , but the source charset is automatically set to the system default charset, and the target charset is automatically assigned from set of allowed encoding for MIME.
+
+
+InlineCodeEx
+mimeinln
+Inline mime encoding similar to InlineEncode , but you can specify source charset, and the target characterset is automatically assigned.
+
+
+InlineDecode
+mimeinln
+Decodes mime inline encoding (i.e. in headers) uses target characterset "CP".
+
+
+InlineEmail
+mimeinln
+Converts e-mail address to canonical mime form. Source charser it system default charset.
+
+
+InlineEmailEx
+mimeinln
+Converts e-mail address to canonical mime form. You can specify source charset.
+
+
+InlineEncode
+mimeinln
+Encodes string to MIME inline encoding. The source characterset is "CP", and the target charset is "MimeP".
+
+
+IntMibToStr
+asn1util
+Encodes an one number from MIB OID to binary form. (used internally from MibToId )
+
+
+IntToBin
+synautil
+Returns a string of binary "Digits" representing "Value".
+
+
+Ip6ToStr
+synaip
+Convert IPv6 address from binary byte array to string form.
+
+
+IPToID
+synaip
+Returns a string with the "Host" ip address converted to binary form.
+
+
+IpToStr
+synaip
+Convert IPv4 address from binary to string form.
+
+
+IsBinaryString
+synautil
+If string is binary string (contains non-printable characters), then is returned true.
+
+
+IsIconvloaded
+synaicnv
+
+
+
+IsIP
+synaip
+Returns True
, if "Value" is a valid IPv4 address. Cannot be a symbolic Name!
+
+
+IsIP6
+synaip
+Returns True
, if "Value" is a valid IPv6 address. Cannot be a symbolic Name!
+
+
+IsSSLloaded
+ssl_openssl_lib
+
+
+
+LDAPResultDump
+ldapsend
+Dump result of LDAP SEARCH into human readable form. Good for debugging.
+
+
+ListToHeaders
+synautil
+Convert lines in stringlist from 'name=value' form to 'name: value' form.
+
+
+MatchBoundary
+synautil
+Compare a text at position ABOL with ABoundary and return position behind the match (including a trailing CRLF if any).
+
+
+MatchLastBoundary
+synautil
+Compare a text at position ABOL with ABoundary + the last boundary suffix and return position behind the match (including a trailing CRLF if any).
+
+
+MD4
+synacode
+Returns a binary string with a RSA-MD4 hashing of "Value" string.
+
+
+MD5
+synacode
+Returns a binary string with a RSA-MD5 hashing of "Value" string.
+
+
+MD5LongHash
+synacode
+Returns a binary string with a RSA-MD5 hashing of string what is constructed by repeating "value" until length is "Len".
+
+
+MibToId
+asn1util
+Encodes an MIB OID string to binary form.
+
+
+NeedCharsetConversion
+synachar
+return True
when value need to be converted. (It is not 7-bit ASCII)
+
+
+NeedInline
+mimeinln
+Returns True
, if "Value" contains characters needed for inline coding.
+
+
+NormalizeHeader
+synautil
+Read header from "Value" stringlist beginning at "Index" position. If header is Splitted into multiple lines, then this procedure de-split it into one line.
+
+
+OPENSSLaddallalgorithms
+ssl_openssl_lib
+
+
+
+PadString
+synautil
+Return padded string. If length is greater, string is truncated. If length is smaller, string is padded by Pad character.
+
+
+ParseParameters
+synautil
+parse value string with elements differed by ';' into stringlist.
+
+
+ParseParametersEx
+synautil
+parse value string with elements differed by Delimiter into stringlist.
+
+
+ParseURL
+synautil
+Parses a URL to its various components.
+
+
+PEMReadBioX509
+ssl_openssl_lib
+
+
+
+PingHost
+pingsend
+A very useful function and example of its use would be found in the TPINGSend object. Use it to ping to any host. If successful, returns the ping time in milliseconds. Returns -1 if an error occurred.
+
+
+PKCS12free
+ssl_openssl_lib
+
+
+
+PKCS12parse
+ssl_openssl_lib
+
+
+
+PosCRLF
+synautil
+return position of string terminator in string. If terminator found, then is returned in terminator parameter. Possible line terminators are: CRLF, LFCR, CR, LF
+
+
+PosFrom
+synautil
+Like Pos function, buf from given string possition.
+
+
+QuoteStr
+synautil
+Quote Value string. If Value contains some Quote chars, then it is doubled.
+
+
+RandScreen
+ssl_openssl_lib
+
+
+
+ReadStrFromStream
+synautil
+read string with requested length form stream.
+
+
+RecvTrap
+snmpsend
+A very useful function and example of its use would be found in the TSNMPSend object. It receives a TRAPv1 and returns all the data that comes with it.
+
+
+ReplaceString
+synautil
+Replaces all "Search" string values found within "Value" string, with the "Replace" string value.
+
+
+ReverseIP
+synaip
+Convert IPv4 address to reverse form.
+
+
+ReverseIP6
+synaip
+Convert IPv6 address to reverse form.
+
+
+Rfc822DateTime
+synautil
+Returns current time in format defined in RFC-822. Useful for SMTP messages, but other protocols use this time format as well. Results contains the timezone specification. Four digit year is used to break any Y2K concerns. (Example 'Fri, 15 Oct 1999 21:14:56 +0200')
+
+
+RPos
+synautil
+It is like POS function, but from right side of Value string.
+
+
+RPosEx
+synautil
+It is like RPos, but search is from specified possition.
+
+
+RsaGenerateKey
+ssl_openssl_lib
+
+
+
+SearchForBoundary
+synautil
+Search ABoundary in a buffer starting at APtr. Return beginning of the ABoundary. Move APtr forward behind a trailing CRLF if any).
+
+
+SearchForLineBreak
+synautil
+Search for one of line terminators CR, LF or NUL. Return position of the line beginning and length of text.
+
+
+SendTo
+smtpsend
+A very useful function and example of its use would be found in the TSMTPsend object. Send "Maildata" (text of e-mail without any SMTP headers!) from "MailFrom" e-mail address to "MailTo" e-mail address with "Subject". (If you need more then one receiver, then separate their addresses by comma).
+
+This function constructs all needed SMTP headers (with DATE header) and sends the e-mail to the SMTP server defined in the "SMTPhost" parameter. If the e-mail message is successfully sent, the result will be True
.
+
+
If you need use different port number then standard, then add this port number to SMTPhost after colon. (i.e. '127.0.0.1:1025')
+
+
+SendToEx
+smtpsend
+A very useful function and example of its use would be found in the TSMTPsend object. Sends "MailData" (text of e-mail without any SMTP headers!) from "MailFrom" e-mail address to "MailTo" e-mail address (If you need more then one receiver, then separate their addresses by comma).
+
+This function sends the e-mail to the SMTP server defined in the "SMTPhost" parameter. Username and password are used for authorization to the "SMTPhost". If you dont want authorization, set "Username" and "Password" to empty Strings. If the e-mail message is successfully sent, the result will be True
.
+
+
If you need use different port number then standard, then add this port number to SMTPhost after colon. (i.e. '127.0.0.1:1025')
+
+
+SendToRaw
+smtpsend
+A very useful function and example of its use would be found in the TSMTPsend object. Send maildata (text of e-mail with all SMTP headers! For example when text of message is created by TMimeMess object) from "MailFrom" e-mail address to "MailTo" e-mail address (If you need more then one receiver, then separate their addresses by comma).
+
+Function sends e-mail to a SMTP server defined in "SMTPhost" parameter. Username and password are used for authorization to the "SMTPhost". If you don't want authorization, set "Username" and "Password" to empty strings. If e-mail message is successfully sent, the result returns True
.
+
+
If you need use different port number then standard, then add this port number to SMTPhost after colon. (i.e. '127.0.0.1:1025')
+
+
+SendTrap
+snmpsend
+A very useful function and example of its use would be found in the TSNMPSend object. It implements a TRAPv1 to send with all data in the parameters.
+
+
+SeparateLeft
+synautil
+Returns a portion of the "Value" string located to the left of the "Delimiter" string. If a delimiter is not found, results is original string.
+
+
+SeparateRight
+synautil
+Returns the portion of the "Value" string located to the right of the "Delimiter" string. If a delimiter is not found, results is original string.
+
+
+SetUTTime
+synautil
+Set Newdt as current system date and time in UTC timezone. This function work only if you have administrator rights!
+
+
+SHA1
+synacode
+Returns a binary string with a SHA-1 hashing of "Value" string.
+
+
+SHA1LongHash
+synacode
+Returns a binary string with a SHA-1 hashing of string what is constructed by repeating "value" until length is "Len".
+
+
+SimpleDateTime
+synautil
+Returns date and time in format defined in format 'yymmdd hhnnss'
+
+
+SkipLineBreak
+synautil
+Skip both line terminators CR LF (if any). Move APtr position forward.
+
+
+SkipNullLines
+synautil
+Skip all blank lines in a buffer starting at APtr and move APtr position forward.
+
+
+SkX509PopFree
+ssl_openssl_lib
+
+
+
+Sleep
+synafpc
+
+
+
+SNMPGet
+snmpsend
+A very useful function and example of its use would be found in the TSNMPSend object. It implements basic GET method of the SNMP protocol. The MIB value is located in the "OID" variable, and is sent to the requested "SNMPHost" with the proper "Community" access identifier. Upon a successful retrieval, "Value" will contain the information requested. If the SNMP operation is successful, the result returns True
.
+
+
+SNMPGetNext
+snmpsend
+A very useful function and example of its use would be found in the TSNMPSend object. It implements basic GETNEXT method of the SNMP protocol. The MIB value is located in the "OID" variable, and is sent to the requested "SNMPHost" with the proper "Community" access identifier. Upon a successful retrieval, "Value" will contain the information requested. If the SNMP operation is successful, the result returns True
.
+
+
+SNMPGetTable
+snmpsend
+A very useful function and example of its use would be found in the TSNMPSend object. It implements basic read of SNMP MIB tables. As BaseOID you must specify basic MIB OID of requested table (base IOD is OID without row and column specificator!) Table is readed into stringlist, where each string is comma delimited string.
+
+Warning: this function is not have best performance. For better performance you must write your own function. best performace you can get by knowledge of structuture of table and by more then one MIB on one query.
+
+
+SNMPGetTableElement
+snmpsend
+A very useful function and example of its use would be found in the TSNMPSend object. It implements basic read of SNMP MIB table element. As BaseOID you must specify basic MIB OID of requested table (base IOD is OID without row and column specificator!) As next you must specify identificator of row and column for specify of needed field of table.
+
+
+SNMPSet
+snmpsend
+This is useful function and example of use TSNMPSend object. It implements the basic SET method of the SNMP protocol. If the SNMP operation is successful, the result is True
. "Value" is value of MIB Oid for "SNMPHost" with "Community" access identifier. You must specify "ValueType" too.
+
+
+SslAccept
+ssl_openssl_lib
+
+
+
+SSLCipherGetBits
+ssl_openssl_lib
+
+
+
+SSLCipherGetName
+ssl_openssl_lib
+
+
+
+SslConnect
+ssl_openssl_lib
+
+
+
+SSLCtrl
+ssl_openssl_lib
+
+
+
+SslCtxCheckPrivateKeyFile
+ssl_openssl_lib
+
+
+
+SslCtxCtrl
+ssl_openssl_lib
+
+
+
+SslCtxFree
+ssl_openssl_lib
+
+
+
+SslCtxLoadVerifyLocations
+ssl_openssl_lib
+
+
+
+SslCtxNew
+ssl_openssl_lib
+
+
+
+SslCtxSetCipherList
+ssl_openssl_lib
+
+
+
+SslCtxSetDefaultPasswdCb
+ssl_openssl_lib
+
+
+
+SslCtxSetDefaultPasswdCbUserdata
+ssl_openssl_lib
+
+
+
+SslCtxSetVerify
+ssl_openssl_lib
+
+
+
+SslCtxUseCertificate
+ssl_openssl_lib
+
+
+
+SslCtxUseCertificateASN1
+ssl_openssl_lib
+
+
+
+SslCtxUseCertificateChainFile
+ssl_openssl_lib
+
+
+
+SslCtxUseCertificateFile
+ssl_openssl_lib
+
+
+
+SslCtxUsePrivateKey
+ssl_openssl_lib
+
+
+
+SslCtxUsePrivateKeyASN1
+ssl_openssl_lib
+
+
+
+SslCtxUsePrivateKeyFile
+ssl_openssl_lib
+
+
+
+SSLeayversion
+ssl_openssl_lib
+
+
+
+SslFree
+ssl_openssl_lib
+
+
+
+SSLGetCurrentCipher
+ssl_openssl_lib
+
+
+
+SslGetError
+ssl_openssl_lib
+
+
+
+SslGetPeerCertificate
+ssl_openssl_lib
+
+
+
+SSLGetVerifyResult
+ssl_openssl_lib
+
+
+
+SslGetVersion
+ssl_openssl_lib
+
+
+
+SslLibraryInit
+ssl_openssl_lib
+
+
+
+SslLoadErrorStrings
+ssl_openssl_lib
+
+
+
+SslMethodTLSV1
+ssl_openssl_lib
+
+
+
+SslMethodV2
+ssl_openssl_lib
+
+
+
+SslMethodV23
+ssl_openssl_lib
+
+
+
+SslMethodV3
+ssl_openssl_lib
+
+
+
+SslNew
+ssl_openssl_lib
+
+
+
+SslPeek
+ssl_openssl_lib
+
+
+
+SslPending
+ssl_openssl_lib
+
+
+
+SslRead
+ssl_openssl_lib
+
+
+
+SslSetFd
+ssl_openssl_lib
+
+
+
+SslShutdown
+ssl_openssl_lib
+
+
+
+SslWrite
+ssl_openssl_lib
+
+
+
+StringsTrim
+synautil
+Delete empty strings from end of stringlist.
+
+
+StringToWide
+synachar
+Convert binary string with unicode content to WideString.
+
+
+StrToHex
+synautil
+Returns a string with hexadecimal digits representing the corresponding values of the bytes found in "Value" string.
+
+
+StrToIp
+synaip
+Convert IPv4 address from their string form to binary.
+
+
+StrToIp6
+synaip
+Convert IPv6 address from their string form to binary byte array.
+
+
+SwapBytes
+synautil
+swap bytes in integer.
+
+
+SynaIconv
+synaicnv
+
+
+
+SynaIconvClose
+synaicnv
+
+
+
+SynaIconvCtl
+synaicnv
+
+
+
+SynaIconvOpen
+synaicnv
+
+
+
+SynaIconvOpenIgnore
+synaicnv
+
+
+
+SynaIconvOpenTranslit
+synaicnv
+
+
+
+Test3Des
+synacrypt
+Call internal test of all 3DES encryptions. Returns True
if all is OK.
+
+
+TestAes
+synacrypt
+Call internal test of all AES encryptions. Returns True
if all is OK.
+
+
+TestDes
+synacrypt
+Call internal test of all DES encryptions. Returns True
if all is OK.
+
+
+TickDelta
+synautil
+Return difference between two timestamps. It working fine only for differences smaller then maxint. (difference must be smaller then 24 days.)
+
+
+TimeZone
+synautil
+Return your timezone bias from UTC time in string representation like "+0200".
+
+
+TimeZoneBias
+synautil
+Return your timezone bias from UTC time in minutes.
+
+
+ToSysLog
+slogsend
+Simply send packet to specified Syslog server.
+
+
+TraceRouteHost
+pingsend
+A very useful function and example of its use would be found in the TPINGSend object. Use it to TraceRoute to any host.
+
+
+TrimSP
+synautil
+Like Trim, but remove only spaces, not control characters!
+
+
+TrimSPLeft
+synautil
+Like TrimLeft, but remove only spaces, not control characters!
+
+
+TrimSPRight
+synautil
+Like TrimRight, but remove only spaces, not control characters!
+
+
+UnquoteStr
+synautil
+Remove quotation from Value string. If Value is not quoted, then return same string without any modification.
+
+
+UpdateCrc16
+synacode
+Returns a new CRC16 value after adding a new byte of data.
+
+
+UpdateCrc32
+synacode
+Returns a new CRC32 value after adding a new byte of data.
+
+
+WakeOnLan
+synamisc
+By this function you can turn-on computer on network, if this computer supporting Wake-on-lan feature. You need MAC number (network card indentifier) of computer for turn-on. You can also assign target IP addres. If you not specify it, then is used broadcast for delivery magic wake-on packet. However broadcasts workinh only on your local network. When you need to wake-up computer on another network, you must specify any existing IP addres on same network segment as targeting computer.
+
+
+WideToString
+synachar
+Convert WideString to binary string with unicode content.
+
+
+WriteStrToStream
+synautil
+write string to stream.
+
+
+X509Digest
+ssl_openssl_lib
+
+
+
+X509Free
+ssl_openssl_lib
+
+
+
+X509GetIssuerName
+ssl_openssl_lib
+
+
+
+X509GetSerialNumber
+ssl_openssl_lib
+
+
+
+X509GetSubjectName
+ssl_openssl_lib
+
+
+
+X509GmtimeAdj
+ssl_openssl_lib
+
+
+
+X509NameAddEntryByTxt
+ssl_openssl_lib
+
+
+
+X509NameHash
+ssl_openssl_lib
+
+
+
+X509NameOneline
+ssl_openssl_lib
+
+
+
+X509New
+ssl_openssl_lib
+
+
+
+X509print
+ssl_openssl_lib
+
+
+
+X509SetIssuerName
+ssl_openssl_lib
+
+
+
+X509SetNotAfter
+ssl_openssl_lib
+
+
+
+X509SetNotBefore
+ssl_openssl_lib
+
+
+
+X509SetPubkey
+ssl_openssl_lib
+
+
+
+X509SetVersion
+ssl_openssl_lib
+
+
+
+X509Sign
+ssl_openssl_lib
+
+
+
+XorString
+synautil
+XOR each byte in the strings
+
+
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:53
+
+
ADDED lib/synapse/docs/help/AllIdentifiers.html
Index: lib/synapse/docs/help/AllIdentifiers.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/AllIdentifiers.html
@@ -0,0 +1,3747 @@
+
+
+
+
+
+All Identifiers
+
+
+
+All Identifiers
+
+
+
+AnsiCDateTime
+synautil
+Returns date and time in format defined in ANSI C compilers in format "ddd mmm d hh:nn:ss yyyy"
+
+
+AppendToLog
+synadbg
+
+
+
+argptr
+synaicnv
+
+
+
+Asn1IntegerGet
+ssl_openssl_lib
+
+
+
+Asn1IntegerSet
+ssl_openssl_lib
+
+
+
+Asn1UtctimeFree
+ssl_openssl_lib
+
+
+
+Asn1UtctimeNew
+ssl_openssl_lib
+
+
+
+ASN1_BOOL
+asn1util
+
+
+
+ASN1_COUNTER
+asn1util
+
+
+
+ASN1_ENUM
+asn1util
+
+
+
+ASN1_GAUGE
+asn1util
+
+
+
+ASN1_INT
+asn1util
+
+
+
+ASN1_IPADDR
+asn1util
+
+
+
+ASN1_NULL
+asn1util
+
+
+
+ASN1_OBJID
+asn1util
+
+
+
+ASN1_OCTSTR
+asn1util
+
+
+
+ASN1_OPAQUE
+asn1util
+
+
+
+ASN1_SEQ
+asn1util
+
+
+
+ASN1_SETOF
+asn1util
+
+
+
+ASN1_TIMETICKS
+asn1util
+
+
+
+ASNDecLen
+asn1util
+Decodes length of next element in "Buffer" from the "Start" position.
+
+
+ASNDecOIDItem
+asn1util
+Decodes an OID item of the next element in the "Buffer" from the "Start" position.
+
+
+ASNdump
+asn1util
+Convert ASN.1 BER encoded buffer to human readable form for debugging.
+
+
+ASNEncInt
+asn1util
+Encodes a signed integer to ASN.1 binary
+
+
+ASNEncLen
+asn1util
+Encodes the length of ASN.1 element to binary.
+
+
+ASNEncOIDItem
+asn1util
+Encodes OID item to binary form.
+
+
+ASNEncUInt
+asn1util
+Encodes unsigned integer into ASN.1 binary
+
+
+ASNItem
+asn1util
+Beginning with the "Start" position, decode the ASN.1 item of the next element in "Buffer". Type of item is stored in "ValueType."
+
+
+ASNObject
+asn1util
+Encodes ASN.1 object to binary form.
+
+
+BC
+synacrypt
+
+
+
+BinToInt
+synautil
+Returns an integer equivalent of the binary string in "Value". (i.e. ('10001010') returns 138)
+
+
+BioCtrlPending
+ssl_openssl_lib
+
+
+
+BioFreeAll
+ssl_openssl_lib
+
+
+
+BioNew
+ssl_openssl_lib
+
+
+
+BioRead
+ssl_openssl_lib
+
+
+
+BioSMem
+ssl_openssl_lib
+
+
+
+BioWrite
+ssl_openssl_lib
+
+
+
+BuildStringFromBuffer
+synautil
+Copy data from a buffer starting at position APtr and delimited by AEtx position into ANSIString.
+
+
+c64k
+blcksock
+
+
+
+c6AnyHost
+blcksock
+
+
+
+c6Broadcast
+blcksock
+
+
+
+c6Localhost
+blcksock
+
+
+
+cAnyHost
+blcksock
+
+
+
+cAnyPort
+blcksock
+
+
+
+cBroadcast
+blcksock
+
+
+
+cClamProtocol
+clamsend
+
+
+
+CDateTime
+synautil
+Returns date and time in format defined in C compilers in format "mmm dd hh:nn:ss"
+
+
+cDnsProtocol
+dnssend
+
+
+
+cFtpDataProtocol
+ftpsend
+
+
+
+cFtpProtocol
+ftpsend
+
+
+
+CharsetConversion
+synachar
+Convert Value from one charset to another. See: CharsetConversionEx
+
+
+CharsetConversionEx
+synachar
+Convert Value from one charset to another with additional character conversion. see: Replace_None and Replace_Czech
+
+
+CharsetConversionTrans
+synachar
+Convert Value from one charset to another with additional character conversion. This funtion is similar to CharsetConversionEx , but you can disable transliteration of unconvertible characters.
+
+
+cHttpProtocol
+httpsend
+
+
+
+cIMAPProtocol
+imapsend
+
+
+
+cLDAPProtocol
+ldapsend
+
+
+
+cLocalhost
+blcksock
+
+
+
+cNNTPProtocol
+nntpsend
+
+
+
+cNtpProtocol
+sntpsend
+
+
+
+CodeInt
+synautil
+Return two characters, which ordinal values represents the value in byte format. (High-endian)
+
+
+CodeLongInt
+synautil
+Return four characters, which ordinal values represents the value in byte format. (High-endian)
+
+
+CopyLinesFromStreamUntilBoundary
+synautil
+Copy all lines from a buffer starting at APtr to ALines until ABoundary or end of the buffer is reached. Move APtr position forward).
+
+
+CopyLinesFromStreamUntilNullLine
+synautil
+Copy all lines from a buffer starting at APtr to ALines until empty line or end of the buffer is reached. Move APtr position forward).
+
+
+CountOfChar
+synautil
+Return count of Chr in Value string.
+
+
+cPop3Protocol
+pop3send
+
+
+
+CR
+synaser
+
+
+
+CR
+blcksock
+
+
+
+Crc16
+synacode
+return CRC16 from a value string.
+
+
+Crc32
+synacode
+return CRC32 from a value string.
+
+
+CRLF
+blcksock
+
+
+
+CRLF
+synaser
+
+
+
+CRYPTOcleanupAllExData
+ssl_openssl_lib
+
+
+
+cSerialChunk
+synaser
+
+
+
+cSmtpProtocol
+smtpsend
+
+
+
+cSnmpProtocol
+snmpsend
+
+
+
+cSnmpTrapProtocol
+snmpsend
+
+
+
+cSSHProtocol
+tlntsend
+
+
+
+cSysLogProtocol
+slogsend
+
+
+
+cTelnetProtocol
+tlntsend
+
+
+
+cTFTPProtocol
+ftptsend
+
+
+
+cTFTP_ACK
+ftptsend
+
+
+
+cTFTP_DTA
+ftptsend
+
+
+
+cTFTP_ERR
+ftptsend
+
+
+
+cTFTP_RRQ
+ftptsend
+
+
+
+cTFTP_WRQ
+ftptsend
+
+
+
+CustomMonthNames
+synautil
+can be used for your own months strings for GetMonthNumber
+
+
+d2iPKCS12bio
+ssl_openssl_lib
+
+
+
+d2iX509bio
+ssl_openssl_lib
+
+
+
+dcb_AbortOnError
+synaser
+
+
+
+dcb_Binary
+synaser
+
+
+
+dcb_DsrSensivity
+synaser
+
+
+
+dcb_DtrControlDisable
+synaser
+
+
+
+dcb_DtrControlEnable
+synaser
+
+
+
+dcb_DtrControlHandshake
+synaser
+
+
+
+dcb_DtrControlMask
+synaser
+
+
+
+dcb_ErrorChar
+synaser
+
+
+
+dcb_InX
+synaser
+
+
+
+dcb_NullStrip
+synaser
+
+
+
+dcb_OutX
+synaser
+
+
+
+dcb_OutxCtsFlow
+synaser
+
+
+
+dcb_OutxDsrFlow
+synaser
+
+
+
+dcb_ParityCheck
+synaser
+
+
+
+dcb_Reserveds
+synaser
+
+
+
+dcb_RtsControlDisable
+synaser
+
+
+
+dcb_RtsControlEnable
+synaser
+
+
+
+dcb_RtsControlHandshake
+synaser
+
+
+
+dcb_RtsControlMask
+synaser
+
+
+
+dcb_RtsControlToggle
+synaser
+
+
+
+dcb_TXContinueOnXoff
+synaser
+
+
+
+Decode4to3
+synacode
+Decode 4to3 encoding with given table. If some element is not found in table, first item from table is used. This is good for buggy coded items by Microsoft Outlook. This software sometimes using wrong table for UUcode, where is used ' ' instead '`'.
+
+
+Decode4to3Ex
+synacode
+Decode 4to3 encoding with given REVERSE table. Using this function with reverse table is much faster then Decode4to3 . This function is used internally for Base64, UU or XX decoding.
+
+
+DecodeBase64
+synacode
+Decode string from base64 format.
+
+
+DecodeBase64mod
+synacode
+Decode string from modified base64 format. (used in IMAP, for example.)
+
+
+DecodeInt
+synautil
+Decodes two characters located at "Index" offset position of the "Value" string to Word values.
+
+
+DecodeLongInt
+synautil
+Decodes four characters located at "Index" offset position of the "Value" string to LongInt values.
+
+
+DecodeQuotedPrintable
+synacode
+Decodes a string from quoted printable form. (also decodes triplet sequences like '=7F')
+
+
+DecodeRfcDateTime
+synautil
+Decode various string representations of date and time to Tdatetime type. This function do all timezone corrections too! This function can decode lot of formats like:
+
+
+ ddd, d mmm yyyy hh:mm:ss
+ ddd, d mmm yy hh:mm:ss
+ ddd, mmm d yyyy hh:mm:ss
+ ddd mmm dd hh:mm:ss yyyy
+
+
+
+
and more with lot of modifications, include:
+
+
+Sun, 06 Nov 1994 08:49 :37 GMT ; RFC 822 , updated by RFC 1123
+Sunday, 06 -Nov-94 08:49 :37 GMT ; RFC 850 , obsoleted by RFC 1036
+Sun Nov 6 08:49 :37 1994 ; ANSI C
+
+ Timezone corrections known lot of symbolic timezone names (like CEST, EDT, etc.) or numeric representation (like +0200). By convention defined in RFC timezone +0000 is GMT and -0000 is current your system timezone.
+
+
+DecodeTriplet
+synacode
+Decodes triplet encoding with a given character delimiter. It is used for decoding quoted-printable or URL encoding.
+
+
+DecodeURL
+synacode
+Decodes a string of URL encoding. (also decodes triplet sequences like '%7F')
+
+
+DecodeUU
+synacode
+Decodes a string from UUcode format.
+
+
+DecodeXX
+synacode
+Decodes a string from XXcode format.
+
+
+DecodeYEnc
+synacode
+decode line with Yenc code. This code is sometimes used in newsgroups.
+
+
+DEFAULT_RECV_BUFFER
+ssl_sbb
+
+
+
+DESecbencrypt
+ssl_openssl_lib
+
+
+
+DESsetkeychecked
+ssl_openssl_lib
+
+
+
+DESsetoddparity
+ssl_openssl_lib
+
+
+
+DestroyIconvInterface
+synaicnv
+
+
+
+DestroySSLInterface
+ssl_openssl_lib
+
+
+
+DES_cblock
+ssl_openssl_lib
+
+
+
+des_key_schedule
+ssl_openssl_lib
+
+
+
+des_ks_struct
+ssl_openssl_lib
+
+
+
+DisableIconv
+synachar
+By this you can generally disable/enable Iconv support.
+
+
+DLLIconvName
+synaicnv
+
+
+
+DLLSSLName
+ssl_openssl_lib
+
+
+
+DLLSSLName2
+ssl_openssl_lib
+
+
+
+DLLUtilName
+ssl_openssl_lib
+
+
+
+Dump
+synautil
+Dump binary buffer stored in a string to a file with DumpFile filename.
+
+
+DumpEx
+synautil
+Dump binary buffer stored in a string to a file with DumpFile filename. All bytes with code of character is written as character, not as hexadecimal value.
+
+
+DumpExStr
+synautil
+Dump binary buffer stored in a string to a result string. All bytes with code of character is written as character, not as hexadecimal value.
+
+
+DumpStr
+synautil
+Dump binary buffer stored in a string to a result string.
+
+
+EAuthorizationError
+snmpsend
+
+
+
+EBadValue
+snmpsend
+
+
+
+ECommitFailed
+snmpsend
+
+
+
+EGenErr
+snmpsend
+
+
+
+EInconsistentName
+snmpsend
+
+
+
+EInconsistentValue
+snmpsend
+
+
+
+Encode3to4
+synacode
+Encode by system 3to4 (used by Base64, UU coding, etc) by given table.
+
+
+EncodeBase64
+synacode
+Encodes a string to base64 format.
+
+
+EncodeBase64mod
+synacode
+Encodes a string to modified base64 format. (used in IMAP, for example.)
+
+
+EncodeQuotedPrintable
+synacode
+Encodes a string to triplet quoted printable form. All NonAsciiChar are encoded.
+
+
+EncodeSafeQuotedPrintable
+synacode
+Encodes a string to triplet quoted printable form. All NonAsciiChar and SpecialChar are encoded.
+
+
+EncodeTriplet
+synacode
+Performs triplet encoding with a given character delimiter. Used for encoding quoted-printable or URL encoding.
+
+
+EncodeURL
+synacode
+Encodes a string to URL format. Used to encode critical characters in all URLs.
+
+
+EncodeURLElement
+synacode
+Encodes a string to URL format. Used for encoding data from a form field in HTTP, etc. (Encodes all critical characters including characters used as URL delimiters ('/',':', etc.)
+
+
+EncodeUU
+synacode
+encode UUcode. it encode only datas, you must also add header and footer for proper encode.
+
+
+ENoAccess
+snmpsend
+
+
+
+ENoCreation
+snmpsend
+
+
+
+ENoError
+snmpsend
+
+
+
+ENoSuchName
+snmpsend
+
+
+
+ENotWritable
+snmpsend
+
+
+
+EReadOnly
+snmpsend
+
+
+
+EResourceUnavailable
+snmpsend
+
+
+
+ErrAlreadyInUse
+synaser
+
+
+
+ErrAlreadyOwned
+synaser
+
+
+
+ErrClearError
+ssl_openssl_lib
+
+
+
+ErrErrorString
+ssl_openssl_lib
+
+
+
+ErrFrame
+synaser
+
+
+
+ErrFreeStrings
+ssl_openssl_lib
+
+
+
+ErrGetError
+ssl_openssl_lib
+
+
+
+ErrMaxBuffer
+synaser
+
+
+
+ErrNoDeviceAnswer
+synaser
+
+
+
+ErrNotRead
+synaser
+
+
+
+ErrOverrun
+synaser
+
+
+
+ErrPortNotOpen
+synaser
+
+
+
+ErrRemoveState
+ssl_openssl_lib
+
+
+
+ErrRxOver
+synaser
+
+
+
+ErrRxParity
+synaser
+
+
+
+ErrTimeout
+synaser
+
+
+
+ErrTxFull
+synaser
+
+
+
+ErrWrongParameter
+synaser
+
+
+
+ESynapseError
+blcksock
+Exception clas used by Synapse
+
+
+ESynaSerError
+synaser
+Exception type for SynaSer errors
+
+
+ETooBig
+snmpsend
+
+
+
+EUndoFailed
+snmpsend
+
+
+
+EVPcleanup
+ssl_openssl_lib
+
+
+
+EvpGetDigestByName
+ssl_openssl_lib
+
+
+
+EvpPkeyAssign
+ssl_openssl_lib
+
+
+
+EvpPkeyFree
+ssl_openssl_lib
+
+
+
+EvpPkeyNew
+ssl_openssl_lib
+
+
+
+EVP_MAX_MD_SIZE
+ssl_openssl_lib
+
+
+
+EVP_PKEY
+ssl_openssl_lib
+
+
+
+EVP_PKEY_RSA
+ssl_openssl_lib
+
+
+
+EWrongEncoding
+snmpsend
+
+
+
+EWrongLength
+snmpsend
+
+
+
+EWrongType
+snmpsend
+
+
+
+EWrongValue
+snmpsend
+
+
+
+ExpandIP6
+synaip
+Expand short form of IPv6 address to long form.
+
+
+FCL_Authorization
+slogsend
+
+
+
+FCL_Clock
+slogsend
+
+
+
+FCL_FTP
+slogsend
+
+
+
+FCL_Kernel
+slogsend
+
+
+
+FCL_Local0
+slogsend
+
+
+
+FCL_Local1
+slogsend
+
+
+
+FCL_Local2
+slogsend
+
+
+
+FCL_Local3
+slogsend
+
+
+
+FCL_Local4
+slogsend
+
+
+
+FCL_Local5
+slogsend
+
+
+
+FCL_Local6
+slogsend
+
+
+
+FCL_Local7
+slogsend
+
+
+
+FCL_LogAlert
+slogsend
+
+
+
+FCL_LogAudit
+slogsend
+
+
+
+FCL_MailSystem
+slogsend
+
+
+
+FCL_News
+slogsend
+
+
+
+FCL_NTP
+slogsend
+
+
+
+FCL_Printer
+slogsend
+
+
+
+FCL_Security
+slogsend
+
+
+
+FCL_Syslogd
+slogsend
+
+
+
+FCL_System
+slogsend
+
+
+
+FCL_Time
+slogsend
+
+
+
+FCL_UserLevel
+slogsend
+
+
+
+FCL_UUCP
+slogsend
+
+
+
+Fetch
+synautil
+Fetch string from left of Value string.
+
+
+FetchBin
+synautil
+Like Fetch , but working with binary strings, not with text.
+
+
+FetchEx
+synautil
+Fetch string from left of Value string. This function ignore delimitesr inside quotations.
+
+
+FtpGetFile
+ftpsend
+A very useful function, and example of use can be found in the TFtpSend object. Dowload specified file from FTP server to LocalFile.
+
+
+FtpInterServerTransfer
+ftpsend
+A very useful function, and example of use can be found in the TFtpSend object. Initiate transfer of file between two FTP servers.
+
+
+FtpPutFile
+ftpsend
+A very useful function, and example of use can be found in the TFtpSend object. Upload specified LocalFile to FTP server.
+
+
+FTP_ERR
+ftpsend
+Terminating value for TLogonActions
+
+
+FTP_OK
+ftpsend
+Terminating value for TLogonActions
+
+
+GenerateBoundary
+mimepart
+Generates a unique boundary string.
+
+
+GetBetween
+synautil
+Get string between PairBegin and PairEnd. This function respect nesting. For example:
+
+
+ Value is : 'Hi! (hello(yes!))'
+ pairbegin is : '('
+ pairend is : ')'
+ In this case result is : 'hello(yes!)'
+
+
+
+
+GetBOM
+synachar
+Return BOM (Byte Order Mark) for given unicode charset.
+
+
+GetCPFromID
+synachar
+Converting string with charset name to TMimeChar.
+
+
+GetCurCP
+synachar
+Returns charset used by operating system.
+
+
+GetCurOEMCP
+synachar
+Returns charset used by operating system as OEM charset. (in Windows DOS box, for example)
+
+
+GetDateMDYFromStr
+synautil
+Decode string in format "m-d-y" to TDateTime type.
+
+
+GetDNS
+synamisc
+Autodetect current DNS servers used by system. If is defined more then one DNS server, then result is comma-delimited.
+
+
+GetEmailAddr
+synautil
+Returns only the e-mail portion of an address from the full address format. i.e. returns 'nobody@somewhere.com' from '"someone" <nobody@somewhere.com>'
+
+
+GetEmailDesc
+synautil
+Returns only the description part from a full address format. i.e. returns 'someone' from '"someone" <nobody@somewhere.com>'
+
+
+GetIDFromCP
+synachar
+Converting TMimeChar to string with name of charset.
+
+
+GetIEProxy
+synamisc
+Autodetect InternetExplorer proxy setting for given protocol. This function working only on windows!
+
+
+GetLocalIPs
+synamisc
+Return all known IP addresses on local system. Addresses are divided by comma.
+
+
+GetMailServers
+dnssend
+A very useful function, and example of it's use is found in the TDNSSend object. This function is used to get mail servers for a domain and sort them by preference numbers. "Servers" contains only the domain names of the mail servers in the right order (without preference number!). The first domain name will always be the highest preferenced mail server. Returns boolean True
if all went well.
+
+
+GetMonthNumber
+synautil
+Decode three-letter string with name of month to their month number. If string not match any month name, then is returned 0. For parsing are used predefined names for English, French and German and names from system locale too.
+
+
+GetParameter
+synautil
+Returns parameter value from string in format: parameter1="value1"; parameter2=value2
+
+
+GetSerialPortNames
+synaser
+Returns list of existing computer serial ports. Working properly only in Windows!
+
+
+GetTempFile
+synautil
+Return filename of new temporary file in Dir (if empty, then default temporary directory is used) and with optional filename prefix.
+
+
+GetTick
+synautil
+Return current value of system timer with precizion 1 millisecond. Good for measure time difference.
+
+
+GetTimeFromStr
+synautil
+Return decoded time from given string. Time must be witch separator ':'. You can use "hh:mm" or "hh:mm:ss".
+
+
+GetUTTime
+synautil
+Return current system date and time in UTC timezone.
+
+
+HeadersToList
+synautil
+Convert lines in stringlist from 'name: value' form to 'name=value' form.
+
+
+HMAC_MD5
+synacode
+Returns a binary string with HMAC-MD5 hash.
+
+
+HMAC_SHA1
+synacode
+Returns a binary string with HMAC-SHA1 hash.
+
+
+HttpGetBinary
+httpsend
+A very usefull function, and example of use can be found in the THTTPSend object. It implements the GET method of the HTTP protocol. This function sends the GET method for URL document to an HTTP server. Returned document is in the "Response" stream. Returns boolean TRUE if all went well.
+
+
+HttpGetText
+httpsend
+A very usefull function, and example of use can be found in the THTTPSend object. It implements the GET method of the HTTP protocol. This function sends the GET method for URL document to an HTTP server. Returned document is in the "Response" stringlist (without any headers). Returns boolean TRUE if all went well.
+
+
+HttpPostBinary
+httpsend
+A very useful function, and example of use can be found in the THTTPSend object. It implements the POST method of the HTTP protocol. This function sends the SEND method for a URL document to an HTTP server. The document to be sent is located in "Data" stream. The returned document is in the "Data" stream. Returns boolean TRUE if all went well.
+
+
+HttpPostFile
+httpsend
+A very useful function, and example of use can be found in the THTTPSend object. It implements the POST method of the HTTP protocol. This function sends the POST method for a URL document to an HTTP server. This function simulate posting of file by HTML form used method 'multipart/form-data'. Posting file is in DATA stream. Its name is Filename string. Fieldname is for name of formular field with file. (simulate HTML INPUT FILE) The returned document is in the ResultData Stringlist. Returns boolean TRUE if all went well.
+
+
+HttpPostURL
+httpsend
+A very useful function, and example of use can be found in the THTTPSend object. It implements the POST method of the HTTP protocol. This function is good for POSTing form data. It sends the POST method for a URL document to an HTTP server. You must prepare the form data in the same manner as you would the URL data, and pass this prepared data to "URLdata". The following is a sample of how the data would appear: 'name=Lukas&field1=some%20data'. The information in the field must be encoded by EncodeURLElement function. The returned document is in the "Data" stream. Returns boolean TRUE if all went well.
+
+
+i2dPrivateKeyBio
+ssl_openssl_lib
+
+
+
+i2dX509bio
+ssl_openssl_lib
+
+
+
+ICMP6_ECHO
+pingsend
+
+
+
+ICMP6_ECHOREPLY
+pingsend
+
+
+
+ICMP6_TIME_EXCEEDED
+pingsend
+
+
+
+ICMP6_UNREACH
+pingsend
+
+
+
+ICMP_ECHO
+pingsend
+
+
+
+ICMP_ECHOREPLY
+pingsend
+
+
+
+ICMP_TIME_EXCEEDED
+pingsend
+
+
+
+ICMP_UNREACH
+pingsend
+
+
+
+iconvLibHandle
+synaicnv
+
+
+
+IconvOnlyChars
+synachar
+Set of charsets supported by Iconv library only.
+
+
+ICONV_GET_DISCARD_ILSEQ
+synaicnv
+
+
+
+ICONV_GET_TRANSLITERATE
+synaicnv
+
+
+
+ICONV_SET_DISCARD_ILSEQ
+synaicnv
+
+
+
+ICONV_SET_TRANSLITERATE
+synaicnv
+
+
+
+iconv_t
+synaicnv
+
+
+
+ICONV_TRIVIALP
+synaicnv
+
+
+
+IdealCharsetCoding
+synachar
+Finding best target charset from set of TMimeChars with minimal count of unconvertible characters.
+
+
+IdealCharsets
+synachar
+Default set of charsets for IdealCharsetCoding function.
+
+
+IdToMib
+asn1util
+Decodes MIB OID from binary form to string form.
+
+
+IncPoint
+synautil
+Increase pointer by value.
+
+
+IndexByBegin
+synautil
+Index of string in stringlist with same beginning as Value is returned.
+
+
+InitIconvInterface
+synaicnv
+
+
+
+InitSSLInterface
+ssl_openssl_lib
+
+
+
+InlineCode
+mimeinln
+Inline MIME encoding similar to InlineEncode , but the source charset is automatically set to the system default charset, and the target charset is automatically assigned from set of allowed encoding for MIME.
+
+
+InlineCodeEx
+mimeinln
+Inline mime encoding similar to InlineEncode , but you can specify source charset, and the target characterset is automatically assigned.
+
+
+InlineDecode
+mimeinln
+Decodes mime inline encoding (i.e. in headers) uses target characterset "CP".
+
+
+InlineEmail
+mimeinln
+Converts e-mail address to canonical mime form. Source charser it system default charset.
+
+
+InlineEmailEx
+mimeinln
+Converts e-mail address to canonical mime form. You can specify source charset.
+
+
+InlineEncode
+mimeinln
+Encodes string to MIME inline encoding. The source characterset is "CP", and the target charset is "MimeP".
+
+
+IntMibToStr
+asn1util
+Encodes an one number from MIB OID to binary form. (used internally from MibToId )
+
+
+IntToBin
+synautil
+Returns a string of binary "Digits" representing "Value".
+
+
+Ip6ToStr
+synaip
+Convert IPv6 address from binary byte array to string form.
+
+
+IPToID
+synaip
+Returns a string with the "Host" ip address converted to binary form.
+
+
+IpToStr
+synaip
+Convert IPv4 address from binary to string form.
+
+
+IsBinaryString
+synautil
+If string is binary string (contains non-printable characters), then is returned true.
+
+
+IsIconvloaded
+synaicnv
+
+
+
+IsIP
+synaip
+Returns True
, if "Value" is a valid IPv4 address. Cannot be a symbolic Name!
+
+
+IsIP6
+synaip
+Returns True
, if "Value" is a valid IPv6 address. Cannot be a symbolic Name!
+
+
+IsSSLloaded
+ssl_openssl_lib
+
+
+
+LDAPResultDump
+ldapsend
+Dump result of LDAP SEARCH into human readable form. Good for debugging.
+
+
+LDAP_ASN1_ABANDON_REQUEST
+ldapsend
+
+
+
+LDAP_ASN1_ADD_REQUEST
+ldapsend
+
+
+
+LDAP_ASN1_ADD_RESPONSE
+ldapsend
+
+
+
+LDAP_ASN1_BIND_REQUEST
+ldapsend
+
+
+
+LDAP_ASN1_BIND_RESPONSE
+ldapsend
+
+
+
+LDAP_ASN1_COMPARE_REQUEST
+ldapsend
+
+
+
+LDAP_ASN1_COMPARE_RESPONSE
+ldapsend
+
+
+
+LDAP_ASN1_DEL_REQUEST
+ldapsend
+
+
+
+LDAP_ASN1_DEL_RESPONSE
+ldapsend
+
+
+
+LDAP_ASN1_EXT_REQUEST
+ldapsend
+
+
+
+LDAP_ASN1_EXT_RESPONSE
+ldapsend
+
+
+
+LDAP_ASN1_MODIFYDN_REQUEST
+ldapsend
+
+
+
+LDAP_ASN1_MODIFYDN_RESPONSE
+ldapsend
+
+
+
+LDAP_ASN1_MODIFY_REQUEST
+ldapsend
+
+
+
+LDAP_ASN1_MODIFY_RESPONSE
+ldapsend
+
+
+
+LDAP_ASN1_SEARCH_DONE
+ldapsend
+
+
+
+LDAP_ASN1_SEARCH_ENTRY
+ldapsend
+
+
+
+LDAP_ASN1_SEARCH_REFERENCE
+ldapsend
+
+
+
+LDAP_ASN1_SEARCH_REQUEST
+ldapsend
+
+
+
+LDAP_ASN1_UNBIND_REQUEST
+ldapsend
+
+
+
+LF
+synaser
+
+
+
+LF
+blcksock
+
+
+
+ListToHeaders
+synautil
+Convert lines in stringlist from 'name=value' form to 'name: value' form.
+
+
+LockfileDirectory
+synaser
+
+
+
+LogFile
+synadbg
+
+
+
+MatchBoundary
+synautil
+Compare a text at position ABOL with ABoundary and return position behind the match (including a trailing CRLF if any).
+
+
+MatchLastBoundary
+synautil
+Compare a text at position ABOL with ABoundary + the last boundary suffix and return position behind the match (including a trailing CRLF if any).
+
+
+MaxMimeType
+mimepart
+
+
+
+MAXROUNDS
+synacrypt
+
+
+
+MD4
+synacode
+Returns a binary string with a RSA-MD4 hashing of "Value" string.
+
+
+MD5
+synacode
+Returns a binary string with a RSA-MD5 hashing of "Value" string.
+
+
+MD5LongHash
+synacode
+Returns a binary string with a RSA-MD5 hashing of string what is constructed by repeating "value" until length is "Len".
+
+
+MibToId
+asn1util
+Encodes an MIB OID string to binary form.
+
+
+MimeType
+mimepart
+
+
+
+NeedCharsetConversion
+synachar
+return True
when value need to be converted. (It is not 7-bit ASCII)
+
+
+NeedInline
+mimeinln
+Returns True
, if "Value" contains characters needed for inline coding.
+
+
+NoIconvChars
+synachar
+Set of charsets supported by internal routines only.
+
+
+NonAsciiChar
+synacode
+
+
+
+NormalizeHeader
+synautil
+Read header from "Value" stringlist beginning at "Index" position. If header is Splitted into multiple lines, then this procedure de-split it into one line.
+
+
+OPENSSLaddallalgorithms
+ssl_openssl_lib
+
+
+
+OPENSSL_DES_DECRYPT
+ssl_openssl_lib
+
+
+
+OPENSSL_DES_ENCRYPT
+ssl_openssl_lib
+
+
+
+PadString
+synautil
+Return padded string. If length is greater, string is truncated. If length is smaller, string is padded by Pad character.
+
+
+ParseParameters
+synautil
+parse value string with elements differed by ';' into stringlist.
+
+
+ParseParametersEx
+synautil
+parse value string with elements differed by Delimiter into stringlist.
+
+
+ParseURL
+synautil
+Parses a URL to its various components.
+
+
+PASN1_INTEGER
+ssl_openssl_lib
+
+
+
+PASN1_UTCTIME
+ssl_openssl_lib
+
+
+
+PBIO
+ssl_openssl_lib
+
+
+
+PBIO_METHOD
+ssl_openssl_lib
+
+
+
+PDES_cblock
+ssl_openssl_lib
+
+
+
+PDUGetBulkRequest
+snmpsend
+
+
+
+PDUGetNextRequest
+snmpsend
+
+
+
+PDUGetRequest
+snmpsend
+
+
+
+PDUGetResponse
+snmpsend
+
+
+
+PDUInformRequest
+snmpsend
+
+
+
+PDUReport
+snmpsend
+
+
+
+PDUSetRequest
+snmpsend
+
+
+
+PDUTrap
+snmpsend
+
+
+
+PDUTrapV2
+snmpsend
+
+
+
+PEMReadBioX509
+ssl_openssl_lib
+
+
+
+PEVP_MD
+ssl_openssl_lib
+
+
+
+PFunction
+ssl_openssl_lib
+
+
+
+PingHost
+pingsend
+A very useful function and example of its use would be found in the TPINGSend object. Use it to ping to any host. If successful, returns the ping time in milliseconds. Returns -1 if an error occurred.
+
+
+PInteger
+ssl_openssl_lib
+
+
+
+PKCS12free
+ssl_openssl_lib
+
+
+
+PKCS12parse
+ssl_openssl_lib
+
+
+
+PortIsClosed
+synaser
+
+
+
+PosCRLF
+synautil
+return position of string terminator in string. If terminator found, then is returned in terminator parameter. Possible line terminators are: CRLF, LFCR, CR, LF
+
+
+PosFrom
+synautil
+Like Pos function, buf from given string possition.
+
+
+PPasswdCb
+ssl_openssl_lib
+
+
+
+PRSA
+ssl_openssl_lib
+
+
+
+PSSL
+ssl_openssl_lib
+
+
+
+PSslPtr
+ssl_openssl_lib
+
+
+
+PSSL_CTX
+ssl_openssl_lib
+
+
+
+PSSL_METHOD
+ssl_openssl_lib
+
+
+
+PSTACK
+ssl_openssl_lib
+
+
+
+PtrInt
+synafpc
+
+
+
+PX509
+ssl_openssl_lib
+
+
+
+PX509_NAME
+ssl_openssl_lib
+
+
+
+QTYPE_A
+dnssend
+
+
+
+QTYPE_AAAA
+dnssend
+
+
+
+QTYPE_AFSDB
+dnssend
+
+
+
+QTYPE_ALL
+dnssend
+
+
+
+QTYPE_AXFR
+dnssend
+
+
+
+QTYPE_CNAME
+dnssend
+
+
+
+QTYPE_GPOS
+dnssend
+
+
+
+QTYPE_HINFO
+dnssend
+
+
+
+QTYPE_ISDN
+dnssend
+
+
+
+QTYPE_KEY
+dnssend
+
+
+
+QTYPE_KX
+dnssend
+
+
+
+QTYPE_LOC
+dnssend
+
+
+
+QTYPE_MAILA
+dnssend
+
+
+
+QTYPE_MAILB
+dnssend
+
+
+
+QTYPE_MB
+dnssend
+
+
+
+QTYPE_MD
+dnssend
+
+
+
+QTYPE_MF
+dnssend
+
+
+
+QTYPE_MG
+dnssend
+
+
+
+QTYPE_MINFO
+dnssend
+
+
+
+QTYPE_MR
+dnssend
+
+
+
+QTYPE_MX
+dnssend
+
+
+
+QTYPE_NAPTR
+dnssend
+
+
+
+QTYPE_NS
+dnssend
+
+
+
+QTYPE_NSAP
+dnssend
+
+
+
+QTYPE_NSAPPTR
+dnssend
+
+
+
+QTYPE_NULL
+dnssend
+
+
+
+QTYPE_NXT
+dnssend
+
+
+
+QTYPE_PTR
+dnssend
+
+
+
+QTYPE_PX
+dnssend
+
+
+
+QTYPE_RP
+dnssend
+
+
+
+QTYPE_RT
+dnssend
+
+
+
+QTYPE_SIG
+dnssend
+
+
+
+QTYPE_SOA
+dnssend
+
+
+
+QTYPE_SPF
+dnssend
+
+
+
+QTYPE_SRV
+dnssend
+
+
+
+QTYPE_TXT
+dnssend
+
+
+
+QTYPE_WKS
+dnssend
+
+
+
+QTYPE_X25
+dnssend
+
+
+
+QuoteStr
+synautil
+Quote Value string. If Value contains some Quote chars, then it is doubled.
+
+
+RandScreen
+ssl_openssl_lib
+
+
+
+ReadStrFromStream
+synautil
+read string with requested length form stream.
+
+
+RecvTrap
+snmpsend
+A very useful function and example of its use would be found in the TSNMPSend object. It receives a TRAPv1 and returns all the data that comes with it.
+
+
+ReplaceString
+synautil
+Replaces all "Search" string values found within "Value" string, with the "Replace" string value.
+
+
+Replace_Czech
+synachar
+Character replace table for remove Czech diakritics.
+
+
+Replace_None
+synachar
+null character replace table. (Usable for disable charater replacing.)
+
+
+ReTablebase64
+synacode
+
+
+
+ReTableUU
+synacode
+
+
+
+ReTableXX
+synacode
+
+
+
+ReverseIP
+synaip
+Convert IPv4 address to reverse form.
+
+
+ReverseIP6
+synaip
+Convert IPv6 address to reverse form.
+
+
+Rfc822DateTime
+synautil
+Returns current time in format defined in RFC-822. Useful for SMTP messages, but other protocols use this time format as well. Results contains the timezone specification. Four digit year is used to break any Y2K concerns. (Example 'Fri, 15 Oct 1999 21:14:56 +0200')
+
+
+RPos
+synautil
+It is like POS function, but from right side of Value string.
+
+
+RPosEx
+synautil
+It is like RPos, but search is from specified possition.
+
+
+RsaGenerateKey
+ssl_openssl_lib
+
+
+
+SB1
+synaser
+stopbit value for 1 stopbit
+
+
+SB1andHalf
+synaser
+stopbit value for 1.5 stopbit
+
+
+SB2
+synaser
+stopbit value for 2 stopbits
+
+
+SearchForBoundary
+synautil
+Search ABoundary in a buffer starting at APtr. Return beginning of the ABoundary. Move APtr forward behind a trailing CRLF if any).
+
+
+SearchForLineBreak
+synautil
+Search for one of line terminators CR, LF or NUL. Return position of the line beginning and length of text.
+
+
+SendTo
+smtpsend
+A very useful function and example of its use would be found in the TSMTPsend object. Send "Maildata" (text of e-mail without any SMTP headers!) from "MailFrom" e-mail address to "MailTo" e-mail address with "Subject". (If you need more then one receiver, then separate their addresses by comma).
+
+This function constructs all needed SMTP headers (with DATE header) and sends the e-mail to the SMTP server defined in the "SMTPhost" parameter. If the e-mail message is successfully sent, the result will be True
.
+
+
If you need use different port number then standard, then add this port number to SMTPhost after colon. (i.e. '127.0.0.1:1025')
+
+
+SendToEx
+smtpsend
+A very useful function and example of its use would be found in the TSMTPsend object. Sends "MailData" (text of e-mail without any SMTP headers!) from "MailFrom" e-mail address to "MailTo" e-mail address (If you need more then one receiver, then separate their addresses by comma).
+
+This function sends the e-mail to the SMTP server defined in the "SMTPhost" parameter. Username and password are used for authorization to the "SMTPhost". If you dont want authorization, set "Username" and "Password" to empty Strings. If the e-mail message is successfully sent, the result will be True
.
+
+
If you need use different port number then standard, then add this port number to SMTPhost after colon. (i.e. '127.0.0.1:1025')
+
+
+SendToRaw
+smtpsend
+A very useful function and example of its use would be found in the TSMTPsend object. Send maildata (text of e-mail with all SMTP headers! For example when text of message is created by TMimeMess object) from "MailFrom" e-mail address to "MailTo" e-mail address (If you need more then one receiver, then separate their addresses by comma).
+
+Function sends e-mail to a SMTP server defined in "SMTPhost" parameter. Username and password are used for authorization to the "SMTPhost". If you don't want authorization, set "Username" and "Password" to empty strings. If e-mail message is successfully sent, the result returns True
.
+
+
If you need use different port number then standard, then add this port number to SMTPhost after colon. (i.e. '127.0.0.1:1025')
+
+
+SendTrap
+snmpsend
+A very useful function and example of its use would be found in the TSNMPSend object. It implements a TRAPv1 to send with all data in the parameters.
+
+
+SeparateLeft
+synautil
+Returns a portion of the "Value" string located to the left of the "Delimiter" string. If a delimiter is not found, results is original string.
+
+
+SeparateRight
+synautil
+Returns the portion of the "Value" string located to the right of the "Delimiter" string. If a delimiter is not found, results is original string.
+
+
+sErr
+synaser
+
+
+
+SetUTTime
+synautil
+Set Newdt as current system date and time in UTC timezone. This function work only if you have administrator rights!
+
+
+SHA1
+synacode
+Returns a binary string with a SHA-1 hashing of "Value" string.
+
+
+SHA1LongHash
+synacode
+Returns a binary string with a SHA-1 hashing of string what is constructed by repeating "value" until length is "Len".
+
+
+SimpleDateTime
+synautil
+Returns date and time in format defined in format 'yymmdd hhnnss'
+
+
+size_t
+synaicnv
+
+
+
+SkipLineBreak
+synautil
+Skip both line terminators CR LF (if any). Move APtr position forward.
+
+
+SkipNullLines
+synautil
+Skip all blank lines in a buffer starting at APtr and move APtr position forward.
+
+
+SkX509PopFree
+ssl_openssl_lib
+
+
+
+Sleep
+synafpc
+
+
+
+SNMPGet
+snmpsend
+A very useful function and example of its use would be found in the TSNMPSend object. It implements basic GET method of the SNMP protocol. The MIB value is located in the "OID" variable, and is sent to the requested "SNMPHost" with the proper "Community" access identifier. Upon a successful retrieval, "Value" will contain the information requested. If the SNMP operation is successful, the result returns True
.
+
+
+SNMPGetNext
+snmpsend
+A very useful function and example of its use would be found in the TSNMPSend object. It implements basic GETNEXT method of the SNMP protocol. The MIB value is located in the "OID" variable, and is sent to the requested "SNMPHost" with the proper "Community" access identifier. Upon a successful retrieval, "Value" will contain the information requested. If the SNMP operation is successful, the result returns True
.
+
+
+SNMPGetTable
+snmpsend
+A very useful function and example of its use would be found in the TSNMPSend object. It implements basic read of SNMP MIB tables. As BaseOID you must specify basic MIB OID of requested table (base IOD is OID without row and column specificator!) Table is readed into stringlist, where each string is comma delimited string.
+
+Warning: this function is not have best performance. For better performance you must write your own function. best performace you can get by knowledge of structuture of table and by more then one MIB on one query.
+
+
+SNMPGetTableElement
+snmpsend
+A very useful function and example of its use would be found in the TSNMPSend object. It implements basic read of SNMP MIB table element. As BaseOID you must specify basic MIB OID of requested table (base IOD is OID without row and column specificator!) As next you must specify identificator of row and column for specify of needed field of table.
+
+
+SNMPSet
+snmpsend
+This is useful function and example of use TSNMPSend object. It implements the basic SET method of the SNMP protocol. If the SNMP operation is successful, the result is True
. "Value" is value of MIB Oid for "SNMPHost" with "Community" access identifier. You must specify "ValueType" too.
+
+
+SNMP_V1
+snmpsend
+
+
+
+SNMP_V2C
+snmpsend
+
+
+
+SNMP_V3
+snmpsend
+
+
+
+sOK
+synaser
+
+
+
+SpecialChar
+synacode
+
+
+
+SslAccept
+ssl_openssl_lib
+
+
+
+SSLCipherGetBits
+ssl_openssl_lib
+
+
+
+SSLCipherGetName
+ssl_openssl_lib
+
+
+
+SslConnect
+ssl_openssl_lib
+
+
+
+SSLCtrl
+ssl_openssl_lib
+
+
+
+SslCtxCheckPrivateKeyFile
+ssl_openssl_lib
+
+
+
+SslCtxCtrl
+ssl_openssl_lib
+
+
+
+SslCtxFree
+ssl_openssl_lib
+
+
+
+SslCtxLoadVerifyLocations
+ssl_openssl_lib
+
+
+
+SslCtxNew
+ssl_openssl_lib
+
+
+
+SslCtxSetCipherList
+ssl_openssl_lib
+
+
+
+SslCtxSetDefaultPasswdCb
+ssl_openssl_lib
+
+
+
+SslCtxSetDefaultPasswdCbUserdata
+ssl_openssl_lib
+
+
+
+SslCtxSetVerify
+ssl_openssl_lib
+
+
+
+SslCtxUseCertificate
+ssl_openssl_lib
+
+
+
+SslCtxUseCertificateASN1
+ssl_openssl_lib
+
+
+
+SslCtxUseCertificateChainFile
+ssl_openssl_lib
+
+
+
+SslCtxUseCertificateFile
+ssl_openssl_lib
+
+
+
+SslCtxUsePrivateKey
+ssl_openssl_lib
+
+
+
+SslCtxUsePrivateKeyASN1
+ssl_openssl_lib
+
+
+
+SslCtxUsePrivateKeyFile
+ssl_openssl_lib
+
+
+
+SSLeayversion
+ssl_openssl_lib
+
+
+
+SslFree
+ssl_openssl_lib
+
+
+
+SSLGetCurrentCipher
+ssl_openssl_lib
+
+
+
+SslGetError
+ssl_openssl_lib
+
+
+
+SslGetPeerCertificate
+ssl_openssl_lib
+
+
+
+SSLGetVerifyResult
+ssl_openssl_lib
+
+
+
+SslGetVersion
+ssl_openssl_lib
+
+
+
+SSLImplementation
+blcksock
+Selected SSL plugin. Default is TSSLNone .
+
+Do not change this value directly!!!
+
+
Just add your plugin unit to your project uses instead. Each plugin unit have initialization code what modify this variable.
+
+
+SSLLibFile
+ssl_openssl_lib
+
+
+
+SSLLibHandle
+ssl_openssl_lib
+
+
+
+SslLibraryInit
+ssl_openssl_lib
+
+
+
+SslLoadErrorStrings
+ssl_openssl_lib
+
+
+
+SslMethodTLSV1
+ssl_openssl_lib
+
+
+
+SslMethodV2
+ssl_openssl_lib
+
+
+
+SslMethodV23
+ssl_openssl_lib
+
+
+
+SslMethodV3
+ssl_openssl_lib
+
+
+
+SslNew
+ssl_openssl_lib
+
+
+
+SslPeek
+ssl_openssl_lib
+
+
+
+SslPending
+ssl_openssl_lib
+
+
+
+SslPtr
+ssl_openssl_lib
+
+
+
+SslRead
+ssl_openssl_lib
+
+
+
+SslSetFd
+ssl_openssl_lib
+
+
+
+SslShutdown
+ssl_openssl_lib
+
+
+
+SSLUtilFile
+ssl_openssl_lib
+
+
+
+SSLUtilHandle
+ssl_openssl_lib
+
+
+
+SslWrite
+ssl_openssl_lib
+
+
+
+SSL_CTRL_SET_TLSEXT_HOSTNAME
+ssl_openssl_lib
+
+
+
+SSL_ERROR_NONE
+ssl_openssl_lib
+
+
+
+SSL_ERROR_SSL
+ssl_openssl_lib
+
+
+
+SSL_ERROR_SYSCALL
+ssl_openssl_lib
+
+
+
+SSL_ERROR_WANT_ACCEPT
+ssl_openssl_lib
+
+
+
+SSL_ERROR_WANT_CONNECT
+ssl_openssl_lib
+
+
+
+SSL_ERROR_WANT_READ
+ssl_openssl_lib
+
+
+
+SSL_ERROR_WANT_WRITE
+ssl_openssl_lib
+
+
+
+SSL_ERROR_WANT_X509_LOOKUP
+ssl_openssl_lib
+
+
+
+SSL_ERROR_ZERO_RETURN
+ssl_openssl_lib
+
+
+
+SSL_FILETYPE_ASN1
+ssl_openssl_lib
+
+
+
+SSL_FILETYPE_PEM
+ssl_openssl_lib
+
+
+
+SSL_OP_ALL
+ssl_openssl_lib
+
+
+
+SSL_OP_NO_SSLv2
+ssl_openssl_lib
+
+
+
+SSL_OP_NO_SSLv3
+ssl_openssl_lib
+
+
+
+SSL_OP_NO_TLSv1
+ssl_openssl_lib
+
+
+
+SSL_VERIFY_NONE
+ssl_openssl_lib
+
+
+
+SSL_VERIFY_PEER
+ssl_openssl_lib
+
+
+
+StringsTrim
+synautil
+Delete empty strings from end of stringlist.
+
+
+StringToWide
+synachar
+Convert binary string with unicode content to WideString.
+
+
+StrToHex
+synautil
+Returns a string with hexadecimal digits representing the corresponding values of the bytes found in "Value" string.
+
+
+StrToIp
+synaip
+Convert IPv4 address from their string form to binary.
+
+
+StrToIp6
+synaip
+Convert IPv6 address from their string form to binary byte array.
+
+
+SwapBytes
+synautil
+swap bytes in integer.
+
+
+SynaIconv
+synaicnv
+
+
+
+SynaIconvClose
+synaicnv
+
+
+
+SynaIconvCtl
+synaicnv
+
+
+
+SynaIconvOpen
+synaicnv
+
+
+
+SynaIconvOpenIgnore
+synaicnv
+
+
+
+SynaIconvOpenTranslit
+synaicnv
+
+
+
+SynapseRelease
+blcksock
+
+
+
+TableBase64
+synacode
+
+
+
+TableBase64mod
+synacode
+
+
+
+TableUU
+synacode
+
+
+
+TableXX
+synacode
+
+
+
+TBlockSerial
+synaser
+Main class implementing all communication routines
+
+
+TBlockSocket
+blcksock
+Basic IP object.
+
+
+TClamSend
+clamsend
+Implementation of ClamAV-daemon client protocol
+
+
+TCustomSSL
+blcksock
+Parent class for all SSL plugins.
+
+
+TDesKeyData
+synacrypt
+Datatype for holding one DES key data
+
+
+TDgramBlockSocket
+blcksock
+Datagram based communication
+
+
+TDNSSend
+dnssend
+Implementation of DNS protocol by UDP or TCP protocol.
+
+
+Test3Des
+synacrypt
+Call internal test of all 3DES encryptions. Returns True
if all is OK.
+
+
+TestAes
+synacrypt
+Call internal test of all AES encryptions. Returns True
if all is OK.
+
+
+TestDes
+synacrypt
+Call internal test of all DES encryptions. Returns True
if all is OK.
+
+
+TFTPList
+ftpsend
+This is TList of TFTPListRec objects.
+
+
+TFTPListRec
+ftpsend
+Object for holding file information
+
+
+TFTPSend
+ftpsend
+Implementation of FTP protocol.
+
+
+TFTPStatus
+ftpsend
+Procedural type for OnStatus event. Sender is calling TFTPSend object. Value is FTP command or reply to this comand. (if it is reply, Response is True
).
+
+
+THookAfterConnect
+blcksock
+This procedural type is used for hook OnAfterConnect. By this hook you can insert your code after TCP socket has been sucessfully connected.
+
+
+THookCreateSocket
+blcksock
+This procedural type is used for hook OnCreateSocket. By this hook you can insert your code after initialisation of socket. (you can set special socket options, etc.)
+
+
+THookDataFilter
+blcksock
+This procedural type is used for DataFilter hooks.
+
+
+THookHeartbeat
+blcksock
+This procedural type is used for hook OnHeartbeat. By this hook you can call your code repeately during long socket operations. You must enable heartbeats by HeartbeatRate
property!
+
+
+THookMonitor
+blcksock
+This procedural type is used for monitoring of communication.
+
+
+THookSerialReason
+synaser
+Possible status event types for THookSerialStatus
+
+
+THookSerialStatus
+synaser
+procedural prototype for status event hooking
+
+
+THookSocketReason
+blcksock
+Types of OnStatus events
+
+
+THookSocketStatus
+blcksock
+Procedural type for OnStatus event. Sender is calling TBlockSocket object, Reason is one of set Status events and value is optional data.
+
+
+THookVerifyCert
+blcksock
+This procedural type is used for hook OnVerifyCert. By this hook you can insert your additional certificate verification code. Usefull to verify server CN against URL.
+
+
+THookWalkPart
+mimepart
+Procedural type for TMimePart .WalkPart hook
+
+
+THTTPSend
+httpsend
+abstract(Implementation of HTTP protocol.)
+
+
+TickDelta
+synautil
+Return difference between two timestamps. It working fine only for differences smaller then maxint. (difference must be smaller then 24 days.)
+
+
+TICMPBlockSocket
+blcksock
+Implementation of RAW ICMP socket.
+
+
+TICMPError
+pingsend
+List of possible ICMP reply packet types.
+
+
+TIMAPSend
+imapsend
+Implementation of IMAP4 protocol.
+
+
+TimeZone
+synautil
+Return your timezone bias from UTC time in string representation like "+0200".
+
+
+TimeZoneBias
+synautil
+Return your timezone bias from UTC time in minutes.
+
+
+TIp6Bytes
+synaip
+binary form of IPv6 adress (for string conversion routines)
+
+
+TIp6Words
+synaip
+binary form of IPv6 adress (for string conversion routines)
+
+
+TIPHeader
+blcksock
+Record with definition of IP packet header.
+
+
+TLDAPAttribute
+ldapsend
+LDAP attribute with list of their values
+
+
+TLDAPAttributeList
+ldapsend
+List of TLDAPAttribute
+
+
+TLDAPModifyOp
+ldapsend
+Define possible operations for LDAP MODIFY operations.
+
+
+TLDAPResult
+ldapsend
+LDAP result object
+
+
+TLDAPResultList
+ldapsend
+List of LDAP result objects
+
+
+TLDAPSearchAliases
+ldapsend
+Specify possible values about alias dereferencing.
+
+
+TLDAPSearchScope
+ldapsend
+Specify possible values for search scope.
+
+
+TLDAPSend
+ldapsend
+Implementation of LDAP client
+
+
+TLibHandle
+synafpc
+
+
+
+TLNT_AO
+tlntsend
+
+
+
+TLNT_AYT
+tlntsend
+
+
+
+TLNT_BREAK
+tlntsend
+
+
+
+TLNT_DATA_MARK
+tlntsend
+
+
+
+TLNT_DO
+tlntsend
+
+
+
+TLNT_DONT
+tlntsend
+
+
+
+TLNT_EC
+tlntsend
+
+
+
+TLNT_EL
+tlntsend
+
+
+
+TLNT_EOR
+tlntsend
+
+
+
+TLNT_GA
+tlntsend
+
+
+
+TLNT_IAC
+tlntsend
+
+
+
+TLNT_IP
+tlntsend
+
+
+
+TLNT_NOP
+tlntsend
+
+
+
+TLNT_SB
+tlntsend
+
+
+
+TLNT_SE
+tlntsend
+
+
+
+TLNT_WILL
+tlntsend
+
+
+
+TLNT_WONT
+tlntsend
+
+
+
+TLogonActions
+ftpsend
+Array for holding definition of logon sequence.
+
+
+TLSEXT_NAMETYPE_host_name
+ssl_openssl_lib
+
+
+
+TMessHeader
+mimemess
+Object for basic e-mail header fields.
+
+
+TMessHeaderClass
+mimemess
+
+
+
+TMessPriority
+mimemess
+Possible values for message priority
+
+
+TMimeChar
+synachar
+Type with all supported charsets.
+
+
+TMimeEncoding
+mimepart
+The various types of possible part encodings.
+
+
+TMimeMess
+mimemess
+Object for handling of e-mail message.
+
+
+TMimePart
+mimepart
+Object for working with parts of MIME e-mail.
+
+
+TMimePrimary
+mimepart
+The four types of MIME parts. (textual, multipart, message or any other binary data.)
+
+
+TMimeSetChar
+synachar
+Set of any charsets.
+
+
+TNNTPSend
+nntpsend
+abstract(Implementation of Network News Transfer Protocol.
+
+Note: Are you missing properties for setting Username and Password? Look to parent TSynaClient object!
+
+
Are you missing properties for specify server address and port? Look to parent TSynaClient too!
+
+
+TNtp
+sntpsend
+Record containing the NTP packet.
+
+
+ToSysLog
+slogsend
+Simply send packet to specified Syslog server.
+
+
+TPGMMessageBlockSocket
+blcksock
+Implementation of PGM-message socket.
+
+
+TPGMStreamBlockSocket
+blcksock
+Implementation of PGM-stream socket.
+
+
+TPINGSend
+pingsend
+Implementation of ICMP PING and ICMPv6 PING.
+
+
+TPOP3AuthType
+pop3send
+The three types of possible authorization methods for "logging in" to a POP3 server.
+
+
+TPOP3Send
+pop3send
+Implementation of POP3 client protocol.
+
+
+TProxySetting
+synamisc
+This record contains information about proxy setting.
+
+
+TraceRouteHost
+pingsend
+A very useful function and example of its use would be found in the TPINGSend object. Use it to TraceRoute to any host.
+
+
+TRAWBlockSocket
+blcksock
+Implementation of RAW socket.
+
+
+TrimSP
+synautil
+Like Trim, but remove only spaces, not control characters!
+
+
+TrimSPLeft
+synautil
+Like TrimLeft, but remove only spaces, not control characters!
+
+
+TrimSPRight
+synautil
+Like TrimRight, but remove only spaces, not control characters!
+
+
+TSkPopFreeFunc
+ssl_openssl_lib
+
+
+
+TSMTPSend
+smtpsend
+Implementation of SMTP and ESMTP procotol
+
+
+TSNMPMib
+snmpsend
+Data object with one record of MIB OID and corresponding values.
+
+
+TSNMPRec
+snmpsend
+Data object abstracts SNMP data packet
+
+
+TSNMPSend
+snmpsend
+Implementation of SNMP protocol.
+
+
+TSNTPSend
+sntpsend
+Implementation of NTP and SNTP client protocol
+
+
+TSocketFamily
+blcksock
+Specify family of socket.
+
+
+TSocksBlockSocket
+blcksock
+Support for SOCKS4 and SOCKS5 proxy
+
+
+TSocksType
+blcksock
+specify possible values of SOCKS modes.
+
+
+TSpecials
+synacode
+
+
+
+TSSLClass
+blcksock
+
+
+
+TSSLCryptLib
+ssl_cryptlib
+class implementing CryptLib SSL/SSH plugin.
+
+
+TSSLNone
+blcksock
+Default SSL plugin with no SSL support.
+
+
+TSSLOpenSSL
+ssl_openssl
+class implementing OpenSSL SSL plugin.
+
+
+TSSLSBB
+ssl_sbb
+class implementing SecureBlackbox SSL plugin.
+
+
+TSSLStreamSec
+ssl_streamsec
+class implementing StreamSecII SSL plugin.
+
+
+TSSLType
+blcksock
+Specify requested SSL/TLS version for secure connection.
+
+
+TSyna3Des
+synacrypt
+Implementation of 3DES encryption
+
+
+TSynaAes
+synacrypt
+Implementation of AES encryption
+
+
+TSynaBlockCipher
+synacrypt
+Implementation of common routines block ciphers (dafault size is 64-bits)
+
+
+TSynaClient
+blcksock
+Parent class of application protocol implementations.
+
+
+TSynaCustomDes
+synacrypt
+Implementation of common routines for DES encryption
+
+
+TSynaDebug
+synadbg
+
+
+
+TSynaDes
+synacrypt
+Implementation of DES encryption
+
+
+TSynaOption
+blcksock
+this object is used for remember delayed socket option set.
+
+
+TSynaOptionType
+blcksock
+Specify type of socket delayed option.
+
+
+TSyslogMessage
+slogsend
+encoding or decoding of SYSLOG message
+
+
+TSyslogSend
+slogsend
+This object implement BSD SysLog client
+
+
+TSyslogSeverity
+slogsend
+Define possible priority of Syslog message
+
+
+TTCPBlockSocket
+blcksock
+Implementation of TCP socket.
+
+
+TTelnetSend
+tlntsend
+Class with implementation of Telnet/SSH script client.
+
+
+TTelnetState
+tlntsend
+State of telnet protocol
+
+
+TTFTPSend
+ftptsend
+Implementation of TFTP client and server
+
+
+TTransferEncoding
+httpsend
+These encoding types are used internally by the THTTPSend object to identify the transfer data types.
+
+
+TUDPBlockSocket
+blcksock
+Implementation of UDP socket.
+
+
+TV3Auth
+snmpsend
+Type of SNMPv3 authorization
+
+
+TV3Flags
+snmpsend
+Possible values for SNMPv3 flags.
+
+
+TV3Priv
+snmpsend
+Type of SNMPv3 privacy
+
+
+TV3Sync
+snmpsend
+It holding all information for SNMPv3 agent synchronization
+
+
+TX509Free
+ssl_openssl_lib
+
+
+
+UnquoteStr
+synautil
+Remove quotation from Value string. If Value is not quoted, then return same string without any modification.
+
+
+UpdateCrc16
+synacode
+Returns a new CRC16 value after adding a new byte of data.
+
+
+UpdateCrc32
+synacode
+Returns a new CRC32 value after adding a new byte of data.
+
+
+URLFullSpecialChar
+synacode
+
+
+
+URLSpecialChar
+synacode
+
+
+
+WakeOnLan
+synamisc
+By this function you can turn-on computer on network, if this computer supporting Wake-on-lan feature. You need MAC number (network card indentifier) of computer for turn-on. You can also assign target IP addres. If you not specify it, then is used broadcast for delivery magic wake-on packet. However broadcasts workinh only on your local network. When you need to wake-up computer on another network, you must specify any existing IP addres on same network segment as targeting computer.
+
+
+WideToString
+synachar
+Convert WideString to binary string with unicode content.
+
+
+WriteStrToStream
+synautil
+write string to stream.
+
+
+X509Digest
+ssl_openssl_lib
+
+
+
+X509Free
+ssl_openssl_lib
+
+
+
+X509GetIssuerName
+ssl_openssl_lib
+
+
+
+X509GetSerialNumber
+ssl_openssl_lib
+
+
+
+X509GetSubjectName
+ssl_openssl_lib
+
+
+
+X509GmtimeAdj
+ssl_openssl_lib
+
+
+
+X509NameAddEntryByTxt
+ssl_openssl_lib
+
+
+
+X509NameHash
+ssl_openssl_lib
+
+
+
+X509NameOneline
+ssl_openssl_lib
+
+
+
+X509New
+ssl_openssl_lib
+
+
+
+X509print
+ssl_openssl_lib
+
+
+
+X509SetIssuerName
+ssl_openssl_lib
+
+
+
+X509SetNotAfter
+ssl_openssl_lib
+
+
+
+X509SetNotBefore
+ssl_openssl_lib
+
+
+
+X509SetPubkey
+ssl_openssl_lib
+
+
+
+X509SetVersion
+ssl_openssl_lib
+
+
+
+X509Sign
+ssl_openssl_lib
+
+
+
+X509_V_ERR_AKID_ISSUER_SERIAL_MISMATCH
+ssl_openssl_lib
+
+
+
+X509_V_ERR_AKID_SKID_MISMATCH
+ssl_openssl_lib
+
+
+
+X509_V_ERR_APPLICATION_VERIFICATION
+ssl_openssl_lib
+
+
+
+X509_V_ERR_CERT_CHAIN_TOO_LONG
+ssl_openssl_lib
+
+
+
+X509_V_ERR_CERT_HAS_EXPIRED
+ssl_openssl_lib
+
+
+
+X509_V_ERR_CERT_NOT_YET_VALID
+ssl_openssl_lib
+
+
+
+X509_V_ERR_CERT_REJECTED
+ssl_openssl_lib
+
+
+
+X509_V_ERR_CERT_REVOKED
+ssl_openssl_lib
+
+
+
+X509_V_ERR_CERT_SIGNATURE_FAILURE
+ssl_openssl_lib
+
+
+
+X509_V_ERR_CERT_UNTRUSTED
+ssl_openssl_lib
+
+
+
+X509_V_ERR_CRL_HAS_EXPIRED
+ssl_openssl_lib
+
+
+
+X509_V_ERR_CRL_NOT_YET_VALID
+ssl_openssl_lib
+
+
+
+X509_V_ERR_CRL_SIGNATURE_FAILURE
+ssl_openssl_lib
+
+
+
+X509_V_ERR_DEPTH_ZERO_SELF_SIGNED_CERT
+ssl_openssl_lib
+
+
+
+X509_V_ERR_ERROR_IN_CERT_NOT_AFTER_FIELD
+ssl_openssl_lib
+
+
+
+X509_V_ERR_ERROR_IN_CERT_NOT_BEFORE_FIELD
+ssl_openssl_lib
+
+
+
+X509_V_ERR_ERROR_IN_CRL_LAST_UPDATE_FIELD
+ssl_openssl_lib
+
+
+
+X509_V_ERR_ERROR_IN_CRL_NEXT_UPDATE_FIELD
+ssl_openssl_lib
+
+
+
+X509_V_ERR_INVALID_CA
+ssl_openssl_lib
+
+
+
+X509_V_ERR_INVALID_PURPOSE
+ssl_openssl_lib
+
+
+
+X509_V_ERR_KEYUSAGE_NO_CERTSIGN
+ssl_openssl_lib
+
+
+
+X509_V_ERR_OUT_OF_MEM
+ssl_openssl_lib
+
+
+
+X509_V_ERR_PATH_LENGTH_EXCEEDED
+ssl_openssl_lib
+
+
+
+X509_V_ERR_SELF_SIGNED_CERT_IN_CHAIN
+ssl_openssl_lib
+
+
+
+X509_V_ERR_SUBJECT_ISSUER_MISMATCH
+ssl_openssl_lib
+
+
+
+X509_V_ERR_UNABLE_TO_DECODE_ISSUER_PUBLIC_KEY
+ssl_openssl_lib
+
+
+
+X509_V_ERR_UNABLE_TO_DECRYPT_CERT_SIGNATURE
+ssl_openssl_lib
+
+
+
+X509_V_ERR_UNABLE_TO_DECRYPT_CRL_SIGNATURE
+ssl_openssl_lib
+
+
+
+X509_V_ERR_UNABLE_TO_GET_CRL
+ssl_openssl_lib
+
+
+
+X509_V_ERR_UNABLE_TO_GET_CRL_ISSUER
+ssl_openssl_lib
+
+
+
+X509_V_ERR_UNABLE_TO_GET_ISSUER_CERT
+ssl_openssl_lib
+
+
+
+X509_V_ERR_UNABLE_TO_GET_ISSUER_CERT_LOCALLY
+ssl_openssl_lib
+
+
+
+X509_V_ERR_UNABLE_TO_VERIFY_LEAF_SIGNATURE
+ssl_openssl_lib
+
+
+
+X509_V_ERR_UNHANDLED_CRITICAL_EXTENSION
+ssl_openssl_lib
+
+
+
+X509_V_ILLEGAL
+ssl_openssl_lib
+
+
+
+X509_V_OK
+ssl_openssl_lib
+
+
+
+XorString
+synautil
+XOR each byte in the strings
+
+
+_X509Free
+ssl_openssl_lib
+
+
+
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:53
+
+
ADDED lib/synapse/docs/help/AllTypes.html
Index: lib/synapse/docs/help/AllTypes.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/AllTypes.html
@@ -0,0 +1,355 @@
+
+
+
+
+
+All Types
+
+
+
+All Types
+
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:52
+
+
ADDED lib/synapse/docs/help/AllUnits.html
Index: lib/synapse/docs/help/AllUnits.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/AllUnits.html
@@ -0,0 +1,163 @@
+
+
+
+
+
+All Units
+
+
+
+All Units
+
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:52
+
+
ADDED lib/synapse/docs/help/AllVariables.html
Index: lib/synapse/docs/help/AllVariables.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/AllVariables.html
@@ -0,0 +1,94 @@
+
+
+
+
+
+All Variables
+
+
+
+All Variables
+
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:53
+
+
ADDED lib/synapse/docs/help/ClassHierarchy.html
Index: lib/synapse/docs/help/ClassHierarchy.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/ClassHierarchy.html
@@ -0,0 +1,45 @@
+
+
+
+
+
+Class Hierarchy
+
+
+
+Class Hierarchy
+
+Exception
+
+TObject
+
+TStringList
+
+
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:52
+
+
ADDED lib/synapse/docs/help/GVClasses.dot
Index: lib/synapse/docs/help/GVClasses.dot
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/GVClasses.dot
@@ -0,0 +1,108 @@
+DiGraph Classes {
+ ESynapseError -> Exception
+ ESynapseError [href="blcksock.ESynapseError.html"]
+ ESynaSerError -> Exception
+ ESynaSerError [href="synaser.ESynaSerError.html"]
+ TBlockSerial -> TObject
+ TBlockSerial [href="synaser.TBlockSerial.html"]
+ TBlockSocket -> TObject
+ TBlockSocket [href="blcksock.TBlockSocket.html"]
+ TPGMMessageBlockSocket -> TBlockSocket
+ TPGMMessageBlockSocket [href="blcksock.TPGMMessageBlockSocket.html"]
+ TPGMStreamBlockSocket -> TBlockSocket
+ TPGMStreamBlockSocket [href="blcksock.TPGMStreamBlockSocket.html"]
+ TRAWBlockSocket -> TBlockSocket
+ TRAWBlockSocket [href="blcksock.TRAWBlockSocket.html"]
+ TSocksBlockSocket -> TBlockSocket
+ TSocksBlockSocket [href="blcksock.TSocksBlockSocket.html"]
+ TDgramBlockSocket -> TSocksBlockSocket
+ TDgramBlockSocket [href="blcksock.TDgramBlockSocket.html"]
+ TICMPBlockSocket -> TDgramBlockSocket
+ TICMPBlockSocket [href="blcksock.TICMPBlockSocket.html"]
+ TUDPBlockSocket -> TDgramBlockSocket
+ TUDPBlockSocket [href="blcksock.TUDPBlockSocket.html"]
+ TTCPBlockSocket -> TSocksBlockSocket
+ TTCPBlockSocket [href="blcksock.TTCPBlockSocket.html"]
+ TCustomSSL -> TObject
+ TCustomSSL [href="blcksock.TCustomSSL.html"]
+ TSSLCryptLib -> TCustomSSL
+ TSSLCryptLib [href="ssl_cryptlib.TSSLCryptLib.html"]
+ TSSLNone -> TCustomSSL
+ TSSLNone [href="blcksock.TSSLNone.html"]
+ TSSLOpenSSL -> TCustomSSL
+ TSSLOpenSSL [href="ssl_openssl.TSSLOpenSSL.html"]
+ TSSLSBB -> TCustomSSL
+ TSSLSBB [href="ssl_sbb.TSSLSBB.html"]
+ TSSLStreamSec -> TCustomSSL
+ TSSLStreamSec [href="ssl_streamsec.TSSLStreamSec.html"]
+ TFTPList -> TObject
+ TFTPList [href="ftpsend.TFTPList.html"]
+ TFTPListRec -> TObject
+ TFTPListRec [href="ftpsend.TFTPListRec.html"]
+ TLDAPAttributeList -> TObject
+ TLDAPAttributeList [href="ldapsend.TLDAPAttributeList.html"]
+ TLDAPResult -> TObject
+ TLDAPResult [href="ldapsend.TLDAPResult.html"]
+ TLDAPResultList -> TObject
+ TLDAPResultList [href="ldapsend.TLDAPResultList.html"]
+ TMessHeader -> TObject
+ TMessHeader [href="mimemess.TMessHeader.html"]
+ TMimeMess -> TObject
+ TMimeMess [href="mimemess.TMimeMess.html"]
+ TMimePart -> TObject
+ TMimePart [href="mimepart.TMimePart.html"]
+ TSNMPMib -> TObject
+ TSNMPMib [href="snmpsend.TSNMPMib.html"]
+ TSNMPRec -> TObject
+ TSNMPRec [href="snmpsend.TSNMPRec.html"]
+ TSynaBlockCipher -> TObject
+ TSynaBlockCipher [href="synacrypt.TSynaBlockCipher.html"]
+ TSynaAes -> TSynaBlockCipher
+ TSynaAes [href="synacrypt.TSynaAes.html"]
+ TSynaCustomDes -> TSynaBlockCipher
+ TSynaCustomDes [href="synacrypt.TSynaCustomDes.html"]
+ TSyna3Des -> TSynaCustomDes
+ TSyna3Des [href="synacrypt.TSyna3Des.html"]
+ TSynaDes -> TSynaCustomDes
+ TSynaDes [href="synacrypt.TSynaDes.html"]
+ TSynaClient -> TObject
+ TSynaClient [href="blcksock.TSynaClient.html"]
+ TClamSend -> TSynaClient
+ TClamSend [href="clamsend.TClamSend.html"]
+ TDNSSend -> TSynaClient
+ TDNSSend [href="dnssend.TDNSSend.html"]
+ TFTPSend -> TSynaClient
+ TFTPSend [href="ftpsend.TFTPSend.html"]
+ THTTPSend -> TSynaClient
+ THTTPSend [href="httpsend.THTTPSend.html"]
+ TIMAPSend -> TSynaClient
+ TIMAPSend [href="imapsend.TIMAPSend.html"]
+ TLDAPSend -> TSynaClient
+ TLDAPSend [href="ldapsend.TLDAPSend.html"]
+ TNNTPSend -> TSynaClient
+ TNNTPSend [href="nntpsend.TNNTPSend.html"]
+ TPINGSend -> TSynaClient
+ TPINGSend [href="pingsend.TPINGSend.html"]
+ TPOP3Send -> TSynaClient
+ TPOP3Send [href="pop3send.TPOP3Send.html"]
+ TSMTPSend -> TSynaClient
+ TSMTPSend [href="smtpsend.TSMTPSend.html"]
+ TSNMPSend -> TSynaClient
+ TSNMPSend [href="snmpsend.TSNMPSend.html"]
+ TSNTPSend -> TSynaClient
+ TSNTPSend [href="sntpsend.TSNTPSend.html"]
+ TSyslogSend -> TSynaClient
+ TSyslogSend [href="slogsend.TSyslogSend.html"]
+ TTelnetSend -> TSynaClient
+ TTelnetSend [href="tlntsend.TTelnetSend.html"]
+ TTFTPSend -> TSynaClient
+ TTFTPSend [href="ftptsend.TTFTPSend.html"]
+ TSynaDebug -> TObject
+ TSynaDebug [href="synadbg.TSynaDebug.html"]
+ TSynaOption -> TObject
+ TSynaOption [href="blcksock.TSynaOption.html"]
+ TSyslogMessage -> TObject
+ TSyslogMessage [href="slogsend.TSyslogMessage.html"]
+ TLDAPAttribute -> TStringList
+ TLDAPAttribute [href="ldapsend.TLDAPAttribute.html"]
+}
ADDED lib/synapse/docs/help/GVClasses.gif
Index: lib/synapse/docs/help/GVClasses.gif
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/GVClasses.gif
cannot compute difference between binary files
ADDED lib/synapse/docs/help/GVUses.dot
Index: lib/synapse/docs/help/GVUses.dot
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/GVUses.dot
@@ -0,0 +1,170 @@
+DiGraph Uses {
+ asn1util -> synautil
+ asn1util [href="asn1util.html"]
+ blcksock -> synafpc
+ blcksock -> synsock
+ blcksock -> synautil
+ blcksock -> synacode
+ blcksock -> synaip
+ blcksock [href="blcksock.html"]
+ clamsend -> synsock
+ clamsend -> blcksock
+ clamsend -> synautil
+ clamsend [href="clamsend.html"]
+ dnssend -> blcksock
+ dnssend -> synautil
+ dnssend -> synaip
+ dnssend -> synsock
+ dnssend [href="dnssend.html"]
+ ftpsend -> blcksock
+ ftpsend -> synautil
+ ftpsend -> synaip
+ ftpsend -> synsock
+ ftpsend [href="ftpsend.html"]
+ ftptsend -> blcksock
+ ftptsend -> synautil
+ ftptsend [href="ftptsend.html"]
+ httpsend -> blcksock
+ httpsend -> synautil
+ httpsend -> synaip
+ httpsend -> synacode
+ httpsend -> synsock
+ httpsend [href="httpsend.html"]
+ imapsend -> blcksock
+ imapsend -> synautil
+ imapsend [href="imapsend.html"]
+ laz_synapse -> asn1util
+ laz_synapse -> blcksock
+ laz_synapse -> clamsend
+ laz_synapse -> dnssend
+ laz_synapse -> ftpsend
+ laz_synapse -> ftptsend
+ laz_synapse -> httpsend
+ laz_synapse -> imapsend
+ laz_synapse -> ldapsend
+ laz_synapse -> mimeinln
+ laz_synapse -> mimemess
+ laz_synapse -> mimepart
+ laz_synapse -> nntpsend
+ laz_synapse -> pingsend
+ laz_synapse -> pop3send
+ laz_synapse -> slogsend
+ laz_synapse -> smtpsend
+ laz_synapse -> snmpsend
+ laz_synapse -> sntpsend
+ laz_synapse -> synachar
+ laz_synapse -> synacode
+ laz_synapse -> synacrypt
+ laz_synapse -> synadbg
+ laz_synapse -> synafpc
+ laz_synapse -> synaicnv
+ laz_synapse -> synaip
+ laz_synapse -> synamisc
+ laz_synapse -> synaser
+ laz_synapse -> synautil
+ laz_synapse -> synsock
+ laz_synapse -> tlntsend
+ laz_synapse [href="laz_synapse.html"]
+ ldapsend -> blcksock
+ ldapsend -> synautil
+ ldapsend -> asn1util
+ ldapsend -> synacode
+ ldapsend [href="ldapsend.html"]
+ mimeinln -> synachar
+ mimeinln -> synacode
+ mimeinln -> synautil
+ mimeinln [href="mimeinln.html"]
+ mimemess -> mimepart
+ mimemess -> synachar
+ mimemess -> synautil
+ mimemess -> mimeinln
+ mimemess [href="mimemess.html"]
+ mimepart -> synafpc
+ mimepart -> synachar
+ mimepart -> synacode
+ mimepart -> synautil
+ mimepart -> mimeinln
+ mimepart [href="mimepart.html"]
+ nntpsend -> blcksock
+ nntpsend -> synautil
+ nntpsend [href="nntpsend.html"]
+ pingsend -> synsock
+ pingsend -> blcksock
+ pingsend -> synautil
+ pingsend -> synafpc
+ pingsend -> synaip
+ pingsend [href="pingsend.html"]
+ pop3send -> blcksock
+ pop3send -> synautil
+ pop3send -> synacode
+ pop3send [href="pop3send.html"]
+ slogsend -> blcksock
+ slogsend -> synautil
+ slogsend [href="slogsend.html"]
+ smtpsend -> blcksock
+ smtpsend -> synautil
+ smtpsend -> synacode
+ smtpsend [href="smtpsend.html"]
+ snmpsend -> blcksock
+ snmpsend -> synautil
+ snmpsend -> asn1util
+ snmpsend -> synaip
+ snmpsend -> synacode
+ snmpsend -> synacrypt
+ snmpsend [href="snmpsend.html"]
+ sntpsend -> synsock
+ sntpsend -> blcksock
+ sntpsend -> synautil
+ sntpsend [href="sntpsend.html"]
+ ssl_cryptlib -> blcksock
+ ssl_cryptlib -> synsock
+ ssl_cryptlib -> synautil
+ ssl_cryptlib -> synacode
+ ssl_cryptlib [href="ssl_cryptlib.html"]
+ ssl_openssl -> blcksock
+ ssl_openssl -> synsock
+ ssl_openssl -> synautil
+ ssl_openssl -> ssl_openssl_lib
+ ssl_openssl [href="ssl_openssl.html"]
+ ssl_openssl_lib -> synafpc
+ ssl_openssl_lib [href="ssl_openssl_lib.html"]
+ ssl_sbb -> blcksock
+ ssl_sbb -> synsock
+ ssl_sbb -> synautil
+ ssl_sbb -> synacode
+ ssl_sbb [href="ssl_sbb.html"]
+ ssl_streamsec -> blcksock
+ ssl_streamsec -> synsock
+ ssl_streamsec -> synautil
+ ssl_streamsec -> synacode
+ ssl_streamsec [href="ssl_streamsec.html"]
+ synachar -> synautil
+ synachar -> synacode
+ synachar -> synaicnv
+ synachar [href="synachar.html"]
+ synacode [href="synacode.html"]
+ synacrypt -> synautil
+ synacrypt -> synafpc
+ synacrypt [href="synacrypt.html"]
+ synadbg -> blcksock
+ synadbg -> synsock
+ synadbg -> synautil
+ synadbg -> synafpc
+ synadbg [href="synadbg.html"]
+ synafpc [href="synafpc.html"]
+ synaicnv -> synafpc
+ synaicnv [href="synaicnv.html"]
+ synaip -> SynaUtil
+ synaip [href="synaip.html"]
+ synamisc -> synautil
+ synamisc -> blcksock
+ synamisc [href="synamisc.html"]
+ synaser -> synafpc
+ synaser -> synautil
+ synaser [href="synaser.html"]
+ synautil -> SynaFpc
+ synautil [href="synautil.html"]
+ tlntsend -> blcksock
+ tlntsend -> synautil
+ tlntsend [href="tlntsend.html"]
+}
ADDED lib/synapse/docs/help/GVUses.gif
Index: lib/synapse/docs/help/GVUses.gif
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/GVUses.gif
cannot compute difference between binary files
ADDED lib/synapse/docs/help/_tipue_results.html
Index: lib/synapse/docs/help/_tipue_results.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/_tipue_results.html
@@ -0,0 +1,51 @@
+
+
+
+
+Search Results
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
ADDED lib/synapse/docs/help/asn1util.html
Index: lib/synapse/docs/help/asn1util.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/asn1util.html
@@ -0,0 +1,260 @@
+
+
+
+
+
+asn1util
+
+
+
+Unit asn1util
+
+Description
+
+Utilities for handling ASN.1 BER encoding
+
+ By this unit you can parse ASN.1 BER encoded data to elements or build back any elements to ASN.1 BER encoded buffer. You can dump ASN.1 BER encoded data to human readable form for easy debugging, too.
+
+
Supported element types are: ASN1_BOOL, ASN1_INT, ASN1_OCTSTR, ASN1_NULL, ASN1_OBJID, ASN1_ENUM, ASN1_SEQ, ASN1_SETOF, ASN1_IPADDR, ASN1_COUNTER, ASN1_GAUGE, ASN1_TIMETICKS, ASN1_OPAQUE
+
+
For sample of using, look to TSNMPSend or TLDAPSend class.
+uses
+Overview
+Functions and Procedures
+
+
+function ASNEncOIDItem (Value: Integer): AnsiString;
+
+
+function ASNDecOIDItem (var Start: Integer; const Buffer: AnsiString): Integer;
+
+
+function ASNEncLen (Len: Integer): AnsiString;
+
+
+function ASNDecLen (var Start: Integer; const Buffer: AnsiString): Integer;
+
+
+function ASNEncInt (Value: Integer): AnsiString;
+
+
+function ASNEncUInt (Value: Integer): AnsiString;
+
+
+function ASNObject (const Data: AnsiString; ASNType: Integer): AnsiString;
+
+
+function ASNItem (var Start: Integer; const Buffer: AnsiString; var ValueType: Integer): AnsiString;
+
+
+function MibToId (Mib: String): AnsiString;
+
+
+function IdToMib (const Id: AnsiString): String;
+
+
+function IntMibToStr (const Value: AnsiString): AnsiString;
+
+
+function ASNdump (const Value: AnsiString): AnsiString;
+
+
+Constants
+
+Description
+Functions and Procedures
+
+
+function ASNEncOIDItem (Value: Integer): AnsiString;
+
+
+
+Encodes OID item to binary form.
+
+
+function ASNDecOIDItem (var Start: Integer; const Buffer: AnsiString): Integer;
+
+
+
+Decodes an OID item of the next element in the "Buffer" from the "Start" position.
+
+
+function ASNEncLen (Len: Integer): AnsiString;
+
+
+
+Encodes the length of ASN.1 element to binary.
+
+
+function ASNDecLen (var Start: Integer; const Buffer: AnsiString): Integer;
+
+
+
+Decodes length of next element in "Buffer" from the "Start" position.
+
+
+function ASNEncInt (Value: Integer): AnsiString;
+
+
+
+Encodes a signed integer to ASN.1 binary
+
+
+function ASNEncUInt (Value: Integer): AnsiString;
+
+
+
+Encodes unsigned integer into ASN.1 binary
+
+
+function ASNObject (const Data: AnsiString; ASNType: Integer): AnsiString;
+
+
+
+Encodes ASN.1 object to binary form.
+
+
+function ASNItem (var Start: Integer; const Buffer: AnsiString; var ValueType: Integer): AnsiString;
+
+
+
+Beginning with the "Start" position, decode the ASN.1 item of the next element in "Buffer". Type of item is stored in "ValueType."
+
+
+function MibToId (Mib: String): AnsiString;
+
+
+
+Encodes an MIB OID string to binary form.
+
+
+function IdToMib (const Id: AnsiString): String;
+
+
+
+Decodes MIB OID from binary form to string form.
+
+
+function IntMibToStr (const Value: AnsiString): AnsiString;
+
+
+
+Encodes an one number from MIB OID to binary form. (used internally from MibToId )
+
+
+function ASNdump (const Value: AnsiString): AnsiString;
+
+
+
+Convert ASN.1 BER encoded buffer to human readable form for debugging.
+Constants
+
+
+
+
+ASN1_OCTSTR = $04;
+
+
+
+
+
+
+
+
+
+ASN1_IPADDR = $40;
+
+
+
+
+ASN1_COUNTER = $41;
+
+
+
+
+
+ASN1_TIMETICKS = $43;
+
+
+
+
+ASN1_OPAQUE = $44;
+
+
+ Generated by PasDoc 0.9.0 on 2012-04-23 21:38:50
+
+
ADDED lib/synapse/docs/help/automated.gif
Index: lib/synapse/docs/help/automated.gif
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/automated.gif
cannot compute difference between binary files
ADDED lib/synapse/docs/help/blcksock.ESynapseError.html
Index: lib/synapse/docs/help/blcksock.ESynapseError.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/blcksock.ESynapseError.html
@@ -0,0 +1,59 @@
+
+
+
+
+
+blcksock: Class ESynapseError
+
+
+
+Class ESynapseError
+
+Unit
+
+blcksock
+Declaration
+
+type ESynapseError = class(Exception)
+Description
+
+Exception clas used by Synapse
+
+ When you enable generating of exceptions, this exception is raised by Synapse's units.
+Hierarchy
+Overview
+Properties
+
+
+
+property ErrorCode : Integer read FErrorCode Write FErrorCode;
+
+
+
+property ErrorMessage : string read FErrorMessage Write FErrorMessage;
+
+
+Description
+Properties
+
+
+
+property ErrorCode : Integer read FErrorCode Write FErrorCode;
+
+
+
+Code of error. Value depending on used operating system
+
+
+
+property ErrorMessage : string read FErrorMessage Write FErrorMessage;
+
+
+
+Human readable description of error.
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:50
+
+
ADDED lib/synapse/docs/help/blcksock.TBlockSocket.html
Index: lib/synapse/docs/help/blcksock.TBlockSocket.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/blcksock.TBlockSocket.html
@@ -0,0 +1,1307 @@
+
+
+
+
+
+blcksock: Class TBlockSocket
+
+
+
+Class TBlockSocket
+
+Unit
+
+blcksock
+Declaration
+
+type TBlockSocket = class(TObject)
+Description
+
+Basic IP object.
+
+ This is parent class for other class with protocol implementations. Do not use this class directly! Use TICMPBlockSocket , TRAWBlockSocket , TTCPBlockSocket or TUDPBlockSocket instead.
+Hierarchy
+Overview
+Methods
+
+
+
+constructor Create ;
+
+
+
+constructor CreateAlternate (Stub: string);
+
+
+
+destructor Destroy ; override;
+
+
+
+procedure CreateSocket ;
+
+
+
+procedure CreateSocketByName (const Value: String);
+
+
+
+procedure CloseSocket ; virtual;
+
+
+
+procedure AbortSocket ; virtual;
+
+
+
+procedure Bind (IP, Port: string);
+
+
+
+procedure Connect (IP, Port: string); virtual;
+
+
+
+procedure Listen ; virtual;
+
+
+
+function Accept : TSocket; virtual;
+
+
+
+function SendBuffer (Buffer: Tmemory; Length: Integer): Integer; virtual;
+
+
+
+procedure SendByte (Data: Byte); virtual;
+
+
+
+procedure SendString (Data: AnsiString); virtual;
+
+
+
+procedure SendInteger (Data: integer); virtual;
+
+
+
+procedure SendBlock (const Data: AnsiString); virtual;
+
+
+
+procedure SendStreamRaw (const Stream: TStream); virtual;
+
+
+
+procedure SendStream (const Stream: TStream); virtual;
+
+
+
+procedure SendStreamIndy (const Stream: TStream); virtual;
+
+
+
+function RecvBuffer (Buffer: TMemory; Length: Integer): Integer; virtual;
+
+
+
+function RecvBufferEx (Buffer: Tmemory; Len: Integer; Timeout: Integer): Integer; virtual;
+
+
+
+function RecvBufferStr (Len: Integer; Timeout: Integer): AnsiString; virtual;
+
+
+
+function RecvByte (Timeout: Integer): Byte; virtual;
+
+
+
+function RecvInteger (Timeout: Integer): Integer; virtual;
+
+
+
+function RecvString (Timeout: Integer): AnsiString; virtual;
+
+
+
+function RecvTerminated (Timeout: Integer; const Terminator: AnsiString): AnsiString; virtual;
+
+
+
+function RecvPacket (Timeout: Integer): AnsiString; virtual;
+
+
+
+function RecvBlock (Timeout: Integer): AnsiString; virtual;
+
+
+
+procedure RecvStreamRaw (const Stream: TStream; Timeout: Integer); virtual;
+
+
+
+procedure RecvStreamSize (const Stream: TStream; Timeout: Integer; Size: Integer);
+
+
+
+procedure RecvStream (const Stream: TStream; Timeout: Integer); virtual;
+
+
+
+procedure RecvStreamIndy (const Stream: TStream; Timeout: Integer); virtual;
+
+
+
+function PeekBuffer (Buffer: TMemory; Length: Integer): Integer; virtual;
+
+
+
+function PeekByte (Timeout: Integer): Byte; virtual;
+
+
+
+function WaitingData : Integer; virtual;
+
+
+
+function WaitingDataEx : Integer;
+
+
+
+procedure Purge ;
+
+
+
+procedure SetLinger (Enable: Boolean; Linger: Integer);
+
+
+
+procedure GetSinLocal ;
+
+
+
+procedure GetSinRemote ;
+
+
+
+procedure GetSins ;
+
+
+
+procedure ResetLastError ;
+
+
+
+function SockCheck (SockResult: Integer): Integer; virtual;
+
+
+
+procedure ExceptCheck ;
+
+
+
+function LocalName : string;
+
+
+
+procedure ResolveNameToIP (Name: string; const IPList: TStrings);
+
+
+
+function ResolveName (Name: string): string;
+
+
+
+function ResolveIPToName (IP: string): string;
+
+
+
+function ResolvePort (Port: string): Word;
+
+
+
+procedure SetRemoteSin (IP, Port: string);
+
+
+
+function GetLocalSinIP : string; virtual;
+
+
+
+function GetRemoteSinIP : string; virtual;
+
+
+
+function GetLocalSinPort : Integer; virtual;
+
+
+
+function GetRemoteSinPort : Integer; virtual;
+
+
+
+function CanRead (Timeout: Integer): Boolean; virtual;
+
+
+
+function CanReadEx (Timeout: Integer): Boolean; virtual;
+
+
+
+function CanWrite (Timeout: Integer): Boolean; virtual;
+
+
+
+function SendBufferTo (Buffer: TMemory; Length: Integer): Integer; virtual;
+
+
+
+function RecvBufferFrom (Buffer: TMemory; Length: Integer): Integer; virtual;
+
+
+
+function GroupCanRead (const SocketList: TList; Timeout: Integer; const CanReadList: TList): Boolean;
+
+
+
+procedure EnableReuse (Value: Boolean);
+
+
+
+procedure SetTimeout (Timeout: Integer);
+
+
+
+procedure SetSendTimeout (Timeout: Integer);
+
+
+
+procedure SetRecvTimeout (Timeout: Integer);
+
+
+
+function GetSocketType : integer; Virtual;
+
+
+
+function GetSocketProtocol : integer; Virtual;
+
+
+
+class function GetErrorDesc (ErrorCode: Integer): string;
+
+
+
+function GetErrorDescEx : string; virtual;
+
+
+Properties
+
+
+
+property WSAData : TWSADATA read GetWsaData;
+
+
+
+property FDset : TFDSet read FFDset;
+
+
+
+property LocalSin : TVarSin read FLocalSin write FLocalSin;
+
+
+
+property RemoteSin : TVarSin read FRemoteSin write FRemoteSin;
+
+
+
+property Socket : TSocket read FSocket write SetSocket;
+
+
+
+property LastError : Integer read FLastError;
+
+
+
+property LastErrorDesc : string read FLastErrorDesc;
+
+
+
+property LineBuffer : AnsiString read FBuffer write FBuffer;
+
+
+
+property SizeRecvBuffer : Integer read GetSizeRecvBuffer write SetSizeRecvBuffer;
+
+
+
+property SizeSendBuffer : Integer read GetSizeSendBuffer write SetSizeSendBuffer;
+
+
+
+property NonBlockMode : Boolean read FNonBlockMode Write SetNonBlockMode;
+
+
+
+property TTL : Integer read GetTTL Write SetTTL;
+
+
+
+property IP6used : Boolean read FIP6used;
+
+
+
+property RecvCounter : Integer read FRecvCounter;
+
+
+
+property SendCounter : Integer read FSendCounter;
+
+
+
+property Tag : Integer read FTag write FTag;
+
+
+
+property RaiseExcept : Boolean read FRaiseExcept write FRaiseExcept;
+
+
+
+property MaxLineLength : Integer read FMaxLineLength Write FMaxLineLength;
+
+
+
+property MaxSendBandwidth : Integer read FMaxSendBandwidth Write FMaxSendBandwidth;
+
+
+
+property MaxRecvBandwidth : Integer read FMaxRecvBandwidth Write FMaxRecvBandwidth;
+
+
+
+property MaxBandwidth : Integer Write SetBandwidth;
+
+
+
+property ConvertLineEnd : Boolean read FConvertLineEnd Write FConvertLineEnd;
+
+
+
+property Family : TSocketFamily read FFamily Write SetFamily;
+
+
+
+property PreferIP4 : Boolean read FPreferIP4 Write FPreferIP4;
+
+
+
+property InterPacketTimeout : Boolean read FInterPacketTimeout Write FInterPacketTimeout;
+
+
+
+property SendMaxChunk : Integer read FSendMaxChunk Write FSendMaxChunk;
+
+
+
+property StopFlag : Boolean read FStopFlag Write FStopFlag;
+
+
+
+property NonblockSendTimeout : Integer read FNonblockSendTimeout Write FNonblockSendTimeout;
+
+
+
+property OnStatus : THookSocketStatus read FOnStatus write FOnStatus;
+
+
+
+property OnReadFilter : THookDataFilter read FOnReadFilter write FOnReadFilter;
+
+
+
+property OnCreateSocket : THookCreateSocket read FOnCreateSocket write FOnCreateSocket;
+
+
+
+property OnMonitor : THookMonitor read FOnMonitor write FOnMonitor;
+
+
+
+property OnHeartbeat : THookHeartbeat read FOnHeartbeat write FOnHeartbeat;
+
+
+
+property HeartbeatRate : integer read FHeartbeatRate Write FHeartbeatRate;
+
+
+
+property Owner : TObject read FOwner Write FOwner;
+
+
+Description
+Methods
+
+
+
+constructor Create ;
+
+
+
+
+
+constructor CreateAlternate (Stub: string);
+
+
+
+Create object and load all necessary socket library. What library is loaded is described by STUB parameter. If STUB is empty string, then is loaded default libraries.
+
+
+
+destructor Destroy ; override;
+
+
+
+
+
+procedure CreateSocket ;
+
+
+
+If Family is not SF_Any, then create socket with type defined in Family property. If family is SF_Any, then do nothing! (socket is created automaticly when you know what type of socket you need to create. (i.e. inside Connect or Bind call.) When socket is created, then is aplyed all stored delayed socket options.
+
+
+
+procedure CreateSocketByName (const Value: String);
+
+
+
+It create socket. Address resolving of Value tells what type of socket is created. If Value is resolved as IPv4 IP, then is created IPv4 socket. If value is resolved as IPv6 address, then is created IPv6 socket.
+
+
+
+procedure CloseSocket ; virtual;
+
+
+
+Destroy socket in use. This method is also automatically called from object destructor.
+
+
+
+procedure AbortSocket ; virtual;
+
+
+
+Abort any work on Socket and destroy them.
+
+
+
+procedure Bind (IP, Port: string);
+
+
+
+Connects socket to local IP address and PORT. IP address may be numeric or symbolic ('192.168.74.50', 'cosi.nekde.cz', 'ff08::1'). The same for PORT - it may be number or mnemonic port ('23', 'telnet').
+
+
If port value is '0', system chooses itself and conects unused port in the range 1024 to 4096 (this depending by operating system!). Structure LocalSin is filled after calling this method.
+
+
Note: If you call this on non-created socket, then socket is created automaticly.
+
+
Warning: when you call : Bind('0.0.0.0','0'); then is nothing done! In this case is used implicit system bind instead.
+
+
+
+procedure Connect (IP, Port: string); virtual;
+
+
+
+Connects socket to remote IP address and PORT. The same rules as with Bind method are valid. The only exception is that PORT with 0 value will not be connected!
+
+
Structures LocalSin and RemoteSin will be filled with valid values.
+
+
When you call this on non-created socket, then socket is created automaticly. Type of created socket is by Family property. If is used SF_IP4, then is created socket for IPv4. If is used SF_IP6, then is created socket for IPv6. When you have family on SF_Any (default!), then type of created socket is determined by address resolving of destination address. (Not work properly on prilimitary winsock IPv6 support!)
+
+
+
+procedure Listen ; virtual;
+
+
+
+Sets socket to receive mode for new incoming connections. It is necessary to use TBlockSocket .Bind function call before this method to select receiving port!
+
+
+
+function Accept : TSocket; virtual;
+
+
+
+Waits until new incoming connection comes. After it comes a new socket is automatically created (socket handler is returned by this function as result).
+
+
+
+function SendBuffer (Buffer: Tmemory; Length: Integer): Integer; virtual;
+
+
+
+Sends data of LENGTH from BUFFER address via connected socket. System automatically splits data to packets.
+
+
+
+procedure SendByte (Data: Byte); virtual;
+
+
+
+One data BYTE is sent via connected socket.
+
+
+
+procedure SendString (Data: AnsiString); virtual;
+
+
+
+Send data string via connected socket. Any terminator is not added! If you need send true string with CR-LF termination, you must add CR-LF characters to sended string! Because any termination is not added automaticly, you can use this function for sending any binary data in binary string.
+
+
+
+procedure SendInteger (Data: integer); virtual;
+
+
+
+Send integer as four bytes to socket.
+
+
+
+procedure SendBlock (const Data: AnsiString); virtual;
+
+
+
+Send data as one block to socket. Each block begin with 4 bytes with length of data in block. This 4 bytes is added automaticly by this function.
+
+
+
+procedure SendStreamRaw (const Stream: TStream); virtual;
+
+
+
+Send data from stream to socket.
+
+
+
+procedure SendStream (const Stream: TStream); virtual;
+
+
+
+Send content of stream to socket. It using SendBlock method
+
+
+
+procedure SendStreamIndy (const Stream: TStream); virtual;
+
+
+
+Send content of stream to socket. It using SendBlock method and this is compatible with streams in Indy library.
+
+
+
+function RecvBuffer (Buffer: TMemory; Length: Integer): Integer; virtual;
+
+
+
+Note: This is low-level receive function. You must be sure if data is waiting for read before call this function for avoid deadlock!
+
+
Waits until allocated buffer is filled by received data. Returns number of data received, which equals to LENGTH value under normal operation. If it is not equal the communication channel is possibly broken.
+
+
On stream oriented sockets if is received 0 bytes, it mean 'socket is closed!"
+
+
On datagram socket is readed first waiting datagram.
+
+
+
+function RecvBufferEx (Buffer: Tmemory; Len: Integer; Timeout: Integer): Integer; virtual;
+
+
+
+Note: This is high-level receive function. It using internal LineBuffer and you can combine this function freely with other high-level functions!
+
+
Method waits until data is received. If no data is received within TIMEOUT (in milliseconds) period, LastError is set to WSAETIMEDOUT. Methods serves for reading any size of data (i.e. one megabyte...). This method is preffered for reading from stream sockets (like TCP).
+
+
+
+function RecvBufferStr (Len: Integer; Timeout: Integer): AnsiString; virtual;
+
+
+
+Similar to RecvBufferEx , but readed data is stored in binary string, not in memory buffer.
+
+
+
+function RecvByte (Timeout: Integer): Byte; virtual;
+
+
+
+Note: This is high-level receive function. It using internal LineBuffer and you can combine this function freely with other high-level functions.
+
+
Waits until one data byte is received which is also returned as function result. If no data is received within TIMEOUT (in milliseconds)period, LastError is set to WSAETIMEDOUT and result have value 0.
+
+
+
+function RecvInteger (Timeout: Integer): Integer; virtual;
+
+
+
+Note: This is high-level receive function. It using internal LineBuffer and you can combine this function freely with other high-level functions.
+
+
Waits until one four bytes are received and return it as one Ineger Value. If no data is received within TIMEOUT (in milliseconds)period, LastError is set to WSAETIMEDOUT and result have value 0.
+
+
+
+function RecvString (Timeout: Integer): AnsiString; virtual;
+
+
+
+Note: This is high-level receive function. It using internal LineBuffer and you can combine this function freely with other high-level functions.
+
+
Method waits until data string is received. This string is terminated by CR-LF characters. The resulting string is returned without this termination (CR-LF)! If ConvertLineEnd is used, then CR-LF sequence may not be exactly CR-LF. See ConvertLineEnd description. If no data is received within TIMEOUT (in milliseconds) period, LastError is set to WSAETIMEDOUT. You may also specify maximum length of reading data by MaxLineLength property.
+
+
+
+function RecvTerminated (Timeout: Integer; const Terminator: AnsiString): AnsiString; virtual;
+
+
+
+Note: This is high-level receive function. It using internal LineBuffer and you can combine this function freely with other high-level functions.
+
+
Method waits until data string is received. This string is terminated by Terminator string. The resulting string is returned without this termination. If no data is received within TIMEOUT (in milliseconds) period, LastError is set to WSAETIMEDOUT. You may also specify maximum length of reading data by MaxLineLength property.
+
+
+
+function RecvPacket (Timeout: Integer): AnsiString; virtual;
+
+
+
+Note: This is high-level receive function. It using internal LineBuffer and you can combine this function freely with other high-level functions.
+
+
Method reads all data waiting for read. If no data is received within TIMEOUT (in milliseconds) period, LastError is set to WSAETIMEDOUT. Methods serves for reading unknown size of data. Because before call this function you don't know size of received data, returned data is stored in dynamic size binary string. This method is preffered for reading from stream sockets (like TCP). It is very goot for receiving datagrams too! (UDP protocol)
+
+
+
+function RecvBlock (Timeout: Integer): AnsiString; virtual;
+
+
+
+Read one block of data from socket. Each block begin with 4 bytes with length of data in block. This function read first 4 bytes for get lenght, then it wait for reported count of bytes.
+
+
+
+procedure RecvStreamRaw (const Stream: TStream; Timeout: Integer); virtual;
+
+
+
+Read all data from socket to stream until socket is closed (or any error occured.)
+
+
+
+procedure RecvStreamSize (const Stream: TStream; Timeout: Integer; Size: Integer);
+
+
+
+Read requested count of bytes from socket to stream.
+
+
+
+procedure RecvStream (const Stream: TStream; Timeout: Integer); virtual;
+
+
+
+Receive data to stream. It using RecvBlock method.
+
+
+
+procedure RecvStreamIndy (const Stream: TStream; Timeout: Integer); virtual;
+
+
+
+Receive data to stream. This function is compatible with similar function in Indy library. It using RecvBlock method.
+
+
+
+function PeekBuffer (Buffer: TMemory; Length: Integer): Integer; virtual;
+
+
+
+Same as RecvBuffer , but readed data stays in system input buffer. Warning: this function not respect data in LineBuffer ! Is not recommended to use this function!
+
+
+
+function PeekByte (Timeout: Integer): Byte; virtual;
+
+
+
+Same as RecvByte , but readed data stays in input system buffer. Warning: this function not respect data in LineBuffer ! Is not recommended to use this function!
+
+
+
+function WaitingData : Integer; virtual;
+
+
+
+On stream sockets it returns number of received bytes waiting for picking. 0 is returned when there is no such data. On datagram socket it returns length of the first waiting datagram. Returns 0 if no datagram is waiting.
+
+
+
+function WaitingDataEx : Integer;
+
+
+
+Same as WaitingData , but if exists some of data in LineBuffer , return their length instead.
+
+
+
+procedure Purge ;
+
+
+
+Clear all waiting data for read from buffers.
+
+
+
+procedure SetLinger (Enable: Boolean; Linger: Integer);
+
+
+
+Sets linger. Enabled linger means that the system waits another LINGER (in milliseconds) time for delivery of sent data. This function is only for stream type of socket! (TCP)
+
+
+
+procedure GetSinLocal ;
+
+
+
+Actualize values in LocalSin .
+
+
+
+procedure GetSinRemote ;
+
+
+
+Actualize values in RemoteSin .
+
+
+
+procedure GetSins ;
+
+
+
+Actualize values in LocalSin and RemoteSin .
+
+
+
+procedure ResetLastError ;
+
+
+
+Reset LastError and LastErrorDesc to non-error state.
+
+
+
+function SockCheck (SockResult: Integer): Integer; virtual;
+
+
+
+If you "manually" call Socket API functions, forward their return code as parameter to this function, which evaluates it, eventually calls GetLastError and found error code returns and stores to LastError .
+
+
+
+procedure ExceptCheck ;
+
+
+
+If LastError contains some error code and RaiseExcept property is True
, raise adequate exception.
+
+
+
+function LocalName : string;
+
+
+
+Returns local computer name as numerical or symbolic value. It try get fully qualified domain name. Name is returned in the format acceptable by functions demanding IP as input parameter.
+
+
+
+procedure ResolveNameToIP (Name: string; const IPList: TStrings);
+
+
+
+Try resolve name to all possible IP address. i.e. If you pass as name result of LocalName method, you get all IP addresses used by local system.
+
+
+
+function ResolveName (Name: string): string;
+
+
+
+Try resolve name to primary IP address. i.e. If you pass as name result of LocalName method, you get primary IP addresses used by local system.
+
+
+
+function ResolveIPToName (IP: string): string;
+
+
+
+Try resolve IP to their primary domain name. If IP not have domain name, then is returned original IP.
+
+
+
+function ResolvePort (Port: string): Word;
+
+
+
+Try resolve symbolic port name to port number. (i.e. 'Echo' to 8)
+
+
+
+procedure SetRemoteSin (IP, Port: string);
+
+
+
+Set information about remote side socket. It is good for seting remote side for sending UDP packet, etc.
+
+
+
+function GetLocalSinIP : string; virtual;
+
+
+
+Picks IP socket address from LocalSin .
+
+
+
+function GetRemoteSinIP : string; virtual;
+
+
+
+Picks IP socket address from RemoteSin .
+
+
+
+function GetLocalSinPort : Integer; virtual;
+
+
+
+Picks socket PORT number from LocalSin .
+
+
+
+function GetRemoteSinPort : Integer; virtual;
+
+
+
+Picks socket PORT number from RemoteSin .
+
+
+
+function CanRead (Timeout: Integer): Boolean; virtual;
+
+
+
+Return True
, if you can read any data from socket or is incoming connection on TCP based socket. Status is tested for time Timeout (in milliseconds). If value in Timeout is 0, status is only tested and continue. If value in Timeout is -1, run is breaked and waiting for read data maybe forever.
+
+
This function is need only on special cases, when you need use RecvBuffer function directly! read functioms what have timeout as calling parameter, calling this function internally.
+
+
+
+function CanReadEx (Timeout: Integer): Boolean; virtual;
+
+
+
+Same as CanRead , but additionally return True
if is some data in LineBuffer .
+
+
+
+function CanWrite (Timeout: Integer): Boolean; virtual;
+
+
+
+Return True
, if you can to socket write any data (not full sending buffer). Status is tested for time Timeout (in milliseconds). If value in Timeout is 0, status is only tested and continue. If value in Timeout is -1, run is breaked and waiting for write data maybe forever.
+
+
This function is need only on special cases!
+
+
+
+function SendBufferTo (Buffer: TMemory; Length: Integer): Integer; virtual;
+
+
+
+Same as SendBuffer , but send datagram to address from RemoteSin . Usefull for sending reply to datagram received by function RecvBufferFrom .
+
+
+
+function RecvBufferFrom (Buffer: TMemory; Length: Integer): Integer; virtual;
+
+
+
+Note: This is low-lever receive function. You must be sure if data is waiting for read before call this function for avoid deadlock!
+
+
Receives first waiting datagram to allocated buffer. If there is no waiting one, then waits until one comes. Returns length of datagram stored in BUFFER. If length exceeds buffer datagram is truncated. After this RemoteSin structure contains information about sender of UDP packet.
+
+
+
+function GroupCanRead (const SocketList: TList; Timeout: Integer; const CanReadList: TList): Boolean;
+
+
+
+This function is for check for incoming data on set of sockets. Whitch sockets is checked is decribed by SocketList Tlist with TBlockSocket objects. TList may have maximal number of objects defined by FD_SETSIZE constant. Return True
, if you can from some socket read any data or is incoming connection on TCP based socket. Status is tested for time Timeout (in milliseconds). If value in Timeout is 0, status is only tested and continue. If value in Timeout is -1, run is breaked and waiting for read data maybe forever. If is returned True
, CanReadList TList is filled by all TBlockSocket objects what waiting for read.
+
+
+
+procedure EnableReuse (Value: Boolean);
+
+
+
+By this method you may turn address reuse mode for local Bind . It is good specially for UDP protocol. Using this with TCP protocol is hazardous!
+
+
+
+procedure SetTimeout (Timeout: Integer);
+
+
+
+Try set timeout for all sending and receiving operations, if socket provider can do it. (It not supported by all socket providers!)
+
+
+
+procedure SetSendTimeout (Timeout: Integer);
+
+
+
+Try set timeout for all sending operations, if socket provider can do it. (It not supported by all socket providers!)
+
+
+
+procedure SetRecvTimeout (Timeout: Integer);
+
+
+
+Try set timeout for all receiving operations, if socket provider can do it. (It not supported by all socket providers!)
+
+
+
+function GetSocketType : integer; Virtual;
+
+
+
+Return value of socket type.
+
+
+
+function GetSocketProtocol : integer; Virtual;
+
+
+
+Return value of protocol type for socket creation.
+
+
+
+class function GetErrorDesc (ErrorCode: Integer): string;
+
+
+
+Return descriptive string for given error code. This is class function. You may call it without created object!
+
+
+
+function GetErrorDescEx : string; virtual;
+
+
+
+Return descriptive string for LastError .
+Properties
+
+
+
+property WSAData : TWSADATA read GetWsaData;
+
+
+
+WSA structure with information about socket provider. On non-windows platforms this structure is simulated!
+
+
+
+property FDset : TFDSet read FFDset;
+
+
+
+FDset structure prepared for usage with this socket.
+
+
+
+property LocalSin : TVarSin read FLocalSin write FLocalSin;
+
+
+
+Structure describing local socket side.
+
+
+
+property RemoteSin : TVarSin read FRemoteSin write FRemoteSin;
+
+
+
+Structure describing remote socket side.
+
+
+
+property Socket : TSocket read FSocket write SetSocket;
+
+
+
+Socket handler. Suitable for "manual" calls to socket API or manual connection of socket to a previously created socket (i.e by Accept method on TCP socket)
+
+
+
+property LastError : Integer read FLastError;
+
+
+
+Last socket operation error code. Error codes are described in socket documentation. Human readable error description is stored in LastErrorDesc property.
+
+
+
+property LastErrorDesc : string read FLastErrorDesc;
+
+
+
+Human readable error description of LastError code.
+
+
+
+property LineBuffer : AnsiString read FBuffer write FBuffer;
+
+
+
+Buffer used by all high-level receiving functions. This buffer is used for optimized reading of data from socket. In normal cases you not need access to this buffer directly!
+
+
+
+property SizeRecvBuffer : Integer read GetSizeRecvBuffer write SetSizeRecvBuffer;
+
+
+
+Size of Winsock receive buffer. If it is not supported by socket provider, it return as size one kilobyte.
+
+
+
+property SizeSendBuffer : Integer read GetSizeSendBuffer write SetSizeSendBuffer;
+
+
+
+Size of Winsock send buffer. If it is not supported by socket provider, it return as size one kilobyte.
+
+
+
+property NonBlockMode : Boolean read FNonBlockMode Write SetNonBlockMode;
+
+
+
+If True
, turn class to non-blocking mode. Not all functions are working properly in this mode, you must know exactly what you are doing! However when you have big experience with non-blocking programming, then you can optimise your program by non-block mode!
+
+
+
+property TTL : Integer read GetTTL Write SetTTL;
+
+
+
+Set Time-to-live value. (if system supporting it!)
+
+
+
+property IP6used : Boolean read FIP6used;
+
+
+
+If is True
, then class in in IPv6 mode.
+
+
+
+property RecvCounter : Integer read FRecvCounter;
+
+
+
+Return count of received bytes on this socket from begin of current connection.
+
+
+
+property SendCounter : Integer read FSendCounter;
+
+
+
+Return count of sended bytes on this socket from begin of current connection.
+
+
+
+property Tag : Integer read FTag write FTag;
+
+
+
+this value is for free use.
+
+
+
+property RaiseExcept : Boolean read FRaiseExcept write FRaiseExcept;
+
+
+
+If True
, winsock errors raises exception. Otherwise is setted LastError value only and you must check it from your program! Default value is False
.
+
+
+
+property MaxLineLength : Integer read FMaxLineLength Write FMaxLineLength;
+
+
+
+Define maximum length in bytes of LineBuffer for high-level receiving functions. If this functions try to read more data then this limit, error is returned! If value is 0 (default), no limitation is used. This is very good protection for stupid attacks to your server by sending lot of data without proper terminator... until all your memory is allocated by LineBuffer!
+
+
Note: This maximum length is checked only in functions, what read unknown number of bytes! (like RecvString or RecvTerminated )
+
+
+
+property MaxSendBandwidth : Integer read FMaxSendBandwidth Write FMaxSendBandwidth;
+
+
+
+Define maximal bandwidth for all sending operations in bytes per second. If value is 0 (default), bandwidth limitation is not used.
+
+
+
+property MaxRecvBandwidth : Integer read FMaxRecvBandwidth Write FMaxRecvBandwidth;
+
+
+
+Define maximal bandwidth for all receiving operations in bytes per second. If value is 0 (default), bandwidth limitation is not used.
+
+
+
+property MaxBandwidth : Integer Write SetBandwidth;
+
+
+
+Define maximal bandwidth for all sending and receiving operations in bytes per second. If value is 0 (default), bandwidth limitation is not used.
+
+
+
+property ConvertLineEnd : Boolean read FConvertLineEnd Write FConvertLineEnd;
+
+
+
+Do a conversion of non-standard line terminators to CRLF. (Off by default) If True
, then terminators like sigle CR, single LF or LFCR are converted to CRLF internally. This have effect only in RecvString method!
+
+
+
+property Family : TSocketFamily read FFamily Write SetFamily;
+
+
+
+Specified Family of this socket. When you are using Windows preliminary support for IPv6, then I recommend to set this property!
+
+
+
+property PreferIP4 : Boolean read FPreferIP4 Write FPreferIP4;
+
+
+
+When resolving of domain name return both IPv4 and IPv6 addresses, then specify if is used IPv4 (dafault - True
) or IPv6.
+
+
+
+property InterPacketTimeout : Boolean read FInterPacketTimeout Write FInterPacketTimeout;
+
+
+
+By default (True
) is all timeouts used as timeout between two packets in reading operations. If you set this to False
, then Timeouts is for overall reading operation!
+
+
+
+property SendMaxChunk : Integer read FSendMaxChunk Write FSendMaxChunk;
+
+
+
+All sended datas was splitted by this value.
+
+
+
+property StopFlag : Boolean read FStopFlag Write FStopFlag;
+
+
+
+By setting this property to True
you can stop any communication. You can use this property for soft abort of communication.
+
+
+
+property NonblockSendTimeout : Integer read FNonblockSendTimeout Write FNonblockSendTimeout;
+
+
+
+Timeout for data sending by non-blocking socket mode.
+
+
+This event is called by various reasons. It is good for monitoring socket, create gauges for data transfers, etc.
+
+
+
+property OnReadFilter : THookDataFilter read FOnReadFilter write FOnReadFilter;
+
+
+
+this event is good for some internal thinks about filtering readed datas. It is used by telnet client by example.
+
+
+
+property OnCreateSocket : THookCreateSocket read FOnCreateSocket write FOnCreateSocket;
+
+
+
+This event is called after real socket creation for setting special socket options, because you not know when socket is created. (it is depended on Ipv4, IPv6 or automatic mode)
+
+
+
+property OnMonitor : THookMonitor read FOnMonitor write FOnMonitor;
+
+
+
+This event is good for monitoring content of readed or writed datas.
+
+
+
+property OnHeartbeat : THookHeartbeat read FOnHeartbeat write FOnHeartbeat;
+
+
+
+This event is good for calling your code during long socket operations. (Example, for refresing UI if class in not called within the thread.) Rate of heartbeats can be modified by HeartbeatRate property.
+
+
+
+property HeartbeatRate : integer read FHeartbeatRate Write FHeartbeatRate;
+
+
+
+Specify typical rate of OnHeartbeat event and StopFlag testing. Default value 0 disabling heartbeats! Value is in milliseconds. Real rate can be higher or smaller then this value, because it depending on real socket operations too! Note: Each heartbeat slowing socket processing.
+
+
+
+property Owner : TObject read FOwner Write FOwner;
+
+
+
+What class own this socket? Used by protocol implementation classes.
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:50
+
+
ADDED lib/synapse/docs/help/blcksock.TCustomSSL.html
Index: lib/synapse/docs/help/blcksock.TCustomSSL.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/blcksock.TCustomSSL.html
@@ -0,0 +1,633 @@
+
+
+
+
+
+blcksock: Class TCustomSSL
+
+
+
+Class TCustomSSL
+
+Unit
+
+blcksock
+Declaration
+
+type TCustomSSL = class(TObject)
+Description
+
+Parent class for all SSL plugins.
+
+ This is abstract class defining interface for other SSL plugins.
+
+
Instance of this class will be created for each TTCPBlockSocket .
+
+
Warning: not all methods and propertis can work in all existing SSL plugins! Please, read documentation of used SSL plugin.
+Hierarchy
+Overview
+Methods
+
+Properties
+
+
+
+property SSLEnabled : Boolean read FSSLEnabled;
+
+
+
+property LastError : integer read FLastError;
+
+
+
+property LastErrorDesc : string read FLastErrorDesc;
+
+
+
+property SSLType : TSSLType read FSSLType write FSSLType;
+
+
+
+property KeyPassword : string read FKeyPassword write FKeyPassword;
+
+
+
+property Username : string read FUsername write FUsername;
+
+
+
+property Password : string read FPassword write FPassword;
+
+
+
+property Ciphers : string read FCiphers write FCiphers;
+
+
+
+property CertificateFile : string read FCertificateFile write FCertificateFile;
+
+
+
+property PrivateKeyFile : string read FPrivateKeyFile write FPrivateKeyFile;
+
+
+
+property Certificate : Ansistring read FCertificate write FCertificate;
+
+
+
+property PrivateKey : Ansistring read FPrivateKey write FPrivateKey;
+
+
+
+property PFX : Ansistring read FPFX write FPFX;
+
+
+
+property PFXfile : string read FPFXfile write FPFXfile;
+
+
+
+property TrustCertificateFile : string read FTrustCertificateFile write FTrustCertificateFile;
+
+
+
+property TrustCertificate : Ansistring read FTrustCertificate write FTrustCertificate;
+
+
+
+property CertCA : Ansistring read FCertCA write FCertCA;
+
+
+
+property CertCAFile : string read FCertCAFile write SetCertCAFile;
+
+
+
+property VerifyCert : Boolean read FVerifyCert write FVerifyCert;
+
+
+
+property SSHChannelType : string read FSSHChannelType write FSSHChannelType;
+
+
+
+property SSHChannelArg1 : string read FSSHChannelArg1 write FSSHChannelArg1;
+
+
+
+property SSHChannelArg2 : string read FSSHChannelArg2 write FSSHChannelArg2;
+
+
+
+property CertComplianceLevel : integer read FCertComplianceLevel write FCertComplianceLevel;
+
+
+
+property OnVerifyCert : THookVerifyCert read FOnVerifyCert write FOnVerifyCert;
+
+
+
+property SNIHost : string read FSNIHost write FSNIHost;
+
+
+Description
+Methods
+
+
+Create plugin class. it is called internally from TTCPBlockSocket
+
+
+
+procedure Assign (const Value: TCustomSSL ); virtual;
+
+
+
+Assign settings (certificates and configuration) from another SSL plugin class.
+
+
+
+function LibVersion : String; virtual;
+
+
+
+return description of used plugin. It usually return name and version of used SSL library.
+
+
+
+function LibName : String; virtual;
+
+
+
+return name of used plugin.
+
+
+
+function Connect : boolean; virtual;
+
+
+
+Do not call this directly. It is used internally by TTCPBlockSocket !
+
+
Here is needed code for start SSL connection.
+
+
+
+function Accept : boolean; virtual;
+
+
+
+Do not call this directly. It is used internally by TTCPBlockSocket !
+
+
Here is needed code for acept new SSL connection.
+
+
+
+function Shutdown : boolean; virtual;
+
+
+
+Do not call this directly. It is used internally by TTCPBlockSocket !
+
+
Here is needed code for hard shutdown of SSL connection. (for example, before socket is closed)
+
+
+
+function BiShutdown : boolean; virtual;
+
+
+
+Do not call this directly. It is used internally by TTCPBlockSocket !
+
+
Here is needed code for soft shutdown of SSL connection. (for example, when you need to continue with unprotected connection.)
+
+
+
+function SendBuffer (Buffer: TMemory; Len: Integer): Integer; virtual;
+
+
+
+Do not call this directly. It is used internally by TTCPBlockSocket !
+
+
Here is needed code for sending some datas by SSL connection.
+
+
+
+function RecvBuffer (Buffer: TMemory; Len: Integer): Integer; virtual;
+
+
+
+Do not call this directly. It is used internally by TTCPBlockSocket !
+
+
Here is needed code for receiving some datas by SSL connection.
+
+
+
+function WaitingData : Integer; virtual;
+
+
+
+Do not call this directly. It is used internally by TTCPBlockSocket !
+
+
Here is needed code for getting count of datas what waiting for read. If SSL plugin not allows this, then it should return 0.
+
+
+
+function GetSSLVersion : string; virtual;
+
+
+
+Return string with identificator of SSL/TLS version of existing connection.
+
+
+
+function GetPeerSubject : string; virtual;
+
+
+
+Return subject of remote SSL peer.
+
+
+
+function GetPeerSerialNo : integer; virtual;
+
+
+
+Return Serial number if remote X509 certificate.
+
+
+
+function GetPeerIssuer : string; virtual;
+
+
+
+Return issuer certificate of remote SSL peer.
+
+
+
+function GetPeerName : string; virtual;
+
+
+
+Return peer name from remote side certificate. This is good for verify, if certificate is generated for remote side IP name.
+
+
+
+function GetPeerNameHash : cardinal; virtual;
+
+
+
+Returns has of peer name from remote side certificate. This is good for fast remote side authentication.
+
+
+
+function GetPeerFingerprint : string; virtual;
+
+
+
+Return fingerprint of remote SSL peer.
+
+
+
+function GetCertInfo : string; virtual;
+
+
+
+Return all detailed information about certificate from remote side of SSL/TLS connection. Result string can be multilined! Each plugin can return this informations in different format!
+
+
+
+function GetCipherName : string; virtual;
+
+
+
+Return currently used Cipher.
+
+
+
+function GetCipherBits : integer; virtual;
+
+
+
+Return currently used number of bits in current Cipher algorythm.
+
+
+
+function GetCipherAlgBits : integer; virtual;
+
+
+
+Return number of bits in current Cipher algorythm.
+
+
+
+function GetVerifyCert : integer; virtual;
+
+
+
+Return result value of verify remote side certificate. Look to OpenSSL documentation for possible values. For example 0 is successfuly verified certificate, or 18 is self-signed certificate.
+Properties
+
+
+
+property SSLEnabled : Boolean read FSSLEnabled;
+
+
+
+Resurn True
if SSL mode is enabled on existing cvonnection.
+
+
+
+property LastError : integer read FLastError;
+
+
+
+Return error code of last SSL operation. 0 is OK.
+
+
+
+property LastErrorDesc : string read FLastErrorDesc;
+
+
+
+Return error description of last SSL operation.
+
+
+
+property SSLType : TSSLType read FSSLType write FSSLType;
+
+
+
+Here you can specify requested SSL/TLS mode. Default is autodetection, but on some servers autodetection not working properly. In this case you must specify requested SSL/TLS mode by your hand!
+
+
+
+property KeyPassword : string read FKeyPassword write FKeyPassword;
+
+
+
+Password for decrypting of encoded certificate or key.
+
+
+
+property Username : string read FUsername write FUsername;
+
+
+
+Username for possible credentials.
+
+
+
+property Password : string read FPassword write FPassword;
+
+
+
+password for possible credentials.
+
+
+
+property Ciphers : string read FCiphers write FCiphers;
+
+
+
+By this property you can modify default set of SSL/TLS ciphers.
+
+
+
+property CertificateFile : string read FCertificateFile write FCertificateFile;
+
+
+
+Used for loading certificate from disk file. See to plugin documentation if this method is supported and how!
+
+
+
+property PrivateKeyFile : string read FPrivateKeyFile write FPrivateKeyFile;
+
+
+
+Used for loading private key from disk file. See to plugin documentation if this method is supported and how!
+
+
+
+property Certificate : Ansistring read FCertificate write FCertificate;
+
+
+
+Used for loading certificate from binary string. See to plugin documentation if this method is supported and how!
+
+
+
+property PrivateKey : Ansistring read FPrivateKey write FPrivateKey;
+
+
+
+Used for loading private key from binary string. See to plugin documentation if this method is supported and how!
+
+
+
+property PFX : Ansistring read FPFX write FPFX;
+
+
+
+Used for loading PFX from binary string. See to plugin documentation if this method is supported and how!
+
+
+
+property PFXfile : string read FPFXfile write FPFXfile;
+
+
+
+Used for loading PFX from disk file. See to plugin documentation if this method is supported and how!
+
+
+
+property TrustCertificateFile : string read FTrustCertificateFile write FTrustCertificateFile;
+
+
+
+Used for loading trusted certificates from disk file. See to plugin documentation if this method is supported and how!
+
+
+
+property TrustCertificate : Ansistring read FTrustCertificate write FTrustCertificate;
+
+
+
+Used for loading trusted certificates from binary string. See to plugin documentation if this method is supported and how!
+
+
+
+property CertCA : Ansistring read FCertCA write FCertCA;
+
+
+
+Used for loading CA certificates from binary string. See to plugin documentation if this method is supported and how!
+
+
+
+property CertCAFile : string read FCertCAFile write SetCertCAFile;
+
+
+
+Used for loading CA certificates from disk file. See to plugin documentation if this method is supported and how!
+
+
+
+property VerifyCert : Boolean read FVerifyCert write FVerifyCert;
+
+
+
+If True
, then is verified client certificate. (it is good for writing SSL/TLS servers.) When you are not server, but you are client, then if this property is True
, verify servers certificate.
+
+
+
+property SSHChannelType : string read FSSHChannelType write FSSHChannelType;
+
+
+
+channel type for possible SSH connections
+
+
+
+property SSHChannelArg1 : string read FSSHChannelArg1 write FSSHChannelArg1;
+
+
+
+First argument of channel type for possible SSH connections
+
+
+
+property SSHChannelArg2 : string read FSSHChannelArg2 write FSSHChannelArg2;
+
+
+
+Second argument of channel type for possible SSH connections
+
+
+
+property CertComplianceLevel : integer read FCertComplianceLevel write FCertComplianceLevel;
+
+
+
+Level of standards compliance level (CryptLib: values in cryptlib.pas, -1: use default value )
+
+
+
+property OnVerifyCert : THookVerifyCert read FOnVerifyCert write FOnVerifyCert;
+
+
+
+This event is called when verifying the server certificate immediatally after a successfull verification in the ssl library.
+
+
+
+property SNIHost : string read FSNIHost write FSNIHost;
+
+
+
+Server Name Identification. Host name to send to server. If empty the host name found in URL will be used, which should be the normal use (http Header Host = SNI Host). The value is cleared after the connection is established. (SNI support requires OpenSSL 0.9.8k or later. Cryptlib not supported, yet )
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:50
+
+
ADDED lib/synapse/docs/help/blcksock.TDgramBlockSocket.html
Index: lib/synapse/docs/help/blcksock.TDgramBlockSocket.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/blcksock.TDgramBlockSocket.html
@@ -0,0 +1,73 @@
+
+
+
+
+
+blcksock: Class TDgramBlockSocket
+
+
+
+Class TDgramBlockSocket
+
+Unit
+
+blcksock
+Declaration
+
+type TDgramBlockSocket = class(TSocksBlockSocket )
+Description
+
+Datagram based communication
+
+ This class implementing datagram based communication instead default stream based communication style.
+Hierarchy
+Overview
+Methods
+
+
+
+procedure Connect (IP, Port: string); override;
+
+
+
+function SendBuffer (Buffer: TMemory; Length: Integer): Integer; override;
+
+
+
+function RecvBuffer (Buffer: TMemory; Length: Integer): Integer; override;
+
+
+Description
+Methods
+
+
+
+procedure Connect (IP, Port: string); override;
+
+
+
+Fill TBlockSocket .RemoteSin structure. This address is used for sending data.
+
+
+
+function SendBuffer (Buffer: TMemory; Length: Integer): Integer; override;
+
+
+
+Silently redirected to TBlockSocket .SendBufferTo .
+
+
+
+function RecvBuffer (Buffer: TMemory; Length: Integer): Integer; override;
+
+
+
+Silently redirected to TBlockSocket .RecvBufferFrom .
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:50
+
+
ADDED lib/synapse/docs/help/blcksock.TICMPBlockSocket.html
Index: lib/synapse/docs/help/blcksock.TICMPBlockSocket.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/blcksock.TICMPBlockSocket.html
@@ -0,0 +1,62 @@
+
+
+
+
+
+blcksock: Class TICMPBlockSocket
+
+
+
+Class TICMPBlockSocket
+
+Unit
+
+blcksock
+Declaration
+
+type TICMPBlockSocket = class(TDgramBlockSocket )
+Description
+
+Implementation of RAW ICMP socket.
+
+ For this object you must have rights for creating RAW sockets!
+Hierarchy
+Overview
+Methods
+
+Description
+Methods
+
+
+
+function GetSocketType : integer; override;
+
+
+
+Return value of socket type. For RAW and ICMP return SOCK_RAW.
+
+
+
+function GetSocketProtocol : integer; override;
+
+
+
+Return value of protocol type for socket creation. For ICMP returns IPPROTO_ICMP or IPPROTO_ICMPV6
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:50
+
+
ADDED lib/synapse/docs/help/blcksock.TIPHeader.html
Index: lib/synapse/docs/help/blcksock.TIPHeader.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/blcksock.TIPHeader.html
@@ -0,0 +1,121 @@
+
+
+
+
+
+blcksock: record TIPHeader
+
+
+
+record TIPHeader
+
+Unit
+
+blcksock
+Declaration
+
+type TIPHeader = record
+Description
+
+Record with definition of IP packet header.
+
+ For reading data from ICMP or RAW sockets.
+Overview
+Fields
+
+Description
+Fields
+
+
+
+
+
+
+FragOffsets : Word;
+
+
+
+
+
+
+
+SourceIp : LongWord;
+
+
+
+
+
+Options : LongWord;
+
+
+ Generated by PasDoc 0.9.0 on 2012-04-23 21:38:50
+
+
ADDED lib/synapse/docs/help/blcksock.TPGMMessageBlockSocket.html
Index: lib/synapse/docs/help/blcksock.TPGMMessageBlockSocket.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/blcksock.TPGMMessageBlockSocket.html
@@ -0,0 +1,60 @@
+
+
+
+
+
+blcksock: Class TPGMMessageBlockSocket
+
+
+
+Class TPGMMessageBlockSocket
+
+Unit
+
+blcksock
+Declaration
+
+type TPGMMessageBlockSocket = class(TBlockSocket )
+Description
+
+Implementation of PGM-message socket.
+
+ Not all systems supports this protocol!
+Hierarchy
+Overview
+Methods
+
+Description
+Methods
+
+
+
+function GetSocketType : integer; override;
+
+
+
+Return value of socket type. For PGM-message return SOCK_RDM.
+
+
+
+function GetSocketProtocol : integer; override;
+
+
+
+Return value of protocol type for socket creation. For PGM-message returns IPPROTO_RM.
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:50
+
+
ADDED lib/synapse/docs/help/blcksock.TPGMStreamBlockSocket.html
Index: lib/synapse/docs/help/blcksock.TPGMStreamBlockSocket.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/blcksock.TPGMStreamBlockSocket.html
@@ -0,0 +1,60 @@
+
+
+
+
+
+blcksock: Class TPGMStreamBlockSocket
+
+
+
+Class TPGMStreamBlockSocket
+
+Unit
+
+blcksock
+Declaration
+
+type TPGMStreamBlockSocket = class(TBlockSocket )
+Description
+
+Implementation of PGM-stream socket.
+
+ Not all systems supports this protocol!
+Hierarchy
+Overview
+Methods
+
+Description
+Methods
+
+
+
+function GetSocketType : integer; override;
+
+
+
+Return value of socket type. For PGM-stream return SOCK_STREAM.
+
+
+
+function GetSocketProtocol : integer; override;
+
+
+
+Return value of protocol type for socket creation. For PGM-stream returns IPPROTO_RM.
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:50
+
+
ADDED lib/synapse/docs/help/blcksock.TRAWBlockSocket.html
Index: lib/synapse/docs/help/blcksock.TRAWBlockSocket.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/blcksock.TRAWBlockSocket.html
@@ -0,0 +1,60 @@
+
+
+
+
+
+blcksock: Class TRAWBlockSocket
+
+
+
+Class TRAWBlockSocket
+
+Unit
+
+blcksock
+Declaration
+
+type TRAWBlockSocket = class(TBlockSocket )
+Description
+
+Implementation of RAW socket.
+
+ For this object you must have rights for creating RAW sockets!
+Hierarchy
+Overview
+Methods
+
+Description
+Methods
+
+
+
+function GetSocketType : integer; override;
+
+
+
+Return value of socket type. For RAW and ICMP return SOCK_RAW.
+
+
+
+function GetSocketProtocol : integer; override;
+
+
+
+Return value of protocol type for socket creation. For RAW returns IPPROTO_RAW.
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:50
+
+
ADDED lib/synapse/docs/help/blcksock.TSSLNone.html
Index: lib/synapse/docs/help/blcksock.TSSLNone.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/blcksock.TSSLNone.html
@@ -0,0 +1,60 @@
+
+
+
+
+
+blcksock: Class TSSLNone
+
+
+
+Class TSSLNone
+
+Unit
+
+blcksock
+Declaration
+
+type TSSLNone = class(TCustomSSL )
+Description
+
+Default SSL plugin with no SSL support.
+
+ Dummy SSL plugin implementation for applications without SSL/TLS support.
+Hierarchy
+Overview
+Methods
+
+
+
+function LibVersion : String; override;
+
+
+
+function LibName : String; override;
+
+
+Description
+Methods
+
+
+
+function LibVersion : String; override;
+
+
+
+See TCustomSSL .LibVersion
+
+
+
+function LibName : String; override;
+
+
+
+See TCustomSSL .LibName
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:50
+
+
ADDED lib/synapse/docs/help/blcksock.TSocksBlockSocket.html
Index: lib/synapse/docs/help/blcksock.TSocksBlockSocket.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/blcksock.TSocksBlockSocket.html
@@ -0,0 +1,194 @@
+
+
+
+
+
+blcksock: Class TSocksBlockSocket
+
+
+
+Class TSocksBlockSocket
+
+Unit
+
+blcksock
+Declaration
+
+type TSocksBlockSocket = class(TBlockSocket )
+Description
+
+Support for SOCKS4 and SOCKS5 proxy
+
+ Layer with definition all necessary properties and functions for implementation SOCKS proxy client. Do not use this class directly.
+Hierarchy
+Overview
+Methods
+
+Properties
+
+
+
+property UsingSocks : Boolean read FUsingSocks;
+
+
+
+property SocksLastError : integer read FSocksLastError;
+
+
+
+property SocksIP : string read FSocksIP write FSocksIP;
+
+
+
+property SocksPort : string read FSocksPort write FSocksPort;
+
+
+
+property SocksUsername : string read FSocksUsername write FSocksUsername;
+
+
+
+property SocksPassword : string read FSocksPassword write FSocksPassword;
+
+
+
+property SocksTimeout : integer read FSocksTimeout write FSocksTimeout;
+
+
+
+property SocksResolver : Boolean read FSocksResolver write FSocksResolver;
+
+
+
+property SocksType : TSocksType read FSocksType write FSocksType;
+
+
+Description
+Methods
+
+
+
+constructor Create ;
+
+
+
+
+
+function SocksOpen : Boolean;
+
+
+
+Open connection to SOCKS proxy and if SocksUsername is set, do authorisation to proxy. This is needed only in special cases! (it is called internally!)
+
+
+
+function SocksRequest (Cmd: Byte; const IP, Port: string): Boolean;
+
+
+
+Send specified request to SOCKS proxy. This is needed only in special cases! (it is called internally!)
+
+
+
+function SocksResponse : Boolean;
+
+
+
+Receive response to previosly sended request. This is needed only in special cases! (it is called internally!)
+Properties
+
+
+
+property UsingSocks : Boolean read FUsingSocks;
+
+
+
+Is True
when class is using SOCKS proxy.
+
+
+
+property SocksLastError : integer read FSocksLastError;
+
+
+
+If SOCKS proxy failed, here is error code returned from SOCKS proxy.
+
+
+
+property SocksIP : string read FSocksIP write FSocksIP;
+
+
+
+Address of SOCKS server. If value is empty string, SOCKS support is disabled. Assingning any value to this property enable SOCKS mode. Warning: You cannot combine this mode with HTTP-tunneling mode!
+
+
+
+property SocksPort : string read FSocksPort write FSocksPort;
+
+
+
+Port of SOCKS server. Default value is '1080'.
+
+
+
+property SocksUsername : string read FSocksUsername write FSocksUsername;
+
+
+
+If you need authorisation on SOCKS server, set username here.
+
+
+
+property SocksPassword : string read FSocksPassword write FSocksPassword;
+
+
+
+If you need authorisation on SOCKS server, set password here.
+
+
+
+property SocksTimeout : integer read FSocksTimeout write FSocksTimeout;
+
+
+
+Specify timeout for communicatin with SOCKS server. Default is one minute.
+
+
+
+property SocksResolver : Boolean read FSocksResolver write FSocksResolver;
+
+
+
+If True
, all symbolic names of target hosts is not translated to IP's locally, but resolving is by SOCKS proxy. Default is True
.
+
+
+
+property SocksType : TSocksType read FSocksType write FSocksType;
+
+
+
+Specify SOCKS type. By default is used SOCKS5, but you can use SOCKS4 too. When you select SOCKS4, then if SocksResolver is enabled, then is used SOCKS4a. Othervise is used pure SOCKS4.
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:50
+
+
ADDED lib/synapse/docs/help/blcksock.TSynaClient.html
Index: lib/synapse/docs/help/blcksock.TSynaClient.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/blcksock.TSynaClient.html
@@ -0,0 +1,121 @@
+
+
+
+
+
+blcksock: Class TSynaClient
+
+
+
+Class TSynaClient
+
+Unit
+
+blcksock
+Declaration
+
+type TSynaClient = class(TObject)
+Description
+
+Parent class of application protocol implementations.
+
+ By this class is defined common properties.
+Hierarchy
+Overview
+Methods
+
+Properties
+
+
+
+property TargetHost : string read FTargetHost Write FTargetHost;
+
+
+
+property TargetPort : string read FTargetPort Write FTargetPort;
+
+
+
+property IPInterface : string read FIPInterface Write FIPInterface;
+
+
+
+property Timeout : integer read FTimeout Write FTimeout;
+
+
+
+property UserName : string read FUserName Write FUserName;
+
+
+
+property Password : string read FPassword Write FPassword;
+
+
+Description
+Methods
+
+
+
+constructor Create ;
+
+
+ Properties
+
+
+
+property TargetHost : string read FTargetHost Write FTargetHost;
+
+
+
+Specify terget server IP (or symbolic name). Default is 'localhost'.
+
+
+
+property TargetPort : string read FTargetPort Write FTargetPort;
+
+
+
+Specify terget server port (or symbolic name).
+
+
+
+property IPInterface : string read FIPInterface Write FIPInterface;
+
+
+
+Defined local socket address. (outgoing IP address). By default is used '0.0.0.0' as wildcard for default IP.
+
+
+
+property Timeout : integer read FTimeout Write FTimeout;
+
+
+
+Specify default timeout for socket operations.
+
+
+
+property UserName : string read FUserName Write FUserName;
+
+
+
+If protocol need user authorization, then fill here username.
+
+
+
+property Password : string read FPassword Write FPassword;
+
+
+
+If protocol need user authorization, then fill here password.
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:50
+
+
ADDED lib/synapse/docs/help/blcksock.TSynaOption.html
Index: lib/synapse/docs/help/blcksock.TSynaOption.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/blcksock.TSynaOption.html
@@ -0,0 +1,63 @@
+
+
+
+
+
+blcksock: Class TSynaOption
+
+
+
+Class TSynaOption
+
+Unit
+
+blcksock
+Declaration
+
+type TSynaOption = class(TObject)
+Description
+
+this object is used for remember delayed socket option set.
+Hierarchy
+Overview
+Fields
+
+Description
+Fields
+
+
+
+
+Enabled : Boolean;
+
+
+
+
+
+Value : Integer;
+
+
+ Generated by PasDoc 0.9.0 on 2012-04-23 21:38:50
+
+
ADDED lib/synapse/docs/help/blcksock.TTCPBlockSocket.html
Index: lib/synapse/docs/help/blcksock.TTCPBlockSocket.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/blcksock.TTCPBlockSocket.html
@@ -0,0 +1,385 @@
+
+
+
+
+
+blcksock: Class TTCPBlockSocket
+
+
+
+Class TTCPBlockSocket
+
+Unit
+
+blcksock
+Declaration
+
+type TTCPBlockSocket = class(TSocksBlockSocket )
+Description
+
+Implementation of TCP socket.
+
+ Supported features: IPv4, IPv6, SSL/TLS or SSH (depending on used plugin), SOCKS5 proxy (outgoing connections and limited incomming), SOCKS4/4a proxy (outgoing connections and limited incomming), TCP through HTTP proxy tunnel.
+Hierarchy
+Overview
+Methods
+
+Properties
+
+Description
+Methods
+
+
+
+constructor Create ;
+
+
+
+Create TCP socket class with default plugin for SSL/TSL/SSH implementation (see SSLImplementation )
+
+
+
+constructor CreateWithSSL (SSLPlugin: TSSLClass );
+
+
+
+Create TCP socket class with desired plugin for SSL/TSL/SSH implementation
+
+
+
+destructor Destroy ; override;
+
+
+
+
+
+procedure CloseSocket ; override;
+
+
+
+See TBlockSocket .CloseSocket
+
+
+
+function WaitingData : Integer; override;
+
+
+
+See TBlockSocket .WaitingData
+
+
+
+procedure Listen ; override;
+
+
+
+Sets socket to receive mode for new incoming connections. It is necessary to use TBlockSocket .Bind function call before this method to select receiving port!
+
+
If you use SOCKS, activate incoming TCP connection by this proxy. (By BIND method of SOCKS.)
+
+
+
+function Accept : TSocket; override;
+
+
+
+Waits until new incoming connection comes. After it comes a new socket is automatically created (socket handler is returned by this function as result).
+
+
If you use SOCKS, new socket is not created! In this case is used same socket as socket for listening! So, you can accept only one connection in SOCKS mode.
+
+
+
+procedure Connect (IP, Port: string); override;
+
+
+
+Connects socket to remote IP address and PORT. The same rules as with TBlockSocket .Bind method are valid. The only exception is that PORT with 0 value will not be connected. After call to this method a communication channel between local and remote socket is created. Local socket is assigned automatically if not controlled by previous call to TBlockSocket .Bind method. Structures TBlockSocket .LocalSin and TBlockSocket .RemoteSin will be filled with valid values.
+
+
If you use SOCKS, activate outgoing TCP connection by SOCKS proxy specified in TSocksBlockSocket .SocksIP . (By CONNECT method of SOCKS.)
+
+
If you use HTTP-tunnel mode, activate outgoing TCP connection by HTTP tunnel specified in HTTPTunnelIP . (By CONNECT method of HTTP protocol.)
+
+
Note: If you call this on non-created socket, then socket is created automaticly.
+
+
+
+procedure SSLDoConnect ;
+
+
+
+If you need upgrade existing TCP connection to SSL/TLS (or SSH2, if plugin allows it) mode, then call this method. This method switch this class to SSL mode and do SSL/TSL handshake.
+
+
+
+procedure SSLDoShutdown ;
+
+
+
+By this method you can downgrade existing SSL/TLS connection to normal TCP connection.
+
+
+
+function SSLAcceptConnection : Boolean;
+
+
+
+If you need use this component as SSL/TLS TCP server, then after accepting of inbound connection you need start SSL/TLS session by this method. Before call this function, you must have assigned all neeeded certificates and keys!
+
+
+
+function GetLocalSinIP : string; override;
+
+
+
+See TBlockSocket .GetLocalSinIP
+
+
+
+function GetRemoteSinIP : string; override;
+
+
+
+See TBlockSocket .GetRemoteSinIP
+
+
+
+function GetLocalSinPort : Integer; override;
+
+
+
+See TBlockSocket .GetLocalSinPort
+
+
+
+function GetRemoteSinPort : Integer; override;
+
+
+
+See TBlockSocket .GetRemoteSinPort
+
+
+
+function SendBuffer (Buffer: TMemory; Length: Integer): Integer; override;
+
+
+
+See TBlockSocket .SendBuffer
+
+
+
+function RecvBuffer (Buffer: TMemory; Len: Integer): Integer; override;
+
+
+
+See TBlockSocket .RecvBuffer
+
+
+
+function GetSocketType : integer; override;
+
+
+
+Return value of socket type. For TCP return SOCK_STREAM.
+
+
+
+function GetSocketProtocol : integer; override;
+
+
+
+Return value of protocol type for socket creation. For TCP return IPPROTO_TCP.
+
+
+
+function GetErrorDescEx : string; override;
+
+
+
+Return descriptive string for LastError
. On case of error in SSL/TLS subsystem, it returns right error description.
+Properties
+
+
+Class implementing SSL/TLS support. It is allways some descendant of TCustomSSL class. When programmer not select some SSL plugin class, then is used TSSLNone
+
+
+
+property HTTPTunnel : Boolean read FHTTPTunnel;
+
+
+
+True
if is used HTTP tunnel mode.
+
+
+
+property HTTPTunnelIP : string read FHTTPTunnelIP Write FHTTPTunnelIP;
+
+
+
+Specify IP address of HTTP proxy. Assingning non-empty value to this property enable HTTP-tunnel mode. This mode is for tunnelling any outgoing TCP connection through HTTP proxy server. (If policy on HTTP proxy server allow this!) Warning: You cannot combine this mode with SOCK5 mode!
+
+
+
+property HTTPTunnelPort : string read FHTTPTunnelPort Write FHTTPTunnelPort;
+
+
+
+Specify port of HTTP proxy for HTTP-tunneling.
+
+
+
+property HTTPTunnelUser : string read FHTTPTunnelUser Write FHTTPTunnelUser;
+
+
+
+Specify authorisation username for access to HTTP proxy in HTTP-tunnel mode. If you not need authorisation, then let this property empty.
+
+
+
+property HTTPTunnelPass : string read FHTTPTunnelPass Write FHTTPTunnelPass;
+
+
+
+Specify authorisation password for access to HTTP proxy in HTTP-tunnel mode.
+
+
+
+property HTTPTunnelTimeout : integer read FHTTPTunnelTimeout Write FHTTPTunnelTimeout;
+
+
+
+Specify timeout for communication with HTTP proxy in HTTPtunnel mode.
+
+
+
+property OnAfterConnect : THookAfterConnect read FOnAfterConnect write FOnAfterConnect;
+
+
+
+This event is called after sucessful TCP socket connection.
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:50
+
+
ADDED lib/synapse/docs/help/blcksock.TUDPBlockSocket.html
Index: lib/synapse/docs/help/blcksock.TUDPBlockSocket.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/blcksock.TUDPBlockSocket.html
@@ -0,0 +1,162 @@
+
+
+
+
+
+blcksock: Class TUDPBlockSocket
+
+
+
+Class TUDPBlockSocket
+
+Unit
+
+blcksock
+Declaration
+
+type TUDPBlockSocket = class(TDgramBlockSocket )
+Description
+
+Implementation of UDP socket.
+
+ NOTE: in this class is all receiving redirected to RecvBufferFrom. You can use for reading any receive function. Preffered is RecvPacket! Similary all sending is redirected to SendbufferTo. You can use for sending UDP packet any sending function, like SendString.
+
+
Supported features: IPv4, IPv6, unicasts, broadcasts, multicasts, SOCKS5 proxy (only unicasts! Outgoing and incomming.)
+Hierarchy
+Overview
+Methods
+
+Properties
+
+
+
+property MulticastTTL : Integer read GetMulticastTTL Write SetMulticastTTL;
+
+
+Description
+Methods
+
+
+
+destructor Destroy ; override;
+
+
+
+
+
+procedure EnableBroadcast (Value: Boolean);
+
+
+
+Enable or disable sending of broadcasts. If seting OK, result is True
. This method is not supported in SOCKS5 mode! IPv6 does not support broadcasts! In this case you must use Multicasts instead.
+
+
+
+function SendBufferTo (Buffer: TMemory; Length: Integer): Integer; override;
+
+
+
+See TBlockSocket .SendBufferTo
+
+
+
+function RecvBufferFrom (Buffer: TMemory; Length: Integer): Integer; override;
+
+
+
+See TBlockSocket .RecvBufferFrom
+
+
+
+procedure AddMulticast (MCastIP:string);
+
+
+
+Add this socket to given multicast group. You cannot use Multicasts in SOCKS mode!
+
+
+
+procedure DropMulticast (MCastIP:string);
+
+
+
+Remove this socket from given multicast group.
+
+
+
+procedure EnableMulticastLoop (Value: Boolean);
+
+
+
+All sended multicast datagrams is loopbacked to your interface too. (you can read your sended datas.) You can disable this feature by this function. This function not working on some Windows systems!
+
+
+
+function GetSocketType : integer; override;
+
+
+
+Return value of socket type. For UDP return SOCK_DGRAM.
+
+
+
+function GetSocketProtocol : integer; override;
+
+
+
+Return value of protocol type for socket creation. For UDP return IPPROTO_UDP.
+Properties
+
+
+
+property MulticastTTL : Integer read GetMulticastTTL Write SetMulticastTTL;
+
+
+
+Set Time-to-live value for multicasts packets. It define number of routers for transfer of datas. If you set this to 1 (dafault system value), then multicasts packet goes only to you local network. If you need transport multicast packet to worldwide, then increase this value, but be carefull, lot of routers on internet does not transport multicasts packets!
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:50
+
+
ADDED lib/synapse/docs/help/blcksock.html
Index: lib/synapse/docs/help/blcksock.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/blcksock.html
@@ -0,0 +1,419 @@
+
+
+
+
+
+blcksock
+
+
+
+Unit blcksock
+
+Description
+ uses
+Overview
+Classes, Interfaces, Objects and Records
+
+Types
+
+Constants
+
+Variables
+
+Description
+Types
+
+
+THookSocketReason = (...);
+
+
+
+Types of OnStatus events
+
+
+HR_ResolvingBegin: Resolving is begin. Resolved IP and port is in parameter in format like: 'localhost.somewhere.com:25'.
+
+HR_ResolvingEnd: Resolving is done. Resolved IP and port is in parameter in format like: 'localhost.somewhere.com:25'. It is always same as in HR_ResolvingBegin!
+
+HR_SocketCreate: Socket created by CreateSocket method. It reporting Family of created socket too!
+
+HR_SocketClose: Socket closed by CloseSocket method.
+
+HR_Bind: Socket binded to IP and Port. Binded IP and Port is in parameter in format like: 'localhost.somewhere.com:25'.
+
+HR_Connect: Socket connected to IP and Port. Connected IP and Port is in parameter in format like: 'localhost.somewhere.com:25'.
+
+HR_CanRead: Called when CanRead method is used with True
result.
+
+HR_CanWrite: Called when CanWrite method is used with True
result.
+
+HR_Listen: Socket is swithed to Listen mode. (TCP socket only)
+
+HR_Accept: Socket Accepting client connection. (TCP socket only)
+
+HR_ReadCount: report count of bytes readed from socket. Number is in parameter string. If you need is in integer, you must use StrToInt function!
+
+HR_WriteCount: report count of bytes writed to socket. Number is in parameter string. If you need is in integer, you must use StrToInt function!
+
+HR_Wait: If is limiting of bandwidth on, then this reason is called when sending or receiving is stopped for satisfy bandwidth limit. Parameter is count of waiting milliseconds.
+
+HR_Error: report situation where communication error occured. When raiseexcept is True
, then exception is called after this Hook reason.
+
+
+
+THookSocketStatus = procedure(Sender: TObject; Reason: THookSocketReason ; const Value: String) of object;
+
+
+
+Procedural type for OnStatus event. Sender is calling TBlockSocket object, Reason is one of set Status events and value is optional data.
+
+
+THookDataFilter = procedure(Sender: TObject; var Value: AnsiString) of object;
+
+
+
+This procedural type is used for DataFilter hooks.
+
+
+THookCreateSocket = procedure(Sender: TObject) of object;
+
+
+
+This procedural type is used for hook OnCreateSocket. By this hook you can insert your code after initialisation of socket. (you can set special socket options, etc.)
+
+
+THookMonitor = procedure(Sender: TObject; Writing: Boolean; const Buffer: TMemory; Len: Integer) of object;
+
+
+
+This procedural type is used for monitoring of communication.
+
+
+THookAfterConnect = procedure(Sender: TObject) of object;
+
+
+
+This procedural type is used for hook OnAfterConnect. By this hook you can insert your code after TCP socket has been sucessfully connected.
+
+
+THookVerifyCert = function(Sender: TObject):boolean of object;
+
+
+
+This procedural type is used for hook OnVerifyCert. By this hook you can insert your additional certificate verification code. Usefull to verify server CN against URL.
+
+
+THookHeartbeat = procedure(Sender: TObject) of object;
+
+
+
+This procedural type is used for hook OnHeartbeat. By this hook you can call your code repeately during long socket operations. You must enable heartbeats by HeartbeatRate
property!
+
+
+TSocketFamily = (...);
+
+
+
+Specify family of socket.
+
+
+SF_Any: Default mode. Socket family is defined by target address for connection. It allows instant access to IPv4 and IPv6 nodes. When you need IPv6 address as destination, then is used IPv6 mode. othervise is used IPv4 mode. However this mode not working properly with preliminary IPv6 supports!
+
+SF_IP4: Turn this class to pure IPv4 mode. This mode is totally compatible with previous Synapse releases.
+
+SF_IP6: Turn to only IPv6 mode.
+
+
+
+TSocksType = (...);
+
+
+
+specify possible values of SOCKS modes.
+
+
+ST_Socks5:
+
+ST_Socks4:
+
+
+
+Specify requested SSL/TLS version for secure connection.
+
+
+LT_all:
+
+LT_SSLv2:
+
+LT_SSLv3:
+
+LT_TLSv1:
+
+LT_TLSv1_1:
+
+LT_SSHv2:
+
+
+
+TSynaOptionType = (...);
+
+
+
+Specify type of socket delayed option.
+
+
+SOT_Linger:
+
+SOT_RecvBuff:
+
+SOT_SendBuff:
+
+SOT_NonBlock:
+
+SOT_RecvTimeout:
+
+SOT_SendTimeout:
+
+SOT_Reuse:
+
+SOT_TTL:
+
+SOT_Broadcast:
+
+SOT_MulticastTTL:
+
+SOT_MulticastLoop:
+
+
+ Constants
+
+
+SynapseRelease = '38';
+
+
+
+
+cLocalhost = '127.0.0.1';
+
+
+
+
+cAnyHost = '0.0.0.0';
+
+
+
+
+cBroadcast = '255.255.255.255';
+
+
+
+
+c6Localhost = '::1';
+
+
+
+
+c6AnyHost = '::0';
+
+
+
+
+c6Broadcast = 'ffff::1';
+
+
+
+
+
+
+
+ Variables
+
+
+Selected SSL plugin. Default is TSSLNone .
+
+
Do not change this value directly!!!
+
+
Just add your plugin unit to your project uses instead. Each plugin unit have initialization code what modify this variable.
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:50
+
+
ADDED lib/synapse/docs/help/clamsend.TClamSend.html
Index: lib/synapse/docs/help/clamsend.TClamSend.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/clamsend.TClamSend.html
@@ -0,0 +1,170 @@
+
+
+
+
+
+clamsend: Class TClamSend
+
+
+
+Class TClamSend
+
+Unit
+
+clamsend
+Declaration
+
+type TClamSend = class(TSynaClient )
+Description
+
+Implementation of ClamAV-daemon client protocol
+
+ By this class you can scan any your data by ClamAV opensource antivirus.
+
+
This class can connect to ClamD by TCP channel, send your data to ClamD and read result.
+Hierarchy
+Overview
+Methods
+
+
+
+constructor Create ;
+
+
+
+destructor Destroy ; override;
+
+
+
+function DoCommand (const Value: AnsiString): AnsiString; virtual;
+
+
+
+function GetVersion : AnsiString; virtual;
+
+
+
+function ScanStrings (const Value: TStrings): AnsiString; virtual;
+
+
+
+function ScanStream (const Value: TStream): AnsiString; virtual;
+
+
+
+function ScanStrings2 (const Value: TStrings): AnsiString; virtual;
+
+
+
+function ScanStream2 (const Value: TStream): AnsiString; virtual;
+
+
+Properties
+
+Description
+Methods
+
+
+
+constructor Create ;
+
+
+
+
+
+destructor Destroy ; override;
+
+
+
+
+
+function DoCommand (const Value: AnsiString): AnsiString; virtual;
+
+
+
+Call any command to ClamD. Used internally by other methods.
+
+
+
+function GetVersion : AnsiString; virtual;
+
+
+
+Return ClamAV version and version of loaded databases.
+
+
+
+function ScanStrings (const Value: TStrings): AnsiString; virtual;
+
+
+
+Scan content of TStrings.
+
+
+
+function ScanStream (const Value: TStream): AnsiString; virtual;
+
+
+
+Scan content of TStream.
+
+
+
+function ScanStrings2 (const Value: TStrings): AnsiString; virtual;
+
+
+
+Scan content of TStrings by new 0.95 API.
+
+
+
+function ScanStream2 (const Value: TStream): AnsiString; virtual;
+
+
+
+Scan content of TStream by new 0.95 API.
+Properties
+
+
+Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.
+
+
+Socket object used for TCP data transfer operation. Good for seting OnStatus hook, etc.
+
+
+
+property Session : boolean read FSession write FSession;
+
+
+
+Can turn-on session mode of communication with ClamD. Default is False
, because ClamAV developers design their TCP code very badly and session mode is broken now (CVS-20051031). Maybe ClamAV developers fix their bugs and this mode will be possible in future.
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:50
+
+
ADDED lib/synapse/docs/help/clamsend.html
Index: lib/synapse/docs/help/clamsend.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/clamsend.html
@@ -0,0 +1,49 @@
+
+
+
+
+
+clamsend
+
+
+
+Unit clamsend
+
+Description
+
+ ClamAV-daemon client
+
+
+
+
This unit is capable to do antivirus scan of your data by TCP channel to ClamD daemon from ClamAV. See more about ClamAV on UNKNOWN
+uses
+Overview
+Classes, Interfaces, Objects and Records
+
+
+
+Class TClamSend
+Implementation of ClamAV-daemon client protocol
+
+
+Constants
+
+Description
+Constants
+
+
+cClamProtocol = '3310';
+
+
+ Generated by PasDoc 0.9.0 on 2012-04-23 21:38:50
+
+
ADDED lib/synapse/docs/help/dnssend.TDNSSend.html
Index: lib/synapse/docs/help/dnssend.TDNSSend.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/dnssend.TDNSSend.html
@@ -0,0 +1,188 @@
+
+
+
+
+
+dnssend: Class TDNSSend
+
+
+
+Class TDNSSend
+
+Unit
+
+dnssend
+Declaration
+
+type TDNSSend = class(TSynaClient )
+Description
+
+Implementation of DNS protocol by UDP or TCP protocol.
+
+
+
+
Note: Are you missing properties for specify server address and port? Look to parent TSynaClient too!
+Hierarchy
+Overview
+Methods
+
+
+
+constructor Create ;
+
+
+
+destructor Destroy ; override;
+
+
+
+function DNSQuery (Name: AnsiString; QType: Integer; const Reply: TStrings): Boolean;
+
+
+Properties
+
+Description
+Methods
+
+
+
+constructor Create ;
+
+
+
+
+
+destructor Destroy ; override;
+
+
+
+
+
+function DNSQuery (Name: AnsiString; QType: Integer; const Reply: TStrings): Boolean;
+
+
+
+Query a DNSHost for QType resources correspond to a name. Supported QType values are: Qtype_A, Qtype_NS, Qtype_MD, Qtype_MF, Qtype_CNAME, Qtype_SOA, Qtype_MB, Qtype_MG, Qtype_MR, Qtype_NULL, Qtype_PTR, Qtype_HINFO, Qtype_MINFO, Qtype_MX, Qtype_TXT, Qtype_RP, Qtype_AFSDB, Qtype_X25, Qtype_ISDN, Qtype_RT, Qtype_NSAP, Qtype_NSAPPTR, Qtype_PX, Qtype_GPOS, Qtype_KX.
+
+
Type for zone transfers QTYPE_AXFR is supported too, but only in TCP mode!
+
+
"Name" is domain name or host name for queried resource. If "name" is IP address, automatically convert to reverse domain form (.in-addr.arpa).
+
+
If result is True
, Reply contains resource records. One record on one line. If Resource record have multiple fields, they are stored on line divided by comma. (example: MX record contains value 'rs.cesnet.cz' with preference number 10, string in Reply is: '10,rs.cesnet.cz'). All numbers or IP address in resource are converted to string form.
+Properties
+
+
+Socket object used for UDP operation. Good for seting OnStatus hook, etc.
+
+
+Socket object used for TCP operation. Good for seting OnStatus hook, etc.
+
+
+
+property UseTCP : Boolean read FUseTCP Write FUseTCP;
+
+
+
+if True
, then is used TCP protocol instead UDP. It is needed for zone transfers, etc.
+
+
+
+property RCode : Integer read FRCode;
+
+
+
+After DNS operation contains ResultCode of DNS operation. Values are: 0-no error, 1-format error, 2-server failure, 3-name error, 4-not implemented, 5-refused.
+
+
+
+property Authoritative : Boolean read FAuthoritative;
+
+
+
+True
, if answer is authoritative.
+
+
+
+property Truncated : Boolean read FTRuncated;
+
+
+
+True
, if answer is truncated to 512 bytes.
+
+
+
+property AnswerInfo : TStringList read FAnswerInfo;
+
+
+
+Detailed informations from name server reply. One record per line. Record have comma delimited entries with type number, TTL and data filelds. This information contains detailed information about query reply.
+
+
+
+property NameserverInfo : TStringList read FNameserverInfo;
+
+
+
+Detailed informations from name server reply. One record per line. Record have comma delimited entries with type number, TTL and data filelds. This information contains detailed information about nameserver.
+
+
+
+property AdditionalInfo : TStringList read FAdditionalInfo;
+
+
+
+Detailed informations from name server reply. One record per line. Record have comma delimited entries with type number, TTL and data filelds. This information contains detailed additional information.
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:50
+
+
ADDED lib/synapse/docs/help/dnssend.html
Index: lib/synapse/docs/help/dnssend.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/dnssend.html
@@ -0,0 +1,367 @@
+
+
+
+
+
+dnssend
+
+
+
+Unit dnssend
+
+Description
+
+DNS client by UDP or TCP
+
+ Support for sending DNS queries by UDP or TCP protocol. It can retrieve zone transfers too!
+
+
Used RFC: RFC-1035, RFC-1183, RFC1706, RFC1712, RFC2163, RFC2230
+uses
+Overview
+Classes, Interfaces, Objects and Records
+
+
+
+Class TDNSSend
+Implementation of DNS protocol by UDP or TCP protocol.
+
+
+Functions and Procedures
+
+
+function GetMailServers (const DNSHost, Domain: AnsiString; const Servers: TStrings): Boolean;
+
+
+Constants
+
+Description
+Functions and Procedures
+
+
+function GetMailServers (const DNSHost, Domain: AnsiString; const Servers: TStrings): Boolean;
+
+
+
+A very useful function, and example of it's use is found in the TDNSSend object. This function is used to get mail servers for a domain and sort them by preference numbers. "Servers" contains only the domain names of the mail servers in the right order (without preference number!). The first domain name will always be the highest preferenced mail server. Returns boolean True
if all went well.
+Constants
+
+
+cDnsProtocol = '53';
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+QTYPE_NSAPPTR = 23;
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+QTYPE_MAILB = 253;
+
+
+
+
+QTYPE_MAILA = 254;
+
+
+
+ Generated by PasDoc 0.9.0 on 2012-04-23 21:38:50
+
+
ADDED lib/synapse/docs/help/ftpsend.TFTPList.html
Index: lib/synapse/docs/help/ftpsend.TFTPList.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/ftpsend.TFTPList.html
@@ -0,0 +1,169 @@
+
+
+
+
+
+ftpsend: Class TFTPList
+
+
+
+Class TFTPList
+
+Unit
+
+ftpsend
+Declaration
+
+type TFTPList = class(TObject)
+Description
+
+This is TList of TFTPListRec objects.
+
+ This object is used for holding lististing of all files information in listed directory on FTP server.
+Hierarchy
+Overview
+Methods
+
+Properties
+
+
+
+property List : TList read FList;
+
+
+
+property Items [Index: Integer]: TFTPListRec read GetListItem;
+
+
+
+property Lines : TStringList read FLines;
+
+
+
+property Masks : TStringList read FMasks;
+
+
+
+property UnparsedLines : TStringList read FUnparsedLines;
+
+
+Description
+Methods
+
+
+
+constructor Create ;
+
+
+
+Constructor. You not need create this object, it is created by TFTPSend class as their property.
+
+
+
+destructor Destroy ; override;
+
+
+
+
+
+procedure Clear ; virtual;
+
+
+
+Clear list.
+
+
+
+function Count : integer; virtual;
+
+
+
+count of holded TFTPListRec objects
+
+
+
+procedure Assign (Value: TFTPList ); virtual;
+
+
+
+Assigns one list to another
+
+
+
+procedure ParseLines ; virtual;
+
+
+
+try to parse raw directory listing in Lines to list of TFTPListRec .
+Properties
+
+
+
+property List : TList read FList;
+
+
+
+By this property you have access to list of TFTPListRec . This is for compatibility only. Please, use Items instead.
+
+
+
+property Items [Index: Integer]: TFTPListRec read GetListItem;
+
+
+
+By this property you have access to list of TFTPListRec .
+
+
+
+property Lines : TStringList read FLines;
+
+
+
+Set of lines with RAW directory listing for ParseLines
+
+
+
+property Masks : TStringList read FMasks;
+
+
+
+Set of masks for directory listing parser. It is predefined by default, however you can modify it as you need. (for example, you can add your own definition mask.) Mask is same as mask used in TotalCommander.
+
+
+
+property UnparsedLines : TStringList read FUnparsedLines;
+
+
+
+After ParseLines it holding lines what was not sucessfully parsed.
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:50
+
+
ADDED lib/synapse/docs/help/ftpsend.TFTPListRec.html
Index: lib/synapse/docs/help/ftpsend.TFTPListRec.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/ftpsend.TFTPListRec.html
@@ -0,0 +1,147 @@
+
+
+
+
+
+ftpsend: Class TFTPListRec
+
+
+
+Class TFTPListRec
+
+Unit
+
+ftpsend
+Declaration
+
+type TFTPListRec = class(TObject)
+Description
+
+Object for holding file information
+
+ parsed from directory listing of FTP server.
+Hierarchy
+Overview
+Methods
+
+Properties
+
+
+
+property FileName : string read FFileName write FFileName;
+
+
+
+property Directory : Boolean read FDirectory write FDirectory;
+
+
+
+property Readable : Boolean read FReadable write FReadable;
+
+
+
+property FileSize : int64 read FFileSize write FFileSize;
+
+
+
+property FileTime : TDateTime read FFileTime write FFileTime;
+
+
+
+property OriginalLine : string read FOriginalLine write FOriginalLine;
+
+
+
+property Mask : string read FMask write FMask;
+
+
+
+property Permission : string read FPermission write FPermission;
+
+
+Description
+Methods
+
+
+
+procedure Assign (Value: TFTPListRec ); virtual;
+
+
+
+You can assign another TFTPListRec to this object.
+Properties
+
+
+
+property FileName : string read FFileName write FFileName;
+
+
+
+name of file
+
+
+
+property Directory : Boolean read FDirectory write FDirectory;
+
+
+
+if name is subdirectory not file.
+
+
+
+property Readable : Boolean read FReadable write FReadable;
+
+
+
+if you have rights to read
+
+
+
+property FileSize : int64 read FFileSize write FFileSize;
+
+
+
+size of file in bytes
+
+
+
+property FileTime : TDateTime read FFileTime write FFileTime;
+
+
+
+date and time of file. Local server timezone is used. Any timezone conversions was not done!
+
+
+
+property OriginalLine : string read FOriginalLine write FOriginalLine;
+
+
+
+original unparsed line
+
+
+
+property Mask : string read FMask write FMask;
+
+
+
+mask what was used for parsing
+
+
+
+property Permission : string read FPermission write FPermission;
+
+
+
+permission string (depending on used mask!)
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:50
+
+
ADDED lib/synapse/docs/help/ftpsend.TFTPSend.html
Index: lib/synapse/docs/help/ftpsend.TFTPSend.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/ftpsend.TFTPSend.html
@@ -0,0 +1,714 @@
+
+
+
+
+
+ftpsend: Class TFTPSend
+
+
+
+Class TFTPSend
+
+Unit
+
+ftpsend
+Declaration
+
+type TFTPSend = class(TSynaClient )
+Description
+
+Implementation of FTP protocol.
+
+ Note: Are you missing properties for setting Username and Password? Look to parent TSynaClient object! (Username and Password have default values for "anonymous" FTP login)
+
+
Are you missing properties for specify server address and port? Look to parent TSynaClient too!
+Hierarchy
+Overview
+Fields
+
+Methods
+
+
+
+constructor Create ;
+
+
+
+destructor Destroy ; override;
+
+
+
+function ReadResult : Integer; virtual;
+
+
+
+procedure ParseRemote (Value: string); virtual;
+
+
+
+procedure ParseRemoteEPSV (Value: string); virtual;
+
+
+
+function FTPCommand (const Value: string): integer; virtual;
+
+
+
+function Login : Boolean; virtual;
+
+
+
+function Logout : Boolean; virtual;
+
+
+
+procedure Abort ; virtual;
+
+
+
+procedure TelnetAbort ; virtual;
+
+
+
+function List (Directory: string; NameList: Boolean): Boolean; virtual;
+
+
+
+function RetrieveFile (const FileName: string; Restore: Boolean): Boolean; virtual;
+
+
+
+function StoreFile (const FileName: string; Restore: Boolean): Boolean; virtual;
+
+
+
+function StoreUniqueFile : Boolean; virtual;
+
+
+
+function AppendFile (const FileName: string): Boolean; virtual;
+
+
+
+function RenameFile (const OldName, NewName: string): Boolean; virtual;
+
+
+
+function DeleteFile (const FileName: string): Boolean; virtual;
+
+
+
+function FileSize (const FileName: string): int64; virtual;
+
+
+
+function NoOp : Boolean; virtual;
+
+
+
+function ChangeWorkingDir (const Directory: string): Boolean; virtual;
+
+
+
+function ChangeToParentDir : Boolean; virtual;
+
+
+
+function ChangeToRootDir : Boolean; virtual;
+
+
+
+function DeleteDir (const Directory: string): Boolean; virtual;
+
+
+
+function CreateDir (const Directory: string): Boolean; virtual;
+
+
+
+function GetCurrentDir : String; virtual;
+
+
+
+function DataRead (const DestStream: TStream): Boolean; virtual;
+
+
+
+function DataWrite (const SourceStream: TStream): Boolean; virtual;
+
+
+Properties
+
+
+
+property ResultCode : Integer read FResultCode;
+
+
+
+property ResultString : string read FResultString;
+
+
+
+property FullResult : TStringList read FFullResult;
+
+
+
+property Account : string read FAccount Write FAccount;
+
+
+
+property FWHost : string read FFWHost Write FFWHost;
+
+
+
+property FWPort : string read FFWPort Write FFWPort;
+
+
+
+property FWUsername : string read FFWUsername Write FFWUsername;
+
+
+
+property FWPassword : string read FFWPassword Write FFWPassword;
+
+
+
+property FWMode : integer read FFWMode Write FFWMode;
+
+
+
+property Sock : TTCPBlockSocket read FSock;
+
+
+
+property DSock : TTCPBlockSocket read FDSock;
+
+
+
+property DataStream : TMemoryStream read FDataStream;
+
+
+
+property DataIP : string read FDataIP;
+
+
+
+property DataPort : string read FDataPort;
+
+
+
+property DirectFile : Boolean read FDirectFile Write FDirectFile;
+
+
+
+property DirectFileName : string read FDirectFileName Write FDirectFileName;
+
+
+
+property CanResume : Boolean read FCanResume;
+
+
+
+property PassiveMode : Boolean read FPassiveMode Write FPassiveMode;
+
+
+
+property ForceDefaultPort : Boolean read FForceDefaultPort Write FForceDefaultPort;
+
+
+
+property ForceOldPort : Boolean read FForceOldPort Write FForceOldPort;
+
+
+
+property OnStatus : TFTPStatus read FOnStatus write FOnStatus;
+
+
+
+property FtpList : TFTPList read FFtpList;
+
+
+
+property BinaryMode : Boolean read FBinaryMode Write FBinaryMode;
+
+
+
+property AutoTLS : Boolean read FAutoTLS Write FAutoTLS;
+
+
+
+property FullSSL : Boolean read FFullSSL Write FFullSSL;
+
+
+
+property IsTLS : Boolean read FIsTLS;
+
+
+
+property IsDataTLS : Boolean read FIsDataTLS;
+
+
+
+property TLSonData : Boolean read FTLSonData write FTLSonData;
+
+
+Description
+Fields
+
+
+Custom definition of login sequence. You can use this when you set FWMode to value -1.
+Methods
+
+
+
+constructor Create ;
+
+
+
+
+
+destructor Destroy ; override;
+
+
+
+
+
+function ReadResult : Integer; virtual;
+
+
+
+Waits and read FTP server response. You need this only in special cases!
+
+
+
+procedure ParseRemote (Value: string); virtual;
+
+
+
+Parse remote side information of data channel from value string (returned by PASV command). This function you need only in special cases!
+
+
+
+procedure ParseRemoteEPSV (Value: string); virtual;
+
+
+
+Parse remote side information of data channel from value string (returned by EPSV command). This function you need only in special cases!
+
+
+
+function FTPCommand (const Value: string): integer; virtual;
+
+
+
+Send Value as FTP command to FTP server. Returned result code is result of this function. This command is good for sending site specific command, or non-standard commands.
+
+
+
+function Login : Boolean; virtual;
+
+
+
+Connect and logon to FTP server. If you specify any FireWall, connect to firewall and throw them connect to FTP server. Login sequence depending on FWMode .
+
+
+
+function Logout : Boolean; virtual;
+
+
+
+Logoff and disconnect from FTP server.
+
+
+
+procedure Abort ; virtual;
+
+
+
+Break current transmission of data. (You can call this method from Sock.OnStatus event, or from another thread.)
+
+
+
+procedure TelnetAbort ; virtual;
+
+
+
+Break current transmission of data. It is same as Abort, but it send abort telnet commands prior ABOR FTP command. Some servers need it. (You can call this method from Sock.OnStatus event, or from another thread.)
+
+
+
+function List (Directory: string; NameList: Boolean): Boolean; virtual;
+
+
+
+Download directory listing of Directory on FTP server. If Directory is empty string, download listing of current working directory. If NameList is True
, download only names of files in directory. (internally use NLST command instead LIST command) If NameList is False
, returned list is also parsed to FtpList property.
+
+
+
+function RetrieveFile (const FileName: string; Restore: Boolean): Boolean; virtual;
+
+
+
+Read data from FileName on FTP server. If Restore is True
and server supports resume dowloads, download is resumed. (received is only rest of file)
+
+
+
+function StoreFile (const FileName: string; Restore: Boolean): Boolean; virtual;
+
+
+
+Send data to FileName on FTP server. If Restore is True
and server supports resume upload, upload is resumed. (send only rest of file) In this case if remote file is same length as local file, nothing will be done. If remote file is larger then local, resume is disabled and file is transfered from begin!
+
+
+
+function StoreUniqueFile : Boolean; virtual;
+
+
+
+Send data to FTP server and assing unique name for this file.
+
+
+
+function AppendFile (const FileName: string): Boolean; virtual;
+
+
+
+Append data to FileName on FTP server.
+
+
+
+function RenameFile (const OldName, NewName: string): Boolean; virtual;
+
+
+
+Rename on FTP server file with OldName to NewName.
+
+
+
+function DeleteFile (const FileName: string): Boolean; virtual;
+
+
+
+Delete file FileName on FTP server.
+
+
+
+function FileSize (const FileName: string): int64; virtual;
+
+
+
+Return size of Filename file on FTP server. If command failed (i.e. not implemented), return -1.
+
+
+
+function NoOp : Boolean; virtual;
+
+
+
+Send NOOP command to FTP server for preserve of disconnect by inactivity timeout.
+
+
+
+function ChangeWorkingDir (const Directory: string): Boolean; virtual;
+
+
+
+Change currect working directory to Directory on FTP server.
+
+
+
+function ChangeToParentDir : Boolean; virtual;
+
+
+
+walk to upper directory on FTP server.
+
+
+
+function ChangeToRootDir : Boolean; virtual;
+
+
+
+walk to root directory on FTP server. (May not work with all servers properly!)
+
+
+
+function DeleteDir (const Directory: string): Boolean; virtual;
+
+
+
+Delete Directory on FTP server.
+
+
+
+function CreateDir (const Directory: string): Boolean; virtual;
+
+
+
+Create Directory on FTP server.
+
+
+
+function GetCurrentDir : String; virtual;
+
+
+
+Return current working directory on FTP server.
+
+
+
+function DataRead (const DestStream: TStream): Boolean; virtual;
+
+
+
+Establish data channel to FTP server and retrieve data. This function you need only in special cases, i.e. when you need to implement some special unsupported FTP command!
+
+
+
+function DataWrite (const SourceStream: TStream): Boolean; virtual;
+
+
+
+Establish data channel to FTP server and send data. This function you need only in special cases, i.e. when you need to implement some special unsupported FTP command.
+Properties
+
+
+
+property ResultCode : Integer read FResultCode;
+
+
+
+After FTP command contains result number of this operation.
+
+
+
+property ResultString : string read FResultString;
+
+
+
+After FTP command contains main line of result.
+
+
+
+property FullResult : TStringList read FFullResult;
+
+
+
+After any FTP command it contains all lines of FTP server reply.
+
+
+
+property Account : string read FAccount Write FAccount;
+
+
+
+Account information used in some cases inside login sequence.
+
+
+
+property FWHost : string read FFWHost Write FFWHost;
+
+
+
+Address of firewall. If empty string (default), firewall not used.
+
+
+
+property FWPort : string read FFWPort Write FFWPort;
+
+
+
+port of firewall. standard value is same port as ftp server used. (21)
+
+
+
+property FWUsername : string read FFWUsername Write FFWUsername;
+
+
+
+Username for login to firewall. (if needed)
+
+
+
+property FWPassword : string read FFWPassword Write FFWPassword;
+
+
+
+password for login to firewall. (if needed)
+
+
+
+property FWMode : integer read FFWMode Write FFWMode;
+
+
+
+Type of Firewall. Used only if you set some firewall address. Supported predefined firewall login sequences are described by comments in source file where you can see pseudocode decribing each sequence.
+
+
+Socket object used for TCP/IP operation on control channel. Good for seting OnStatus hook, etc.
+
+
+Socket object used for TCP/IP operation on data channel. Good for seting OnStatus hook, etc.
+
+
+
+property DataStream : TMemoryStream read FDataStream;
+
+
+
+If you not use DirectFile mode, all data transfers is made to or from this stream.
+
+
+
+property DataIP : string read FDataIP;
+
+
+
+After data connection is established, contains remote side IP of this connection.
+
+
+
+property DataPort : string read FDataPort;
+
+
+
+After data connection is established, contains remote side port of this connection.
+
+
+
+property DirectFile : Boolean read FDirectFile Write FDirectFile;
+
+
+
+Mode of data handling by data connection. If False
, all data operations are made to or from DataStream TMemoryStream. If True
, data operations is made directly to file in your disk. (filename is specified by DirectFileName property.) Dafault is False
!
+
+
+
+property DirectFileName : string read FDirectFileName Write FDirectFileName;
+
+
+
+Filename for direct disk data operations.
+
+
+
+property CanResume : Boolean read FCanResume;
+
+
+
+Indicate after Login if remote server support resume downloads and uploads.
+
+
+
+property PassiveMode : Boolean read FPassiveMode Write FPassiveMode;
+
+
+
+If true (default value), all transfers is made by passive method. It is safer method for various firewalls.
+
+
+
+property ForceDefaultPort : Boolean read FForceDefaultPort Write FForceDefaultPort;
+
+
+
+Force to listen for dataconnection on standard port (20). Default is False
, dataconnections will be made to any non-standard port reported by PORT FTP command. This setting is not used, if you use passive mode.
+
+
+
+property ForceOldPort : Boolean read FForceOldPort Write FForceOldPort;
+
+
+
+When is True
, then is disabled EPSV and EPRT support. However without this commands you cannot use IPv6! (Disabling of this commands is needed only when you are behind some crap firewall/NAT.
+
+
+
+property OnStatus : TFTPStatus read FOnStatus write FOnStatus;
+
+
+
+You may set this hook for monitoring FTP commands and replies.
+
+
+
+property FtpList : TFTPList read FFtpList;
+
+
+
+After LIST command is here parsed list of files in given directory.
+
+
+
+property BinaryMode : Boolean read FBinaryMode Write FBinaryMode;
+
+
+
+if True
(default), then data transfers is in binary mode. If this is set to False
, then ASCII mode is used.
+
+
+
+property AutoTLS : Boolean read FAutoTLS Write FAutoTLS;
+
+
+
+if is true, then if server support upgrade to SSL/TLS mode, then use them.
+
+
+
+property FullSSL : Boolean read FFullSSL Write FFullSSL;
+
+
+
+if server listen on SSL/TLS port, then you set this to true.
+
+
+
+property IsTLS : Boolean read FIsTLS;
+
+
+
+Signalise, if control channel is in SSL/TLS mode.
+
+
+
+property IsDataTLS : Boolean read FIsDataTLS;
+
+
+
+Signalise, if data transfers is in SSL/TLS mode.
+
+
+
+property TLSonData : Boolean read FTLSonData write FTLSonData;
+
+
+
+If True
(default), then try to use SSL/TLS on data transfers too. If False
, then SSL/TLS is used only for control connection.
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:50
+
+
ADDED lib/synapse/docs/help/ftpsend.html
Index: lib/synapse/docs/help/ftpsend.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/ftpsend.html
@@ -0,0 +1,137 @@
+
+
+
+
+
+ftpsend
+
+
+
+Unit ftpsend
+
+Description
+ uses
+Overview
+Classes, Interfaces, Objects and Records
+
+
+
+Class TFTPListRec
+Object for holding file information
+
+
+Class TFTPList
+This is TList of TFTPListRec objects.
+
+
+Class TFTPSend
+Implementation of FTP protocol.
+
+
+Functions and Procedures
+
+
+function FtpGetFile (const IP, Port, FileName, LocalFile, User, Pass: string): Boolean;
+
+
+function FtpPutFile (const IP, Port, FileName, LocalFile, User, Pass: string): Boolean;
+
+
+function FtpInterServerTransfer ( const FromIP, FromPort, FromFile, FromUser, FromPass: string; const ToIP, ToPort, ToFile, ToUser, ToPass: string): Boolean;
+
+
+Types
+
+
+TLogonActions = array [0..17] of byte;
+
+
+TFTPStatus = procedure(Sender: TObject; Response: Boolean; const Value: string) of object;
+
+
+Constants
+
+Description
+Functions and Procedures
+
+
+function FtpGetFile (const IP, Port, FileName, LocalFile, User, Pass: string): Boolean;
+
+
+
+A very useful function, and example of use can be found in the TFtpSend object. Dowload specified file from FTP server to LocalFile.
+
+
+function FtpPutFile (const IP, Port, FileName, LocalFile, User, Pass: string): Boolean;
+
+
+
+A very useful function, and example of use can be found in the TFtpSend object. Upload specified LocalFile to FTP server.
+
+
+function FtpInterServerTransfer ( const FromIP, FromPort, FromFile, FromUser, FromPass: string; const ToIP, ToPort, ToFile, ToUser, ToPass: string): Boolean;
+
+
+
+A very useful function, and example of use can be found in the TFtpSend object. Initiate transfer of file between two FTP servers.
+Types
+
+
+TLogonActions = array [0..17] of byte;
+
+
+
+Array for holding definition of logon sequence.
+
+
+TFTPStatus = procedure(Sender: TObject; Response: Boolean; const Value: string) of object;
+
+
+
+Procedural type for OnStatus event. Sender is calling TFTPSend object. Value is FTP command or reply to this comand. (if it is reply, Response is True
).
+Constants
+
+
+cFtpProtocol = '21';
+
+
+
+
+cFtpDataProtocol = '20';
+
+
+
+
+Terminating value for TLogonActions
+
+
+Terminating value for TLogonActions
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:50
+
+
ADDED lib/synapse/docs/help/ftptsend.TTFTPSend.html
Index: lib/synapse/docs/help/ftptsend.TTFTPSend.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/ftptsend.TTFTPSend.html
@@ -0,0 +1,192 @@
+
+
+
+
+
+ftptsend: Class TTFTPSend
+
+
+
+Class TTFTPSend
+
+Unit
+
+ftptsend
+Declaration
+
+type TTFTPSend = class(TSynaClient )
+Description
+
+Implementation of TFTP client and server
+
+ Note: Are you missing properties for specify server address and port? Look to parent TSynaClient too!
+Hierarchy
+Overview
+Methods
+
+
+
+constructor Create ;
+
+
+
+destructor Destroy ; override;
+
+
+
+function SendFile (const Filename: string): Boolean;
+
+
+
+function RecvFile (const Filename: string): Boolean;
+
+
+
+function WaitForRequest (var Req: word; var filename: string): Boolean;
+
+
+
+procedure ReplyError (Error: word; Description: string);
+
+
+
+function ReplyRecv : Boolean;
+
+
+
+function ReplySend : Boolean;
+
+
+Properties
+
+
+
+property ErrorCode : integer read FErrorCode;
+
+
+
+property ErrorString : string read FErrorString;
+
+
+
+property Data : TMemoryStream read FData;
+
+
+
+property RequestIP : string read FRequestIP write FRequestIP;
+
+
+
+property RequestPort : string read FRequestPort write FRequestPort;
+
+
+Description
+Methods
+
+
+
+constructor Create ;
+
+
+
+
+
+destructor Destroy ; override;
+
+
+
+
+
+function SendFile (const Filename: string): Boolean;
+
+
+
+Upload Data as file to TFTP server.
+
+
+
+function RecvFile (const Filename: string): Boolean;
+
+
+
+Download file from TFTP server to Data .
+
+
+
+function WaitForRequest (var Req: word; var filename: string): Boolean;
+
+
+
+Acts as TFTP server and wait for client request. When some request incoming within Timeout, result is True
and parametres is filled with information from request. You must handle this request, validate it, and call ReplyError , ReplyRecv or ReplySend for send reply to TFTP Client.
+
+
+
+procedure ReplyError (Error: word; Description: string);
+
+
+
+send error to TFTP client, when you acts as TFTP server.
+
+
+
+function ReplyRecv : Boolean;
+
+
+
+Accept uploaded file from TFTP client to Data , when you acts as TFTP server.
+
+
+
+function ReplySend : Boolean;
+
+
+
+Accept download request file from TFTP client and send content of Data , when you acts as TFTP server.
+Properties
+
+
+
+property ErrorCode : integer read FErrorCode;
+
+
+
+Code of TFTP error.
+
+
+
+property ErrorString : string read FErrorString;
+
+
+
+Human readable decription of TFTP error. (if is sended by remote side)
+
+
+
+property Data : TMemoryStream read FData;
+
+
+
+MemoryStream with datas for sending or receiving
+
+
+
+property RequestIP : string read FRequestIP write FRequestIP;
+
+
+
+Address of TFTP remote side.
+
+
+
+property RequestPort : string read FRequestPort write FRequestPort;
+
+
+
+Port of TFTP remote side.
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:50
+
+
ADDED lib/synapse/docs/help/ftptsend.html
Index: lib/synapse/docs/help/ftptsend.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/ftptsend.html
@@ -0,0 +1,89 @@
+
+
+
+
+
+ftptsend
+
+
+
+Unit ftptsend
+
+Description
+
+TFTP client and server protocol
+
+
+
+
Used RFC: RFC-1350
+uses
+Overview
+Classes, Interfaces, Objects and Records
+
+
+
+Class TTFTPSend
+Implementation of TFTP client and server
+
+
+Constants
+
+Description
+Constants
+
+
+cTFTPProtocol = '69';
+
+
+
+
+cTFTP_RRQ = word(1);
+
+
+
+
+cTFTP_WRQ = word(2);
+
+
+
+
+cTFTP_DTA = word(3);
+
+
+
+
+cTFTP_ACK = word(4);
+
+
+
+
+cTFTP_ERR = word(5);
+
+
+ Generated by PasDoc 0.9.0 on 2012-04-23 21:38:50
+
+
ADDED lib/synapse/docs/help/httpsend.THTTPSend.html
Index: lib/synapse/docs/help/httpsend.THTTPSend.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/httpsend.THTTPSend.html
@@ -0,0 +1,360 @@
+
+
+
+
+
+httpsend: Class THTTPSend
+
+
+
+Class THTTPSend
+
+Unit
+
+httpsend
+Declaration
+
+type THTTPSend = class(TSynaClient )
+Description
+
+abstract(Implementation of HTTP protocol.)
+Hierarchy
+Overview
+Methods
+
+
+
+constructor Create ;
+
+
+
+destructor Destroy ; override;
+
+
+
+procedure Clear ;
+
+
+
+procedure DecodeStatus (const Value: string);
+
+
+
+function HTTPMethod (const Method, URL: string): Boolean;
+
+
+
+procedure Abort ;
+
+
+Properties
+
+
+
+property Headers : TStringList read FHeaders;
+
+
+
+property Cookies : TStringList read FCookies;
+
+
+
+property Document : TMemoryStream read FDocument;
+
+
+
+property RangeStart : integer read FRangeStart Write FRangeStart;
+
+
+
+property RangeEnd : integer read FRangeEnd Write FRangeEnd;
+
+
+
+property MimeType : string read FMimeType Write FMimeType;
+
+
+
+property Protocol : string read FProtocol Write FProtocol;
+
+
+
+property KeepAlive : Boolean read FKeepAlive Write FKeepAlive;
+
+
+
+property KeepAliveTimeout : integer read FKeepAliveTimeout Write FKeepAliveTimeout;
+
+
+
+property Status100 : Boolean read FStatus100 Write FStatus100;
+
+
+
+property ProxyHost : string read FProxyHost Write FProxyHost;
+
+
+
+property ProxyPort : string read FProxyPort Write FProxyPort;
+
+
+
+property ProxyUser : string read FProxyUser Write FProxyUser;
+
+
+
+property ProxyPass : string read FProxyPass Write FProxyPass;
+
+
+
+property UserAgent : string read FUserAgent Write FUserAgent;
+
+
+
+property ResultCode : Integer read FResultCode;
+
+
+
+property ResultString : string read FResultString;
+
+
+
+property DownloadSize : integer read FDownloadSize;
+
+
+
+property UploadSize : integer read FUploadSize;
+
+
+
+property Sock : TTCPBlockSocket read FSock;
+
+
+
+property AddPortNumberToHost : Boolean read FAddPortNumberToHost write FAddPortNumberToHost;
+
+
+Description
+Methods
+
+
+
+constructor Create ;
+
+
+
+
+
+destructor Destroy ; override;
+
+
+
+
+
+procedure Clear ;
+
+
+
+Reset headers and document and Mimetype.
+
+
+
+procedure DecodeStatus (const Value: string);
+
+
+
+Decode ResultCode and ResultString from Value.
+
+
+
+function HTTPMethod (const Method, URL: string): Boolean;
+
+
+
+Connects to host define in URL and access to resource defined in URL by method. If Document is not empty, send it to server as part of HTTP request. Server response is in Document and headers. Connection may be authorised by username and password in URL. If you define proxy properties, connection is made by this proxy. If all OK, result is True
, else result is False
.
+
+
If you use in URL 'https:' instead only 'http:', then your request is made by SSL/TLS connection (if you not specify port, then port 443 is used instead standard port 80). If you use SSL/TLS request and you have defined HTTP proxy, then HTTP-tunnel mode is automaticly used .
+
+
+
+procedure Abort ;
+
+
+
+You can call this method from OnStatus event for break current data transfer. (or from another thread.)
+Properties
+
+
+
+property Headers : TStringList read FHeaders;
+
+
+
+Before HTTP operation you may define any non-standard headers for HTTP request, except of: 'Expect: 100-continue', 'Content-Length', 'Content-Type', 'Connection', 'Authorization', 'Proxy-Authorization' and 'Host' headers. After HTTP operation contains full headers of returned document.
+
+
+
+property Cookies : TStringList read FCookies;
+
+
+
+This is stringlist with name-value stringlist pairs. Each this pair is one cookie. After HTTP request is returned cookies parsed to this stringlist. You can leave this cookies untouched for next HTTP request. You can also save this stringlist for later use.
+
+
+
+property Document : TMemoryStream read FDocument;
+
+
+
+Stream with document to send (before request, or with document received from HTTP server (after request).
+
+
+
+property RangeStart : integer read FRangeStart Write FRangeStart;
+
+
+
+If you need download only part of requested document, here specify possition of subpart begin. If here 0, then is requested full document.
+
+
+
+property RangeEnd : integer read FRangeEnd Write FRangeEnd;
+
+
+
+If you need download only part of requested document, here specify possition of subpart end. If here 0, then is requested document from rangeStart to end of document. (for broken download restoration, for example.)
+
+
+
+property MimeType : string read FMimeType Write FMimeType;
+
+
+
+Mime type of sending data. Default is: 'text/html'.
+
+
+
+property Protocol : string read FProtocol Write FProtocol;
+
+
+
+Define protocol version. Possible values are: '1.1', '1.0' (default) and '0.9'.
+
+
+
+property KeepAlive : Boolean read FKeepAlive Write FKeepAlive;
+
+
+
+If True
(default value), keepalives in HTTP protocol 1.1 is enabled.
+
+
+
+property KeepAliveTimeout : integer read FKeepAliveTimeout Write FKeepAliveTimeout;
+
+
+
+Define timeout for keepalives in seconds!
+
+
+
+property Status100 : Boolean read FStatus100 Write FStatus100;
+
+
+
+if True
, then server is requested for 100status capability when uploading data. Default is False
(off).
+
+
+
+property ProxyHost : string read FProxyHost Write FProxyHost;
+
+
+
+Address of proxy server (IP address or domain name) where you want to connect in HTTPMethod method.
+
+
+
+property ProxyPort : string read FProxyPort Write FProxyPort;
+
+
+
+Port number for proxy connection. Default value is 8080.
+
+
+
+property ProxyUser : string read FProxyUser Write FProxyUser;
+
+
+
+Username for connect to proxy server where you want to connect in HTTPMethod method.
+
+
+
+property ProxyPass : string read FProxyPass Write FProxyPass;
+
+
+
+Password for connect to proxy server where you want to connect in HTTPMethod method.
+
+
+
+property UserAgent : string read FUserAgent Write FUserAgent;
+
+
+
+Here you can specify custom User-Agent indentification. By default is used: 'Mozilla/4.0 (compatible; Synapse)'
+
+
+
+property ResultCode : Integer read FResultCode;
+
+
+
+After successful HTTPMethod method contains result code of operation.
+
+
+
+property ResultString : string read FResultString;
+
+
+
+After successful HTTPMethod method contains string after result code.
+
+
+
+property DownloadSize : integer read FDownloadSize;
+
+
+
+if this value is not 0, then data download pending. In this case you have here total sice of downloaded data. It is good for draw download progressbar from OnStatus event.
+
+
+
+property UploadSize : integer read FUploadSize;
+
+
+
+if this value is not 0, then data upload pending. In this case you have here total sice of uploaded data. It is good for draw upload progressbar from OnStatus event.
+
+
+Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.
+
+
+
+property AddPortNumberToHost : Boolean read FAddPortNumberToHost write FAddPortNumberToHost;
+
+
+
+To have possibility to switch off port number in 'Host:' HTTP header, by default True
. Some buggy servers not like port informations in this header.
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:50
+
+
ADDED lib/synapse/docs/help/httpsend.html
Index: lib/synapse/docs/help/httpsend.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/httpsend.html
@@ -0,0 +1,119 @@
+
+
+
+
+
+httpsend
+
+
+
+Unit httpsend
+
+Description
+ uses
+Overview
+Classes, Interfaces, Objects and Records
+
+Functions and Procedures
+
+
+function HttpGetText (const URL: string; const Response: TStrings): Boolean;
+
+
+function HttpGetBinary (const URL: string; const Response: TStream): Boolean;
+
+
+function HttpPostBinary (const URL: string; const Data: TStream): Boolean;
+
+
+function HttpPostURL (const URL, URLData: string; const Data: TStream): Boolean;
+
+
+function HttpPostFile (const URL, FieldName, FileName: string; const Data: TStream; const ResultData: TStrings): Boolean;
+
+
+Types
+
+Constants
+
+Description
+Functions and Procedures
+
+
+function HttpGetText (const URL: string; const Response: TStrings): Boolean;
+
+
+
+A very usefull function, and example of use can be found in the THTTPSend object. It implements the GET method of the HTTP protocol. This function sends the GET method for URL document to an HTTP server. Returned document is in the "Response" stringlist (without any headers). Returns boolean TRUE if all went well.
+
+
+function HttpGetBinary (const URL: string; const Response: TStream): Boolean;
+
+
+
+A very usefull function, and example of use can be found in the THTTPSend object. It implements the GET method of the HTTP protocol. This function sends the GET method for URL document to an HTTP server. Returned document is in the "Response" stream. Returns boolean TRUE if all went well.
+
+
+function HttpPostBinary (const URL: string; const Data: TStream): Boolean;
+
+
+
+A very useful function, and example of use can be found in the THTTPSend object. It implements the POST method of the HTTP protocol. This function sends the SEND method for a URL document to an HTTP server. The document to be sent is located in "Data" stream. The returned document is in the "Data" stream. Returns boolean TRUE if all went well.
+
+
+function HttpPostURL (const URL, URLData: string; const Data: TStream): Boolean;
+
+
+
+A very useful function, and example of use can be found in the THTTPSend object. It implements the POST method of the HTTP protocol. This function is good for POSTing form data. It sends the POST method for a URL document to an HTTP server. You must prepare the form data in the same manner as you would the URL data, and pass this prepared data to "URLdata". The following is a sample of how the data would appear: 'name=Lukas&field1=some%20data'. The information in the field must be encoded by EncodeURLElement function. The returned document is in the "Data" stream. Returns boolean TRUE if all went well.
+
+
+function HttpPostFile (const URL, FieldName, FileName: string; const Data: TStream; const ResultData: TStrings): Boolean;
+
+
+
+A very useful function, and example of use can be found in the THTTPSend object. It implements the POST method of the HTTP protocol. This function sends the POST method for a URL document to an HTTP server. This function simulate posting of file by HTML form used method 'multipart/form-data'. Posting file is in DATA stream. Its name is Filename string. Fieldname is for name of formular field with file. (simulate HTML INPUT FILE) The returned document is in the ResultData Stringlist. Returns boolean TRUE if all went well.
+Types
+
+
+TTransferEncoding = (...);
+
+
+
+These encoding types are used internally by the THTTPSend object to identify the transfer data types.
+
+
+TE_UNKNOWN:
+
+TE_IDENTITY:
+
+TE_CHUNKED:
+
+Constants
+
+
+cHttpProtocol = '80';
+
+
+ Generated by PasDoc 0.9.0 on 2012-04-23 21:38:50
+
+
ADDED lib/synapse/docs/help/imapsend.TIMAPSend.html
Index: lib/synapse/docs/help/imapsend.TIMAPSend.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/imapsend.TIMAPSend.html
@@ -0,0 +1,626 @@
+
+
+
+
+
+imapsend: Class TIMAPSend
+
+
+
+Class TIMAPSend
+
+Unit
+
+imapsend
+Declaration
+
+type TIMAPSend = class(TSynaClient )
+Description
+
+Implementation of IMAP4 protocol.
+
+ Note: Are you missing properties for setting Username and Password? Look to parent TSynaClient object!
+
+
Are you missing properties for specify server address and port? Look to parent TSynaClient too!
+Hierarchy
+Overview
+Methods
+
+
+
+constructor Create ;
+
+
+
+destructor Destroy ; override;
+
+
+
+function IMAPcommand (Value: string): string;
+
+
+
+function IMAPuploadCommand (Value: string; const Data:TStrings): string;
+
+
+
+function Capability : Boolean;
+
+
+
+function Login : Boolean;
+
+
+
+function Logout : Boolean;
+
+
+
+function NoOp : Boolean;
+
+
+
+function List (FromFolder: string; const FolderList: TStrings): Boolean;
+
+
+
+function ListSearch (FromFolder, Search: string; const FolderList: TStrings): Boolean;
+
+
+
+function ListSubscribed (FromFolder: string; const FolderList: TStrings): Boolean;
+
+
+
+function ListSearchSubscribed (FromFolder, Search: string; const FolderList: TStrings): Boolean;
+
+
+
+function CreateFolder (FolderName: string): Boolean;
+
+
+
+function DeleteFolder (FolderName: string): Boolean;
+
+
+
+function RenameFolder (FolderName, NewFolderName: string): Boolean;
+
+
+
+function SubscribeFolder (FolderName: string): Boolean;
+
+
+
+function UnsubscribeFolder (FolderName: string): Boolean;
+
+
+
+function SelectFolder (FolderName: string): Boolean;
+
+
+
+function SelectROFolder (FolderName: string): Boolean;
+
+
+
+function CloseFolder : Boolean;
+
+
+
+function StatusFolder (FolderName, Value: string): integer;
+
+
+
+function ExpungeFolder : Boolean;
+
+
+
+function CheckFolder : Boolean;
+
+
+
+function AppendMess (ToFolder: string; const Mess: TStrings): Boolean;
+
+
+
+function DeleteMess (MessID: integer): boolean;
+
+
+
+function FetchMess (MessID: integer; const Mess: TStrings): Boolean;
+
+
+
+function FetchHeader (MessID: integer; const Headers: TStrings): Boolean;
+
+
+
+function MessageSize (MessID: integer): integer;
+
+
+
+function CopyMess (MessID: integer; ToFolder: string): Boolean;
+
+
+
+function SearchMess (Criteria: string; const FoundMess: TStrings): Boolean;
+
+
+
+function SetFlagsMess (MessID: integer; Flags: string): Boolean;
+
+
+
+function GetFlagsMess (MessID: integer; var Flags: string): Boolean;
+
+
+
+function AddFlagsMess (MessID: integer; Flags: string): Boolean;
+
+
+
+function DelFlagsMess (MessID: integer; Flags: string): Boolean;
+
+
+
+function StartTLS : Boolean;
+
+
+
+function GetUID (MessID: integer; var UID : Integer): Boolean;
+
+
+
+function FindCap (const Value: string): string;
+
+
+Properties
+
+
+
+property ResultString : string read FResultString;
+
+
+
+property FullResult : TStringList read FFullResult;
+
+
+
+property IMAPcap : TStringList read FIMAPcap;
+
+
+
+property AuthDone : Boolean read FAuthDone;
+
+
+
+property UID : Boolean read FUID Write FUID;
+
+
+
+property SelectedFolder : string read FSelectedFolder;
+
+
+
+property SelectedCount : integer read FSelectedCount;
+
+
+
+property SelectedRecent : integer read FSelectedRecent;
+
+
+
+property SelectedUIDvalidity : integer read FSelectedUIDvalidity;
+
+
+
+property AutoTLS : Boolean read FAutoTLS Write FAutoTLS;
+
+
+
+property FullSSL : Boolean read FFullSSL Write FFullSSL;
+
+
+
+property Sock : TTCPBlockSocket read FSock;
+
+
+Description
+Methods
+
+
+
+constructor Create ;
+
+
+
+
+
+destructor Destroy ; override;
+
+
+
+
+
+function IMAPcommand (Value: string): string;
+
+
+
+By this function you can call any IMAP command. Result of this command is in adequate properties.
+
+
+
+function IMAPuploadCommand (Value: string; const Data:TStrings): string;
+
+
+
+By this function you can call any IMAP command what need upload any data. Result of this command is in adequate properties.
+
+
+
+function Capability : Boolean;
+
+
+
+Call CAPABILITY command and fill IMAPcap property by new values.
+
+
+
+function Login : Boolean;
+
+
+
+Connect to IMAP server and do login to this server. This command begin session.
+
+
+
+function Logout : Boolean;
+
+
+
+Disconnect from IMAP server and terminate session session. If exists some deleted and non-purged messages, these messages are not deleted!
+
+
+
+function NoOp : Boolean;
+
+
+
+Do NOOP. It is for prevent disconnect by timeout.
+
+
+
+function List (FromFolder: string; const FolderList: TStrings): Boolean;
+
+
+
+Lists folder names. You may specify level of listing. If you specify FromFolder as empty string, return is all folders in system.
+
+
+
+function ListSearch (FromFolder, Search: string; const FolderList: TStrings): Boolean;
+
+
+
+Lists folder names what match search criteria. You may specify level of listing. If you specify FromFolder as empty string, return is all folders in system.
+
+
+
+function ListSubscribed (FromFolder: string; const FolderList: TStrings): Boolean;
+
+
+
+Lists subscribed folder names. You may specify level of listing. If you specify FromFolder as empty string, return is all subscribed folders in system.
+
+
+
+function ListSearchSubscribed (FromFolder, Search: string; const FolderList: TStrings): Boolean;
+
+
+
+Lists subscribed folder names what matching search criteria. You may specify level of listing. If you specify FromFolder as empty string, return is all subscribed folders in system.
+
+
+
+function CreateFolder (FolderName: string): Boolean;
+
+
+
+Create a new folder.
+
+
+
+function DeleteFolder (FolderName: string): Boolean;
+
+
+
+Delete a folder.
+
+
+
+function RenameFolder (FolderName, NewFolderName: string): Boolean;
+
+
+
+Rename folder names.
+
+
+
+function SubscribeFolder (FolderName: string): Boolean;
+
+
+
+Subscribe folder.
+
+
+
+function UnsubscribeFolder (FolderName: string): Boolean;
+
+
+
+Unsubscribe folder.
+
+
+
+function SelectFolder (FolderName: string): Boolean;
+
+
+
+Select folder.
+
+
+
+function SelectROFolder (FolderName: string): Boolean;
+
+
+
+Select folder, but only for reading. Any changes are not allowed!
+
+
+
+function CloseFolder : Boolean;
+
+
+
+Close a folder. (end of Selected state)
+
+
+
+function StatusFolder (FolderName, Value: string): integer;
+
+
+
+Ask for given status of folder. I.e. if you specify as value 'UNSEEN', result is number of unseen messages in folder. For another status indentificator check IMAP documentation and documentation of your IMAP server (each IMAP server can have their own statuses.)
+
+
+
+function ExpungeFolder : Boolean;
+
+
+
+Hardly delete all messages marked as 'deleted' in current selected folder.
+
+
+
+function CheckFolder : Boolean;
+
+
+
+Touch to folder. (use as update status of folder, etc.)
+
+
+
+function AppendMess (ToFolder: string; const Mess: TStrings): Boolean;
+
+
+
+Append given message to specified folder.
+
+
+
+function DeleteMess (MessID: integer): boolean;
+
+
+
+'Delete' message from current selected folder. It mark message as Deleted. Real deleting will be done after sucessfull CloseFolder or ExpungeFolder
+
+
+
+function FetchMess (MessID: integer; const Mess: TStrings): Boolean;
+
+
+
+Get full message from specified message in selected folder.
+
+
+
+function FetchHeader (MessID: integer; const Headers: TStrings): Boolean;
+
+
+
+Get message headers only from specified message in selected folder.
+
+
+
+function MessageSize (MessID: integer): integer;
+
+
+
+Return message size of specified message from current selected folder.
+
+
+
+function CopyMess (MessID: integer; ToFolder: string): Boolean;
+
+
+
+Copy message from current selected folder to another folder.
+
+
+
+function SearchMess (Criteria: string; const FoundMess: TStrings): Boolean;
+
+
+
+Return message numbers from currently selected folder as result of searching. Search criteria is very complex language (see to IMAP specification) similar to SQL (but not same syntax!).
+
+
+
+function SetFlagsMess (MessID: integer; Flags: string): Boolean;
+
+
+
+Sets flags of message from current selected folder.
+
+
+
+function GetFlagsMess (MessID: integer; var Flags: string): Boolean;
+
+
+
+Gets flags of message from current selected folder.
+
+
+
+function AddFlagsMess (MessID: integer; Flags: string): Boolean;
+
+
+
+Add flags to message's flags.
+
+
+
+function DelFlagsMess (MessID: integer; Flags: string): Boolean;
+
+
+
+Remove flags from message's flags.
+
+
+
+function StartTLS : Boolean;
+
+
+
+Call STARTTLS command for upgrade connection to SSL/TLS mode.
+
+
+
+function GetUID (MessID: integer; var UID : Integer): Boolean;
+
+
+
+return UID of requested message ID.
+
+
+
+function FindCap (const Value: string): string;
+
+
+
+Try to find given capabily in capabilty string returned from IMAP server.
+Properties
+
+
+
+property ResultString : string read FResultString;
+
+
+
+Status line with result of last operation.
+
+
+
+property FullResult : TStringList read FFullResult;
+
+
+
+Full result of last IMAP operation.
+
+
+
+property IMAPcap : TStringList read FIMAPcap;
+
+
+
+List of server capabilites.
+
+
+
+property AuthDone : Boolean read FAuthDone;
+
+
+
+Authorization is successful done.
+
+
+
+property UID : Boolean read FUID Write FUID;
+
+
+
+Turn on or off usage of UID (unicate identificator) of messages instead only sequence numbers.
+
+
+
+property SelectedFolder : string read FSelectedFolder;
+
+
+
+Name of currently selected folder.
+
+
+
+property SelectedCount : integer read FSelectedCount;
+
+
+
+Count of messages in currently selected folder.
+
+
+
+property SelectedRecent : integer read FSelectedRecent;
+
+
+
+Count of not-visited messages in currently selected folder.
+
+
+
+property SelectedUIDvalidity : integer read FSelectedUIDvalidity;
+
+
+
+This number with name of folder is unique indentificator of folder. (If someone delete folder and next create new folder with exactly same name of folder, this number is must be different!)
+
+
+
+property AutoTLS : Boolean read FAutoTLS Write FAutoTLS;
+
+
+
+If is set to true, then upgrade to SSL/TLS mode if remote server support it.
+
+
+
+property FullSSL : Boolean read FFullSSL Write FFullSSL;
+
+
+
+SSL/TLS mode is used from first contact to server. Servers with full SSL/TLS mode usualy using non-standard TCP port!
+
+
+Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:51
+
+
ADDED lib/synapse/docs/help/imapsend.html
Index: lib/synapse/docs/help/imapsend.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/imapsend.html
@@ -0,0 +1,49 @@
+
+
+
+
+
+imapsend
+
+
+
+Unit imapsend
+
+Description
+
+IMAP4 rev1 protocol client
+
+
+
+
Used RFC: RFC-2060, RFC-2595
+uses
+Overview
+Classes, Interfaces, Objects and Records
+
+
+
+Class TIMAPSend
+Implementation of IMAP4 protocol.
+
+
+Constants
+
+Description
+Constants
+
+
+cIMAPProtocol = '143';
+
+
+ Generated by PasDoc 0.9.0 on 2012-04-23 21:38:50
+
+
ADDED lib/synapse/docs/help/index.html
Index: lib/synapse/docs/help/index.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/index.html
@@ -0,0 +1,8 @@
+
+
+
+
+
+
+
+
ADDED lib/synapse/docs/help/laz_synapse.html
Index: lib/synapse/docs/help/laz_synapse.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/laz_synapse.html
@@ -0,0 +1,18 @@
+
+
+
+
+
+laz_synapse
+
+
+
+Unit laz_synapse
+
+
+Description uses Classes, Interfaces, Objects and Records Functions and Procedures Types Constants Variables
+Description
+ uses
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:51
+
+
ADDED lib/synapse/docs/help/ldapsend.TLDAPAttribute.html
Index: lib/synapse/docs/help/ldapsend.TLDAPAttribute.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/ldapsend.TLDAPAttribute.html
@@ -0,0 +1,59 @@
+
+
+
+
+
+ldapsend: Class TLDAPAttribute
+
+
+
+Class TLDAPAttribute
+
+Unit
+
+ldapsend
+Declaration
+
+type TLDAPAttribute = class(TStringList)
+Description
+
+LDAP attribute with list of their values
+
+ This class holding name of LDAP attribute and list of their values. This is descendant of TStringList class enhanced by some new properties.
+Hierarchy
+TStringList
+TLDAPAttribute Overview
+Properties
+
+
+
+property AttributeName : AnsiString read FAttributeName Write SetAttributeName;
+
+
+
+property IsBinary : Boolean read FIsBinary;
+
+
+Description
+Properties
+
+
+
+property AttributeName : AnsiString read FAttributeName Write SetAttributeName;
+
+
+
+Name of LDAP attribute.
+
+
+
+property IsBinary : Boolean read FIsBinary;
+
+
+
+Return True
when attribute contains binary data.
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:51
+
+
ADDED lib/synapse/docs/help/ldapsend.TLDAPAttributeList.html
Index: lib/synapse/docs/help/ldapsend.TLDAPAttributeList.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/ldapsend.TLDAPAttributeList.html
@@ -0,0 +1,143 @@
+
+
+
+
+
+ldapsend: Class TLDAPAttributeList
+
+
+
+Class TLDAPAttributeList
+
+Unit
+
+ldapsend
+Declaration
+
+type TLDAPAttributeList = class(TObject)
+Description
+
+List of TLDAPAttribute
+
+ This object can hold list of TLDAPAttribute objects.
+Hierarchy
+TObject
+TLDAPAttributeList Overview
+Methods
+
+Properties
+
+Description
+Methods
+
+
+
+constructor Create ;
+
+
+
+
+
+destructor Destroy ; override;
+
+
+
+
+
+procedure Clear ;
+
+
+
+Clear list.
+
+
+
+function Count : integer;
+
+
+
+Return count of TLDAPAttribute objects in list.
+
+
+Add new TLDAPAttribute object to list.
+
+
+
+procedure Del (Index: integer);
+
+
+
+Delete one TLDAPAttribute object from list.
+
+
+Find and return attribute with requested name. Returns nil if not found.
+
+
+
+function Get (AttributeName: AnsiString): string;
+
+
+
+Find and return attribute value with requested name. Returns empty string if not found.
+Properties
+
+
+
+property Items [Index: Integer]: TLDAPAttribute read GetAttribute;
+
+
+
+List of TLDAPAttribute objects.
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:51
+
+
ADDED lib/synapse/docs/help/ldapsend.TLDAPResult.html
Index: lib/synapse/docs/help/ldapsend.TLDAPResult.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/ldapsend.TLDAPResult.html
@@ -0,0 +1,83 @@
+
+
+
+
+
+ldapsend: Class TLDAPResult
+
+
+
+Class TLDAPResult
+
+Unit
+
+ldapsend
+Declaration
+
+type TLDAPResult = class(TObject)
+Description
+
+LDAP result object
+
+ This object can hold LDAP object. (their name and all their attributes with values)
+Hierarchy
+Overview
+Methods
+
+
+
+constructor Create ;
+
+
+
+destructor Destroy ; override;
+
+
+Properties
+
+Description
+Methods
+
+
+
+constructor Create ;
+
+
+
+
+
+destructor Destroy ; override;
+
+
+ Properties
+
+
+
+property ObjectName : AnsiString read FObjectName write FObjectName;
+
+
+
+Name of this LDAP object.
+
+
+Here is list of object attributes.
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:51
+
+
ADDED lib/synapse/docs/help/ldapsend.TLDAPResultList.html
Index: lib/synapse/docs/help/ldapsend.TLDAPResultList.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/ldapsend.TLDAPResultList.html
@@ -0,0 +1,107 @@
+
+
+
+
+
+ldapsend: Class TLDAPResultList
+
+
+
+Class TLDAPResultList
+
+Unit
+
+ldapsend
+Declaration
+
+type TLDAPResultList = class(TObject)
+Description
+
+List of LDAP result objects
+
+ This object can hold list of LDAP objects. (for example result of LDAP SEARCH.)
+Hierarchy
+Overview
+Methods
+
+Properties
+
+Description
+Methods
+
+
+
+constructor Create ;
+
+
+
+
+
+destructor Destroy ; override;
+
+
+
+
+
+procedure Clear ;
+
+
+
+Clear all TLDAPResult objects in list.
+
+
+
+function Count : integer;
+
+
+
+Return count of TLDAPResult objects in list.
+
+
+Create and add new TLDAPResult object to list.
+Properties
+
+
+
+property Items [Index: Integer]: TLDAPResult read GetResult;
+
+
+
+List of TLDAPResult objects.
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:51
+
+
ADDED lib/synapse/docs/help/ldapsend.TLDAPSend.html
Index: lib/synapse/docs/help/ldapsend.TLDAPSend.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/ldapsend.TLDAPSend.html
@@ -0,0 +1,404 @@
+
+
+
+
+
+ldapsend: Class TLDAPSend
+
+
+
+Class TLDAPSend
+
+Unit
+
+ldapsend
+Declaration
+
+type TLDAPSend = class(TSynaClient )
+Description
+
+Implementation of LDAP client
+
+ (version 2 and 3)
+
+
Note: Are you missing properties for setting Username and Password? Look to parent TSynaClient object!
+
+
Are you missing properties for specify server address and port? Look to parent TSynaClient too!
+Hierarchy
+Overview
+Methods
+
+
+
+constructor Create ;
+
+
+
+destructor Destroy ; override;
+
+
+
+function Login : Boolean;
+
+
+
+function Bind : Boolean;
+
+
+
+function BindSasl : Boolean;
+
+
+
+function Logout : Boolean;
+
+
+
+function Modify (obj: AnsiString; Op: TLDAPModifyOp ; const Value: TLDAPAttribute ): Boolean;
+
+
+
+function Add (obj: AnsiString; const Value: TLDAPAttributeList ): Boolean;
+
+
+
+function Delete (obj: AnsiString): Boolean;
+
+
+
+function ModifyDN (obj, newRDN, newSuperior: AnsiString; DeleteoldRDN: Boolean): Boolean;
+
+
+
+function Compare (obj, AttributeValue: AnsiString): Boolean;
+
+
+
+function Search (obj: AnsiString; TypesOnly: Boolean; Filter: AnsiString; const Attributes: TStrings): Boolean;
+
+
+
+function Extended (const Name, Value: AnsiString): Boolean;
+
+
+
+function StartTLS : Boolean;
+
+
+Properties
+
+Description
+Methods
+
+
+
+constructor Create ;
+
+
+
+
+
+destructor Destroy ; override;
+
+
+
+
+
+function Login : Boolean;
+
+
+
+Try to connect to LDAP server and start secure channel, when it is required.
+
+
+
+function Bind : Boolean;
+
+
+
+Try to bind to LDAP server with TSynaClient .UserName and TSynaClient .Password . If this is empty strings, then it do annonymous Bind. When you not call Bind on LDAPv3, then is automaticly used anonymous mode.
+
+
This method using plaintext transport of password! It is not secure!
+
+
+
+function BindSasl : Boolean;
+
+
+
+Try to bind to LDAP server with TSynaClient .UserName and TSynaClient .Password . If this is empty strings, then it do annonymous Bind. When you not call Bind on LDAPv3, then is automaticly used anonymous mode.
+
+
This method using SASL with DIGEST-MD5 method for secure transfer of your password.
+
+
+
+function Logout : Boolean;
+
+
+
+Close connection to LDAP server.
+
+
+Modify content of LDAP attribute on this object.
+
+
+Add list of attributes to specified object.
+
+
+
+function Delete (obj: AnsiString): Boolean;
+
+
+
+Delete this LDAP object from server.
+
+
+
+function ModifyDN (obj, newRDN, newSuperior: AnsiString; DeleteoldRDN: Boolean): Boolean;
+
+
+
+Modify object name of this LDAP object.
+
+
+
+function Compare (obj, AttributeValue: AnsiString): Boolean;
+
+
+
+Try to compare Attribute value with this LDAP object.
+
+
+
+function Search (obj: AnsiString; TypesOnly: Boolean; Filter: AnsiString; const Attributes: TStrings): Boolean;
+
+
+
+Search LDAP base for LDAP objects by Filter.
+
+
+
+function Extended (const Name, Value: AnsiString): Boolean;
+
+
+
+Call any LDAPv3 extended command.
+
+
+
+function StartTLS : Boolean;
+
+
+
+Try to start SSL/TLS connection to LDAP server.
+Properties
+
+
+
+property Version : integer read FVersion Write FVersion;
+
+
+
+Specify version of used LDAP protocol. Default value is 3.
+
+
+
+property ResultCode : Integer read FResultCode;
+
+
+
+Result code of last LDAP operation.
+
+
+
+property ResultString : AnsiString read FResultString;
+
+
+
+Human readable description of result code of last LDAP operation.
+
+
+
+property FullResult : AnsiString read FFullResult;
+
+
+
+Binary string with full last response of LDAP server. This string is encoded by ASN.1 BER encoding! You need this only for debugging.
+
+
+
+property AutoTLS : Boolean read FAutoTLS Write FAutoTLS;
+
+
+
+If True
, then try to start TSL mode in Login procedure.
+
+
+
+property FullSSL : Boolean read FFullSSL Write FFullSSL;
+
+
+
+If True
, then use connection to LDAP server through SSL/TLS tunnel.
+
+
+
+property Seq : integer read FSeq;
+
+
+
+Sequence number of last LDAp command. It is incremented by any LDAP command.
+
+
+
+property SearchScope : TLDAPSearchScope read FSearchScope Write FSearchScope;
+
+
+
+Specify what search scope is used in search command.
+
+
+
+property SearchAliases : TLDAPSearchAliases read FSearchAliases Write FSearchAliases;
+
+
+
+Specify how to handle aliases in search command.
+
+
+
+property SearchSizeLimit : integer read FSearchSizeLimit Write FSearchSizeLimit;
+
+
+
+Specify result size limit in search command. Value 0 means without limit.
+
+
+
+property SearchTimeLimit : integer read FSearchTimeLimit Write FSearchTimeLimit;
+
+
+
+Specify search time limit in search command (seconds). Value 0 means without limit.
+
+
+Here is result of search command.
+
+
+
+property Referals : TStringList read FReferals;
+
+
+
+On each LDAP operation can LDAP server return some referals URLs. Here is their list.
+
+
+
+property ExtName : AnsiString read FExtName;
+
+
+
+When you call Extended operation, then here is result Name returned by server.
+
+
+
+property ExtValue : AnsiString read FExtValue;
+
+
+
+When you call Extended operation, then here is result Value returned by server.
+
+
+TCP socket used by all LDAP operations.
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:51
+
+
ADDED lib/synapse/docs/help/ldapsend.html
Index: lib/synapse/docs/help/ldapsend.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/ldapsend.html
@@ -0,0 +1,299 @@
+
+
+
+
+
+ldapsend
+
+
+
+Unit ldapsend
+
+Description
+
+LDAP client
+
+
+
+
Used RFC: RFC-2251, RFC-2254, RFC-2829, RFC-2830
+uses
+Overview
+Classes, Interfaces, Objects and Records
+
+Functions and Procedures
+
+Types
+
+Constants
+
+Description
+Functions and Procedures
+
+
+Dump result of LDAP SEARCH into human readable form. Good for debugging.
+Types
+
+
+TLDAPModifyOp = (...);
+
+
+
+Define possible operations for LDAP MODIFY operations.
+
+
+MO_Add:
+
+MO_Delete:
+
+MO_Replace:
+
+
+
+TLDAPSearchScope = (...);
+
+
+
+Specify possible values for search scope.
+
+
+SS_BaseObject:
+
+SS_SingleLevel:
+
+SS_WholeSubtree:
+
+
+
+TLDAPSearchAliases = (...);
+
+
+
+Specify possible values about alias dereferencing.
+
+
+SA_NeverDeref:
+
+SA_InSearching:
+
+SA_FindingBaseObj:
+
+SA_Always:
+
+Constants
+
+
+cLDAPProtocol = '389';
+
+
+
+
+LDAP_ASN1_BIND_REQUEST = $60;
+
+
+
+
+LDAP_ASN1_BIND_RESPONSE = $61;
+
+
+
+
+LDAP_ASN1_UNBIND_REQUEST = $42;
+
+
+
+
+LDAP_ASN1_SEARCH_REQUEST = $63;
+
+
+
+
+LDAP_ASN1_SEARCH_ENTRY = $64;
+
+
+
+
+LDAP_ASN1_SEARCH_DONE = $65;
+
+
+
+
+LDAP_ASN1_SEARCH_REFERENCE = $73;
+
+
+
+
+LDAP_ASN1_MODIFY_REQUEST = $66;
+
+
+
+
+LDAP_ASN1_MODIFY_RESPONSE = $67;
+
+
+
+
+LDAP_ASN1_ADD_REQUEST = $68;
+
+
+
+
+LDAP_ASN1_ADD_RESPONSE = $69;
+
+
+
+
+LDAP_ASN1_DEL_REQUEST = $4A;
+
+
+
+
+LDAP_ASN1_DEL_RESPONSE = $6B;
+
+
+
+
+LDAP_ASN1_MODIFYDN_REQUEST = $6C;
+
+
+
+
+LDAP_ASN1_MODIFYDN_RESPONSE = $6D;
+
+
+
+
+LDAP_ASN1_COMPARE_REQUEST = $6E;
+
+
+
+
+LDAP_ASN1_COMPARE_RESPONSE = $6F;
+
+
+
+
+LDAP_ASN1_ABANDON_REQUEST = $70;
+
+
+
+
+LDAP_ASN1_EXT_REQUEST = $77;
+
+
+
+
+LDAP_ASN1_EXT_RESPONSE = $78;
+
+
+ Generated by PasDoc 0.9.0 on 2012-04-23 21:38:51
+
+
ADDED lib/synapse/docs/help/legend.html
Index: lib/synapse/docs/help/legend.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/legend.html
@@ -0,0 +1,39 @@
+
+
+
+
+
+Legend
+
+
+
+Legend
+
+
+
+
+Private
+
+
+
+Protected
+
+
+
+Public
+
+
+
+Published
+
+
+
+Automated
+
+
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:53
+
+
ADDED lib/synapse/docs/help/mimeinln.html
Index: lib/synapse/docs/help/mimeinln.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/mimeinln.html
@@ -0,0 +1,100 @@
+
+
+
+
+
+mimeinln
+
+
+
+Unit mimeinln
+
+Description
+
+Utilities for inline MIME
+
+ Support for Inline MIME encoding and decoding.
+
+
Used RFC: RFC-2047, RFC-2231
+uses
+Overview
+Functions and Procedures
+
+Description
+Functions and Procedures
+
+
+function InlineDecode (const Value: string; CP: TMimeChar ): string;
+
+
+
+Decodes mime inline encoding (i.e. in headers) uses target characterset "CP".
+
+
+function InlineEncode (const Value: string; CP, MimeP: TMimeChar ): string;
+
+
+
+Encodes string to MIME inline encoding. The source characterset is "CP", and the target charset is "MimeP".
+
+
+function NeedInline (const Value: AnsiString): boolean;
+
+
+
+Returns True
, if "Value" contains characters needed for inline coding.
+
+
+function InlineCodeEx (const Value: string; FromCP: TMimeChar ): string;
+
+
+
+Inline mime encoding similar to InlineEncode , but you can specify source charset, and the target characterset is automatically assigned.
+
+
+function InlineCode (const Value: string): string;
+
+
+
+Inline MIME encoding similar to InlineEncode , but the source charset is automatically set to the system default charset, and the target charset is automatically assigned from set of allowed encoding for MIME.
+
+
+function InlineEmailEx (const Value: string; FromCP: TMimeChar ): string;
+
+
+
+Converts e-mail address to canonical mime form. You can specify source charset.
+
+
+function InlineEmail (const Value: string): string;
+
+
+
+Converts e-mail address to canonical mime form. Source charser it system default charset.
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:51
+
+
ADDED lib/synapse/docs/help/mimemess.TMessHeader.html
Index: lib/synapse/docs/help/mimemess.TMessHeader.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/mimemess.TMessHeader.html
@@ -0,0 +1,263 @@
+
+
+
+
+
+mimemess: Class TMessHeader
+
+
+
+Class TMessHeader
+
+Unit
+
+mimemess
+Declaration
+
+type TMessHeader = class(TObject)
+Description
+
+Object for basic e-mail header fields.
+Hierarchy
+Overview
+Methods
+
+
+
+constructor Create ; virtual;
+
+
+
+destructor Destroy ; override;
+
+
+
+procedure Clear ; virtual;
+
+
+
+procedure EncodeHeaders (const Value: TStrings); virtual;
+
+
+
+procedure DecodeHeaders (const Value: TStrings);
+
+
+
+function FindHeader (Value: string): string;
+
+
+
+procedure FindHeaderList (Value: string; const HeaderList: TStrings);
+
+
+Properties
+
+
+
+property From : string read FFrom Write FFrom;
+
+
+
+property ToList : TStringList read FToList;
+
+
+
+property CCList : TStringList read FCCList;
+
+
+
+property Subject : string read FSubject Write FSubject;
+
+
+
+property Organization : string read FOrganization Write FOrganization;
+
+
+
+property CustomHeaders : TStringList read FCustomHeaders;
+
+
+
+property Date : TDateTime read FDate Write FDate;
+
+
+
+property XMailer : string read FXMailer Write FXMailer;
+
+
+
+property ReplyTo : string read FReplyTo Write FReplyTo;
+
+
+
+property MessageID : string read FMessageID Write FMessageID;
+
+
+
+property Priority : TMessPriority read FPriority Write FPriority;
+
+
+
+property CharsetCode : TMimeChar read FCharsetCode Write FCharsetCode;
+
+
+Description
+Methods
+
+
+
+constructor Create ; virtual;
+
+
+
+
+
+destructor Destroy ; override;
+
+
+
+
+
+procedure Clear ; virtual;
+
+
+
+Clears all data fields.
+
+
+
+procedure EncodeHeaders (const Value: TStrings); virtual;
+
+
+
+
+
+procedure DecodeHeaders (const Value: TStrings);
+
+
+
+Parse header from Value to this object.
+
+
+
+function FindHeader (Value: string): string;
+
+
+
+Try find specific header in CustomHeader. Search is case insensitive. This is good for reading any non-parsed header.
+
+
+
+procedure FindHeaderList (Value: string; const HeaderList: TStrings);
+
+
+
+Try find specific headers in CustomHeader. This metod is for repeatly used headers like 'received' header, etc. Search is case insensitive. This is good for reading ano non-parsed header.
+Properties
+
+
+
+property From : string read FFrom Write FFrom;
+
+
+
+Sender of message.
+
+
+
+property ToList : TStringList read FToList;
+
+
+
+Stringlist with receivers of message. (one per line)
+
+
+
+property CCList : TStringList read FCCList;
+
+
+
+Stringlist with Carbon Copy receivers of message. (one per line)
+
+
+
+property Subject : string read FSubject Write FSubject;
+
+
+
+Subject of message.
+
+
+
+property Organization : string read FOrganization Write FOrganization;
+
+
+
+Organization string.
+
+
+
+property CustomHeaders : TStringList read FCustomHeaders;
+
+
+
+After decoding contains all headers lines witch not have parsed to any other structures in this object. It mean: this conatins all other headers except:
+
+
X-MAILER, FROM, SUBJECT, ORGANIZATION, TO, CC, DATE, MIME-VERSION, CONTENT-TYPE, CONTENT-DESCRIPTION, CONTENT-DISPOSITION, CONTENT-ID, CONTENT-TRANSFER-ENCODING, REPLY-TO, MESSAGE-ID, X-MSMAIL-PRIORITY, X-PRIORITY, PRIORITY
+
+
When you encode headers, all this lines is added as headers. Be carefull for duplicites!
+
+
+
+property Date : TDateTime read FDate Write FDate;
+
+
+
+Date and time of message.
+
+
+
+property XMailer : string read FXMailer Write FXMailer;
+
+
+
+Mailer identification.
+
+
+
+property ReplyTo : string read FReplyTo Write FReplyTo;
+
+
+
+Address for replies
+
+
+
+property MessageID : string read FMessageID Write FMessageID;
+
+
+
+message indetifier
+
+
+
+property Priority : TMessPriority read FPriority Write FPriority;
+
+
+
+message priority
+
+
+
+property CharsetCode : TMimeChar read FCharsetCode Write FCharsetCode;
+
+
+
+Specify base charset. By default is used system charset.
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:51
+
+
ADDED lib/synapse/docs/help/mimemess.TMimeMess.html
Index: lib/synapse/docs/help/mimemess.TMimeMess.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/mimemess.TMimeMess.html
@@ -0,0 +1,331 @@
+
+
+
+
+
+mimemess: Class TMimeMess
+
+
+
+Class TMimeMess
+
+Unit
+
+mimemess
+Declaration
+
+type TMimeMess = class(TObject)
+Description
+
+Object for handling of e-mail message.
+Hierarchy
+Overview
+Methods
+
+Properties
+
+Description
+Methods
+
+
+
+constructor Create ;
+
+
+
+
+create this object and assign your own descendant of TMessHeader object to Header property. So, you can create your own message headers parser and use it by this object.
+
+
+
+destructor Destroy ; override;
+
+
+
+
+
+procedure Clear ; virtual;
+
+
+
+Reset component to default state.
+
+
+Add MIME part as subpart of PartParent. If you need set root MIME part, then set as PartParent Nil
value. If you need set more then one subpart, you must have PartParent of multipart type!
+
+
+
+function AddPartMultipart (const MultipartType: String; const PartParent: TMimePart ): TMimePart ;
+
+
+
+Add MIME part as subpart of PartParent. If you need set root MIME part, then set as PartParent Nil
value. If you need set more then 1 subpart, you must have PartParent of multipart type!
+
+
This part is marked as multipart with secondary MIME type specified by MultipartType parameter. (typical value is 'mixed')
+
+
This part can be used as PartParent for another parts (include next multipart). If you need only one part, then you not need Multipart part.
+
+
+
+function AddPartText (const Value: TStrings; const PartParent: TMimePart ): TMimepart ;
+
+
+
+Add MIME part as subpart of PartParent. If you need set root MIME part, then set as PartParent Nil
value. If you need set more then 1 subpart, you must have PartParent of multipart type!
+
+
After creation of part set type to text part and set all necessary properties. Content of part is readed from value stringlist.
+
+
+Add MIME part as subpart of PartParent. If you need set root MIME part, then set as PartParent Nil
value. If you need set more then 1 subpart, you must have PartParent of multipart type!
+
+
After creation of part set type to text part and set all necessary properties. Content of part is readed from value stringlist. You can select your charset and your encoding type. If Raw is True
, then it not doing charset conversion!
+
+
+
+function AddPartHTML (const Value: TStrings; const PartParent: TMimePart ): TMimepart ;
+
+
+
+Add MIME part as subpart of PartParent. If you need set root MIME part, then set as PartParent Nil
value. If you need set more then 1 subpart, you must have PartParent of multipart type!
+
+
After creation of part set type to text part to HTML type and set all necessary properties. Content of HTML part is readed from Value stringlist.
+
+
+
+function AddPartTextFromFile (const FileName: String; const PartParent: TMimePart ): TMimepart ;
+
+
+
+Same as AddPartText , but content is readed from file
+
+
+
+function AddPartHTMLFromFile (const FileName: String; const PartParent: TMimePart ): TMimepart ;
+
+
+
+Same as AddPartHTML , but content is readed from file
+
+
+
+function AddPartBinary (const Stream: TStream; const FileName: string; const PartParent: TMimePart ): TMimepart ;
+
+
+
+Add MIME part as subpart of PartParent. If you need set root MIME part, then set as PartParent Nil
value. If you need set more then 1 subpart, you must have PartParent of multipart type!
+
+
After creation of part set type to binary and set all necessary properties. MIME primary and secondary types defined automaticly by filename extension. Content of binary part is readed from Stream. This binary part is encoded as file attachment.
+
+
+
+function AddPartBinaryFromFile (const FileName: string; const PartParent: TMimePart ): TMimepart ;
+
+
+
+Same as AddPartBinary , but content is readed from file
+
+
+
+function AddPartHTMLBinary (const Stream: TStream; const FileName, Cid: string; const PartParent: TMimePart ): TMimepart ;
+
+
+
+Add MIME part as subpart of PartParent. If you need set root MIME part, then set as PartParent Nil
value. If you need set more then 1 subpart, you must have PartParent of multipart type!
+
+
After creation of part set type to binary and set all necessary properties. MIME primary and secondary types defined automaticly by filename extension. Content of binary part is readed from Stream.
+
+
This binary part is encoded as inline data with given Conten ID (cid). Content ID can be used as reference ID in HTML source in HTML part.
+
+
+
+function AddPartHTMLBinaryFromFile (const FileName, Cid: string; const PartParent: TMimePart ): TMimepart ;
+
+
+
+Same as AddPartHTMLBinary , but content is readed from file
+
+
+
+function AddPartMess (const Value: TStrings; const PartParent: TMimePart ): TMimepart ;
+
+
+
+Add MIME part as subpart of PartParent. If you need set root MIME part, then set as PartParent Nil
value. If you need set more then 1 subpart, you must have PartParent of multipart type!
+
+
After creation of part set type to message and set all necessary properties. MIME primary and secondary types are setted to 'message/rfc822'. Content of raw RFC-822 message is readed from Stream.
+
+
+
+function AddPartMessFromFile (const FileName: string; const PartParent: TMimePart ): TMimepart ;
+
+
+
+Same as AddPartMess , but content is readed from file
+
+
+
+procedure EncodeMessage ;
+
+
+
+Compose message from MessagePart to Lines . Headers from Header object is added also.
+
+
+
+procedure DecodeMessage ;
+
+
+
+Decode message from Lines to MessagePart . Massage headers are parsed into Header object.
+
+
+
+procedure DecodeMessageBinary (AHeader:TStrings; AData:TMemoryStream);
+
+
+
+HTTP message is received by THTTPSend component in two parts: headers are stored in THTTPSend .Headers and a body in memory stream THTTPSend .Document .
+
+
On the top of it, HTTP connections are always 8-bit, hence data are transferred in native format i.e. no transfer encoding is applied.
+
+
This method operates the similiar way and produces the same result as DecodeMessage .
+Properties
+
+
+
+property MessagePart : TMimePart read FMessagePart;
+
+
+
+TMimePart object with decoded MIME message. This object can handle any number of nested TMimePart objects itself. It is used for handle any tree of MIME subparts.
+
+
+
+property Lines : TStringList read FLines;
+
+
+
+Raw MIME encoded message.
+
+
+Object for e-mail header fields. This object is created automaticly. Do not free this object!
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:51
+
+
ADDED lib/synapse/docs/help/mimemess.html
Index: lib/synapse/docs/help/mimemess.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/mimemess.html
@@ -0,0 +1,71 @@
+
+
+
+
+
+mimemess
+
+
+
+Unit mimemess
+
+Description
+
+MIME message handling
+
+ Classes for easy handling with e-mail message.
+uses
+Overview
+Classes, Interfaces, Objects and Records
+
+
+
+Class TMessHeader
+Object for basic e-mail header fields.
+
+
+Class TMimeMess
+Object for handling of e-mail message.
+
+
+Types
+
+Description
+Types
+
+
+TMessPriority = (...);
+
+
+
+Possible values for message priority
+
+
+MP_unknown:
+
+MP_low:
+
+MP_normal:
+
+MP_high:
+
+
+ Generated by PasDoc 0.9.0 on 2012-04-23 21:38:51
+
+
ADDED lib/synapse/docs/help/mimepart.TMimePart.html
Index: lib/synapse/docs/help/mimepart.TMimePart.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/mimepart.TMimePart.html
@@ -0,0 +1,615 @@
+
+
+
+
+
+mimepart: Class TMimePart
+
+
+
+Class TMimePart
+
+Unit
+
+mimepart
+Declaration
+
+type TMimePart = class(TObject)
+Description
+
+Object for working with parts of MIME e-mail.
+
+ Each TMimePart object can handle any number of nested subparts as new TMimepart objects. It can handle any tree hierarchy structure of nested MIME subparts itself.
+
+
Basic tasks are:
+
+
Decoding of MIME message: - store message into Lines property - call DecomposeParts. Now you have decomposed MIME parts in all nested levels! - now you can explore all properties and subparts. (You can use WalkPart method) - if you need decode part, call DecodePart.
+
+
Encoding of MIME message:
+
+
- if you need multipart message, you must create subpart by AddSubPart. - set all properties of all parts. - set content of part into DecodedLines stream - encode this stream by EncodePart. - compose full message by ComposeParts. (it build full MIME message from all subparts. Do not call this method for each subpart! It is needed on root part!) - encoded MIME message is stored in Lines property.
+Hierarchy
+Overview
+Methods
+
+Properties
+
+
+
+property Primary : string read FPrimary write SetPrimary;
+
+
+
+property Encoding : string read FEncoding write SetEncoding;
+
+
+
+property Charset : string read FCharset write SetCharset;
+
+
+
+property DefaultCharset : string read FDefaultCharset write FDefaultCharset;
+
+
+
+property PrimaryCode : TMimePrimary read FPrimaryCode Write FPrimaryCode;
+
+
+
+property EncodingCode : TMimeEncoding read FEncodingCode Write FEncodingCode;
+
+
+
+property CharsetCode : TMimeChar read FCharsetCode Write FCharsetCode;
+
+
+
+property TargetCharset : TMimeChar read FTargetCharset Write FTargetCharset;
+
+
+
+property ConvertCharset : Boolean read FConvertCharset Write FConvertCharset;
+
+
+
+property ForcedHTMLConvert : Boolean read FForcedHTMLConvert Write FForcedHTMLConvert;
+
+
+
+property Secondary : string read FSecondary Write FSecondary;
+
+
+
+property Description : string read FDescription Write FDescription;
+
+
+
+property Disposition : string read FDisposition Write FDisposition;
+
+
+
+property ContentID : string read FContentID Write FContentID;
+
+
+
+property Boundary : string read FBoundary Write FBoundary;
+
+
+
+property FileName : string read FFileName Write FFileName;
+
+
+
+property Lines : TStringList read FLines;
+
+
+
+property PartBody : TStringList read FPartBody;
+
+
+
+property Headers : TStringList read FHeaders;
+
+
+
+property PrePart : TStringList read FPrePart;
+
+
+
+property PostPart : TStringList read FPostPart;
+
+
+
+property DecodedLines : TMemoryStream read FDecodedLines;
+
+
+
+property SubLevel : integer read FSubLevel write FSubLevel;
+
+
+
+property MaxSubLevel : integer read FMaxSubLevel write FMaxSubLevel;
+
+
+
+property AttachInside : boolean read FAttachInside;
+
+
+
+property OnWalkPart : THookWalkPart read FOnWalkPart write FOnWalkPart;
+
+
+
+property MaxLineLength : integer read FMaxLineLength Write FMaxLineLength;
+
+
+Description
+Methods
+
+
+
+constructor Create ;
+
+
+
+
+
+destructor Destroy ; override;
+
+
+
+
+Assign content of another object to this object. (Only this part, not subparts!)
+
+
+
+procedure AssignSubParts (Value: TMimePart );
+
+
+
+Assign content of another object to this object. (With all subparts!)
+
+
+
+procedure Clear ;
+
+
+
+Clear all data values to default values. It also call ClearSubParts .
+
+
+
+procedure DecodePart ;
+
+
+
+Decode Mime part from Lines to DecodedLines .
+
+
+
+procedure DecodePartHeader ;
+
+
+
+Parse header lines from Headers property into another properties.
+
+
+
+procedure EncodePart ;
+
+
+
+Encode mime part from DecodedLines to Lines and build mime headers.
+
+
+
+procedure EncodePartHeader ;
+
+
+
+Build header lines in Headers property from another properties.
+
+
+
+procedure MimeTypeFromExt (Value: string);
+
+
+
+generate primary and secondary mime type from filename extension in value. If type not recognised, it return 'Application/octet-string' type.
+
+
+
+function GetSubPartCount : integer;
+
+
+
+Return number of decomposed subparts. (On this level! Each of this subparts can hold any number of their own nested subparts!)
+
+
+
+function GetSubPart (index: integer): TMimePart ;
+
+
+
+Get nested subpart object as new TMimePart. For getting maximum possible index you can use GetSubPartCount method.
+
+
+
+procedure DeleteSubPart (index: integer);
+
+
+
+delete subpart on given index.
+
+
+
+procedure ClearSubParts ;
+
+
+
+Clear and destroy all subpart TMimePart objects.
+
+
+Add and create new subpart.
+
+
+
+procedure DecomposeParts ;
+
+
+
+E-mail message in Lines property is parsed into this object. E-mail headers are stored in Headers property and is parsed into another properties automaticly. Not need call DecodePartHeader ! Content of message (part) is stored into PartBody property. This part is in undecoded form! If you need decode it, then you must call DecodePart method by your hands. Lot of another properties is filled also.
+
+
Decoding of parts you must call separately due performance reasons. (Not needed to decode all parts in all reasons.)
+
+
For each MIME subpart is created new TMimepart object (accessible via method GetSubPart ).
+
+
+
+procedure DecomposePartsBinary (AHeader:TStrings; AStx,AEtx:PANSIChar);
+
+
+
+HTTP message is received by THTTPSend component in two parts: headers are stored in THTTPSend .Headers and a body in memory stream THTTPSend .Document .
+
+
On the top of it, HTTP connections are always 8-bit, hence data are transferred in native format i.e. no transfer encoding is applied.
+
+
This method operates the similiar way and produces the same result as DecomposeParts .
+
+
+
+procedure ComposeParts ;
+
+
+
+This part and all subparts is composed into one MIME message stored in Lines property.
+
+
+
+procedure WalkPart ;
+
+
+
+By calling this method is called OnWalkPart event for each part and their subparts. It is very good for calling some code for each part in MIME message
+
+
+
+function CanSubPart : boolean;
+
+
+
+Return True
when is possible create next subpart. (MaxSubLevel is still not reached)
+Properties
+
+
+
+property Primary : string read FPrimary write SetPrimary;
+
+
+
+Primary Mime type of part. (i.e. 'application') Writing to this property automaticly generate value of PrimaryCode .
+
+
+
+property Encoding : string read FEncoding write SetEncoding;
+
+
+
+String representation of used Mime encoding in part. (i.e. 'base64') Writing to this property automaticly generate value of EncodingCode .
+
+
+
+property Charset : string read FCharset write SetCharset;
+
+
+
+String representation of used Mime charset in part. (i.e. 'iso-8859-1') Writing to this property automaticly generate value of CharsetCode . Charset is used only for text parts.
+
+
+
+property DefaultCharset : string read FDefaultCharset write FDefaultCharset;
+
+
+
+Define default charset for decoding text MIME parts without charset specification. Default value is 'ISO-8859-1' by RCF documents. But Microsoft Outlook use windows codings as default. This property allows properly decode textual parts from some broken versions of Microsoft Outlook. (this is bad software!)
+
+
+
+property PrimaryCode : TMimePrimary read FPrimaryCode Write FPrimaryCode;
+
+
+
+Decoded primary type. Possible values are: MP_TEXT, MP_MULTIPART, MP_MESSAGE and MP_BINARY. If type not recognised, result is MP_BINARY.
+
+
+
+property EncodingCode : TMimeEncoding read FEncodingCode Write FEncodingCode;
+
+
+
+Decoded encoding type. Possible values are: ME_7BIT, ME_8BIT, ME_QUOTED_PRINTABLE and ME_BASE64. If type not recognised, result is ME_7BIT.
+
+
+
+property CharsetCode : TMimeChar read FCharsetCode Write FCharsetCode;
+
+
+
+Decoded charset type. Possible values are defined in synachar unit.
+
+
+
+property TargetCharset : TMimeChar read FTargetCharset Write FTargetCharset;
+
+
+
+System charset type. Default value is charset used by default in your operating system.
+
+
+
+property ConvertCharset : Boolean read FConvertCharset Write FConvertCharset;
+
+
+
+If True
, then do internal charset translation of part content between CharsetCode and TargetCharset
+
+
+
+property ForcedHTMLConvert : Boolean read FForcedHTMLConvert Write FForcedHTMLConvert;
+
+
+
+If True
, then allways do internal charset translation of HTML parts by MIME even it have their own charset in META tag. Default is False
.
+
+
+
+property Secondary : string read FSecondary Write FSecondary;
+
+
+
+Secondary Mime type of part. (i.e. 'mixed')
+
+
+
+property Description : string read FDescription Write FDescription;
+
+
+
+Description of Mime part.
+
+
+
+property Disposition : string read FDisposition Write FDisposition;
+
+
+
+Value of content disposition field. (i.e. 'inline' or 'attachment')
+
+
+
+property ContentID : string read FContentID Write FContentID;
+
+
+
+Content ID.
+
+
+
+property Boundary : string read FBoundary Write FBoundary;
+
+
+
+Boundary delimiter of multipart Mime part. Used only in multipart part.
+
+
+
+property FileName : string read FFileName Write FFileName;
+
+
+
+Filename of file in binary part.
+
+
+
+property Lines : TStringList read FLines;
+
+
+
+String list with lines contains mime part (It can be a full message).
+
+
+
+property PartBody : TStringList read FPartBody;
+
+
+
+Encoded form of MIME part data.
+
+
+
+property Headers : TStringList read FHeaders;
+
+
+
+All header lines of MIME part.
+
+
+
+property PrePart : TStringList read FPrePart;
+
+
+
+On multipart this contains part of message between first line of message and first boundary.
+
+
+
+property PostPart : TStringList read FPostPart;
+
+
+
+On multipart this contains part of message between last boundary and end of message.
+
+
+
+property DecodedLines : TMemoryStream read FDecodedLines;
+
+
+
+Stream with decoded form of budy part.
+
+
+
+property SubLevel : integer read FSubLevel write FSubLevel;
+
+
+
+Show nested level in subpart tree. Value 0 means root part. 1 means subpart from this root. etc.
+
+
+
+property MaxSubLevel : integer read FMaxSubLevel write FMaxSubLevel;
+
+
+
+Specify maximum sublevel value for decomposing.
+
+
+
+property AttachInside : boolean read FAttachInside;
+
+
+
+When is True
, then this part maybe(!) have included some uuencoded binary data.
+
+
+
+property OnWalkPart : THookWalkPart read FOnWalkPart write FOnWalkPart;
+
+
+
+Here you can assign hook procedure for walking through all part and their subparts.
+
+
+
+property MaxLineLength : integer read FMaxLineLength Write FMaxLineLength;
+
+
+
+Here you can specify maximum line length for encoding of MIME part. If line is longer, then is splitted by standard of MIME. Correct MIME mailers can de-split this line into original length.
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:51
+
+
ADDED lib/synapse/docs/help/mimepart.html
Index: lib/synapse/docs/help/mimepart.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/mimepart.html
@@ -0,0 +1,187 @@
+
+
+
+
+
+mimepart
+
+
+
+Unit mimepart
+
+Description
+
+MIME part handling
+
+ Handling with MIME parts.
+
+
Used RFC: RFC-2045
+uses
+Overview
+Classes, Interfaces, Objects and Records
+
+
+
+Class TMimePart
+Object for working with parts of MIME e-mail.
+
+
+Functions and Procedures
+
+Types
+
+Constants
+
+
+MaxMimeType = 25;
+
+
+MimeType : array[0..MaxMimeType , 0..2] of string =
+ (
+ ('AU', 'audio', 'basic'),
+ ('AVI', 'video', 'x-msvideo'),
+ ('BMP', 'image', 'BMP'),
+ ('DOC', 'application', 'MSWord'),
+ ('EPS', 'application', 'Postscript'),
+ ('GIF', 'image', 'GIF'),
+ ('JPEG', 'image', 'JPEG'),
+ ('JPG', 'image', 'JPEG'),
+ ('MID', 'audio', 'midi'),
+ ('MOV', 'video', 'quicktime'),
+ ('MPEG', 'video', 'MPEG'),
+ ('MPG', 'video', 'MPEG'),
+ ('MP2', 'audio', 'mpeg'),
+ ('MP3', 'audio', 'mpeg'),
+ ('PDF', 'application', 'PDF'),
+ ('PNG', 'image', 'PNG'),
+ ('PS', 'application', 'Postscript'),
+ ('QT', 'video', 'quicktime'),
+ ('RA', 'audio', 'x-realaudio'),
+ ('RTF', 'application', 'RTF'),
+ ('SND', 'audio', 'basic'),
+ ('TIF', 'image', 'TIFF'),
+ ('TIFF', 'image', 'TIFF'),
+ ('WAV', 'audio', 'x-wav'),
+ ('WPD', 'application', 'Wordperfect5.1'),
+ ('ZIP', 'application', 'ZIP')
+ );
+
+
+Description
+Functions and Procedures
+
+
+function GenerateBoundary : string;
+
+
+
+Generates a unique boundary string.
+Types
+
+
+THookWalkPart = procedure(const Sender: TMimePart ) of object;
+
+
+
+Procedural type for TMimePart .WalkPart hook
+
+. This hook is used for easy walking through MIME subparts.
+
+
+TMimePrimary = (...);
+
+
+
+The four types of MIME parts. (textual, multipart, message or any other binary data.)
+
+
+MP_TEXT:
+
+MP_MULTIPART:
+
+MP_MESSAGE:
+
+MP_BINARY:
+
+
+
+TMimeEncoding = (...);
+
+
+
+The various types of possible part encodings.
+
+
+ME_7BIT:
+
+ME_8BIT:
+
+ME_QUOTED_PRINTABLE:
+
+ME_BASE64:
+
+ME_UU:
+
+ME_XX:
+
+Constants
+
+
+
+MimeType : array[0..MaxMimeType , 0..2] of string =
+ (
+ ('AU', 'audio', 'basic'),
+ ('AVI', 'video', 'x-msvideo'),
+ ('BMP', 'image', 'BMP'),
+ ('DOC', 'application', 'MSWord'),
+ ('EPS', 'application', 'Postscript'),
+ ('GIF', 'image', 'GIF'),
+ ('JPEG', 'image', 'JPEG'),
+ ('JPG', 'image', 'JPEG'),
+ ('MID', 'audio', 'midi'),
+ ('MOV', 'video', 'quicktime'),
+ ('MPEG', 'video', 'MPEG'),
+ ('MPG', 'video', 'MPEG'),
+ ('MP2', 'audio', 'mpeg'),
+ ('MP3', 'audio', 'mpeg'),
+ ('PDF', 'application', 'PDF'),
+ ('PNG', 'image', 'PNG'),
+ ('PS', 'application', 'Postscript'),
+ ('QT', 'video', 'quicktime'),
+ ('RA', 'audio', 'x-realaudio'),
+ ('RTF', 'application', 'RTF'),
+ ('SND', 'audio', 'basic'),
+ ('TIF', 'image', 'TIFF'),
+ ('TIFF', 'image', 'TIFF'),
+ ('WAV', 'audio', 'x-wav'),
+ ('WPD', 'application', 'Wordperfect5.1'),
+ ('ZIP', 'application', 'ZIP')
+ );
+
+
+ Generated by PasDoc 0.9.0 on 2012-04-23 21:38:51
+
+
ADDED lib/synapse/docs/help/navigation.html
Index: lib/synapse/docs/help/navigation.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/navigation.html
@@ -0,0 +1,24 @@
+
+
+
+
+Navigation
+
+
+
+
ADDED lib/synapse/docs/help/nntpsend.TNNTPSend.html
Index: lib/synapse/docs/help/nntpsend.TNNTPSend.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/nntpsend.TNNTPSend.html
@@ -0,0 +1,398 @@
+
+
+
+
+
+nntpsend: Class TNNTPSend
+
+
+
+Class TNNTPSend
+
+Unit
+
+nntpsend
+Declaration
+
+type TNNTPSend = class(TSynaClient )
+Description
+
+abstract(Implementation of Network News Transfer Protocol.
+
+
Note: Are you missing properties for setting Username and Password? Look to parent TSynaClient object!
+
+
Are you missing properties for specify server address and port? Look to parent TSynaClient too!
+Hierarchy
+Overview
+Methods
+
+
+
+constructor Create ;
+
+
+
+destructor Destroy ; override;
+
+
+
+function Login : Boolean;
+
+
+
+function Logout : Boolean;
+
+
+
+function DoCommand (const Command: string): boolean;
+
+
+
+function DoCommandRead (const Command: string): boolean;
+
+
+
+function DoCommandWrite (const Command: string): boolean;
+
+
+
+function GetArticle (const Value: string): Boolean;
+
+
+
+function GetBody (const Value: string): Boolean;
+
+
+
+function GetHead (const Value: string): Boolean;
+
+
+
+function GetStat (const Value: string): Boolean;
+
+
+
+function SelectGroup (const Value: string): Boolean;
+
+
+
+function IHave (const MessID: string): Boolean;
+
+
+
+function GotoLast : Boolean;
+
+
+
+function GotoNext : Boolean;
+
+
+
+function ListGroups : Boolean;
+
+
+
+function ListNewGroups (Since: TDateTime): Boolean;
+
+
+
+function NewArticles (const Group: string; Since: TDateTime): Boolean;
+
+
+
+function PostArticle : Boolean;
+
+
+
+function SwitchToSlave : Boolean;
+
+
+
+function Xover (xoStart, xoEnd: string): boolean;
+
+
+
+function StartTLS : Boolean;
+
+
+
+function FindCap (const Value: string): string;
+
+
+
+function ListExtensions : Boolean;
+
+
+Properties
+
+
+
+property ResultCode : Integer read FResultCode;
+
+
+
+property ResultString : string read FResultString;
+
+
+
+property Data : TStringList read FData;
+
+
+
+property AutoTLS : Boolean read FAutoTLS Write FAutoTLS;
+
+
+
+property FullSSL : Boolean read FFullSSL Write FFullSSL;
+
+
+
+property Sock : TTCPBlockSocket read FSock;
+
+
+Description
+Methods
+
+
+
+constructor Create ;
+
+
+
+
+
+destructor Destroy ; override;
+
+
+
+
+
+function Login : Boolean;
+
+
+
+Connects to NNTP server and begin session.
+
+
+
+function Logout : Boolean;
+
+
+
+Logout from NNTP server and terminate session.
+
+
+
+function DoCommand (const Command: string): boolean;
+
+
+
+By this you can call any NNTP command.
+
+
+
+function DoCommandRead (const Command: string): boolean;
+
+
+
+by this you can call any NNTP command. This variant is used for commands for download information from server.
+
+
+
+function DoCommandWrite (const Command: string): boolean;
+
+
+
+by this you can call any NNTP command. This variant is used for commands for upload information to server.
+
+
+
+function GetArticle (const Value: string): Boolean;
+
+
+
+Download full message to Data property. Value can be number of message or message-id (in brackets).
+
+
+
+function GetBody (const Value: string): Boolean;
+
+
+
+Download only body of message to Data property. Value can be number of message or message-id (in brackets).
+
+
+
+function GetHead (const Value: string): Boolean;
+
+
+
+Download only headers of message to Data property. Value can be number of message or message-id (in brackets).
+
+
+
+function GetStat (const Value: string): Boolean;
+
+
+
+Get message status. Value can be number of message or message-id (in brackets).
+
+
+
+function SelectGroup (const Value: string): Boolean;
+
+
+
+Select given group.
+
+
+
+function IHave (const MessID: string): Boolean;
+
+
+
+Tell to server 'I have mesage with given message-ID.' If server need this message, message is uploaded to server.
+
+
+
+function GotoLast : Boolean;
+
+
+
+Move message pointer to last item in group.
+
+
+
+function GotoNext : Boolean;
+
+
+
+Move message pointer to next item in group.
+
+
+
+function ListGroups : Boolean;
+
+
+
+Download to Data property list of all groups on NNTP server.
+
+
+
+function ListNewGroups (Since: TDateTime): Boolean;
+
+
+
+Download to Data property list of all groups created after given time.
+
+
+
+function NewArticles (const Group: string; Since: TDateTime): Boolean;
+
+
+
+Download to Data property list of message-ids in given group since given time.
+
+
+
+function PostArticle : Boolean;
+
+
+
+Upload new article to server. (for new messages by you)
+
+
+
+function SwitchToSlave : Boolean;
+
+
+
+Tells to remote NNTP server 'I am not NNTP client, but I am another NNTP server'.
+
+
+
+function Xover (xoStart, xoEnd: string): boolean;
+
+
+
+Call NNTP XOVER command.
+
+
+
+function StartTLS : Boolean;
+
+
+
+Call STARTTLS command for upgrade connection to SSL/TLS mode.
+
+
+
+function FindCap (const Value: string): string;
+
+
+
+Try to find given capability in extension list. This list is getted after successful login to NNTP server. If extension capability is not found, then return is empty string.
+
+
+
+function ListExtensions : Boolean;
+
+
+
+Try get list of server extensions. List is returned in Data property.
+Properties
+
+
+
+property ResultCode : Integer read FResultCode;
+
+
+
+Result code number of last operation.
+
+
+
+property ResultString : string read FResultString;
+
+
+
+String description of last result code from NNTP server.
+
+
+
+property Data : TStringList read FData;
+
+
+
+Readed data. (message, etc.)
+
+
+
+property AutoTLS : Boolean read FAutoTLS Write FAutoTLS;
+
+
+
+If is set to True
, then upgrade to SSL/TLS mode after login if remote server support it.
+
+
+
+property FullSSL : Boolean read FFullSSL Write FFullSSL;
+
+
+
+SSL/TLS mode is used from first contact to server. Servers with full SSL/TLS mode usualy using non-standard TCP port!
+
+
+Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:51
+
+
ADDED lib/synapse/docs/help/nntpsend.html
Index: lib/synapse/docs/help/nntpsend.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/nntpsend.html
@@ -0,0 +1,49 @@
+
+
+
+
+
+nntpsend
+
+
+
+Unit nntpsend
+
+Description
+
+NNTP client
+
+ NNTP (network news transfer protocol)
+
+
Used RFC: RFC-977, RFC-2980
+uses
+Overview
+Classes, Interfaces, Objects and Records
+
+Constants
+
+Description
+Constants
+
+
+cNNTPProtocol = '119';
+
+
+ Generated by PasDoc 0.9.0 on 2012-04-23 21:38:51
+
+
ADDED lib/synapse/docs/help/pasdoc.css
Index: lib/synapse/docs/help/pasdoc.css
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/pasdoc.css
@@ -0,0 +1,82 @@
+body { font-family: Verdana,Arial;
+ color: black; background-color: white;
+ font-size: 12px; }
+body.navigationframe { font-family: Verdana,Arial;
+ color: white; background-color: #787878;
+ font-size: 12px; }
+
+img { border:0px; }
+
+a:link {color:#C91E0C; text-decoration: none; }
+a:visited {color:#7E5C31; text-decoration: none; }
+a:hover {text-decoration: underline; }
+a:active {text-decoration: underline; }
+
+a.navigation:link { color: white; text-decoration: none; font-size: 12px;}
+a.navigation:visited { color: white; text-decoration: none; font-size: 12px;}
+a.navigation:hover { color: white; font-weight: bold;
+ text-decoration: none; font-size: 12px; }
+a.navigation:active { color: white; text-decoration: none; font-size: 12px;}
+
+a.bold:link {color:#C91E0C; text-decoration: none; font-weight:bold; }
+a.bold:visited {color:#7E5C31; text-decoration: none; font-weight:bold; }
+a.bold:hover {text-decoration: underline; font-weight:bold; }
+a.bold:active {text-decoration: underline; font-weight:bold; }
+
+a.section {color: green; text-decoration: none; font-weight: bold; }
+a.section:hover {color: green; text-decoration: underline; font-weight: bold; }
+
+ul.useslist a:link {color:#C91E0C; text-decoration: none; font-weight:bold; }
+ul.useslist a:visited {color:#7E5C31; text-decoration: none; font-weight:bold; }
+ul.useslist a:hover {text-decoration: underline; font-weight:bold; }
+ul.useslist a:active {text-decoration: underline; font-weight:bold; }
+
+ul.hierarchy { list-style-type:none; }
+ul.hierarchylevel { list-style-type:none; }
+
+p.unitlink a:link {color:#C91E0C; text-decoration: none; font-weight:bold; }
+p.unitlink a:visited {color:#7E5C31; text-decoration: none; font-weight:bold; }
+p.unitlink a:hover {text-decoration: underline; font-weight:bold; }
+p.unitlink a:active {text-decoration: underline; font-weight:bold; }
+
+tr.list { background: #FFBF44; }
+tr.list2 { background: #FFC982; }
+tr.listheader { background: #C91E0C; color: white; }
+
+table { border-spacing:2px; padding:4px; width:100%; }
+
+table.markerlegend { width:auto; }
+table.markerlegend td.legendmarker { text-align:center; }
+
+table.sections { background:white; }
+table.sections td {background:lightgray; }
+
+table.summary td.itemcode { width:100%; }
+table.detail td.itemcode { width:100%; }
+
+td { vertical-align:top; padding:4px; }
+
+td.itemname {white-space:nowrap; }
+td.itemunit {white-space:nowrap; }
+td.itemdesc { width:100%; }
+
+div.nodescription {color:red;}
+dl.parameters {;}
+dl.parameters dt {color:blue;}
+dl.parameters dd {;}
+
+/* Style applied to Pascal code in documentation
+ (e.g. produced by @longcode tag) } */
+span.pascal_string { color: #000080; }
+span.pascal_keyword { font-weight: bolder; }
+span.pascal_comment { color: #000080; font-style: italic; }
+span.pascal_compiler_comment { color: #008000; }
+span.pascal_numeric { }
+span.pascal_hex { }
+
+p.hint_directive { color: red; }
+
+input#search_text { }
+input#search_submit_button { }
+
+acronym.mispelling { background-color: #ffa; }
ADDED lib/synapse/docs/help/pingsend.TPINGSend.html
Index: lib/synapse/docs/help/pingsend.TPINGSend.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/pingsend.TPINGSend.html
@@ -0,0 +1,178 @@
+
+
+
+
+
+pingsend: Class TPINGSend
+
+
+
+Class TPINGSend
+
+Unit
+
+pingsend
+Declaration
+
+type TPINGSend = class(TSynaClient )
+Description
+
+Implementation of ICMP PING and ICMPv6 PING.
+Hierarchy
+Overview
+Methods
+
+
+
+function Ping (const Host: string): Boolean;
+
+
+
+constructor Create ;
+
+
+
+destructor Destroy ; override;
+
+
+Properties
+
+Description
+Methods
+
+
+
+function Ping (const Host: string): Boolean;
+
+
+
+Send ICMP ping to host and count PingTime . If ping OK, result is True
.
+
+
+
+constructor Create ;
+
+
+
+
+
+destructor Destroy ; override;
+
+
+ Properties
+
+
+
+property PacketSize : Integer read FPacketSize Write FPacketSize;
+
+
+
+Size of PING packet. Default size is 32 bytes.
+
+
+
+property PingTime : Integer read FPingTime;
+
+
+
+Time between request and reply.
+
+
+
+property ReplyFrom : string read FReplyFrom;
+
+
+
+From this address is sended reply for your PING request. It maybe not your requested destination, when some error occured!
+
+
+
+property ReplyType : byte read FReplyType;
+
+
+
+ICMP type of PING reply. Each protocol using another values! For IPv4 and IPv6 are used different values!
+
+
+
+property ReplyCode : byte read FReplyCode;
+
+
+
+ICMP code of PING reply. Each protocol using another values! For IPv4 and IPv6 are used different values! For protocol independent value look to ReplyError
+
+
+
+property ReplyError : TICMPError read FReplyError;
+
+
+
+Return type of returned ICMP message. This value is independent on used protocol!
+
+
+
+property ReplyErrorDesc : string read FReplyErrorDesc;
+
+
+
+Return human readable description of returned packet type.
+
+
+Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.
+
+
+
+property TTL : byte read FTTL write FTTL;
+
+
+
+TTL value for ICMP query
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:51
+
+
ADDED lib/synapse/docs/help/pingsend.html
Index: lib/synapse/docs/help/pingsend.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/pingsend.html
@@ -0,0 +1,155 @@
+
+
+
+
+
+pingsend
+
+
+
+Unit pingsend
+
+Description
+ uses
+Overview
+Classes, Interfaces, Objects and Records
+
+
+
+Class TPINGSend
+Implementation of ICMP PING and ICMPv6 PING.
+
+
+Functions and Procedures
+
+
+function PingHost (const Host: string): Integer;
+
+
+function TraceRouteHost (const Host: string): string;
+
+
+Types
+
+Constants
+
+Description
+Functions and Procedures
+
+
+function PingHost (const Host: string): Integer;
+
+
+
+A very useful function and example of its use would be found in the TPINGSend object. Use it to ping to any host. If successful, returns the ping time in milliseconds. Returns -1 if an error occurred.
+
+
+function TraceRouteHost (const Host: string): string;
+
+
+
+A very useful function and example of its use would be found in the TPINGSend object. Use it to TraceRoute to any host.
+Types
+
+
+TICMPError = (...);
+
+
+
+List of possible ICMP reply packet types.
+
+
+IE_NoError:
+
+IE_Other:
+
+IE_TTLExceed:
+
+IE_UnreachOther:
+
+IE_UnreachRoute:
+
+IE_UnreachAdmin:
+
+IE_UnreachAddr:
+
+IE_UnreachPort:
+
+Constants
+
+
+
+ICMP_ECHOREPLY = 0;
+
+
+
+
+
+ICMP_TIME_EXCEEDED = 11;
+
+
+
+
+
+ICMP6_ECHOREPLY = 129;
+
+
+
+
+ICMP6_UNREACH = 1;
+
+
+
+
+ICMP6_TIME_EXCEEDED = 3;
+
+
+ Generated by PasDoc 0.9.0 on 2012-04-23 21:38:51
+
+
ADDED lib/synapse/docs/help/pop3send.TPOP3Send.html
Index: lib/synapse/docs/help/pop3send.TPOP3Send.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/pop3send.TPOP3Send.html
@@ -0,0 +1,378 @@
+
+
+
+
+
+pop3send: Class TPOP3Send
+
+
+
+Class TPOP3Send
+
+Unit
+
+pop3send
+Declaration
+
+type TPOP3Send = class(TSynaClient )
+Description
+
+Implementation of POP3 client protocol.
+
+
+
+
Note: Are you missing properties for setting Username and Password? Look to parent TSynaClient object!
+
+
Are you missing properties for specify server address and port? Look to parent TSynaClient too!
+Hierarchy
+Overview
+Methods
+
+
+
+constructor Create ;
+
+
+
+destructor Destroy ; override;
+
+
+
+function CustomCommand (const Command: string; MultiLine: Boolean): boolean;
+
+
+
+function Capability : Boolean;
+
+
+
+function Login : Boolean;
+
+
+
+function Logout : Boolean;
+
+
+
+function Reset : Boolean;
+
+
+
+function NoOp : Boolean;
+
+
+
+function Stat : Boolean;
+
+
+
+function List (Value: Integer): Boolean;
+
+
+
+function Retr (Value: Integer): Boolean;
+
+
+
+function RetrStream (Value: Integer; Stream: TStream): Boolean;
+
+
+
+function Dele (Value: Integer): Boolean;
+
+
+
+function Top (Value, Maxlines: Integer): Boolean;
+
+
+
+function Uidl (Value: Integer): Boolean;
+
+
+
+function StartTLS : Boolean;
+
+
+
+function FindCap (const Value: string): string;
+
+
+Properties
+
+
+
+property ResultCode : Integer read FResultCode;
+
+
+
+property ResultString : string read FResultString;
+
+
+
+property FullResult : TStringList read FFullResult;
+
+
+
+property StatCount : Integer read FStatCount;
+
+
+
+property StatSize : Integer read FStatSize;
+
+
+
+property ListSize : Integer read FListSize;
+
+
+
+property TimeStamp : string read FTimeStamp;
+
+
+
+property AuthType : TPOP3AuthType read FAuthType Write FAuthType;
+
+
+
+property AutoTLS : Boolean read FAutoTLS Write FAutoTLS;
+
+
+
+property FullSSL : Boolean read FFullSSL Write FFullSSL;
+
+
+
+property Sock : TTCPBlockSocket read FSock;
+
+
+Description
+Methods
+
+
+
+constructor Create ;
+
+
+
+
+
+destructor Destroy ; override;
+
+
+
+
+
+function CustomCommand (const Command: string; MultiLine: Boolean): boolean;
+
+
+
+You can call any custom by this method. Call Command without trailing CRLF. If MultiLine parameter is True
, multilined response are expected. Result is True
on sucess.
+
+
+
+function Capability : Boolean;
+
+
+
+Call CAPA command for get POP3 server capabilites. note: not all servers support this command!
+
+
+
+function Login : Boolean;
+
+
+
+Connect to remote POP3 host. If all OK, result is True
.
+
+
+
+function Logout : Boolean;
+
+
+
+Disconnects from POP3 server.
+
+
+
+function Reset : Boolean;
+
+
+
+Send RSET command. If all OK, result is True
.
+
+
+
+function NoOp : Boolean;
+
+
+
+Send NOOP command. If all OK, result is True
.
+
+
+
+function Stat : Boolean;
+
+
+
+Send STAT command and fill StatCount and StatSize property. If all OK, result is True
.
+
+
+
+function List (Value: Integer): Boolean;
+
+
+
+Send LIST command. If Value is 0, LIST is for all messages. After successful operation is listing in FullResult. If all OK, result is True
.
+
+
+
+function Retr (Value: Integer): Boolean;
+
+
+
+Send RETR command. After successful operation dowloaded message in FullResult . If all OK, result is True
.
+
+
+
+function RetrStream (Value: Integer; Stream: TStream): Boolean;
+
+
+
+Send RETR command. After successful operation dowloaded message in Stream
. If all OK, result is True
.
+
+
+
+function Dele (Value: Integer): Boolean;
+
+
+
+Send DELE command for delete specified message. If all OK, result is True
.
+
+
+
+function Top (Value, Maxlines: Integer): Boolean;
+
+
+
+Send TOP command. After successful operation dowloaded headers of message and maxlines count of message in FullResult . If all OK, result is True
.
+
+
+
+function Uidl (Value: Integer): Boolean;
+
+
+
+Send UIDL command. If Value is 0, UIDL is for all messages. After successful operation is listing in FullResult. If all OK, result is True
.
+
+
+
+function StartTLS : Boolean;
+
+
+
+Call STLS command for upgrade connection to SSL/TLS mode.
+
+
+
+function FindCap (const Value: string): string;
+
+
+
+Try to find given capabily in capabilty string returned from POP3 server by CAPA command.
+Properties
+
+
+
+property ResultCode : Integer read FResultCode;
+
+
+
+Result code of last POP3 operation. 0 - error, 1 - OK.
+
+
+
+property ResultString : string read FResultString;
+
+
+
+Result string of last POP3 operation.
+
+
+
+property FullResult : TStringList read FFullResult;
+
+
+
+Stringlist with full lines returned as result of POP3 operation. I.e. if operation is LIST, this property is filled by list of messages. If operation is RETR, this property have downloaded message.
+
+
+
+property StatCount : Integer read FStatCount;
+
+
+
+After STAT command is there count of messages in inbox.
+
+
+
+property StatSize : Integer read FStatSize;
+
+
+
+After STAT command is there size of all messages in inbox.
+
+
+
+property ListSize : Integer read FListSize;
+
+
+
+After LIST 0 command size of all messages on server, After LIST x size of message x on server
+
+
+
+property TimeStamp : string read FTimeStamp;
+
+
+
+If server support this, after comnnect is in this property timestamp of remote server.
+
+
+
+property AuthType : TPOP3AuthType read FAuthType Write FAuthType;
+
+
+
+Type of authorisation for login to POP3 server. Dafault is autodetect one of possible authorisation. Autodetect do this:
+
+
If remote POP3 server support APOP, try login by APOP method. If APOP is not supported, or if APOP login failed, try classic USER+PASS login method.
+
+
+
+property AutoTLS : Boolean read FAutoTLS Write FAutoTLS;
+
+
+
+If is set to True
, then upgrade to SSL/TLS mode if remote server support it.
+
+
+
+property FullSSL : Boolean read FFullSSL Write FFullSSL;
+
+
+
+SSL/TLS mode is used from first contact to server. Servers with full SSL/TLS mode usualy using non-standard TCP port!
+
+
+Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:51
+
+
ADDED lib/synapse/docs/help/pop3send.html
Index: lib/synapse/docs/help/pop3send.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/pop3send.html
@@ -0,0 +1,71 @@
+
+
+
+
+
+pop3send
+
+
+
+Unit pop3send
+
+Description
+
+POP3 protocol client
+
+
+
+
Used RFC: RFC-1734, RFC-1939, RFC-2195, RFC-2449, RFC-2595
+uses
+Overview
+Classes, Interfaces, Objects and Records
+
+
+
+Class TPOP3Send
+Implementation of POP3 client protocol.
+
+
+Types
+
+Constants
+
+Description
+Types
+
+
+TPOP3AuthType = (...);
+
+
+
+The three types of possible authorization methods for "logging in" to a POP3 server.
+
+
+POP3AuthAll:
+
+POP3AuthLogin:
+
+POP3AuthAPOP:
+
+Constants
+
+
+cPop3Protocol = '110';
+
+
+ Generated by PasDoc 0.9.0 on 2012-04-23 21:38:51
+
+
ADDED lib/synapse/docs/help/private.gif
Index: lib/synapse/docs/help/private.gif
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/private.gif
cannot compute difference between binary files
ADDED lib/synapse/docs/help/protected.gif
Index: lib/synapse/docs/help/protected.gif
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/protected.gif
cannot compute difference between binary files
ADDED lib/synapse/docs/help/public.gif
Index: lib/synapse/docs/help/public.gif
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/public.gif
cannot compute difference between binary files
ADDED lib/synapse/docs/help/published.gif
Index: lib/synapse/docs/help/published.gif
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/published.gif
cannot compute difference between binary files
ADDED lib/synapse/docs/help/slogsend.TSyslogMessage.html
Index: lib/synapse/docs/help/slogsend.TSyslogMessage.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/slogsend.TSyslogMessage.html
@@ -0,0 +1,133 @@
+
+
+
+
+
+slogsend: Class TSyslogMessage
+
+
+
+Class TSyslogMessage
+
+Unit
+
+slogsend
+Declaration
+
+type TSyslogMessage = class(TObject)
+Description
+
+encoding or decoding of SYSLOG message
+Hierarchy
+Overview
+Methods
+
+
+
+procedure Clear ;
+
+
+Properties
+
+
+
+property Facility : Byte read FFacility write FFacility;
+
+
+
+property Severity : TSyslogSeverity read FSeverity write FSeverity;
+
+
+
+property DateTime : TDateTime read FDateTime write FDateTime;
+
+
+
+property Tag : String read FTag write FTag;
+
+
+
+property LogMessage : String read FMessage write FMessage;
+
+
+
+property LocalIP : String read FLocalIP write FLocalIP;
+
+
+
+property PacketBuf : String read GetPacketBuf write SetPacketBuf;
+
+
+Description
+Methods
+
+
+
+procedure Clear ;
+
+
+
+Reset values to defaults
+Properties
+
+
+
+property Facility : Byte read FFacility write FFacility;
+
+
+
+Define facilicity of Syslog message. For specify you may use predefined FCL_* constants. Default is "FCL_Local0".
+
+
+
+property Severity : TSyslogSeverity read FSeverity write FSeverity;
+
+
+
+Define possible priority of Syslog message. Default is "Debug".
+
+
+
+property DateTime : TDateTime read FDateTime write FDateTime;
+
+
+
+date and time of Syslog message
+
+
+
+property Tag : String read FTag write FTag;
+
+
+
+This is used for identify process of this message. Default is filename of your executable file.
+
+
+
+property LogMessage : String read FMessage write FMessage;
+
+
+
+Text of your message for log.
+
+
+
+property LocalIP : String read FLocalIP write FLocalIP;
+
+
+
+IP address of message sender.
+
+
+
+property PacketBuf : String read GetPacketBuf write SetPacketBuf;
+
+
+
+This property holds encoded binary SYSLOG packet
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:51
+
+
ADDED lib/synapse/docs/help/slogsend.TSyslogSend.html
Index: lib/synapse/docs/help/slogsend.TSyslogSend.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/slogsend.TSyslogSend.html
@@ -0,0 +1,86 @@
+
+
+
+
+
+slogsend: Class TSyslogSend
+
+
+
+Class TSyslogSend
+
+Unit
+
+slogsend
+Declaration
+
+type TSyslogSend = class(TSynaClient )
+Description
+
+This object implement BSD SysLog client
+
+
+
+
Note: Are you missing properties for specify server address and port? Look to parent TSynaClient too!
+Hierarchy
+Overview
+Methods
+
+
+
+constructor Create ;
+
+
+
+destructor Destroy ; override;
+
+
+
+function DoIt : Boolean;
+
+
+Properties
+
+Description
+Methods
+
+
+
+constructor Create ;
+
+
+
+
+
+destructor Destroy ; override;
+
+
+
+
+
+function DoIt : Boolean;
+
+
+
+Send Syslog UDP packet defined by SysLogMessage .
+Properties
+
+
+
+property SysLogMessage : TSysLogMessage read FSysLogMessage write FSysLogMessage;
+
+
+
+Syslog message for send
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:51
+
+
ADDED lib/synapse/docs/help/slogsend.html
Index: lib/synapse/docs/help/slogsend.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/slogsend.html
@@ -0,0 +1,291 @@
+
+
+
+
+
+slogsend
+
+
+
+Unit slogsend
+
+Description
+
+BSD SYSLOG protocol
+
+
+
+
Used RFC: RFC-3164
+uses
+Overview
+Classes, Interfaces, Objects and Records
+
+
+
+Class TSyslogMessage
+encoding or decoding of SYSLOG message
+
+
+Class TSyslogSend
+This object implement BSD SysLog client
+
+
+Functions and Procedures
+
+
+function ToSysLog (const SyslogServer: string; Facil: Byte; Sever: TSyslogSeverity ; const Content: string): Boolean;
+
+
+Types
+
+Constants
+
+Description
+Functions and Procedures
+
+
+function ToSysLog (const SyslogServer: string; Facil: Byte; Sever: TSyslogSeverity ; const Content: string): Boolean;
+
+
+
+Simply send packet to specified Syslog server.
+Types
+
+
+TSyslogSeverity = (...);
+
+
+
+Define possible priority of Syslog message
+
+
+Emergency:
+
+Alert:
+
+Critical:
+
+Error:
+
+Warning:
+
+Notice:
+
+Info:
+
+Debug:
+
+Constants
+
+
+cSysLogProtocol = '514';
+
+
+
+
+
+FCL_UserLevel = 1;
+
+
+
+
+FCL_MailSystem = 2;
+
+
+
+
+
+
+
+
+
+
+
+FCL_Authorization = 10;
+
+
+
+
+
+
+FCL_LogAudit = 13;
+
+
+
+
+FCL_LogAlert = 14;
+
+
+
+
+
+
+
+
+
+
+
+ Generated by PasDoc 0.9.0 on 2012-04-23 21:38:51
+
+
ADDED lib/synapse/docs/help/smtpsend.TSMTPSend.html
Index: lib/synapse/docs/help/smtpsend.TSMTPSend.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/smtpsend.TSMTPSend.html
@@ -0,0 +1,390 @@
+
+
+
+
+
+smtpsend: Class TSMTPSend
+
+
+
+Class TSMTPSend
+
+Unit
+
+smtpsend
+Declaration
+
+type TSMTPSend = class(TSynaClient )
+Description
+
+Implementation of SMTP and ESMTP procotol
+
+, include some ESMTP extensions, include SSL/TLS too.
+
+
Note: Are you missing properties for setting Username and Password for ESMTP? Look to parent TSynaClient object!
+
+
Are you missing properties for specify server address and port? Look to parent TSynaClient too!
+Hierarchy
+Overview
+Methods
+
+
+
+constructor Create ;
+
+
+
+destructor Destroy ; override;
+
+
+
+function Login : Boolean;
+
+
+
+function Logout : Boolean;
+
+
+
+function Reset : Boolean;
+
+
+
+function NoOp : Boolean;
+
+
+
+function MailFrom (const Value: string; Size: Integer): Boolean;
+
+
+
+function MailTo (const Value: string): Boolean;
+
+
+
+function MailData (const Value: Tstrings): Boolean;
+
+
+
+function Etrn (const Value: string): Boolean;
+
+
+
+function Verify (const Value: string): Boolean;
+
+
+
+function StartTLS : Boolean;
+
+
+
+function EnhCodeString : string;
+
+
+
+function FindCap (const Value: string): string;
+
+
+Properties
+
+
+
+property ResultCode : Integer read FResultCode;
+
+
+
+property ResultString : string read FResultString;
+
+
+
+property FullResult : TStringList read FFullResult;
+
+
+
+property ESMTPcap : TStringList read FESMTPcap;
+
+
+
+property ESMTP : Boolean read FESMTP;
+
+
+
+property AuthDone : Boolean read FAuthDone;
+
+
+
+property ESMTPSize : Boolean read FESMTPSize;
+
+
+
+property MaxSize : Integer read FMaxSize;
+
+
+
+property EnhCode1 : Integer read FEnhCode1;
+
+
+
+property EnhCode2 : Integer read FEnhCode2;
+
+
+
+property EnhCode3 : Integer read FEnhCode3;
+
+
+
+property SystemName : string read FSystemName Write FSystemName;
+
+
+
+property AutoTLS : Boolean read FAutoTLS Write FAutoTLS;
+
+
+
+property FullSSL : Boolean read FFullSSL Write FFullSSL;
+
+
+
+property Sock : TTCPBlockSocket read FSock;
+
+
+Description
+Methods
+
+
+
+constructor Create ;
+
+
+
+
+
+destructor Destroy ; override;
+
+
+
+
+
+function Login : Boolean;
+
+
+
+Connects to SMTP server (defined in TSynaClient .TargetHost ) and begin SMTP session. (First try ESMTP EHLO, next old HELO handshake). Parses ESMTP capabilites and if you specified Username and password and remote server can handle AUTH command, try login by AUTH command. Preffered login method is CRAM-MD5 (if safer!). If all OK, result is True
, else result is False
.
+
+
+
+function Logout : Boolean;
+
+
+
+Close SMTP session (QUIT command) and disconnect from SMTP server.
+
+
+
+function Reset : Boolean;
+
+
+
+Send RSET SMTP command for reset SMTP session. If all OK, result is True
, else result is False
.
+
+
+
+function NoOp : Boolean;
+
+
+
+Send NOOP SMTP command for keep SMTP session. If all OK, result is True
, else result is False
.
+
+
+
+function MailFrom (const Value: string; Size: Integer): Boolean;
+
+
+
+Send MAIL FROM SMTP command for set sender e-mail address. If sender's e-mail address is empty string, transmited message is error message.
+
+
If size not 0 and remote server can handle SIZE parameter, append SIZE parameter to request. If all OK, result is True
, else result is False
.
+
+
+
+function MailTo (const Value: string): Boolean;
+
+
+
+Send RCPT TO SMTP command for set receiver e-mail address. It cannot be an empty string. If all OK, result is True
, else result is False
.
+
+
+
+function MailData (const Value: Tstrings): Boolean;
+
+
+
+Send DATA SMTP command and transmit message data. If all OK, result is True
, else result is False
.
+
+
+
+function Etrn (const Value: string): Boolean;
+
+
+
+Send ETRN SMTP command for start sending of remote queue for domain in Value. If all OK, result is True
, else result is False
.
+
+
+
+function Verify (const Value: string): Boolean;
+
+
+
+Send VRFY SMTP command for check receiver e-mail address. It cannot be an empty string. If all OK, result is True
, else result is False
.
+
+
+
+function StartTLS : Boolean;
+
+
+
+Call STARTTLS command for upgrade connection to SSL/TLS mode.
+
+
+
+function EnhCodeString : string;
+
+
+
+Return string descriptive text for enhanced result codes stored in EnhCode1 , EnhCode2 and EnhCode3 .
+
+
+
+function FindCap (const Value: string): string;
+
+
+
+Try to find specified capability in ESMTP response.
+Properties
+
+
+
+property ResultCode : Integer read FResultCode;
+
+
+
+result code of last SMTP command.
+
+
+
+property ResultString : string read FResultString;
+
+
+
+result string of last SMTP command (begin with string representation of result code).
+
+
+
+property FullResult : TStringList read FFullResult;
+
+
+
+All result strings of last SMTP command (result is maybe multiline!).
+
+
+
+property ESMTPcap : TStringList read FESMTPcap;
+
+
+
+List of ESMTP capabilites of remote ESMTP server. (If you connect to ESMTP server only!).
+
+
+
+property ESMTP : Boolean read FESMTP;
+
+
+
+True
if you successfuly logged to ESMTP server.
+
+
+
+property AuthDone : Boolean read FAuthDone;
+
+
+
+True
if you successfuly pass authorisation to remote server.
+
+
+
+property ESMTPSize : Boolean read FESMTPSize;
+
+
+
+True
if remote server can handle SIZE parameter.
+
+
+
+property MaxSize : Integer read FMaxSize;
+
+
+
+When ESMTPSize is True
, contains max length of message that remote server can handle.
+
+
+
+property EnhCode1 : Integer read FEnhCode1;
+
+
+
+First digit of Enhanced result code. If last operation does not have enhanced result code, values is 0.
+
+
+
+property EnhCode2 : Integer read FEnhCode2;
+
+
+
+Second digit of Enhanced result code. If last operation does not have enhanced result code, values is 0.
+
+
+
+property EnhCode3 : Integer read FEnhCode3;
+
+
+
+Third digit of Enhanced result code. If last operation does not have enhanced result code, values is 0.
+
+
+
+property SystemName : string read FSystemName Write FSystemName;
+
+
+
+name of our system used in HELO and EHLO command. Implicit value is internet address of your machine.
+
+
+
+property AutoTLS : Boolean read FAutoTLS Write FAutoTLS;
+
+
+
+If is set to true, then upgrade to SSL/TLS mode if remote server support it.
+
+
+
+property FullSSL : Boolean read FFullSSL Write FFullSSL;
+
+
+
+SSL/TLS mode is used from first contact to server. Servers with full SSL/TLS mode usualy using non-standard TCP port!
+
+
+Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:51
+
+
ADDED lib/synapse/docs/help/smtpsend.html
Index: lib/synapse/docs/help/smtpsend.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/smtpsend.html
@@ -0,0 +1,95 @@
+
+
+
+
+
+smtpsend
+
+
+
+Unit smtpsend
+
+Description
+
+SMTP client
+
+
+
+
Used RFC: RFC-1869, RFC-1870, RFC-1893, RFC-2034, RFC-2104, RFC-2195, RFC-2487, RFC-2554, RFC-2821
+uses
+Overview
+Classes, Interfaces, Objects and Records
+
+
+
+Class TSMTPSend
+Implementation of SMTP and ESMTP procotol
+
+
+Functions and Procedures
+
+
+function SendToRaw (const MailFrom, MailTo, SMTPHost: string; const MailData: TStrings; const Username, Password: string): Boolean;
+
+
+function SendTo (const MailFrom, MailTo, Subject, SMTPHost: string; const MailData: TStrings): Boolean;
+
+
+function SendToEx (const MailFrom, MailTo, Subject, SMTPHost: string; const MailData: TStrings; const Username, Password: string): Boolean;
+
+
+Constants
+
+Description
+Functions and Procedures
+
+
+function SendToRaw (const MailFrom, MailTo, SMTPHost: string; const MailData: TStrings; const Username, Password: string): Boolean;
+
+
+
+A very useful function and example of its use would be found in the TSMTPsend object. Send maildata (text of e-mail with all SMTP headers! For example when text of message is created by TMimeMess object) from "MailFrom" e-mail address to "MailTo" e-mail address (If you need more then one receiver, then separate their addresses by comma).
+
+
Function sends e-mail to a SMTP server defined in "SMTPhost" parameter. Username and password are used for authorization to the "SMTPhost". If you don't want authorization, set "Username" and "Password" to empty strings. If e-mail message is successfully sent, the result returns True
.
+
+
If you need use different port number then standard, then add this port number to SMTPhost after colon. (i.e. '127.0.0.1:1025')
+
+
+function SendTo (const MailFrom, MailTo, Subject, SMTPHost: string; const MailData: TStrings): Boolean;
+
+
+
+A very useful function and example of its use would be found in the TSMTPsend object. Send "Maildata" (text of e-mail without any SMTP headers!) from "MailFrom" e-mail address to "MailTo" e-mail address with "Subject". (If you need more then one receiver, then separate their addresses by comma).
+
+
This function constructs all needed SMTP headers (with DATE header) and sends the e-mail to the SMTP server defined in the "SMTPhost" parameter. If the e-mail message is successfully sent, the result will be True
.
+
+
If you need use different port number then standard, then add this port number to SMTPhost after colon. (i.e. '127.0.0.1:1025')
+
+
+function SendToEx (const MailFrom, MailTo, Subject, SMTPHost: string; const MailData: TStrings; const Username, Password: string): Boolean;
+
+
+
+A very useful function and example of its use would be found in the TSMTPsend object. Sends "MailData" (text of e-mail without any SMTP headers!) from "MailFrom" e-mail address to "MailTo" e-mail address (If you need more then one receiver, then separate their addresses by comma).
+
+
This function sends the e-mail to the SMTP server defined in the "SMTPhost" parameter. Username and password are used for authorization to the "SMTPhost". If you dont want authorization, set "Username" and "Password" to empty Strings. If the e-mail message is successfully sent, the result will be True
.
+
+
If you need use different port number then standard, then add this port number to SMTPhost after colon. (i.e. '127.0.0.1:1025')
+Constants
+
+
+cSmtpProtocol = '25';
+
+
+ Generated by PasDoc 0.9.0 on 2012-04-23 21:38:51
+
+
ADDED lib/synapse/docs/help/snmpsend.TSNMPMib.html
Index: lib/synapse/docs/help/snmpsend.TSNMPMib.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/snmpsend.TSNMPMib.html
@@ -0,0 +1,69 @@
+
+
+
+
+
+snmpsend: Class TSNMPMib
+
+
+
+Class TSNMPMib
+
+Unit
+
+snmpsend
+Declaration
+
+type TSNMPMib = class(TObject)
+Description
+
+Data object with one record of MIB OID and corresponding values.
+Hierarchy
+Overview
+Properties
+
+
+
+property OID : AnsiString read FOID write FOID;
+
+
+
+property Value : AnsiString read FValue write FValue;
+
+
+
+property ValueType : Integer read FValueType write FValueType;
+
+
+Description
+Properties
+
+
+
+property OID : AnsiString read FOID write FOID;
+
+
+
+OID number in string format.
+
+
+
+property Value : AnsiString read FValue write FValue;
+
+
+
+Value of OID object in string format.
+
+
+
+property ValueType : Integer read FValueType write FValueType;
+
+
+
+Define type of Value. Supported values are defined in asn1util . For queries use ASN1_NULL, becouse you don't know type in response!
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:51
+
+
ADDED lib/synapse/docs/help/snmpsend.TSNMPRec.html
Index: lib/synapse/docs/help/snmpsend.TSNMPRec.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/snmpsend.TSNMPRec.html
@@ -0,0 +1,513 @@
+
+
+
+
+
+snmpsend: Class TSNMPRec
+
+
+
+Class TSNMPRec
+
+Unit
+
+snmpsend
+Declaration
+
+type TSNMPRec = class(TObject)
+Description
+
+Data object abstracts SNMP data packet
+Hierarchy
+Overview
+Methods
+
+
+
+constructor Create ;
+
+
+
+destructor Destroy ; override;
+
+
+
+function DecodeBuf (Buffer: AnsiString): Boolean;
+
+
+
+function EncodeBuf : AnsiString;
+
+
+
+procedure Clear ;
+
+
+
+procedure MIBAdd (const MIB, Value: AnsiString; ValueType: Integer);
+
+
+
+procedure MIBDelete (Index: Integer);
+
+
+
+function MIBGet (const MIB: AnsiString): AnsiString;
+
+
+
+function MIBCount : integer;
+
+
+
+function MIBByIndex (Index: Integer): TSNMPMib ;
+
+
+Properties
+
+
+
+property SNMPMibList : TList read FSNMPMibList;
+
+
+
+property Version : Integer read FVersion write FVersion;
+
+
+
+property Community : AnsiString read FCommunity write FCommunity;
+
+
+
+property PDUType : Integer read FPDUType write FPDUType;
+
+
+
+property ID : Integer read FID write FID;
+
+
+
+property ErrorStatus : Integer read FErrorStatus write FErrorStatus;
+
+
+
+property ErrorIndex : Integer read FErrorIndex write FErrorIndex;
+
+
+
+property NonRepeaters : Integer read FErrorStatus write FErrorStatus;
+
+
+
+property MaxRepetitions : Integer read FErrorIndex write FErrorIndex;
+
+
+
+property MaxSize : Integer read FMaxSize write FMaxSize;
+
+
+
+property Flags : TV3Flags read FFlags write FFlags;
+
+
+
+property FlagReportable : Boolean read FFlagReportable write FFlagReportable;
+
+
+
+property ContextEngineID : AnsiString read FContextEngineID write FContextEngineID;
+
+
+
+property ContextName : AnsiString read FContextName write FContextName;
+
+
+
+property AuthMode : TV3Auth read FAuthMode write FAuthMode;
+
+
+
+property PrivMode : TV3Priv read FPrivMode write FPrivMode;
+
+
+
+property AuthEngineID : AnsiString read FAuthEngineID write FAuthEngineID;
+
+
+
+property AuthEngineBoots : Integer read FAuthEngineBoots write FAuthEngineBoots;
+
+
+
+property AuthEngineTime : Integer read FAuthEngineTime write FAuthEngineTime;
+
+
+
+property AuthEngineTimeStamp : Cardinal read FAuthEngineTimeStamp Write FAuthEngineTimeStamp;
+
+
+
+property UserName : AnsiString read FUserName write FUserName;
+
+
+
+property Password : AnsiString read FPassword write FPassword;
+
+
+
+property AuthKey : AnsiString read FAuthKey write FAuthKey;
+
+
+
+property PrivPassword : AnsiString read FPrivPassword write FPrivPassword;
+
+
+
+property PrivKey : AnsiString read FPrivKey write FPrivKey;
+
+
+
+property OldTrapEnterprise : AnsiString read FOldTrapEnterprise write FOldTrapEnterprise;
+
+
+
+property OldTrapHost : AnsiString read FOldTrapHost write FOldTrapHost;
+
+
+
+property OldTrapGen : Integer read FOldTrapGen write FOldTrapGen;
+
+
+
+property OldTrapSpec : Integer read FOldTrapSpec write FOldTrapSpec;
+
+
+
+property OldTrapTimeTicks : Integer read FOldTrapTimeTicks write FOldTrapTimeTicks;
+
+
+Description
+Methods
+
+
+
+constructor Create ;
+
+
+
+
+
+destructor Destroy ; override;
+
+
+
+
+
+function DecodeBuf (Buffer: AnsiString): Boolean;
+
+
+
+Decode SNMP packet in buffer to object properties.
+
+
+
+function EncodeBuf : AnsiString;
+
+
+
+Encode obeject properties to SNMP packet.
+
+
+
+procedure Clear ;
+
+
+
+Clears all object properties to default values.
+
+
+
+procedure MIBAdd (const MIB, Value: AnsiString; ValueType: Integer);
+
+
+
+Add entry to SNMPMibList . For queries use value as empty string, and ValueType as ASN1_NULL.
+
+
+
+procedure MIBDelete (Index: Integer);
+
+
+
+Delete entry from SNMPMibList .
+
+
+
+function MIBGet (const MIB: AnsiString): AnsiString;
+
+
+
+Search SNMPMibList list for MIB and return correspond value.
+
+
+
+function MIBCount : integer;
+
+
+
+return number of entries in MIB array.
+
+
+
+function MIBByIndex (Index: Integer): TSNMPMib ;
+
+
+
+Return MIB information from given row of MIB array.
+Properties
+
+
+
+property SNMPMibList : TList read FSNMPMibList;
+
+
+
+List of TSNMPMib objects.
+
+
+
+property Version : Integer read FVersion write FVersion;
+
+
+
+Version of SNMP packet. Default value is 0 (SNMP ver. 1). You can use value 1 for SNMPv2c or value 3 for SNMPv3.
+
+
+
+property Community : AnsiString read FCommunity write FCommunity;
+
+
+
+Community string for autorize access to SNMP server. (Case sensitive!) Community string is not used in SNMPv3! Use UserName and Password instead!
+
+
+
+property PDUType : Integer read FPDUType write FPDUType;
+
+
+
+Define type of SNMP operation.
+
+
+
+property ID : Integer read FID write FID;
+
+
+
+Contains ID number. Not need to use.
+
+
+
+property ErrorStatus : Integer read FErrorStatus write FErrorStatus;
+
+
+
+When packet is reply, contains error code. Supported values are defined by E* constants.
+
+
+
+property ErrorIndex : Integer read FErrorIndex write FErrorIndex;
+
+
+
+Point to error position in reply packet. Not usefull for users. It only good for debugging!
+
+
+
+property NonRepeaters : Integer read FErrorStatus write FErrorStatus;
+
+
+
+special value for GetBulkRequest of SNMPv2 and v3.
+
+
+
+property MaxRepetitions : Integer read FErrorIndex write FErrorIndex;
+
+
+
+special value for GetBulkRequest of SNMPv2 and v3.
+
+
+
+property MaxSize : Integer read FMaxSize write FMaxSize;
+
+
+
+Maximum message size in bytes for SNMPv3. For sending is default 1472 bytes.
+
+
+
+property Flags : TV3Flags read FFlags write FFlags;
+
+
+
+Specify if message is authorised or encrypted. Used only in SNMPv3.
+
+
+
+property FlagReportable : Boolean read FFlagReportable write FFlagReportable;
+
+
+
+For SNMPv3.... If is True
, SNMP agent must send reply (at least with some error).
+
+
+
+property ContextEngineID : AnsiString read FContextEngineID write FContextEngineID;
+
+
+
+For SNMPv3. If not specified, is used value from AuthEngineID
+
+
+
+property ContextName : AnsiString read FContextName write FContextName;
+
+
+
+For SNMPv3.
+
+
+
+property AuthMode : TV3Auth read FAuthMode write FAuthMode;
+
+
+
+For SNMPv3. Specify Authorization mode. (specify used hash for authorization)
+
+
+
+property PrivMode : TV3Priv read FPrivMode write FPrivMode;
+
+
+
+For SNMPv3. Specify Privacy mode.
+
+
+
+property AuthEngineID : AnsiString read FAuthEngineID write FAuthEngineID;
+
+
+
+value used by SNMPv3 authorisation for synchronization with SNMP agent.
+
+
+
+property AuthEngineBoots : Integer read FAuthEngineBoots write FAuthEngineBoots;
+
+
+
+value used by SNMPv3 authorisation for synchronization with SNMP agent.
+
+
+
+property AuthEngineTime : Integer read FAuthEngineTime write FAuthEngineTime;
+
+
+
+value used by SNMPv3 authorisation for synchronization with SNMP agent.
+
+
+
+property AuthEngineTimeStamp : Cardinal read FAuthEngineTimeStamp Write FAuthEngineTimeStamp;
+
+
+
+value used by SNMPv3 authorisation for synchronization with SNMP agent.
+
+
+
+property UserName : AnsiString read FUserName write FUserName;
+
+
+
+SNMPv3 authorization username
+
+
+
+property Password : AnsiString read FPassword write FPassword;
+
+
+
+SNMPv3 authorization password
+
+
+
+property AuthKey : AnsiString read FAuthKey write FAuthKey;
+
+
+
+For SNMPv3. Computed Athorization key from Password .
+
+
+
+property PrivPassword : AnsiString read FPrivPassword write FPrivPassword;
+
+
+
+SNMPv3 privacy password
+
+
+
+property PrivKey : AnsiString read FPrivKey write FPrivKey;
+
+
+
+For SNMPv3. Computed Privacy key from PrivPassword .
+
+
+
+property OldTrapEnterprise : AnsiString read FOldTrapEnterprise write FOldTrapEnterprise;
+
+
+
+MIB value to identify the object that sent the TRAPv1.
+
+
+
+property OldTrapHost : AnsiString read FOldTrapHost write FOldTrapHost;
+
+
+
+Address of TRAPv1 sender (IP address).
+
+
+
+property OldTrapGen : Integer read FOldTrapGen write FOldTrapGen;
+
+
+
+Generic TRAPv1 identification.
+
+
+
+property OldTrapSpec : Integer read FOldTrapSpec write FOldTrapSpec;
+
+
+
+Specific TRAPv1 identification.
+
+
+
+property OldTrapTimeTicks : Integer read FOldTrapTimeTicks write FOldTrapTimeTicks;
+
+
+
+Number of 1/100th of seconds since last reboot or power up. (for TRAPv1)
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:51
+
+
ADDED lib/synapse/docs/help/snmpsend.TSNMPSend.html
Index: lib/synapse/docs/help/snmpsend.TSNMPSend.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/snmpsend.TSNMPSend.html
@@ -0,0 +1,170 @@
+
+
+
+
+
+snmpsend: Class TSNMPSend
+
+
+
+Class TSNMPSend
+
+Unit
+
+snmpsend
+Declaration
+
+type TSNMPSend = class(TSynaClient )
+Description
+
+Implementation of SNMP protocol.
+
+
+
+
Note: Are you missing properties for specify server address and port? Look to parent TSynaClient too!
+Hierarchy
+Overview
+Methods
+
+Properties
+
+Description
+Methods
+
+
+
+constructor Create ;
+
+
+
+
+
+destructor Destroy ; override;
+
+
+
+
+
+function SendRequest : Boolean;
+
+
+
+Connects to a Host and send there query. If in timeout SNMP server send back query, result is True
. If is used SNMPv3, then it synchronize self with SNMPv3 agent first. (It is needed for SNMPv3 auhorization!)
+
+
+
+function SendTrap : Boolean;
+
+
+
+Send SNMP packet only, but not waits for reply. Good for sending traps.
+
+
+
+function RecvTrap : Boolean;
+
+
+
+Receive SNMP packet only. Good for receiving traps.
+
+
+
+function DoIt : Boolean;
+
+
+
+Mapped to SendRequest internally. This function is only for backward compatibility.
+Properties
+
+
+
+property Buffer : AnsiString read FBuffer write FBuffer;
+
+
+
+contains raw binary form of SNMP packet. Good for debugging.
+
+
+
+property HostIP : AnsiString read FHostIP;
+
+
+
+After SNMP operation hold IP address of remote side.
+
+
+
+property Query : TSNMPRec read FQuery;
+
+
+
+Data object contains SNMP query.
+
+
+
+property Reply : TSNMPRec read FReply;
+
+
+
+Data object contains SNMP reply.
+
+
+Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:51
+
+
ADDED lib/synapse/docs/help/snmpsend.TV3Sync.html
Index: lib/synapse/docs/help/snmpsend.TV3Sync.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/snmpsend.TV3Sync.html
@@ -0,0 +1,65 @@
+
+
+
+
+
+snmpsend: record TV3Sync
+
+
+
+record TV3Sync
+
+Unit
+
+snmpsend
+Declaration
+
+type TV3Sync = record
+Description
+
+It holding all information for SNMPv3 agent synchronization
+
+ Used internally.
+Overview
+Fields
+
+Description
+Fields
+
+
+EngineID : AnsiString;
+
+
+
+
+EngineBoots : integer;
+
+
+
+
+EngineTime : integer;
+
+
+
+
+EngineStamp : Cardinal;
+
+
+ Generated by PasDoc 0.9.0 on 2012-04-23 21:38:51
+
+
ADDED lib/synapse/docs/help/snmpsend.html
Index: lib/synapse/docs/help/snmpsend.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/snmpsend.html
@@ -0,0 +1,453 @@
+
+
+
+
+
+snmpsend
+
+
+
+Unit snmpsend
+
+Description
+
+SNMP client
+
+ Supports SNMPv1 include traps, SNMPv2c and SNMPv3 include authorization and privacy encryption.
+
+
Used RFC: RFC-1157, RFC-1901, RFC-3412, RFC-3414, RFC-3416, RFC-3826
+
+
Supported Authorization hashes: MD5, SHA1 Supported Privacy encryptions: DES, 3DES, AES
+uses
+Overview
+Classes, Interfaces, Objects and Records
+
+
+
+Class TSNMPMib
+Data object with one record of MIB OID and corresponding values.
+
+
+record TV3Sync
+It holding all information for SNMPv3 agent synchronization
+
+
+Class TSNMPRec
+Data object abstracts SNMP data packet
+
+
+Class TSNMPSend
+Implementation of SNMP protocol.
+
+
+Functions and Procedures
+
+
+function SNMPGet (const OID, Community, SNMPHost: AnsiString; var Value: AnsiString): Boolean;
+
+
+function SNMPSet (const OID, Community, SNMPHost, Value: AnsiString; ValueType: Integer): Boolean;
+
+
+function SNMPGetNext (var OID: AnsiString; const Community, SNMPHost: AnsiString; var Value: AnsiString): Boolean;
+
+
+function SNMPGetTable (const BaseOID, Community, SNMPHost: AnsiString; const Value: TStrings): Boolean;
+
+
+function SNMPGetTableElement (const BaseOID, RowID, ColID, Community, SNMPHost: AnsiString; var Value: AnsiString): Boolean;
+
+
+function SendTrap (const Dest, Source, Enterprise, Community: AnsiString; Generic, Specific, Seconds: Integer; const MIBName, MIBValue: AnsiString; MIBtype: Integer): Integer;
+
+
+function RecvTrap (var Dest, Source, Enterprise, Community: AnsiString; var Generic, Specific, Seconds: Integer; const MIBName, MIBValue: TStringList): Integer;
+
+
+Types
+
+Constants
+
+Description
+Functions and Procedures
+
+
+function SNMPGet (const OID, Community, SNMPHost: AnsiString; var Value: AnsiString): Boolean;
+
+
+
+A very useful function and example of its use would be found in the TSNMPSend object. It implements basic GET method of the SNMP protocol. The MIB value is located in the "OID" variable, and is sent to the requested "SNMPHost" with the proper "Community" access identifier. Upon a successful retrieval, "Value" will contain the information requested. If the SNMP operation is successful, the result returns True
.
+
+
+function SNMPSet (const OID, Community, SNMPHost, Value: AnsiString; ValueType: Integer): Boolean;
+
+
+
+This is useful function and example of use TSNMPSend object. It implements the basic SET method of the SNMP protocol. If the SNMP operation is successful, the result is True
. "Value" is value of MIB Oid for "SNMPHost" with "Community" access identifier. You must specify "ValueType" too.
+
+
+function SNMPGetNext (var OID: AnsiString; const Community, SNMPHost: AnsiString; var Value: AnsiString): Boolean;
+
+
+
+A very useful function and example of its use would be found in the TSNMPSend object. It implements basic GETNEXT method of the SNMP protocol. The MIB value is located in the "OID" variable, and is sent to the requested "SNMPHost" with the proper "Community" access identifier. Upon a successful retrieval, "Value" will contain the information requested. If the SNMP operation is successful, the result returns True
.
+
+
+function SNMPGetTable (const BaseOID, Community, SNMPHost: AnsiString; const Value: TStrings): Boolean;
+
+
+
+A very useful function and example of its use would be found in the TSNMPSend object. It implements basic read of SNMP MIB tables. As BaseOID you must specify basic MIB OID of requested table (base IOD is OID without row and column specificator!) Table is readed into stringlist, where each string is comma delimited string.
+
+
Warning: this function is not have best performance. For better performance you must write your own function. best performace you can get by knowledge of structuture of table and by more then one MIB on one query.
+
+
+function SNMPGetTableElement (const BaseOID, RowID, ColID, Community, SNMPHost: AnsiString; var Value: AnsiString): Boolean;
+
+
+
+A very useful function and example of its use would be found in the TSNMPSend object. It implements basic read of SNMP MIB table element. As BaseOID you must specify basic MIB OID of requested table (base IOD is OID without row and column specificator!) As next you must specify identificator of row and column for specify of needed field of table.
+
+
+function SendTrap (const Dest, Source, Enterprise, Community: AnsiString; Generic, Specific, Seconds: Integer; const MIBName, MIBValue: AnsiString; MIBtype: Integer): Integer;
+
+
+
+A very useful function and example of its use would be found in the TSNMPSend object. It implements a TRAPv1 to send with all data in the parameters.
+
+
+function RecvTrap (var Dest, Source, Enterprise, Community: AnsiString; var Generic, Specific, Seconds: Integer; const MIBName, MIBValue: TStringList): Integer;
+
+
+
+A very useful function and example of its use would be found in the TSNMPSend object. It receives a TRAPv1 and returns all the data that comes with it.
+Types
+
+
+Possible values for SNMPv3 flags.
+
+ This flags specify level of authorization and encryption.
+
+
+NoAuthNoPriv:
+
+AuthNoPriv:
+
+AuthPriv:
+
+
+
+Type of SNMPv3 authorization
+
+
+AuthMD5:
+
+AuthSHA1:
+
+
+
+Type of SNMPv3 privacy
+
+
+PrivDES:
+
+Priv3DES:
+
+PrivAES:
+
+Constants
+
+
+cSnmpProtocol = '161';
+
+
+
+
+cSnmpTrapProtocol = '162';
+
+
+
+
+
+
+
+PDUGetRequest = $A0;
+
+
+
+
+PDUGetNextRequest = $A1;
+
+
+
+
+PDUGetResponse = $A2;
+
+
+
+
+PDUSetRequest = $A3;
+
+
+
+
+
+PDUGetBulkRequest = $A5;
+
+
+
+
+PDUInformRequest = $A6;
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+EWrongEncoding = 9;
+
+
+
+
+
+
+EInconsistentValue = 12;
+
+
+
+
+EResourceUnavailable = 13;
+
+
+
+
+ECommitFailed = 14;
+
+
+
+
+
+EAuthorizationError = 16;
+
+
+
+
+ENotWritable = 17;
+
+
+
+
+EInconsistentName = 18;
+
+
+ Generated by PasDoc 0.9.0 on 2012-04-23 21:38:51
+
+
ADDED lib/synapse/docs/help/sntpsend.TNtp.html
Index: lib/synapse/docs/help/sntpsend.TNtp.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/sntpsend.TNtp.html
@@ -0,0 +1,151 @@
+
+
+
+
+
+sntpsend: packed record TNtp
+
+
+
+packed record TNtp
+
+Unit
+
+sntpsend
+Declaration
+
+type TNtp = packed record
+Description
+
+Record containing the NTP packet.
+Overview
+Fields
+
+Description
+Fields
+
+
+
+
+
+
+RootDelay : Longint;
+
+
+
+
+RootDisperson : Longint;
+
+
+
+
+
+
+
+
+
+
+
+ Generated by PasDoc 0.9.0 on 2012-04-23 21:38:51
+
+
ADDED lib/synapse/docs/help/sntpsend.TSNTPSend.html
Index: lib/synapse/docs/help/sntpsend.TSNTPSend.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/sntpsend.TSNTPSend.html
@@ -0,0 +1,206 @@
+
+
+
+
+
+sntpsend: Class TSNTPSend
+
+
+
+Class TSNTPSend
+
+Unit
+
+sntpsend
+Declaration
+
+type TSNTPSend = class(TSynaClient )
+Description
+
+Implementation of NTP and SNTP client protocol
+
+, include time synchronisation. It can send NTP or SNTP time queries, or it can receive NTP broadcasts too.
+
+
Note: Are you missing properties for specify server address and port? Look to parent TSynaClient too!
+Hierarchy
+Overview
+Methods
+
+
+
+constructor Create ;
+
+
+
+destructor Destroy ; override;
+
+
+
+function DecodeTs (Nsec, Nfrac: Longint): TDateTime;
+
+
+
+procedure EncodeTs (dt: TDateTime; var Nsec, Nfrac: Longint);
+
+
+
+function GetSNTP : Boolean;
+
+
+
+function GetNTP : Boolean;
+
+
+
+function GetBroadcastNTP : Boolean;
+
+
+Properties
+
+
+
+property NTPReply : TNtp read FNTPReply;
+
+
+
+property NTPTime : TDateTime read FNTPTime;
+
+
+
+property NTPOffset : Double read FNTPOffset;
+
+
+
+property NTPDelay : Double read FNTPDelay;
+
+
+
+property MaxSyncDiff : double read FMaxSyncDiff write FMaxSyncDiff;
+
+
+
+property SyncTime : Boolean read FSyncTime write FSyncTime;
+
+
+
+property Sock : TUDPBlockSocket read FSock;
+
+
+Description
+Methods
+
+
+
+constructor Create ;
+
+
+
+
+
+destructor Destroy ; override;
+
+
+
+
+
+function DecodeTs (Nsec, Nfrac: Longint): TDateTime;
+
+
+
+Decode 128 bit timestamp used in NTP packet to TDateTime type.
+
+
+
+procedure EncodeTs (dt: TDateTime; var Nsec, Nfrac: Longint);
+
+
+
+Decode TDateTime type to 128 bit timestamp used in NTP packet.
+
+
+
+function GetSNTP : Boolean;
+
+
+
+Send request to TSynaClient .TargetHost and wait for reply. If all is OK, then result is True
and NTPReply and NTPTime are valid.
+
+
+
+function GetNTP : Boolean;
+
+
+
+Send request to TSynaClient .TargetHost and wait for reply. If all is OK, then result is True
and NTPReply and NTPTime are valid. Result time is after all needed corrections.
+
+
+
+function GetBroadcastNTP : Boolean;
+
+
+
+Wait for broadcast NTP packet. If all OK, result is True
and NTPReply and NTPTime are valid.
+Properties
+
+
+
+property NTPReply : TNtp read FNTPReply;
+
+
+
+Holds last received NTP packet.
+
+
+
+property NTPTime : TDateTime read FNTPTime;
+
+
+
+Date and time of remote NTP or SNTP server. (UTC time!!!)
+
+
+
+property NTPOffset : Double read FNTPOffset;
+
+
+
+Offset between your computer and remote NTP or SNTP server.
+
+
+
+property NTPDelay : Double read FNTPDelay;
+
+
+
+Delay between your computer and remote NTP or SNTP server.
+
+
+
+property MaxSyncDiff : double read FMaxSyncDiff write FMaxSyncDiff;
+
+
+
+Define allowed maximum difference between your time and remote time for synchronising time. If difference is bigger, your system time is not changed!
+
+
+
+property SyncTime : Boolean read FSyncTime write FSyncTime;
+
+
+
+If True
, after successfull getting time is local computer clock synchronised to given time. For synchronising time you must have proper rights! (Usually Administrator)
+
+
+Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:51
+
+
ADDED lib/synapse/docs/help/sntpsend.html
Index: lib/synapse/docs/help/sntpsend.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/sntpsend.html
@@ -0,0 +1,53 @@
+
+
+
+
+
+sntpsend
+
+
+
+Unit sntpsend
+
+Description
+
+ NTP and SNTP client
+
+
+
+
Used RFC: RFC-1305, RFC-2030
+uses
+Overview
+Classes, Interfaces, Objects and Records
+
+
+
+packed record TNtp
+Record containing the NTP packet.
+
+
+Class TSNTPSend
+Implementation of NTP and SNTP client protocol
+
+
+Constants
+
+Description
+Constants
+
+
+cNtpProtocol = '123';
+
+
+ Generated by PasDoc 0.9.0 on 2012-04-23 21:38:51
+
+
ADDED lib/synapse/docs/help/ssl_cryptlib.TSSLCryptLib.html
Index: lib/synapse/docs/help/ssl_cryptlib.TSSLCryptLib.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/ssl_cryptlib.TSSLCryptLib.html
@@ -0,0 +1,278 @@
+
+
+
+
+
+ssl_cryptlib: Class TSSLCryptLib
+
+
+
+Class TSSLCryptLib
+
+Unit
+
+ssl_cryptlib
+Declaration
+
+type TSSLCryptLib = class(TCustomSSL )
+Description
+
+class implementing CryptLib SSL/SSH plugin.
+
+ Instance of this class will be created for each TTCPBlockSocket . You not need to create instance of this class, all is done by Synapse itself!
+Hierarchy
+Overview
+Methods
+
+Properties
+
+
+
+property PrivateKeyLabel : string read FPrivateKeyLabel Write FPrivateKeyLabel;
+
+
+Description
+Methods
+
+
+See TCustomSSL .Create
+
+
+
+destructor Destroy ; override;
+
+
+
+
+
+procedure SetCertCAFile (const Value: string); override;
+
+
+
+Load trusted CA's in PEM format
+
+
+
+function LibVersion : String; override;
+
+
+
+See TCustomSSL .LibVersion
+
+
+
+function LibName : String; override;
+
+
+
+See TCustomSSL .LibName
+
+
+
+procedure Assign (const Value: TCustomSSL ); override;
+
+
+
+See TCustomSSL .Assign
+
+
+
+function Connect : boolean; override;
+
+
+
+See TCustomSSL .Connect and ssl_cryptlib for more details.
+
+
+
+function Accept : boolean; override;
+
+
+
+See TCustomSSL .Accept and ssl_cryptlib for more details.
+
+
+
+function Shutdown : boolean; override;
+
+
+
+See TCustomSSL .Shutdown
+
+
+
+function BiShutdown : boolean; override;
+
+
+
+See TCustomSSL .BiShutdown
+
+
+
+function SendBuffer (Buffer: TMemory; Len: Integer): Integer; override;
+
+
+
+See TCustomSSL .SendBuffer
+
+
+
+function RecvBuffer (Buffer: TMemory; Len: Integer): Integer; override;
+
+
+
+See TCustomSSL .RecvBuffer
+
+
+
+function WaitingData : Integer; override;
+
+
+
+See TCustomSSL .WaitingData
+
+
+
+function GetSSLVersion : string; override;
+
+
+
+See TCustomSSL .GetSSLVersion
+
+
+
+function GetPeerSubject : string; override;
+
+
+
+See TCustomSSL .GetPeerSubject
+
+
+
+function GetPeerIssuer : string; override;
+
+
+
+See TCustomSSL .GetPeerIssuer
+
+
+
+function GetPeerName : string; override;
+
+
+
+See TCustomSSL .GetPeerName
+
+
+
+function GetPeerFingerprint : string; override;
+
+
+
+See TCustomSSL .GetPeerFingerprint
+
+
+
+function GetVerifyCert : integer; override;
+
+
+
+See TCustomSSL .GetVerifyCert
+Properties
+
+
+
+property PrivateKeyLabel : string read FPrivateKeyLabel Write FPrivateKeyLabel;
+
+
+
+name of certificate/key within PKCS#15 file. It can hold more then one certificate/key and each certificate/key must have unique label within one file.
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:51
+
+
ADDED lib/synapse/docs/help/ssl_cryptlib.html
Index: lib/synapse/docs/help/ssl_cryptlib.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/ssl_cryptlib.html
@@ -0,0 +1,46 @@
+
+
+
+
+
+ssl_cryptlib
+
+
+
+Unit ssl_cryptlib
+
+Description
+
+SSL/SSH plugin for CryptLib
+
+
+
+
This plugin requires cl32.dll at least version 3.2.0! It can be used on Win32 and Linux. This library is staticly linked - when you compile your application with this plugin, you MUST distribute it with Cryptib library, otherwise you cannot run your application!
+
+
It can work with keys and certificates stored as PKCS#15 only! It must be stored as disk file only, you cannot load them from memory! Each file can hold multiple keys and certificates. You must identify it by 'label' stored in TSSLCryptLib .PrivateKeyLabel .
+
+
If you need to use secure connection and authorize self by certificate (each SSL/TLS server or client with client authorization), then use TCustomSSL .PrivateKeyFile , TSSLCryptLib .PrivateKeyLabel and TCustomSSL .KeyPassword properties.
+
+
If you need to use server what verifying client certificates, then use TCustomSSL .CertCAFile as PKCS#15 file with public keyas of allowed clients. Clients with non-matching certificates will be rejected by cryptLib.
+
+
This plugin is capable to create Ad-Hoc certificates. When you start SSL/TLS server without explicitly assigned key and certificate, then this plugin create Ad-Hoc key and certificate for each incomming connection by self. It slowdown accepting of new connections!
+
+
You can use this plugin for SSHv2 connections too! You must explicitly set TCustomSSL .SSLType to value LT_SSHv2 and set TCustomSSL .Username and TCustomSSL .Password . You can use special SSH channels too, see TCustomSSL .
+uses
+Overview
+Classes, Interfaces, Objects and Records
+
+
+
+Class TSSLCryptLib
+class implementing CryptLib SSL/SSH plugin.
+
+
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:51
+
+
ADDED lib/synapse/docs/help/ssl_openssl.TSSLOpenSSL.html
Index: lib/synapse/docs/help/ssl_openssl.TSSLOpenSSL.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/ssl_openssl.TSSLOpenSSL.html
@@ -0,0 +1,310 @@
+
+
+
+
+
+ssl_openssl: Class TSSLOpenSSL
+
+
+
+Class TSSLOpenSSL
+
+Unit
+
+ssl_openssl
+Declaration
+
+type TSSLOpenSSL = class(TCustomSSL )
+Description
+
+class implementing OpenSSL SSL plugin.
+
+ Instance of this class will be created for each TTCPBlockSocket . You not need to create instance of this class, all is done by Synapse itself!
+Hierarchy
+Overview
+Methods
+
+Description
+Methods
+
+
+See TCustomSSL .Create
+
+
+
+destructor Destroy ; override;
+
+
+
+
+
+function LibVersion : String; override;
+
+
+
+See TCustomSSL .LibVersion
+
+
+
+function LibName : String; override;
+
+
+
+See TCustomSSL .LibName
+
+
+
+function Connect : boolean; override;
+
+
+
+See TCustomSSL .Connect and ssl_cryptlib for more details.
+
+
+
+function Accept : boolean; override;
+
+
+
+See TCustomSSL .Accept and ssl_cryptlib for more details.
+
+
+
+function Shutdown : boolean; override;
+
+
+
+See TCustomSSL .Shutdown
+
+
+
+function BiShutdown : boolean; override;
+
+
+
+See TCustomSSL .BiShutdown
+
+
+
+function SendBuffer (Buffer: TMemory; Len: Integer): Integer; override;
+
+
+
+See TCustomSSL .SendBuffer
+
+
+
+function RecvBuffer (Buffer: TMemory; Len: Integer): Integer; override;
+
+
+
+See TCustomSSL .RecvBuffer
+
+
+
+function WaitingData : Integer; override;
+
+
+
+See TCustomSSL .WaitingData
+
+
+
+function GetSSLVersion : string; override;
+
+
+
+See TCustomSSL .GetSSLVersion
+
+
+
+function GetPeerSubject : string; override;
+
+
+
+See TCustomSSL .GetPeerSubject
+
+
+
+function GetPeerSerialNo : integer; override;
+
+
+
+See TCustomSSL .GetPeerSerialNo
+
+
+
+function GetPeerIssuer : string; override;
+
+
+
+See TCustomSSL .GetPeerIssuer
+
+
+
+function GetPeerName : string; override;
+
+
+
+See TCustomSSL .GetPeerName
+
+
+
+function GetPeerNameHash : cardinal; override;
+
+
+
+See TCustomSSL .GetPeerNameHash
+
+
+
+function GetPeerFingerprint : string; override;
+
+
+
+See TCustomSSL .GetPeerFingerprint
+
+
+
+function GetCertInfo : string; override;
+
+
+
+See TCustomSSL .GetCertInfo
+
+
+
+function GetCipherName : string; override;
+
+
+
+See TCustomSSL .GetCipherName
+
+
+
+function GetCipherBits : integer; override;
+
+
+
+See TCustomSSL .GetCipherBits
+
+
+
+function GetCipherAlgBits : integer; override;
+
+
+
+See TCustomSSL .GetCipherAlgBits
+
+
+
+function GetVerifyCert : integer; override;
+
+
+
+See TCustomSSL .GetVerifyCert
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:52
+
+
ADDED lib/synapse/docs/help/ssl_openssl.html
Index: lib/synapse/docs/help/ssl_openssl.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/ssl_openssl.html
@@ -0,0 +1,46 @@
+
+
+
+
+
+ssl_openssl
+
+
+
+Unit ssl_openssl
+
+Description
+
+SSL plugin for OpenSSL
+
+
+
+
You need OpenSSL libraries version 0.9.7. It can work with 0.9.6 too, but application mysteriously crashing when you are using freePascal on Linux. Use Kylix on Linux is OK! If you have version 0.9.7 on Linux, then I not see any problems with FreePascal.
+
+
OpenSSL libraries are loaded dynamicly - you not need OpenSSl librares even you compile your application with this unit. SSL just not working when you not have OpenSSL libraries.
+
+
This plugin have limited support for .NET too! Because is not possible to use callbacks with CDECL calling convention under .NET, is not supported key/certificate passwords and multithread locking. :-(
+
+
For handling keys and certificates you can use this properties:
+
+
TCustomSSL .CertificateFile for PEM or ASN1 DER (cer) format. TCustomSSL .Certificate for ASN1 DER format only. TCustomSSL .PrivateKeyFile for PEM or ASN1 DER (key) format. TCustomSSL .PrivateKey for ASN1 DER format only. TCustomSSL .CertCAFile for PEM CA certificate bundle. TCustomSSL .PFXfile for PFX format. TCustomSSL .PFX for PFX format from binary string.
+
+
This plugin is capable to create Ad-Hoc certificates. When you start SSL/TLS server without explicitly assigned key and certificate, then this plugin create Ad-Hoc key and certificate for each incomming connection by self. It slowdown accepting of new connections!
+uses
+Overview
+Classes, Interfaces, Objects and Records
+
+
+
+Class TSSLOpenSSL
+class implementing OpenSSL SSL plugin.
+
+
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:51
+
+
ADDED lib/synapse/docs/help/ssl_openssl_lib.des_ks_struct.html
Index: lib/synapse/docs/help/ssl_openssl_lib.des_ks_struct.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/ssl_openssl_lib.des_ks_struct.html
@@ -0,0 +1,45 @@
+
+
+
+
+
+ssl_openssl_lib: packed record des_ks_struct
+
+
+
+packed record des_ks_struct
+
+Unit
+
+ssl_openssl_lib
+Declaration
+
+type des_ks_struct = packed record
+Description
+ Overview
+Fields
+
+Description
+Fields
+
+
+
+weak_key : Integer;
+
+
+ Generated by PasDoc 0.9.0 on 2012-04-23 21:38:52
+
+
ADDED lib/synapse/docs/help/ssl_openssl_lib.html
Index: lib/synapse/docs/help/ssl_openssl_lib.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/ssl_openssl_lib.html
@@ -0,0 +1,1541 @@
+
+
+
+
+
+ssl_openssl_lib
+
+
+
+Unit ssl_openssl_lib
+
+Description
+
+OpenSSL support
+
+
+
+
This unit is Pascal interface to OpenSSL library (used by ssl_openssl unit). OpenSSL is loaded dynamicly on-demand. If this library is not found in system, requested OpenSSL function just return errorcode.
+uses
+Overview
+Classes, Interfaces, Objects and Records
+
+Functions and Procedures
+
+Types
+
+Constants
+
+Variables
+
+Description
+Functions and Procedures
+
+
+function SslGetError (s: PSSL ; ret_code: Integer):Integer;
+
+
+
+
+function SslLibraryInit :Integer;
+
+
+
+
+procedure SslLoadErrorStrings ;
+
+
+
+
+function SslCtxSetCipherList (arg0: PSSL_CTX ; var str: AnsiString):Integer;
+
+
+
+
+
+procedure SslCtxFree (arg0: PSSL_CTX );
+
+
+
+
+function SslSetFd (s: PSSL ; fd: Integer):Integer;
+
+
+
+
+
+
+
+
+function SslCtxUsePrivateKey (ctx: PSSL_CTX ; pkey: SslPtr ):Integer;
+
+
+
+
+function SslCtxUsePrivateKeyASN1 (pk: integer; ctx: PSSL_CTX ; d: AnsiString; len: integer):Integer;
+
+
+
+
+function SslCtxUsePrivateKeyFile (ctx: PSSL_CTX ; const _file: AnsiString; _type: Integer):Integer;
+
+
+
+
+function SslCtxUseCertificate (ctx: PSSL_CTX ; x: SslPtr ):Integer;
+
+
+
+
+function SslCtxUseCertificateASN1 (ctx: PSSL_CTX ; len: integer; d: AnsiString):Integer;
+
+
+
+
+function SslCtxUseCertificateFile (ctx: PSSL_CTX ; const _file: AnsiString; _type: Integer):Integer;
+
+
+
+
+function SslCtxUseCertificateChainFile (ctx: PSSL_CTX ; const _file: AnsiString):Integer;
+
+
+
+
+function SslCtxCheckPrivateKeyFile (ctx: PSSL_CTX ):Integer;
+
+
+
+
+
+procedure SslCtxSetDefaultPasswdCbUserdata (ctx: PSSL_CTX ; u: SslPtr );
+
+
+
+
+function SslCtxLoadVerifyLocations (ctx: PSSL_CTX ; const CAfile: AnsiString; const CApath: AnsiString):Integer;
+
+
+
+
+function SslCtxCtrl (ctx: PSSL_CTX ; cmd: integer; larg: integer; parg: SslPtr ): integer;
+
+
+
+
+
+procedure SslFree (ssl: PSSL );
+
+
+
+
+function SslAccept (ssl: PSSL ):Integer;
+
+
+
+
+function SslConnect (ssl: PSSL ):Integer;
+
+
+
+
+function SslShutdown (ssl: PSSL ):Integer;
+
+
+
+
+function SslRead (ssl: PSSL ; buf: SslPtr ; num: Integer):Integer;
+
+
+
+
+function SslPeek (ssl: PSSL ; buf: SslPtr ; num: Integer):Integer;
+
+
+
+
+function SslWrite (ssl: PSSL ; buf: SslPtr ; num: Integer):Integer;
+
+
+
+
+function SslPending (ssl: PSSL ):Integer;
+
+
+
+
+function SslGetVersion (ssl: PSSL ):AnsiString;
+
+
+
+
+function SslGetPeerCertificate (ssl: PSSL ):PX509 ;
+
+
+
+
+
+function SSLGetCurrentCipher (s: PSSL ):SslPtr ;
+
+
+
+
+function SSLCipherGetName (c: SslPtr ): AnsiString;
+
+
+
+
+function SSLCipherGetBits (c: SslPtr ; var alg_bits: Integer):Integer;
+
+
+
+
+function SSLGetVerifyResult (ssl: PSSL ):Integer;
+
+
+
+
+function SSLCtrl (ssl: PSSL ; cmd: integer; larg: integer; parg: SslPtr ):Integer;
+
+
+
+
+function X509New : PX509 ;
+
+
+
+
+procedure X509Free (x: PX509 );
+
+
+
+
+function X509NameOneline (a: PX509_NAME ; var buf: AnsiString; size: Integer):AnsiString;
+
+
+
+
+
+
+function X509NameHash (x: PX509_NAME ):Cardinal;
+
+
+
+
+function X509Digest (data: PX509 ; _type: PEVP_MD ; md: AnsiString; var len: Integer):Integer;
+
+
+
+
+function X509print (b: PBIO ; a: PX509 ): integer;
+
+
+
+
+function X509SetVersion (x: PX509 ; version: integer): integer;
+
+
+
+
+function X509SetPubkey (x: PX509 ; pkey: EVP_PKEY ): integer;
+
+
+
+
+
+function X509NameAddEntryByTxt (name: PX509_NAME ; field: Ansistring; _type: integer; bytes: Ansistring; len, loc, _set: integer): integer;
+
+
+
+
+
+
+
+
+
+
+procedure EvpPkeyFree (pk: EVP_PKEY );
+
+
+
+
+function EvpPkeyAssign (pkey: EVP_PKEY ; _type: integer; key: Prsa ): integer;
+
+
+
+
+function EvpGetDigestByName (Name: AnsiString): PEVP_MD ;
+
+
+
+
+procedure EVPcleanup ;
+
+
+
+
+function SSLeayversion (t: integer): Ansistring;
+
+
+
+
+procedure ErrErrorString (e: integer; var buf: Ansistring; len: integer);
+
+
+
+
+function ErrGetError : integer;
+
+
+
+
+procedure ErrClearError ;
+
+
+
+
+procedure ErrFreeStrings ;
+
+
+
+
+procedure ErrRemoveState (pid: integer);
+
+
+
+
+procedure OPENSSLaddallalgorithms ;
+
+
+
+
+procedure CRYPTOcleanupAllExData ;
+
+
+
+
+procedure RandScreen ;
+
+
+
+
+
+procedure BioFreeAll (b: PBIO );
+
+
+
+
+
+function BioCtrlPending (b: PBIO ): integer;
+
+
+
+
+function BioRead (b: PBIO ; var Buf: AnsiString; Len: integer): integer;
+
+
+
+
+function BioWrite (b: PBIO ; Buf: AnsiString; Len: integer): integer;
+
+
+
+
+
+function PKCS12parse (p12: SslPtr ; pass: Ansistring; var pkey, cert, ca: SslPtr ): integer;
+
+
+
+
+procedure PKCS12free (p12: SslPtr );
+
+
+
+
+
+
+
+function Asn1IntegerSet (a: PASN1_INTEGER ; v: integer): integer;
+
+
+
+
+
+function i2dX509bio (b: PBIO ; x: PX509 ): integer;
+
+
+
+
+
+
+
+function i2dPrivateKeyBio (b: PBIO ; pkey: EVP_PKEY ): integer;
+
+
+
+
+procedure DESsetoddparity (Key: des_cblock );
+
+
+
+
+
+
+function IsSSLloaded : Boolean;
+
+
+
+
+function InitSSLInterface : Boolean;
+
+
+
+
+function DestroySSLInterface : Boolean;
+
+
+ Types
+
+
+
+
+
+
+
+
+
+
+PInteger = ˆInteger;
+
+
+
+
+
+
+
+
+PASN1_UTCTIME = SslPtr ;
+
+
+
+
+PASN1_INTEGER = SslPtr ;
+
+
+
+
+
+PFunction = procedure;
+
+
+
+
+
+TSkPopFreeFunc = procedure(p:SslPtr ); cdecl;
+
+
+
+
+TX509Free = procedure(x: PX509 ); cdecl;
+
+
+
+
+DES_cblock = array[0..7] of Byte;
+
+
+
+
+ Constants
+
+
+EVP_MAX_MD_SIZE = 16 + 20;
+
+
+
+
+SSL_ERROR_NONE = 0;
+
+
+
+
+SSL_ERROR_SSL = 1;
+
+
+
+
+SSL_ERROR_WANT_READ = 2;
+
+
+
+
+SSL_ERROR_WANT_WRITE = 3;
+
+
+
+
+SSL_ERROR_WANT_X509_LOOKUP = 4;
+
+
+
+
+SSL_ERROR_SYSCALL = 5;
+
+
+
+
+SSL_ERROR_ZERO_RETURN = 6;
+
+
+
+
+SSL_ERROR_WANT_CONNECT = 7;
+
+
+
+
+SSL_ERROR_WANT_ACCEPT = 8;
+
+
+
+
+SSL_OP_NO_SSLv2 = $01000000;
+
+
+
+
+SSL_OP_NO_SSLv3 = $02000000;
+
+
+
+
+SSL_OP_NO_TLSv1 = $04000000;
+
+
+
+
+SSL_OP_ALL = $000FFFFF;
+
+
+
+
+SSL_VERIFY_NONE = $00;
+
+
+
+
+SSL_VERIFY_PEER = $01;
+
+
+
+
+OPENSSL_DES_DECRYPT = 0;
+
+
+
+
+OPENSSL_DES_ENCRYPT = 1;
+
+
+
+
+
+X509_V_ILLEGAL = 1;
+
+
+
+
+X509_V_ERR_UNABLE_TO_GET_ISSUER_CERT = 2;
+
+
+
+
+X509_V_ERR_UNABLE_TO_GET_CRL = 3;
+
+
+
+
+X509_V_ERR_UNABLE_TO_DECRYPT_CERT_SIGNATURE = 4;
+
+
+
+
+X509_V_ERR_UNABLE_TO_DECRYPT_CRL_SIGNATURE = 5;
+
+
+
+
+X509_V_ERR_UNABLE_TO_DECODE_ISSUER_PUBLIC_KEY = 6;
+
+
+
+
+X509_V_ERR_CERT_SIGNATURE_FAILURE = 7;
+
+
+
+
+X509_V_ERR_CRL_SIGNATURE_FAILURE = 8;
+
+
+
+
+X509_V_ERR_CERT_NOT_YET_VALID = 9;
+
+
+
+
+X509_V_ERR_CERT_HAS_EXPIRED = 10;
+
+
+
+
+X509_V_ERR_CRL_NOT_YET_VALID = 11;
+
+
+
+
+X509_V_ERR_CRL_HAS_EXPIRED = 12;
+
+
+
+
+X509_V_ERR_ERROR_IN_CERT_NOT_BEFORE_FIELD = 13;
+
+
+
+
+X509_V_ERR_ERROR_IN_CERT_NOT_AFTER_FIELD = 14;
+
+
+
+
+X509_V_ERR_ERROR_IN_CRL_LAST_UPDATE_FIELD = 15;
+
+
+
+
+X509_V_ERR_ERROR_IN_CRL_NEXT_UPDATE_FIELD = 16;
+
+
+
+
+X509_V_ERR_OUT_OF_MEM = 17;
+
+
+
+
+X509_V_ERR_DEPTH_ZERO_SELF_SIGNED_CERT = 18;
+
+
+
+
+X509_V_ERR_SELF_SIGNED_CERT_IN_CHAIN = 19;
+
+
+
+
+X509_V_ERR_UNABLE_TO_GET_ISSUER_CERT_LOCALLY = 20;
+
+
+
+
+X509_V_ERR_UNABLE_TO_VERIFY_LEAF_SIGNATURE = 21;
+
+
+
+
+X509_V_ERR_CERT_CHAIN_TOO_LONG = 22;
+
+
+
+
+X509_V_ERR_CERT_REVOKED = 23;
+
+
+
+
+X509_V_ERR_INVALID_CA = 24;
+
+
+
+
+X509_V_ERR_PATH_LENGTH_EXCEEDED = 25;
+
+
+
+
+X509_V_ERR_INVALID_PURPOSE = 26;
+
+
+
+
+X509_V_ERR_CERT_UNTRUSTED = 27;
+
+
+
+
+X509_V_ERR_CERT_REJECTED = 28;
+
+
+
+
+X509_V_ERR_SUBJECT_ISSUER_MISMATCH = 29;
+
+
+
+
+X509_V_ERR_AKID_SKID_MISMATCH = 30;
+
+
+
+
+X509_V_ERR_AKID_ISSUER_SERIAL_MISMATCH = 31;
+
+
+
+
+X509_V_ERR_KEYUSAGE_NO_CERTSIGN = 32;
+
+
+
+
+X509_V_ERR_UNABLE_TO_GET_CRL_ISSUER = 33;
+
+
+
+
+X509_V_ERR_UNHANDLED_CRITICAL_EXTENSION = 34;
+
+
+
+
+X509_V_ERR_APPLICATION_VERIFICATION = 50;
+
+
+
+
+SSL_FILETYPE_ASN1 = 2;
+
+
+
+
+SSL_FILETYPE_PEM = 1;
+
+
+
+
+
+SSL_CTRL_SET_TLSEXT_HOSTNAME = 55;
+
+
+
+
+TLSEXT_NAMETYPE_host_name = 0;
+
+
+ Variables
+
+
+DLLSSLName : string = 'ssleay32.dll';
+
+
+
+
+DLLSSLName2 : string = 'libssl32.dll';
+
+
+
+
+DLLUtilName : string = 'libeay32.dll';
+
+
+
+
+
+
+SSLLibFile : string = '';
+
+
+
+
+SSLUtilFile : string = '';
+
+
+
+ Generated by PasDoc 0.9.0 on 2012-04-23 21:38:52
+
+
ADDED lib/synapse/docs/help/ssl_sbb.TSSLSBB.html
Index: lib/synapse/docs/help/ssl_sbb.TSSLSBB.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/ssl_sbb.TSSLSBB.html
@@ -0,0 +1,280 @@
+
+
+
+
+
+ssl_sbb: Class TSSLSBB
+
+
+
+Class TSSLSBB
+
+Unit
+
+ssl_sbb
+Declaration
+
+type TSSLSBB = class(TCustomSSL )
+Description
+
+class implementing SecureBlackbox SSL plugin.
+
+ Instance of this class will be created for each TTCPBlockSocket . You not need to create instance of this class, all is done by Synapse itself!
+Hierarchy
+Overview
+Methods
+
+Properties
+
+
+
+property ElSecureClient : TElSecureClient read FElSecureClient write FElSecureClient;
+
+
+
+property ElSecureServer : TElSecureServer read FElSecureServer write FElSecureServer;
+
+
+
+property CipherSuites : TBits read FCipherSuites write FCipherSuites;
+
+
+
+property CipherSuite : Integer read GetCipherSuite;
+
+
+Description
+Methods
+
+
+
+
+destructor Destroy ; override;
+
+
+
+
+
+function LibVersion : String; override;
+
+
+
+See TCustomSSL .LibVersion
+
+
+
+function LibName : String; override;
+
+
+
+See TCustomSSL .LibName
+
+
+
+function Connect : boolean; override;
+
+
+
+See TCustomSSL .Connect and ssl_sbb for more details.
+
+
+
+function Accept : boolean; override;
+
+
+
+See TCustomSSL .Accept and ssl_sbb for more details.
+
+
+
+function Shutdown : boolean; override;
+
+
+
+See TCustomSSL .Shutdown
+
+
+
+function BiShutdown : boolean; override;
+
+
+
+See TCustomSSL .BiShutdown
+
+
+
+function SendBuffer (Buffer: TMemory; Len: Integer): Integer; override;
+
+
+
+See TCustomSSL .SendBuffer
+
+
+
+function RecvBuffer (Buffer: TMemory; Len: Integer): Integer; override;
+
+
+
+See TCustomSSL .RecvBuffer
+
+
+
+function WaitingData : Integer; override;
+
+
+
+See TCustomSSL .WaitingData
+
+
+
+function GetSSLVersion : string; override;
+
+
+
+See TCustomSSL .GetSSLVersion
+
+
+
+function GetPeerSubject : string; override;
+
+
+
+See TCustomSSL .GetPeerSubject
+
+
+
+function GetPeerIssuer : string; override;
+
+
+
+See TCustomSSL .GetPeerIssuer
+
+
+
+function GetPeerName : string; override;
+
+
+
+See TCustomSSL .GetPeerName
+
+
+
+function GetPeerFingerprint : string; override;
+
+
+
+See TCustomSSL .GetPeerFingerprint
+
+
+
+function GetCertInfo : string; override;
+
+
+
+See TCustomSSL .GetCertInfo
+Properties
+
+
+
+property ElSecureClient : TElSecureClient read FElSecureClient write FElSecureClient;
+
+
+
+
+
+property ElSecureServer : TElSecureServer read FElSecureServer write FElSecureServer;
+
+
+
+
+
+property CipherSuites : TBits read FCipherSuites write FCipherSuites;
+
+
+
+
+
+property CipherSuite : Integer read GetCipherSuite;
+
+
+ Generated by PasDoc 0.9.0 on 2012-04-23 21:38:52
+
+
ADDED lib/synapse/docs/help/ssl_sbb.html
Index: lib/synapse/docs/help/ssl_sbb.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/ssl_sbb.html
@@ -0,0 +1,49 @@
+
+
+
+
+
+ssl_sbb
+
+
+
+Unit ssl_sbb
+
+Description
+
+SSL plugin for Eldos SecureBlackBox
+
+
+
+
For handling keys and certificates you can use this properties: TCustomSSL .CertCAFile , TCustomSSL .CertCA , TCustomSSL .TrustCertificateFile , TCustomSSL .TrustCertificate , TCustomSSL .PrivateKeyFile , TCustomSSL .PrivateKey , TCustomSSL .CertificateFile , TCustomSSL .Certificate , TCustomSSL .PFXfile . For usage of this properties and for possible formats of keys and certificates refer to SecureBlackBox documentation.
+uses
+SysUtils Classes Windows blcksock synsock synautil synacode SBClient SBServer SBX509 SBWinCertStorage SBCustomCertStorage SBUtils SBConstants SBSessionPool Overview
+Classes, Interfaces, Objects and Records
+
+
+
+Class TSSLSBB
+class implementing SecureBlackbox SSL plugin.
+
+
+Constants
+
+Description
+Constants
+
+
+DEFAULT_RECV_BUFFER =32768;
+
+
+ Generated by PasDoc 0.9.0 on 2012-04-23 21:38:52
+
+
ADDED lib/synapse/docs/help/ssl_streamsec.TSSLStreamSec.html
Index: lib/synapse/docs/help/ssl_streamsec.TSSLStreamSec.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/ssl_streamsec.TSSLStreamSec.html
@@ -0,0 +1,252 @@
+
+
+
+
+
+ssl_streamsec: Class TSSLStreamSec
+
+
+
+Class TSSLStreamSec
+
+Unit
+
+ssl_streamsec
+Declaration
+
+type TSSLStreamSec = class(TCustomSSL )
+Description
+
+class implementing StreamSecII SSL plugin.
+
+ Instance of this class will be created for each TTCPBlockSocket . You not need to create instance of this class, all is done by Synapse itself!
+Hierarchy
+Overview
+Methods
+
+Properties
+
+
+
+property TLSServer : TCustomTLSInternalServer read FTLSServer write FTLSServer;
+
+
+Description
+Methods
+
+
+
+
+destructor Destroy ; override;
+
+
+
+
+
+function LibVersion : String; override;
+
+
+
+See TCustomSSL .LibVersion
+
+
+
+function LibName : String; override;
+
+
+
+See TCustomSSL .LibName
+
+
+
+function Connect : boolean; override;
+
+
+
+See TCustomSSL .Connect and ssl_streamsec for more details.
+
+
+
+function Accept : boolean; override;
+
+
+
+See TCustomSSL .Accept and ssl_streamsec for more details.
+
+
+
+function Shutdown : boolean; override;
+
+
+
+See TCustomSSL .Shutdown
+
+
+
+function BiShutdown : boolean; override;
+
+
+
+See TCustomSSL .BiShutdown
+
+
+
+function SendBuffer (Buffer: TMemory; Len: Integer): Integer; override;
+
+
+
+See TCustomSSL .SendBuffer
+
+
+
+function RecvBuffer (Buffer: TMemory; Len: Integer): Integer; override;
+
+
+
+See TCustomSSL .RecvBuffer
+
+
+
+function WaitingData : Integer; override;
+
+
+
+See TCustomSSL .WaitingData
+
+
+
+function GetSSLVersion : string; override;
+
+
+
+See TCustomSSL .GetSSLVersion
+
+
+
+function GetPeerSubject : string; override;
+
+
+
+See TCustomSSL .GetPeerSubject
+
+
+
+function GetPeerIssuer : string; override;
+
+
+
+See TCustomSSL .GetPeerIssuer
+
+
+
+function GetPeerName : string; override;
+
+
+
+See TCustomSSL .GetPeerName
+
+
+
+function GetPeerFingerprint : string; override;
+
+
+
+See TCustomSSL .GetPeerFingerprint
+
+
+
+function GetCertInfo : string; override;
+
+
+
+See TCustomSSL .GetCertInfo
+Properties
+
+
+
+property TLSServer : TCustomTLSInternalServer read FTLSServer write FTLSServer;
+
+
+
+TLS server for tuning of StreamSecII.
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:52
+
+
ADDED lib/synapse/docs/help/ssl_streamsec.html
Index: lib/synapse/docs/help/ssl_streamsec.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/ssl_streamsec.html
@@ -0,0 +1,42 @@
+
+
+
+
+
+ssl_streamsec
+
+
+
+Unit ssl_streamsec
+
+Description
+
+SSL plugin for StreamSecII or OpenStreamSecII
+
+
+
+
StreamSecII is native pascal library, you not need any external libraries!
+
+
You can tune lot of StreamSecII properties by using your GlobalServer. If you not using your GlobalServer, then this plugin create own TSimpleTLSInternalServer instance for each TCP connection. Formore information about GlobalServer usage refer StreamSecII documentation.
+
+
If you are not using key and certificate by GlobalServer, then you can use properties of this plugin instead, but this have limited features and TCustomSSL .KeyPassword not working properly yet!
+
+
For handling keys and certificates you can use this properties: TCustomSSL .CertCAFile , TCustomSSL .CertCA , TCustomSSL .TrustCertificateFile , TCustomSSL .TrustCertificate , TCustomSSL .PrivateKeyFile , TCustomSSL .PrivateKey , TCustomSSL .CertificateFile , TCustomSSL .Certificate , TCustomSSL .PFXfile . For usage of this properties and for possible formats of keys and certificates refer to StreamSecII documentation.
+uses
+Overview
+Classes, Interfaces, Objects and Records
+
+
+
+Class TSSLStreamSec
+class implementing StreamSecII SSL plugin.
+
+
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:52
+
+
ADDED lib/synapse/docs/help/synachar.html
Index: lib/synapse/docs/help/synachar.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/synachar.html
@@ -0,0 +1,560 @@
+
+
+
+
+
+synachar
+
+
+
+Unit synachar
+
+Description
+
+Charset conversion support
+
+ This unit contains a routines for lot of charset conversions.
+
+
It using built-in conversion tables or external Iconv library. Iconv is used when needed conversion is known by Iconv library. When Iconv library is not found or Iconv not know requested conversion, then are internal routines used for conversion. (You can disable Iconv support from your program too!)
+
+
Internal routines knows all major charsets for Europe or America. For East-Asian charsets you must use Iconv library!
+uses
+Overview
+Functions and Procedures
+
+Types
+
+Constants
+
+
+IconvOnlyChars : set of TMimeChar = [UTF_16, UTF_16LE, UTF_32, UTF_32LE,
+ C99, JAVA, ISO_8859_16, KOI8_U, KOI8_RU, CP862, CP866, MAC, MACCE, MACICE,
+ MACCRO, MACRO, MACCYR, MACUK, MACGR, MACTU, MACHEB, MACAR, MACTH, ROMAN8,
+ NEXTSTEP, ARMASCII, GEORGIAN_AC, GEORGIAN_PS, KOI8_T, MULELAO, CP1133,
+ TIS620, CP874, VISCII, TCVN, ISO_IR_14, JIS_X0201, JIS_X0208, JIS_X0212,
+ GB1988_80, GB2312_80, ISO_IR_165, ISO_IR_149, EUC_JP, SHIFT_JIS, CP932,
+ ISO_2022_JP, ISO_2022_JP1, ISO_2022_JP2, GB2312, CP936, GB18030,
+ ISO_2022_CN, ISO_2022_CNE, HZ, EUC_TW, BIG5, CP950, BIG5_HKSCS, EUC_KR,
+ CP949, CP1361, ISO_2022_KR, CP737, CP775, CP853, CP855, CP857, CP858,
+ CP860, CP861, CP863, CP864, CP865, CP869, CP1125];
+
+
+NoIconvChars : set of TMimeChar = [CP895, UTF_7mod];
+
+
+Replace_None : array[0..0] of Word =
+ (0);
+
+
+Replace_Czech : array[0..59] of Word =
+ (
+ $00E1, $0061,
+ $010D, $0063,
+ $010F, $0064,
+ $010E, $0044,
+ $00E9, $0065,
+ $011B, $0065,
+ $00ED, $0069,
+ $0148, $006E,
+ $00F3, $006F,
+ $0159, $0072,
+ $0161, $0073,
+ $0165, $0074,
+ $00FA, $0075,
+ $016F, $0075,
+ $00FD, $0079,
+ $017E, $007A,
+ $00C1, $0041,
+ $010C, $0043,
+ $00C9, $0045,
+ $011A, $0045,
+ $00CD, $0049,
+ $0147, $004E,
+ $00D3, $004F,
+ $0158, $0052,
+ $0160, $0053,
+ $0164, $0054,
+ $00DA, $0055,
+ $016E, $0055,
+ $00DD, $0059,
+ $017D, $005A
+ );
+
+
+Variables
+
+
+DisableIconv : Boolean = False;
+
+
+IdealCharsets : TMimeSetChar =
+ [ISO_8859_1, ISO_8859_2, ISO_8859_3, ISO_8859_4, ISO_8859_5,
+ ISO_8859_6, ISO_8859_7, ISO_8859_8, ISO_8859_9, ISO_8859_10,
+ KOI8_R, KOI8_U
+
+ , GB2312, EUC_KR, ISO_2022_JP, EUC_TW
+
+ ];
+
+
+Description
+Functions and Procedures
+
+
+function CharsetConversion (const Value: AnsiString; CharFrom: TMimeChar ; CharTo: TMimeChar ): AnsiString;
+
+
+
+Convert Value from one charset to another. See: CharsetConversionEx
+
+
+function CharsetConversionEx (const Value: AnsiString; CharFrom: TMimeChar ; CharTo: TMimeChar ; const TransformTable: array of Word): AnsiString;
+
+
+
+Convert Value from one charset to another with additional character conversion. see: Replace_None and Replace_Czech
+
+
+function CharsetConversionTrans (Value: AnsiString; CharFrom: TMimeChar ; CharTo: TMimeChar ; const TransformTable: array of Word; Translit: Boolean): AnsiString;
+
+
+
+Convert Value from one charset to another with additional character conversion. This funtion is similar to CharsetConversionEx , but you can disable transliteration of unconvertible characters.
+
+
+Returns charset used by operating system.
+
+
+Returns charset used by operating system as OEM charset. (in Windows DOS box, for example)
+
+
+function GetCPFromID (Value: AnsiString): TMimeChar ;
+
+
+
+Converting string with charset name to TMimeChar.
+
+
+function GetIDFromCP (Value: TMimeChar ): AnsiString;
+
+
+
+Converting TMimeChar to string with name of charset.
+
+
+function NeedCharsetConversion (const Value: AnsiString): Boolean;
+
+
+
+return True
when value need to be converted. (It is not 7-bit ASCII)
+
+
+Finding best target charset from set of TMimeChars with minimal count of unconvertible characters.
+
+
+function GetBOM (Value: TMimeChar ): AnsiString;
+
+
+
+Return BOM (Byte Order Mark) for given unicode charset.
+
+
+function StringToWide (const Value: AnsiString): WideString;
+
+
+
+Convert binary string with unicode content to WideString.
+
+
+function WideToString (const Value: WideString): AnsiString;
+
+
+
+Convert WideString to binary string with unicode content.
+Types
+
+
+TMimeChar = (...);
+
+
+
+Type with all supported charsets.
+
+
+ISO_8859_1:
+
+ISO_8859_2:
+
+ISO_8859_3:
+
+ISO_8859_4:
+
+ISO_8859_5:
+
+ISO_8859_6:
+
+ISO_8859_7:
+
+ISO_8859_8:
+
+ISO_8859_9:
+
+ISO_8859_10:
+
+ISO_8859_13:
+
+ISO_8859_14:
+
+ISO_8859_15:
+
+CP1250:
+
+CP1251:
+
+CP1252:
+
+CP1253:
+
+CP1254:
+
+CP1255:
+
+CP1256:
+
+CP1257:
+
+CP1258:
+
+KOI8_R:
+
+CP895:
+
+CP852:
+
+UCS_2:
+
+UCS_4:
+
+UTF_8:
+
+UTF_7:
+
+UTF_7mod:
+
+UCS_2LE:
+
+UCS_4LE:
+
+UTF_16:
+
+UTF_16LE:
+
+UTF_32:
+
+UTF_32LE:
+
+C99:
+
+JAVA:
+
+ISO_8859_16:
+
+KOI8_U:
+
+KOI8_RU:
+
+CP862:
+
+CP866:
+
+MAC:
+
+MACCE:
+
+MACICE:
+
+MACCRO:
+
+MACRO:
+
+MACCYR:
+
+MACUK:
+
+MACGR:
+
+MACTU:
+
+MACHEB:
+
+MACAR:
+
+MACTH:
+
+ROMAN8:
+
+NEXTSTEP:
+
+ARMASCII:
+
+GEORGIAN_AC:
+
+GEORGIAN_PS:
+
+KOI8_T:
+
+MULELAO:
+
+CP1133:
+
+TIS620:
+
+CP874:
+
+VISCII:
+
+TCVN:
+
+ISO_IR_14:
+
+JIS_X0201:
+
+JIS_X0208:
+
+JIS_X0212:
+
+GB1988_80:
+
+GB2312_80:
+
+ISO_IR_165:
+
+ISO_IR_149:
+
+EUC_JP:
+
+SHIFT_JIS:
+
+CP932:
+
+ISO_2022_JP:
+
+ISO_2022_JP1:
+
+ISO_2022_JP2:
+
+GB2312:
+
+CP936:
+
+GB18030:
+
+ISO_2022_CN:
+
+ISO_2022_CNE:
+
+HZ:
+
+EUC_TW:
+
+BIG5:
+
+CP950:
+
+BIG5_HKSCS:
+
+EUC_KR:
+
+CP949:
+
+CP1361:
+
+ISO_2022_KR:
+
+CP737:
+
+CP775:
+
+CP853:
+
+CP855:
+
+CP857:
+
+CP858:
+
+CP860:
+
+CP861:
+
+CP863:
+
+CP864:
+
+CP865:
+
+CP869:
+
+CP1125:
+
+
+
+Set of any charsets.
+Constants
+
+
+IconvOnlyChars : set of TMimeChar = [UTF_16, UTF_16LE, UTF_32, UTF_32LE,
+ C99, JAVA, ISO_8859_16, KOI8_U, KOI8_RU, CP862, CP866, MAC, MACCE, MACICE,
+ MACCRO, MACRO, MACCYR, MACUK, MACGR, MACTU, MACHEB, MACAR, MACTH, ROMAN8,
+ NEXTSTEP, ARMASCII, GEORGIAN_AC, GEORGIAN_PS, KOI8_T, MULELAO, CP1133,
+ TIS620, CP874, VISCII, TCVN, ISO_IR_14, JIS_X0201, JIS_X0208, JIS_X0212,
+ GB1988_80, GB2312_80, ISO_IR_165, ISO_IR_149, EUC_JP, SHIFT_JIS, CP932,
+ ISO_2022_JP, ISO_2022_JP1, ISO_2022_JP2, GB2312, CP936, GB18030,
+ ISO_2022_CN, ISO_2022_CNE, HZ, EUC_TW, BIG5, CP950, BIG5_HKSCS, EUC_KR,
+ CP949, CP1361, ISO_2022_KR, CP737, CP775, CP853, CP855, CP857, CP858,
+ CP860, CP861, CP863, CP864, CP865, CP869, CP1125];
+
+
+
+Set of charsets supported by Iconv library only.
+
+
+NoIconvChars : set of TMimeChar = [CP895, UTF_7mod];
+
+
+
+Set of charsets supported by internal routines only.
+
+
+Replace_None : array[0..0] of Word =
+ (0);
+
+
+
+null character replace table. (Usable for disable charater replacing.)
+
+
+Replace_Czech : array[0..59] of Word =
+ (
+ $00E1, $0061,
+ $010D, $0063,
+ $010F, $0064,
+ $010E, $0044,
+ $00E9, $0065,
+ $011B, $0065,
+ $00ED, $0069,
+ $0148, $006E,
+ $00F3, $006F,
+ $0159, $0072,
+ $0161, $0073,
+ $0165, $0074,
+ $00FA, $0075,
+ $016F, $0075,
+ $00FD, $0079,
+ $017E, $007A,
+ $00C1, $0041,
+ $010C, $0043,
+ $00C9, $0045,
+ $011A, $0045,
+ $00CD, $0049,
+ $0147, $004E,
+ $00D3, $004F,
+ $0158, $0052,
+ $0160, $0053,
+ $0164, $0054,
+ $00DA, $0055,
+ $016E, $0055,
+ $00DD, $0059,
+ $017D, $005A
+ );
+
+
+
+Character replace table for remove Czech diakritics.
+Variables
+
+
+DisableIconv : Boolean = False;
+
+
+
+By this you can generally disable/enable Iconv support.
+
+
+IdealCharsets : TMimeSetChar =
+ [ISO_8859_1, ISO_8859_2, ISO_8859_3, ISO_8859_4, ISO_8859_5,
+ ISO_8859_6, ISO_8859_7, ISO_8859_8, ISO_8859_9, ISO_8859_10,
+ KOI8_R, KOI8_U
+
+ , GB2312, EUC_KR, ISO_2022_JP, EUC_TW
+
+ ];
+
+
+
+Default set of charsets for IdealCharsetCoding function.
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:52
+
+
ADDED lib/synapse/docs/help/synacode.html
Index: lib/synapse/docs/help/synacode.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/synacode.html
@@ -0,0 +1,498 @@
+
+
+
+
+
+synacode
+
+
+
+Unit synacode
+
+Description
+
+Various encoding and decoding support
+uses
+Overview
+Functions and Procedures
+
+
+function DecodeTriplet (const Value: AnsiString; Delimiter: AnsiChar): AnsiString;
+
+
+function DecodeQuotedPrintable (const Value: AnsiString): AnsiString;
+
+
+function DecodeURL (const Value: AnsiString): AnsiString;
+
+
+function EncodeTriplet (const Value: AnsiString; Delimiter: AnsiChar; Specials: TSpecials ): AnsiString;
+
+
+function EncodeQuotedPrintable (const Value: AnsiString): AnsiString;
+
+
+function EncodeSafeQuotedPrintable (const Value: AnsiString): AnsiString;
+
+
+function EncodeURLElement (const Value: AnsiString): AnsiString;
+
+
+function EncodeURL (const Value: AnsiString): AnsiString;
+
+
+function Decode4to3 (const Value, Table: AnsiString): AnsiString;
+
+
+function Decode4to3Ex (const Value, Table: AnsiString): AnsiString;
+
+
+function Encode3to4 (const Value, Table: AnsiString): AnsiString;
+
+
+function DecodeBase64 (const Value: AnsiString): AnsiString;
+
+
+function EncodeBase64 (const Value: AnsiString): AnsiString;
+
+
+function DecodeBase64mod (const Value: AnsiString): AnsiString;
+
+
+function EncodeBase64mod (const Value: AnsiString): AnsiString;
+
+
+function DecodeUU (const Value: AnsiString): AnsiString;
+
+
+function EncodeUU (const Value: AnsiString): AnsiString;
+
+
+function DecodeXX (const Value: AnsiString): AnsiString;
+
+
+function DecodeYEnc (const Value: AnsiString): AnsiString;
+
+
+function UpdateCrc32 (Value: Byte; Crc32: Integer): Integer;
+
+
+function Crc32 (const Value: AnsiString): Integer;
+
+
+function UpdateCrc16 (Value: Byte; Crc16: Word): Word;
+
+
+function Crc16 (const Value: AnsiString): Word;
+
+
+function MD5 (const Value: AnsiString): AnsiString;
+
+
+function HMAC_MD5 (Text, Key: AnsiString): AnsiString;
+
+
+function MD5LongHash (const Value: AnsiString; Len: integer): AnsiString;
+
+
+function SHA1 (const Value: AnsiString): AnsiString;
+
+
+function HMAC_SHA1 (Text, Key: AnsiString): AnsiString;
+
+
+function SHA1LongHash (const Value: AnsiString; Len: integer): AnsiString;
+
+
+function MD4 (const Value: AnsiString): AnsiString;
+
+
+Types
+
+Constants
+
+
+SpecialChar : TSpecials =
+ ['=', '(', ')', '[', ']', '<', '>', ':', ';', ',', '@', '/', '?', '\',
+ '"', '_'];
+
+
+NonAsciiChar : TSpecials =
+ [#0..#31, #127..#255];
+
+
+URLFullSpecialChar : TSpecials =
+ [';', '/', '?', ':', '@', '=', '&', '#', '+'];
+
+
+URLSpecialChar : TSpecials =
+ [#$00..#$20, '_', '<', '>', '"', '%', '{', '}', '|', '\', 'ˆ', '˜', '[', ']',
+ '`', #$7F..#$FF];
+
+
+TableBase64 =
+ 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=';
+
+
+TableBase64mod =
+ 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+,=';
+
+
+TableUU =
+ '`!"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]ˆ_';
+
+
+TableXX =
+ '+-0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
+
+
+ReTablebase64 =
+ #$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$3E +#$40
+ +#$40 +#$40 +#$3F +#$34 +#$35 +#$36 +#$37 +#$38 +#$39 +#$3A +#$3B +#$3C
+ +#$3D +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$00 +#$01 +#$02 +#$03
+ +#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A +#$0B +#$0C +#$0D +#$0E +#$0F
+ +#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18 +#$19 +#$40 +#$40
+ +#$40 +#$40 +#$40 +#$40 +#$1A +#$1B +#$1C +#$1D +#$1E +#$1F +#$20 +#$21
+ +#$22 +#$23 +#$24 +#$25 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D
+ +#$2E +#$2F +#$30 +#$31 +#$32 +#$33 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40;
+
+
+ReTableUU =
+ #$01 +#$02 +#$03 +#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A +#$0B +#$0C
+ +#$0D +#$0E +#$0F +#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18
+ +#$19 +#$1A +#$1B +#$1C +#$1D +#$1E +#$1F +#$20 +#$21 +#$22 +#$23 +#$24
+ +#$25 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D +#$2E +#$2F +#$30
+ +#$31 +#$32 +#$33 +#$34 +#$35 +#$36 +#$37 +#$38 +#$39 +#$3A +#$3B +#$3C
+ +#$3D +#$3E +#$3F +#$00 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40
+ +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40
+ +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40;
+
+
+ReTableXX =
+ #$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$00 +#$40
+ +#$01 +#$40 +#$40 +#$02 +#$03 +#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A
+ +#$0B +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$0C +#$0D +#$0E +#$0F
+ +#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18 +#$19 +#$1A +#$1B
+ +#$1C +#$1D +#$1E +#$1F +#$20 +#$21 +#$22 +#$23 +#$24 +#$25 +#$40 +#$40
+ +#$40 +#$40 +#$40 +#$40 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D
+ +#$2E +#$2F +#$30 +#$31 +#$32 +#$33 +#$34 +#$35 +#$36 +#$37 +#$38 +#$39
+ +#$3A +#$3B +#$3C +#$3D +#$3E +#$3F +#$40 +#$40 +#$40 +#$40 +#$40 +#$40;
+
+
+Description
+Functions and Procedures
+
+
+function DecodeTriplet (const Value: AnsiString; Delimiter: AnsiChar): AnsiString;
+
+
+
+Decodes triplet encoding with a given character delimiter. It is used for decoding quoted-printable or URL encoding.
+
+
+function DecodeQuotedPrintable (const Value: AnsiString): AnsiString;
+
+
+
+Decodes a string from quoted printable form. (also decodes triplet sequences like '=7F')
+
+
+function DecodeURL (const Value: AnsiString): AnsiString;
+
+
+
+Decodes a string of URL encoding. (also decodes triplet sequences like '%7F')
+
+
+function EncodeTriplet (const Value: AnsiString; Delimiter: AnsiChar; Specials: TSpecials ): AnsiString;
+
+
+
+Performs triplet encoding with a given character delimiter. Used for encoding quoted-printable or URL encoding.
+
+
+function EncodeQuotedPrintable (const Value: AnsiString): AnsiString;
+
+
+
+Encodes a string to triplet quoted printable form. All NonAsciiChar are encoded.
+
+
+function EncodeSafeQuotedPrintable (const Value: AnsiString): AnsiString;
+
+
+
+Encodes a string to triplet quoted printable form. All NonAsciiChar and SpecialChar are encoded.
+
+
+function EncodeURLElement (const Value: AnsiString): AnsiString;
+
+
+
+Encodes a string to URL format. Used for encoding data from a form field in HTTP, etc. (Encodes all critical characters including characters used as URL delimiters ('/',':', etc.)
+
+
+function EncodeURL (const Value: AnsiString): AnsiString;
+
+
+
+Encodes a string to URL format. Used to encode critical characters in all URLs.
+
+
+function Decode4to3 (const Value, Table: AnsiString): AnsiString;
+
+
+
+Decode 4to3 encoding with given table. If some element is not found in table, first item from table is used. This is good for buggy coded items by Microsoft Outlook. This software sometimes using wrong table for UUcode, where is used ' ' instead '`'.
+
+
+function Decode4to3Ex (const Value, Table: AnsiString): AnsiString;
+
+
+
+Decode 4to3 encoding with given REVERSE table. Using this function with reverse table is much faster then Decode4to3 . This function is used internally for Base64, UU or XX decoding.
+
+
+function Encode3to4 (const Value, Table: AnsiString): AnsiString;
+
+
+
+Encode by system 3to4 (used by Base64, UU coding, etc) by given table.
+
+
+function DecodeBase64 (const Value: AnsiString): AnsiString;
+
+
+
+Decode string from base64 format.
+
+
+function EncodeBase64 (const Value: AnsiString): AnsiString;
+
+
+
+Encodes a string to base64 format.
+
+
+function DecodeBase64mod (const Value: AnsiString): AnsiString;
+
+
+
+Decode string from modified base64 format. (used in IMAP, for example.)
+
+
+function EncodeBase64mod (const Value: AnsiString): AnsiString;
+
+
+
+Encodes a string to modified base64 format. (used in IMAP, for example.)
+
+
+function DecodeUU (const Value: AnsiString): AnsiString;
+
+
+
+Decodes a string from UUcode format.
+
+
+function EncodeUU (const Value: AnsiString): AnsiString;
+
+
+
+encode UUcode. it encode only datas, you must also add header and footer for proper encode.
+
+
+function DecodeXX (const Value: AnsiString): AnsiString;
+
+
+
+Decodes a string from XXcode format.
+
+
+function DecodeYEnc (const Value: AnsiString): AnsiString;
+
+
+
+decode line with Yenc code. This code is sometimes used in newsgroups.
+
+
+function UpdateCrc32 (Value: Byte; Crc32: Integer): Integer;
+
+
+
+Returns a new CRC32 value after adding a new byte of data.
+
+
+function Crc32 (const Value: AnsiString): Integer;
+
+
+
+return CRC32 from a value string.
+
+
+function UpdateCrc16 (Value: Byte; Crc16: Word): Word;
+
+
+
+Returns a new CRC16 value after adding a new byte of data.
+
+
+function Crc16 (const Value: AnsiString): Word;
+
+
+
+return CRC16 from a value string.
+
+
+function MD5 (const Value: AnsiString): AnsiString;
+
+
+
+Returns a binary string with a RSA-MD5 hashing of "Value" string.
+
+
+function HMAC_MD5 (Text, Key: AnsiString): AnsiString;
+
+
+
+Returns a binary string with HMAC-MD5 hash.
+
+
+function MD5LongHash (const Value: AnsiString; Len: integer): AnsiString;
+
+
+
+Returns a binary string with a RSA-MD5 hashing of string what is constructed by repeating "value" until length is "Len".
+
+
+function SHA1 (const Value: AnsiString): AnsiString;
+
+
+
+Returns a binary string with a SHA-1 hashing of "Value" string.
+
+
+function HMAC_SHA1 (Text, Key: AnsiString): AnsiString;
+
+
+
+Returns a binary string with HMAC-SHA1 hash.
+
+
+function SHA1LongHash (const Value: AnsiString; Len: integer): AnsiString;
+
+
+
+Returns a binary string with a SHA-1 hashing of string what is constructed by repeating "value" until length is "Len".
+
+
+function MD4 (const Value: AnsiString): AnsiString;
+
+
+
+Returns a binary string with a RSA-MD4 hashing of "Value" string.
+Types
+
+
+TSpecials = set of AnsiChar;
+
+
+ Constants
+
+
+SpecialChar : TSpecials =
+ ['=', '(', ')', '[', ']', '<', '>', ':', ';', ',', '@', '/', '?', '\',
+ '"', '_'];
+
+
+
+
+NonAsciiChar : TSpecials =
+ [#0..#31, #127..#255];
+
+
+
+
+URLFullSpecialChar : TSpecials =
+ [';', '/', '?', ':', '@', '=', '&', '#', '+'];
+
+
+
+
+URLSpecialChar : TSpecials =
+ [#$00..#$20, '_', '<', '>', '"', '%', '{', '}', '|', '\', 'ˆ', '˜', '[', ']',
+ '`', #$7F..#$FF];
+
+
+
+
+TableBase64 =
+ 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=';
+
+
+
+
+TableBase64mod =
+ 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+,=';
+
+
+
+
+TableUU =
+ '`!"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]ˆ_';
+
+
+
+
+TableXX =
+ '+-0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
+
+
+
+
+ReTablebase64 =
+ #$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$3E +#$40
+ +#$40 +#$40 +#$3F +#$34 +#$35 +#$36 +#$37 +#$38 +#$39 +#$3A +#$3B +#$3C
+ +#$3D +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$00 +#$01 +#$02 +#$03
+ +#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A +#$0B +#$0C +#$0D +#$0E +#$0F
+ +#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18 +#$19 +#$40 +#$40
+ +#$40 +#$40 +#$40 +#$40 +#$1A +#$1B +#$1C +#$1D +#$1E +#$1F +#$20 +#$21
+ +#$22 +#$23 +#$24 +#$25 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D
+ +#$2E +#$2F +#$30 +#$31 +#$32 +#$33 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40;
+
+
+
+
+ReTableUU =
+ #$01 +#$02 +#$03 +#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A +#$0B +#$0C
+ +#$0D +#$0E +#$0F +#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18
+ +#$19 +#$1A +#$1B +#$1C +#$1D +#$1E +#$1F +#$20 +#$21 +#$22 +#$23 +#$24
+ +#$25 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D +#$2E +#$2F +#$30
+ +#$31 +#$32 +#$33 +#$34 +#$35 +#$36 +#$37 +#$38 +#$39 +#$3A +#$3B +#$3C
+ +#$3D +#$3E +#$3F +#$00 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40
+ +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40
+ +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40;
+
+
+
+
+ReTableXX =
+ #$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$00 +#$40
+ +#$01 +#$40 +#$40 +#$02 +#$03 +#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A
+ +#$0B +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$0C +#$0D +#$0E +#$0F
+ +#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18 +#$19 +#$1A +#$1B
+ +#$1C +#$1D +#$1E +#$1F +#$20 +#$21 +#$22 +#$23 +#$24 +#$25 +#$40 +#$40
+ +#$40 +#$40 +#$40 +#$40 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D
+ +#$2E +#$2F +#$30 +#$31 +#$32 +#$33 +#$34 +#$35 +#$36 +#$37 +#$38 +#$39
+ +#$3A +#$3B +#$3C +#$3D +#$3E +#$3F +#$40 +#$40 +#$40 +#$40 +#$40 +#$40;
+
+
+ Generated by PasDoc 0.9.0 on 2012-04-23 21:38:52
+
+
ADDED lib/synapse/docs/help/synacrypt.TSyna3Des.html
Index: lib/synapse/docs/help/synacrypt.TSyna3Des.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/synacrypt.TSyna3Des.html
@@ -0,0 +1,59 @@
+
+
+
+
+
+synacrypt: Class TSyna3Des
+
+
+
+Class TSyna3Des
+
+Unit
+
+synacrypt
+Declaration
+
+type TSyna3Des = class(TSynaCustomDes )
+Description
+
+Implementation of 3DES encryption
+Hierarchy
+Overview
+Methods
+
+
+
+function EncryptECB (const InData: AnsiString): AnsiString; override;
+
+
+
+function DecryptECB (const InData: AnsiString): AnsiString; override;
+
+
+Description
+Methods
+
+
+
+function EncryptECB (const InData: AnsiString): AnsiString; override;
+
+
+
+Encrypt a 64-bit block of data using the ECB method of encryption
+
+
+
+function DecryptECB (const InData: AnsiString): AnsiString; override;
+
+
+
+Decrypt a 64-bit block of data using the ECB method of decryption
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:52
+
+
ADDED lib/synapse/docs/help/synacrypt.TSynaAes.html
Index: lib/synapse/docs/help/synacrypt.TSynaAes.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/synacrypt.TSynaAes.html
@@ -0,0 +1,58 @@
+
+
+
+
+
+synacrypt: Class TSynaAes
+
+
+
+Class TSynaAes
+
+Unit
+
+synacrypt
+Declaration
+
+type TSynaAes = class(TSynaBlockCipher )
+Description
+
+Implementation of AES encryption
+Hierarchy
+Overview
+Methods
+
+
+
+function EncryptECB (const InData: AnsiString): AnsiString; override;
+
+
+
+function DecryptECB (const InData: AnsiString): AnsiString; override;
+
+
+Description
+Methods
+
+
+
+function EncryptECB (const InData: AnsiString): AnsiString; override;
+
+
+
+Encrypt a 128-bit block of data using the ECB method of encryption
+
+
+
+function DecryptECB (const InData: AnsiString): AnsiString; override;
+
+
+
+Decrypt a 128-bit block of data using the ECB method of decryption
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:52
+
+
ADDED lib/synapse/docs/help/synacrypt.TSynaBlockCipher.html
Index: lib/synapse/docs/help/synacrypt.TSynaBlockCipher.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/synacrypt.TSynaBlockCipher.html
@@ -0,0 +1,229 @@
+
+
+
+
+
+synacrypt: Class TSynaBlockCipher
+
+
+
+Class TSynaBlockCipher
+
+Unit
+
+synacrypt
+Declaration
+
+type TSynaBlockCipher = class(TObject)
+Description
+
+Implementation of common routines block ciphers (dafault size is 64-bits)
+
+
+
+
Do not use this class directly, use descendants only!
+Hierarchy
+TObject
+TSynaBlockCipher Overview
+Methods
+
+
+
+procedure SetIV (const Value: AnsiString); virtual;
+
+
+
+function GetIV : AnsiString; virtual;
+
+
+
+procedure Reset ; virtual;
+
+
+
+function EncryptECB (const InData: AnsiString): AnsiString; virtual;
+
+
+
+function DecryptECB (const InData: AnsiString): AnsiString; virtual;
+
+
+
+function EncryptCBC (const Indata: AnsiString): AnsiString; virtual;
+
+
+
+function DecryptCBC (const Indata: AnsiString): AnsiString; virtual;
+
+
+
+function EncryptCFB8bit (const Indata: AnsiString): AnsiString; virtual;
+
+
+
+function DecryptCFB8bit (const Indata: AnsiString): AnsiString; virtual;
+
+
+
+function EncryptCFBblock (const Indata: AnsiString): AnsiString; virtual;
+
+
+
+function DecryptCFBblock (const Indata: AnsiString): AnsiString; virtual;
+
+
+
+function EncryptOFB (const Indata: AnsiString): AnsiString; virtual;
+
+
+
+function DecryptOFB (const Indata: AnsiString): AnsiString; virtual;
+
+
+
+function EncryptCTR (const Indata: AnsiString): AnsiString; virtual;
+
+
+
+function DecryptCTR (const Indata: AnsiString): AnsiString; virtual;
+
+
+
+constructor Create (Key: AnsiString);
+
+
+Description
+Methods
+
+
+
+procedure SetIV (const Value: AnsiString); virtual;
+
+
+
+Sets the IV to Value and performs a reset
+
+
+
+function GetIV : AnsiString; virtual;
+
+
+
+Returns the current chaining information, not the actual IV
+
+
+
+procedure Reset ; virtual;
+
+
+
+Reset any stored chaining information
+
+
+
+function EncryptECB (const InData: AnsiString): AnsiString; virtual;
+
+
+
+Encrypt a 64-bit block of data using the ECB method of encryption
+
+
+
+function DecryptECB (const InData: AnsiString): AnsiString; virtual;
+
+
+
+Decrypt a 64-bit block of data using the ECB method of decryption
+
+
+
+function EncryptCBC (const Indata: AnsiString): AnsiString; virtual;
+
+
+
+Encrypt data using the CBC method of encryption
+
+
+
+function DecryptCBC (const Indata: AnsiString): AnsiString; virtual;
+
+
+
+Decrypt data using the CBC method of decryption
+
+
+
+function EncryptCFB8bit (const Indata: AnsiString): AnsiString; virtual;
+
+
+
+Encrypt data using the CFB (8 bit) method of encryption
+
+
+
+function DecryptCFB8bit (const Indata: AnsiString): AnsiString; virtual;
+
+
+
+Decrypt data using the CFB (8 bit) method of decryption
+
+
+
+function EncryptCFBblock (const Indata: AnsiString): AnsiString; virtual;
+
+
+
+Encrypt data using the CFB (block) method of encryption
+
+
+
+function DecryptCFBblock (const Indata: AnsiString): AnsiString; virtual;
+
+
+
+Decrypt data using the CFB (block) method of decryption
+
+
+
+function EncryptOFB (const Indata: AnsiString): AnsiString; virtual;
+
+
+
+Encrypt data using the OFB method of encryption
+
+
+
+function DecryptOFB (const Indata: AnsiString): AnsiString; virtual;
+
+
+
+Decrypt data using the OFB method of decryption
+
+
+
+function EncryptCTR (const Indata: AnsiString): AnsiString; virtual;
+
+
+
+Encrypt data using the CTR method of encryption
+
+
+
+function DecryptCTR (const Indata: AnsiString): AnsiString; virtual;
+
+
+
+Decrypt data using the CTR method of decryption
+
+
+
+constructor Create (Key: AnsiString);
+
+
+
+Create a encryptor/decryptor instance and initialize it by the Key.
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:52
+
+
ADDED lib/synapse/docs/help/synacrypt.TSynaCustomDes.html
Index: lib/synapse/docs/help/synacrypt.TSynaCustomDes.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/synacrypt.TSynaCustomDes.html
@@ -0,0 +1,32 @@
+
+
+
+
+
+synacrypt: Class TSynaCustomDes
+
+
+
+Class TSynaCustomDes
+
+Unit
+
+synacrypt
+Declaration
+
+type TSynaCustomDes = class(TSynaBlockCipher )
+Description
+
+Implementation of common routines for DES encryption
+
+
+
+
Do not use this class directly, use descendants only!
+Hierarchy
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:52
+
+
ADDED lib/synapse/docs/help/synacrypt.TSynaDes.html
Index: lib/synapse/docs/help/synacrypt.TSynaDes.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/synacrypt.TSynaDes.html
@@ -0,0 +1,59 @@
+
+
+
+
+
+synacrypt: Class TSynaDes
+
+
+
+Class TSynaDes
+
+Unit
+
+synacrypt
+Declaration
+
+type TSynaDes = class(TSynaCustomDes )
+Description
+
+Implementation of DES encryption
+Hierarchy
+Overview
+Methods
+
+
+
+function EncryptECB (const InData: AnsiString): AnsiString; override;
+
+
+
+function DecryptECB (const InData: AnsiString): AnsiString; override;
+
+
+Description
+Methods
+
+
+
+function EncryptECB (const InData: AnsiString): AnsiString; override;
+
+
+
+Encrypt a 64-bit block of data using the ECB method of encryption
+
+
+
+function DecryptECB (const InData: AnsiString): AnsiString; override;
+
+
+
+Decrypt a 64-bit block of data using the ECB method of decryption
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:52
+
+
ADDED lib/synapse/docs/help/synacrypt.html
Index: lib/synapse/docs/help/synacrypt.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/synacrypt.html
@@ -0,0 +1,125 @@
+
+
+
+
+
+synacrypt
+
+
+
+Unit synacrypt
+
+Description
+
+Encryption support
+
+
+
+
Implemented are DES and 3DES encryption/decryption by ECB, CBC, CFB-8bit, CFB-block, OFB and CTR methods.
+uses
+Overview
+Classes, Interfaces, Objects and Records
+
+
+
+Class TSynaBlockCipher
+Implementation of common routines block ciphers (dafault size is 64-bits)
+
+
+Class TSynaCustomDes
+Implementation of common routines for DES encryption
+
+
+Class TSynaDes
+Implementation of DES encryption
+
+
+Class TSyna3Des
+Implementation of 3DES encryption
+
+
+Class TSynaAes
+Implementation of AES encryption
+
+
+Functions and Procedures
+
+Types
+
+Constants
+
+Description
+Functions and Procedures
+
+
+function TestDes : boolean;
+
+
+
+Call internal test of all DES encryptions. Returns True
if all is OK.
+
+
+function Test3Des : boolean;
+
+
+
+Call internal test of all 3DES encryptions. Returns True
if all is OK.
+
+
+function TestAes : boolean;
+
+
+
+Call internal test of all AES encryptions. Returns True
if all is OK.
+Types
+
+
+TDesKeyData = array[0..31] of integer;
+
+
+
+Datatype for holding one DES key data
+
+
+
+
This data type is used internally.
+Constants
+
+
+ Generated by PasDoc 0.9.0 on 2012-04-23 21:38:52
+
+
ADDED lib/synapse/docs/help/synadbg.TSynaDebug.html
Index: lib/synapse/docs/help/synadbg.TSynaDebug.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/synadbg.TSynaDebug.html
@@ -0,0 +1,51 @@
+
+
+
+
+
+synadbg: Class TSynaDebug
+
+
+
+Class TSynaDebug
+
+Unit
+
+synadbg
+Declaration
+
+type TSynaDebug = class(TObject)
+Description
+Hierarchy
+Overview
+Methods
+
+
+
+class procedure HookStatus (Sender: TObject; Reason: THookSocketReason ; const Value: string);
+
+
+
+class procedure HookMonitor (Sender: TObject; Writing: Boolean; const Buffer: TMemory; Len: Integer);
+
+
+Description
+Methods
+
+
+
+class procedure HookStatus (Sender: TObject; Reason: THookSocketReason ; const Value: string);
+
+
+
+
+
+class procedure HookMonitor (Sender: TObject; Writing: Boolean; const Buffer: TMemory; Len: Integer);
+
+
+ Generated by PasDoc 0.9.0 on 2012-04-23 21:38:52
+
+
ADDED lib/synapse/docs/help/synadbg.html
Index: lib/synapse/docs/help/synadbg.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/synadbg.html
@@ -0,0 +1,61 @@
+
+
+
+
+
+synadbg
+
+
+
+Unit synadbg
+
+Description
+
+Socket debug tools
+
+
+
+
Routines for help with debugging of events on the Sockets.
+uses
+Overview
+Classes, Interfaces, Objects and Records
+
+Functions and Procedures
+
+Variables
+
+Description
+Functions and Procedures
+
+
+procedure AppendToLog (const value: Ansistring);
+
+
+ Variables
+
+ Generated by PasDoc 0.9.0 on 2012-04-23 21:38:52
+
+
ADDED lib/synapse/docs/help/synafpc.html
Index: lib/synapse/docs/help/synafpc.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/synafpc.html
@@ -0,0 +1,52 @@
+
+
+
+
+
+synafpc
+
+
+
+Unit synafpc
+
+Description
+ uses
+Overview
+Functions and Procedures
+
+
+procedure Sleep (milliseconds: Cardinal);
+
+
+Types
+
+Description
+Functions and Procedures
+
+
+procedure Sleep (milliseconds: Cardinal);
+
+
+ Types
+
+
+TLibHandle = HModule;
+
+
+
+ Generated by PasDoc 0.9.0 on 2012-04-23 21:38:52
+
+
ADDED lib/synapse/docs/help/synaicnv.html
Index: lib/synapse/docs/help/synaicnv.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/synaicnv.html
@@ -0,0 +1,194 @@
+
+
+
+
+
+synaicnv
+
+
+
+Unit synaicnv
+
+Description
+
+LibIconv support
+
+
+
+
This unit is Pascal interface to LibIconv library for charset translations. LibIconv is loaded dynamicly on-demand. If this library is not found in system, requested LibIconv function just return errorcode.
+uses
+Overview
+Functions and Procedures
+
+Types
+
+Constants
+
+Variables
+
+Description
+Functions and Procedures
+
+
+function SynaIconvOpen (const tocode, fromcode: Ansistring): iconv_t ;
+
+
+
+
+function SynaIconvOpenTranslit (const tocode, fromcode: Ansistring): iconv_t ;
+
+
+
+
+function SynaIconvOpenIgnore (const tocode, fromcode: Ansistring): iconv_t ;
+
+
+
+
+function SynaIconv (cd: iconv_t ; inbuf: AnsiString; var outbuf: AnsiString): integer;
+
+
+
+
+function SynaIconvClose (var cd: iconv_t ): integer;
+
+
+
+
+function SynaIconvCtl (cd: iconv_t ; request: integer; argument: argptr ): integer;
+
+
+
+
+function IsIconvloaded : Boolean;
+
+
+
+
+function InitIconvInterface : Boolean;
+
+
+
+
+function DestroyIconvInterface : Boolean;
+
+
+ Types
+
+
+size_t = Cardinal;
+
+
+
+
+iconv_t = Pointer;
+
+
+
+ Constants
+
+
+DLLIconvName = 'iconv.dll';
+
+
+
+
+ICONV_TRIVIALP = 0;
+
+
+
+
+ICONV_GET_TRANSLITERATE = 1;
+
+
+
+
+ICONV_SET_TRANSLITERATE = 2;
+
+
+
+
+ICONV_GET_DISCARD_ILSEQ = 3;
+
+
+
+
+ICONV_SET_DISCARD_ILSEQ = 4;
+
+
+ Variables
+
+ Generated by PasDoc 0.9.0 on 2012-04-23 21:38:52
+
+
ADDED lib/synapse/docs/help/synaip.html
Index: lib/synapse/docs/help/synaip.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/synaip.html
@@ -0,0 +1,150 @@
+
+
+
+
+
+synaip
+
+
+
+Unit synaip
+
+Description
+
+IP adress support procedures and functions
+uses
+Overview
+Functions and Procedures
+
+
+function IsIP (const Value: string): Boolean;
+
+
+function IsIP6 (const Value: string): Boolean;
+
+
+function IPToID (Host: string): Ansistring;
+
+
+function StrToIp6 (value: string): TIp6Bytes ;
+
+
+function Ip6ToStr (value: TIp6Bytes ): string;
+
+
+function StrToIp (value: string): integer;
+
+
+function IpToStr (value: integer): string;
+
+
+function ReverseIP (Value: AnsiString): AnsiString;
+
+
+function ReverseIP6 (Value: AnsiString): AnsiString;
+
+
+function ExpandIP6 (Value: AnsiString): AnsiString;
+
+
+Types
+
+Description
+Functions and Procedures
+
+
+function IsIP (const Value: string): Boolean;
+
+
+
+Returns True
, if "Value" is a valid IPv4 address. Cannot be a symbolic Name!
+
+
+function IsIP6 (const Value: string): Boolean;
+
+
+
+Returns True
, if "Value" is a valid IPv6 address. Cannot be a symbolic Name!
+
+
+function IPToID (Host: string): Ansistring;
+
+
+
+Returns a string with the "Host" ip address converted to binary form.
+
+
+function StrToIp6 (value: string): TIp6Bytes ;
+
+
+
+Convert IPv6 address from their string form to binary byte array.
+
+
+function Ip6ToStr (value: TIp6Bytes ): string;
+
+
+
+Convert IPv6 address from binary byte array to string form.
+
+
+function StrToIp (value: string): integer;
+
+
+
+Convert IPv4 address from their string form to binary.
+
+
+function IpToStr (value: integer): string;
+
+
+
+Convert IPv4 address from binary to string form.
+
+
+function ReverseIP (Value: AnsiString): AnsiString;
+
+
+
+Convert IPv4 address to reverse form.
+
+
+function ReverseIP6 (Value: AnsiString): AnsiString;
+
+
+
+Convert IPv6 address to reverse form.
+
+
+function ExpandIP6 (Value: AnsiString): AnsiString;
+
+
+
+Expand short form of IPv6 address to long form.
+Types
+
+
+TIp6Bytes = array [0..15] of Byte;
+
+
+
+binary form of IPv6 adress (for string conversion routines)
+
+
+TIp6Words = array [0..7] of Word;
+
+
+
+binary form of IPv6 adress (for string conversion routines)
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:52
+
+
ADDED lib/synapse/docs/help/synamisc.TProxySetting.html
Index: lib/synapse/docs/help/synamisc.TProxySetting.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/synamisc.TProxySetting.html
@@ -0,0 +1,55 @@
+
+
+
+
+
+synamisc: record TProxySetting
+
+
+
+record TProxySetting
+
+Unit
+
+synamisc
+Declaration
+
+type TProxySetting = record
+Description
+
+This record contains information about proxy setting.
+Overview
+Fields
+
+Description
+Fields
+
+
+
+ Generated by PasDoc 0.9.0 on 2012-04-23 21:38:52
+
+
ADDED lib/synapse/docs/help/synamisc.html
Index: lib/synapse/docs/help/synamisc.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/synamisc.html
@@ -0,0 +1,75 @@
+
+
+
+
+
+synamisc
+
+
+
+Unit synamisc
+
+Description
+ uses
+Overview
+Classes, Interfaces, Objects and Records
+
+
+
+record TProxySetting
+This record contains information about proxy setting.
+
+
+Functions and Procedures
+
+Description
+Functions and Procedures
+
+
+procedure WakeOnLan (MAC, IP: string);
+
+
+
+By this function you can turn-on computer on network, if this computer supporting Wake-on-lan feature. You need MAC number (network card indentifier) of computer for turn-on. You can also assign target IP addres. If you not specify it, then is used broadcast for delivery magic wake-on packet. However broadcasts workinh only on your local network. When you need to wake-up computer on another network, you must specify any existing IP addres on same network segment as targeting computer.
+
+
+function GetDNS : string;
+
+
+
+Autodetect current DNS servers used by system. If is defined more then one DNS server, then result is comma-delimited.
+
+
+Autodetect InternetExplorer proxy setting for given protocol. This function working only on windows!
+
+
+function GetLocalIPs : string;
+
+
+
+Return all known IP addresses on local system. Addresses are divided by comma.
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:52
+
+
ADDED lib/synapse/docs/help/synaser.ESynaSerError.html
Index: lib/synapse/docs/help/synaser.ESynaSerError.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/synaser.ESynaSerError.html
@@ -0,0 +1,53 @@
+
+
+
+
+
+synaser: Class ESynaSerError
+
+
+
+Class ESynaSerError
+
+Unit
+
+synaser
+Declaration
+
+type ESynaSerError = class(Exception)
+Description
+
+Exception type for SynaSer errors
+Hierarchy
+Overview
+Fields
+
+Description
+Fields
+
+
+
+ErrorCode : integer;
+
+
+
+
+
+ErrorMessage : string;
+
+
+ Generated by PasDoc 0.9.0 on 2012-04-23 21:38:52
+
+
ADDED lib/synapse/docs/help/synaser.TBlockSerial.html
Index: lib/synapse/docs/help/synaser.TBlockSerial.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/synaser.TBlockSerial.html
@@ -0,0 +1,1002 @@
+
+
+
+
+
+synaser: Class TBlockSerial
+
+
+
+Class TBlockSerial
+
+Unit
+
+synaser
+Declaration
+
+type TBlockSerial = class(TObject)
+Description
+
+Main class implementing all communication routines
+Hierarchy
+Overview
+Fields
+
+
+
+DCB : Tdcb;
+
+
+Methods
+
+
+
+constructor Create ;
+
+
+
+destructor Destroy ; override;
+
+
+
+class function GetVersion : string; virtual;
+
+
+
+procedure CloseSocket ; virtual;
+
+
+
+procedure Config (baud, bits: integer; parity: char; stop: integer; softflow, hardflow: boolean); virtual;
+
+
+
+procedure Connect (comport: string); virtual;
+
+
+
+procedure SetCommState ; virtual;
+
+
+
+procedure GetCommState ; virtual;
+
+
+
+function SendBuffer (buffer: pointer; length: integer): integer; virtual;
+
+
+
+procedure SendByte (data: byte); virtual;
+
+
+
+procedure SendString (data: AnsiString); virtual;
+
+
+
+procedure SendInteger (Data: integer); virtual;
+
+
+
+procedure SendBlock (const Data: AnsiString); virtual;
+
+
+
+procedure SendStreamRaw (const Stream: TStream); virtual;
+
+
+
+procedure SendStream (const Stream: TStream); virtual;
+
+
+
+procedure SendStreamIndy (const Stream: TStream); virtual;
+
+
+
+function RecvBuffer (buffer: pointer; length: integer): integer; virtual;
+
+
+
+function RecvBufferEx (buffer: pointer; length: integer; timeout: integer): integer; virtual;
+
+
+
+function RecvBufferStr (Length: Integer; Timeout: Integer): AnsiString; virtual;
+
+
+
+function RecvPacket (Timeout: Integer): AnsiString; virtual;
+
+
+
+function RecvByte (timeout: integer): byte; virtual;
+
+
+
+function RecvTerminated (Timeout: Integer; const Terminator: AnsiString): AnsiString; virtual;
+
+
+
+function Recvstring (timeout: integer): AnsiString; virtual;
+
+
+
+function RecvInteger (Timeout: Integer): Integer; virtual;
+
+
+
+function RecvBlock (Timeout: Integer): AnsiString; virtual;
+
+
+
+procedure RecvStreamRaw (const Stream: TStream; Timeout: Integer); virtual;
+
+
+
+procedure RecvStreamSize (const Stream: TStream; Timeout: Integer; Size: Integer); virtual;
+
+
+
+procedure RecvStream (const Stream: TStream; Timeout: Integer); virtual;
+
+
+
+procedure RecvStreamIndy (const Stream: TStream; Timeout: Integer); virtual;
+
+
+
+function WaitingData : integer; virtual;
+
+
+
+function WaitingDataEx : integer; virtual;
+
+
+
+function SendingData : integer; virtual;
+
+
+
+procedure EnableRTSToggle (value: boolean); virtual;
+
+
+
+procedure Flush ; virtual;
+
+
+
+procedure Purge ; virtual;
+
+
+
+function CanRead (Timeout: integer): boolean; virtual;
+
+
+
+function CanWrite (Timeout: integer): boolean; virtual;
+
+
+
+function CanReadEx (Timeout: integer): boolean; virtual;
+
+
+
+function ModemStatus : integer; virtual;
+
+
+
+procedure SetBreak (Duration: integer); virtual;
+
+
+
+function ATCommand (value: AnsiString): AnsiString; virtual;
+
+
+
+function ATConnect (value: AnsiString): AnsiString; virtual;
+
+
+
+function SerialCheck (SerialResult: integer): integer; virtual;
+
+
+
+procedure ExceptCheck ; virtual;
+
+
+
+procedure SetSynaError (ErrNumber: integer); virtual;
+
+
+
+procedure RaiseSynaError (ErrNumber: integer); virtual;
+
+
+
+class function GetErrorDesc (ErrorCode: integer): string;
+
+
+Properties
+
+
+
+property Device : string read FDevice;
+
+
+
+property LastError : integer read FLastError;
+
+
+
+property LastErrorDesc : string read FLastErrorDesc;
+
+
+
+property ATResult : Boolean read FATResult;
+
+
+
+property RTS : Boolean write SetRTSF;
+
+
+
+property CTS : boolean read GetCTS;
+
+
+
+property DTR : Boolean write SetDTRF;
+
+
+
+property DSR : boolean read GetDSR;
+
+
+
+property Carrier : boolean read GetCarrier;
+
+
+
+property Ring : boolean read GetRing;
+
+
+
+property InstanceActive : boolean read FInstanceActive;
+
+
+
+property MaxSendBandwidth : Integer read FMaxSendBandwidth Write FMaxSendBandwidth;
+
+
+
+property MaxRecvBandwidth : Integer read FMaxRecvBandwidth Write FMaxRecvBandwidth;
+
+
+
+property MaxBandwidth : Integer Write SetBandwidth;
+
+
+
+property SizeRecvBuffer : integer read FRecvBuffer write SetSizeRecvBuffer;
+
+
+
+property Tag : integer read FTag write FTag;
+
+
+
+property Handle : THandle read Fhandle write FHandle;
+
+
+
+property LineBuffer : AnsiString read FBuffer write FBuffer;
+
+
+
+property RaiseExcept : boolean read FRaiseExcept write FRaiseExcept;
+
+
+
+property OnStatus : THookSerialStatus read FOnStatus write FOnStatus;
+
+
+
+property TestDSR : boolean read FTestDSR write FTestDSR;
+
+
+
+property TestCTS : boolean read FTestCTS write FTestCTS;
+
+
+
+property MaxLineLength : Integer read FMaxLineLength Write FMaxLineLength;
+
+
+
+property DeadlockTimeout : Integer read FDeadlockTimeout Write FDeadlockTimeout;
+
+
+
+property LinuxLock : Boolean read FLinuxLock write FLinuxLock;
+
+
+
+property ConvertLineEnd : Boolean read FConvertLineEnd Write FConvertLineEnd;
+
+
+
+property AtTimeout : integer read FAtTimeout Write FAtTimeout;
+
+
+
+property InterPacketTimeout : Boolean read FInterPacketTimeout Write FInterPacketTimeout;
+
+
+Description
+Fields
+
+
+
+DCB : Tdcb;
+
+
+
+data Control Block with communication parameters. Usable only when you need to call API directly.
+Methods
+
+
+
+constructor Create ;
+
+
+
+Object constructor.
+
+
+
+destructor Destroy ; override;
+
+
+
+Object destructor.
+
+
+
+class function GetVersion : string; virtual;
+
+
+
+Returns a string containing the version number of the library.
+
+
+
+procedure CloseSocket ; virtual;
+
+
+
+Destroy handle in use. It close connection to serial port.
+
+
+
+procedure Config (baud, bits: integer; parity: char; stop: integer; softflow, hardflow: boolean); virtual;
+
+
+
+Reconfigure communication parameters on the fly. You must be connected to port before!
+parameters
+
+baud
+Define connection speed. Baud rate can be from 50 to 4000000 bits per second. (it depends on your hardware!)
+bits
+Number of bits in communication.
+parity
+Define communication parity (N - None, O - Odd, E - Even, M - Mark or S - Space).
+stop
+Define number of stopbits. Use constants SB1 , SB1andHalf and SB2 .
+softflow
+Enable XON/XOFF handshake.
+hardflow
+Enable CTS/RTS handshake.
+
+
+
+
+procedure Connect (comport: string); virtual;
+
+
+
+Connects to the port indicated by comport. Comport can be used in Windows style (COM2), or in Linux style (/dev/ttyS1). When you use windows style in Linux, then it will be converted to Linux name. And vice versa! However you can specify any device name! (other device names then standart is not converted!)
+
+
After successfull connection the DTR signal is set (if you not set hardware handshake, then the RTS signal is set, too!)
+
+
Connection parameters is predefined by your system configuration. If you need use another parameters, then you can use Config method after. Notes:
+
+
- Remember, the commonly used serial Laplink cable does not support hardware handshake.
+
+
- Before setting any handshake you must be sure that it is supported by your hardware.
+
+
- Some serial devices are slow. In some cases you must wait up to a few seconds after connection for the device to respond.
+
+
- when you connect to a modem device, then is best to test it by an empty AT command. (call ATCommand('AT'))
+
+
+
+procedure SetCommState ; virtual;
+
+
+
+Set communication parameters from the DCB structure (the DCB structure is simulated under Linux).
+
+
+
+procedure GetCommState ; virtual;
+
+
+
+Read communication parameters into the DCB structure (DCB structure is simulated under Linux).
+
+
+
+function SendBuffer (buffer: pointer; length: integer): integer; virtual;
+
+
+
+Sends Length bytes of data from Buffer through the connected port.
+
+
+
+procedure SendByte (data: byte); virtual;
+
+
+
+One data BYTE is sent.
+
+
+
+procedure SendString (data: AnsiString); virtual;
+
+
+
+Send the string in the data parameter. No terminator is appended by this method. If you need to send a string with CR/LF terminator, you must append the CR/LF characters to the data string!
+
+
Since no terminator is appended, you can use this function for sending binary data too.
+
+
+
+procedure SendInteger (Data: integer); virtual;
+
+
+
+send four bytes as integer.
+
+
+
+procedure SendBlock (const Data: AnsiString); virtual;
+
+
+
+send data as one block. Each block begins with integer value with Length of block.
+
+
+
+procedure SendStreamRaw (const Stream: TStream); virtual;
+
+
+
+send content of stream from current position
+
+
+
+procedure SendStream (const Stream: TStream); virtual;
+
+
+
+send content of stream as block. see SendBlock
+
+
+
+procedure SendStreamIndy (const Stream: TStream); virtual;
+
+
+
+send content of stream as block, but this is compatioble with Indy library. (it have swapped lenght of block). See SendStream
+
+
+
+function RecvBuffer (buffer: pointer; length: integer): integer; virtual;
+
+
+
+Waits until the allocated buffer is filled by received data. Returns number of data bytes received, which equals to the Length value under normal operation. If it is not equal, the communication channel is possibly broken.
+
+
This method not using any internal buffering, like all others receiving methods. You cannot freely combine this method with all others receiving methods!
+
+
+
+function RecvBufferEx (buffer: pointer; length: integer; timeout: integer): integer; virtual;
+
+
+
+Method waits until data is received. If no data is received within the Timeout (in milliseconds) period, LastError is set to ErrTimeout . This method is used to read any amount of data (e. g. 1MB), and may be freely combined with all receviving methods what have Timeout parameter, like the Recvstring , RecvByte or RecvTerminated methods.
+
+
+
+function RecvBufferStr (Length: Integer; Timeout: Integer): AnsiString; virtual;
+
+
+
+It is like recvBufferEx, but data is readed to dynamicly allocated binary string.
+
+
+
+function RecvPacket (Timeout: Integer): AnsiString; virtual;
+
+
+
+Read all available data and return it in the function result string. This function may be combined with Recvstring , RecvByte or related methods.
+
+
+
+function RecvByte (timeout: integer): byte; virtual;
+
+
+
+Waits until one data byte is received which is returned as the function result. If no data is received within the Timeout (in milliseconds) period, LastError is set to ErrTimeout .
+
+
+
+function RecvTerminated (Timeout: Integer; const Terminator: AnsiString): AnsiString; virtual;
+
+
+
+This method waits until a terminated data string is received. This string is terminated by the Terminator string. The resulting string is returned without this termination string! If no data is received within the Timeout (in milliseconds) period, LastError is set to ErrTimeout .
+
+
+
+function Recvstring (timeout: integer): AnsiString; virtual;
+
+
+
+This method waits until a terminated data string is received. The string is terminated by a CR/LF sequence. The resulting string is returned without the terminator (CR/LF)! If no data is received within the Timeout (in milliseconds) period, LastError is set to ErrTimeout .
+
+
If ConvertLineEnd is used, then the CR/LF sequence may not be exactly CR/LF. See the description of ConvertLineEnd .
+
+
This method serves for line protocol implementation and uses its own buffers to maximize performance. Therefore do NOT use this method with the RecvBuffer method to receive data as it may cause data loss.
+
+
+
+function RecvInteger (Timeout: Integer): Integer; virtual;
+
+
+
+Waits until four data bytes are received which is returned as the function integer result. If no data is received within the Timeout (in milliseconds) period, LastError is set to ErrTimeout .
+
+
+
+function RecvBlock (Timeout: Integer): AnsiString; virtual;
+
+
+
+Waits until one data block is received. See SendBlock . If no data is received within the Timeout (in milliseconds) period, LastError is set to ErrTimeout .
+
+
+
+procedure RecvStreamRaw (const Stream: TStream; Timeout: Integer); virtual;
+
+
+
+Receive all data to stream, until some error occured. (for example timeout)
+
+
+
+procedure RecvStreamSize (const Stream: TStream; Timeout: Integer; Size: Integer); virtual;
+
+
+
+receive requested count of bytes to stream
+
+
+
+procedure RecvStream (const Stream: TStream; Timeout: Integer); virtual;
+
+
+
+receive block of data to stream. (Data can be sended by SendStream
+
+
+
+procedure RecvStreamIndy (const Stream: TStream; Timeout: Integer); virtual;
+
+
+
+receive block of data to stream. (Data can be sended by SendStreamIndy
+
+
+
+function WaitingData : integer; virtual;
+
+
+
+Returns the number of received bytes waiting for reading. 0 is returned when there is no data waiting.
+
+
+
+function WaitingDataEx : integer; virtual;
+
+
+
+Same as WaitingData , but in respect to data in the internal LineBuffer .
+
+
+
+function SendingData : integer; virtual;
+
+
+
+Returns the number of bytes waiting to be sent in the output buffer. 0 is returned when the output buffer is empty.
+
+
+
+procedure EnableRTSToggle (value: boolean); virtual;
+
+
+
+Enable or disable RTS driven communication (half-duplex). It can be used to communicate with RS485 converters, or other special equipment. If you enable this feature, the system automatically controls the RTS signal.
+
+
Notes:
+
+
- On Windows NT (or higher) ir RTS signal driven by system driver.
+
+
- On Win9x family is used special code for waiting until last byte is sended from your UART.
+
+
- On Linux you must have kernel 2.1 or higher!
+
+
+
+procedure Flush ; virtual;
+
+
+
+Waits until all data to is sent and buffers are emptied. Warning: On Windows systems is this method returns when all buffers are flushed to the serial port controller, before the last byte is sent!
+
+
+
+procedure Purge ; virtual;
+
+
+
+Unconditionally empty all buffers. It is good when you need to interrupt communication and for cleanups.
+
+
+
+function CanRead (Timeout: integer): boolean; virtual;
+
+
+
+Returns True
, if you can from read any data from the port. Status is tested for a period of time given by the Timeout parameter (in milliseconds). If the value of the Timeout parameter is 0, the status is tested only once and the function returns immediately. If the value of the Timeout parameter is set to -1, the function returns only after it detects data on the port (this may cause the process to hang).
+
+
+
+function CanWrite (Timeout: integer): boolean; virtual;
+
+
+
+Returns True
, if you can write any data to the port (this function is not sending the contents of the buffer). Status is tested for a period of time given by the Timeout parameter (in milliseconds). If the value of the Timeout parameter is 0, the status is tested only once and the function returns immediately. If the value of the Timeout parameter is set to -1, the function returns only after it detects that it can write data to the port (this may cause the process to hang).
+
+
+
+function CanReadEx (Timeout: integer): boolean; virtual;
+
+
+
+Same as CanRead , but the test is against data in the internal LineBuffer too.
+
+
+
+function ModemStatus : integer; virtual;
+
+
+
+Returns the status word of the modem. Decoding the status word could yield the status of carrier detect signaland other signals. This method is used internally by the modem status reading properties. You usually do not need to call this method directly.
+
+
+
+procedure SetBreak (Duration: integer); virtual;
+
+
+
+Send a break signal to the communication device for Duration milliseconds.
+
+
+
+function ATCommand (value: AnsiString): AnsiString; virtual;
+
+
+
+This function is designed to send AT commands to the modem. The AT command is sent in the Value parameter and the response is returned in the function return value (may contain multiple lines!). If the AT command is processed successfully (modem returns OK), then the ATResult property is set to True.
+
+
This function is designed only for AT commands that return OK or ERROR response! To call connection commands the ATConnect method. Remember, when you connect to a modem device, it is in AT command mode. Now you can send AT commands to the modem. If you need to transfer data to the modem on the other side of the line, you must first switch to data mode using the ATConnect method.
+
+
+
+function ATConnect (value: AnsiString): AnsiString; virtual;
+
+
+
+This function is used to send connect type AT commands to the modem. It is for commands to switch to connected state. (ATD, ATA, ATO,...) It sends the AT command in the Value parameter and returns the modem's response (may be multiple lines - usually with connection parameters info). If the AT command is processed successfully (the modem returns CONNECT), then the ATResult property is set to True
.
+
+
This function is designed only for AT commands which respond by CONNECT, BUSY, NO DIALTONE NO CARRIER or ERROR. For other AT commands use the ATCommand method.
+
+
The connect timeout is 90*AtTimeout . If this command is successful (ATResult is True
), then the modem is in data state. When you now send or receive some data, it is not to or from your modem, but from the modem on other side of the line. Now you can transfer your data. If the connection attempt failed (ATResult is False
), then the modem is still in AT command mode.
+
+
+
+function SerialCheck (SerialResult: integer): integer; virtual;
+
+
+
+If you "manually" call API functions, forward their return code in the SerialResult parameter to this function, which evaluates it and sets LastError and LastErrorDesc .
+
+
+
+procedure ExceptCheck ; virtual;
+
+
+
+If LastError is not 0 and exceptions are enabled, then this procedure raises an exception. This method is used internally. You may need it only in special cases.
+
+
+
+procedure SetSynaError (ErrNumber: integer); virtual;
+
+
+
+Set Synaser to error state with ErrNumber code. Usually used by internal routines.
+
+
+
+procedure RaiseSynaError (ErrNumber: integer); virtual;
+
+
+
+Raise Synaser error with ErrNumber code. Usually used by internal routines.
+
+
+
+class function GetErrorDesc (ErrorCode: integer): string;
+
+
+
+Returns the descriptive text associated with ErrorCode. You need this method only in special cases. Description of LastError is now accessible through the LastErrorDesc property.
+Properties
+
+
+
+property Device : string read FDevice;
+
+
+
+True device name of currently used port
+
+
+
+property LastError : integer read FLastError;
+
+
+
+Error code of last operation. Value is defined by the host operating system, but value 0 is always OK.
+
+
+
+property LastErrorDesc : string read FLastErrorDesc;
+
+
+
+Human readable description of LastError code.
+
+
+
+property ATResult : Boolean read FATResult;
+
+
+
+Indicates if the last ATCommand or ATConnect method was successful
+
+
+
+property RTS : Boolean write SetRTSF;
+
+
+
+Read the value of the RTS signal.
+
+
+
+property CTS : boolean read GetCTS;
+
+
+
+Indicates the presence of the CTS signal
+
+
+
+property DTR : Boolean write SetDTRF;
+
+
+
+Use this property to set the value of the DTR signal.
+
+
+
+property DSR : boolean read GetDSR;
+
+
+
+Exposes the status of the DSR signal.
+
+
+
+property Carrier : boolean read GetCarrier;
+
+
+
+Indicates the presence of the Carrier signal
+
+
+
+property Ring : boolean read GetRing;
+
+
+
+Reflects the status of the Ring signal.
+
+
+
+property InstanceActive : boolean read FInstanceActive;
+
+
+
+indicates if this instance of SynaSer is active. (Connected to some port)
+
+
+
+property MaxSendBandwidth : Integer read FMaxSendBandwidth Write FMaxSendBandwidth;
+
+
+
+Defines maximum bandwidth for all sending operations in bytes per second. If this value is set to 0 (default), bandwidth limitation is not used.
+
+
+
+property MaxRecvBandwidth : Integer read FMaxRecvBandwidth Write FMaxRecvBandwidth;
+
+
+
+Defines maximum bandwidth for all receiving operations in bytes per second. If this value is set to 0 (default), bandwidth limitation is not used.
+
+
+
+property MaxBandwidth : Integer Write SetBandwidth;
+
+
+
+Defines maximum bandwidth for all sending and receiving operations in bytes per second. If this value is set to 0 (default), bandwidth limitation is not used.
+
+
+
+property SizeRecvBuffer : integer read FRecvBuffer write SetSizeRecvBuffer;
+
+
+
+Size of the Windows internal receive buffer. Default value is usually 4096 bytes. Note: Valid only in Windows versions!
+
+
+
+property Tag : integer read FTag write FTag;
+
+
+
+Freely usable property
+
+
+
+property Handle : THandle read Fhandle write FHandle;
+
+
+
+Contains the handle of the open communication port. You may need this value to directly call communication functions outside SynaSer.
+
+
+
+property LineBuffer : AnsiString read FBuffer write FBuffer;
+
+
+
+Internally used read buffer.
+
+
+
+property RaiseExcept : boolean read FRaiseExcept write FRaiseExcept;
+
+
+
+If True
, communication errors raise exceptions. If False
(default), only the LastError value is set.
+
+
+This event is triggered when the communication status changes. It can be used to monitor communication status.
+
+
+
+property TestDSR : boolean read FTestDSR write FTestDSR;
+
+
+
+If you set this property to True
, then the value of the DSR signal is tested before every data transfer. It can be used to detect the presence of a communications device.
+
+
+
+property TestCTS : boolean read FTestCTS write FTestCTS;
+
+
+
+If you set this property to True
, then the value of the CTS signal is tested before every data transfer. It can be used to detect the presence of a communications device. Warning: This property cannot be used if you need hardware handshake!
+
+
+
+property MaxLineLength : Integer read FMaxLineLength Write FMaxLineLength;
+
+
+
+Use this property you to limit the maximum size of LineBuffer (as a protection against unlimited memory allocation for LineBuffer). Default value is 0 - no limit.
+
+
+
+property DeadlockTimeout : Integer read FDeadlockTimeout Write FDeadlockTimeout;
+
+
+
+This timeout value is used as deadlock protection when trying to send data to (or receive data from) a device that stopped communicating during data transmission (e.g. by physically disconnecting the device). The timeout value is in milliseconds. The default value is 30,000 (30 seconds).
+
+
+
+property LinuxLock : Boolean read FLinuxLock write FLinuxLock;
+
+
+
+If set to True
(default value), port locking is enabled (under Linux only). WARNING: To use this feature, the application must run by a user with full permission to the /var/lock directory!
+
+
+
+property ConvertLineEnd : Boolean read FConvertLineEnd Write FConvertLineEnd;
+
+
+
+Indicates if non-standard line terminators should be converted to a CR/LF pair (standard DOS line terminator). If True
, line terminators CR, single LF or LF/CR are converted to CR/LF. Defaults to False
. This property has effect only on the behavior of the RecvString method.
+
+
+
+property AtTimeout : integer read FAtTimeout Write FAtTimeout;
+
+
+
+Timeout for AT modem based operations
+
+
+
+property InterPacketTimeout : Boolean read FInterPacketTimeout Write FInterPacketTimeout;
+
+
+
+If True
(default), then all timeouts is timeout between two characters. If False
, then timeout is overall for whoole reading operation.
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:52
+
+
ADDED lib/synapse/docs/help/synaser.html
Index: lib/synapse/docs/help/synaser.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/synaser.html
@@ -0,0 +1,459 @@
+
+
+
+
+
+synaser
+
+
+
+Unit synaser
+
+Description
+ uses
+Overview
+Classes, Interfaces, Objects and Records
+
+
+
+Class ESynaSerError
+Exception type for SynaSer errors
+
+
+Class TBlockSerial
+Main class implementing all communication routines
+
+
+Functions and Procedures
+
+Types
+
+Constants
+
+Description
+Functions and Procedures
+
+
+function GetSerialPortNames : string;
+
+
+
+Returns list of existing computer serial ports. Working properly only in Windows!
+Types
+
+
+THookSerialReason = (...);
+
+
+
+Possible status event types for THookSerialStatus
+
+
+HR_SerialClose:
+
+HR_Connect:
+
+HR_CanRead:
+
+HR_CanWrite:
+
+HR_ReadCount:
+
+HR_WriteCount:
+
+HR_Wait:
+
+
+
+THookSerialStatus = procedure(Sender: TObject; Reason: THookSerialReason ; const Value: string) of object;
+
+
+
+procedural prototype for status event hooking
+Constants
+
+
+
+
+
+cSerialChunk = 8192;
+
+
+
+
+LockfileDirectory = '/var/lock';
+
+
+
+
+PortIsClosed = -1;
+
+
+
+
+ErrAlreadyOwned = 9991;
+
+
+
+
+ErrAlreadyInUse = 9992;
+
+
+
+
+ErrWrongParameter = 9993;
+
+
+
+
+ErrPortNotOpen = 9994;
+
+
+
+
+ErrNoDeviceAnswer = 9995;
+
+
+
+
+ErrMaxBuffer = 9996;
+
+
+
+
+ErrTimeout = 9997;
+
+
+
+
+ErrNotRead = 9998;
+
+
+
+
+
+ErrOverrun = 10000;
+
+
+
+
+ErrRxOver = 10001;
+
+
+
+
+ErrRxParity = 10002;
+
+
+
+
+ErrTxFull = 10003;
+
+
+
+
+dcb_Binary = $00000001;
+
+
+
+
+dcb_ParityCheck = $00000002;
+
+
+
+
+dcb_OutxCtsFlow = $00000004;
+
+
+
+
+dcb_OutxDsrFlow = $00000008;
+
+
+
+
+dcb_DtrControlMask = $00000030;
+
+
+
+
+dcb_DtrControlDisable = $00000000;
+
+
+
+
+dcb_DtrControlEnable = $00000010;
+
+
+
+
+dcb_DtrControlHandshake = $00000020;
+
+
+
+
+dcb_DsrSensivity = $00000040;
+
+
+
+
+dcb_TXContinueOnXoff = $00000080;
+
+
+
+
+dcb_OutX = $00000100;
+
+
+
+
+dcb_InX = $00000200;
+
+
+
+
+dcb_ErrorChar = $00000400;
+
+
+
+
+dcb_NullStrip = $00000800;
+
+
+
+
+dcb_RtsControlMask = $00003000;
+
+
+
+
+dcb_RtsControlDisable = $00000000;
+
+
+
+
+dcb_RtsControlEnable = $00001000;
+
+
+
+
+dcb_RtsControlHandshake = $00002000;
+
+
+
+
+dcb_RtsControlToggle = $00003000;
+
+
+
+
+dcb_AbortOnError = $00004000;
+
+
+
+
+dcb_Reserveds = $FFFF8000;
+
+
+
+
+stopbit value for 1 stopbit
+
+
+stopbit value for 1.5 stopbit
+
+
+stopbit value for 2 stopbits
+
+
+
+sErr = integer(-1);
+
+
+ Generated by PasDoc 0.9.0 on 2012-04-23 21:38:52
+
+
ADDED lib/synapse/docs/help/synautil.html
Index: lib/synapse/docs/help/synautil.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/synautil.html
@@ -0,0 +1,763 @@
+
+
+
+
+
+synautil
+
+
+
+Unit synautil
+
+Description
+ uses
+Overview
+Functions and Procedures
+
+
+function TimeZoneBias : integer;
+
+
+function TimeZone : string;
+
+
+function Rfc822DateTime (t: TDateTime): string;
+
+
+function CDateTime (t: TDateTime): string;
+
+
+function SimpleDateTime (t: TDateTime): string;
+
+
+function AnsiCDateTime (t: TDateTime): string;
+
+
+function GetMonthNumber (Value: String): integer;
+
+
+function GetTimeFromStr (Value: string): TDateTime;
+
+
+function GetDateMDYFromStr (Value: string): TDateTime;
+
+
+function DecodeRfcDateTime (Value: string): TDateTime;
+
+
+function GetUTTime : TDateTime;
+
+
+function SetUTTime (Newdt: TDateTime): Boolean;
+
+
+function GetTick : LongWord;
+
+
+function TickDelta (TickOld, TickNew: LongWord): LongWord;
+
+
+function CodeInt (Value: Word): Ansistring;
+
+
+function DecodeInt (const Value: Ansistring; Index: Integer): Word;
+
+
+function CodeLongInt (Value: LongInt): Ansistring;
+
+
+function DecodeLongInt (const Value: Ansistring; Index: Integer): LongInt;
+
+
+function DumpStr (const Buffer: Ansistring): string;
+
+
+function DumpExStr (const Buffer: Ansistring): string;
+
+
+procedure Dump (const Buffer: AnsiString; DumpFile: string);
+
+
+procedure DumpEx (const Buffer: AnsiString; DumpFile: string);
+
+
+function TrimSPLeft (const S: string): string;
+
+
+function TrimSPRight (const S: string): string;
+
+
+function TrimSP (const S: string): string;
+
+
+function SeparateLeft (const Value, Delimiter: string): string;
+
+
+function SeparateRight (const Value, Delimiter: string): string;
+
+
+function GetParameter (const Value, Parameter: string): string;
+
+
+procedure ParseParametersEx (Value, Delimiter: string; const Parameters: TStrings);
+
+
+procedure ParseParameters (Value: string; const Parameters: TStrings);
+
+
+function IndexByBegin (Value: string; const List: TStrings): integer;
+
+
+function GetEmailAddr (const Value: string): string;
+
+
+function GetEmailDesc (Value: string): string;
+
+
+function StrToHex (const Value: Ansistring): string;
+
+
+function IntToBin (Value: Integer; Digits: Byte): string;
+
+
+function BinToInt (const Value: string): Integer;
+
+
+function ParseURL (URL: string; var Prot, User, Pass, Host, Port, Path, Para: string): string;
+
+
+function ReplaceString (Value, Search, Replace: AnsiString): AnsiString;
+
+
+function RPosEx (const Sub, Value: string; From: integer): Integer;
+
+
+function RPos (const Sub, Value: String): Integer;
+
+
+function FetchBin (var Value: string; const Delimiter: string): string;
+
+
+function Fetch (var Value: string; const Delimiter: string): string;
+
+
+function FetchEx (var Value: string; const Delimiter, Quotation: string): string;
+
+
+function IsBinaryString (const Value: AnsiString): Boolean;
+
+
+function PosCRLF (const Value: AnsiString; var Terminator: AnsiString): integer;
+
+
+Procedure StringsTrim (const value: TStrings);
+
+
+function PosFrom (const SubStr, Value: String; From: integer): integer;
+
+
+function IncPoint (const p: pointer; Value: integer): pointer;
+
+
+function GetBetween (const PairBegin, PairEnd, Value: string): string;
+
+
+function CountOfChar (const Value: string; Chr: char): integer;
+
+
+function UnquoteStr (const Value: string; Quote: Char): string;
+
+
+function QuoteStr (const Value: string; Quote: Char): string;
+
+
+procedure HeadersToList (const Value: TStrings);
+
+
+procedure ListToHeaders (const Value: TStrings);
+
+
+function SwapBytes (Value: integer): integer;
+
+
+function ReadStrFromStream (const Stream: TStream; len: integer): AnsiString;
+
+
+procedure WriteStrToStream (const Stream: TStream; Value: AnsiString);
+
+
+function GetTempFile (const Dir, prefix: AnsiString): AnsiString;
+
+
+function PadString (const Value: AnsiString; len: integer; Pad: AnsiChar): AnsiString;
+
+
+function XorString (Indata1, Indata2: AnsiString): AnsiString;
+
+
+function NormalizeHeader (Value: TStrings; var Index: Integer): string;
+
+
+procedure SearchForLineBreak (var APtr:PANSIChar; AEtx:PANSIChar; out ABol:PANSIChar; out ALength:integer);
+
+
+procedure SkipLineBreak (var APtr:PANSIChar; AEtx:PANSIChar);
+
+
+procedure SkipNullLines (var APtr:PANSIChar; AEtx:PANSIChar);
+
+
+procedure CopyLinesFromStreamUntilNullLine (var APtr:PANSIChar; AEtx:PANSIChar; ALines:TStrings);
+
+
+procedure CopyLinesFromStreamUntilBoundary (var APtr:PANSIChar; AEtx:PANSIChar; ALines:TStrings; const ABoundary:ANSIString);
+
+
+function SearchForBoundary (var APtr:PANSIChar; AEtx:PANSIChar; const ABoundary:ANSIString): PANSIChar;
+
+
+function MatchBoundary (ABOL,AETX:PANSIChar; const ABoundary:ANSIString): PANSIChar;
+
+
+function MatchLastBoundary (ABOL,AETX:PANSIChar; const ABoundary:ANSIString): PANSIChar;
+
+
+function BuildStringFromBuffer (AStx,AEtx:PANSIChar): ANSIString;
+
+
+Variables
+
+Description
+Functions and Procedures
+
+
+function TimeZoneBias : integer;
+
+
+
+Return your timezone bias from UTC time in minutes.
+
+
+function TimeZone : string;
+
+
+
+Return your timezone bias from UTC time in string representation like "+0200".
+
+
+function Rfc822DateTime (t: TDateTime): string;
+
+
+
+Returns current time in format defined in RFC-822. Useful for SMTP messages, but other protocols use this time format as well. Results contains the timezone specification. Four digit year is used to break any Y2K concerns. (Example 'Fri, 15 Oct 1999 21:14:56 +0200')
+
+
+function CDateTime (t: TDateTime): string;
+
+
+
+Returns date and time in format defined in C compilers in format "mmm dd hh:nn:ss"
+
+
+function SimpleDateTime (t: TDateTime): string;
+
+
+
+Returns date and time in format defined in format 'yymmdd hhnnss'
+
+
+function AnsiCDateTime (t: TDateTime): string;
+
+
+
+Returns date and time in format defined in ANSI C compilers in format "ddd mmm d hh:nn:ss yyyy"
+
+
+function GetMonthNumber (Value: String): integer;
+
+
+
+Decode three-letter string with name of month to their month number. If string not match any month name, then is returned 0. For parsing are used predefined names for English, French and German and names from system locale too.
+
+
+function GetTimeFromStr (Value: string): TDateTime;
+
+
+
+Return decoded time from given string. Time must be witch separator ':'. You can use "hh:mm" or "hh:mm:ss".
+
+
+function GetDateMDYFromStr (Value: string): TDateTime;
+
+
+
+Decode string in format "m-d-y" to TDateTime type.
+
+
+function DecodeRfcDateTime (Value: string): TDateTime;
+
+
+
+Decode various string representations of date and time to Tdatetime type. This function do all timezone corrections too! This function can decode lot of formats like:
+
+
+ ddd, d mmm yyyy hh:mm:ss
+ ddd, d mmm yy hh:mm:ss
+ ddd, mmm d yyyy hh:mm:ss
+ ddd mmm dd hh:mm:ss yyyy
+
+
+
+
and more with lot of modifications, include:
+
+
+Sun, 06 Nov 1994 08:49 :37 GMT ; RFC 822 , updated by RFC 1123
+Sunday, 06 -Nov-94 08:49 :37 GMT ; RFC 850 , obsoleted by RFC 1036
+Sun Nov 6 08:49 :37 1994 ; ANSI C
+
+ Timezone corrections known lot of symbolic timezone names (like CEST, EDT, etc.) or numeric representation (like +0200). By convention defined in RFC timezone +0000 is GMT and -0000 is current your system timezone.
+
+
+function GetUTTime : TDateTime;
+
+
+
+Return current system date and time in UTC timezone.
+
+
+function SetUTTime (Newdt: TDateTime): Boolean;
+
+
+
+Set Newdt as current system date and time in UTC timezone. This function work only if you have administrator rights!
+
+
+function GetTick : LongWord;
+
+
+
+Return current value of system timer with precizion 1 millisecond. Good for measure time difference.
+
+
+function TickDelta (TickOld, TickNew: LongWord): LongWord;
+
+
+
+Return difference between two timestamps. It working fine only for differences smaller then maxint. (difference must be smaller then 24 days.)
+
+
+function CodeInt (Value: Word): Ansistring;
+
+
+
+Return two characters, which ordinal values represents the value in byte format. (High-endian)
+
+
+function DecodeInt (const Value: Ansistring; Index: Integer): Word;
+
+
+
+Decodes two characters located at "Index" offset position of the "Value" string to Word values.
+
+
+function CodeLongInt (Value: LongInt): Ansistring;
+
+
+
+Return four characters, which ordinal values represents the value in byte format. (High-endian)
+
+
+function DecodeLongInt (const Value: Ansistring; Index: Integer): LongInt;
+
+
+
+Decodes four characters located at "Index" offset position of the "Value" string to LongInt values.
+
+
+function DumpStr (const Buffer: Ansistring): string;
+
+
+
+Dump binary buffer stored in a string to a result string.
+
+
+function DumpExStr (const Buffer: Ansistring): string;
+
+
+
+Dump binary buffer stored in a string to a result string. All bytes with code of character is written as character, not as hexadecimal value.
+
+
+procedure Dump (const Buffer: AnsiString; DumpFile: string);
+
+
+
+Dump binary buffer stored in a string to a file with DumpFile filename.
+
+
+procedure DumpEx (const Buffer: AnsiString; DumpFile: string);
+
+
+
+Dump binary buffer stored in a string to a file with DumpFile filename. All bytes with code of character is written as character, not as hexadecimal value.
+
+
+function TrimSPLeft (const S: string): string;
+
+
+
+Like TrimLeft, but remove only spaces, not control characters!
+
+
+function TrimSPRight (const S: string): string;
+
+
+
+Like TrimRight, but remove only spaces, not control characters!
+
+
+function TrimSP (const S: string): string;
+
+
+
+Like Trim, but remove only spaces, not control characters!
+
+
+function SeparateLeft (const Value, Delimiter: string): string;
+
+
+
+Returns a portion of the "Value" string located to the left of the "Delimiter" string. If a delimiter is not found, results is original string.
+
+
+function SeparateRight (const Value, Delimiter: string): string;
+
+
+
+Returns the portion of the "Value" string located to the right of the "Delimiter" string. If a delimiter is not found, results is original string.
+
+
+function GetParameter (const Value, Parameter: string): string;
+
+
+
+Returns parameter value from string in format: parameter1="value1"; parameter2=value2
+
+
+procedure ParseParametersEx (Value, Delimiter: string; const Parameters: TStrings);
+
+
+
+parse value string with elements differed by Delimiter into stringlist.
+
+
+procedure ParseParameters (Value: string; const Parameters: TStrings);
+
+
+
+parse value string with elements differed by ';' into stringlist.
+
+
+function IndexByBegin (Value: string; const List: TStrings): integer;
+
+
+
+Index of string in stringlist with same beginning as Value is returned.
+
+
+function GetEmailAddr (const Value: string): string;
+
+
+
+Returns only the e-mail portion of an address from the full address format. i.e. returns 'nobody@somewhere.com' from '"someone" <nobody@somewhere.com>'
+
+
+function GetEmailDesc (Value: string): string;
+
+
+
+Returns only the description part from a full address format. i.e. returns 'someone' from '"someone" <nobody@somewhere.com>'
+
+
+function StrToHex (const Value: Ansistring): string;
+
+
+
+Returns a string with hexadecimal digits representing the corresponding values of the bytes found in "Value" string.
+
+
+function IntToBin (Value: Integer; Digits: Byte): string;
+
+
+
+Returns a string of binary "Digits" representing "Value".
+
+
+function BinToInt (const Value: string): Integer;
+
+
+
+Returns an integer equivalent of the binary string in "Value". (i.e. ('10001010') returns 138)
+
+
+function ParseURL (URL: string; var Prot, User, Pass, Host, Port, Path, Para: string): string;
+
+
+
+Parses a URL to its various components.
+
+
+function ReplaceString (Value, Search, Replace: AnsiString): AnsiString;
+
+
+
+Replaces all "Search" string values found within "Value" string, with the "Replace" string value.
+
+
+function RPosEx (const Sub, Value: string; From: integer): Integer;
+
+
+
+It is like RPos, but search is from specified possition.
+
+
+function RPos (const Sub, Value: String): Integer;
+
+
+
+It is like POS function, but from right side of Value string.
+
+
+function FetchBin (var Value: string; const Delimiter: string): string;
+
+
+
+Like Fetch , but working with binary strings, not with text.
+
+
+function Fetch (var Value: string; const Delimiter: string): string;
+
+
+
+Fetch string from left of Value string.
+
+
+function FetchEx (var Value: string; const Delimiter, Quotation: string): string;
+
+
+
+Fetch string from left of Value string. This function ignore delimitesr inside quotations.
+
+
+function IsBinaryString (const Value: AnsiString): Boolean;
+
+
+
+If string is binary string (contains non-printable characters), then is returned true.
+
+
+function PosCRLF (const Value: AnsiString; var Terminator: AnsiString): integer;
+
+
+
+return position of string terminator in string. If terminator found, then is returned in terminator parameter. Possible line terminators are: CRLF, LFCR, CR, LF
+
+
+Procedure StringsTrim (const value: TStrings);
+
+
+
+Delete empty strings from end of stringlist.
+
+
+function PosFrom (const SubStr, Value: String; From: integer): integer;
+
+
+
+Like Pos function, buf from given string possition.
+
+
+function IncPoint (const p: pointer; Value: integer): pointer;
+
+
+
+Increase pointer by value.
+
+
+function GetBetween (const PairBegin, PairEnd, Value: string): string;
+
+
+
+Get string between PairBegin and PairEnd. This function respect nesting. For example:
+
+
+ Value is : 'Hi! (hello(yes!))'
+ pairbegin is : '('
+ pairend is : ')'
+ In this case result is : 'hello(yes!)'
+
+
+
+
+function CountOfChar (const Value: string; Chr: char): integer;
+
+
+
+Return count of Chr in Value string.
+
+
+function UnquoteStr (const Value: string; Quote: Char): string;
+
+
+
+Remove quotation from Value string. If Value is not quoted, then return same string without any modification.
+
+
+function QuoteStr (const Value: string; Quote: Char): string;
+
+
+
+Quote Value string. If Value contains some Quote chars, then it is doubled.
+
+
+procedure HeadersToList (const Value: TStrings);
+
+
+
+Convert lines in stringlist from 'name: value' form to 'name=value' form.
+
+
+procedure ListToHeaders (const Value: TStrings);
+
+
+
+Convert lines in stringlist from 'name=value' form to 'name: value' form.
+
+
+function SwapBytes (Value: integer): integer;
+
+
+
+swap bytes in integer.
+
+
+function ReadStrFromStream (const Stream: TStream; len: integer): AnsiString;
+
+
+
+read string with requested length form stream.
+
+
+procedure WriteStrToStream (const Stream: TStream; Value: AnsiString);
+
+
+
+write string to stream.
+
+
+function GetTempFile (const Dir, prefix: AnsiString): AnsiString;
+
+
+
+Return filename of new temporary file in Dir (if empty, then default temporary directory is used) and with optional filename prefix.
+
+
+function PadString (const Value: AnsiString; len: integer; Pad: AnsiChar): AnsiString;
+
+
+
+Return padded string. If length is greater, string is truncated. If length is smaller, string is padded by Pad character.
+
+
+function XorString (Indata1, Indata2: AnsiString): AnsiString;
+
+
+
+XOR each byte in the strings
+
+
+function NormalizeHeader (Value: TStrings; var Index: Integer): string;
+
+
+
+Read header from "Value" stringlist beginning at "Index" position. If header is Splitted into multiple lines, then this procedure de-split it into one line.
+
+
+procedure SearchForLineBreak (var APtr:PANSIChar; AEtx:PANSIChar; out ABol:PANSIChar; out ALength:integer);
+
+
+
+Search for one of line terminators CR, LF or NUL. Return position of the line beginning and length of text.
+
+
+procedure SkipLineBreak (var APtr:PANSIChar; AEtx:PANSIChar);
+
+
+
+Skip both line terminators CR LF (if any). Move APtr position forward.
+
+
+procedure SkipNullLines (var APtr:PANSIChar; AEtx:PANSIChar);
+
+
+
+Skip all blank lines in a buffer starting at APtr and move APtr position forward.
+
+
+procedure CopyLinesFromStreamUntilNullLine (var APtr:PANSIChar; AEtx:PANSIChar; ALines:TStrings);
+
+
+
+Copy all lines from a buffer starting at APtr to ALines until empty line or end of the buffer is reached. Move APtr position forward).
+
+
+procedure CopyLinesFromStreamUntilBoundary (var APtr:PANSIChar; AEtx:PANSIChar; ALines:TStrings; const ABoundary:ANSIString);
+
+
+
+Copy all lines from a buffer starting at APtr to ALines until ABoundary or end of the buffer is reached. Move APtr position forward).
+
+
+function SearchForBoundary (var APtr:PANSIChar; AEtx:PANSIChar; const ABoundary:ANSIString): PANSIChar;
+
+
+
+Search ABoundary in a buffer starting at APtr. Return beginning of the ABoundary. Move APtr forward behind a trailing CRLF if any).
+
+
+function MatchBoundary (ABOL,AETX:PANSIChar; const ABoundary:ANSIString): PANSIChar;
+
+
+
+Compare a text at position ABOL with ABoundary and return position behind the match (including a trailing CRLF if any).
+
+
+function MatchLastBoundary (ABOL,AETX:PANSIChar; const ABoundary:ANSIString): PANSIChar;
+
+
+
+Compare a text at position ABOL with ABoundary + the last boundary suffix and return position behind the match (including a trailing CRLF if any).
+
+
+function BuildStringFromBuffer (AStx,AEtx:PANSIChar): ANSIString;
+
+
+
+Copy data from a buffer starting at position APtr and delimited by AEtx position into ANSIString.
+Variables
+
+
+CustomMonthNames : array[1..12] of string;
+
+
+
+can be used for your own months strings for GetMonthNumber
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:52
+
+
ADDED lib/synapse/docs/help/tip_data.js
Index: lib/synapse/docs/help/tip_data.js
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/tip_data.js
@@ -0,0 +1,1739 @@
+var s = new Array()
+
+s[0] = "asn1util^asn1util.html^Utilities for handling ASN.1 BER encoding^ By this unit you can parse ASN.1 BER encoded data to elements or build back any elements to ASN.1 BER encoded buffer. You can dump ASN.1 BER encoded data to human readable form for easy debugging, too. Supported element types are: ASN1_BOOL, ASN1_INT, ASN1_OCTSTR, ASN1_NULL, ASN1_OBJID, ASN1_ENUM, ASN1_SEQ, ASN1_SETOF, ASN1_IPADDR, ASN1_COUNTER, ASN1_GAUGE, ASN1_TIMETICKS, ASN1_OPAQUE
For sample of using, look to TSNMPSend or TLDAPSend class. ^0"
+s[1] = "asn1util.ASN1_BOOL^asn1util.html#ASN1_BOOL^^ ^0"
+s[2] = "asn1util.ASN1_INT^asn1util.html#ASN1_INT^^ ^0"
+s[3] = "asn1util.ASN1_OCTSTR^asn1util.html#ASN1_OCTSTR^^ ^0"
+s[4] = "asn1util.ASN1_NULL^asn1util.html#ASN1_NULL^^ ^0"
+s[5] = "asn1util.ASN1_OBJID^asn1util.html#ASN1_OBJID^^ ^0"
+s[6] = "asn1util.ASN1_ENUM^asn1util.html#ASN1_ENUM^^ ^0"
+s[7] = "asn1util.ASN1_SEQ^asn1util.html#ASN1_SEQ^^ ^0"
+s[8] = "asn1util.ASN1_SETOF^asn1util.html#ASN1_SETOF^^ ^0"
+s[9] = "asn1util.ASN1_IPADDR^asn1util.html#ASN1_IPADDR^^ ^0"
+s[10] = "asn1util.ASN1_COUNTER^asn1util.html#ASN1_COUNTER^^ ^0"
+s[11] = "asn1util.ASN1_GAUGE^asn1util.html#ASN1_GAUGE^^ ^0"
+s[12] = "asn1util.ASN1_TIMETICKS^asn1util.html#ASN1_TIMETICKS^^ ^0"
+s[13] = "asn1util.ASN1_OPAQUE^asn1util.html#ASN1_OPAQUE^^ ^0"
+s[14] = "asn1util.ASNEncOIDItem^asn1util.html#ASNEncOIDItem^^Encodes OID item to binary form. ^0"
+s[15] = "asn1util.ASNDecOIDItem^asn1util.html#ASNDecOIDItem^^Decodes an OID item of the next element in the "Buffer" from the "Start" position. ^0"
+s[16] = "asn1util.ASNEncLen^asn1util.html#ASNEncLen^^Encodes the length of ASN.1 element to binary. ^0"
+s[17] = "asn1util.ASNDecLen^asn1util.html#ASNDecLen^^Decodes length of next element in "Buffer" from the "Start" position. ^0"
+s[18] = "asn1util.ASNEncInt^asn1util.html#ASNEncInt^^Encodes a signed integer to ASN.1 binary ^0"
+s[19] = "asn1util.ASNEncUInt^asn1util.html#ASNEncUInt^^Encodes unsigned integer into ASN.1 binary ^0"
+s[20] = "asn1util.ASNObject^asn1util.html#ASNObject^^Encodes ASN.1 object to binary form. ^0"
+s[21] = "asn1util.ASNItem^asn1util.html#ASNItem^^Beginning with the "Start" position, decode the ASN.1 item of the next element in "Buffer". Type of item is stored in "ValueType." ^0"
+s[22] = "asn1util.MibToId^asn1util.html#MibToId^^Encodes an MIB OID string to binary form. ^0"
+s[23] = "asn1util.IdToMib^asn1util.html#IdToMib^^Decodes MIB OID from binary form to string form. ^0"
+s[24] = "asn1util.IntMibToStr^asn1util.html#IntMibToStr^^Encodes an one number from MIB OID to binary form. (used internally from MibToId ) ^0"
+s[25] = "asn1util.ASNdump^asn1util.html#ASNdump^^Convert ASN.1 BER encoded buffer to human readable form for debugging. ^0"
+s[26] = "blcksock^blcksock.html^^ ^0"
+s[27] = "blcksock.ESynapseError^blcksock.ESynapseError.html^Exception clas used by Synapse^ When you enable generating of exceptions, this exception is raised by Synapse's units. ^0"
+s[28] = "blcksock.ESynapseError.ErrorCode^blcksock.ESynapseError.html#ErrorCode^^Code of error. Value depending on used operating system ^0"
+s[29] = "blcksock.ESynapseError.ErrorMessage^blcksock.ESynapseError.html#ErrorMessage^^Human readable description of error. ^0"
+s[30] = "blcksock.TSynaOption^blcksock.TSynaOption.html^this object is used for remember delayed socket option set.^ ^0"
+s[31] = "blcksock.TSynaOption.Option^blcksock.TSynaOption.html#Option^^ ^0"
+s[32] = "blcksock.TSynaOption.Enabled^blcksock.TSynaOption.html#Enabled^^ ^0"
+s[33] = "blcksock.TSynaOption.Value^blcksock.TSynaOption.html#Value^^ ^0"
+s[34] = "blcksock.TBlockSocket^blcksock.TBlockSocket.html^Basic IP object.^ This is parent class for other class with protocol implementations. Do not use this class directly! Use TICMPBlockSocket , TRAWBlockSocket , TTCPBlockSocket or TUDPBlockSocket instead. ^0"
+s[35] = "blcksock.TBlockSocket.Create^blcksock.TBlockSocket.html#Create^^ ^0"
+s[36] = "blcksock.TBlockSocket.CreateAlternate^blcksock.TBlockSocket.html#CreateAlternate^^Create object and load all necessary socket library. What library is loaded is described by STUB parameter. If STUB is empty string, then is loaded default libraries. ^0"
+s[37] = "blcksock.TBlockSocket.Destroy^blcksock.TBlockSocket.html#Destroy^^ ^0"
+s[38] = "blcksock.TBlockSocket.CreateSocket^blcksock.TBlockSocket.html#CreateSocket^^If Family is not SF_Any, then create socket with type defined in Family property. If family is SF_Any, then do nothing! (socket is created automaticly when you know what type of socket you need to create. (i.e. inside Connect or Bind call.) When socket is created, then is aplyed all stored delayed socket options. ^0"
+s[39] = "blcksock.TBlockSocket.CreateSocketByName^blcksock.TBlockSocket.html#CreateSocketByName^^It create socket. Address resolving of Value tells what type of socket is created. If Value is resolved as IPv4 IP, then is created IPv4 socket. If value is resolved as IPv6 address, then is created IPv6 socket. ^0"
+s[40] = "blcksock.TBlockSocket.CloseSocket^blcksock.TBlockSocket.html#CloseSocket^^Destroy socket in use. This method is also automatically called from object destructor. ^0"
+s[41] = "blcksock.TBlockSocket.AbortSocket^blcksock.TBlockSocket.html#AbortSocket^^Abort any work on Socket and destroy them. ^0"
+s[42] = "blcksock.TBlockSocket.Bind^blcksock.TBlockSocket.html#Bind^^Connects socket to local IP address and PORT. IP address may be numeric or symbolic ('192.168.74.50', 'cosi.nekde.cz', 'ff08::1'). The same for PORT - it may be number or mnemonic port ('23', 'telnet').
If port value is '0', system chooses itself and conects unused port in the range 1024 to 4096 (this depending by operating system!). Structure LocalSin is filled after calling this method.
Note: If you call this on non-created socket, then socket is created automaticly.
Warning: when you call : Bind('0.0.0.0','0'); then is nothing done! In this case is used implicit system bind instead. ^0"
+s[43] = "blcksock.TBlockSocket.Connect^blcksock.TBlockSocket.html#Connect^^Connects socket to remote IP address and PORT. The same rules as with Bind method are valid. The only exception is that PORT with 0 value will not be connected!
Structures LocalSin and RemoteSin will be filled with valid values.
When you call this on non-created socket, then socket is created automaticly. Type of created socket is by Family property. If is used SF_IP4, then is created socket for IPv4. If is used SF_IP6, then is created socket for IPv6. When you have family on SF_Any (default!), then type of created socket is determined by address resolving of destination address. (Not work properly on prilimitary winsock IPv6 support!) ^0"
+s[44] = "blcksock.TBlockSocket.Listen^blcksock.TBlockSocket.html#Listen^^Sets socket to receive mode for new incoming connections. It is necessary to use TBlockSocket .Bind function call before this method to select receiving port! ^0"
+s[45] = "blcksock.TBlockSocket.Accept^blcksock.TBlockSocket.html#Accept^^Waits until new incoming connection comes. After it comes a new socket is automatically created (socket handler is returned by this function as result). ^0"
+s[46] = "blcksock.TBlockSocket.SendBuffer^blcksock.TBlockSocket.html#SendBuffer^^Sends data of LENGTH from BUFFER address via connected socket. System automatically splits data to packets. ^0"
+s[47] = "blcksock.TBlockSocket.SendByte^blcksock.TBlockSocket.html#SendByte^^One data BYTE is sent via connected socket. ^0"
+s[48] = "blcksock.TBlockSocket.SendString^blcksock.TBlockSocket.html#SendString^^Send data string via connected socket. Any terminator is not added! If you need send true string with CR-LF termination, you must add CR-LF characters to sended string! Because any termination is not added automaticly, you can use this function for sending any binary data in binary string. ^0"
+s[49] = "blcksock.TBlockSocket.SendInteger^blcksock.TBlockSocket.html#SendInteger^^Send integer as four bytes to socket. ^0"
+s[50] = "blcksock.TBlockSocket.SendBlock^blcksock.TBlockSocket.html#SendBlock^^Send data as one block to socket. Each block begin with 4 bytes with length of data in block. This 4 bytes is added automaticly by this function. ^0"
+s[51] = "blcksock.TBlockSocket.SendStreamRaw^blcksock.TBlockSocket.html#SendStreamRaw^^Send data from stream to socket. ^0"
+s[52] = "blcksock.TBlockSocket.SendStream^blcksock.TBlockSocket.html#SendStream^^Send content of stream to socket. It using SendBlock method ^0"
+s[53] = "blcksock.TBlockSocket.SendStreamIndy^blcksock.TBlockSocket.html#SendStreamIndy^^Send content of stream to socket. It using SendBlock method and this is compatible with streams in Indy library. ^0"
+s[54] = "blcksock.TBlockSocket.RecvBuffer^blcksock.TBlockSocket.html#RecvBuffer^^Note: This is low-level receive function. You must be sure if data is waiting for read before call this function for avoid deadlock!
Waits until allocated buffer is filled by received data. Returns number of data received, which equals to LENGTH value under normal operation. If it is not equal the communication channel is possibly broken.
On stream oriented sockets if is received 0 bytes, it mean 'socket is closed!"
On datagram socket is readed first waiting datagram. ^0"
+s[55] = "blcksock.TBlockSocket.RecvBufferEx^blcksock.TBlockSocket.html#RecvBufferEx^^Note: This is high-level receive function. It using internal LineBuffer and you can combine this function freely with other high-level functions!
Method waits until data is received. If no data is received within TIMEOUT (in milliseconds) period, LastError is set to WSAETIMEDOUT. Methods serves for reading any size of data (i.e. one megabyte...). This method is preffered for reading from stream sockets (like TCP). ^0"
+s[56] = "blcksock.TBlockSocket.RecvBufferStr^blcksock.TBlockSocket.html#RecvBufferStr^^Similar to RecvBufferEx , but readed data is stored in binary string, not in memory buffer. ^0"
+s[57] = "blcksock.TBlockSocket.RecvByte^blcksock.TBlockSocket.html#RecvByte^^Note: This is high-level receive function. It using internal LineBuffer and you can combine this function freely with other high-level functions.
Waits until one data byte is received which is also returned as function result. If no data is received within TIMEOUT (in milliseconds)period, LastError is set to WSAETIMEDOUT and result have value 0. ^0"
+s[58] = "blcksock.TBlockSocket.RecvInteger^blcksock.TBlockSocket.html#RecvInteger^^Note: This is high-level receive function. It using internal LineBuffer and you can combine this function freely with other high-level functions.
Waits until one four bytes are received and return it as one Ineger Value. If no data is received within TIMEOUT (in milliseconds)period, LastError is set to WSAETIMEDOUT and result have value 0. ^0"
+s[59] = "blcksock.TBlockSocket.RecvString^blcksock.TBlockSocket.html#RecvString^^Note: This is high-level receive function. It using internal LineBuffer and you can combine this function freely with other high-level functions.
Method waits until data string is received. This string is terminated by CR-LF characters. The resulting string is returned without this termination (CR-LF)! If ConvertLineEnd is used, then CR-LF sequence may not be exactly CR-LF. See ConvertLineEnd description. If no data is received within TIMEOUT (in milliseconds) period, LastError is set to WSAETIMEDOUT. You may also specify maximum length of reading data by MaxLineLength property. ^0"
+s[60] = "blcksock.TBlockSocket.RecvTerminated^blcksock.TBlockSocket.html#RecvTerminated^^Note: This is high-level receive function. It using internal LineBuffer and you can combine this function freely with other high-level functions.
Method waits until data string is received. This string is terminated by Terminator string. The resulting string is returned without this termination. If no data is received within TIMEOUT (in milliseconds) period, LastError is set to WSAETIMEDOUT. You may also specify maximum length of reading data by MaxLineLength property. ^0"
+s[61] = "blcksock.TBlockSocket.RecvPacket^blcksock.TBlockSocket.html#RecvPacket^^Note: This is high-level receive function. It using internal LineBuffer and you can combine this function freely with other high-level functions.
Method reads all data waiting for read. If no data is received within TIMEOUT (in milliseconds) period, LastError is set to WSAETIMEDOUT. Methods serves for reading unknown size of data. Because before call this function you don't know size of received data, returned data is stored in dynamic size binary string. This method is preffered for reading from stream sockets (like TCP). It is very goot for receiving datagrams too! (UDP protocol) ^0"
+s[62] = "blcksock.TBlockSocket.RecvBlock^blcksock.TBlockSocket.html#RecvBlock^^Read one block of data from socket. Each block begin with 4 bytes with length of data in block. This function read first 4 bytes for get lenght, then it wait for reported count of bytes. ^0"
+s[63] = "blcksock.TBlockSocket.RecvStreamRaw^blcksock.TBlockSocket.html#RecvStreamRaw^^Read all data from socket to stream until socket is closed (or any error occured.) ^0"
+s[64] = "blcksock.TBlockSocket.RecvStreamSize^blcksock.TBlockSocket.html#RecvStreamSize^^Read requested count of bytes from socket to stream. ^0"
+s[65] = "blcksock.TBlockSocket.RecvStream^blcksock.TBlockSocket.html#RecvStream^^Receive data to stream. It using RecvBlock method. ^0"
+s[66] = "blcksock.TBlockSocket.RecvStreamIndy^blcksock.TBlockSocket.html#RecvStreamIndy^^Receive data to stream. This function is compatible with similar function in Indy library. It using RecvBlock method. ^0"
+s[67] = "blcksock.TBlockSocket.PeekBuffer^blcksock.TBlockSocket.html#PeekBuffer^^Same as RecvBuffer , but readed data stays in system input buffer. Warning: this function not respect data in LineBuffer ! Is not recommended to use this function! ^0"
+s[68] = "blcksock.TBlockSocket.PeekByte^blcksock.TBlockSocket.html#PeekByte^^Same as RecvByte , but readed data stays in input system buffer. Warning: this function not respect data in LineBuffer ! Is not recommended to use this function! ^0"
+s[69] = "blcksock.TBlockSocket.WaitingData^blcksock.TBlockSocket.html#WaitingData^^On stream sockets it returns number of received bytes waiting for picking. 0 is returned when there is no such data. On datagram socket it returns length of the first waiting datagram. Returns 0 if no datagram is waiting. ^0"
+s[70] = "blcksock.TBlockSocket.WaitingDataEx^blcksock.TBlockSocket.html#WaitingDataEx^^Same as WaitingData , but if exists some of data in LineBuffer , return their length instead. ^0"
+s[71] = "blcksock.TBlockSocket.Purge^blcksock.TBlockSocket.html#Purge^^Clear all waiting data for read from buffers. ^0"
+s[72] = "blcksock.TBlockSocket.SetLinger^blcksock.TBlockSocket.html#SetLinger^^Sets linger. Enabled linger means that the system waits another LINGER (in milliseconds) time for delivery of sent data. This function is only for stream type of socket! (TCP) ^0"
+s[73] = "blcksock.TBlockSocket.GetSinLocal^blcksock.TBlockSocket.html#GetSinLocal^^Actualize values in LocalSin . ^0"
+s[74] = "blcksock.TBlockSocket.GetSinRemote^blcksock.TBlockSocket.html#GetSinRemote^^Actualize values in RemoteSin . ^0"
+s[75] = "blcksock.TBlockSocket.GetSins^blcksock.TBlockSocket.html#GetSins^^Actualize values in LocalSin and RemoteSin . ^0"
+s[76] = "blcksock.TBlockSocket.ResetLastError^blcksock.TBlockSocket.html#ResetLastError^^Reset LastError and LastErrorDesc to non-error state. ^0"
+s[77] = "blcksock.TBlockSocket.SockCheck^blcksock.TBlockSocket.html#SockCheck^^If you "manually" call Socket API functions, forward their return code as parameter to this function, which evaluates it, eventually calls GetLastError and found error code returns and stores to LastError . ^0"
+s[78] = "blcksock.TBlockSocket.ExceptCheck^blcksock.TBlockSocket.html#ExceptCheck^^If LastError contains some error code and RaiseExcept property is True
, raise adequate exception. ^0"
+s[79] = "blcksock.TBlockSocket.LocalName^blcksock.TBlockSocket.html#LocalName^^Returns local computer name as numerical or symbolic value. It try get fully qualified domain name. Name is returned in the format acceptable by functions demanding IP as input parameter. ^0"
+s[80] = "blcksock.TBlockSocket.ResolveNameToIP^blcksock.TBlockSocket.html#ResolveNameToIP^^Try resolve name to all possible IP address. i.e. If you pass as name result of LocalName method, you get all IP addresses used by local system. ^0"
+s[81] = "blcksock.TBlockSocket.ResolveName^blcksock.TBlockSocket.html#ResolveName^^Try resolve name to primary IP address. i.e. If you pass as name result of LocalName method, you get primary IP addresses used by local system. ^0"
+s[82] = "blcksock.TBlockSocket.ResolveIPToName^blcksock.TBlockSocket.html#ResolveIPToName^^Try resolve IP to their primary domain name. If IP not have domain name, then is returned original IP. ^0"
+s[83] = "blcksock.TBlockSocket.ResolvePort^blcksock.TBlockSocket.html#ResolvePort^^Try resolve symbolic port name to port number. (i.e. 'Echo' to 8) ^0"
+s[84] = "blcksock.TBlockSocket.SetRemoteSin^blcksock.TBlockSocket.html#SetRemoteSin^^Set information about remote side socket. It is good for seting remote side for sending UDP packet, etc. ^0"
+s[85] = "blcksock.TBlockSocket.GetLocalSinIP^blcksock.TBlockSocket.html#GetLocalSinIP^^Picks IP socket address from LocalSin . ^0"
+s[86] = "blcksock.TBlockSocket.GetRemoteSinIP^blcksock.TBlockSocket.html#GetRemoteSinIP^^Picks IP socket address from RemoteSin . ^0"
+s[87] = "blcksock.TBlockSocket.GetLocalSinPort^blcksock.TBlockSocket.html#GetLocalSinPort^^Picks socket PORT number from LocalSin . ^0"
+s[88] = "blcksock.TBlockSocket.GetRemoteSinPort^blcksock.TBlockSocket.html#GetRemoteSinPort^^Picks socket PORT number from RemoteSin . ^0"
+s[89] = "blcksock.TBlockSocket.CanRead^blcksock.TBlockSocket.html#CanRead^^Return True
, if you can read any data from socket or is incoming connection on TCP based socket. Status is tested for time Timeout (in milliseconds). If value in Timeout is 0, status is only tested and continue. If value in Timeout is -1, run is breaked and waiting for read data maybe forever.
This function is need only on special cases, when you need use RecvBuffer function directly! read functioms what have timeout as calling parameter, calling this function internally. ^0"
+s[90] = "blcksock.TBlockSocket.CanReadEx^blcksock.TBlockSocket.html#CanReadEx^^Same as CanRead , but additionally return True
if is some data in LineBuffer . ^0"
+s[91] = "blcksock.TBlockSocket.CanWrite^blcksock.TBlockSocket.html#CanWrite^^Return True
, if you can to socket write any data (not full sending buffer). Status is tested for time Timeout (in milliseconds). If value in Timeout is 0, status is only tested and continue. If value in Timeout is -1, run is breaked and waiting for write data maybe forever.
This function is need only on special cases! ^0"
+s[92] = "blcksock.TBlockSocket.SendBufferTo^blcksock.TBlockSocket.html#SendBufferTo^^Same as SendBuffer , but send datagram to address from RemoteSin . Usefull for sending reply to datagram received by function RecvBufferFrom . ^0"
+s[93] = "blcksock.TBlockSocket.RecvBufferFrom^blcksock.TBlockSocket.html#RecvBufferFrom^^Note: This is low-lever receive function. You must be sure if data is waiting for read before call this function for avoid deadlock!
Receives first waiting datagram to allocated buffer. If there is no waiting one, then waits until one comes. Returns length of datagram stored in BUFFER. If length exceeds buffer datagram is truncated. After this RemoteSin structure contains information about sender of UDP packet. ^0"
+s[94] = "blcksock.TBlockSocket.GroupCanRead^blcksock.TBlockSocket.html#GroupCanRead^^This function is for check for incoming data on set of sockets. Whitch sockets is checked is decribed by SocketList Tlist with TBlockSocket objects. TList may have maximal number of objects defined by FD_SETSIZE constant. Return True
, if you can from some socket read any data or is incoming connection on TCP based socket. Status is tested for time Timeout (in milliseconds). If value in Timeout is 0, status is only tested and continue. If value in Timeout is -1, run is breaked and waiting for read data maybe forever. If is returned True
, CanReadList TList is filled by all TBlockSocket objects what waiting for read. ^0"
+s[95] = "blcksock.TBlockSocket.EnableReuse^blcksock.TBlockSocket.html#EnableReuse^^By this method you may turn address reuse mode for local Bind . It is good specially for UDP protocol. Using this with TCP protocol is hazardous! ^0"
+s[96] = "blcksock.TBlockSocket.SetTimeout^blcksock.TBlockSocket.html#SetTimeout^^Try set timeout for all sending and receiving operations, if socket provider can do it. (It not supported by all socket providers!) ^0"
+s[97] = "blcksock.TBlockSocket.SetSendTimeout^blcksock.TBlockSocket.html#SetSendTimeout^^Try set timeout for all sending operations, if socket provider can do it. (It not supported by all socket providers!) ^0"
+s[98] = "blcksock.TBlockSocket.SetRecvTimeout^blcksock.TBlockSocket.html#SetRecvTimeout^^Try set timeout for all receiving operations, if socket provider can do it. (It not supported by all socket providers!) ^0"
+s[99] = "blcksock.TBlockSocket.GetSocketType^blcksock.TBlockSocket.html#GetSocketType^^Return value of socket type. ^0"
+s[100] = "blcksock.TBlockSocket.GetSocketProtocol^blcksock.TBlockSocket.html#GetSocketProtocol^^Return value of protocol type for socket creation. ^0"
+s[101] = "blcksock.TBlockSocket.GetErrorDesc^blcksock.TBlockSocket.html#GetErrorDesc^^Return descriptive string for given error code. This is class function. You may call it without created object! ^0"
+s[102] = "blcksock.TBlockSocket.GetErrorDescEx^blcksock.TBlockSocket.html#GetErrorDescEx^^Return descriptive string for LastError . ^0"
+s[103] = "blcksock.TBlockSocket.WSAData^blcksock.TBlockSocket.html#WSAData^^WSA structure with information about socket provider. On non-windows platforms this structure is simulated! ^0"
+s[104] = "blcksock.TBlockSocket.FDset^blcksock.TBlockSocket.html#FDset^^FDset structure prepared for usage with this socket. ^0"
+s[105] = "blcksock.TBlockSocket.LocalSin^blcksock.TBlockSocket.html#LocalSin^^Structure describing local socket side. ^0"
+s[106] = "blcksock.TBlockSocket.RemoteSin^blcksock.TBlockSocket.html#RemoteSin^^Structure describing remote socket side. ^0"
+s[107] = "blcksock.TBlockSocket.Socket^blcksock.TBlockSocket.html#Socket^^Socket handler. Suitable for "manual" calls to socket API or manual connection of socket to a previously created socket (i.e by Accept method on TCP socket) ^0"
+s[108] = "blcksock.TBlockSocket.LastError^blcksock.TBlockSocket.html#LastError^^Last socket operation error code. Error codes are described in socket documentation. Human readable error description is stored in LastErrorDesc property. ^0"
+s[109] = "blcksock.TBlockSocket.LastErrorDesc^blcksock.TBlockSocket.html#LastErrorDesc^^Human readable error description of LastError code. ^0"
+s[110] = "blcksock.TBlockSocket.LineBuffer^blcksock.TBlockSocket.html#LineBuffer^^Buffer used by all high-level receiving functions. This buffer is used for optimized reading of data from socket. In normal cases you not need access to this buffer directly! ^0"
+s[111] = "blcksock.TBlockSocket.SizeRecvBuffer^blcksock.TBlockSocket.html#SizeRecvBuffer^^Size of Winsock receive buffer. If it is not supported by socket provider, it return as size one kilobyte. ^0"
+s[112] = "blcksock.TBlockSocket.SizeSendBuffer^blcksock.TBlockSocket.html#SizeSendBuffer^^Size of Winsock send buffer. If it is not supported by socket provider, it return as size one kilobyte. ^0"
+s[113] = "blcksock.TBlockSocket.NonBlockMode^blcksock.TBlockSocket.html#NonBlockMode^^If True
, turn class to non-blocking mode. Not all functions are working properly in this mode, you must know exactly what you are doing! However when you have big experience with non-blocking programming, then you can optimise your program by non-block mode! ^0"
+s[114] = "blcksock.TBlockSocket.TTL^blcksock.TBlockSocket.html#TTL^^Set Time-to-live value. (if system supporting it!) ^0"
+s[115] = "blcksock.TBlockSocket.IP6used^blcksock.TBlockSocket.html#IP6used^^If is True
, then class in in IPv6 mode. ^0"
+s[116] = "blcksock.TBlockSocket.RecvCounter^blcksock.TBlockSocket.html#RecvCounter^^Return count of received bytes on this socket from begin of current connection. ^0"
+s[117] = "blcksock.TBlockSocket.SendCounter^blcksock.TBlockSocket.html#SendCounter^^Return count of sended bytes on this socket from begin of current connection. ^0"
+s[118] = "blcksock.TBlockSocket.Tag^blcksock.TBlockSocket.html#Tag^^this value is for free use. ^0"
+s[119] = "blcksock.TBlockSocket.RaiseExcept^blcksock.TBlockSocket.html#RaiseExcept^^If True
, winsock errors raises exception. Otherwise is setted LastError value only and you must check it from your program! Default value is False
. ^0"
+s[120] = "blcksock.TBlockSocket.MaxLineLength^blcksock.TBlockSocket.html#MaxLineLength^^Define maximum length in bytes of LineBuffer for high-level receiving functions. If this functions try to read more data then this limit, error is returned! If value is 0 (default), no limitation is used. This is very good protection for stupid attacks to your server by sending lot of data without proper terminator... until all your memory is allocated by LineBuffer!
Note: This maximum length is checked only in functions, what read unknown number of bytes! (like RecvString or RecvTerminated ) ^0"
+s[121] = "blcksock.TBlockSocket.MaxSendBandwidth^blcksock.TBlockSocket.html#MaxSendBandwidth^^Define maximal bandwidth for all sending operations in bytes per second. If value is 0 (default), bandwidth limitation is not used. ^0"
+s[122] = "blcksock.TBlockSocket.MaxRecvBandwidth^blcksock.TBlockSocket.html#MaxRecvBandwidth^^Define maximal bandwidth for all receiving operations in bytes per second. If value is 0 (default), bandwidth limitation is not used. ^0"
+s[123] = "blcksock.TBlockSocket.MaxBandwidth^blcksock.TBlockSocket.html#MaxBandwidth^^Define maximal bandwidth for all sending and receiving operations in bytes per second. If value is 0 (default), bandwidth limitation is not used. ^0"
+s[124] = "blcksock.TBlockSocket.ConvertLineEnd^blcksock.TBlockSocket.html#ConvertLineEnd^^Do a conversion of non-standard line terminators to CRLF. (Off by default) If True
, then terminators like sigle CR, single LF or LFCR are converted to CRLF internally. This have effect only in RecvString method! ^0"
+s[125] = "blcksock.TBlockSocket.Family^blcksock.TBlockSocket.html#Family^^Specified Family of this socket. When you are using Windows preliminary support for IPv6, then I recommend to set this property! ^0"
+s[126] = "blcksock.TBlockSocket.PreferIP4^blcksock.TBlockSocket.html#PreferIP4^^When resolving of domain name return both IPv4 and IPv6 addresses, then specify if is used IPv4 (dafault - True
) or IPv6. ^0"
+s[127] = "blcksock.TBlockSocket.InterPacketTimeout^blcksock.TBlockSocket.html#InterPacketTimeout^^By default (True
) is all timeouts used as timeout between two packets in reading operations. If you set this to False
, then Timeouts is for overall reading operation! ^0"
+s[128] = "blcksock.TBlockSocket.SendMaxChunk^blcksock.TBlockSocket.html#SendMaxChunk^^All sended datas was splitted by this value. ^0"
+s[129] = "blcksock.TBlockSocket.StopFlag^blcksock.TBlockSocket.html#StopFlag^^By setting this property to True
you can stop any communication. You can use this property for soft abort of communication. ^0"
+s[130] = "blcksock.TBlockSocket.NonblockSendTimeout^blcksock.TBlockSocket.html#NonblockSendTimeout^^Timeout for data sending by non-blocking socket mode. ^0"
+s[131] = "blcksock.TBlockSocket.OnStatus^blcksock.TBlockSocket.html#OnStatus^^This event is called by various reasons. It is good for monitoring socket, create gauges for data transfers, etc. ^0"
+s[132] = "blcksock.TBlockSocket.OnReadFilter^blcksock.TBlockSocket.html#OnReadFilter^^this event is good for some internal thinks about filtering readed datas. It is used by telnet client by example. ^0"
+s[133] = "blcksock.TBlockSocket.OnCreateSocket^blcksock.TBlockSocket.html#OnCreateSocket^^This event is called after real socket creation for setting special socket options, because you not know when socket is created. (it is depended on Ipv4, IPv6 or automatic mode) ^0"
+s[134] = "blcksock.TBlockSocket.OnMonitor^blcksock.TBlockSocket.html#OnMonitor^^This event is good for monitoring content of readed or writed datas. ^0"
+s[135] = "blcksock.TBlockSocket.OnHeartbeat^blcksock.TBlockSocket.html#OnHeartbeat^^This event is good for calling your code during long socket operations. (Example, for refresing UI if class in not called within the thread.) Rate of heartbeats can be modified by HeartbeatRate property. ^0"
+s[136] = "blcksock.TBlockSocket.HeartbeatRate^blcksock.TBlockSocket.html#HeartbeatRate^^Specify typical rate of OnHeartbeat event and StopFlag testing. Default value 0 disabling heartbeats! Value is in milliseconds. Real rate can be higher or smaller then this value, because it depending on real socket operations too! Note: Each heartbeat slowing socket processing. ^0"
+s[137] = "blcksock.TBlockSocket.Owner^blcksock.TBlockSocket.html#Owner^^What class own this socket? Used by protocol implementation classes. ^0"
+s[138] = "blcksock.TSocksBlockSocket^blcksock.TSocksBlockSocket.html^Support for SOCKS4 and SOCKS5 proxy^ Layer with definition all necessary properties and functions for implementation SOCKS proxy client. Do not use this class directly. ^0"
+s[139] = "blcksock.TSocksBlockSocket.Create^blcksock.TSocksBlockSocket.html#Create^^ ^0"
+s[140] = "blcksock.TSocksBlockSocket.SocksOpen^blcksock.TSocksBlockSocket.html#SocksOpen^^Open connection to SOCKS proxy and if SocksUsername is set, do authorisation to proxy. This is needed only in special cases! (it is called internally!) ^0"
+s[141] = "blcksock.TSocksBlockSocket.SocksRequest^blcksock.TSocksBlockSocket.html#SocksRequest^^Send specified request to SOCKS proxy. This is needed only in special cases! (it is called internally!) ^0"
+s[142] = "blcksock.TSocksBlockSocket.SocksResponse^blcksock.TSocksBlockSocket.html#SocksResponse^^Receive response to previosly sended request. This is needed only in special cases! (it is called internally!) ^0"
+s[143] = "blcksock.TSocksBlockSocket.UsingSocks^blcksock.TSocksBlockSocket.html#UsingSocks^^Is True
when class is using SOCKS proxy. ^0"
+s[144] = "blcksock.TSocksBlockSocket.SocksLastError^blcksock.TSocksBlockSocket.html#SocksLastError^^If SOCKS proxy failed, here is error code returned from SOCKS proxy. ^0"
+s[145] = "blcksock.TSocksBlockSocket.SocksIP^blcksock.TSocksBlockSocket.html#SocksIP^^Address of SOCKS server. If value is empty string, SOCKS support is disabled. Assingning any value to this property enable SOCKS mode. Warning: You cannot combine this mode with HTTP-tunneling mode! ^0"
+s[146] = "blcksock.TSocksBlockSocket.SocksPort^blcksock.TSocksBlockSocket.html#SocksPort^^Port of SOCKS server. Default value is '1080'. ^0"
+s[147] = "blcksock.TSocksBlockSocket.SocksUsername^blcksock.TSocksBlockSocket.html#SocksUsername^^If you need authorisation on SOCKS server, set username here. ^0"
+s[148] = "blcksock.TSocksBlockSocket.SocksPassword^blcksock.TSocksBlockSocket.html#SocksPassword^^If you need authorisation on SOCKS server, set password here. ^0"
+s[149] = "blcksock.TSocksBlockSocket.SocksTimeout^blcksock.TSocksBlockSocket.html#SocksTimeout^^Specify timeout for communicatin with SOCKS server. Default is one minute. ^0"
+s[150] = "blcksock.TSocksBlockSocket.SocksResolver^blcksock.TSocksBlockSocket.html#SocksResolver^^If True
, all symbolic names of target hosts is not translated to IP's locally, but resolving is by SOCKS proxy. Default is True
. ^0"
+s[151] = "blcksock.TSocksBlockSocket.SocksType^blcksock.TSocksBlockSocket.html#SocksType^^Specify SOCKS type. By default is used SOCKS5, but you can use SOCKS4 too. When you select SOCKS4, then if SocksResolver is enabled, then is used SOCKS4a. Othervise is used pure SOCKS4. ^0"
+s[152] = "blcksock.TTCPBlockSocket^blcksock.TTCPBlockSocket.html^Implementation of TCP socket.^ Supported features: IPv4, IPv6, SSL/TLS or SSH (depending on used plugin), SOCKS5 proxy (outgoing connections and limited incomming), SOCKS4/4a proxy (outgoing connections and limited incomming), TCP through HTTP proxy tunnel. ^0"
+s[153] = "blcksock.TTCPBlockSocket.Create^blcksock.TTCPBlockSocket.html#Create^^Create TCP socket class with default plugin for SSL/TSL/SSH implementation (see SSLImplementation ) ^0"
+s[154] = "blcksock.TTCPBlockSocket.CreateWithSSL^blcksock.TTCPBlockSocket.html#CreateWithSSL^^Create TCP socket class with desired plugin for SSL/TSL/SSH implementation ^0"
+s[155] = "blcksock.TTCPBlockSocket.Destroy^blcksock.TTCPBlockSocket.html#Destroy^^ ^0"
+s[156] = "blcksock.TTCPBlockSocket.CloseSocket^blcksock.TTCPBlockSocket.html#CloseSocket^^See TBlockSocket .CloseSocket ^0"
+s[157] = "blcksock.TTCPBlockSocket.WaitingData^blcksock.TTCPBlockSocket.html#WaitingData^^See TBlockSocket .WaitingData ^0"
+s[158] = "blcksock.TTCPBlockSocket.Listen^blcksock.TTCPBlockSocket.html#Listen^^Sets socket to receive mode for new incoming connections. It is necessary to use TBlockSocket .Bind function call before this method to select receiving port!
If you use SOCKS, activate incoming TCP connection by this proxy. (By BIND method of SOCKS.) ^0"
+s[159] = "blcksock.TTCPBlockSocket.Accept^blcksock.TTCPBlockSocket.html#Accept^^Waits until new incoming connection comes. After it comes a new socket is automatically created (socket handler is returned by this function as result).
If you use SOCKS, new socket is not created! In this case is used same socket as socket for listening! So, you can accept only one connection in SOCKS mode. ^0"
+s[160] = "blcksock.TTCPBlockSocket.Connect^blcksock.TTCPBlockSocket.html#Connect^^Connects socket to remote IP address and PORT. The same rules as with TBlockSocket .Bind method are valid. The only exception is that PORT with 0 value will not be connected. After call to this method a communication channel between local and remote socket is created. Local socket is assigned automatically if not controlled by previous call to TBlockSocket .Bind method. Structures TBlockSocket .LocalSin and TBlockSocket .RemoteSin will be filled with valid values.
If you use SOCKS, activate outgoing TCP connection by SOCKS proxy specified in TSocksBlockSocket .SocksIP . (By CONNECT method of SOCKS.)
If you use HTTP-tunnel mode, activate outgoing TCP connection by HTTP tunnel specified in HTTPTunnelIP . (By CONNECT method of HTTP protocol.)
Note: If you call this on non-created socket, then socket is created automaticly. ^0"
+s[161] = "blcksock.TTCPBlockSocket.SSLDoConnect^blcksock.TTCPBlockSocket.html#SSLDoConnect^^If you need upgrade existing TCP connection to SSL/TLS (or SSH2, if plugin allows it) mode, then call this method. This method switch this class to SSL mode and do SSL/TSL handshake. ^0"
+s[162] = "blcksock.TTCPBlockSocket.SSLDoShutdown^blcksock.TTCPBlockSocket.html#SSLDoShutdown^^By this method you can downgrade existing SSL/TLS connection to normal TCP connection. ^0"
+s[163] = "blcksock.TTCPBlockSocket.SSLAcceptConnection^blcksock.TTCPBlockSocket.html#SSLAcceptConnection^^If you need use this component as SSL/TLS TCP server, then after accepting of inbound connection you need start SSL/TLS session by this method. Before call this function, you must have assigned all neeeded certificates and keys! ^0"
+s[164] = "blcksock.TTCPBlockSocket.GetLocalSinIP^blcksock.TTCPBlockSocket.html#GetLocalSinIP^^See TBlockSocket .GetLocalSinIP ^0"
+s[165] = "blcksock.TTCPBlockSocket.GetRemoteSinIP^blcksock.TTCPBlockSocket.html#GetRemoteSinIP^^See TBlockSocket .GetRemoteSinIP ^0"
+s[166] = "blcksock.TTCPBlockSocket.GetLocalSinPort^blcksock.TTCPBlockSocket.html#GetLocalSinPort^^See TBlockSocket .GetLocalSinPort ^0"
+s[167] = "blcksock.TTCPBlockSocket.GetRemoteSinPort^blcksock.TTCPBlockSocket.html#GetRemoteSinPort^^See TBlockSocket .GetRemoteSinPort ^0"
+s[168] = "blcksock.TTCPBlockSocket.SendBuffer^blcksock.TTCPBlockSocket.html#SendBuffer^^See TBlockSocket .SendBuffer ^0"
+s[169] = "blcksock.TTCPBlockSocket.RecvBuffer^blcksock.TTCPBlockSocket.html#RecvBuffer^^See TBlockSocket .RecvBuffer ^0"
+s[170] = "blcksock.TTCPBlockSocket.GetSocketType^blcksock.TTCPBlockSocket.html#GetSocketType^^Return value of socket type. For TCP return SOCK_STREAM. ^0"
+s[171] = "blcksock.TTCPBlockSocket.GetSocketProtocol^blcksock.TTCPBlockSocket.html#GetSocketProtocol^^Return value of protocol type for socket creation. For TCP return IPPROTO_TCP. ^0"
+s[172] = "blcksock.TTCPBlockSocket.GetErrorDescEx^blcksock.TTCPBlockSocket.html#GetErrorDescEx^^Return descriptive string for LastError
. On case of error in SSL/TLS subsystem, it returns right error description. ^0"
+s[173] = "blcksock.TTCPBlockSocket.SSL^blcksock.TTCPBlockSocket.html#SSL^^Class implementing SSL/TLS support. It is allways some descendant of TCustomSSL class. When programmer not select some SSL plugin class, then is used TSSLNone ^0"
+s[174] = "blcksock.TTCPBlockSocket.HTTPTunnel^blcksock.TTCPBlockSocket.html#HTTPTunnel^^True
if is used HTTP tunnel mode. ^0"
+s[175] = "blcksock.TTCPBlockSocket.HTTPTunnelIP^blcksock.TTCPBlockSocket.html#HTTPTunnelIP^^Specify IP address of HTTP proxy. Assingning non-empty value to this property enable HTTP-tunnel mode. This mode is for tunnelling any outgoing TCP connection through HTTP proxy server. (If policy on HTTP proxy server allow this!) Warning: You cannot combine this mode with SOCK5 mode! ^0"
+s[176] = "blcksock.TTCPBlockSocket.HTTPTunnelPort^blcksock.TTCPBlockSocket.html#HTTPTunnelPort^^Specify port of HTTP proxy for HTTP-tunneling. ^0"
+s[177] = "blcksock.TTCPBlockSocket.HTTPTunnelUser^blcksock.TTCPBlockSocket.html#HTTPTunnelUser^^Specify authorisation username for access to HTTP proxy in HTTP-tunnel mode. If you not need authorisation, then let this property empty. ^0"
+s[178] = "blcksock.TTCPBlockSocket.HTTPTunnelPass^blcksock.TTCPBlockSocket.html#HTTPTunnelPass^^Specify authorisation password for access to HTTP proxy in HTTP-tunnel mode. ^0"
+s[179] = "blcksock.TTCPBlockSocket.HTTPTunnelTimeout^blcksock.TTCPBlockSocket.html#HTTPTunnelTimeout^^Specify timeout for communication with HTTP proxy in HTTPtunnel mode. ^0"
+s[180] = "blcksock.TTCPBlockSocket.OnAfterConnect^blcksock.TTCPBlockSocket.html#OnAfterConnect^^This event is called after sucessful TCP socket connection. ^0"
+s[181] = "blcksock.TDgramBlockSocket^blcksock.TDgramBlockSocket.html^Datagram based communication^ This class implementing datagram based communication instead default stream based communication style. ^0"
+s[182] = "blcksock.TDgramBlockSocket.Connect^blcksock.TDgramBlockSocket.html#Connect^^Fill TBlockSocket .RemoteSin structure. This address is used for sending data. ^0"
+s[183] = "blcksock.TDgramBlockSocket.SendBuffer^blcksock.TDgramBlockSocket.html#SendBuffer^^Silently redirected to TBlockSocket .SendBufferTo . ^0"
+s[184] = "blcksock.TDgramBlockSocket.RecvBuffer^blcksock.TDgramBlockSocket.html#RecvBuffer^^Silently redirected to TBlockSocket .RecvBufferFrom . ^0"
+s[185] = "blcksock.TUDPBlockSocket^blcksock.TUDPBlockSocket.html^Implementation of UDP socket.^ NOTE: in this class is all receiving redirected to RecvBufferFrom. You can use for reading any receive function. Preffered is RecvPacket! Similary all sending is redirected to SendbufferTo. You can use for sending UDP packet any sending function, like SendString.
Supported features: IPv4, IPv6, unicasts, broadcasts, multicasts, SOCKS5 proxy (only unicasts! Outgoing and incomming.) ^0"
+s[186] = "blcksock.TUDPBlockSocket.Destroy^blcksock.TUDPBlockSocket.html#Destroy^^ ^0"
+s[187] = "blcksock.TUDPBlockSocket.EnableBroadcast^blcksock.TUDPBlockSocket.html#EnableBroadcast^^Enable or disable sending of broadcasts. If seting OK, result is True
. This method is not supported in SOCKS5 mode! IPv6 does not support broadcasts! In this case you must use Multicasts instead. ^0"
+s[188] = "blcksock.TUDPBlockSocket.SendBufferTo^blcksock.TUDPBlockSocket.html#SendBufferTo^^See TBlockSocket .SendBufferTo ^0"
+s[189] = "blcksock.TUDPBlockSocket.RecvBufferFrom^blcksock.TUDPBlockSocket.html#RecvBufferFrom^^See TBlockSocket .RecvBufferFrom ^0"
+s[190] = "blcksock.TUDPBlockSocket.AddMulticast^blcksock.TUDPBlockSocket.html#AddMulticast^^Add this socket to given multicast group. You cannot use Multicasts in SOCKS mode! ^0"
+s[191] = "blcksock.TUDPBlockSocket.DropMulticast^blcksock.TUDPBlockSocket.html#DropMulticast^^Remove this socket from given multicast group. ^0"
+s[192] = "blcksock.TUDPBlockSocket.EnableMulticastLoop^blcksock.TUDPBlockSocket.html#EnableMulticastLoop^^All sended multicast datagrams is loopbacked to your interface too. (you can read your sended datas.) You can disable this feature by this function. This function not working on some Windows systems! ^0"
+s[193] = "blcksock.TUDPBlockSocket.GetSocketType^blcksock.TUDPBlockSocket.html#GetSocketType^^Return value of socket type. For UDP return SOCK_DGRAM. ^0"
+s[194] = "blcksock.TUDPBlockSocket.GetSocketProtocol^blcksock.TUDPBlockSocket.html#GetSocketProtocol^^Return value of protocol type for socket creation. For UDP return IPPROTO_UDP. ^0"
+s[195] = "blcksock.TUDPBlockSocket.MulticastTTL^blcksock.TUDPBlockSocket.html#MulticastTTL^^Set Time-to-live value for multicasts packets. It define number of routers for transfer of datas. If you set this to 1 (dafault system value), then multicasts packet goes only to you local network. If you need transport multicast packet to worldwide, then increase this value, but be carefull, lot of routers on internet does not transport multicasts packets! ^0"
+s[196] = "blcksock.TICMPBlockSocket^blcksock.TICMPBlockSocket.html^Implementation of RAW ICMP socket.^ For this object you must have rights for creating RAW sockets! ^0"
+s[197] = "blcksock.TICMPBlockSocket.GetSocketType^blcksock.TICMPBlockSocket.html#GetSocketType^^Return value of socket type. For RAW and ICMP return SOCK_RAW. ^0"
+s[198] = "blcksock.TICMPBlockSocket.GetSocketProtocol^blcksock.TICMPBlockSocket.html#GetSocketProtocol^^Return value of protocol type for socket creation. For ICMP returns IPPROTO_ICMP or IPPROTO_ICMPV6 ^0"
+s[199] = "blcksock.TRAWBlockSocket^blcksock.TRAWBlockSocket.html^Implementation of RAW socket.^ For this object you must have rights for creating RAW sockets! ^0"
+s[200] = "blcksock.TRAWBlockSocket.GetSocketType^blcksock.TRAWBlockSocket.html#GetSocketType^^Return value of socket type. For RAW and ICMP return SOCK_RAW. ^0"
+s[201] = "blcksock.TRAWBlockSocket.GetSocketProtocol^blcksock.TRAWBlockSocket.html#GetSocketProtocol^^Return value of protocol type for socket creation. For RAW returns IPPROTO_RAW. ^0"
+s[202] = "blcksock.TPGMMessageBlockSocket^blcksock.TPGMMessageBlockSocket.html^Implementation of PGM-message socket.^ Not all systems supports this protocol! ^0"
+s[203] = "blcksock.TPGMMessageBlockSocket.GetSocketType^blcksock.TPGMMessageBlockSocket.html#GetSocketType^^Return value of socket type. For PGM-message return SOCK_RDM. ^0"
+s[204] = "blcksock.TPGMMessageBlockSocket.GetSocketProtocol^blcksock.TPGMMessageBlockSocket.html#GetSocketProtocol^^Return value of protocol type for socket creation. For PGM-message returns IPPROTO_RM. ^0"
+s[205] = "blcksock.TPGMStreamBlockSocket^blcksock.TPGMStreamBlockSocket.html^Implementation of PGM-stream socket.^ Not all systems supports this protocol! ^0"
+s[206] = "blcksock.TPGMStreamBlockSocket.GetSocketType^blcksock.TPGMStreamBlockSocket.html#GetSocketType^^Return value of socket type. For PGM-stream return SOCK_STREAM. ^0"
+s[207] = "blcksock.TPGMStreamBlockSocket.GetSocketProtocol^blcksock.TPGMStreamBlockSocket.html#GetSocketProtocol^^Return value of protocol type for socket creation. For PGM-stream returns IPPROTO_RM. ^0"
+s[208] = "blcksock.TCustomSSL^blcksock.TCustomSSL.html^Parent class for all SSL plugins.^ This is abstract class defining interface for other SSL plugins.
Instance of this class will be created for each TTCPBlockSocket .
Warning: not all methods and propertis can work in all existing SSL plugins! Please, read documentation of used SSL plugin. ^0"
+s[209] = "blcksock.TCustomSSL.Create^blcksock.TCustomSSL.html#Create^^Create plugin class. it is called internally from TTCPBlockSocket ^0"
+s[210] = "blcksock.TCustomSSL.Assign^blcksock.TCustomSSL.html#Assign^^Assign settings (certificates and configuration) from another SSL plugin class. ^0"
+s[211] = "blcksock.TCustomSSL.LibVersion^blcksock.TCustomSSL.html#LibVersion^^return description of used plugin. It usually return name and version of used SSL library. ^0"
+s[212] = "blcksock.TCustomSSL.LibName^blcksock.TCustomSSL.html#LibName^^return name of used plugin. ^0"
+s[213] = "blcksock.TCustomSSL.Connect^blcksock.TCustomSSL.html#Connect^^Do not call this directly. It is used internally by TTCPBlockSocket !
Here is needed code for start SSL connection. ^0"
+s[214] = "blcksock.TCustomSSL.Accept^blcksock.TCustomSSL.html#Accept^^Do not call this directly. It is used internally by TTCPBlockSocket !
Here is needed code for acept new SSL connection. ^0"
+s[215] = "blcksock.TCustomSSL.Shutdown^blcksock.TCustomSSL.html#Shutdown^^Do not call this directly. It is used internally by TTCPBlockSocket !
Here is needed code for hard shutdown of SSL connection. (for example, before socket is closed) ^0"
+s[216] = "blcksock.TCustomSSL.BiShutdown^blcksock.TCustomSSL.html#BiShutdown^^Do not call this directly. It is used internally by TTCPBlockSocket !
Here is needed code for soft shutdown of SSL connection. (for example, when you need to continue with unprotected connection.) ^0"
+s[217] = "blcksock.TCustomSSL.SendBuffer^blcksock.TCustomSSL.html#SendBuffer^^Do not call this directly. It is used internally by TTCPBlockSocket !
Here is needed code for sending some datas by SSL connection. ^0"
+s[218] = "blcksock.TCustomSSL.RecvBuffer^blcksock.TCustomSSL.html#RecvBuffer^^Do not call this directly. It is used internally by TTCPBlockSocket !
Here is needed code for receiving some datas by SSL connection. ^0"
+s[219] = "blcksock.TCustomSSL.WaitingData^blcksock.TCustomSSL.html#WaitingData^^Do not call this directly. It is used internally by TTCPBlockSocket !
Here is needed code for getting count of datas what waiting for read. If SSL plugin not allows this, then it should return 0. ^0"
+s[220] = "blcksock.TCustomSSL.GetSSLVersion^blcksock.TCustomSSL.html#GetSSLVersion^^Return string with identificator of SSL/TLS version of existing connection. ^0"
+s[221] = "blcksock.TCustomSSL.GetPeerSubject^blcksock.TCustomSSL.html#GetPeerSubject^^Return subject of remote SSL peer. ^0"
+s[222] = "blcksock.TCustomSSL.GetPeerSerialNo^blcksock.TCustomSSL.html#GetPeerSerialNo^^Return Serial number if remote X509 certificate. ^0"
+s[223] = "blcksock.TCustomSSL.GetPeerIssuer^blcksock.TCustomSSL.html#GetPeerIssuer^^Return issuer certificate of remote SSL peer. ^0"
+s[224] = "blcksock.TCustomSSL.GetPeerName^blcksock.TCustomSSL.html#GetPeerName^^Return peer name from remote side certificate. This is good for verify, if certificate is generated for remote side IP name. ^0"
+s[225] = "blcksock.TCustomSSL.GetPeerNameHash^blcksock.TCustomSSL.html#GetPeerNameHash^^Returns has of peer name from remote side certificate. This is good for fast remote side authentication. ^0"
+s[226] = "blcksock.TCustomSSL.GetPeerFingerprint^blcksock.TCustomSSL.html#GetPeerFingerprint^^Return fingerprint of remote SSL peer. ^0"
+s[227] = "blcksock.TCustomSSL.GetCertInfo^blcksock.TCustomSSL.html#GetCertInfo^^Return all detailed information about certificate from remote side of SSL/TLS connection. Result string can be multilined! Each plugin can return this informations in different format! ^0"
+s[228] = "blcksock.TCustomSSL.GetCipherName^blcksock.TCustomSSL.html#GetCipherName^^Return currently used Cipher. ^0"
+s[229] = "blcksock.TCustomSSL.GetCipherBits^blcksock.TCustomSSL.html#GetCipherBits^^Return currently used number of bits in current Cipher algorythm. ^0"
+s[230] = "blcksock.TCustomSSL.GetCipherAlgBits^blcksock.TCustomSSL.html#GetCipherAlgBits^^Return number of bits in current Cipher algorythm. ^0"
+s[231] = "blcksock.TCustomSSL.GetVerifyCert^blcksock.TCustomSSL.html#GetVerifyCert^^Return result value of verify remote side certificate. Look to OpenSSL documentation for possible values. For example 0 is successfuly verified certificate, or 18 is self-signed certificate. ^0"
+s[232] = "blcksock.TCustomSSL.SSLEnabled^blcksock.TCustomSSL.html#SSLEnabled^^Resurn True
if SSL mode is enabled on existing cvonnection. ^0"
+s[233] = "blcksock.TCustomSSL.LastError^blcksock.TCustomSSL.html#LastError^^Return error code of last SSL operation. 0 is OK. ^0"
+s[234] = "blcksock.TCustomSSL.LastErrorDesc^blcksock.TCustomSSL.html#LastErrorDesc^^Return error description of last SSL operation. ^0"
+s[235] = "blcksock.TCustomSSL.SSLType^blcksock.TCustomSSL.html#SSLType^^Here you can specify requested SSL/TLS mode. Default is autodetection, but on some servers autodetection not working properly. In this case you must specify requested SSL/TLS mode by your hand! ^0"
+s[236] = "blcksock.TCustomSSL.KeyPassword^blcksock.TCustomSSL.html#KeyPassword^^Password for decrypting of encoded certificate or key. ^0"
+s[237] = "blcksock.TCustomSSL.Username^blcksock.TCustomSSL.html#Username^^Username for possible credentials. ^0"
+s[238] = "blcksock.TCustomSSL.Password^blcksock.TCustomSSL.html#Password^^password for possible credentials. ^0"
+s[239] = "blcksock.TCustomSSL.Ciphers^blcksock.TCustomSSL.html#Ciphers^^By this property you can modify default set of SSL/TLS ciphers. ^0"
+s[240] = "blcksock.TCustomSSL.CertificateFile^blcksock.TCustomSSL.html#CertificateFile^^Used for loading certificate from disk file. See to plugin documentation if this method is supported and how! ^0"
+s[241] = "blcksock.TCustomSSL.PrivateKeyFile^blcksock.TCustomSSL.html#PrivateKeyFile^^Used for loading private key from disk file. See to plugin documentation if this method is supported and how! ^0"
+s[242] = "blcksock.TCustomSSL.Certificate^blcksock.TCustomSSL.html#Certificate^^Used for loading certificate from binary string. See to plugin documentation if this method is supported and how! ^0"
+s[243] = "blcksock.TCustomSSL.PrivateKey^blcksock.TCustomSSL.html#PrivateKey^^Used for loading private key from binary string. See to plugin documentation if this method is supported and how! ^0"
+s[244] = "blcksock.TCustomSSL.PFX^blcksock.TCustomSSL.html#PFX^^Used for loading PFX from binary string. See to plugin documentation if this method is supported and how! ^0"
+s[245] = "blcksock.TCustomSSL.PFXfile^blcksock.TCustomSSL.html#PFXfile^^Used for loading PFX from disk file. See to plugin documentation if this method is supported and how! ^0"
+s[246] = "blcksock.TCustomSSL.TrustCertificateFile^blcksock.TCustomSSL.html#TrustCertificateFile^^Used for loading trusted certificates from disk file. See to plugin documentation if this method is supported and how! ^0"
+s[247] = "blcksock.TCustomSSL.TrustCertificate^blcksock.TCustomSSL.html#TrustCertificate^^Used for loading trusted certificates from binary string. See to plugin documentation if this method is supported and how! ^0"
+s[248] = "blcksock.TCustomSSL.CertCA^blcksock.TCustomSSL.html#CertCA^^Used for loading CA certificates from binary string. See to plugin documentation if this method is supported and how! ^0"
+s[249] = "blcksock.TCustomSSL.CertCAFile^blcksock.TCustomSSL.html#CertCAFile^^Used for loading CA certificates from disk file. See to plugin documentation if this method is supported and how! ^0"
+s[250] = "blcksock.TCustomSSL.VerifyCert^blcksock.TCustomSSL.html#VerifyCert^^If True
, then is verified client certificate. (it is good for writing SSL/TLS servers.) When you are not server, but you are client, then if this property is True
, verify servers certificate. ^0"
+s[251] = "blcksock.TCustomSSL.SSHChannelType^blcksock.TCustomSSL.html#SSHChannelType^^channel type for possible SSH connections ^0"
+s[252] = "blcksock.TCustomSSL.SSHChannelArg1^blcksock.TCustomSSL.html#SSHChannelArg1^^First argument of channel type for possible SSH connections ^0"
+s[253] = "blcksock.TCustomSSL.SSHChannelArg2^blcksock.TCustomSSL.html#SSHChannelArg2^^Second argument of channel type for possible SSH connections ^0"
+s[254] = "blcksock.TCustomSSL.CertComplianceLevel^blcksock.TCustomSSL.html#CertComplianceLevel^^Level of standards compliance level (CryptLib: values in cryptlib.pas, -1: use default value ) ^0"
+s[255] = "blcksock.TCustomSSL.OnVerifyCert^blcksock.TCustomSSL.html#OnVerifyCert^^This event is called when verifying the server certificate immediatally after a successfull verification in the ssl library. ^0"
+s[256] = "blcksock.TCustomSSL.SNIHost^blcksock.TCustomSSL.html#SNIHost^^Server Name Identification. Host name to send to server. If empty the host name found in URL will be used, which should be the normal use (http Header Host = SNI Host). The value is cleared after the connection is established. (SNI support requires OpenSSL 0.9.8k or later. Cryptlib not supported, yet ) ^0"
+s[257] = "blcksock.TSSLNone^blcksock.TSSLNone.html^Default SSL plugin with no SSL support.^ Dummy SSL plugin implementation for applications without SSL/TLS support. ^0"
+s[258] = "blcksock.TSSLNone.LibVersion^blcksock.TSSLNone.html#LibVersion^^See TCustomSSL .LibVersion ^0"
+s[259] = "blcksock.TSSLNone.LibName^blcksock.TSSLNone.html#LibName^^See TCustomSSL .LibName ^0"
+s[260] = "blcksock.TIPHeader^blcksock.TIPHeader.html^Record with definition of IP packet header.^ For reading data from ICMP or RAW sockets. ^0"
+s[261] = "blcksock.TIPHeader.VerLen^blcksock.TIPHeader.html#VerLen^^ ^0"
+s[262] = "blcksock.TIPHeader.TOS^blcksock.TIPHeader.html#TOS^^ ^0"
+s[263] = "blcksock.TIPHeader.TotalLen^blcksock.TIPHeader.html#TotalLen^^ ^0"
+s[264] = "blcksock.TIPHeader.Identifer^blcksock.TIPHeader.html#Identifer^^ ^0"
+s[265] = "blcksock.TIPHeader.FragOffsets^blcksock.TIPHeader.html#FragOffsets^^ ^0"
+s[266] = "blcksock.TIPHeader.TTL^blcksock.TIPHeader.html#TTL^^ ^0"
+s[267] = "blcksock.TIPHeader.Protocol^blcksock.TIPHeader.html#Protocol^^ ^0"
+s[268] = "blcksock.TIPHeader.CheckSum^blcksock.TIPHeader.html#CheckSum^^ ^0"
+s[269] = "blcksock.TIPHeader.SourceIp^blcksock.TIPHeader.html#SourceIp^^ ^0"
+s[270] = "blcksock.TIPHeader.DestIp^blcksock.TIPHeader.html#DestIp^^ ^0"
+s[271] = "blcksock.TIPHeader.Options^blcksock.TIPHeader.html#Options^^ ^0"
+s[272] = "blcksock.TSynaClient^blcksock.TSynaClient.html^Parent class of application protocol implementations.^ By this class is defined common properties. ^0"
+s[273] = "blcksock.TSynaClient.Create^blcksock.TSynaClient.html#Create^^ ^0"
+s[274] = "blcksock.TSynaClient.TargetHost^blcksock.TSynaClient.html#TargetHost^^Specify terget server IP (or symbolic name). Default is 'localhost'. ^0"
+s[275] = "blcksock.TSynaClient.TargetPort^blcksock.TSynaClient.html#TargetPort^^Specify terget server port (or symbolic name). ^0"
+s[276] = "blcksock.TSynaClient.IPInterface^blcksock.TSynaClient.html#IPInterface^^Defined local socket address. (outgoing IP address). By default is used '0.0.0.0' as wildcard for default IP. ^0"
+s[277] = "blcksock.TSynaClient.Timeout^blcksock.TSynaClient.html#Timeout^^Specify default timeout for socket operations. ^0"
+s[278] = "blcksock.TSynaClient.UserName^blcksock.TSynaClient.html#UserName^^If protocol need user authorization, then fill here username. ^0"
+s[279] = "blcksock.TSynaClient.Password^blcksock.TSynaClient.html#Password^^If protocol need user authorization, then fill here password. ^0"
+s[280] = "blcksock.SynapseRelease^blcksock.html#SynapseRelease^^ ^0"
+s[281] = "blcksock.cLocalhost^blcksock.html#cLocalhost^^ ^0"
+s[282] = "blcksock.cAnyHost^blcksock.html#cAnyHost^^ ^0"
+s[283] = "blcksock.cBroadcast^blcksock.html#cBroadcast^^ ^0"
+s[284] = "blcksock.c6Localhost^blcksock.html#c6Localhost^^ ^0"
+s[285] = "blcksock.c6AnyHost^blcksock.html#c6AnyHost^^ ^0"
+s[286] = "blcksock.c6Broadcast^blcksock.html#c6Broadcast^^ ^0"
+s[287] = "blcksock.cAnyPort^blcksock.html#cAnyPort^^ ^0"
+s[288] = "blcksock.CR^blcksock.html#CR^^ ^0"
+s[289] = "blcksock.LF^blcksock.html#LF^^ ^0"
+s[290] = "blcksock.CRLF^blcksock.html#CRLF^^ ^0"
+s[291] = "blcksock.c64k^blcksock.html#c64k^^ ^0"
+s[292] = "blcksock.THookSocketReason^blcksock.html#THookSocketReason^^Types of OnStatus events HR_ResolvingBegin Resolving is begin. Resolved IP and port is in parameter in format like: 'localhost.somewhere.com:25'. HR_ResolvingEnd Resolving is done. Resolved IP and port is in parameter in format like: 'localhost.somewhere.com:25'. It is always same as in HR_ResolvingBegin! HR_SocketCreate Socket created by CreateSocket method. It reporting Family of created socket too! HR_SocketClose Socket closed by CloseSocket method. HR_Bind Socket binded to IP and Port. Binded IP and Port is in parameter in format like: 'localhost.somewhere.com:25'. HR_Connect Socket connected to IP and Port. Connected IP and Port is in parameter in format like: 'localhost.somewhere.com:25'. HR_CanRead Called when CanRead method is used with True
result. HR_CanWrite Called when CanWrite method is used with True
result. HR_Listen Socket is swithed to Listen mode. (TCP socket only) HR_Accept Socket Accepting client connection. (TCP socket only) HR_ReadCount report count of bytes readed from socket. Number is in parameter string. If you need is in integer, you must use StrToInt function! HR_WriteCount report count of bytes writed to socket. Number is in parameter string. If you need is in integer, you must use StrToInt function! HR_Wait If is limiting of bandwidth on, then this reason is called when sending or receiving is stopped for satisfy bandwidth limit. Parameter is count of waiting milliseconds. HR_Error report situation where communication error occured. When raiseexcept is True
, then exception is called after this Hook reason. ^0"
+s[293] = "blcksock.THookSocketStatus^blcksock.html#THookSocketStatus^^Procedural type for OnStatus event. Sender is calling TBlockSocket object, Reason is one of set Status events and value is optional data. ^0"
+s[294] = "blcksock.THookDataFilter^blcksock.html#THookDataFilter^^This procedural type is used for DataFilter hooks. ^0"
+s[295] = "blcksock.THookCreateSocket^blcksock.html#THookCreateSocket^^This procedural type is used for hook OnCreateSocket. By this hook you can insert your code after initialisation of socket. (you can set special socket options, etc.) ^0"
+s[296] = "blcksock.THookMonitor^blcksock.html#THookMonitor^^This procedural type is used for monitoring of communication. ^0"
+s[297] = "blcksock.THookAfterConnect^blcksock.html#THookAfterConnect^^This procedural type is used for hook OnAfterConnect. By this hook you can insert your code after TCP socket has been sucessfully connected. ^0"
+s[298] = "blcksock.THookVerifyCert^blcksock.html#THookVerifyCert^^This procedural type is used for hook OnVerifyCert. By this hook you can insert your additional certificate verification code. Usefull to verify server CN against URL. ^0"
+s[299] = "blcksock.THookHeartbeat^blcksock.html#THookHeartbeat^^This procedural type is used for hook OnHeartbeat. By this hook you can call your code repeately during long socket operations. You must enable heartbeats by HeartbeatRate
property! ^0"
+s[300] = "blcksock.TSocketFamily^blcksock.html#TSocketFamily^^Specify family of socket. SF_Any Default mode. Socket family is defined by target address for connection. It allows instant access to IPv4 and IPv6 nodes. When you need IPv6 address as destination, then is used IPv6 mode. othervise is used IPv4 mode. However this mode not working properly with preliminary IPv6 supports! SF_IP4 Turn this class to pure IPv4 mode. This mode is totally compatible with previous Synapse releases. SF_IP6 Turn to only IPv6 mode. ^0"
+s[301] = "blcksock.TSocksType^blcksock.html#TSocksType^^specify possible values of SOCKS modes. ST_Socks5 ST_Socks4 ^0"
+s[302] = "blcksock.TSSLType^blcksock.html#TSSLType^^Specify requested SSL/TLS version for secure connection. LT_all LT_SSLv2 LT_SSLv3 LT_TLSv1 LT_TLSv1_1 LT_SSHv2 ^0"
+s[303] = "blcksock.TSynaOptionType^blcksock.html#TSynaOptionType^^Specify type of socket delayed option. SOT_Linger SOT_RecvBuff SOT_SendBuff SOT_NonBlock SOT_RecvTimeout SOT_SendTimeout SOT_Reuse SOT_TTL SOT_Broadcast SOT_MulticastTTL SOT_MulticastLoop ^0"
+s[304] = "blcksock.TSSLClass^blcksock.html#TSSLClass^^ ^0"
+s[305] = "blcksock.SSLImplementation^blcksock.html#SSLImplementation^^Selected SSL plugin. Default is TSSLNone .
Do not change this value directly!!!
Just add your plugin unit to your project uses instead. Each plugin unit have initialization code what modify this variable. ^0"
+s[306] = "clamsend^clamsend.html^ ClamAV-daemon client^
This unit is capable to do antivirus scan of your data by TCP channel to ClamD daemon from ClamAV. See more about ClamAV on UNKNOWN ^0"
+s[307] = "clamsend.TClamSend^clamsend.TClamSend.html^Implementation of ClamAV-daemon client protocol^ By this class you can scan any your data by ClamAV opensource antivirus.
This class can connect to ClamD by TCP channel, send your data to ClamD and read result. ^0"
+s[308] = "clamsend.TClamSend.Create^clamsend.TClamSend.html#Create^^ ^0"
+s[309] = "clamsend.TClamSend.Destroy^clamsend.TClamSend.html#Destroy^^ ^0"
+s[310] = "clamsend.TClamSend.DoCommand^clamsend.TClamSend.html#DoCommand^^Call any command to ClamD. Used internally by other methods. ^0"
+s[311] = "clamsend.TClamSend.GetVersion^clamsend.TClamSend.html#GetVersion^^Return ClamAV version and version of loaded databases. ^0"
+s[312] = "clamsend.TClamSend.ScanStrings^clamsend.TClamSend.html#ScanStrings^^Scan content of TStrings. ^0"
+s[313] = "clamsend.TClamSend.ScanStream^clamsend.TClamSend.html#ScanStream^^Scan content of TStream. ^0"
+s[314] = "clamsend.TClamSend.ScanStrings2^clamsend.TClamSend.html#ScanStrings2^^Scan content of TStrings by new 0.95 API. ^0"
+s[315] = "clamsend.TClamSend.ScanStream2^clamsend.TClamSend.html#ScanStream2^^Scan content of TStream by new 0.95 API. ^0"
+s[316] = "clamsend.TClamSend.Sock^clamsend.TClamSend.html#Sock^^Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc. ^0"
+s[317] = "clamsend.TClamSend.DSock^clamsend.TClamSend.html#DSock^^Socket object used for TCP data transfer operation. Good for seting OnStatus hook, etc. ^0"
+s[318] = "clamsend.TClamSend.Session^clamsend.TClamSend.html#Session^^Can turn-on session mode of communication with ClamD. Default is False
, because ClamAV developers design their TCP code very badly and session mode is broken now (CVS-20051031). Maybe ClamAV developers fix their bugs and this mode will be possible in future. ^0"
+s[319] = "clamsend.cClamProtocol^clamsend.html#cClamProtocol^^ ^0"
+s[320] = "dnssend^dnssend.html^DNS client by UDP or TCP^ Support for sending DNS queries by UDP or TCP protocol. It can retrieve zone transfers too!
Used RFC: RFC-1035, RFC-1183, RFC1706, RFC1712, RFC2163, RFC2230 ^0"
+s[321] = "dnssend.TDNSSend^dnssend.TDNSSend.html^Implementation of DNS protocol by UDP or TCP protocol.^
Note: Are you missing properties for specify server address and port? Look to parent TSynaClient too! ^0"
+s[322] = "dnssend.TDNSSend.Create^dnssend.TDNSSend.html#Create^^ ^0"
+s[323] = "dnssend.TDNSSend.Destroy^dnssend.TDNSSend.html#Destroy^^ ^0"
+s[324] = "dnssend.TDNSSend.DNSQuery^dnssend.TDNSSend.html#DNSQuery^^Query a DNSHost for QType resources correspond to a name. Supported QType values are: Qtype_A, Qtype_NS, Qtype_MD, Qtype_MF, Qtype_CNAME, Qtype_SOA, Qtype_MB, Qtype_MG, Qtype_MR, Qtype_NULL, Qtype_PTR, Qtype_HINFO, Qtype_MINFO, Qtype_MX, Qtype_TXT, Qtype_RP, Qtype_AFSDB, Qtype_X25, Qtype_ISDN, Qtype_RT, Qtype_NSAP, Qtype_NSAPPTR, Qtype_PX, Qtype_GPOS, Qtype_KX.
Type for zone transfers QTYPE_AXFR is supported too, but only in TCP mode!
"Name" is domain name or host name for queried resource. If "name" is IP address, automatically convert to reverse domain form (.in-addr.arpa).
If result is True
, Reply contains resource records. One record on one line. If Resource record have multiple fields, they are stored on line divided by comma. (example: MX record contains value 'rs.cesnet.cz' with preference number 10, string in Reply is: '10,rs.cesnet.cz'). All numbers or IP address in resource are converted to string form. ^0"
+s[325] = "dnssend.TDNSSend.Sock^dnssend.TDNSSend.html#Sock^^Socket object used for UDP operation. Good for seting OnStatus hook, etc. ^0"
+s[326] = "dnssend.TDNSSend.TCPSock^dnssend.TDNSSend.html#TCPSock^^Socket object used for TCP operation. Good for seting OnStatus hook, etc. ^0"
+s[327] = "dnssend.TDNSSend.UseTCP^dnssend.TDNSSend.html#UseTCP^^if True
, then is used TCP protocol instead UDP. It is needed for zone transfers, etc. ^0"
+s[328] = "dnssend.TDNSSend.RCode^dnssend.TDNSSend.html#RCode^^After DNS operation contains ResultCode of DNS operation. Values are: 0-no error, 1-format error, 2-server failure, 3-name error, 4-not implemented, 5-refused. ^0"
+s[329] = "dnssend.TDNSSend.Authoritative^dnssend.TDNSSend.html#Authoritative^^True
, if answer is authoritative. ^0"
+s[330] = "dnssend.TDNSSend.Truncated^dnssend.TDNSSend.html#Truncated^^True
, if answer is truncated to 512 bytes. ^0"
+s[331] = "dnssend.TDNSSend.AnswerInfo^dnssend.TDNSSend.html#AnswerInfo^^Detailed informations from name server reply. One record per line. Record have comma delimited entries with type number, TTL and data filelds. This information contains detailed information about query reply. ^0"
+s[332] = "dnssend.TDNSSend.NameserverInfo^dnssend.TDNSSend.html#NameserverInfo^^Detailed informations from name server reply. One record per line. Record have comma delimited entries with type number, TTL and data filelds. This information contains detailed information about nameserver. ^0"
+s[333] = "dnssend.TDNSSend.AdditionalInfo^dnssend.TDNSSend.html#AdditionalInfo^^Detailed informations from name server reply. One record per line. Record have comma delimited entries with type number, TTL and data filelds. This information contains detailed additional information. ^0"
+s[334] = "dnssend.cDnsProtocol^dnssend.html#cDnsProtocol^^ ^0"
+s[335] = "dnssend.QTYPE_A^dnssend.html#QTYPE_A^^ ^0"
+s[336] = "dnssend.QTYPE_NS^dnssend.html#QTYPE_NS^^ ^0"
+s[337] = "dnssend.QTYPE_MD^dnssend.html#QTYPE_MD^^ ^0"
+s[338] = "dnssend.QTYPE_MF^dnssend.html#QTYPE_MF^^ ^0"
+s[339] = "dnssend.QTYPE_CNAME^dnssend.html#QTYPE_CNAME^^ ^0"
+s[340] = "dnssend.QTYPE_SOA^dnssend.html#QTYPE_SOA^^ ^0"
+s[341] = "dnssend.QTYPE_MB^dnssend.html#QTYPE_MB^^ ^0"
+s[342] = "dnssend.QTYPE_MG^dnssend.html#QTYPE_MG^^ ^0"
+s[343] = "dnssend.QTYPE_MR^dnssend.html#QTYPE_MR^^ ^0"
+s[344] = "dnssend.QTYPE_NULL^dnssend.html#QTYPE_NULL^^ ^0"
+s[345] = "dnssend.QTYPE_WKS^dnssend.html#QTYPE_WKS^^ ^0"
+s[346] = "dnssend.QTYPE_PTR^dnssend.html#QTYPE_PTR^^ ^0"
+s[347] = "dnssend.QTYPE_HINFO^dnssend.html#QTYPE_HINFO^^ ^0"
+s[348] = "dnssend.QTYPE_MINFO^dnssend.html#QTYPE_MINFO^^ ^0"
+s[349] = "dnssend.QTYPE_MX^dnssend.html#QTYPE_MX^^ ^0"
+s[350] = "dnssend.QTYPE_TXT^dnssend.html#QTYPE_TXT^^ ^0"
+s[351] = "dnssend.QTYPE_RP^dnssend.html#QTYPE_RP^^ ^0"
+s[352] = "dnssend.QTYPE_AFSDB^dnssend.html#QTYPE_AFSDB^^ ^0"
+s[353] = "dnssend.QTYPE_X25^dnssend.html#QTYPE_X25^^ ^0"
+s[354] = "dnssend.QTYPE_ISDN^dnssend.html#QTYPE_ISDN^^ ^0"
+s[355] = "dnssend.QTYPE_RT^dnssend.html#QTYPE_RT^^ ^0"
+s[356] = "dnssend.QTYPE_NSAP^dnssend.html#QTYPE_NSAP^^ ^0"
+s[357] = "dnssend.QTYPE_NSAPPTR^dnssend.html#QTYPE_NSAPPTR^^ ^0"
+s[358] = "dnssend.QTYPE_SIG^dnssend.html#QTYPE_SIG^^ ^0"
+s[359] = "dnssend.QTYPE_KEY^dnssend.html#QTYPE_KEY^^ ^0"
+s[360] = "dnssend.QTYPE_PX^dnssend.html#QTYPE_PX^^ ^0"
+s[361] = "dnssend.QTYPE_GPOS^dnssend.html#QTYPE_GPOS^^ ^0"
+s[362] = "dnssend.QTYPE_AAAA^dnssend.html#QTYPE_AAAA^^ ^0"
+s[363] = "dnssend.QTYPE_LOC^dnssend.html#QTYPE_LOC^^ ^0"
+s[364] = "dnssend.QTYPE_NXT^dnssend.html#QTYPE_NXT^^ ^0"
+s[365] = "dnssend.QTYPE_SRV^dnssend.html#QTYPE_SRV^^ ^0"
+s[366] = "dnssend.QTYPE_NAPTR^dnssend.html#QTYPE_NAPTR^^ ^0"
+s[367] = "dnssend.QTYPE_KX^dnssend.html#QTYPE_KX^^ ^0"
+s[368] = "dnssend.QTYPE_SPF^dnssend.html#QTYPE_SPF^^ ^0"
+s[369] = "dnssend.QTYPE_AXFR^dnssend.html#QTYPE_AXFR^^ ^0"
+s[370] = "dnssend.QTYPE_MAILB^dnssend.html#QTYPE_MAILB^^ ^0"
+s[371] = "dnssend.QTYPE_MAILA^dnssend.html#QTYPE_MAILA^^ ^0"
+s[372] = "dnssend.QTYPE_ALL^dnssend.html#QTYPE_ALL^^ ^0"
+s[373] = "dnssend.GetMailServers^dnssend.html#GetMailServers^^A very useful function, and example of it's use is found in the TDNSSend object. This function is used to get mail servers for a domain and sort them by preference numbers. "Servers" contains only the domain names of the mail servers in the right order (without preference number!). The first domain name will always be the highest preferenced mail server. Returns boolean True
if all went well. ^0"
+s[374] = "ftpsend^ftpsend.html^^ ^0"
+s[375] = "ftpsend.TFTPListRec^ftpsend.TFTPListRec.html^Object for holding file information^ parsed from directory listing of FTP server. ^0"
+s[376] = "ftpsend.TFTPListRec.Assign^ftpsend.TFTPListRec.html#Assign^^You can assign another TFTPListRec to this object. ^0"
+s[377] = "ftpsend.TFTPListRec.FileName^ftpsend.TFTPListRec.html#FileName^^name of file ^0"
+s[378] = "ftpsend.TFTPListRec.Directory^ftpsend.TFTPListRec.html#Directory^^if name is subdirectory not file. ^0"
+s[379] = "ftpsend.TFTPListRec.Readable^ftpsend.TFTPListRec.html#Readable^^if you have rights to read ^0"
+s[380] = "ftpsend.TFTPListRec.FileSize^ftpsend.TFTPListRec.html#FileSize^^size of file in bytes ^0"
+s[381] = "ftpsend.TFTPListRec.FileTime^ftpsend.TFTPListRec.html#FileTime^^date and time of file. Local server timezone is used. Any timezone conversions was not done! ^0"
+s[382] = "ftpsend.TFTPListRec.OriginalLine^ftpsend.TFTPListRec.html#OriginalLine^^original unparsed line ^0"
+s[383] = "ftpsend.TFTPListRec.Mask^ftpsend.TFTPListRec.html#Mask^^mask what was used for parsing ^0"
+s[384] = "ftpsend.TFTPListRec.Permission^ftpsend.TFTPListRec.html#Permission^^permission string (depending on used mask!) ^0"
+s[385] = "ftpsend.TFTPList^ftpsend.TFTPList.html^This is TList of TFTPListRec objects.^ This object is used for holding lististing of all files information in listed directory on FTP server. ^0"
+s[386] = "ftpsend.TFTPList.Create^ftpsend.TFTPList.html#Create^^Constructor. You not need create this object, it is created by TFTPSend class as their property. ^0"
+s[387] = "ftpsend.TFTPList.Destroy^ftpsend.TFTPList.html#Destroy^^ ^0"
+s[388] = "ftpsend.TFTPList.Clear^ftpsend.TFTPList.html#Clear^^Clear list. ^0"
+s[389] = "ftpsend.TFTPList.Count^ftpsend.TFTPList.html#Count^^count of holded TFTPListRec objects ^0"
+s[390] = "ftpsend.TFTPList.Assign^ftpsend.TFTPList.html#Assign^^Assigns one list to another ^0"
+s[391] = "ftpsend.TFTPList.ParseLines^ftpsend.TFTPList.html#ParseLines^^try to parse raw directory listing in Lines to list of TFTPListRec . ^0"
+s[392] = "ftpsend.TFTPList.List^ftpsend.TFTPList.html#List^^By this property you have access to list of TFTPListRec . This is for compatibility only. Please, use Items instead. ^0"
+s[393] = "ftpsend.TFTPList.Items^ftpsend.TFTPList.html#Items^^By this property you have access to list of TFTPListRec . ^0"
+s[394] = "ftpsend.TFTPList.Lines^ftpsend.TFTPList.html#Lines^^Set of lines with RAW directory listing for ParseLines ^0"
+s[395] = "ftpsend.TFTPList.Masks^ftpsend.TFTPList.html#Masks^^Set of masks for directory listing parser. It is predefined by default, however you can modify it as you need. (for example, you can add your own definition mask.) Mask is same as mask used in TotalCommander. ^0"
+s[396] = "ftpsend.TFTPList.UnparsedLines^ftpsend.TFTPList.html#UnparsedLines^^After ParseLines it holding lines what was not sucessfully parsed. ^0"
+s[397] = "ftpsend.TFTPSend^ftpsend.TFTPSend.html^Implementation of FTP protocol.^ Note: Are you missing properties for setting Username and Password? Look to parent TSynaClient object! (Username and Password have default values for "anonymous" FTP login)
Are you missing properties for specify server address and port? Look to parent TSynaClient too! ^0"
+s[398] = "ftpsend.TFTPSend.CustomLogon^ftpsend.TFTPSend.html#CustomLogon^^Custom definition of login sequence. You can use this when you set FWMode to value -1. ^0"
+s[399] = "ftpsend.TFTPSend.Create^ftpsend.TFTPSend.html#Create^^ ^0"
+s[400] = "ftpsend.TFTPSend.Destroy^ftpsend.TFTPSend.html#Destroy^^ ^0"
+s[401] = "ftpsend.TFTPSend.ReadResult^ftpsend.TFTPSend.html#ReadResult^^Waits and read FTP server response. You need this only in special cases! ^0"
+s[402] = "ftpsend.TFTPSend.ParseRemote^ftpsend.TFTPSend.html#ParseRemote^^Parse remote side information of data channel from value string (returned by PASV command). This function you need only in special cases! ^0"
+s[403] = "ftpsend.TFTPSend.ParseRemoteEPSV^ftpsend.TFTPSend.html#ParseRemoteEPSV^^Parse remote side information of data channel from value string (returned by EPSV command). This function you need only in special cases! ^0"
+s[404] = "ftpsend.TFTPSend.FTPCommand^ftpsend.TFTPSend.html#FTPCommand^^Send Value as FTP command to FTP server. Returned result code is result of this function. This command is good for sending site specific command, or non-standard commands. ^0"
+s[405] = "ftpsend.TFTPSend.Login^ftpsend.TFTPSend.html#Login^^Connect and logon to FTP server. If you specify any FireWall, connect to firewall and throw them connect to FTP server. Login sequence depending on FWMode . ^0"
+s[406] = "ftpsend.TFTPSend.Logout^ftpsend.TFTPSend.html#Logout^^Logoff and disconnect from FTP server. ^0"
+s[407] = "ftpsend.TFTPSend.Abort^ftpsend.TFTPSend.html#Abort^^Break current transmission of data. (You can call this method from Sock.OnStatus event, or from another thread.) ^0"
+s[408] = "ftpsend.TFTPSend.TelnetAbort^ftpsend.TFTPSend.html#TelnetAbort^^Break current transmission of data. It is same as Abort, but it send abort telnet commands prior ABOR FTP command. Some servers need it. (You can call this method from Sock.OnStatus event, or from another thread.) ^0"
+s[409] = "ftpsend.TFTPSend.List^ftpsend.TFTPSend.html#List^^Download directory listing of Directory on FTP server. If Directory is empty string, download listing of current working directory. If NameList is True
, download only names of files in directory. (internally use NLST command instead LIST command) If NameList is False
, returned list is also parsed to FtpList property. ^0"
+s[410] = "ftpsend.TFTPSend.RetrieveFile^ftpsend.TFTPSend.html#RetrieveFile^^Read data from FileName on FTP server. If Restore is True
and server supports resume dowloads, download is resumed. (received is only rest of file) ^0"
+s[411] = "ftpsend.TFTPSend.StoreFile^ftpsend.TFTPSend.html#StoreFile^^Send data to FileName on FTP server. If Restore is True
and server supports resume upload, upload is resumed. (send only rest of file) In this case if remote file is same length as local file, nothing will be done. If remote file is larger then local, resume is disabled and file is transfered from begin! ^0"
+s[412] = "ftpsend.TFTPSend.StoreUniqueFile^ftpsend.TFTPSend.html#StoreUniqueFile^^Send data to FTP server and assing unique name for this file. ^0"
+s[413] = "ftpsend.TFTPSend.AppendFile^ftpsend.TFTPSend.html#AppendFile^^Append data to FileName on FTP server. ^0"
+s[414] = "ftpsend.TFTPSend.RenameFile^ftpsend.TFTPSend.html#RenameFile^^Rename on FTP server file with OldName to NewName. ^0"
+s[415] = "ftpsend.TFTPSend.DeleteFile^ftpsend.TFTPSend.html#DeleteFile^^Delete file FileName on FTP server. ^0"
+s[416] = "ftpsend.TFTPSend.FileSize^ftpsend.TFTPSend.html#FileSize^^Return size of Filename file on FTP server. If command failed (i.e. not implemented), return -1. ^0"
+s[417] = "ftpsend.TFTPSend.NoOp^ftpsend.TFTPSend.html#NoOp^^Send NOOP command to FTP server for preserve of disconnect by inactivity timeout. ^0"
+s[418] = "ftpsend.TFTPSend.ChangeWorkingDir^ftpsend.TFTPSend.html#ChangeWorkingDir^^Change currect working directory to Directory on FTP server. ^0"
+s[419] = "ftpsend.TFTPSend.ChangeToParentDir^ftpsend.TFTPSend.html#ChangeToParentDir^^walk to upper directory on FTP server. ^0"
+s[420] = "ftpsend.TFTPSend.ChangeToRootDir^ftpsend.TFTPSend.html#ChangeToRootDir^^walk to root directory on FTP server. (May not work with all servers properly!) ^0"
+s[421] = "ftpsend.TFTPSend.DeleteDir^ftpsend.TFTPSend.html#DeleteDir^^Delete Directory on FTP server. ^0"
+s[422] = "ftpsend.TFTPSend.CreateDir^ftpsend.TFTPSend.html#CreateDir^^Create Directory on FTP server. ^0"
+s[423] = "ftpsend.TFTPSend.GetCurrentDir^ftpsend.TFTPSend.html#GetCurrentDir^^Return current working directory on FTP server. ^0"
+s[424] = "ftpsend.TFTPSend.DataRead^ftpsend.TFTPSend.html#DataRead^^Establish data channel to FTP server and retrieve data. This function you need only in special cases, i.e. when you need to implement some special unsupported FTP command! ^0"
+s[425] = "ftpsend.TFTPSend.DataWrite^ftpsend.TFTPSend.html#DataWrite^^Establish data channel to FTP server and send data. This function you need only in special cases, i.e. when you need to implement some special unsupported FTP command. ^0"
+s[426] = "ftpsend.TFTPSend.ResultCode^ftpsend.TFTPSend.html#ResultCode^^After FTP command contains result number of this operation. ^0"
+s[427] = "ftpsend.TFTPSend.ResultString^ftpsend.TFTPSend.html#ResultString^^After FTP command contains main line of result. ^0"
+s[428] = "ftpsend.TFTPSend.FullResult^ftpsend.TFTPSend.html#FullResult^^After any FTP command it contains all lines of FTP server reply. ^0"
+s[429] = "ftpsend.TFTPSend.Account^ftpsend.TFTPSend.html#Account^^Account information used in some cases inside login sequence. ^0"
+s[430] = "ftpsend.TFTPSend.FWHost^ftpsend.TFTPSend.html#FWHost^^Address of firewall. If empty string (default), firewall not used. ^0"
+s[431] = "ftpsend.TFTPSend.FWPort^ftpsend.TFTPSend.html#FWPort^^port of firewall. standard value is same port as ftp server used. (21) ^0"
+s[432] = "ftpsend.TFTPSend.FWUsername^ftpsend.TFTPSend.html#FWUsername^^Username for login to firewall. (if needed) ^0"
+s[433] = "ftpsend.TFTPSend.FWPassword^ftpsend.TFTPSend.html#FWPassword^^password for login to firewall. (if needed) ^0"
+s[434] = "ftpsend.TFTPSend.FWMode^ftpsend.TFTPSend.html#FWMode^^Type of Firewall. Used only if you set some firewall address. Supported predefined firewall login sequences are described by comments in source file where you can see pseudocode decribing each sequence. ^0"
+s[435] = "ftpsend.TFTPSend.Sock^ftpsend.TFTPSend.html#Sock^^Socket object used for TCP/IP operation on control channel. Good for seting OnStatus hook, etc. ^0"
+s[436] = "ftpsend.TFTPSend.DSock^ftpsend.TFTPSend.html#DSock^^Socket object used for TCP/IP operation on data channel. Good for seting OnStatus hook, etc. ^0"
+s[437] = "ftpsend.TFTPSend.DataStream^ftpsend.TFTPSend.html#DataStream^^If you not use DirectFile mode, all data transfers is made to or from this stream. ^0"
+s[438] = "ftpsend.TFTPSend.DataIP^ftpsend.TFTPSend.html#DataIP^^After data connection is established, contains remote side IP of this connection. ^0"
+s[439] = "ftpsend.TFTPSend.DataPort^ftpsend.TFTPSend.html#DataPort^^After data connection is established, contains remote side port of this connection. ^0"
+s[440] = "ftpsend.TFTPSend.DirectFile^ftpsend.TFTPSend.html#DirectFile^^Mode of data handling by data connection. If False
, all data operations are made to or from DataStream TMemoryStream. If True
, data operations is made directly to file in your disk. (filename is specified by DirectFileName property.) Dafault is False
! ^0"
+s[441] = "ftpsend.TFTPSend.DirectFileName^ftpsend.TFTPSend.html#DirectFileName^^Filename for direct disk data operations. ^0"
+s[442] = "ftpsend.TFTPSend.CanResume^ftpsend.TFTPSend.html#CanResume^^Indicate after Login if remote server support resume downloads and uploads. ^0"
+s[443] = "ftpsend.TFTPSend.PassiveMode^ftpsend.TFTPSend.html#PassiveMode^^If true (default value), all transfers is made by passive method. It is safer method for various firewalls. ^0"
+s[444] = "ftpsend.TFTPSend.ForceDefaultPort^ftpsend.TFTPSend.html#ForceDefaultPort^^Force to listen for dataconnection on standard port (20). Default is False
, dataconnections will be made to any non-standard port reported by PORT FTP command. This setting is not used, if you use passive mode. ^0"
+s[445] = "ftpsend.TFTPSend.ForceOldPort^ftpsend.TFTPSend.html#ForceOldPort^^When is True
, then is disabled EPSV and EPRT support. However without this commands you cannot use IPv6! (Disabling of this commands is needed only when you are behind some crap firewall/NAT. ^0"
+s[446] = "ftpsend.TFTPSend.OnStatus^ftpsend.TFTPSend.html#OnStatus^^You may set this hook for monitoring FTP commands and replies. ^0"
+s[447] = "ftpsend.TFTPSend.FtpList^ftpsend.TFTPSend.html#FtpList^^After LIST command is here parsed list of files in given directory. ^0"
+s[448] = "ftpsend.TFTPSend.BinaryMode^ftpsend.TFTPSend.html#BinaryMode^^if True
(default), then data transfers is in binary mode. If this is set to False
, then ASCII mode is used. ^0"
+s[449] = "ftpsend.TFTPSend.AutoTLS^ftpsend.TFTPSend.html#AutoTLS^^if is true, then if server support upgrade to SSL/TLS mode, then use them. ^0"
+s[450] = "ftpsend.TFTPSend.FullSSL^ftpsend.TFTPSend.html#FullSSL^^if server listen on SSL/TLS port, then you set this to true. ^0"
+s[451] = "ftpsend.TFTPSend.IsTLS^ftpsend.TFTPSend.html#IsTLS^^Signalise, if control channel is in SSL/TLS mode. ^0"
+s[452] = "ftpsend.TFTPSend.IsDataTLS^ftpsend.TFTPSend.html#IsDataTLS^^Signalise, if data transfers is in SSL/TLS mode. ^0"
+s[453] = "ftpsend.TFTPSend.TLSonData^ftpsend.TFTPSend.html#TLSonData^^If True
(default), then try to use SSL/TLS on data transfers too. If False
, then SSL/TLS is used only for control connection. ^0"
+s[454] = "ftpsend.cFtpProtocol^ftpsend.html#cFtpProtocol^^ ^0"
+s[455] = "ftpsend.cFtpDataProtocol^ftpsend.html#cFtpDataProtocol^^ ^0"
+s[456] = "ftpsend.FTP_OK^ftpsend.html#FTP_OK^^Terminating value for TLogonActions ^0"
+s[457] = "ftpsend.FTP_ERR^ftpsend.html#FTP_ERR^^Terminating value for TLogonActions ^0"
+s[458] = "ftpsend.FtpGetFile^ftpsend.html#FtpGetFile^^A very useful function, and example of use can be found in the TFtpSend object. Dowload specified file from FTP server to LocalFile. ^0"
+s[459] = "ftpsend.FtpPutFile^ftpsend.html#FtpPutFile^^A very useful function, and example of use can be found in the TFtpSend object. Upload specified LocalFile to FTP server. ^0"
+s[460] = "ftpsend.FtpInterServerTransfer^ftpsend.html#FtpInterServerTransfer^^A very useful function, and example of use can be found in the TFtpSend object. Initiate transfer of file between two FTP servers. ^0"
+s[461] = "ftpsend.TLogonActions^ftpsend.html#TLogonActions^^Array for holding definition of logon sequence. ^0"
+s[462] = "ftpsend.TFTPStatus^ftpsend.html#TFTPStatus^^Procedural type for OnStatus event. Sender is calling TFTPSend object. Value is FTP command or reply to this comand. (if it is reply, Response is True
). ^0"
+s[463] = "ftptsend^ftptsend.html^TFTP client and server protocol^
Used RFC: RFC-1350 ^0"
+s[464] = "ftptsend.TTFTPSend^ftptsend.TTFTPSend.html^Implementation of TFTP client and server^ Note: Are you missing properties for specify server address and port? Look to parent TSynaClient too! ^0"
+s[465] = "ftptsend.TTFTPSend.Create^ftptsend.TTFTPSend.html#Create^^ ^0"
+s[466] = "ftptsend.TTFTPSend.Destroy^ftptsend.TTFTPSend.html#Destroy^^ ^0"
+s[467] = "ftptsend.TTFTPSend.SendFile^ftptsend.TTFTPSend.html#SendFile^^Upload Data as file to TFTP server. ^0"
+s[468] = "ftptsend.TTFTPSend.RecvFile^ftptsend.TTFTPSend.html#RecvFile^^Download file from TFTP server to Data . ^0"
+s[469] = "ftptsend.TTFTPSend.WaitForRequest^ftptsend.TTFTPSend.html#WaitForRequest^^Acts as TFTP server and wait for client request. When some request incoming within Timeout, result is True
and parametres is filled with information from request. You must handle this request, validate it, and call ReplyError , ReplyRecv or ReplySend for send reply to TFTP Client. ^0"
+s[470] = "ftptsend.TTFTPSend.ReplyError^ftptsend.TTFTPSend.html#ReplyError^^send error to TFTP client, when you acts as TFTP server. ^0"
+s[471] = "ftptsend.TTFTPSend.ReplyRecv^ftptsend.TTFTPSend.html#ReplyRecv^^Accept uploaded file from TFTP client to Data , when you acts as TFTP server. ^0"
+s[472] = "ftptsend.TTFTPSend.ReplySend^ftptsend.TTFTPSend.html#ReplySend^^Accept download request file from TFTP client and send content of Data , when you acts as TFTP server. ^0"
+s[473] = "ftptsend.TTFTPSend.ErrorCode^ftptsend.TTFTPSend.html#ErrorCode^^Code of TFTP error. ^0"
+s[474] = "ftptsend.TTFTPSend.ErrorString^ftptsend.TTFTPSend.html#ErrorString^^Human readable decription of TFTP error. (if is sended by remote side) ^0"
+s[475] = "ftptsend.TTFTPSend.Data^ftptsend.TTFTPSend.html#Data^^MemoryStream with datas for sending or receiving ^0"
+s[476] = "ftptsend.TTFTPSend.RequestIP^ftptsend.TTFTPSend.html#RequestIP^^Address of TFTP remote side. ^0"
+s[477] = "ftptsend.TTFTPSend.RequestPort^ftptsend.TTFTPSend.html#RequestPort^^Port of TFTP remote side. ^0"
+s[478] = "ftptsend.cTFTPProtocol^ftptsend.html#cTFTPProtocol^^ ^0"
+s[479] = "ftptsend.cTFTP_RRQ^ftptsend.html#cTFTP_RRQ^^ ^0"
+s[480] = "ftptsend.cTFTP_WRQ^ftptsend.html#cTFTP_WRQ^^ ^0"
+s[481] = "ftptsend.cTFTP_DTA^ftptsend.html#cTFTP_DTA^^ ^0"
+s[482] = "ftptsend.cTFTP_ACK^ftptsend.html#cTFTP_ACK^^ ^0"
+s[483] = "ftptsend.cTFTP_ERR^ftptsend.html#cTFTP_ERR^^ ^0"
+s[484] = "httpsend^httpsend.html^^ ^0"
+s[485] = "httpsend.THTTPSend^httpsend.THTTPSend.html^^abstract(Implementation of HTTP protocol.) ^0"
+s[486] = "httpsend.THTTPSend.Create^httpsend.THTTPSend.html#Create^^ ^0"
+s[487] = "httpsend.THTTPSend.Destroy^httpsend.THTTPSend.html#Destroy^^ ^0"
+s[488] = "httpsend.THTTPSend.Clear^httpsend.THTTPSend.html#Clear^^Reset headers and document and Mimetype. ^0"
+s[489] = "httpsend.THTTPSend.DecodeStatus^httpsend.THTTPSend.html#DecodeStatus^^Decode ResultCode and ResultString from Value. ^0"
+s[490] = "httpsend.THTTPSend.HTTPMethod^httpsend.THTTPSend.html#HTTPMethod^^Connects to host define in URL and access to resource defined in URL by method. If Document is not empty, send it to server as part of HTTP request. Server response is in Document and headers. Connection may be authorised by username and password in URL. If you define proxy properties, connection is made by this proxy. If all OK, result is True
, else result is False
.
If you use in URL 'https:' instead only 'http:', then your request is made by SSL/TLS connection (if you not specify port, then port 443 is used instead standard port 80). If you use SSL/TLS request and you have defined HTTP proxy, then HTTP-tunnel mode is automaticly used . ^0"
+s[491] = "httpsend.THTTPSend.Abort^httpsend.THTTPSend.html#Abort^^You can call this method from OnStatus event for break current data transfer. (or from another thread.) ^0"
+s[492] = "httpsend.THTTPSend.Headers^httpsend.THTTPSend.html#Headers^^Before HTTP operation you may define any non-standard headers for HTTP request, except of: 'Expect: 100-continue', 'Content-Length', 'Content-Type', 'Connection', 'Authorization', 'Proxy-Authorization' and 'Host' headers. After HTTP operation contains full headers of returned document. ^0"
+s[493] = "httpsend.THTTPSend.Cookies^httpsend.THTTPSend.html#Cookies^^This is stringlist with name-value stringlist pairs. Each this pair is one cookie. After HTTP request is returned cookies parsed to this stringlist. You can leave this cookies untouched for next HTTP request. You can also save this stringlist for later use. ^0"
+s[494] = "httpsend.THTTPSend.Document^httpsend.THTTPSend.html#Document^^Stream with document to send (before request, or with document received from HTTP server (after request). ^0"
+s[495] = "httpsend.THTTPSend.RangeStart^httpsend.THTTPSend.html#RangeStart^^If you need download only part of requested document, here specify possition of subpart begin. If here 0, then is requested full document. ^0"
+s[496] = "httpsend.THTTPSend.RangeEnd^httpsend.THTTPSend.html#RangeEnd^^If you need download only part of requested document, here specify possition of subpart end. If here 0, then is requested document from rangeStart to end of document. (for broken download restoration, for example.) ^0"
+s[497] = "httpsend.THTTPSend.MimeType^httpsend.THTTPSend.html#MimeType^^Mime type of sending data. Default is: 'text/html'. ^0"
+s[498] = "httpsend.THTTPSend.Protocol^httpsend.THTTPSend.html#Protocol^^Define protocol version. Possible values are: '1.1', '1.0' (default) and '0.9'. ^0"
+s[499] = "httpsend.THTTPSend.KeepAlive^httpsend.THTTPSend.html#KeepAlive^^If True
(default value), keepalives in HTTP protocol 1.1 is enabled. ^0"
+s[500] = "httpsend.THTTPSend.KeepAliveTimeout^httpsend.THTTPSend.html#KeepAliveTimeout^^Define timeout for keepalives in seconds! ^0"
+s[501] = "httpsend.THTTPSend.Status100^httpsend.THTTPSend.html#Status100^^if True
, then server is requested for 100status capability when uploading data. Default is False
(off). ^0"
+s[502] = "httpsend.THTTPSend.ProxyHost^httpsend.THTTPSend.html#ProxyHost^^Address of proxy server (IP address or domain name) where you want to connect in HTTPMethod method. ^0"
+s[503] = "httpsend.THTTPSend.ProxyPort^httpsend.THTTPSend.html#ProxyPort^^Port number for proxy connection. Default value is 8080. ^0"
+s[504] = "httpsend.THTTPSend.ProxyUser^httpsend.THTTPSend.html#ProxyUser^^Username for connect to proxy server where you want to connect in HTTPMethod method. ^0"
+s[505] = "httpsend.THTTPSend.ProxyPass^httpsend.THTTPSend.html#ProxyPass^^Password for connect to proxy server where you want to connect in HTTPMethod method. ^0"
+s[506] = "httpsend.THTTPSend.UserAgent^httpsend.THTTPSend.html#UserAgent^^Here you can specify custom User-Agent indentification. By default is used: 'Mozilla/4.0 (compatible; Synapse)' ^0"
+s[507] = "httpsend.THTTPSend.ResultCode^httpsend.THTTPSend.html#ResultCode^^After successful HTTPMethod method contains result code of operation. ^0"
+s[508] = "httpsend.THTTPSend.ResultString^httpsend.THTTPSend.html#ResultString^^After successful HTTPMethod method contains string after result code. ^0"
+s[509] = "httpsend.THTTPSend.DownloadSize^httpsend.THTTPSend.html#DownloadSize^^if this value is not 0, then data download pending. In this case you have here total sice of downloaded data. It is good for draw download progressbar from OnStatus event. ^0"
+s[510] = "httpsend.THTTPSend.UploadSize^httpsend.THTTPSend.html#UploadSize^^if this value is not 0, then data upload pending. In this case you have here total sice of uploaded data. It is good for draw upload progressbar from OnStatus event. ^0"
+s[511] = "httpsend.THTTPSend.Sock^httpsend.THTTPSend.html#Sock^^Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc. ^0"
+s[512] = "httpsend.THTTPSend.AddPortNumberToHost^httpsend.THTTPSend.html#AddPortNumberToHost^^To have possibility to switch off port number in 'Host:' HTTP header, by default True
. Some buggy servers not like port informations in this header. ^0"
+s[513] = "httpsend.cHttpProtocol^httpsend.html#cHttpProtocol^^ ^0"
+s[514] = "httpsend.HttpGetText^httpsend.html#HttpGetText^^A very usefull function, and example of use can be found in the THTTPSend object. It implements the GET method of the HTTP protocol. This function sends the GET method for URL document to an HTTP server. Returned document is in the "Response" stringlist (without any headers). Returns boolean TRUE if all went well. ^0"
+s[515] = "httpsend.HttpGetBinary^httpsend.html#HttpGetBinary^^A very usefull function, and example of use can be found in the THTTPSend object. It implements the GET method of the HTTP protocol. This function sends the GET method for URL document to an HTTP server. Returned document is in the "Response" stream. Returns boolean TRUE if all went well. ^0"
+s[516] = "httpsend.HttpPostBinary^httpsend.html#HttpPostBinary^^A very useful function, and example of use can be found in the THTTPSend object. It implements the POST method of the HTTP protocol. This function sends the SEND method for a URL document to an HTTP server. The document to be sent is located in "Data" stream. The returned document is in the "Data" stream. Returns boolean TRUE if all went well. ^0"
+s[517] = "httpsend.HttpPostURL^httpsend.html#HttpPostURL^^A very useful function, and example of use can be found in the THTTPSend object. It implements the POST method of the HTTP protocol. This function is good for POSTing form data. It sends the POST method for a URL document to an HTTP server. You must prepare the form data in the same manner as you would the URL data, and pass this prepared data to "URLdata". The following is a sample of how the data would appear: 'name=Lukas&field1=some%20data'. The information in the field must be encoded by EncodeURLElement function. The returned document is in the "Data" stream. Returns boolean TRUE if all went well. ^0"
+s[518] = "httpsend.HttpPostFile^httpsend.html#HttpPostFile^^A very useful function, and example of use can be found in the THTTPSend object. It implements the POST method of the HTTP protocol. This function sends the POST method for a URL document to an HTTP server. This function simulate posting of file by HTML form used method 'multipart/form-data'. Posting file is in DATA stream. Its name is Filename string. Fieldname is for name of formular field with file. (simulate HTML INPUT FILE) The returned document is in the ResultData Stringlist. Returns boolean TRUE if all went well. ^0"
+s[519] = "httpsend.TTransferEncoding^httpsend.html#TTransferEncoding^^These encoding types are used internally by the THTTPSend object to identify the transfer data types. TE_UNKNOWN TE_IDENTITY TE_CHUNKED ^0"
+s[520] = "imapsend^imapsend.html^IMAP4 rev1 protocol client^
Used RFC: RFC-2060, RFC-2595 ^0"
+s[521] = "imapsend.TIMAPSend^imapsend.TIMAPSend.html^Implementation of IMAP4 protocol.^ Note: Are you missing properties for setting Username and Password? Look to parent TSynaClient object!
Are you missing properties for specify server address and port? Look to parent TSynaClient too! ^0"
+s[522] = "imapsend.TIMAPSend.Create^imapsend.TIMAPSend.html#Create^^ ^0"
+s[523] = "imapsend.TIMAPSend.Destroy^imapsend.TIMAPSend.html#Destroy^^ ^0"
+s[524] = "imapsend.TIMAPSend.IMAPcommand^imapsend.TIMAPSend.html#IMAPcommand^^By this function you can call any IMAP command. Result of this command is in adequate properties. ^0"
+s[525] = "imapsend.TIMAPSend.IMAPuploadCommand^imapsend.TIMAPSend.html#IMAPuploadCommand^^By this function you can call any IMAP command what need upload any data. Result of this command is in adequate properties. ^0"
+s[526] = "imapsend.TIMAPSend.Capability^imapsend.TIMAPSend.html#Capability^^Call CAPABILITY command and fill IMAPcap property by new values. ^0"
+s[527] = "imapsend.TIMAPSend.Login^imapsend.TIMAPSend.html#Login^^Connect to IMAP server and do login to this server. This command begin session. ^0"
+s[528] = "imapsend.TIMAPSend.Logout^imapsend.TIMAPSend.html#Logout^^Disconnect from IMAP server and terminate session session. If exists some deleted and non-purged messages, these messages are not deleted! ^0"
+s[529] = "imapsend.TIMAPSend.NoOp^imapsend.TIMAPSend.html#NoOp^^Do NOOP. It is for prevent disconnect by timeout. ^0"
+s[530] = "imapsend.TIMAPSend.List^imapsend.TIMAPSend.html#List^^Lists folder names. You may specify level of listing. If you specify FromFolder as empty string, return is all folders in system. ^0"
+s[531] = "imapsend.TIMAPSend.ListSearch^imapsend.TIMAPSend.html#ListSearch^^Lists folder names what match search criteria. You may specify level of listing. If you specify FromFolder as empty string, return is all folders in system. ^0"
+s[532] = "imapsend.TIMAPSend.ListSubscribed^imapsend.TIMAPSend.html#ListSubscribed^^Lists subscribed folder names. You may specify level of listing. If you specify FromFolder as empty string, return is all subscribed folders in system. ^0"
+s[533] = "imapsend.TIMAPSend.ListSearchSubscribed^imapsend.TIMAPSend.html#ListSearchSubscribed^^Lists subscribed folder names what matching search criteria. You may specify level of listing. If you specify FromFolder as empty string, return is all subscribed folders in system. ^0"
+s[534] = "imapsend.TIMAPSend.CreateFolder^imapsend.TIMAPSend.html#CreateFolder^^Create a new folder. ^0"
+s[535] = "imapsend.TIMAPSend.DeleteFolder^imapsend.TIMAPSend.html#DeleteFolder^^Delete a folder. ^0"
+s[536] = "imapsend.TIMAPSend.RenameFolder^imapsend.TIMAPSend.html#RenameFolder^^Rename folder names. ^0"
+s[537] = "imapsend.TIMAPSend.SubscribeFolder^imapsend.TIMAPSend.html#SubscribeFolder^^Subscribe folder. ^0"
+s[538] = "imapsend.TIMAPSend.UnsubscribeFolder^imapsend.TIMAPSend.html#UnsubscribeFolder^^Unsubscribe folder. ^0"
+s[539] = "imapsend.TIMAPSend.SelectFolder^imapsend.TIMAPSend.html#SelectFolder^^Select folder. ^0"
+s[540] = "imapsend.TIMAPSend.SelectROFolder^imapsend.TIMAPSend.html#SelectROFolder^^Select folder, but only for reading. Any changes are not allowed! ^0"
+s[541] = "imapsend.TIMAPSend.CloseFolder^imapsend.TIMAPSend.html#CloseFolder^^Close a folder. (end of Selected state) ^0"
+s[542] = "imapsend.TIMAPSend.StatusFolder^imapsend.TIMAPSend.html#StatusFolder^^Ask for given status of folder. I.e. if you specify as value 'UNSEEN', result is number of unseen messages in folder. For another status indentificator check IMAP documentation and documentation of your IMAP server (each IMAP server can have their own statuses.) ^0"
+s[543] = "imapsend.TIMAPSend.ExpungeFolder^imapsend.TIMAPSend.html#ExpungeFolder^^Hardly delete all messages marked as 'deleted' in current selected folder. ^0"
+s[544] = "imapsend.TIMAPSend.CheckFolder^imapsend.TIMAPSend.html#CheckFolder^^Touch to folder. (use as update status of folder, etc.) ^0"
+s[545] = "imapsend.TIMAPSend.AppendMess^imapsend.TIMAPSend.html#AppendMess^^Append given message to specified folder. ^0"
+s[546] = "imapsend.TIMAPSend.DeleteMess^imapsend.TIMAPSend.html#DeleteMess^^'Delete' message from current selected folder. It mark message as Deleted. Real deleting will be done after sucessfull CloseFolder or ExpungeFolder ^0"
+s[547] = "imapsend.TIMAPSend.FetchMess^imapsend.TIMAPSend.html#FetchMess^^Get full message from specified message in selected folder. ^0"
+s[548] = "imapsend.TIMAPSend.FetchHeader^imapsend.TIMAPSend.html#FetchHeader^^Get message headers only from specified message in selected folder. ^0"
+s[549] = "imapsend.TIMAPSend.MessageSize^imapsend.TIMAPSend.html#MessageSize^^Return message size of specified message from current selected folder. ^0"
+s[550] = "imapsend.TIMAPSend.CopyMess^imapsend.TIMAPSend.html#CopyMess^^Copy message from current selected folder to another folder. ^0"
+s[551] = "imapsend.TIMAPSend.SearchMess^imapsend.TIMAPSend.html#SearchMess^^Return message numbers from currently selected folder as result of searching. Search criteria is very complex language (see to IMAP specification) similar to SQL (but not same syntax!). ^0"
+s[552] = "imapsend.TIMAPSend.SetFlagsMess^imapsend.TIMAPSend.html#SetFlagsMess^^Sets flags of message from current selected folder. ^0"
+s[553] = "imapsend.TIMAPSend.GetFlagsMess^imapsend.TIMAPSend.html#GetFlagsMess^^Gets flags of message from current selected folder. ^0"
+s[554] = "imapsend.TIMAPSend.AddFlagsMess^imapsend.TIMAPSend.html#AddFlagsMess^^Add flags to message's flags. ^0"
+s[555] = "imapsend.TIMAPSend.DelFlagsMess^imapsend.TIMAPSend.html#DelFlagsMess^^Remove flags from message's flags. ^0"
+s[556] = "imapsend.TIMAPSend.StartTLS^imapsend.TIMAPSend.html#StartTLS^^Call STARTTLS command for upgrade connection to SSL/TLS mode. ^0"
+s[557] = "imapsend.TIMAPSend.GetUID^imapsend.TIMAPSend.html#GetUID^^return UID of requested message ID. ^0"
+s[558] = "imapsend.TIMAPSend.FindCap^imapsend.TIMAPSend.html#FindCap^^Try to find given capabily in capabilty string returned from IMAP server. ^0"
+s[559] = "imapsend.TIMAPSend.ResultString^imapsend.TIMAPSend.html#ResultString^^Status line with result of last operation. ^0"
+s[560] = "imapsend.TIMAPSend.FullResult^imapsend.TIMAPSend.html#FullResult^^Full result of last IMAP operation. ^0"
+s[561] = "imapsend.TIMAPSend.IMAPcap^imapsend.TIMAPSend.html#IMAPcap^^List of server capabilites. ^0"
+s[562] = "imapsend.TIMAPSend.AuthDone^imapsend.TIMAPSend.html#AuthDone^^Authorization is successful done. ^0"
+s[563] = "imapsend.TIMAPSend.UID^imapsend.TIMAPSend.html#UID^^Turn on or off usage of UID (unicate identificator) of messages instead only sequence numbers. ^0"
+s[564] = "imapsend.TIMAPSend.SelectedFolder^imapsend.TIMAPSend.html#SelectedFolder^^Name of currently selected folder. ^0"
+s[565] = "imapsend.TIMAPSend.SelectedCount^imapsend.TIMAPSend.html#SelectedCount^^Count of messages in currently selected folder. ^0"
+s[566] = "imapsend.TIMAPSend.SelectedRecent^imapsend.TIMAPSend.html#SelectedRecent^^Count of not-visited messages in currently selected folder. ^0"
+s[567] = "imapsend.TIMAPSend.SelectedUIDvalidity^imapsend.TIMAPSend.html#SelectedUIDvalidity^^This number with name of folder is unique indentificator of folder. (If someone delete folder and next create new folder with exactly same name of folder, this number is must be different!) ^0"
+s[568] = "imapsend.TIMAPSend.AutoTLS^imapsend.TIMAPSend.html#AutoTLS^^If is set to true, then upgrade to SSL/TLS mode if remote server support it. ^0"
+s[569] = "imapsend.TIMAPSend.FullSSL^imapsend.TIMAPSend.html#FullSSL^^SSL/TLS mode is used from first contact to server. Servers with full SSL/TLS mode usualy using non-standard TCP port! ^0"
+s[570] = "imapsend.TIMAPSend.Sock^imapsend.TIMAPSend.html#Sock^^Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc. ^0"
+s[571] = "imapsend.cIMAPProtocol^imapsend.html#cIMAPProtocol^^ ^0"
+s[572] = "laz_synapse^laz_synapse.html^^ ^0"
+s[573] = "ldapsend^ldapsend.html^LDAP client^
Used RFC: RFC-2251, RFC-2254, RFC-2829, RFC-2830 ^0"
+s[574] = "ldapsend.TLDAPAttribute^ldapsend.TLDAPAttribute.html^LDAP attribute with list of their values^ This class holding name of LDAP attribute and list of their values. This is descendant of TStringList class enhanced by some new properties. ^0"
+s[575] = "ldapsend.TLDAPAttribute.AttributeName^ldapsend.TLDAPAttribute.html#AttributeName^^Name of LDAP attribute. ^0"
+s[576] = "ldapsend.TLDAPAttribute.IsBinary^ldapsend.TLDAPAttribute.html#IsBinary^^Return True
when attribute contains binary data. ^0"
+s[577] = "ldapsend.TLDAPAttributeList^ldapsend.TLDAPAttributeList.html^List of TLDAPAttribute ^ This object can hold list of TLDAPAttribute objects. ^0"
+s[578] = "ldapsend.TLDAPAttributeList.Create^ldapsend.TLDAPAttributeList.html#Create^^ ^0"
+s[579] = "ldapsend.TLDAPAttributeList.Destroy^ldapsend.TLDAPAttributeList.html#Destroy^^ ^0"
+s[580] = "ldapsend.TLDAPAttributeList.Clear^ldapsend.TLDAPAttributeList.html#Clear^^Clear list. ^0"
+s[581] = "ldapsend.TLDAPAttributeList.Count^ldapsend.TLDAPAttributeList.html#Count^^Return count of TLDAPAttribute objects in list. ^0"
+s[582] = "ldapsend.TLDAPAttributeList.Add^ldapsend.TLDAPAttributeList.html#Add^^Add new TLDAPAttribute object to list. ^0"
+s[583] = "ldapsend.TLDAPAttributeList.Del^ldapsend.TLDAPAttributeList.html#Del^^Delete one TLDAPAttribute object from list. ^0"
+s[584] = "ldapsend.TLDAPAttributeList.Find^ldapsend.TLDAPAttributeList.html#Find^^Find and return attribute with requested name. Returns nil if not found. ^0"
+s[585] = "ldapsend.TLDAPAttributeList.Get^ldapsend.TLDAPAttributeList.html#Get^^Find and return attribute value with requested name. Returns empty string if not found. ^0"
+s[586] = "ldapsend.TLDAPAttributeList.Items^ldapsend.TLDAPAttributeList.html#Items^^List of TLDAPAttribute objects. ^0"
+s[587] = "ldapsend.TLDAPResult^ldapsend.TLDAPResult.html^LDAP result object^ This object can hold LDAP object. (their name and all their attributes with values) ^0"
+s[588] = "ldapsend.TLDAPResult.Create^ldapsend.TLDAPResult.html#Create^^ ^0"
+s[589] = "ldapsend.TLDAPResult.Destroy^ldapsend.TLDAPResult.html#Destroy^^ ^0"
+s[590] = "ldapsend.TLDAPResult.ObjectName^ldapsend.TLDAPResult.html#ObjectName^^Name of this LDAP object. ^0"
+s[591] = "ldapsend.TLDAPResult.Attributes^ldapsend.TLDAPResult.html#Attributes^^Here is list of object attributes. ^0"
+s[592] = "ldapsend.TLDAPResultList^ldapsend.TLDAPResultList.html^List of LDAP result objects^ This object can hold list of LDAP objects. (for example result of LDAP SEARCH.) ^0"
+s[593] = "ldapsend.TLDAPResultList.Create^ldapsend.TLDAPResultList.html#Create^^ ^0"
+s[594] = "ldapsend.TLDAPResultList.Destroy^ldapsend.TLDAPResultList.html#Destroy^^ ^0"
+s[595] = "ldapsend.TLDAPResultList.Clear^ldapsend.TLDAPResultList.html#Clear^^Clear all TLDAPResult objects in list. ^0"
+s[596] = "ldapsend.TLDAPResultList.Count^ldapsend.TLDAPResultList.html#Count^^Return count of TLDAPResult objects in list. ^0"
+s[597] = "ldapsend.TLDAPResultList.Add^ldapsend.TLDAPResultList.html#Add^^Create and add new TLDAPResult object to list. ^0"
+s[598] = "ldapsend.TLDAPResultList.Items^ldapsend.TLDAPResultList.html#Items^^List of TLDAPResult objects. ^0"
+s[599] = "ldapsend.TLDAPSend^ldapsend.TLDAPSend.html^Implementation of LDAP client^ (version 2 and 3)
Note: Are you missing properties for setting Username and Password? Look to parent TSynaClient object!
Are you missing properties for specify server address and port? Look to parent TSynaClient too! ^0"
+s[600] = "ldapsend.TLDAPSend.Create^ldapsend.TLDAPSend.html#Create^^ ^0"
+s[601] = "ldapsend.TLDAPSend.Destroy^ldapsend.TLDAPSend.html#Destroy^^ ^0"
+s[602] = "ldapsend.TLDAPSend.Login^ldapsend.TLDAPSend.html#Login^^Try to connect to LDAP server and start secure channel, when it is required. ^0"
+s[603] = "ldapsend.TLDAPSend.Bind^ldapsend.TLDAPSend.html#Bind^^Try to bind to LDAP server with TSynaClient .UserName and TSynaClient .Password . If this is empty strings, then it do annonymous Bind. When you not call Bind on LDAPv3, then is automaticly used anonymous mode.
This method using plaintext transport of password! It is not secure! ^0"
+s[604] = "ldapsend.TLDAPSend.BindSasl^ldapsend.TLDAPSend.html#BindSasl^^Try to bind to LDAP server with TSynaClient .UserName and TSynaClient .Password . If this is empty strings, then it do annonymous Bind. When you not call Bind on LDAPv3, then is automaticly used anonymous mode.
This method using SASL with DIGEST-MD5 method for secure transfer of your password. ^0"
+s[605] = "ldapsend.TLDAPSend.Logout^ldapsend.TLDAPSend.html#Logout^^Close connection to LDAP server. ^0"
+s[606] = "ldapsend.TLDAPSend.Modify^ldapsend.TLDAPSend.html#Modify^^Modify content of LDAP attribute on this object. ^0"
+s[607] = "ldapsend.TLDAPSend.Add^ldapsend.TLDAPSend.html#Add^^Add list of attributes to specified object. ^0"
+s[608] = "ldapsend.TLDAPSend.Delete^ldapsend.TLDAPSend.html#Delete^^Delete this LDAP object from server. ^0"
+s[609] = "ldapsend.TLDAPSend.ModifyDN^ldapsend.TLDAPSend.html#ModifyDN^^Modify object name of this LDAP object. ^0"
+s[610] = "ldapsend.TLDAPSend.Compare^ldapsend.TLDAPSend.html#Compare^^Try to compare Attribute value with this LDAP object. ^0"
+s[611] = "ldapsend.TLDAPSend.Search^ldapsend.TLDAPSend.html#Search^^Search LDAP base for LDAP objects by Filter. ^0"
+s[612] = "ldapsend.TLDAPSend.Extended^ldapsend.TLDAPSend.html#Extended^^Call any LDAPv3 extended command. ^0"
+s[613] = "ldapsend.TLDAPSend.StartTLS^ldapsend.TLDAPSend.html#StartTLS^^Try to start SSL/TLS connection to LDAP server. ^0"
+s[614] = "ldapsend.TLDAPSend.Version^ldapsend.TLDAPSend.html#Version^^Specify version of used LDAP protocol. Default value is 3. ^0"
+s[615] = "ldapsend.TLDAPSend.ResultCode^ldapsend.TLDAPSend.html#ResultCode^^Result code of last LDAP operation. ^0"
+s[616] = "ldapsend.TLDAPSend.ResultString^ldapsend.TLDAPSend.html#ResultString^^Human readable description of result code of last LDAP operation. ^0"
+s[617] = "ldapsend.TLDAPSend.FullResult^ldapsend.TLDAPSend.html#FullResult^^Binary string with full last response of LDAP server. This string is encoded by ASN.1 BER encoding! You need this only for debugging. ^0"
+s[618] = "ldapsend.TLDAPSend.AutoTLS^ldapsend.TLDAPSend.html#AutoTLS^^If True
, then try to start TSL mode in Login procedure. ^0"
+s[619] = "ldapsend.TLDAPSend.FullSSL^ldapsend.TLDAPSend.html#FullSSL^^If True
, then use connection to LDAP server through SSL/TLS tunnel. ^0"
+s[620] = "ldapsend.TLDAPSend.Seq^ldapsend.TLDAPSend.html#Seq^^Sequence number of last LDAp command. It is incremented by any LDAP command. ^0"
+s[621] = "ldapsend.TLDAPSend.SearchScope^ldapsend.TLDAPSend.html#SearchScope^^Specify what search scope is used in search command. ^0"
+s[622] = "ldapsend.TLDAPSend.SearchAliases^ldapsend.TLDAPSend.html#SearchAliases^^Specify how to handle aliases in search command. ^0"
+s[623] = "ldapsend.TLDAPSend.SearchSizeLimit^ldapsend.TLDAPSend.html#SearchSizeLimit^^Specify result size limit in search command. Value 0 means without limit. ^0"
+s[624] = "ldapsend.TLDAPSend.SearchTimeLimit^ldapsend.TLDAPSend.html#SearchTimeLimit^^Specify search time limit in search command (seconds). Value 0 means without limit. ^0"
+s[625] = "ldapsend.TLDAPSend.SearchResult^ldapsend.TLDAPSend.html#SearchResult^^Here is result of search command. ^0"
+s[626] = "ldapsend.TLDAPSend.Referals^ldapsend.TLDAPSend.html#Referals^^On each LDAP operation can LDAP server return some referals URLs. Here is their list. ^0"
+s[627] = "ldapsend.TLDAPSend.ExtName^ldapsend.TLDAPSend.html#ExtName^^When you call Extended operation, then here is result Name returned by server. ^0"
+s[628] = "ldapsend.TLDAPSend.ExtValue^ldapsend.TLDAPSend.html#ExtValue^^When you call Extended operation, then here is result Value returned by server. ^0"
+s[629] = "ldapsend.TLDAPSend.Sock^ldapsend.TLDAPSend.html#Sock^^TCP socket used by all LDAP operations. ^0"
+s[630] = "ldapsend.cLDAPProtocol^ldapsend.html#cLDAPProtocol^^ ^0"
+s[631] = "ldapsend.LDAP_ASN1_BIND_REQUEST^ldapsend.html#LDAP_ASN1_BIND_REQUEST^^ ^0"
+s[632] = "ldapsend.LDAP_ASN1_BIND_RESPONSE^ldapsend.html#LDAP_ASN1_BIND_RESPONSE^^ ^0"
+s[633] = "ldapsend.LDAP_ASN1_UNBIND_REQUEST^ldapsend.html#LDAP_ASN1_UNBIND_REQUEST^^ ^0"
+s[634] = "ldapsend.LDAP_ASN1_SEARCH_REQUEST^ldapsend.html#LDAP_ASN1_SEARCH_REQUEST^^ ^0"
+s[635] = "ldapsend.LDAP_ASN1_SEARCH_ENTRY^ldapsend.html#LDAP_ASN1_SEARCH_ENTRY^^ ^0"
+s[636] = "ldapsend.LDAP_ASN1_SEARCH_DONE^ldapsend.html#LDAP_ASN1_SEARCH_DONE^^ ^0"
+s[637] = "ldapsend.LDAP_ASN1_SEARCH_REFERENCE^ldapsend.html#LDAP_ASN1_SEARCH_REFERENCE^^ ^0"
+s[638] = "ldapsend.LDAP_ASN1_MODIFY_REQUEST^ldapsend.html#LDAP_ASN1_MODIFY_REQUEST^^ ^0"
+s[639] = "ldapsend.LDAP_ASN1_MODIFY_RESPONSE^ldapsend.html#LDAP_ASN1_MODIFY_RESPONSE^^ ^0"
+s[640] = "ldapsend.LDAP_ASN1_ADD_REQUEST^ldapsend.html#LDAP_ASN1_ADD_REQUEST^^ ^0"
+s[641] = "ldapsend.LDAP_ASN1_ADD_RESPONSE^ldapsend.html#LDAP_ASN1_ADD_RESPONSE^^ ^0"
+s[642] = "ldapsend.LDAP_ASN1_DEL_REQUEST^ldapsend.html#LDAP_ASN1_DEL_REQUEST^^ ^0"
+s[643] = "ldapsend.LDAP_ASN1_DEL_RESPONSE^ldapsend.html#LDAP_ASN1_DEL_RESPONSE^^ ^0"
+s[644] = "ldapsend.LDAP_ASN1_MODIFYDN_REQUEST^ldapsend.html#LDAP_ASN1_MODIFYDN_REQUEST^^ ^0"
+s[645] = "ldapsend.LDAP_ASN1_MODIFYDN_RESPONSE^ldapsend.html#LDAP_ASN1_MODIFYDN_RESPONSE^^ ^0"
+s[646] = "ldapsend.LDAP_ASN1_COMPARE_REQUEST^ldapsend.html#LDAP_ASN1_COMPARE_REQUEST^^ ^0"
+s[647] = "ldapsend.LDAP_ASN1_COMPARE_RESPONSE^ldapsend.html#LDAP_ASN1_COMPARE_RESPONSE^^ ^0"
+s[648] = "ldapsend.LDAP_ASN1_ABANDON_REQUEST^ldapsend.html#LDAP_ASN1_ABANDON_REQUEST^^ ^0"
+s[649] = "ldapsend.LDAP_ASN1_EXT_REQUEST^ldapsend.html#LDAP_ASN1_EXT_REQUEST^^ ^0"
+s[650] = "ldapsend.LDAP_ASN1_EXT_RESPONSE^ldapsend.html#LDAP_ASN1_EXT_RESPONSE^^ ^0"
+s[651] = "ldapsend.LDAPResultDump^ldapsend.html#LDAPResultDump^^Dump result of LDAP SEARCH into human readable form. Good for debugging. ^0"
+s[652] = "ldapsend.TLDAPModifyOp^ldapsend.html#TLDAPModifyOp^^Define possible operations for LDAP MODIFY operations. MO_Add MO_Delete MO_Replace ^0"
+s[653] = "ldapsend.TLDAPSearchScope^ldapsend.html#TLDAPSearchScope^^Specify possible values for search scope. SS_BaseObject SS_SingleLevel SS_WholeSubtree ^0"
+s[654] = "ldapsend.TLDAPSearchAliases^ldapsend.html#TLDAPSearchAliases^^Specify possible values about alias dereferencing. SA_NeverDeref SA_InSearching SA_FindingBaseObj SA_Always ^0"
+s[655] = "mimeinln^mimeinln.html^Utilities for inline MIME^ Support for Inline MIME encoding and decoding.
Used RFC: RFC-2047, RFC-2231 ^0"
+s[656] = "mimeinln.InlineDecode^mimeinln.html#InlineDecode^^Decodes mime inline encoding (i.e. in headers) uses target characterset "CP". ^0"
+s[657] = "mimeinln.InlineEncode^mimeinln.html#InlineEncode^^Encodes string to MIME inline encoding. The source characterset is "CP", and the target charset is "MimeP". ^0"
+s[658] = "mimeinln.NeedInline^mimeinln.html#NeedInline^^Returns True
, if "Value" contains characters needed for inline coding. ^0"
+s[659] = "mimeinln.InlineCodeEx^mimeinln.html#InlineCodeEx^^Inline mime encoding similar to InlineEncode , but you can specify source charset, and the target characterset is automatically assigned. ^0"
+s[660] = "mimeinln.InlineCode^mimeinln.html#InlineCode^^Inline MIME encoding similar to InlineEncode , but the source charset is automatically set to the system default charset, and the target charset is automatically assigned from set of allowed encoding for MIME. ^0"
+s[661] = "mimeinln.InlineEmailEx^mimeinln.html#InlineEmailEx^^Converts e-mail address to canonical mime form. You can specify source charset. ^0"
+s[662] = "mimeinln.InlineEmail^mimeinln.html#InlineEmail^^Converts e-mail address to canonical mime form. Source charser it system default charset. ^0"
+s[663] = "mimemess^mimemess.html^MIME message handling^ Classes for easy handling with e-mail message. ^0"
+s[664] = "mimemess.TMessHeader^mimemess.TMessHeader.html^Object for basic e-mail header fields.^ ^0"
+s[665] = "mimemess.TMessHeader.Create^mimemess.TMessHeader.html#Create^^ ^0"
+s[666] = "mimemess.TMessHeader.Destroy^mimemess.TMessHeader.html#Destroy^^ ^0"
+s[667] = "mimemess.TMessHeader.Clear^mimemess.TMessHeader.html#Clear^^Clears all data fields. ^0"
+s[668] = "mimemess.TMessHeader.EncodeHeaders^mimemess.TMessHeader.html#EncodeHeaders^^ ^0"
+s[669] = "mimemess.TMessHeader.DecodeHeaders^mimemess.TMessHeader.html#DecodeHeaders^^Parse header from Value to this object. ^0"
+s[670] = "mimemess.TMessHeader.FindHeader^mimemess.TMessHeader.html#FindHeader^^Try find specific header in CustomHeader. Search is case insensitive. This is good for reading any non-parsed header. ^0"
+s[671] = "mimemess.TMessHeader.FindHeaderList^mimemess.TMessHeader.html#FindHeaderList^^Try find specific headers in CustomHeader. This metod is for repeatly used headers like 'received' header, etc. Search is case insensitive. This is good for reading ano non-parsed header. ^0"
+s[672] = "mimemess.TMessHeader.From^mimemess.TMessHeader.html#From^^Sender of message. ^0"
+s[673] = "mimemess.TMessHeader.ToList^mimemess.TMessHeader.html#ToList^^Stringlist with receivers of message. (one per line) ^0"
+s[674] = "mimemess.TMessHeader.CCList^mimemess.TMessHeader.html#CCList^^Stringlist with Carbon Copy receivers of message. (one per line) ^0"
+s[675] = "mimemess.TMessHeader.Subject^mimemess.TMessHeader.html#Subject^^Subject of message. ^0"
+s[676] = "mimemess.TMessHeader.Organization^mimemess.TMessHeader.html#Organization^^Organization string. ^0"
+s[677] = "mimemess.TMessHeader.CustomHeaders^mimemess.TMessHeader.html#CustomHeaders^^After decoding contains all headers lines witch not have parsed to any other structures in this object. It mean: this conatins all other headers except:
X-MAILER, FROM, SUBJECT, ORGANIZATION, TO, CC, DATE, MIME-VERSION, CONTENT-TYPE, CONTENT-DESCRIPTION, CONTENT-DISPOSITION, CONTENT-ID, CONTENT-TRANSFER-ENCODING, REPLY-TO, MESSAGE-ID, X-MSMAIL-PRIORITY, X-PRIORITY, PRIORITY
When you encode headers, all this lines is added as headers. Be carefull for duplicites! ^0"
+s[678] = "mimemess.TMessHeader.Date^mimemess.TMessHeader.html#Date^^Date and time of message. ^0"
+s[679] = "mimemess.TMessHeader.XMailer^mimemess.TMessHeader.html#XMailer^^Mailer identification. ^0"
+s[680] = "mimemess.TMessHeader.ReplyTo^mimemess.TMessHeader.html#ReplyTo^^Address for replies ^0"
+s[681] = "mimemess.TMessHeader.MessageID^mimemess.TMessHeader.html#MessageID^^message indetifier ^0"
+s[682] = "mimemess.TMessHeader.Priority^mimemess.TMessHeader.html#Priority^^message priority ^0"
+s[683] = "mimemess.TMessHeader.CharsetCode^mimemess.TMessHeader.html#CharsetCode^^Specify base charset. By default is used system charset. ^0"
+s[684] = "mimemess.TMimeMess^mimemess.TMimeMess.html^Object for handling of e-mail message.^ ^0"
+s[685] = "mimemess.TMimeMess.Create^mimemess.TMimeMess.html#Create^^ ^0"
+s[686] = "mimemess.TMimeMess.CreateAltHeaders^mimemess.TMimeMess.html#CreateAltHeaders^^create this object and assign your own descendant of TMessHeader object to Header property. So, you can create your own message headers parser and use it by this object. ^0"
+s[687] = "mimemess.TMimeMess.Destroy^mimemess.TMimeMess.html#Destroy^^ ^0"
+s[688] = "mimemess.TMimeMess.Clear^mimemess.TMimeMess.html#Clear^^Reset component to default state. ^0"
+s[689] = "mimemess.TMimeMess.AddPart^mimemess.TMimeMess.html#AddPart^^Add MIME part as subpart of PartParent. If you need set root MIME part, then set as PartParent Nil
value. If you need set more then one subpart, you must have PartParent of multipart type! ^0"
+s[690] = "mimemess.TMimeMess.AddPartMultipart^mimemess.TMimeMess.html#AddPartMultipart^^Add MIME part as subpart of PartParent. If you need set root MIME part, then set as PartParent Nil
value. If you need set more then 1 subpart, you must have PartParent of multipart type!
This part is marked as multipart with secondary MIME type specified by MultipartType parameter. (typical value is 'mixed')
This part can be used as PartParent for another parts (include next multipart). If you need only one part, then you not need Multipart part. ^0"
+s[691] = "mimemess.TMimeMess.AddPartText^mimemess.TMimeMess.html#AddPartText^^Add MIME part as subpart of PartParent. If you need set root MIME part, then set as PartParent Nil
value. If you need set more then 1 subpart, you must have PartParent of multipart type!
After creation of part set type to text part and set all necessary properties. Content of part is readed from value stringlist. ^0"
+s[692] = "mimemess.TMimeMess.AddPartTextEx^mimemess.TMimeMess.html#AddPartTextEx^^Add MIME part as subpart of PartParent. If you need set root MIME part, then set as PartParent Nil
value. If you need set more then 1 subpart, you must have PartParent of multipart type!
After creation of part set type to text part and set all necessary properties. Content of part is readed from value stringlist. You can select your charset and your encoding type. If Raw is True
, then it not doing charset conversion! ^0"
+s[693] = "mimemess.TMimeMess.AddPartHTML^mimemess.TMimeMess.html#AddPartHTML^^Add MIME part as subpart of PartParent. If you need set root MIME part, then set as PartParent Nil
value. If you need set more then 1 subpart, you must have PartParent of multipart type!
After creation of part set type to text part to HTML type and set all necessary properties. Content of HTML part is readed from Value stringlist. ^0"
+s[694] = "mimemess.TMimeMess.AddPartTextFromFile^mimemess.TMimeMess.html#AddPartTextFromFile^^Same as AddPartText , but content is readed from file ^0"
+s[695] = "mimemess.TMimeMess.AddPartHTMLFromFile^mimemess.TMimeMess.html#AddPartHTMLFromFile^^Same as AddPartHTML , but content is readed from file ^0"
+s[696] = "mimemess.TMimeMess.AddPartBinary^mimemess.TMimeMess.html#AddPartBinary^^Add MIME part as subpart of PartParent. If you need set root MIME part, then set as PartParent Nil
value. If you need set more then 1 subpart, you must have PartParent of multipart type!
After creation of part set type to binary and set all necessary properties. MIME primary and secondary types defined automaticly by filename extension. Content of binary part is readed from Stream. This binary part is encoded as file attachment. ^0"
+s[697] = "mimemess.TMimeMess.AddPartBinaryFromFile^mimemess.TMimeMess.html#AddPartBinaryFromFile^^Same as AddPartBinary , but content is readed from file ^0"
+s[698] = "mimemess.TMimeMess.AddPartHTMLBinary^mimemess.TMimeMess.html#AddPartHTMLBinary^^Add MIME part as subpart of PartParent. If you need set root MIME part, then set as PartParent Nil
value. If you need set more then 1 subpart, you must have PartParent of multipart type!
After creation of part set type to binary and set all necessary properties. MIME primary and secondary types defined automaticly by filename extension. Content of binary part is readed from Stream.
This binary part is encoded as inline data with given Conten ID (cid). Content ID can be used as reference ID in HTML source in HTML part. ^0"
+s[699] = "mimemess.TMimeMess.AddPartHTMLBinaryFromFile^mimemess.TMimeMess.html#AddPartHTMLBinaryFromFile^^Same as AddPartHTMLBinary , but content is readed from file ^0"
+s[700] = "mimemess.TMimeMess.AddPartMess^mimemess.TMimeMess.html#AddPartMess^^Add MIME part as subpart of PartParent. If you need set root MIME part, then set as PartParent Nil
value. If you need set more then 1 subpart, you must have PartParent of multipart type!
After creation of part set type to message and set all necessary properties. MIME primary and secondary types are setted to 'message/rfc822'. Content of raw RFC-822 message is readed from Stream. ^0"
+s[701] = "mimemess.TMimeMess.AddPartMessFromFile^mimemess.TMimeMess.html#AddPartMessFromFile^^Same as AddPartMess , but content is readed from file ^0"
+s[702] = "mimemess.TMimeMess.EncodeMessage^mimemess.TMimeMess.html#EncodeMessage^^Compose message from MessagePart to Lines . Headers from Header object is added also. ^0"
+s[703] = "mimemess.TMimeMess.DecodeMessage^mimemess.TMimeMess.html#DecodeMessage^^Decode message from Lines to MessagePart . Massage headers are parsed into Header object. ^0"
+s[704] = "mimemess.TMimeMess.DecodeMessageBinary^mimemess.TMimeMess.html#DecodeMessageBinary^^HTTP message is received by THTTPSend component in two parts: headers are stored in THTTPSend .Headers and a body in memory stream THTTPSend .Document .
On the top of it, HTTP connections are always 8-bit, hence data are transferred in native format i.e. no transfer encoding is applied.
This method operates the similiar way and produces the same result as DecodeMessage . ^0"
+s[705] = "mimemess.TMimeMess.MessagePart^mimemess.TMimeMess.html#MessagePart^^TMimePart object with decoded MIME message. This object can handle any number of nested TMimePart objects itself. It is used for handle any tree of MIME subparts. ^0"
+s[706] = "mimemess.TMimeMess.Lines^mimemess.TMimeMess.html#Lines^^Raw MIME encoded message. ^0"
+s[707] = "mimemess.TMimeMess.Header^mimemess.TMimeMess.html#Header^^Object for e-mail header fields. This object is created automaticly. Do not free this object! ^0"
+s[708] = "mimemess.TMessPriority^mimemess.html#TMessPriority^^Possible values for message priority MP_unknown MP_low MP_normal MP_high ^0"
+s[709] = "mimemess.TMessHeaderClass^mimemess.html#TMessHeaderClass^^ ^0"
+s[710] = "mimepart^mimepart.html^MIME part handling^ Handling with MIME parts.
Used RFC: RFC-2045 ^0"
+s[711] = "mimepart.TMimePart^mimepart.TMimePart.html^Object for working with parts of MIME e-mail.^ Each TMimePart object can handle any number of nested subparts as new TMimepart objects. It can handle any tree hierarchy structure of nested MIME subparts itself.
Basic tasks are:
Decoding of MIME message: - store message into Lines property - call DecomposeParts. Now you have decomposed MIME parts in all nested levels! - now you can explore all properties and subparts. (You can use WalkPart method) - if you need decode part, call DecodePart.
Encoding of MIME message:
- if you need multipart message, you must create subpart by AddSubPart. - set all properties of all parts. - set content of part into DecodedLines stream - encode this stream by EncodePart. - compose full message by ComposeParts. (it build full MIME message from all subparts. Do not call this method for each subpart! It is needed on root part!) - encoded MIME message is stored in Lines property. ^0"
+s[712] = "mimepart.TMimePart.Create^mimepart.TMimePart.html#Create^^ ^0"
+s[713] = "mimepart.TMimePart.Destroy^mimepart.TMimePart.html#Destroy^^ ^0"
+s[714] = "mimepart.TMimePart.Assign^mimepart.TMimePart.html#Assign^^Assign content of another object to this object. (Only this part, not subparts!) ^0"
+s[715] = "mimepart.TMimePart.AssignSubParts^mimepart.TMimePart.html#AssignSubParts^^Assign content of another object to this object. (With all subparts!) ^0"
+s[716] = "mimepart.TMimePart.Clear^mimepart.TMimePart.html#Clear^^Clear all data values to default values. It also call ClearSubParts . ^0"
+s[717] = "mimepart.TMimePart.DecodePart^mimepart.TMimePart.html#DecodePart^^Decode Mime part from Lines to DecodedLines . ^0"
+s[718] = "mimepart.TMimePart.DecodePartHeader^mimepart.TMimePart.html#DecodePartHeader^^Parse header lines from Headers property into another properties. ^0"
+s[719] = "mimepart.TMimePart.EncodePart^mimepart.TMimePart.html#EncodePart^^Encode mime part from DecodedLines to Lines and build mime headers. ^0"
+s[720] = "mimepart.TMimePart.EncodePartHeader^mimepart.TMimePart.html#EncodePartHeader^^Build header lines in Headers property from another properties. ^0"
+s[721] = "mimepart.TMimePart.MimeTypeFromExt^mimepart.TMimePart.html#MimeTypeFromExt^^generate primary and secondary mime type from filename extension in value. If type not recognised, it return 'Application/octet-string' type. ^0"
+s[722] = "mimepart.TMimePart.GetSubPartCount^mimepart.TMimePart.html#GetSubPartCount^^Return number of decomposed subparts. (On this level! Each of this subparts can hold any number of their own nested subparts!) ^0"
+s[723] = "mimepart.TMimePart.GetSubPart^mimepart.TMimePart.html#GetSubPart^^Get nested subpart object as new TMimePart. For getting maximum possible index you can use GetSubPartCount method. ^0"
+s[724] = "mimepart.TMimePart.DeleteSubPart^mimepart.TMimePart.html#DeleteSubPart^^delete subpart on given index. ^0"
+s[725] = "mimepart.TMimePart.ClearSubParts^mimepart.TMimePart.html#ClearSubParts^^Clear and destroy all subpart TMimePart objects. ^0"
+s[726] = "mimepart.TMimePart.AddSubPart^mimepart.TMimePart.html#AddSubPart^^Add and create new subpart. ^0"
+s[727] = "mimepart.TMimePart.DecomposeParts^mimepart.TMimePart.html#DecomposeParts^^E-mail message in Lines property is parsed into this object. E-mail headers are stored in Headers property and is parsed into another properties automaticly. Not need call DecodePartHeader ! Content of message (part) is stored into PartBody property. This part is in undecoded form! If you need decode it, then you must call DecodePart method by your hands. Lot of another properties is filled also.
Decoding of parts you must call separately due performance reasons. (Not needed to decode all parts in all reasons.)
For each MIME subpart is created new TMimepart object (accessible via method GetSubPart ). ^0"
+s[728] = "mimepart.TMimePart.DecomposePartsBinary^mimepart.TMimePart.html#DecomposePartsBinary^^HTTP message is received by THTTPSend component in two parts: headers are stored in THTTPSend .Headers and a body in memory stream THTTPSend .Document .
On the top of it, HTTP connections are always 8-bit, hence data are transferred in native format i.e. no transfer encoding is applied.
This method operates the similiar way and produces the same result as DecomposeParts . ^0"
+s[729] = "mimepart.TMimePart.ComposeParts^mimepart.TMimePart.html#ComposeParts^^This part and all subparts is composed into one MIME message stored in Lines property. ^0"
+s[730] = "mimepart.TMimePart.WalkPart^mimepart.TMimePart.html#WalkPart^^By calling this method is called OnWalkPart event for each part and their subparts. It is very good for calling some code for each part in MIME message ^0"
+s[731] = "mimepart.TMimePart.CanSubPart^mimepart.TMimePart.html#CanSubPart^^Return True
when is possible create next subpart. (MaxSubLevel is still not reached) ^0"
+s[732] = "mimepart.TMimePart.Primary^mimepart.TMimePart.html#Primary^^Primary Mime type of part. (i.e. 'application') Writing to this property automaticly generate value of PrimaryCode . ^0"
+s[733] = "mimepart.TMimePart.Encoding^mimepart.TMimePart.html#Encoding^^String representation of used Mime encoding in part. (i.e. 'base64') Writing to this property automaticly generate value of EncodingCode . ^0"
+s[734] = "mimepart.TMimePart.Charset^mimepart.TMimePart.html#Charset^^String representation of used Mime charset in part. (i.e. 'iso-8859-1') Writing to this property automaticly generate value of CharsetCode . Charset is used only for text parts. ^0"
+s[735] = "mimepart.TMimePart.DefaultCharset^mimepart.TMimePart.html#DefaultCharset^^Define default charset for decoding text MIME parts without charset specification. Default value is 'ISO-8859-1' by RCF documents. But Microsoft Outlook use windows codings as default. This property allows properly decode textual parts from some broken versions of Microsoft Outlook. (this is bad software!) ^0"
+s[736] = "mimepart.TMimePart.PrimaryCode^mimepart.TMimePart.html#PrimaryCode^^Decoded primary type. Possible values are: MP_TEXT, MP_MULTIPART, MP_MESSAGE and MP_BINARY. If type not recognised, result is MP_BINARY. ^0"
+s[737] = "mimepart.TMimePart.EncodingCode^mimepart.TMimePart.html#EncodingCode^^Decoded encoding type. Possible values are: ME_7BIT, ME_8BIT, ME_QUOTED_PRINTABLE and ME_BASE64. If type not recognised, result is ME_7BIT. ^0"
+s[738] = "mimepart.TMimePart.CharsetCode^mimepart.TMimePart.html#CharsetCode^^Decoded charset type. Possible values are defined in synachar unit. ^0"
+s[739] = "mimepart.TMimePart.TargetCharset^mimepart.TMimePart.html#TargetCharset^^System charset type. Default value is charset used by default in your operating system. ^0"
+s[740] = "mimepart.TMimePart.ConvertCharset^mimepart.TMimePart.html#ConvertCharset^^If True
, then do internal charset translation of part content between CharsetCode and TargetCharset ^0"
+s[741] = "mimepart.TMimePart.ForcedHTMLConvert^mimepart.TMimePart.html#ForcedHTMLConvert^^If True
, then allways do internal charset translation of HTML parts by MIME even it have their own charset in META tag. Default is False
. ^0"
+s[742] = "mimepart.TMimePart.Secondary^mimepart.TMimePart.html#Secondary^^Secondary Mime type of part. (i.e. 'mixed') ^0"
+s[743] = "mimepart.TMimePart.Description^mimepart.TMimePart.html#Description^^Description of Mime part. ^0"
+s[744] = "mimepart.TMimePart.Disposition^mimepart.TMimePart.html#Disposition^^Value of content disposition field. (i.e. 'inline' or 'attachment') ^0"
+s[745] = "mimepart.TMimePart.ContentID^mimepart.TMimePart.html#ContentID^^Content ID. ^0"
+s[746] = "mimepart.TMimePart.Boundary^mimepart.TMimePart.html#Boundary^^Boundary delimiter of multipart Mime part. Used only in multipart part. ^0"
+s[747] = "mimepart.TMimePart.FileName^mimepart.TMimePart.html#FileName^^Filename of file in binary part. ^0"
+s[748] = "mimepart.TMimePart.Lines^mimepart.TMimePart.html#Lines^^String list with lines contains mime part (It can be a full message). ^0"
+s[749] = "mimepart.TMimePart.PartBody^mimepart.TMimePart.html#PartBody^^Encoded form of MIME part data. ^0"
+s[750] = "mimepart.TMimePart.Headers^mimepart.TMimePart.html#Headers^^All header lines of MIME part. ^0"
+s[751] = "mimepart.TMimePart.PrePart^mimepart.TMimePart.html#PrePart^^On multipart this contains part of message between first line of message and first boundary. ^0"
+s[752] = "mimepart.TMimePart.PostPart^mimepart.TMimePart.html#PostPart^^On multipart this contains part of message between last boundary and end of message. ^0"
+s[753] = "mimepart.TMimePart.DecodedLines^mimepart.TMimePart.html#DecodedLines^^Stream with decoded form of budy part. ^0"
+s[754] = "mimepart.TMimePart.SubLevel^mimepart.TMimePart.html#SubLevel^^Show nested level in subpart tree. Value 0 means root part. 1 means subpart from this root. etc. ^0"
+s[755] = "mimepart.TMimePart.MaxSubLevel^mimepart.TMimePart.html#MaxSubLevel^^Specify maximum sublevel value for decomposing. ^0"
+s[756] = "mimepart.TMimePart.AttachInside^mimepart.TMimePart.html#AttachInside^^When is True
, then this part maybe(!) have included some uuencoded binary data. ^0"
+s[757] = "mimepart.TMimePart.OnWalkPart^mimepart.TMimePart.html#OnWalkPart^^Here you can assign hook procedure for walking through all part and their subparts. ^0"
+s[758] = "mimepart.TMimePart.MaxLineLength^mimepart.TMimePart.html#MaxLineLength^^Here you can specify maximum line length for encoding of MIME part. If line is longer, then is splitted by standard of MIME. Correct MIME mailers can de-split this line into original length. ^0"
+s[759] = "mimepart.MaxMimeType^mimepart.html#MaxMimeType^^ ^0"
+s[760] = "mimepart.MimeType^mimepart.html#MimeType^^ ^0"
+s[761] = "mimepart.GenerateBoundary^mimepart.html#GenerateBoundary^^Generates a unique boundary string. ^0"
+s[762] = "mimepart.THookWalkPart^mimepart.html#THookWalkPart^Procedural type for TMimePart .WalkPart hook^. This hook is used for easy walking through MIME subparts. ^0"
+s[763] = "mimepart.TMimePrimary^mimepart.html#TMimePrimary^^The four types of MIME parts. (textual, multipart, message or any other binary data.) MP_TEXT MP_MULTIPART MP_MESSAGE MP_BINARY ^0"
+s[764] = "mimepart.TMimeEncoding^mimepart.html#TMimeEncoding^^The various types of possible part encodings. ME_7BIT ME_8BIT ME_QUOTED_PRINTABLE ME_BASE64 ME_UU ME_XX ^0"
+s[765] = "nntpsend^nntpsend.html^NNTP client^ NNTP (network news transfer protocol)
Used RFC: RFC-977, RFC-2980 ^0"
+s[766] = "nntpsend.TNNTPSend^nntpsend.TNNTPSend.html^^abstract(Implementation of Network News Transfer Protocol.
Note: Are you missing properties for setting Username and Password? Look to parent TSynaClient object!
Are you missing properties for specify server address and port? Look to parent TSynaClient too! ^0"
+s[767] = "nntpsend.TNNTPSend.Create^nntpsend.TNNTPSend.html#Create^^ ^0"
+s[768] = "nntpsend.TNNTPSend.Destroy^nntpsend.TNNTPSend.html#Destroy^^ ^0"
+s[769] = "nntpsend.TNNTPSend.Login^nntpsend.TNNTPSend.html#Login^^Connects to NNTP server and begin session. ^0"
+s[770] = "nntpsend.TNNTPSend.Logout^nntpsend.TNNTPSend.html#Logout^^Logout from NNTP server and terminate session. ^0"
+s[771] = "nntpsend.TNNTPSend.DoCommand^nntpsend.TNNTPSend.html#DoCommand^^By this you can call any NNTP command. ^0"
+s[772] = "nntpsend.TNNTPSend.DoCommandRead^nntpsend.TNNTPSend.html#DoCommandRead^^by this you can call any NNTP command. This variant is used for commands for download information from server. ^0"
+s[773] = "nntpsend.TNNTPSend.DoCommandWrite^nntpsend.TNNTPSend.html#DoCommandWrite^^by this you can call any NNTP command. This variant is used for commands for upload information to server. ^0"
+s[774] = "nntpsend.TNNTPSend.GetArticle^nntpsend.TNNTPSend.html#GetArticle^^Download full message to Data property. Value can be number of message or message-id (in brackets). ^0"
+s[775] = "nntpsend.TNNTPSend.GetBody^nntpsend.TNNTPSend.html#GetBody^^Download only body of message to Data property. Value can be number of message or message-id (in brackets). ^0"
+s[776] = "nntpsend.TNNTPSend.GetHead^nntpsend.TNNTPSend.html#GetHead^^Download only headers of message to Data property. Value can be number of message or message-id (in brackets). ^0"
+s[777] = "nntpsend.TNNTPSend.GetStat^nntpsend.TNNTPSend.html#GetStat^^Get message status. Value can be number of message or message-id (in brackets). ^0"
+s[778] = "nntpsend.TNNTPSend.SelectGroup^nntpsend.TNNTPSend.html#SelectGroup^^Select given group. ^0"
+s[779] = "nntpsend.TNNTPSend.IHave^nntpsend.TNNTPSend.html#IHave^^Tell to server 'I have mesage with given message-ID.' If server need this message, message is uploaded to server. ^0"
+s[780] = "nntpsend.TNNTPSend.GotoLast^nntpsend.TNNTPSend.html#GotoLast^^Move message pointer to last item in group. ^0"
+s[781] = "nntpsend.TNNTPSend.GotoNext^nntpsend.TNNTPSend.html#GotoNext^^Move message pointer to next item in group. ^0"
+s[782] = "nntpsend.TNNTPSend.ListGroups^nntpsend.TNNTPSend.html#ListGroups^^Download to Data property list of all groups on NNTP server. ^0"
+s[783] = "nntpsend.TNNTPSend.ListNewGroups^nntpsend.TNNTPSend.html#ListNewGroups^^Download to Data property list of all groups created after given time. ^0"
+s[784] = "nntpsend.TNNTPSend.NewArticles^nntpsend.TNNTPSend.html#NewArticles^^Download to Data property list of message-ids in given group since given time. ^0"
+s[785] = "nntpsend.TNNTPSend.PostArticle^nntpsend.TNNTPSend.html#PostArticle^^Upload new article to server. (for new messages by you) ^0"
+s[786] = "nntpsend.TNNTPSend.SwitchToSlave^nntpsend.TNNTPSend.html#SwitchToSlave^^Tells to remote NNTP server 'I am not NNTP client, but I am another NNTP server'. ^0"
+s[787] = "nntpsend.TNNTPSend.Xover^nntpsend.TNNTPSend.html#Xover^^Call NNTP XOVER command. ^0"
+s[788] = "nntpsend.TNNTPSend.StartTLS^nntpsend.TNNTPSend.html#StartTLS^^Call STARTTLS command for upgrade connection to SSL/TLS mode. ^0"
+s[789] = "nntpsend.TNNTPSend.FindCap^nntpsend.TNNTPSend.html#FindCap^^Try to find given capability in extension list. This list is getted after successful login to NNTP server. If extension capability is not found, then return is empty string. ^0"
+s[790] = "nntpsend.TNNTPSend.ListExtensions^nntpsend.TNNTPSend.html#ListExtensions^^Try get list of server extensions. List is returned in Data property. ^0"
+s[791] = "nntpsend.TNNTPSend.ResultCode^nntpsend.TNNTPSend.html#ResultCode^^Result code number of last operation. ^0"
+s[792] = "nntpsend.TNNTPSend.ResultString^nntpsend.TNNTPSend.html#ResultString^^String description of last result code from NNTP server. ^0"
+s[793] = "nntpsend.TNNTPSend.Data^nntpsend.TNNTPSend.html#Data^^Readed data. (message, etc.) ^0"
+s[794] = "nntpsend.TNNTPSend.AutoTLS^nntpsend.TNNTPSend.html#AutoTLS^^If is set to True
, then upgrade to SSL/TLS mode after login if remote server support it. ^0"
+s[795] = "nntpsend.TNNTPSend.FullSSL^nntpsend.TNNTPSend.html#FullSSL^^SSL/TLS mode is used from first contact to server. Servers with full SSL/TLS mode usualy using non-standard TCP port! ^0"
+s[796] = "nntpsend.TNNTPSend.Sock^nntpsend.TNNTPSend.html#Sock^^Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc. ^0"
+s[797] = "nntpsend.cNNTPProtocol^nntpsend.html#cNNTPProtocol^^ ^0"
+s[798] = "pingsend^pingsend.html^^ ^0"
+s[799] = "pingsend.TPINGSend^pingsend.TPINGSend.html^Implementation of ICMP PING and ICMPv6 PING.^ ^0"
+s[800] = "pingsend.TPINGSend.Ping^pingsend.TPINGSend.html#Ping^^Send ICMP ping to host and count PingTime . If ping OK, result is True
. ^0"
+s[801] = "pingsend.TPINGSend.Create^pingsend.TPINGSend.html#Create^^ ^0"
+s[802] = "pingsend.TPINGSend.Destroy^pingsend.TPINGSend.html#Destroy^^ ^0"
+s[803] = "pingsend.TPINGSend.PacketSize^pingsend.TPINGSend.html#PacketSize^^Size of PING packet. Default size is 32 bytes. ^0"
+s[804] = "pingsend.TPINGSend.PingTime^pingsend.TPINGSend.html#PingTime^^Time between request and reply. ^0"
+s[805] = "pingsend.TPINGSend.ReplyFrom^pingsend.TPINGSend.html#ReplyFrom^^From this address is sended reply for your PING request. It maybe not your requested destination, when some error occured! ^0"
+s[806] = "pingsend.TPINGSend.ReplyType^pingsend.TPINGSend.html#ReplyType^^ICMP type of PING reply. Each protocol using another values! For IPv4 and IPv6 are used different values! ^0"
+s[807] = "pingsend.TPINGSend.ReplyCode^pingsend.TPINGSend.html#ReplyCode^^ICMP code of PING reply. Each protocol using another values! For IPv4 and IPv6 are used different values! For protocol independent value look to ReplyError ^0"
+s[808] = "pingsend.TPINGSend.ReplyError^pingsend.TPINGSend.html#ReplyError^^Return type of returned ICMP message. This value is independent on used protocol! ^0"
+s[809] = "pingsend.TPINGSend.ReplyErrorDesc^pingsend.TPINGSend.html#ReplyErrorDesc^^Return human readable description of returned packet type. ^0"
+s[810] = "pingsend.TPINGSend.Sock^pingsend.TPINGSend.html#Sock^^Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc. ^0"
+s[811] = "pingsend.TPINGSend.TTL^pingsend.TPINGSend.html#TTL^^TTL value for ICMP query ^0"
+s[812] = "pingsend.ICMP_ECHO^pingsend.html#ICMP_ECHO^^ ^0"
+s[813] = "pingsend.ICMP_ECHOREPLY^pingsend.html#ICMP_ECHOREPLY^^ ^0"
+s[814] = "pingsend.ICMP_UNREACH^pingsend.html#ICMP_UNREACH^^ ^0"
+s[815] = "pingsend.ICMP_TIME_EXCEEDED^pingsend.html#ICMP_TIME_EXCEEDED^^ ^0"
+s[816] = "pingsend.ICMP6_ECHO^pingsend.html#ICMP6_ECHO^^ ^0"
+s[817] = "pingsend.ICMP6_ECHOREPLY^pingsend.html#ICMP6_ECHOREPLY^^ ^0"
+s[818] = "pingsend.ICMP6_UNREACH^pingsend.html#ICMP6_UNREACH^^ ^0"
+s[819] = "pingsend.ICMP6_TIME_EXCEEDED^pingsend.html#ICMP6_TIME_EXCEEDED^^ ^0"
+s[820] = "pingsend.PingHost^pingsend.html#PingHost^^A very useful function and example of its use would be found in the TPINGSend object. Use it to ping to any host. If successful, returns the ping time in milliseconds. Returns -1 if an error occurred. ^0"
+s[821] = "pingsend.TraceRouteHost^pingsend.html#TraceRouteHost^^A very useful function and example of its use would be found in the TPINGSend object. Use it to TraceRoute to any host. ^0"
+s[822] = "pingsend.TICMPError^pingsend.html#TICMPError^^List of possible ICMP reply packet types. IE_NoError IE_Other IE_TTLExceed IE_UnreachOther IE_UnreachRoute IE_UnreachAdmin IE_UnreachAddr IE_UnreachPort ^0"
+s[823] = "pop3send^pop3send.html^POP3 protocol client^
Used RFC: RFC-1734, RFC-1939, RFC-2195, RFC-2449, RFC-2595 ^0"
+s[824] = "pop3send.TPOP3Send^pop3send.TPOP3Send.html^Implementation of POP3 client protocol.^
Note: Are you missing properties for setting Username and Password? Look to parent TSynaClient object!
Are you missing properties for specify server address and port? Look to parent TSynaClient too! ^0"
+s[825] = "pop3send.TPOP3Send.Create^pop3send.TPOP3Send.html#Create^^ ^0"
+s[826] = "pop3send.TPOP3Send.Destroy^pop3send.TPOP3Send.html#Destroy^^ ^0"
+s[827] = "pop3send.TPOP3Send.CustomCommand^pop3send.TPOP3Send.html#CustomCommand^^You can call any custom by this method. Call Command without trailing CRLF. If MultiLine parameter is True
, multilined response are expected. Result is True
on sucess. ^0"
+s[828] = "pop3send.TPOP3Send.Capability^pop3send.TPOP3Send.html#Capability^^Call CAPA command for get POP3 server capabilites. note: not all servers support this command! ^0"
+s[829] = "pop3send.TPOP3Send.Login^pop3send.TPOP3Send.html#Login^^Connect to remote POP3 host. If all OK, result is True
. ^0"
+s[830] = "pop3send.TPOP3Send.Logout^pop3send.TPOP3Send.html#Logout^^Disconnects from POP3 server. ^0"
+s[831] = "pop3send.TPOP3Send.Reset^pop3send.TPOP3Send.html#Reset^^Send RSET command. If all OK, result is True
. ^0"
+s[832] = "pop3send.TPOP3Send.NoOp^pop3send.TPOP3Send.html#NoOp^^Send NOOP command. If all OK, result is True
. ^0"
+s[833] = "pop3send.TPOP3Send.Stat^pop3send.TPOP3Send.html#Stat^^Send STAT command and fill StatCount and StatSize property. If all OK, result is True
. ^0"
+s[834] = "pop3send.TPOP3Send.List^pop3send.TPOP3Send.html#List^^Send LIST command. If Value is 0, LIST is for all messages. After successful operation is listing in FullResult. If all OK, result is True
. ^0"
+s[835] = "pop3send.TPOP3Send.Retr^pop3send.TPOP3Send.html#Retr^^Send RETR command. After successful operation dowloaded message in FullResult . If all OK, result is True
. ^0"
+s[836] = "pop3send.TPOP3Send.RetrStream^pop3send.TPOP3Send.html#RetrStream^^Send RETR command. After successful operation dowloaded message in Stream
. If all OK, result is True
. ^0"
+s[837] = "pop3send.TPOP3Send.Dele^pop3send.TPOP3Send.html#Dele^^Send DELE command for delete specified message. If all OK, result is True
. ^0"
+s[838] = "pop3send.TPOP3Send.Top^pop3send.TPOP3Send.html#Top^^Send TOP command. After successful operation dowloaded headers of message and maxlines count of message in FullResult . If all OK, result is True
. ^0"
+s[839] = "pop3send.TPOP3Send.Uidl^pop3send.TPOP3Send.html#Uidl^^Send UIDL command. If Value is 0, UIDL is for all messages. After successful operation is listing in FullResult. If all OK, result is True
. ^0"
+s[840] = "pop3send.TPOP3Send.StartTLS^pop3send.TPOP3Send.html#StartTLS^^Call STLS command for upgrade connection to SSL/TLS mode. ^0"
+s[841] = "pop3send.TPOP3Send.FindCap^pop3send.TPOP3Send.html#FindCap^^Try to find given capabily in capabilty string returned from POP3 server by CAPA command. ^0"
+s[842] = "pop3send.TPOP3Send.ResultCode^pop3send.TPOP3Send.html#ResultCode^^Result code of last POP3 operation. 0 - error, 1 - OK. ^0"
+s[843] = "pop3send.TPOP3Send.ResultString^pop3send.TPOP3Send.html#ResultString^^Result string of last POP3 operation. ^0"
+s[844] = "pop3send.TPOP3Send.FullResult^pop3send.TPOP3Send.html#FullResult^^Stringlist with full lines returned as result of POP3 operation. I.e. if operation is LIST, this property is filled by list of messages. If operation is RETR, this property have downloaded message. ^0"
+s[845] = "pop3send.TPOP3Send.StatCount^pop3send.TPOP3Send.html#StatCount^^After STAT command is there count of messages in inbox. ^0"
+s[846] = "pop3send.TPOP3Send.StatSize^pop3send.TPOP3Send.html#StatSize^^After STAT command is there size of all messages in inbox. ^0"
+s[847] = "pop3send.TPOP3Send.ListSize^pop3send.TPOP3Send.html#ListSize^^After LIST 0 command size of all messages on server, After LIST x size of message x on server ^0"
+s[848] = "pop3send.TPOP3Send.TimeStamp^pop3send.TPOP3Send.html#TimeStamp^^If server support this, after comnnect is in this property timestamp of remote server. ^0"
+s[849] = "pop3send.TPOP3Send.AuthType^pop3send.TPOP3Send.html#AuthType^^Type of authorisation for login to POP3 server. Dafault is autodetect one of possible authorisation. Autodetect do this:
If remote POP3 server support APOP, try login by APOP method. If APOP is not supported, or if APOP login failed, try classic USER+PASS login method. ^0"
+s[850] = "pop3send.TPOP3Send.AutoTLS^pop3send.TPOP3Send.html#AutoTLS^^If is set to True
, then upgrade to SSL/TLS mode if remote server support it. ^0"
+s[851] = "pop3send.TPOP3Send.FullSSL^pop3send.TPOP3Send.html#FullSSL^^SSL/TLS mode is used from first contact to server. Servers with full SSL/TLS mode usualy using non-standard TCP port! ^0"
+s[852] = "pop3send.TPOP3Send.Sock^pop3send.TPOP3Send.html#Sock^^Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc. ^0"
+s[853] = "pop3send.cPop3Protocol^pop3send.html#cPop3Protocol^^ ^0"
+s[854] = "pop3send.TPOP3AuthType^pop3send.html#TPOP3AuthType^^The three types of possible authorization methods for "logging in" to a POP3 server. POP3AuthAll POP3AuthLogin POP3AuthAPOP ^0"
+s[855] = "slogsend^slogsend.html^BSD SYSLOG protocol^
Used RFC: RFC-3164 ^0"
+s[856] = "slogsend.TSyslogMessage^slogsend.TSyslogMessage.html^encoding or decoding of SYSLOG message^ ^0"
+s[857] = "slogsend.TSyslogMessage.Clear^slogsend.TSyslogMessage.html#Clear^^Reset values to defaults ^0"
+s[858] = "slogsend.TSyslogMessage.Facility^slogsend.TSyslogMessage.html#Facility^^Define facilicity of Syslog message. For specify you may use predefined FCL_* constants. Default is "FCL_Local0". ^0"
+s[859] = "slogsend.TSyslogMessage.Severity^slogsend.TSyslogMessage.html#Severity^^Define possible priority of Syslog message. Default is "Debug". ^0"
+s[860] = "slogsend.TSyslogMessage.DateTime^slogsend.TSyslogMessage.html#DateTime^^date and time of Syslog message ^0"
+s[861] = "slogsend.TSyslogMessage.Tag^slogsend.TSyslogMessage.html#Tag^^This is used for identify process of this message. Default is filename of your executable file. ^0"
+s[862] = "slogsend.TSyslogMessage.LogMessage^slogsend.TSyslogMessage.html#LogMessage^^Text of your message for log. ^0"
+s[863] = "slogsend.TSyslogMessage.LocalIP^slogsend.TSyslogMessage.html#LocalIP^^IP address of message sender. ^0"
+s[864] = "slogsend.TSyslogMessage.PacketBuf^slogsend.TSyslogMessage.html#PacketBuf^^This property holds encoded binary SYSLOG packet ^0"
+s[865] = "slogsend.TSyslogSend^slogsend.TSyslogSend.html^This object implement BSD SysLog client^
Note: Are you missing properties for specify server address and port? Look to parent TSynaClient too! ^0"
+s[866] = "slogsend.TSyslogSend.Create^slogsend.TSyslogSend.html#Create^^ ^0"
+s[867] = "slogsend.TSyslogSend.Destroy^slogsend.TSyslogSend.html#Destroy^^ ^0"
+s[868] = "slogsend.TSyslogSend.DoIt^slogsend.TSyslogSend.html#DoIt^^Send Syslog UDP packet defined by SysLogMessage . ^0"
+s[869] = "slogsend.TSyslogSend.SysLogMessage^slogsend.TSyslogSend.html#SysLogMessage^^Syslog message for send ^0"
+s[870] = "slogsend.cSysLogProtocol^slogsend.html#cSysLogProtocol^^ ^0"
+s[871] = "slogsend.FCL_Kernel^slogsend.html#FCL_Kernel^^ ^0"
+s[872] = "slogsend.FCL_UserLevel^slogsend.html#FCL_UserLevel^^ ^0"
+s[873] = "slogsend.FCL_MailSystem^slogsend.html#FCL_MailSystem^^ ^0"
+s[874] = "slogsend.FCL_System^slogsend.html#FCL_System^^ ^0"
+s[875] = "slogsend.FCL_Security^slogsend.html#FCL_Security^^ ^0"
+s[876] = "slogsend.FCL_Syslogd^slogsend.html#FCL_Syslogd^^ ^0"
+s[877] = "slogsend.FCL_Printer^slogsend.html#FCL_Printer^^ ^0"
+s[878] = "slogsend.FCL_News^slogsend.html#FCL_News^^ ^0"
+s[879] = "slogsend.FCL_UUCP^slogsend.html#FCL_UUCP^^ ^0"
+s[880] = "slogsend.FCL_Clock^slogsend.html#FCL_Clock^^ ^0"
+s[881] = "slogsend.FCL_Authorization^slogsend.html#FCL_Authorization^^ ^0"
+s[882] = "slogsend.FCL_FTP^slogsend.html#FCL_FTP^^ ^0"
+s[883] = "slogsend.FCL_NTP^slogsend.html#FCL_NTP^^ ^0"
+s[884] = "slogsend.FCL_LogAudit^slogsend.html#FCL_LogAudit^^ ^0"
+s[885] = "slogsend.FCL_LogAlert^slogsend.html#FCL_LogAlert^^ ^0"
+s[886] = "slogsend.FCL_Time^slogsend.html#FCL_Time^^ ^0"
+s[887] = "slogsend.FCL_Local0^slogsend.html#FCL_Local0^^ ^0"
+s[888] = "slogsend.FCL_Local1^slogsend.html#FCL_Local1^^ ^0"
+s[889] = "slogsend.FCL_Local2^slogsend.html#FCL_Local2^^ ^0"
+s[890] = "slogsend.FCL_Local3^slogsend.html#FCL_Local3^^ ^0"
+s[891] = "slogsend.FCL_Local4^slogsend.html#FCL_Local4^^ ^0"
+s[892] = "slogsend.FCL_Local5^slogsend.html#FCL_Local5^^ ^0"
+s[893] = "slogsend.FCL_Local6^slogsend.html#FCL_Local6^^ ^0"
+s[894] = "slogsend.FCL_Local7^slogsend.html#FCL_Local7^^ ^0"
+s[895] = "slogsend.ToSysLog^slogsend.html#ToSysLog^^Simply send packet to specified Syslog server. ^0"
+s[896] = "slogsend.TSyslogSeverity^slogsend.html#TSyslogSeverity^Define possible priority of Syslog message^ Emergency Alert Critical Error Warning Notice Info Debug ^0"
+s[897] = "smtpsend^smtpsend.html^SMTP client^
Used RFC: RFC-1869, RFC-1870, RFC-1893, RFC-2034, RFC-2104, RFC-2195, RFC-2487, RFC-2554, RFC-2821 ^0"
+s[898] = "smtpsend.TSMTPSend^smtpsend.TSMTPSend.html^Implementation of SMTP and ESMTP procotol^, include some ESMTP extensions, include SSL/TLS too.
Note: Are you missing properties for setting Username and Password for ESMTP? Look to parent TSynaClient object!
Are you missing properties for specify server address and port? Look to parent TSynaClient too! ^0"
+s[899] = "smtpsend.TSMTPSend.Create^smtpsend.TSMTPSend.html#Create^^ ^0"
+s[900] = "smtpsend.TSMTPSend.Destroy^smtpsend.TSMTPSend.html#Destroy^^ ^0"
+s[901] = "smtpsend.TSMTPSend.Login^smtpsend.TSMTPSend.html#Login^^Connects to SMTP server (defined in TSynaClient .TargetHost ) and begin SMTP session. (First try ESMTP EHLO, next old HELO handshake). Parses ESMTP capabilites and if you specified Username and password and remote server can handle AUTH command, try login by AUTH command. Preffered login method is CRAM-MD5 (if safer!). If all OK, result is True
, else result is False
. ^0"
+s[902] = "smtpsend.TSMTPSend.Logout^smtpsend.TSMTPSend.html#Logout^^Close SMTP session (QUIT command) and disconnect from SMTP server. ^0"
+s[903] = "smtpsend.TSMTPSend.Reset^smtpsend.TSMTPSend.html#Reset^^Send RSET SMTP command for reset SMTP session. If all OK, result is True
, else result is False
. ^0"
+s[904] = "smtpsend.TSMTPSend.NoOp^smtpsend.TSMTPSend.html#NoOp^^Send NOOP SMTP command for keep SMTP session. If all OK, result is True
, else result is False
. ^0"
+s[905] = "smtpsend.TSMTPSend.MailFrom^smtpsend.TSMTPSend.html#MailFrom^^Send MAIL FROM SMTP command for set sender e-mail address. If sender's e-mail address is empty string, transmited message is error message.
If size not 0 and remote server can handle SIZE parameter, append SIZE parameter to request. If all OK, result is True
, else result is False
. ^0"
+s[906] = "smtpsend.TSMTPSend.MailTo^smtpsend.TSMTPSend.html#MailTo^^Send RCPT TO SMTP command for set receiver e-mail address. It cannot be an empty string. If all OK, result is True
, else result is False
. ^0"
+s[907] = "smtpsend.TSMTPSend.MailData^smtpsend.TSMTPSend.html#MailData^^Send DATA SMTP command and transmit message data. If all OK, result is True
, else result is False
. ^0"
+s[908] = "smtpsend.TSMTPSend.Etrn^smtpsend.TSMTPSend.html#Etrn^^Send ETRN SMTP command for start sending of remote queue for domain in Value. If all OK, result is True
, else result is False
. ^0"
+s[909] = "smtpsend.TSMTPSend.Verify^smtpsend.TSMTPSend.html#Verify^^Send VRFY SMTP command for check receiver e-mail address. It cannot be an empty string. If all OK, result is True
, else result is False
. ^0"
+s[910] = "smtpsend.TSMTPSend.StartTLS^smtpsend.TSMTPSend.html#StartTLS^^Call STARTTLS command for upgrade connection to SSL/TLS mode. ^0"
+s[911] = "smtpsend.TSMTPSend.EnhCodeString^smtpsend.TSMTPSend.html#EnhCodeString^^Return string descriptive text for enhanced result codes stored in EnhCode1 , EnhCode2 and EnhCode3 . ^0"
+s[912] = "smtpsend.TSMTPSend.FindCap^smtpsend.TSMTPSend.html#FindCap^^Try to find specified capability in ESMTP response. ^0"
+s[913] = "smtpsend.TSMTPSend.ResultCode^smtpsend.TSMTPSend.html#ResultCode^^result code of last SMTP command. ^0"
+s[914] = "smtpsend.TSMTPSend.ResultString^smtpsend.TSMTPSend.html#ResultString^^result string of last SMTP command (begin with string representation of result code). ^0"
+s[915] = "smtpsend.TSMTPSend.FullResult^smtpsend.TSMTPSend.html#FullResult^^All result strings of last SMTP command (result is maybe multiline!). ^0"
+s[916] = "smtpsend.TSMTPSend.ESMTPcap^smtpsend.TSMTPSend.html#ESMTPcap^^List of ESMTP capabilites of remote ESMTP server. (If you connect to ESMTP server only!). ^0"
+s[917] = "smtpsend.TSMTPSend.ESMTP^smtpsend.TSMTPSend.html#ESMTP^^True
if you successfuly logged to ESMTP server. ^0"
+s[918] = "smtpsend.TSMTPSend.AuthDone^smtpsend.TSMTPSend.html#AuthDone^^True
if you successfuly pass authorisation to remote server. ^0"
+s[919] = "smtpsend.TSMTPSend.ESMTPSize^smtpsend.TSMTPSend.html#ESMTPSize^^True
if remote server can handle SIZE parameter. ^0"
+s[920] = "smtpsend.TSMTPSend.MaxSize^smtpsend.TSMTPSend.html#MaxSize^^When ESMTPSize is True
, contains max length of message that remote server can handle. ^0"
+s[921] = "smtpsend.TSMTPSend.EnhCode1^smtpsend.TSMTPSend.html#EnhCode1^^First digit of Enhanced result code. If last operation does not have enhanced result code, values is 0. ^0"
+s[922] = "smtpsend.TSMTPSend.EnhCode2^smtpsend.TSMTPSend.html#EnhCode2^^Second digit of Enhanced result code. If last operation does not have enhanced result code, values is 0. ^0"
+s[923] = "smtpsend.TSMTPSend.EnhCode3^smtpsend.TSMTPSend.html#EnhCode3^^Third digit of Enhanced result code. If last operation does not have enhanced result code, values is 0. ^0"
+s[924] = "smtpsend.TSMTPSend.SystemName^smtpsend.TSMTPSend.html#SystemName^^name of our system used in HELO and EHLO command. Implicit value is internet address of your machine. ^0"
+s[925] = "smtpsend.TSMTPSend.AutoTLS^smtpsend.TSMTPSend.html#AutoTLS^^If is set to true, then upgrade to SSL/TLS mode if remote server support it. ^0"
+s[926] = "smtpsend.TSMTPSend.FullSSL^smtpsend.TSMTPSend.html#FullSSL^^SSL/TLS mode is used from first contact to server. Servers with full SSL/TLS mode usualy using non-standard TCP port! ^0"
+s[927] = "smtpsend.TSMTPSend.Sock^smtpsend.TSMTPSend.html#Sock^^Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc. ^0"
+s[928] = "smtpsend.cSmtpProtocol^smtpsend.html#cSmtpProtocol^^ ^0"
+s[929] = "smtpsend.SendToRaw^smtpsend.html#SendToRaw^^A very useful function and example of its use would be found in the TSMTPsend object. Send maildata (text of e-mail with all SMTP headers! For example when text of message is created by TMimeMess object) from "MailFrom" e-mail address to "MailTo" e-mail address (If you need more then one receiver, then separate their addresses by comma).
Function sends e-mail to a SMTP server defined in "SMTPhost" parameter. Username and password are used for authorization to the "SMTPhost". If you don't want authorization, set "Username" and "Password" to empty strings. If e-mail message is successfully sent, the result returns True
.
If you need use different port number then standard, then add this port number to SMTPhost after colon. (i.e. '127.0.0.1:1025') ^0"
+s[930] = "smtpsend.SendTo^smtpsend.html#SendTo^^A very useful function and example of its use would be found in the TSMTPsend object. Send "Maildata" (text of e-mail without any SMTP headers!) from "MailFrom" e-mail address to "MailTo" e-mail address with "Subject". (If you need more then one receiver, then separate their addresses by comma).
This function constructs all needed SMTP headers (with DATE header) and sends the e-mail to the SMTP server defined in the "SMTPhost" parameter. If the e-mail message is successfully sent, the result will be True
.
If you need use different port number then standard, then add this port number to SMTPhost after colon. (i.e. '127.0.0.1:1025') ^0"
+s[931] = "smtpsend.SendToEx^smtpsend.html#SendToEx^^A very useful function and example of its use would be found in the TSMTPsend object. Sends "MailData" (text of e-mail without any SMTP headers!) from "MailFrom" e-mail address to "MailTo" e-mail address (If you need more then one receiver, then separate their addresses by comma).
This function sends the e-mail to the SMTP server defined in the "SMTPhost" parameter. Username and password are used for authorization to the "SMTPhost". If you dont want authorization, set "Username" and "Password" to empty Strings. If the e-mail message is successfully sent, the result will be True
.
If you need use different port number then standard, then add this port number to SMTPhost after colon. (i.e. '127.0.0.1:1025') ^0"
+s[932] = "snmpsend^snmpsend.html^SNMP client^ Supports SNMPv1 include traps, SNMPv2c and SNMPv3 include authorization and privacy encryption.
Used RFC: RFC-1157, RFC-1901, RFC-3412, RFC-3414, RFC-3416, RFC-3826
Supported Authorization hashes: MD5, SHA1 Supported Privacy encryptions: DES, 3DES, AES ^0"
+s[933] = "snmpsend.TSNMPMib^snmpsend.TSNMPMib.html^Data object with one record of MIB OID and corresponding values.^ ^0"
+s[934] = "snmpsend.TSNMPMib.OID^snmpsend.TSNMPMib.html#OID^^OID number in string format. ^0"
+s[935] = "snmpsend.TSNMPMib.Value^snmpsend.TSNMPMib.html#Value^^Value of OID object in string format. ^0"
+s[936] = "snmpsend.TSNMPMib.ValueType^snmpsend.TSNMPMib.html#ValueType^^Define type of Value. Supported values are defined in asn1util . For queries use ASN1_NULL, becouse you don't know type in response! ^0"
+s[937] = "snmpsend.TV3Sync^snmpsend.TV3Sync.html^It holding all information for SNMPv3 agent synchronization^ Used internally. ^0"
+s[938] = "snmpsend.TV3Sync.EngineID^snmpsend.TV3Sync.html#EngineID^^ ^0"
+s[939] = "snmpsend.TV3Sync.EngineBoots^snmpsend.TV3Sync.html#EngineBoots^^ ^0"
+s[940] = "snmpsend.TV3Sync.EngineTime^snmpsend.TV3Sync.html#EngineTime^^ ^0"
+s[941] = "snmpsend.TV3Sync.EngineStamp^snmpsend.TV3Sync.html#EngineStamp^^ ^0"
+s[942] = "snmpsend.TSNMPRec^snmpsend.TSNMPRec.html^Data object abstracts SNMP data packet^ ^0"
+s[943] = "snmpsend.TSNMPRec.Create^snmpsend.TSNMPRec.html#Create^^ ^0"
+s[944] = "snmpsend.TSNMPRec.Destroy^snmpsend.TSNMPRec.html#Destroy^^ ^0"
+s[945] = "snmpsend.TSNMPRec.DecodeBuf^snmpsend.TSNMPRec.html#DecodeBuf^^Decode SNMP packet in buffer to object properties. ^0"
+s[946] = "snmpsend.TSNMPRec.EncodeBuf^snmpsend.TSNMPRec.html#EncodeBuf^^Encode obeject properties to SNMP packet. ^0"
+s[947] = "snmpsend.TSNMPRec.Clear^snmpsend.TSNMPRec.html#Clear^^Clears all object properties to default values. ^0"
+s[948] = "snmpsend.TSNMPRec.MIBAdd^snmpsend.TSNMPRec.html#MIBAdd^^Add entry to SNMPMibList . For queries use value as empty string, and ValueType as ASN1_NULL. ^0"
+s[949] = "snmpsend.TSNMPRec.MIBDelete^snmpsend.TSNMPRec.html#MIBDelete^^Delete entry from SNMPMibList . ^0"
+s[950] = "snmpsend.TSNMPRec.MIBGet^snmpsend.TSNMPRec.html#MIBGet^^Search SNMPMibList list for MIB and return correspond value. ^0"
+s[951] = "snmpsend.TSNMPRec.MIBCount^snmpsend.TSNMPRec.html#MIBCount^^return number of entries in MIB array. ^0"
+s[952] = "snmpsend.TSNMPRec.MIBByIndex^snmpsend.TSNMPRec.html#MIBByIndex^^Return MIB information from given row of MIB array. ^0"
+s[953] = "snmpsend.TSNMPRec.SNMPMibList^snmpsend.TSNMPRec.html#SNMPMibList^^List of TSNMPMib objects. ^0"
+s[954] = "snmpsend.TSNMPRec.Version^snmpsend.TSNMPRec.html#Version^^Version of SNMP packet. Default value is 0 (SNMP ver. 1). You can use value 1 for SNMPv2c or value 3 for SNMPv3. ^0"
+s[955] = "snmpsend.TSNMPRec.Community^snmpsend.TSNMPRec.html#Community^^Community string for autorize access to SNMP server. (Case sensitive!) Community string is not used in SNMPv3! Use UserName and Password instead! ^0"
+s[956] = "snmpsend.TSNMPRec.PDUType^snmpsend.TSNMPRec.html#PDUType^^Define type of SNMP operation. ^0"
+s[957] = "snmpsend.TSNMPRec.ID^snmpsend.TSNMPRec.html#ID^^Contains ID number. Not need to use. ^0"
+s[958] = "snmpsend.TSNMPRec.ErrorStatus^snmpsend.TSNMPRec.html#ErrorStatus^^When packet is reply, contains error code. Supported values are defined by E* constants. ^0"
+s[959] = "snmpsend.TSNMPRec.ErrorIndex^snmpsend.TSNMPRec.html#ErrorIndex^^Point to error position in reply packet. Not usefull for users. It only good for debugging! ^0"
+s[960] = "snmpsend.TSNMPRec.NonRepeaters^snmpsend.TSNMPRec.html#NonRepeaters^^special value for GetBulkRequest of SNMPv2 and v3. ^0"
+s[961] = "snmpsend.TSNMPRec.MaxRepetitions^snmpsend.TSNMPRec.html#MaxRepetitions^^special value for GetBulkRequest of SNMPv2 and v3. ^0"
+s[962] = "snmpsend.TSNMPRec.MaxSize^snmpsend.TSNMPRec.html#MaxSize^^Maximum message size in bytes for SNMPv3. For sending is default 1472 bytes. ^0"
+s[963] = "snmpsend.TSNMPRec.Flags^snmpsend.TSNMPRec.html#Flags^^Specify if message is authorised or encrypted. Used only in SNMPv3. ^0"
+s[964] = "snmpsend.TSNMPRec.FlagReportable^snmpsend.TSNMPRec.html#FlagReportable^^For SNMPv3.... If is True
, SNMP agent must send reply (at least with some error). ^0"
+s[965] = "snmpsend.TSNMPRec.ContextEngineID^snmpsend.TSNMPRec.html#ContextEngineID^^For SNMPv3. If not specified, is used value from AuthEngineID ^0"
+s[966] = "snmpsend.TSNMPRec.ContextName^snmpsend.TSNMPRec.html#ContextName^^For SNMPv3. ^0"
+s[967] = "snmpsend.TSNMPRec.AuthMode^snmpsend.TSNMPRec.html#AuthMode^^For SNMPv3. Specify Authorization mode. (specify used hash for authorization) ^0"
+s[968] = "snmpsend.TSNMPRec.PrivMode^snmpsend.TSNMPRec.html#PrivMode^^For SNMPv3. Specify Privacy mode. ^0"
+s[969] = "snmpsend.TSNMPRec.AuthEngineID^snmpsend.TSNMPRec.html#AuthEngineID^^value used by SNMPv3 authorisation for synchronization with SNMP agent. ^0"
+s[970] = "snmpsend.TSNMPRec.AuthEngineBoots^snmpsend.TSNMPRec.html#AuthEngineBoots^^value used by SNMPv3 authorisation for synchronization with SNMP agent. ^0"
+s[971] = "snmpsend.TSNMPRec.AuthEngineTime^snmpsend.TSNMPRec.html#AuthEngineTime^^value used by SNMPv3 authorisation for synchronization with SNMP agent. ^0"
+s[972] = "snmpsend.TSNMPRec.AuthEngineTimeStamp^snmpsend.TSNMPRec.html#AuthEngineTimeStamp^^value used by SNMPv3 authorisation for synchronization with SNMP agent. ^0"
+s[973] = "snmpsend.TSNMPRec.UserName^snmpsend.TSNMPRec.html#UserName^^SNMPv3 authorization username ^0"
+s[974] = "snmpsend.TSNMPRec.Password^snmpsend.TSNMPRec.html#Password^^SNMPv3 authorization password ^0"
+s[975] = "snmpsend.TSNMPRec.AuthKey^snmpsend.TSNMPRec.html#AuthKey^^For SNMPv3. Computed Athorization key from Password . ^0"
+s[976] = "snmpsend.TSNMPRec.PrivPassword^snmpsend.TSNMPRec.html#PrivPassword^^SNMPv3 privacy password ^0"
+s[977] = "snmpsend.TSNMPRec.PrivKey^snmpsend.TSNMPRec.html#PrivKey^^For SNMPv3. Computed Privacy key from PrivPassword . ^0"
+s[978] = "snmpsend.TSNMPRec.OldTrapEnterprise^snmpsend.TSNMPRec.html#OldTrapEnterprise^^MIB value to identify the object that sent the TRAPv1. ^0"
+s[979] = "snmpsend.TSNMPRec.OldTrapHost^snmpsend.TSNMPRec.html#OldTrapHost^^Address of TRAPv1 sender (IP address). ^0"
+s[980] = "snmpsend.TSNMPRec.OldTrapGen^snmpsend.TSNMPRec.html#OldTrapGen^^Generic TRAPv1 identification. ^0"
+s[981] = "snmpsend.TSNMPRec.OldTrapSpec^snmpsend.TSNMPRec.html#OldTrapSpec^^Specific TRAPv1 identification. ^0"
+s[982] = "snmpsend.TSNMPRec.OldTrapTimeTicks^snmpsend.TSNMPRec.html#OldTrapTimeTicks^^Number of 1/100th of seconds since last reboot or power up. (for TRAPv1) ^0"
+s[983] = "snmpsend.TSNMPSend^snmpsend.TSNMPSend.html^Implementation of SNMP protocol.^
Note: Are you missing properties for specify server address and port? Look to parent TSynaClient too! ^0"
+s[984] = "snmpsend.TSNMPSend.Create^snmpsend.TSNMPSend.html#Create^^ ^0"
+s[985] = "snmpsend.TSNMPSend.Destroy^snmpsend.TSNMPSend.html#Destroy^^ ^0"
+s[986] = "snmpsend.TSNMPSend.SendRequest^snmpsend.TSNMPSend.html#SendRequest^^Connects to a Host and send there query. If in timeout SNMP server send back query, result is True
. If is used SNMPv3, then it synchronize self with SNMPv3 agent first. (It is needed for SNMPv3 auhorization!) ^0"
+s[987] = "snmpsend.TSNMPSend.SendTrap^snmpsend.TSNMPSend.html#SendTrap^^Send SNMP packet only, but not waits for reply. Good for sending traps. ^0"
+s[988] = "snmpsend.TSNMPSend.RecvTrap^snmpsend.TSNMPSend.html#RecvTrap^^Receive SNMP packet only. Good for receiving traps. ^0"
+s[989] = "snmpsend.TSNMPSend.DoIt^snmpsend.TSNMPSend.html#DoIt^^Mapped to SendRequest internally. This function is only for backward compatibility. ^0"
+s[990] = "snmpsend.TSNMPSend.Buffer^snmpsend.TSNMPSend.html#Buffer^^contains raw binary form of SNMP packet. Good for debugging. ^0"
+s[991] = "snmpsend.TSNMPSend.HostIP^snmpsend.TSNMPSend.html#HostIP^^After SNMP operation hold IP address of remote side. ^0"
+s[992] = "snmpsend.TSNMPSend.Query^snmpsend.TSNMPSend.html#Query^^Data object contains SNMP query. ^0"
+s[993] = "snmpsend.TSNMPSend.Reply^snmpsend.TSNMPSend.html#Reply^^Data object contains SNMP reply. ^0"
+s[994] = "snmpsend.TSNMPSend.Sock^snmpsend.TSNMPSend.html#Sock^^Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc. ^0"
+s[995] = "snmpsend.cSnmpProtocol^snmpsend.html#cSnmpProtocol^^ ^0"
+s[996] = "snmpsend.cSnmpTrapProtocol^snmpsend.html#cSnmpTrapProtocol^^ ^0"
+s[997] = "snmpsend.SNMP_V1^snmpsend.html#SNMP_V1^^ ^0"
+s[998] = "snmpsend.SNMP_V2C^snmpsend.html#SNMP_V2C^^ ^0"
+s[999] = "snmpsend.SNMP_V3^snmpsend.html#SNMP_V3^^ ^0"
+s[1000] = "snmpsend.PDUGetRequest^snmpsend.html#PDUGetRequest^^ ^0"
+s[1001] = "snmpsend.PDUGetNextRequest^snmpsend.html#PDUGetNextRequest^^ ^0"
+s[1002] = "snmpsend.PDUGetResponse^snmpsend.html#PDUGetResponse^^ ^0"
+s[1003] = "snmpsend.PDUSetRequest^snmpsend.html#PDUSetRequest^^ ^0"
+s[1004] = "snmpsend.PDUTrap^snmpsend.html#PDUTrap^^ ^0"
+s[1005] = "snmpsend.PDUGetBulkRequest^snmpsend.html#PDUGetBulkRequest^^ ^0"
+s[1006] = "snmpsend.PDUInformRequest^snmpsend.html#PDUInformRequest^^ ^0"
+s[1007] = "snmpsend.PDUTrapV2^snmpsend.html#PDUTrapV2^^ ^0"
+s[1008] = "snmpsend.PDUReport^snmpsend.html#PDUReport^^ ^0"
+s[1009] = "snmpsend.ENoError^snmpsend.html#ENoError^^ ^0"
+s[1010] = "snmpsend.ETooBig^snmpsend.html#ETooBig^^ ^0"
+s[1011] = "snmpsend.ENoSuchName^snmpsend.html#ENoSuchName^^ ^0"
+s[1012] = "snmpsend.EBadValue^snmpsend.html#EBadValue^^ ^0"
+s[1013] = "snmpsend.EReadOnly^snmpsend.html#EReadOnly^^ ^0"
+s[1014] = "snmpsend.EGenErr^snmpsend.html#EGenErr^^ ^0"
+s[1015] = "snmpsend.ENoAccess^snmpsend.html#ENoAccess^^ ^0"
+s[1016] = "snmpsend.EWrongType^snmpsend.html#EWrongType^^ ^0"
+s[1017] = "snmpsend.EWrongLength^snmpsend.html#EWrongLength^^ ^0"
+s[1018] = "snmpsend.EWrongEncoding^snmpsend.html#EWrongEncoding^^ ^0"
+s[1019] = "snmpsend.EWrongValue^snmpsend.html#EWrongValue^^ ^0"
+s[1020] = "snmpsend.ENoCreation^snmpsend.html#ENoCreation^^ ^0"
+s[1021] = "snmpsend.EInconsistentValue^snmpsend.html#EInconsistentValue^^ ^0"
+s[1022] = "snmpsend.EResourceUnavailable^snmpsend.html#EResourceUnavailable^^ ^0"
+s[1023] = "snmpsend.ECommitFailed^snmpsend.html#ECommitFailed^^ ^0"
+s[1024] = "snmpsend.EUndoFailed^snmpsend.html#EUndoFailed^^ ^0"
+s[1025] = "snmpsend.EAuthorizationError^snmpsend.html#EAuthorizationError^^ ^0"
+s[1026] = "snmpsend.ENotWritable^snmpsend.html#ENotWritable^^ ^0"
+s[1027] = "snmpsend.EInconsistentName^snmpsend.html#EInconsistentName^^ ^0"
+s[1028] = "snmpsend.SNMPGet^snmpsend.html#SNMPGet^^A very useful function and example of its use would be found in the TSNMPSend object. It implements basic GET method of the SNMP protocol. The MIB value is located in the "OID" variable, and is sent to the requested "SNMPHost" with the proper "Community" access identifier. Upon a successful retrieval, "Value" will contain the information requested. If the SNMP operation is successful, the result returns True
. ^0"
+s[1029] = "snmpsend.SNMPSet^snmpsend.html#SNMPSet^^This is useful function and example of use TSNMPSend object. It implements the basic SET method of the SNMP protocol. If the SNMP operation is successful, the result is True
. "Value" is value of MIB Oid for "SNMPHost" with "Community" access identifier. You must specify "ValueType" too. ^0"
+s[1030] = "snmpsend.SNMPGetNext^snmpsend.html#SNMPGetNext^^A very useful function and example of its use would be found in the TSNMPSend object. It implements basic GETNEXT method of the SNMP protocol. The MIB value is located in the "OID" variable, and is sent to the requested "SNMPHost" with the proper "Community" access identifier. Upon a successful retrieval, "Value" will contain the information requested. If the SNMP operation is successful, the result returns True
. ^0"
+s[1031] = "snmpsend.SNMPGetTable^snmpsend.html#SNMPGetTable^^A very useful function and example of its use would be found in the TSNMPSend object. It implements basic read of SNMP MIB tables. As BaseOID you must specify basic MIB OID of requested table (base IOD is OID without row and column specificator!) Table is readed into stringlist, where each string is comma delimited string.
Warning: this function is not have best performance. For better performance you must write your own function. best performace you can get by knowledge of structuture of table and by more then one MIB on one query. ^0"
+s[1032] = "snmpsend.SNMPGetTableElement^snmpsend.html#SNMPGetTableElement^^A very useful function and example of its use would be found in the TSNMPSend object. It implements basic read of SNMP MIB table element. As BaseOID you must specify basic MIB OID of requested table (base IOD is OID without row and column specificator!) As next you must specify identificator of row and column for specify of needed field of table. ^0"
+s[1033] = "snmpsend.SendTrap^snmpsend.html#SendTrap^^A very useful function and example of its use would be found in the TSNMPSend object. It implements a TRAPv1 to send with all data in the parameters. ^0"
+s[1034] = "snmpsend.RecvTrap^snmpsend.html#RecvTrap^^A very useful function and example of its use would be found in the TSNMPSend object. It receives a TRAPv1 and returns all the data that comes with it. ^0"
+s[1035] = "snmpsend.TV3Flags^snmpsend.html#TV3Flags^Possible values for SNMPv3 flags.^ This flags specify level of authorization and encryption. NoAuthNoPriv AuthNoPriv AuthPriv ^0"
+s[1036] = "snmpsend.TV3Auth^snmpsend.html#TV3Auth^Type of SNMPv3 authorization^ AuthMD5 AuthSHA1 ^0"
+s[1037] = "snmpsend.TV3Priv^snmpsend.html#TV3Priv^Type of SNMPv3 privacy^ PrivDES Priv3DES PrivAES ^0"
+s[1038] = "sntpsend^sntpsend.html^ NTP and SNTP client^
Used RFC: RFC-1305, RFC-2030 ^0"
+s[1039] = "sntpsend.TNtp^sntpsend.TNtp.html^Record containing the NTP packet.^ ^0"
+s[1040] = "sntpsend.TNtp.mode^sntpsend.TNtp.html#mode^^ ^0"
+s[1041] = "sntpsend.TNtp.stratum^sntpsend.TNtp.html#stratum^^ ^0"
+s[1042] = "sntpsend.TNtp.poll^sntpsend.TNtp.html#poll^^ ^0"
+s[1043] = "sntpsend.TNtp.Precision^sntpsend.TNtp.html#Precision^^ ^0"
+s[1044] = "sntpsend.TNtp.RootDelay^sntpsend.TNtp.html#RootDelay^^ ^0"
+s[1045] = "sntpsend.TNtp.RootDisperson^sntpsend.TNtp.html#RootDisperson^^ ^0"
+s[1046] = "sntpsend.TNtp.RefID^sntpsend.TNtp.html#RefID^^ ^0"
+s[1047] = "sntpsend.TNtp.Ref1^sntpsend.TNtp.html#Ref1^^ ^0"
+s[1048] = "sntpsend.TNtp.Ref2^sntpsend.TNtp.html#Ref2^^ ^0"
+s[1049] = "sntpsend.TNtp.Org1^sntpsend.TNtp.html#Org1^^ ^0"
+s[1050] = "sntpsend.TNtp.Org2^sntpsend.TNtp.html#Org2^^ ^0"
+s[1051] = "sntpsend.TNtp.Rcv1^sntpsend.TNtp.html#Rcv1^^ ^0"
+s[1052] = "sntpsend.TNtp.Rcv2^sntpsend.TNtp.html#Rcv2^^ ^0"
+s[1053] = "sntpsend.TNtp.Xmit1^sntpsend.TNtp.html#Xmit1^^ ^0"
+s[1054] = "sntpsend.TNtp.Xmit2^sntpsend.TNtp.html#Xmit2^^ ^0"
+s[1055] = "sntpsend.TSNTPSend^sntpsend.TSNTPSend.html^Implementation of NTP and SNTP client protocol^, include time synchronisation. It can send NTP or SNTP time queries, or it can receive NTP broadcasts too.
Note: Are you missing properties for specify server address and port? Look to parent TSynaClient too! ^0"
+s[1056] = "sntpsend.TSNTPSend.Create^sntpsend.TSNTPSend.html#Create^^ ^0"
+s[1057] = "sntpsend.TSNTPSend.Destroy^sntpsend.TSNTPSend.html#Destroy^^ ^0"
+s[1058] = "sntpsend.TSNTPSend.DecodeTs^sntpsend.TSNTPSend.html#DecodeTs^^Decode 128 bit timestamp used in NTP packet to TDateTime type. ^0"
+s[1059] = "sntpsend.TSNTPSend.EncodeTs^sntpsend.TSNTPSend.html#EncodeTs^^Decode TDateTime type to 128 bit timestamp used in NTP packet. ^0"
+s[1060] = "sntpsend.TSNTPSend.GetSNTP^sntpsend.TSNTPSend.html#GetSNTP^^Send request to TSynaClient .TargetHost and wait for reply. If all is OK, then result is True
and NTPReply and NTPTime are valid. ^0"
+s[1061] = "sntpsend.TSNTPSend.GetNTP^sntpsend.TSNTPSend.html#GetNTP^^Send request to TSynaClient .TargetHost and wait for reply. If all is OK, then result is True
and NTPReply and NTPTime are valid. Result time is after all needed corrections. ^0"
+s[1062] = "sntpsend.TSNTPSend.GetBroadcastNTP^sntpsend.TSNTPSend.html#GetBroadcastNTP^^Wait for broadcast NTP packet. If all OK, result is True
and NTPReply and NTPTime are valid. ^0"
+s[1063] = "sntpsend.TSNTPSend.NTPReply^sntpsend.TSNTPSend.html#NTPReply^^Holds last received NTP packet. ^0"
+s[1064] = "sntpsend.TSNTPSend.NTPTime^sntpsend.TSNTPSend.html#NTPTime^^Date and time of remote NTP or SNTP server. (UTC time!!!) ^0"
+s[1065] = "sntpsend.TSNTPSend.NTPOffset^sntpsend.TSNTPSend.html#NTPOffset^^Offset between your computer and remote NTP or SNTP server. ^0"
+s[1066] = "sntpsend.TSNTPSend.NTPDelay^sntpsend.TSNTPSend.html#NTPDelay^^Delay between your computer and remote NTP or SNTP server. ^0"
+s[1067] = "sntpsend.TSNTPSend.MaxSyncDiff^sntpsend.TSNTPSend.html#MaxSyncDiff^^Define allowed maximum difference between your time and remote time for synchronising time. If difference is bigger, your system time is not changed! ^0"
+s[1068] = "sntpsend.TSNTPSend.SyncTime^sntpsend.TSNTPSend.html#SyncTime^^If True
, after successfull getting time is local computer clock synchronised to given time. For synchronising time you must have proper rights! (Usually Administrator) ^0"
+s[1069] = "sntpsend.TSNTPSend.Sock^sntpsend.TSNTPSend.html#Sock^^Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc. ^0"
+s[1070] = "sntpsend.cNtpProtocol^sntpsend.html#cNtpProtocol^^ ^0"
+s[1071] = "ssl_cryptlib^ssl_cryptlib.html^SSL/SSH plugin for CryptLib^
This plugin requires cl32.dll at least version 3.2.0! It can be used on Win32 and Linux. This library is staticly linked - when you compile your application with this plugin, you MUST distribute it with Cryptib library, otherwise you cannot run your application!
It can work with keys and certificates stored as PKCS#15 only! It must be stored as disk file only, you cannot load them from memory! Each file can hold multiple keys and certificates. You must identify it by 'label' stored in TSSLCryptLib .PrivateKeyLabel .
If you need to use secure connection and authorize self by certificate (each SSL/TLS server or client with client authorization), then use TCustomSSL .PrivateKeyFile , TSSLCryptLib .PrivateKeyLabel and TCustomSSL .KeyPassword properties.
If you need to use server what verifying client certificates, then use TCustomSSL .CertCAFile as PKCS#15 file with public keyas of allowed clients. Clients with non-matching certificates will be rejected by cryptLib.
This plugin is capable to create Ad-Hoc certificates. When you start SSL/TLS server without explicitly assigned key and certificate, then this plugin create Ad-Hoc key and certificate for each incomming connection by self. It slowdown accepting of new connections!
You can use this plugin for SSHv2 connections too! You must explicitly set TCustomSSL .SSLType to value LT_SSHv2 and set TCustomSSL .Username and TCustomSSL .Password . You can use special SSH channels too, see TCustomSSL . ^0"
+s[1072] = "ssl_cryptlib.TSSLCryptLib^ssl_cryptlib.TSSLCryptLib.html^class implementing CryptLib SSL/SSH plugin.^ Instance of this class will be created for each TTCPBlockSocket . You not need to create instance of this class, all is done by Synapse itself! ^0"
+s[1073] = "ssl_cryptlib.TSSLCryptLib.Create^ssl_cryptlib.TSSLCryptLib.html#Create^^See TCustomSSL .Create ^0"
+s[1074] = "ssl_cryptlib.TSSLCryptLib.Destroy^ssl_cryptlib.TSSLCryptLib.html#Destroy^^ ^0"
+s[1075] = "ssl_cryptlib.TSSLCryptLib.SetCertCAFile^ssl_cryptlib.TSSLCryptLib.html#SetCertCAFile^^Load trusted CA's in PEM format ^0"
+s[1076] = "ssl_cryptlib.TSSLCryptLib.LibVersion^ssl_cryptlib.TSSLCryptLib.html#LibVersion^^See TCustomSSL .LibVersion ^0"
+s[1077] = "ssl_cryptlib.TSSLCryptLib.LibName^ssl_cryptlib.TSSLCryptLib.html#LibName^^See TCustomSSL .LibName ^0"
+s[1078] = "ssl_cryptlib.TSSLCryptLib.Assign^ssl_cryptlib.TSSLCryptLib.html#Assign^^See TCustomSSL .Assign ^0"
+s[1079] = "ssl_cryptlib.TSSLCryptLib.Connect^ssl_cryptlib.TSSLCryptLib.html#Connect^^See TCustomSSL .Connect and ssl_cryptlib for more details. ^0"
+s[1080] = "ssl_cryptlib.TSSLCryptLib.Accept^ssl_cryptlib.TSSLCryptLib.html#Accept^^See TCustomSSL .Accept and ssl_cryptlib for more details. ^0"
+s[1081] = "ssl_cryptlib.TSSLCryptLib.Shutdown^ssl_cryptlib.TSSLCryptLib.html#Shutdown^^See TCustomSSL .Shutdown ^0"
+s[1082] = "ssl_cryptlib.TSSLCryptLib.BiShutdown^ssl_cryptlib.TSSLCryptLib.html#BiShutdown^^See TCustomSSL .BiShutdown ^0"
+s[1083] = "ssl_cryptlib.TSSLCryptLib.SendBuffer^ssl_cryptlib.TSSLCryptLib.html#SendBuffer^^See TCustomSSL .SendBuffer ^0"
+s[1084] = "ssl_cryptlib.TSSLCryptLib.RecvBuffer^ssl_cryptlib.TSSLCryptLib.html#RecvBuffer^^See TCustomSSL .RecvBuffer ^0"
+s[1085] = "ssl_cryptlib.TSSLCryptLib.WaitingData^ssl_cryptlib.TSSLCryptLib.html#WaitingData^^See TCustomSSL .WaitingData ^0"
+s[1086] = "ssl_cryptlib.TSSLCryptLib.GetSSLVersion^ssl_cryptlib.TSSLCryptLib.html#GetSSLVersion^^See TCustomSSL .GetSSLVersion ^0"
+s[1087] = "ssl_cryptlib.TSSLCryptLib.GetPeerSubject^ssl_cryptlib.TSSLCryptLib.html#GetPeerSubject^^See TCustomSSL .GetPeerSubject ^0"
+s[1088] = "ssl_cryptlib.TSSLCryptLib.GetPeerIssuer^ssl_cryptlib.TSSLCryptLib.html#GetPeerIssuer^^See TCustomSSL .GetPeerIssuer ^0"
+s[1089] = "ssl_cryptlib.TSSLCryptLib.GetPeerName^ssl_cryptlib.TSSLCryptLib.html#GetPeerName^^See TCustomSSL .GetPeerName ^0"
+s[1090] = "ssl_cryptlib.TSSLCryptLib.GetPeerFingerprint^ssl_cryptlib.TSSLCryptLib.html#GetPeerFingerprint^^See TCustomSSL .GetPeerFingerprint ^0"
+s[1091] = "ssl_cryptlib.TSSLCryptLib.GetVerifyCert^ssl_cryptlib.TSSLCryptLib.html#GetVerifyCert^^See TCustomSSL .GetVerifyCert ^0"
+s[1092] = "ssl_cryptlib.TSSLCryptLib.PrivateKeyLabel^ssl_cryptlib.TSSLCryptLib.html#PrivateKeyLabel^^name of certificate/key within PKCS#15 file. It can hold more then one certificate/key and each certificate/key must have unique label within one file. ^0"
+s[1093] = "ssl_openssl^ssl_openssl.html^SSL plugin for OpenSSL^
You need OpenSSL libraries version 0.9.7. It can work with 0.9.6 too, but application mysteriously crashing when you are using freePascal on Linux. Use Kylix on Linux is OK! If you have version 0.9.7 on Linux, then I not see any problems with FreePascal.
OpenSSL libraries are loaded dynamicly - you not need OpenSSl librares even you compile your application with this unit. SSL just not working when you not have OpenSSL libraries.
This plugin have limited support for .NET too! Because is not possible to use callbacks with CDECL calling convention under .NET, is not supported key/certificate passwords and multithread locking. :-(
For handling keys and certificates you can use this properties:
TCustomSSL .CertificateFile for PEM or ASN1 DER (cer) format. TCustomSSL .Certificate for ASN1 DER format only. TCustomSSL .PrivateKeyFile for PEM or ASN1 DER (key) format. TCustomSSL .PrivateKey for ASN1 DER format only. TCustomSSL .CertCAFile for PEM CA certificate bundle. TCustomSSL .PFXfile for PFX format. TCustomSSL .PFX for PFX format from binary string.
This plugin is capable to create Ad-Hoc certificates. When you start SSL/TLS server without explicitly assigned key and certificate, then this plugin create Ad-Hoc key and certificate for each incomming connection by self. It slowdown accepting of new connections! ^0"
+s[1094] = "ssl_openssl.TSSLOpenSSL^ssl_openssl.TSSLOpenSSL.html^class implementing OpenSSL SSL plugin.^ Instance of this class will be created for each TTCPBlockSocket . You not need to create instance of this class, all is done by Synapse itself! ^0"
+s[1095] = "ssl_openssl.TSSLOpenSSL.Create^ssl_openssl.TSSLOpenSSL.html#Create^^See TCustomSSL .Create ^0"
+s[1096] = "ssl_openssl.TSSLOpenSSL.Destroy^ssl_openssl.TSSLOpenSSL.html#Destroy^^ ^0"
+s[1097] = "ssl_openssl.TSSLOpenSSL.LibVersion^ssl_openssl.TSSLOpenSSL.html#LibVersion^^See TCustomSSL .LibVersion ^0"
+s[1098] = "ssl_openssl.TSSLOpenSSL.LibName^ssl_openssl.TSSLOpenSSL.html#LibName^^See TCustomSSL .LibName ^0"
+s[1099] = "ssl_openssl.TSSLOpenSSL.Connect^ssl_openssl.TSSLOpenSSL.html#Connect^^See TCustomSSL .Connect and ssl_cryptlib for more details. ^0"
+s[1100] = "ssl_openssl.TSSLOpenSSL.Accept^ssl_openssl.TSSLOpenSSL.html#Accept^^See TCustomSSL .Accept and ssl_cryptlib for more details. ^0"
+s[1101] = "ssl_openssl.TSSLOpenSSL.Shutdown^ssl_openssl.TSSLOpenSSL.html#Shutdown^^See TCustomSSL .Shutdown ^0"
+s[1102] = "ssl_openssl.TSSLOpenSSL.BiShutdown^ssl_openssl.TSSLOpenSSL.html#BiShutdown^^See TCustomSSL .BiShutdown ^0"
+s[1103] = "ssl_openssl.TSSLOpenSSL.SendBuffer^ssl_openssl.TSSLOpenSSL.html#SendBuffer^^See TCustomSSL .SendBuffer ^0"
+s[1104] = "ssl_openssl.TSSLOpenSSL.RecvBuffer^ssl_openssl.TSSLOpenSSL.html#RecvBuffer^^See TCustomSSL .RecvBuffer ^0"
+s[1105] = "ssl_openssl.TSSLOpenSSL.WaitingData^ssl_openssl.TSSLOpenSSL.html#WaitingData^^See TCustomSSL .WaitingData ^0"
+s[1106] = "ssl_openssl.TSSLOpenSSL.GetSSLVersion^ssl_openssl.TSSLOpenSSL.html#GetSSLVersion^^See TCustomSSL .GetSSLVersion ^0"
+s[1107] = "ssl_openssl.TSSLOpenSSL.GetPeerSubject^ssl_openssl.TSSLOpenSSL.html#GetPeerSubject^^See TCustomSSL .GetPeerSubject ^0"
+s[1108] = "ssl_openssl.TSSLOpenSSL.GetPeerSerialNo^ssl_openssl.TSSLOpenSSL.html#GetPeerSerialNo^^See TCustomSSL .GetPeerSerialNo ^0"
+s[1109] = "ssl_openssl.TSSLOpenSSL.GetPeerIssuer^ssl_openssl.TSSLOpenSSL.html#GetPeerIssuer^^See TCustomSSL .GetPeerIssuer ^0"
+s[1110] = "ssl_openssl.TSSLOpenSSL.GetPeerName^ssl_openssl.TSSLOpenSSL.html#GetPeerName^^See TCustomSSL .GetPeerName ^0"
+s[1111] = "ssl_openssl.TSSLOpenSSL.GetPeerNameHash^ssl_openssl.TSSLOpenSSL.html#GetPeerNameHash^^See TCustomSSL .GetPeerNameHash ^0"
+s[1112] = "ssl_openssl.TSSLOpenSSL.GetPeerFingerprint^ssl_openssl.TSSLOpenSSL.html#GetPeerFingerprint^^See TCustomSSL .GetPeerFingerprint ^0"
+s[1113] = "ssl_openssl.TSSLOpenSSL.GetCertInfo^ssl_openssl.TSSLOpenSSL.html#GetCertInfo^^See TCustomSSL .GetCertInfo ^0"
+s[1114] = "ssl_openssl.TSSLOpenSSL.GetCipherName^ssl_openssl.TSSLOpenSSL.html#GetCipherName^^See TCustomSSL .GetCipherName ^0"
+s[1115] = "ssl_openssl.TSSLOpenSSL.GetCipherBits^ssl_openssl.TSSLOpenSSL.html#GetCipherBits^^See TCustomSSL .GetCipherBits ^0"
+s[1116] = "ssl_openssl.TSSLOpenSSL.GetCipherAlgBits^ssl_openssl.TSSLOpenSSL.html#GetCipherAlgBits^^See TCustomSSL .GetCipherAlgBits ^0"
+s[1117] = "ssl_openssl.TSSLOpenSSL.GetVerifyCert^ssl_openssl.TSSLOpenSSL.html#GetVerifyCert^^See TCustomSSL .GetVerifyCert ^0"
+s[1118] = "ssl_openssl_lib^ssl_openssl_lib.html^OpenSSL support^
This unit is Pascal interface to OpenSSL library (used by ssl_openssl unit). OpenSSL is loaded dynamicly on-demand. If this library is not found in system, requested OpenSSL function just return errorcode. ^0"
+s[1119] = "ssl_openssl_lib.des_ks_struct^ssl_openssl_lib.des_ks_struct.html^^ ^0"
+s[1120] = "ssl_openssl_lib.des_ks_struct.ks^ssl_openssl_lib.des_ks_struct.html#ks^^ ^0"
+s[1121] = "ssl_openssl_lib.des_ks_struct.weak_key^ssl_openssl_lib.des_ks_struct.html#weak_key^^ ^0"
+s[1122] = "ssl_openssl_lib.EVP_MAX_MD_SIZE^ssl_openssl_lib.html#EVP_MAX_MD_SIZE^^ ^0"
+s[1123] = "ssl_openssl_lib.SSL_ERROR_NONE^ssl_openssl_lib.html#SSL_ERROR_NONE^^ ^0"
+s[1124] = "ssl_openssl_lib.SSL_ERROR_SSL^ssl_openssl_lib.html#SSL_ERROR_SSL^^ ^0"
+s[1125] = "ssl_openssl_lib.SSL_ERROR_WANT_READ^ssl_openssl_lib.html#SSL_ERROR_WANT_READ^^ ^0"
+s[1126] = "ssl_openssl_lib.SSL_ERROR_WANT_WRITE^ssl_openssl_lib.html#SSL_ERROR_WANT_WRITE^^ ^0"
+s[1127] = "ssl_openssl_lib.SSL_ERROR_WANT_X509_LOOKUP^ssl_openssl_lib.html#SSL_ERROR_WANT_X509_LOOKUP^^ ^0"
+s[1128] = "ssl_openssl_lib.SSL_ERROR_SYSCALL^ssl_openssl_lib.html#SSL_ERROR_SYSCALL^^ ^0"
+s[1129] = "ssl_openssl_lib.SSL_ERROR_ZERO_RETURN^ssl_openssl_lib.html#SSL_ERROR_ZERO_RETURN^^ ^0"
+s[1130] = "ssl_openssl_lib.SSL_ERROR_WANT_CONNECT^ssl_openssl_lib.html#SSL_ERROR_WANT_CONNECT^^ ^0"
+s[1131] = "ssl_openssl_lib.SSL_ERROR_WANT_ACCEPT^ssl_openssl_lib.html#SSL_ERROR_WANT_ACCEPT^^ ^0"
+s[1132] = "ssl_openssl_lib.SSL_OP_NO_SSLv2^ssl_openssl_lib.html#SSL_OP_NO_SSLv2^^ ^0"
+s[1133] = "ssl_openssl_lib.SSL_OP_NO_SSLv3^ssl_openssl_lib.html#SSL_OP_NO_SSLv3^^ ^0"
+s[1134] = "ssl_openssl_lib.SSL_OP_NO_TLSv1^ssl_openssl_lib.html#SSL_OP_NO_TLSv1^^ ^0"
+s[1135] = "ssl_openssl_lib.SSL_OP_ALL^ssl_openssl_lib.html#SSL_OP_ALL^^ ^0"
+s[1136] = "ssl_openssl_lib.SSL_VERIFY_NONE^ssl_openssl_lib.html#SSL_VERIFY_NONE^^ ^0"
+s[1137] = "ssl_openssl_lib.SSL_VERIFY_PEER^ssl_openssl_lib.html#SSL_VERIFY_PEER^^ ^0"
+s[1138] = "ssl_openssl_lib.OPENSSL_DES_DECRYPT^ssl_openssl_lib.html#OPENSSL_DES_DECRYPT^^ ^0"
+s[1139] = "ssl_openssl_lib.OPENSSL_DES_ENCRYPT^ssl_openssl_lib.html#OPENSSL_DES_ENCRYPT^^ ^0"
+s[1140] = "ssl_openssl_lib.X509_V_OK^ssl_openssl_lib.html#X509_V_OK^^ ^0"
+s[1141] = "ssl_openssl_lib.X509_V_ILLEGAL^ssl_openssl_lib.html#X509_V_ILLEGAL^^ ^0"
+s[1142] = "ssl_openssl_lib.X509_V_ERR_UNABLE_TO_GET_ISSUER_CERT^ssl_openssl_lib.html#X509_V_ERR_UNABLE_TO_GET_ISSUER_CERT^^ ^0"
+s[1143] = "ssl_openssl_lib.X509_V_ERR_UNABLE_TO_GET_CRL^ssl_openssl_lib.html#X509_V_ERR_UNABLE_TO_GET_CRL^^ ^0"
+s[1144] = "ssl_openssl_lib.X509_V_ERR_UNABLE_TO_DECRYPT_CERT_SIGNATURE^ssl_openssl_lib.html#X509_V_ERR_UNABLE_TO_DECRYPT_CERT_SIGNATURE^^ ^0"
+s[1145] = "ssl_openssl_lib.X509_V_ERR_UNABLE_TO_DECRYPT_CRL_SIGNATURE^ssl_openssl_lib.html#X509_V_ERR_UNABLE_TO_DECRYPT_CRL_SIGNATURE^^ ^0"
+s[1146] = "ssl_openssl_lib.X509_V_ERR_UNABLE_TO_DECODE_ISSUER_PUBLIC_KEY^ssl_openssl_lib.html#X509_V_ERR_UNABLE_TO_DECODE_ISSUER_PUBLIC_KEY^^ ^0"
+s[1147] = "ssl_openssl_lib.X509_V_ERR_CERT_SIGNATURE_FAILURE^ssl_openssl_lib.html#X509_V_ERR_CERT_SIGNATURE_FAILURE^^ ^0"
+s[1148] = "ssl_openssl_lib.X509_V_ERR_CRL_SIGNATURE_FAILURE^ssl_openssl_lib.html#X509_V_ERR_CRL_SIGNATURE_FAILURE^^ ^0"
+s[1149] = "ssl_openssl_lib.X509_V_ERR_CERT_NOT_YET_VALID^ssl_openssl_lib.html#X509_V_ERR_CERT_NOT_YET_VALID^^ ^0"
+s[1150] = "ssl_openssl_lib.X509_V_ERR_CERT_HAS_EXPIRED^ssl_openssl_lib.html#X509_V_ERR_CERT_HAS_EXPIRED^^ ^0"
+s[1151] = "ssl_openssl_lib.X509_V_ERR_CRL_NOT_YET_VALID^ssl_openssl_lib.html#X509_V_ERR_CRL_NOT_YET_VALID^^ ^0"
+s[1152] = "ssl_openssl_lib.X509_V_ERR_CRL_HAS_EXPIRED^ssl_openssl_lib.html#X509_V_ERR_CRL_HAS_EXPIRED^^ ^0"
+s[1153] = "ssl_openssl_lib.X509_V_ERR_ERROR_IN_CERT_NOT_BEFORE_FIELD^ssl_openssl_lib.html#X509_V_ERR_ERROR_IN_CERT_NOT_BEFORE_FIELD^^ ^0"
+s[1154] = "ssl_openssl_lib.X509_V_ERR_ERROR_IN_CERT_NOT_AFTER_FIELD^ssl_openssl_lib.html#X509_V_ERR_ERROR_IN_CERT_NOT_AFTER_FIELD^^ ^0"
+s[1155] = "ssl_openssl_lib.X509_V_ERR_ERROR_IN_CRL_LAST_UPDATE_FIELD^ssl_openssl_lib.html#X509_V_ERR_ERROR_IN_CRL_LAST_UPDATE_FIELD^^ ^0"
+s[1156] = "ssl_openssl_lib.X509_V_ERR_ERROR_IN_CRL_NEXT_UPDATE_FIELD^ssl_openssl_lib.html#X509_V_ERR_ERROR_IN_CRL_NEXT_UPDATE_FIELD^^ ^0"
+s[1157] = "ssl_openssl_lib.X509_V_ERR_OUT_OF_MEM^ssl_openssl_lib.html#X509_V_ERR_OUT_OF_MEM^^ ^0"
+s[1158] = "ssl_openssl_lib.X509_V_ERR_DEPTH_ZERO_SELF_SIGNED_CERT^ssl_openssl_lib.html#X509_V_ERR_DEPTH_ZERO_SELF_SIGNED_CERT^^ ^0"
+s[1159] = "ssl_openssl_lib.X509_V_ERR_SELF_SIGNED_CERT_IN_CHAIN^ssl_openssl_lib.html#X509_V_ERR_SELF_SIGNED_CERT_IN_CHAIN^^ ^0"
+s[1160] = "ssl_openssl_lib.X509_V_ERR_UNABLE_TO_GET_ISSUER_CERT_LOCALLY^ssl_openssl_lib.html#X509_V_ERR_UNABLE_TO_GET_ISSUER_CERT_LOCALLY^^ ^0"
+s[1161] = "ssl_openssl_lib.X509_V_ERR_UNABLE_TO_VERIFY_LEAF_SIGNATURE^ssl_openssl_lib.html#X509_V_ERR_UNABLE_TO_VERIFY_LEAF_SIGNATURE^^ ^0"
+s[1162] = "ssl_openssl_lib.X509_V_ERR_CERT_CHAIN_TOO_LONG^ssl_openssl_lib.html#X509_V_ERR_CERT_CHAIN_TOO_LONG^^ ^0"
+s[1163] = "ssl_openssl_lib.X509_V_ERR_CERT_REVOKED^ssl_openssl_lib.html#X509_V_ERR_CERT_REVOKED^^ ^0"
+s[1164] = "ssl_openssl_lib.X509_V_ERR_INVALID_CA^ssl_openssl_lib.html#X509_V_ERR_INVALID_CA^^ ^0"
+s[1165] = "ssl_openssl_lib.X509_V_ERR_PATH_LENGTH_EXCEEDED^ssl_openssl_lib.html#X509_V_ERR_PATH_LENGTH_EXCEEDED^^ ^0"
+s[1166] = "ssl_openssl_lib.X509_V_ERR_INVALID_PURPOSE^ssl_openssl_lib.html#X509_V_ERR_INVALID_PURPOSE^^ ^0"
+s[1167] = "ssl_openssl_lib.X509_V_ERR_CERT_UNTRUSTED^ssl_openssl_lib.html#X509_V_ERR_CERT_UNTRUSTED^^ ^0"
+s[1168] = "ssl_openssl_lib.X509_V_ERR_CERT_REJECTED^ssl_openssl_lib.html#X509_V_ERR_CERT_REJECTED^^ ^0"
+s[1169] = "ssl_openssl_lib.X509_V_ERR_SUBJECT_ISSUER_MISMATCH^ssl_openssl_lib.html#X509_V_ERR_SUBJECT_ISSUER_MISMATCH^^ ^0"
+s[1170] = "ssl_openssl_lib.X509_V_ERR_AKID_SKID_MISMATCH^ssl_openssl_lib.html#X509_V_ERR_AKID_SKID_MISMATCH^^ ^0"
+s[1171] = "ssl_openssl_lib.X509_V_ERR_AKID_ISSUER_SERIAL_MISMATCH^ssl_openssl_lib.html#X509_V_ERR_AKID_ISSUER_SERIAL_MISMATCH^^ ^0"
+s[1172] = "ssl_openssl_lib.X509_V_ERR_KEYUSAGE_NO_CERTSIGN^ssl_openssl_lib.html#X509_V_ERR_KEYUSAGE_NO_CERTSIGN^^ ^0"
+s[1173] = "ssl_openssl_lib.X509_V_ERR_UNABLE_TO_GET_CRL_ISSUER^ssl_openssl_lib.html#X509_V_ERR_UNABLE_TO_GET_CRL_ISSUER^^ ^0"
+s[1174] = "ssl_openssl_lib.X509_V_ERR_UNHANDLED_CRITICAL_EXTENSION^ssl_openssl_lib.html#X509_V_ERR_UNHANDLED_CRITICAL_EXTENSION^^ ^0"
+s[1175] = "ssl_openssl_lib.X509_V_ERR_APPLICATION_VERIFICATION^ssl_openssl_lib.html#X509_V_ERR_APPLICATION_VERIFICATION^^ ^0"
+s[1176] = "ssl_openssl_lib.SSL_FILETYPE_ASN1^ssl_openssl_lib.html#SSL_FILETYPE_ASN1^^ ^0"
+s[1177] = "ssl_openssl_lib.SSL_FILETYPE_PEM^ssl_openssl_lib.html#SSL_FILETYPE_PEM^^ ^0"
+s[1178] = "ssl_openssl_lib.EVP_PKEY_RSA^ssl_openssl_lib.html#EVP_PKEY_RSA^^ ^0"
+s[1179] = "ssl_openssl_lib.SSL_CTRL_SET_TLSEXT_HOSTNAME^ssl_openssl_lib.html#SSL_CTRL_SET_TLSEXT_HOSTNAME^^ ^0"
+s[1180] = "ssl_openssl_lib.TLSEXT_NAMETYPE_host_name^ssl_openssl_lib.html#TLSEXT_NAMETYPE_host_name^^ ^0"
+s[1181] = "ssl_openssl_lib.SslGetError^ssl_openssl_lib.html#SslGetError^^ ^0"
+s[1182] = "ssl_openssl_lib.SslLibraryInit^ssl_openssl_lib.html#SslLibraryInit^^ ^0"
+s[1183] = "ssl_openssl_lib.SslLoadErrorStrings^ssl_openssl_lib.html#SslLoadErrorStrings^^ ^0"
+s[1184] = "ssl_openssl_lib.SslCtxSetCipherList^ssl_openssl_lib.html#SslCtxSetCipherList^^ ^0"
+s[1185] = "ssl_openssl_lib.SslCtxNew^ssl_openssl_lib.html#SslCtxNew^^ ^0"
+s[1186] = "ssl_openssl_lib.SslCtxFree^ssl_openssl_lib.html#SslCtxFree^^ ^0"
+s[1187] = "ssl_openssl_lib.SslSetFd^ssl_openssl_lib.html#SslSetFd^^ ^0"
+s[1188] = "ssl_openssl_lib.SslMethodV2^ssl_openssl_lib.html#SslMethodV2^^ ^0"
+s[1189] = "ssl_openssl_lib.SslMethodV3^ssl_openssl_lib.html#SslMethodV3^^ ^0"
+s[1190] = "ssl_openssl_lib.SslMethodTLSV1^ssl_openssl_lib.html#SslMethodTLSV1^^ ^0"
+s[1191] = "ssl_openssl_lib.SslMethodV23^ssl_openssl_lib.html#SslMethodV23^^ ^0"
+s[1192] = "ssl_openssl_lib.SslCtxUsePrivateKey^ssl_openssl_lib.html#SslCtxUsePrivateKey^^ ^0"
+s[1193] = "ssl_openssl_lib.SslCtxUsePrivateKeyASN1^ssl_openssl_lib.html#SslCtxUsePrivateKeyASN1^^ ^0"
+s[1194] = "ssl_openssl_lib.SslCtxUsePrivateKeyFile^ssl_openssl_lib.html#SslCtxUsePrivateKeyFile^^ ^0"
+s[1195] = "ssl_openssl_lib.SslCtxUseCertificate^ssl_openssl_lib.html#SslCtxUseCertificate^^ ^0"
+s[1196] = "ssl_openssl_lib.SslCtxUseCertificateASN1^ssl_openssl_lib.html#SslCtxUseCertificateASN1^^ ^0"
+s[1197] = "ssl_openssl_lib.SslCtxUseCertificateFile^ssl_openssl_lib.html#SslCtxUseCertificateFile^^ ^0"
+s[1198] = "ssl_openssl_lib.SslCtxUseCertificateChainFile^ssl_openssl_lib.html#SslCtxUseCertificateChainFile^^ ^0"
+s[1199] = "ssl_openssl_lib.SslCtxCheckPrivateKeyFile^ssl_openssl_lib.html#SslCtxCheckPrivateKeyFile^^ ^0"
+s[1200] = "ssl_openssl_lib.SslCtxSetDefaultPasswdCb^ssl_openssl_lib.html#SslCtxSetDefaultPasswdCb^^ ^0"
+s[1201] = "ssl_openssl_lib.SslCtxSetDefaultPasswdCbUserdata^ssl_openssl_lib.html#SslCtxSetDefaultPasswdCbUserdata^^ ^0"
+s[1202] = "ssl_openssl_lib.SslCtxLoadVerifyLocations^ssl_openssl_lib.html#SslCtxLoadVerifyLocations^^ ^0"
+s[1203] = "ssl_openssl_lib.SslCtxCtrl^ssl_openssl_lib.html#SslCtxCtrl^^ ^0"
+s[1204] = "ssl_openssl_lib.SslNew^ssl_openssl_lib.html#SslNew^^ ^0"
+s[1205] = "ssl_openssl_lib.SslFree^ssl_openssl_lib.html#SslFree^^ ^0"
+s[1206] = "ssl_openssl_lib.SslAccept^ssl_openssl_lib.html#SslAccept^^ ^0"
+s[1207] = "ssl_openssl_lib.SslConnect^ssl_openssl_lib.html#SslConnect^^ ^0"
+s[1208] = "ssl_openssl_lib.SslShutdown^ssl_openssl_lib.html#SslShutdown^^ ^0"
+s[1209] = "ssl_openssl_lib.SslRead^ssl_openssl_lib.html#SslRead^^ ^0"
+s[1210] = "ssl_openssl_lib.SslPeek^ssl_openssl_lib.html#SslPeek^^ ^0"
+s[1211] = "ssl_openssl_lib.SslWrite^ssl_openssl_lib.html#SslWrite^^ ^0"
+s[1212] = "ssl_openssl_lib.SslPending^ssl_openssl_lib.html#SslPending^^ ^0"
+s[1213] = "ssl_openssl_lib.SslGetVersion^ssl_openssl_lib.html#SslGetVersion^^ ^0"
+s[1214] = "ssl_openssl_lib.SslGetPeerCertificate^ssl_openssl_lib.html#SslGetPeerCertificate^^ ^0"
+s[1215] = "ssl_openssl_lib.SslCtxSetVerify^ssl_openssl_lib.html#SslCtxSetVerify^^ ^0"
+s[1216] = "ssl_openssl_lib.SSLGetCurrentCipher^ssl_openssl_lib.html#SSLGetCurrentCipher^^ ^0"
+s[1217] = "ssl_openssl_lib.SSLCipherGetName^ssl_openssl_lib.html#SSLCipherGetName^^ ^0"
+s[1218] = "ssl_openssl_lib.SSLCipherGetBits^ssl_openssl_lib.html#SSLCipherGetBits^^ ^0"
+s[1219] = "ssl_openssl_lib.SSLGetVerifyResult^ssl_openssl_lib.html#SSLGetVerifyResult^^ ^0"
+s[1220] = "ssl_openssl_lib.SSLCtrl^ssl_openssl_lib.html#SSLCtrl^^ ^0"
+s[1221] = "ssl_openssl_lib.X509New^ssl_openssl_lib.html#X509New^^ ^0"
+s[1222] = "ssl_openssl_lib.X509Free^ssl_openssl_lib.html#X509Free^^ ^0"
+s[1223] = "ssl_openssl_lib.X509NameOneline^ssl_openssl_lib.html#X509NameOneline^^ ^0"
+s[1224] = "ssl_openssl_lib.X509GetSubjectName^ssl_openssl_lib.html#X509GetSubjectName^^ ^0"
+s[1225] = "ssl_openssl_lib.X509GetIssuerName^ssl_openssl_lib.html#X509GetIssuerName^^ ^0"
+s[1226] = "ssl_openssl_lib.X509NameHash^ssl_openssl_lib.html#X509NameHash^^ ^0"
+s[1227] = "ssl_openssl_lib.X509Digest^ssl_openssl_lib.html#X509Digest^^ ^0"
+s[1228] = "ssl_openssl_lib.X509print^ssl_openssl_lib.html#X509print^^ ^0"
+s[1229] = "ssl_openssl_lib.X509SetVersion^ssl_openssl_lib.html#X509SetVersion^^ ^0"
+s[1230] = "ssl_openssl_lib.X509SetPubkey^ssl_openssl_lib.html#X509SetPubkey^^ ^0"
+s[1231] = "ssl_openssl_lib.X509SetIssuerName^ssl_openssl_lib.html#X509SetIssuerName^^ ^0"
+s[1232] = "ssl_openssl_lib.X509NameAddEntryByTxt^ssl_openssl_lib.html#X509NameAddEntryByTxt^^ ^0"
+s[1233] = "ssl_openssl_lib.X509Sign^ssl_openssl_lib.html#X509Sign^^ ^0"
+s[1234] = "ssl_openssl_lib.X509GmtimeAdj^ssl_openssl_lib.html#X509GmtimeAdj^^ ^0"
+s[1235] = "ssl_openssl_lib.X509SetNotBefore^ssl_openssl_lib.html#X509SetNotBefore^^ ^0"
+s[1236] = "ssl_openssl_lib.X509SetNotAfter^ssl_openssl_lib.html#X509SetNotAfter^^ ^0"
+s[1237] = "ssl_openssl_lib.X509GetSerialNumber^ssl_openssl_lib.html#X509GetSerialNumber^^ ^0"
+s[1238] = "ssl_openssl_lib.EvpPkeyNew^ssl_openssl_lib.html#EvpPkeyNew^^ ^0"
+s[1239] = "ssl_openssl_lib.EvpPkeyFree^ssl_openssl_lib.html#EvpPkeyFree^^ ^0"
+s[1240] = "ssl_openssl_lib.EvpPkeyAssign^ssl_openssl_lib.html#EvpPkeyAssign^^ ^0"
+s[1241] = "ssl_openssl_lib.EvpGetDigestByName^ssl_openssl_lib.html#EvpGetDigestByName^^ ^0"
+s[1242] = "ssl_openssl_lib.EVPcleanup^ssl_openssl_lib.html#EVPcleanup^^ ^0"
+s[1243] = "ssl_openssl_lib.SSLeayversion^ssl_openssl_lib.html#SSLeayversion^^ ^0"
+s[1244] = "ssl_openssl_lib.ErrErrorString^ssl_openssl_lib.html#ErrErrorString^^ ^0"
+s[1245] = "ssl_openssl_lib.ErrGetError^ssl_openssl_lib.html#ErrGetError^^ ^0"
+s[1246] = "ssl_openssl_lib.ErrClearError^ssl_openssl_lib.html#ErrClearError^^ ^0"
+s[1247] = "ssl_openssl_lib.ErrFreeStrings^ssl_openssl_lib.html#ErrFreeStrings^^ ^0"
+s[1248] = "ssl_openssl_lib.ErrRemoveState^ssl_openssl_lib.html#ErrRemoveState^^ ^0"
+s[1249] = "ssl_openssl_lib.OPENSSLaddallalgorithms^ssl_openssl_lib.html#OPENSSLaddallalgorithms^^ ^0"
+s[1250] = "ssl_openssl_lib.CRYPTOcleanupAllExData^ssl_openssl_lib.html#CRYPTOcleanupAllExData^^ ^0"
+s[1251] = "ssl_openssl_lib.RandScreen^ssl_openssl_lib.html#RandScreen^^ ^0"
+s[1252] = "ssl_openssl_lib.BioNew^ssl_openssl_lib.html#BioNew^^ ^0"
+s[1253] = "ssl_openssl_lib.BioFreeAll^ssl_openssl_lib.html#BioFreeAll^^ ^0"
+s[1254] = "ssl_openssl_lib.BioSMem^ssl_openssl_lib.html#BioSMem^^ ^0"
+s[1255] = "ssl_openssl_lib.BioCtrlPending^ssl_openssl_lib.html#BioCtrlPending^^ ^0"
+s[1256] = "ssl_openssl_lib.BioRead^ssl_openssl_lib.html#BioRead^^ ^0"
+s[1257] = "ssl_openssl_lib.BioWrite^ssl_openssl_lib.html#BioWrite^^ ^0"
+s[1258] = "ssl_openssl_lib.d2iPKCS12bio^ssl_openssl_lib.html#d2iPKCS12bio^^ ^0"
+s[1259] = "ssl_openssl_lib.PKCS12parse^ssl_openssl_lib.html#PKCS12parse^^ ^0"
+s[1260] = "ssl_openssl_lib.PKCS12free^ssl_openssl_lib.html#PKCS12free^^ ^0"
+s[1261] = "ssl_openssl_lib.RsaGenerateKey^ssl_openssl_lib.html#RsaGenerateKey^^ ^0"
+s[1262] = "ssl_openssl_lib.Asn1UtctimeNew^ssl_openssl_lib.html#Asn1UtctimeNew^^ ^0"
+s[1263] = "ssl_openssl_lib.Asn1UtctimeFree^ssl_openssl_lib.html#Asn1UtctimeFree^^ ^0"
+s[1264] = "ssl_openssl_lib.Asn1IntegerSet^ssl_openssl_lib.html#Asn1IntegerSet^^ ^0"
+s[1265] = "ssl_openssl_lib.Asn1IntegerGet^ssl_openssl_lib.html#Asn1IntegerGet^^ ^0"
+s[1266] = "ssl_openssl_lib.i2dX509bio^ssl_openssl_lib.html#i2dX509bio^^ ^0"
+s[1267] = "ssl_openssl_lib.d2iX509bio^ssl_openssl_lib.html#d2iX509bio^^ ^0"
+s[1268] = "ssl_openssl_lib.PEMReadBioX509^ssl_openssl_lib.html#PEMReadBioX509^^ ^0"
+s[1269] = "ssl_openssl_lib.SkX509PopFree^ssl_openssl_lib.html#SkX509PopFree^^ ^0"
+s[1270] = "ssl_openssl_lib.i2dPrivateKeyBio^ssl_openssl_lib.html#i2dPrivateKeyBio^^ ^0"
+s[1271] = "ssl_openssl_lib.DESsetoddparity^ssl_openssl_lib.html#DESsetoddparity^^ ^0"
+s[1272] = "ssl_openssl_lib.DESsetkeychecked^ssl_openssl_lib.html#DESsetkeychecked^^ ^0"
+s[1273] = "ssl_openssl_lib.DESecbencrypt^ssl_openssl_lib.html#DESecbencrypt^^ ^0"
+s[1274] = "ssl_openssl_lib.IsSSLloaded^ssl_openssl_lib.html#IsSSLloaded^^ ^0"
+s[1275] = "ssl_openssl_lib.InitSSLInterface^ssl_openssl_lib.html#InitSSLInterface^^ ^0"
+s[1276] = "ssl_openssl_lib.DestroySSLInterface^ssl_openssl_lib.html#DestroySSLInterface^^ ^0"
+s[1277] = "ssl_openssl_lib.SslPtr^ssl_openssl_lib.html#SslPtr^^ ^0"
+s[1278] = "ssl_openssl_lib.PSslPtr^ssl_openssl_lib.html#PSslPtr^^ ^0"
+s[1279] = "ssl_openssl_lib.PSSL_CTX^ssl_openssl_lib.html#PSSL_CTX^^ ^0"
+s[1280] = "ssl_openssl_lib.PSSL^ssl_openssl_lib.html#PSSL^^ ^0"
+s[1281] = "ssl_openssl_lib.PSSL_METHOD^ssl_openssl_lib.html#PSSL_METHOD^^ ^0"
+s[1282] = "ssl_openssl_lib.PX509^ssl_openssl_lib.html#PX509^^ ^0"
+s[1283] = "ssl_openssl_lib.PX509_NAME^ssl_openssl_lib.html#PX509_NAME^^ ^0"
+s[1284] = "ssl_openssl_lib.PEVP_MD^ssl_openssl_lib.html#PEVP_MD^^ ^0"
+s[1285] = "ssl_openssl_lib.PInteger^ssl_openssl_lib.html#PInteger^^ ^0"
+s[1286] = "ssl_openssl_lib.PBIO_METHOD^ssl_openssl_lib.html#PBIO_METHOD^^ ^0"
+s[1287] = "ssl_openssl_lib.PBIO^ssl_openssl_lib.html#PBIO^^ ^0"
+s[1288] = "ssl_openssl_lib.EVP_PKEY^ssl_openssl_lib.html#EVP_PKEY^^ ^0"
+s[1289] = "ssl_openssl_lib.PRSA^ssl_openssl_lib.html#PRSA^^ ^0"
+s[1290] = "ssl_openssl_lib.PASN1_UTCTIME^ssl_openssl_lib.html#PASN1_UTCTIME^^ ^0"
+s[1291] = "ssl_openssl_lib.PASN1_INTEGER^ssl_openssl_lib.html#PASN1_INTEGER^^ ^0"
+s[1292] = "ssl_openssl_lib.PPasswdCb^ssl_openssl_lib.html#PPasswdCb^^ ^0"
+s[1293] = "ssl_openssl_lib.PFunction^ssl_openssl_lib.html#PFunction^^ ^0"
+s[1294] = "ssl_openssl_lib.PSTACK^ssl_openssl_lib.html#PSTACK^^ ^0"
+s[1295] = "ssl_openssl_lib.TSkPopFreeFunc^ssl_openssl_lib.html#TSkPopFreeFunc^^ ^0"
+s[1296] = "ssl_openssl_lib.TX509Free^ssl_openssl_lib.html#TX509Free^^ ^0"
+s[1297] = "ssl_openssl_lib.DES_cblock^ssl_openssl_lib.html#DES_cblock^^ ^0"
+s[1298] = "ssl_openssl_lib.PDES_cblock^ssl_openssl_lib.html#PDES_cblock^^ ^0"
+s[1299] = "ssl_openssl_lib.des_key_schedule^ssl_openssl_lib.html#des_key_schedule^^ ^0"
+s[1300] = "ssl_openssl_lib.DLLSSLName^ssl_openssl_lib.html#DLLSSLName^^ ^0"
+s[1301] = "ssl_openssl_lib.DLLSSLName2^ssl_openssl_lib.html#DLLSSLName2^^ ^0"
+s[1302] = "ssl_openssl_lib.DLLUtilName^ssl_openssl_lib.html#DLLUtilName^^ ^0"
+s[1303] = "ssl_openssl_lib.SSLLibHandle^ssl_openssl_lib.html#SSLLibHandle^^ ^0"
+s[1304] = "ssl_openssl_lib.SSLUtilHandle^ssl_openssl_lib.html#SSLUtilHandle^^ ^0"
+s[1305] = "ssl_openssl_lib.SSLLibFile^ssl_openssl_lib.html#SSLLibFile^^ ^0"
+s[1306] = "ssl_openssl_lib.SSLUtilFile^ssl_openssl_lib.html#SSLUtilFile^^ ^0"
+s[1307] = "ssl_openssl_lib._X509Free^ssl_openssl_lib.html#_X509Free^^ ^0"
+s[1308] = "ssl_sbb^ssl_sbb.html^SSL plugin for Eldos SecureBlackBox^
For handling keys and certificates you can use this properties: TCustomSSL .CertCAFile , TCustomSSL .CertCA , TCustomSSL .TrustCertificateFile , TCustomSSL .TrustCertificate , TCustomSSL .PrivateKeyFile , TCustomSSL .PrivateKey , TCustomSSL .CertificateFile , TCustomSSL .Certificate , TCustomSSL .PFXfile . For usage of this properties and for possible formats of keys and certificates refer to SecureBlackBox documentation. ^0"
+s[1309] = "ssl_sbb.TSSLSBB^ssl_sbb.TSSLSBB.html^class implementing SecureBlackbox SSL plugin.^ Instance of this class will be created for each TTCPBlockSocket . You not need to create instance of this class, all is done by Synapse itself! ^0"
+s[1310] = "ssl_sbb.TSSLSBB.Create^ssl_sbb.TSSLSBB.html#Create^^ ^0"
+s[1311] = "ssl_sbb.TSSLSBB.Destroy^ssl_sbb.TSSLSBB.html#Destroy^^ ^0"
+s[1312] = "ssl_sbb.TSSLSBB.LibVersion^ssl_sbb.TSSLSBB.html#LibVersion^^See TCustomSSL .LibVersion ^0"
+s[1313] = "ssl_sbb.TSSLSBB.LibName^ssl_sbb.TSSLSBB.html#LibName^^See TCustomSSL .LibName ^0"
+s[1314] = "ssl_sbb.TSSLSBB.Connect^ssl_sbb.TSSLSBB.html#Connect^^See TCustomSSL .Connect and ssl_sbb for more details. ^0"
+s[1315] = "ssl_sbb.TSSLSBB.Accept^ssl_sbb.TSSLSBB.html#Accept^^See TCustomSSL .Accept and ssl_sbb for more details. ^0"
+s[1316] = "ssl_sbb.TSSLSBB.Shutdown^ssl_sbb.TSSLSBB.html#Shutdown^^See TCustomSSL .Shutdown ^0"
+s[1317] = "ssl_sbb.TSSLSBB.BiShutdown^ssl_sbb.TSSLSBB.html#BiShutdown^^See TCustomSSL .BiShutdown ^0"
+s[1318] = "ssl_sbb.TSSLSBB.SendBuffer^ssl_sbb.TSSLSBB.html#SendBuffer^^See TCustomSSL .SendBuffer ^0"
+s[1319] = "ssl_sbb.TSSLSBB.RecvBuffer^ssl_sbb.TSSLSBB.html#RecvBuffer^^See TCustomSSL .RecvBuffer ^0"
+s[1320] = "ssl_sbb.TSSLSBB.WaitingData^ssl_sbb.TSSLSBB.html#WaitingData^^See TCustomSSL .WaitingData ^0"
+s[1321] = "ssl_sbb.TSSLSBB.GetSSLVersion^ssl_sbb.TSSLSBB.html#GetSSLVersion^^See TCustomSSL .GetSSLVersion ^0"
+s[1322] = "ssl_sbb.TSSLSBB.GetPeerSubject^ssl_sbb.TSSLSBB.html#GetPeerSubject^^See TCustomSSL .GetPeerSubject ^0"
+s[1323] = "ssl_sbb.TSSLSBB.GetPeerIssuer^ssl_sbb.TSSLSBB.html#GetPeerIssuer^^See TCustomSSL .GetPeerIssuer ^0"
+s[1324] = "ssl_sbb.TSSLSBB.GetPeerName^ssl_sbb.TSSLSBB.html#GetPeerName^^See TCustomSSL .GetPeerName ^0"
+s[1325] = "ssl_sbb.TSSLSBB.GetPeerFingerprint^ssl_sbb.TSSLSBB.html#GetPeerFingerprint^^See TCustomSSL .GetPeerFingerprint ^0"
+s[1326] = "ssl_sbb.TSSLSBB.GetCertInfo^ssl_sbb.TSSLSBB.html#GetCertInfo^^See TCustomSSL .GetCertInfo ^0"
+s[1327] = "ssl_sbb.TSSLSBB.ElSecureClient^ssl_sbb.TSSLSBB.html#ElSecureClient^^ ^0"
+s[1328] = "ssl_sbb.TSSLSBB.ElSecureServer^ssl_sbb.TSSLSBB.html#ElSecureServer^^ ^0"
+s[1329] = "ssl_sbb.TSSLSBB.CipherSuites^ssl_sbb.TSSLSBB.html#CipherSuites^^ ^0"
+s[1330] = "ssl_sbb.TSSLSBB.CipherSuite^ssl_sbb.TSSLSBB.html#CipherSuite^^ ^0"
+s[1331] = "ssl_sbb.DEFAULT_RECV_BUFFER^ssl_sbb.html#DEFAULT_RECV_BUFFER^^ ^0"
+s[1332] = "ssl_streamsec^ssl_streamsec.html^SSL plugin for StreamSecII or OpenStreamSecII^
StreamSecII is native pascal library, you not need any external libraries!
You can tune lot of StreamSecII properties by using your GlobalServer. If you not using your GlobalServer, then this plugin create own TSimpleTLSInternalServer instance for each TCP connection. Formore information about GlobalServer usage refer StreamSecII documentation.
If you are not using key and certificate by GlobalServer, then you can use properties of this plugin instead, but this have limited features and TCustomSSL .KeyPassword not working properly yet!
For handling keys and certificates you can use this properties: TCustomSSL .CertCAFile , TCustomSSL .CertCA , TCustomSSL .TrustCertificateFile , TCustomSSL .TrustCertificate , TCustomSSL .PrivateKeyFile , TCustomSSL .PrivateKey , TCustomSSL .CertificateFile , TCustomSSL .Certificate , TCustomSSL .PFXfile . For usage of this properties and for possible formats of keys and certificates refer to StreamSecII documentation. ^0"
+s[1333] = "ssl_streamsec.TSSLStreamSec^ssl_streamsec.TSSLStreamSec.html^class implementing StreamSecII SSL plugin.^ Instance of this class will be created for each TTCPBlockSocket . You not need to create instance of this class, all is done by Synapse itself! ^0"
+s[1334] = "ssl_streamsec.TSSLStreamSec.Create^ssl_streamsec.TSSLStreamSec.html#Create^^ ^0"
+s[1335] = "ssl_streamsec.TSSLStreamSec.Destroy^ssl_streamsec.TSSLStreamSec.html#Destroy^^ ^0"
+s[1336] = "ssl_streamsec.TSSLStreamSec.LibVersion^ssl_streamsec.TSSLStreamSec.html#LibVersion^^See TCustomSSL .LibVersion ^0"
+s[1337] = "ssl_streamsec.TSSLStreamSec.LibName^ssl_streamsec.TSSLStreamSec.html#LibName^^See TCustomSSL .LibName ^0"
+s[1338] = "ssl_streamsec.TSSLStreamSec.Connect^ssl_streamsec.TSSLStreamSec.html#Connect^^See TCustomSSL .Connect and ssl_streamsec for more details. ^0"
+s[1339] = "ssl_streamsec.TSSLStreamSec.Accept^ssl_streamsec.TSSLStreamSec.html#Accept^^See TCustomSSL .Accept and ssl_streamsec for more details. ^0"
+s[1340] = "ssl_streamsec.TSSLStreamSec.Shutdown^ssl_streamsec.TSSLStreamSec.html#Shutdown^^See TCustomSSL .Shutdown ^0"
+s[1341] = "ssl_streamsec.TSSLStreamSec.BiShutdown^ssl_streamsec.TSSLStreamSec.html#BiShutdown^^See TCustomSSL .BiShutdown ^0"
+s[1342] = "ssl_streamsec.TSSLStreamSec.SendBuffer^ssl_streamsec.TSSLStreamSec.html#SendBuffer^^See TCustomSSL .SendBuffer ^0"
+s[1343] = "ssl_streamsec.TSSLStreamSec.RecvBuffer^ssl_streamsec.TSSLStreamSec.html#RecvBuffer^^See TCustomSSL .RecvBuffer ^0"
+s[1344] = "ssl_streamsec.TSSLStreamSec.WaitingData^ssl_streamsec.TSSLStreamSec.html#WaitingData^^See TCustomSSL .WaitingData ^0"
+s[1345] = "ssl_streamsec.TSSLStreamSec.GetSSLVersion^ssl_streamsec.TSSLStreamSec.html#GetSSLVersion^^See TCustomSSL .GetSSLVersion ^0"
+s[1346] = "ssl_streamsec.TSSLStreamSec.GetPeerSubject^ssl_streamsec.TSSLStreamSec.html#GetPeerSubject^^See TCustomSSL .GetPeerSubject ^0"
+s[1347] = "ssl_streamsec.TSSLStreamSec.GetPeerIssuer^ssl_streamsec.TSSLStreamSec.html#GetPeerIssuer^^See TCustomSSL .GetPeerIssuer ^0"
+s[1348] = "ssl_streamsec.TSSLStreamSec.GetPeerName^ssl_streamsec.TSSLStreamSec.html#GetPeerName^^See TCustomSSL .GetPeerName ^0"
+s[1349] = "ssl_streamsec.TSSLStreamSec.GetPeerFingerprint^ssl_streamsec.TSSLStreamSec.html#GetPeerFingerprint^^See TCustomSSL .GetPeerFingerprint ^0"
+s[1350] = "ssl_streamsec.TSSLStreamSec.GetCertInfo^ssl_streamsec.TSSLStreamSec.html#GetCertInfo^^See TCustomSSL .GetCertInfo ^0"
+s[1351] = "ssl_streamsec.TSSLStreamSec.TLSServer^ssl_streamsec.TSSLStreamSec.html#TLSServer^^TLS server for tuning of StreamSecII. ^0"
+s[1352] = "synachar^synachar.html^Charset conversion support^ This unit contains a routines for lot of charset conversions.
It using built-in conversion tables or external Iconv library. Iconv is used when needed conversion is known by Iconv library. When Iconv library is not found or Iconv not know requested conversion, then are internal routines used for conversion. (You can disable Iconv support from your program too!)
Internal routines knows all major charsets for Europe or America. For East-Asian charsets you must use Iconv library! ^0"
+s[1353] = "synachar.IconvOnlyChars^synachar.html#IconvOnlyChars^^Set of charsets supported by Iconv library only. ^0"
+s[1354] = "synachar.NoIconvChars^synachar.html#NoIconvChars^^Set of charsets supported by internal routines only. ^0"
+s[1355] = "synachar.Replace_None^synachar.html#Replace_None^^null character replace table. (Usable for disable charater replacing.) ^0"
+s[1356] = "synachar.Replace_Czech^synachar.html#Replace_Czech^^Character replace table for remove Czech diakritics. ^0"
+s[1357] = "synachar.CharsetConversion^synachar.html#CharsetConversion^^Convert Value from one charset to another. See: CharsetConversionEx ^0"
+s[1358] = "synachar.CharsetConversionEx^synachar.html#CharsetConversionEx^^Convert Value from one charset to another with additional character conversion. see: Replace_None and Replace_Czech ^0"
+s[1359] = "synachar.CharsetConversionTrans^synachar.html#CharsetConversionTrans^^Convert Value from one charset to another with additional character conversion. This funtion is similar to CharsetConversionEx , but you can disable transliteration of unconvertible characters. ^0"
+s[1360] = "synachar.GetCurCP^synachar.html#GetCurCP^^Returns charset used by operating system. ^0"
+s[1361] = "synachar.GetCurOEMCP^synachar.html#GetCurOEMCP^^Returns charset used by operating system as OEM charset. (in Windows DOS box, for example) ^0"
+s[1362] = "synachar.GetCPFromID^synachar.html#GetCPFromID^^Converting string with charset name to TMimeChar. ^0"
+s[1363] = "synachar.GetIDFromCP^synachar.html#GetIDFromCP^^Converting TMimeChar to string with name of charset. ^0"
+s[1364] = "synachar.NeedCharsetConversion^synachar.html#NeedCharsetConversion^^return True
when value need to be converted. (It is not 7-bit ASCII) ^0"
+s[1365] = "synachar.IdealCharsetCoding^synachar.html#IdealCharsetCoding^^Finding best target charset from set of TMimeChars with minimal count of unconvertible characters. ^0"
+s[1366] = "synachar.GetBOM^synachar.html#GetBOM^^Return BOM (Byte Order Mark) for given unicode charset. ^0"
+s[1367] = "synachar.StringToWide^synachar.html#StringToWide^^Convert binary string with unicode content to WideString. ^0"
+s[1368] = "synachar.WideToString^synachar.html#WideToString^^Convert WideString to binary string with unicode content. ^0"
+s[1369] = "synachar.TMimeChar^synachar.html#TMimeChar^^Type with all supported charsets. ISO_8859_1 ISO_8859_2 ISO_8859_3 ISO_8859_4 ISO_8859_5 ISO_8859_6 ISO_8859_7 ISO_8859_8 ISO_8859_9 ISO_8859_10 ISO_8859_13 ISO_8859_14 ISO_8859_15 CP1250 CP1251 CP1252 CP1253 CP1254 CP1255 CP1256 CP1257 CP1258 KOI8_R CP895 CP852 UCS_2 UCS_4 UTF_8 UTF_7 UTF_7mod UCS_2LE UCS_4LE UTF_16 UTF_16LE UTF_32 UTF_32LE C99 JAVA ISO_8859_16 KOI8_U KOI8_RU CP862 CP866 MAC MACCE MACICE MACCRO MACRO MACCYR MACUK MACGR MACTU MACHEB MACAR MACTH ROMAN8 NEXTSTEP ARMASCII GEORGIAN_AC GEORGIAN_PS KOI8_T MULELAO CP1133 TIS620 CP874 VISCII TCVN ISO_IR_14 JIS_X0201 JIS_X0208 JIS_X0212 GB1988_80 GB2312_80 ISO_IR_165 ISO_IR_149 EUC_JP SHIFT_JIS CP932 ISO_2022_JP ISO_2022_JP1 ISO_2022_JP2 GB2312 CP936 GB18030 ISO_2022_CN ISO_2022_CNE HZ EUC_TW BIG5 CP950 BIG5_HKSCS EUC_KR CP949 CP1361 ISO_2022_KR CP737 CP775 CP853 CP855 CP857 CP858 CP860 CP861 CP863 CP864 CP865 CP869 CP1125 ^0"
+s[1370] = "synachar.TMimeSetChar^synachar.html#TMimeSetChar^^Set of any charsets. ^0"
+s[1371] = "synachar.DisableIconv^synachar.html#DisableIconv^^By this you can generally disable/enable Iconv support. ^0"
+s[1372] = "synachar.IdealCharsets^synachar.html#IdealCharsets^^Default set of charsets for IdealCharsetCoding function. ^0"
+s[1373] = "synacode^synacode.html^Various encoding and decoding support^ ^0"
+s[1374] = "synacode.SpecialChar^synacode.html#SpecialChar^^ ^0"
+s[1375] = "synacode.NonAsciiChar^synacode.html#NonAsciiChar^^ ^0"
+s[1376] = "synacode.URLFullSpecialChar^synacode.html#URLFullSpecialChar^^ ^0"
+s[1377] = "synacode.URLSpecialChar^synacode.html#URLSpecialChar^^ ^0"
+s[1378] = "synacode.TableBase64^synacode.html#TableBase64^^ ^0"
+s[1379] = "synacode.TableBase64mod^synacode.html#TableBase64mod^^ ^0"
+s[1380] = "synacode.TableUU^synacode.html#TableUU^^ ^0"
+s[1381] = "synacode.TableXX^synacode.html#TableXX^^ ^0"
+s[1382] = "synacode.ReTablebase64^synacode.html#ReTablebase64^^ ^0"
+s[1383] = "synacode.ReTableUU^synacode.html#ReTableUU^^ ^0"
+s[1384] = "synacode.ReTableXX^synacode.html#ReTableXX^^ ^0"
+s[1385] = "synacode.DecodeTriplet^synacode.html#DecodeTriplet^^Decodes triplet encoding with a given character delimiter. It is used for decoding quoted-printable or URL encoding. ^0"
+s[1386] = "synacode.DecodeQuotedPrintable^synacode.html#DecodeQuotedPrintable^^Decodes a string from quoted printable form. (also decodes triplet sequences like '=7F') ^0"
+s[1387] = "synacode.DecodeURL^synacode.html#DecodeURL^^Decodes a string of URL encoding. (also decodes triplet sequences like '%7F') ^0"
+s[1388] = "synacode.EncodeTriplet^synacode.html#EncodeTriplet^^Performs triplet encoding with a given character delimiter. Used for encoding quoted-printable or URL encoding. ^0"
+s[1389] = "synacode.EncodeQuotedPrintable^synacode.html#EncodeQuotedPrintable^^Encodes a string to triplet quoted printable form. All NonAsciiChar are encoded. ^0"
+s[1390] = "synacode.EncodeSafeQuotedPrintable^synacode.html#EncodeSafeQuotedPrintable^^Encodes a string to triplet quoted printable form. All NonAsciiChar and SpecialChar are encoded. ^0"
+s[1391] = "synacode.EncodeURLElement^synacode.html#EncodeURLElement^^Encodes a string to URL format. Used for encoding data from a form field in HTTP, etc. (Encodes all critical characters including characters used as URL delimiters ('/',':', etc.) ^0"
+s[1392] = "synacode.EncodeURL^synacode.html#EncodeURL^^Encodes a string to URL format. Used to encode critical characters in all URLs. ^0"
+s[1393] = "synacode.Decode4to3^synacode.html#Decode4to3^^Decode 4to3 encoding with given table. If some element is not found in table, first item from table is used. This is good for buggy coded items by Microsoft Outlook. This software sometimes using wrong table for UUcode, where is used ' ' instead '`'. ^0"
+s[1394] = "synacode.Decode4to3Ex^synacode.html#Decode4to3Ex^^Decode 4to3 encoding with given REVERSE table. Using this function with reverse table is much faster then Decode4to3 . This function is used internally for Base64, UU or XX decoding. ^0"
+s[1395] = "synacode.Encode3to4^synacode.html#Encode3to4^^Encode by system 3to4 (used by Base64, UU coding, etc) by given table. ^0"
+s[1396] = "synacode.DecodeBase64^synacode.html#DecodeBase64^^Decode string from base64 format. ^0"
+s[1397] = "synacode.EncodeBase64^synacode.html#EncodeBase64^^Encodes a string to base64 format. ^0"
+s[1398] = "synacode.DecodeBase64mod^synacode.html#DecodeBase64mod^^Decode string from modified base64 format. (used in IMAP, for example.) ^0"
+s[1399] = "synacode.EncodeBase64mod^synacode.html#EncodeBase64mod^^Encodes a string to modified base64 format. (used in IMAP, for example.) ^0"
+s[1400] = "synacode.DecodeUU^synacode.html#DecodeUU^^Decodes a string from UUcode format. ^0"
+s[1401] = "synacode.EncodeUU^synacode.html#EncodeUU^^encode UUcode. it encode only datas, you must also add header and footer for proper encode. ^0"
+s[1402] = "synacode.DecodeXX^synacode.html#DecodeXX^^Decodes a string from XXcode format. ^0"
+s[1403] = "synacode.DecodeYEnc^synacode.html#DecodeYEnc^^decode line with Yenc code. This code is sometimes used in newsgroups. ^0"
+s[1404] = "synacode.UpdateCrc32^synacode.html#UpdateCrc32^^Returns a new CRC32 value after adding a new byte of data. ^0"
+s[1405] = "synacode.Crc32^synacode.html#Crc32^^return CRC32 from a value string. ^0"
+s[1406] = "synacode.UpdateCrc16^synacode.html#UpdateCrc16^^Returns a new CRC16 value after adding a new byte of data. ^0"
+s[1407] = "synacode.Crc16^synacode.html#Crc16^^return CRC16 from a value string. ^0"
+s[1408] = "synacode.MD5^synacode.html#MD5^^Returns a binary string with a RSA-MD5 hashing of "Value" string. ^0"
+s[1409] = "synacode.HMAC_MD5^synacode.html#HMAC_MD5^^Returns a binary string with HMAC-MD5 hash. ^0"
+s[1410] = "synacode.MD5LongHash^synacode.html#MD5LongHash^^Returns a binary string with a RSA-MD5 hashing of string what is constructed by repeating "value" until length is "Len". ^0"
+s[1411] = "synacode.SHA1^synacode.html#SHA1^^Returns a binary string with a SHA-1 hashing of "Value" string. ^0"
+s[1412] = "synacode.HMAC_SHA1^synacode.html#HMAC_SHA1^^Returns a binary string with HMAC-SHA1 hash. ^0"
+s[1413] = "synacode.SHA1LongHash^synacode.html#SHA1LongHash^^Returns a binary string with a SHA-1 hashing of string what is constructed by repeating "value" until length is "Len". ^0"
+s[1414] = "synacode.MD4^synacode.html#MD4^^Returns a binary string with a RSA-MD4 hashing of "Value" string. ^0"
+s[1415] = "synacode.TSpecials^synacode.html#TSpecials^^ ^0"
+s[1416] = "synacrypt^synacrypt.html^Encryption support^
Implemented are DES and 3DES encryption/decryption by ECB, CBC, CFB-8bit, CFB-block, OFB and CTR methods. ^0"
+s[1417] = "synacrypt.TSynaBlockCipher^synacrypt.TSynaBlockCipher.html^Implementation of common routines block ciphers (dafault size is 64-bits)^
Do not use this class directly, use descendants only! ^0"
+s[1418] = "synacrypt.TSynaBlockCipher.SetIV^synacrypt.TSynaBlockCipher.html#SetIV^^Sets the IV to Value and performs a reset ^0"
+s[1419] = "synacrypt.TSynaBlockCipher.GetIV^synacrypt.TSynaBlockCipher.html#GetIV^^Returns the current chaining information, not the actual IV ^0"
+s[1420] = "synacrypt.TSynaBlockCipher.Reset^synacrypt.TSynaBlockCipher.html#Reset^^Reset any stored chaining information ^0"
+s[1421] = "synacrypt.TSynaBlockCipher.EncryptECB^synacrypt.TSynaBlockCipher.html#EncryptECB^^Encrypt a 64-bit block of data using the ECB method of encryption ^0"
+s[1422] = "synacrypt.TSynaBlockCipher.DecryptECB^synacrypt.TSynaBlockCipher.html#DecryptECB^^Decrypt a 64-bit block of data using the ECB method of decryption ^0"
+s[1423] = "synacrypt.TSynaBlockCipher.EncryptCBC^synacrypt.TSynaBlockCipher.html#EncryptCBC^^Encrypt data using the CBC method of encryption ^0"
+s[1424] = "synacrypt.TSynaBlockCipher.DecryptCBC^synacrypt.TSynaBlockCipher.html#DecryptCBC^^Decrypt data using the CBC method of decryption ^0"
+s[1425] = "synacrypt.TSynaBlockCipher.EncryptCFB8bit^synacrypt.TSynaBlockCipher.html#EncryptCFB8bit^^Encrypt data using the CFB (8 bit) method of encryption ^0"
+s[1426] = "synacrypt.TSynaBlockCipher.DecryptCFB8bit^synacrypt.TSynaBlockCipher.html#DecryptCFB8bit^^Decrypt data using the CFB (8 bit) method of decryption ^0"
+s[1427] = "synacrypt.TSynaBlockCipher.EncryptCFBblock^synacrypt.TSynaBlockCipher.html#EncryptCFBblock^^Encrypt data using the CFB (block) method of encryption ^0"
+s[1428] = "synacrypt.TSynaBlockCipher.DecryptCFBblock^synacrypt.TSynaBlockCipher.html#DecryptCFBblock^^Decrypt data using the CFB (block) method of decryption ^0"
+s[1429] = "synacrypt.TSynaBlockCipher.EncryptOFB^synacrypt.TSynaBlockCipher.html#EncryptOFB^^Encrypt data using the OFB method of encryption ^0"
+s[1430] = "synacrypt.TSynaBlockCipher.DecryptOFB^synacrypt.TSynaBlockCipher.html#DecryptOFB^^Decrypt data using the OFB method of decryption ^0"
+s[1431] = "synacrypt.TSynaBlockCipher.EncryptCTR^synacrypt.TSynaBlockCipher.html#EncryptCTR^^Encrypt data using the CTR method of encryption ^0"
+s[1432] = "synacrypt.TSynaBlockCipher.DecryptCTR^synacrypt.TSynaBlockCipher.html#DecryptCTR^^Decrypt data using the CTR method of decryption ^0"
+s[1433] = "synacrypt.TSynaBlockCipher.Create^synacrypt.TSynaBlockCipher.html#Create^^Create a encryptor/decryptor instance and initialize it by the Key. ^0"
+s[1434] = "synacrypt.TSynaCustomDes^synacrypt.TSynaCustomDes.html^Implementation of common routines for DES encryption^
Do not use this class directly, use descendants only! ^0"
+s[1435] = "synacrypt.TSynaDes^synacrypt.TSynaDes.html^Implementation of DES encryption^ ^0"
+s[1436] = "synacrypt.TSynaDes.EncryptECB^synacrypt.TSynaDes.html#EncryptECB^^Encrypt a 64-bit block of data using the ECB method of encryption ^0"
+s[1437] = "synacrypt.TSynaDes.DecryptECB^synacrypt.TSynaDes.html#DecryptECB^^Decrypt a 64-bit block of data using the ECB method of decryption ^0"
+s[1438] = "synacrypt.TSyna3Des^synacrypt.TSyna3Des.html^Implementation of 3DES encryption^ ^0"
+s[1439] = "synacrypt.TSyna3Des.EncryptECB^synacrypt.TSyna3Des.html#EncryptECB^^Encrypt a 64-bit block of data using the ECB method of encryption ^0"
+s[1440] = "synacrypt.TSyna3Des.DecryptECB^synacrypt.TSyna3Des.html#DecryptECB^^Decrypt a 64-bit block of data using the ECB method of decryption ^0"
+s[1441] = "synacrypt.TSynaAes^synacrypt.TSynaAes.html^Implementation of AES encryption^ ^0"
+s[1442] = "synacrypt.TSynaAes.EncryptECB^synacrypt.TSynaAes.html#EncryptECB^^Encrypt a 128-bit block of data using the ECB method of encryption ^0"
+s[1443] = "synacrypt.TSynaAes.DecryptECB^synacrypt.TSynaAes.html#DecryptECB^^Decrypt a 128-bit block of data using the ECB method of decryption ^0"
+s[1444] = "synacrypt.BC^synacrypt.html#BC^^ ^0"
+s[1445] = "synacrypt.MAXROUNDS^synacrypt.html#MAXROUNDS^^ ^0"
+s[1446] = "synacrypt.TestDes^synacrypt.html#TestDes^^Call internal test of all DES encryptions. Returns True
if all is OK. ^0"
+s[1447] = "synacrypt.Test3Des^synacrypt.html#Test3Des^^Call internal test of all 3DES encryptions. Returns True
if all is OK. ^0"
+s[1448] = "synacrypt.TestAes^synacrypt.html#TestAes^^Call internal test of all AES encryptions. Returns True
if all is OK. ^0"
+s[1449] = "synacrypt.TDesKeyData^synacrypt.html#TDesKeyData^Datatype for holding one DES key data^
This data type is used internally. ^0"
+s[1450] = "synadbg^synadbg.html^Socket debug tools^
Routines for help with debugging of events on the Sockets. ^0"
+s[1451] = "synadbg.TSynaDebug^synadbg.TSynaDebug.html^^ ^0"
+s[1452] = "synadbg.TSynaDebug.HookStatus^synadbg.TSynaDebug.html#HookStatus^^ ^0"
+s[1453] = "synadbg.TSynaDebug.HookMonitor^synadbg.TSynaDebug.html#HookMonitor^^ ^0"
+s[1454] = "synadbg.AppendToLog^synadbg.html#AppendToLog^^ ^0"
+s[1455] = "synadbg.LogFile^synadbg.html#LogFile^^ ^0"
+s[1456] = "synafpc^synafpc.html^^ ^0"
+s[1457] = "synafpc.Sleep^synafpc.html#Sleep^^ ^0"
+s[1458] = "synafpc.TLibHandle^synafpc.html#TLibHandle^^ ^0"
+s[1459] = "synafpc.PtrInt^synafpc.html#PtrInt^^ ^0"
+s[1460] = "synaicnv^synaicnv.html^LibIconv support^
This unit is Pascal interface to LibIconv library for charset translations. LibIconv is loaded dynamicly on-demand. If this library is not found in system, requested LibIconv function just return errorcode. ^0"
+s[1461] = "synaicnv.DLLIconvName^synaicnv.html#DLLIconvName^^ ^0"
+s[1462] = "synaicnv.ICONV_TRIVIALP^synaicnv.html#ICONV_TRIVIALP^^ ^0"
+s[1463] = "synaicnv.ICONV_GET_TRANSLITERATE^synaicnv.html#ICONV_GET_TRANSLITERATE^^ ^0"
+s[1464] = "synaicnv.ICONV_SET_TRANSLITERATE^synaicnv.html#ICONV_SET_TRANSLITERATE^^ ^0"
+s[1465] = "synaicnv.ICONV_GET_DISCARD_ILSEQ^synaicnv.html#ICONV_GET_DISCARD_ILSEQ^^ ^0"
+s[1466] = "synaicnv.ICONV_SET_DISCARD_ILSEQ^synaicnv.html#ICONV_SET_DISCARD_ILSEQ^^ ^0"
+s[1467] = "synaicnv.SynaIconvOpen^synaicnv.html#SynaIconvOpen^^ ^0"
+s[1468] = "synaicnv.SynaIconvOpenTranslit^synaicnv.html#SynaIconvOpenTranslit^^ ^0"
+s[1469] = "synaicnv.SynaIconvOpenIgnore^synaicnv.html#SynaIconvOpenIgnore^^ ^0"
+s[1470] = "synaicnv.SynaIconv^synaicnv.html#SynaIconv^^ ^0"
+s[1471] = "synaicnv.SynaIconvClose^synaicnv.html#SynaIconvClose^^ ^0"
+s[1472] = "synaicnv.SynaIconvCtl^synaicnv.html#SynaIconvCtl^^ ^0"
+s[1473] = "synaicnv.IsIconvloaded^synaicnv.html#IsIconvloaded^^ ^0"
+s[1474] = "synaicnv.InitIconvInterface^synaicnv.html#InitIconvInterface^^ ^0"
+s[1475] = "synaicnv.DestroyIconvInterface^synaicnv.html#DestroyIconvInterface^^ ^0"
+s[1476] = "synaicnv.size_t^synaicnv.html#size_t^^ ^0"
+s[1477] = "synaicnv.iconv_t^synaicnv.html#iconv_t^^ ^0"
+s[1478] = "synaicnv.argptr^synaicnv.html#argptr^^ ^0"
+s[1479] = "synaicnv.iconvLibHandle^synaicnv.html#iconvLibHandle^^ ^0"
+s[1480] = "synaip^synaip.html^IP adress support procedures and functions^ ^0"
+s[1481] = "synaip.IsIP^synaip.html#IsIP^^Returns True
, if "Value" is a valid IPv4 address. Cannot be a symbolic Name! ^0"
+s[1482] = "synaip.IsIP6^synaip.html#IsIP6^^Returns True
, if "Value" is a valid IPv6 address. Cannot be a symbolic Name! ^0"
+s[1483] = "synaip.IPToID^synaip.html#IPToID^^Returns a string with the "Host" ip address converted to binary form. ^0"
+s[1484] = "synaip.StrToIp6^synaip.html#StrToIp6^^Convert IPv6 address from their string form to binary byte array. ^0"
+s[1485] = "synaip.Ip6ToStr^synaip.html#Ip6ToStr^^Convert IPv6 address from binary byte array to string form. ^0"
+s[1486] = "synaip.StrToIp^synaip.html#StrToIp^^Convert IPv4 address from their string form to binary. ^0"
+s[1487] = "synaip.IpToStr^synaip.html#IpToStr^^Convert IPv4 address from binary to string form. ^0"
+s[1488] = "synaip.ReverseIP^synaip.html#ReverseIP^^Convert IPv4 address to reverse form. ^0"
+s[1489] = "synaip.ReverseIP6^synaip.html#ReverseIP6^^Convert IPv6 address to reverse form. ^0"
+s[1490] = "synaip.ExpandIP6^synaip.html#ExpandIP6^^Expand short form of IPv6 address to long form. ^0"
+s[1491] = "synaip.TIp6Bytes^synaip.html#TIp6Bytes^^binary form of IPv6 adress (for string conversion routines) ^0"
+s[1492] = "synaip.TIp6Words^synaip.html#TIp6Words^^binary form of IPv6 adress (for string conversion routines) ^0"
+s[1493] = "synamisc^synamisc.html^^ ^0"
+s[1494] = "synamisc.TProxySetting^synamisc.TProxySetting.html^This record contains information about proxy setting.^ ^0"
+s[1495] = "synamisc.TProxySetting.Host^synamisc.TProxySetting.html#Host^^ ^0"
+s[1496] = "synamisc.TProxySetting.Port^synamisc.TProxySetting.html#Port^^ ^0"
+s[1497] = "synamisc.TProxySetting.Bypass^synamisc.TProxySetting.html#Bypass^^ ^0"
+s[1498] = "synamisc.WakeOnLan^synamisc.html#WakeOnLan^^By this function you can turn-on computer on network, if this computer supporting Wake-on-lan feature. You need MAC number (network card indentifier) of computer for turn-on. You can also assign target IP addres. If you not specify it, then is used broadcast for delivery magic wake-on packet. However broadcasts workinh only on your local network. When you need to wake-up computer on another network, you must specify any existing IP addres on same network segment as targeting computer. ^0"
+s[1499] = "synamisc.GetDNS^synamisc.html#GetDNS^^Autodetect current DNS servers used by system. If is defined more then one DNS server, then result is comma-delimited. ^0"
+s[1500] = "synamisc.GetIEProxy^synamisc.html#GetIEProxy^^Autodetect InternetExplorer proxy setting for given protocol. This function working only on windows! ^0"
+s[1501] = "synamisc.GetLocalIPs^synamisc.html#GetLocalIPs^^Return all known IP addresses on local system. Addresses are divided by comma. ^0"
+s[1502] = "synaser^synaser.html^^ ^0"
+s[1503] = "synaser.ESynaSerError^synaser.ESynaSerError.html^Exception type for SynaSer errors^ ^0"
+s[1504] = "synaser.ESynaSerError.ErrorCode^synaser.ESynaSerError.html#ErrorCode^^ ^0"
+s[1505] = "synaser.ESynaSerError.ErrorMessage^synaser.ESynaSerError.html#ErrorMessage^^ ^0"
+s[1506] = "synaser.TBlockSerial^synaser.TBlockSerial.html^Main class implementing all communication routines^ ^0"
+s[1507] = "synaser.TBlockSerial.DCB^synaser.TBlockSerial.html#DCB^^data Control Block with communication parameters. Usable only when you need to call API directly. ^0"
+s[1508] = "synaser.TBlockSerial.Create^synaser.TBlockSerial.html#Create^^Object constructor. ^0"
+s[1509] = "synaser.TBlockSerial.Destroy^synaser.TBlockSerial.html#Destroy^^Object destructor. ^0"
+s[1510] = "synaser.TBlockSerial.GetVersion^synaser.TBlockSerial.html#GetVersion^^Returns a string containing the version number of the library. ^0"
+s[1511] = "synaser.TBlockSerial.CloseSocket^synaser.TBlockSerial.html#CloseSocket^^Destroy handle in use. It close connection to serial port. ^0"
+s[1512] = "synaser.TBlockSerial.Config^synaser.TBlockSerial.html#Config^^Reconfigure communication parameters on the fly. You must be connected to port before! baud Define connection speed. Baud rate can be from 50 to 4000000 bits per second. (it depends on your hardware!) bits Number of bits in communication. parity Define communication parity (N - None, O - Odd, E - Even, M - Mark or S - Space). stop Define number of stopbits. Use constants SB1 , SB1andHalf and SB2 . softflow Enable XON/XOFF handshake. hardflow Enable CTS/RTS handshake. ^0"
+s[1513] = "synaser.TBlockSerial.Connect^synaser.TBlockSerial.html#Connect^^Connects to the port indicated by comport. Comport can be used in Windows style (COM2), or in Linux style (/dev/ttyS1). When you use windows style in Linux, then it will be converted to Linux name. And vice versa! However you can specify any device name! (other device names then standart is not converted!)
After successfull connection the DTR signal is set (if you not set hardware handshake, then the RTS signal is set, too!)
Connection parameters is predefined by your system configuration. If you need use another parameters, then you can use Config method after. Notes:
- Remember, the commonly used serial Laplink cable does not support hardware handshake.
- Before setting any handshake you must be sure that it is supported by your hardware.
- Some serial devices are slow. In some cases you must wait up to a few seconds after connection for the device to respond.
- when you connect to a modem device, then is best to test it by an empty AT command. (call ATCommand('AT')) ^0"
+s[1514] = "synaser.TBlockSerial.SetCommState^synaser.TBlockSerial.html#SetCommState^^Set communication parameters from the DCB structure (the DCB structure is simulated under Linux). ^0"
+s[1515] = "synaser.TBlockSerial.GetCommState^synaser.TBlockSerial.html#GetCommState^^Read communication parameters into the DCB structure (DCB structure is simulated under Linux). ^0"
+s[1516] = "synaser.TBlockSerial.SendBuffer^synaser.TBlockSerial.html#SendBuffer^^Sends Length bytes of data from Buffer through the connected port. ^0"
+s[1517] = "synaser.TBlockSerial.SendByte^synaser.TBlockSerial.html#SendByte^^One data BYTE is sent. ^0"
+s[1518] = "synaser.TBlockSerial.SendString^synaser.TBlockSerial.html#SendString^^Send the string in the data parameter. No terminator is appended by this method. If you need to send a string with CR/LF terminator, you must append the CR/LF characters to the data string!
Since no terminator is appended, you can use this function for sending binary data too. ^0"
+s[1519] = "synaser.TBlockSerial.SendInteger^synaser.TBlockSerial.html#SendInteger^^send four bytes as integer. ^0"
+s[1520] = "synaser.TBlockSerial.SendBlock^synaser.TBlockSerial.html#SendBlock^^send data as one block. Each block begins with integer value with Length of block. ^0"
+s[1521] = "synaser.TBlockSerial.SendStreamRaw^synaser.TBlockSerial.html#SendStreamRaw^^send content of stream from current position ^0"
+s[1522] = "synaser.TBlockSerial.SendStream^synaser.TBlockSerial.html#SendStream^^send content of stream as block. see SendBlock ^0"
+s[1523] = "synaser.TBlockSerial.SendStreamIndy^synaser.TBlockSerial.html#SendStreamIndy^^send content of stream as block, but this is compatioble with Indy library. (it have swapped lenght of block). See SendStream ^0"
+s[1524] = "synaser.TBlockSerial.RecvBuffer^synaser.TBlockSerial.html#RecvBuffer^^Waits until the allocated buffer is filled by received data. Returns number of data bytes received, which equals to the Length value under normal operation. If it is not equal, the communication channel is possibly broken.
This method not using any internal buffering, like all others receiving methods. You cannot freely combine this method with all others receiving methods! ^0"
+s[1525] = "synaser.TBlockSerial.RecvBufferEx^synaser.TBlockSerial.html#RecvBufferEx^^Method waits until data is received. If no data is received within the Timeout (in milliseconds) period, LastError is set to ErrTimeout . This method is used to read any amount of data (e. g. 1MB), and may be freely combined with all receviving methods what have Timeout parameter, like the Recvstring , RecvByte or RecvTerminated methods. ^0"
+s[1526] = "synaser.TBlockSerial.RecvBufferStr^synaser.TBlockSerial.html#RecvBufferStr^^It is like recvBufferEx, but data is readed to dynamicly allocated binary string. ^0"
+s[1527] = "synaser.TBlockSerial.RecvPacket^synaser.TBlockSerial.html#RecvPacket^^Read all available data and return it in the function result string. This function may be combined with Recvstring , RecvByte or related methods. ^0"
+s[1528] = "synaser.TBlockSerial.RecvByte^synaser.TBlockSerial.html#RecvByte^^Waits until one data byte is received which is returned as the function result. If no data is received within the Timeout (in milliseconds) period, LastError is set to ErrTimeout . ^0"
+s[1529] = "synaser.TBlockSerial.RecvTerminated^synaser.TBlockSerial.html#RecvTerminated^^This method waits until a terminated data string is received. This string is terminated by the Terminator string. The resulting string is returned without this termination string! If no data is received within the Timeout (in milliseconds) period, LastError is set to ErrTimeout . ^0"
+s[1530] = "synaser.TBlockSerial.Recvstring^synaser.TBlockSerial.html#Recvstring^^This method waits until a terminated data string is received. The string is terminated by a CR/LF sequence. The resulting string is returned without the terminator (CR/LF)! If no data is received within the Timeout (in milliseconds) period, LastError is set to ErrTimeout .
If ConvertLineEnd is used, then the CR/LF sequence may not be exactly CR/LF. See the description of ConvertLineEnd .
This method serves for line protocol implementation and uses its own buffers to maximize performance. Therefore do NOT use this method with the RecvBuffer method to receive data as it may cause data loss. ^0"
+s[1531] = "synaser.TBlockSerial.RecvInteger^synaser.TBlockSerial.html#RecvInteger^^Waits until four data bytes are received which is returned as the function integer result. If no data is received within the Timeout (in milliseconds) period, LastError is set to ErrTimeout . ^0"
+s[1532] = "synaser.TBlockSerial.RecvBlock^synaser.TBlockSerial.html#RecvBlock^^Waits until one data block is received. See SendBlock . If no data is received within the Timeout (in milliseconds) period, LastError is set to ErrTimeout . ^0"
+s[1533] = "synaser.TBlockSerial.RecvStreamRaw^synaser.TBlockSerial.html#RecvStreamRaw^^Receive all data to stream, until some error occured. (for example timeout) ^0"
+s[1534] = "synaser.TBlockSerial.RecvStreamSize^synaser.TBlockSerial.html#RecvStreamSize^^receive requested count of bytes to stream ^0"
+s[1535] = "synaser.TBlockSerial.RecvStream^synaser.TBlockSerial.html#RecvStream^^receive block of data to stream. (Data can be sended by SendStream ^0"
+s[1536] = "synaser.TBlockSerial.RecvStreamIndy^synaser.TBlockSerial.html#RecvStreamIndy^^receive block of data to stream. (Data can be sended by SendStreamIndy ^0"
+s[1537] = "synaser.TBlockSerial.WaitingData^synaser.TBlockSerial.html#WaitingData^^Returns the number of received bytes waiting for reading. 0 is returned when there is no data waiting. ^0"
+s[1538] = "synaser.TBlockSerial.WaitingDataEx^synaser.TBlockSerial.html#WaitingDataEx^^Same as WaitingData , but in respect to data in the internal LineBuffer . ^0"
+s[1539] = "synaser.TBlockSerial.SendingData^synaser.TBlockSerial.html#SendingData^^Returns the number of bytes waiting to be sent in the output buffer. 0 is returned when the output buffer is empty. ^0"
+s[1540] = "synaser.TBlockSerial.EnableRTSToggle^synaser.TBlockSerial.html#EnableRTSToggle^^Enable or disable RTS driven communication (half-duplex). It can be used to communicate with RS485 converters, or other special equipment. If you enable this feature, the system automatically controls the RTS signal.
Notes:
- On Windows NT (or higher) ir RTS signal driven by system driver.
- On Win9x family is used special code for waiting until last byte is sended from your UART.
- On Linux you must have kernel 2.1 or higher! ^0"
+s[1541] = "synaser.TBlockSerial.Flush^synaser.TBlockSerial.html#Flush^^Waits until all data to is sent and buffers are emptied. Warning: On Windows systems is this method returns when all buffers are flushed to the serial port controller, before the last byte is sent! ^0"
+s[1542] = "synaser.TBlockSerial.Purge^synaser.TBlockSerial.html#Purge^^Unconditionally empty all buffers. It is good when you need to interrupt communication and for cleanups. ^0"
+s[1543] = "synaser.TBlockSerial.CanRead^synaser.TBlockSerial.html#CanRead^^Returns True
, if you can from read any data from the port. Status is tested for a period of time given by the Timeout parameter (in milliseconds). If the value of the Timeout parameter is 0, the status is tested only once and the function returns immediately. If the value of the Timeout parameter is set to -1, the function returns only after it detects data on the port (this may cause the process to hang). ^0"
+s[1544] = "synaser.TBlockSerial.CanWrite^synaser.TBlockSerial.html#CanWrite^^Returns True
, if you can write any data to the port (this function is not sending the contents of the buffer). Status is tested for a period of time given by the Timeout parameter (in milliseconds). If the value of the Timeout parameter is 0, the status is tested only once and the function returns immediately. If the value of the Timeout parameter is set to -1, the function returns only after it detects that it can write data to the port (this may cause the process to hang). ^0"
+s[1545] = "synaser.TBlockSerial.CanReadEx^synaser.TBlockSerial.html#CanReadEx^^Same as CanRead , but the test is against data in the internal LineBuffer too. ^0"
+s[1546] = "synaser.TBlockSerial.ModemStatus^synaser.TBlockSerial.html#ModemStatus^^Returns the status word of the modem. Decoding the status word could yield the status of carrier detect signaland other signals. This method is used internally by the modem status reading properties. You usually do not need to call this method directly. ^0"
+s[1547] = "synaser.TBlockSerial.SetBreak^synaser.TBlockSerial.html#SetBreak^^Send a break signal to the communication device for Duration milliseconds. ^0"
+s[1548] = "synaser.TBlockSerial.ATCommand^synaser.TBlockSerial.html#ATCommand^^This function is designed to send AT commands to the modem. The AT command is sent in the Value parameter and the response is returned in the function return value (may contain multiple lines!). If the AT command is processed successfully (modem returns OK), then the ATResult property is set to True.
This function is designed only for AT commands that return OK or ERROR response! To call connection commands the ATConnect method. Remember, when you connect to a modem device, it is in AT command mode. Now you can send AT commands to the modem. If you need to transfer data to the modem on the other side of the line, you must first switch to data mode using the ATConnect method. ^0"
+s[1549] = "synaser.TBlockSerial.ATConnect^synaser.TBlockSerial.html#ATConnect^^This function is used to send connect type AT commands to the modem. It is for commands to switch to connected state. (ATD, ATA, ATO,...) It sends the AT command in the Value parameter and returns the modem's response (may be multiple lines - usually with connection parameters info). If the AT command is processed successfully (the modem returns CONNECT), then the ATResult property is set to True
.
This function is designed only for AT commands which respond by CONNECT, BUSY, NO DIALTONE NO CARRIER or ERROR. For other AT commands use the ATCommand method.
The connect timeout is 90*AtTimeout . If this command is successful (ATResult is True
), then the modem is in data state. When you now send or receive some data, it is not to or from your modem, but from the modem on other side of the line. Now you can transfer your data. If the connection attempt failed (ATResult is False
), then the modem is still in AT command mode. ^0"
+s[1550] = "synaser.TBlockSerial.SerialCheck^synaser.TBlockSerial.html#SerialCheck^^If you "manually" call API functions, forward their return code in the SerialResult parameter to this function, which evaluates it and sets LastError and LastErrorDesc . ^0"
+s[1551] = "synaser.TBlockSerial.ExceptCheck^synaser.TBlockSerial.html#ExceptCheck^^If LastError is not 0 and exceptions are enabled, then this procedure raises an exception. This method is used internally. You may need it only in special cases. ^0"
+s[1552] = "synaser.TBlockSerial.SetSynaError^synaser.TBlockSerial.html#SetSynaError^^Set Synaser to error state with ErrNumber code. Usually used by internal routines. ^0"
+s[1553] = "synaser.TBlockSerial.RaiseSynaError^synaser.TBlockSerial.html#RaiseSynaError^^Raise Synaser error with ErrNumber code. Usually used by internal routines. ^0"
+s[1554] = "synaser.TBlockSerial.GetErrorDesc^synaser.TBlockSerial.html#GetErrorDesc^^Returns the descriptive text associated with ErrorCode. You need this method only in special cases. Description of LastError is now accessible through the LastErrorDesc property. ^0"
+s[1555] = "synaser.TBlockSerial.Device^synaser.TBlockSerial.html#Device^^True device name of currently used port ^0"
+s[1556] = "synaser.TBlockSerial.LastError^synaser.TBlockSerial.html#LastError^^Error code of last operation. Value is defined by the host operating system, but value 0 is always OK. ^0"
+s[1557] = "synaser.TBlockSerial.LastErrorDesc^synaser.TBlockSerial.html#LastErrorDesc^^Human readable description of LastError code. ^0"
+s[1558] = "synaser.TBlockSerial.ATResult^synaser.TBlockSerial.html#ATResult^^Indicates if the last ATCommand or ATConnect method was successful ^0"
+s[1559] = "synaser.TBlockSerial.RTS^synaser.TBlockSerial.html#RTS^^Read the value of the RTS signal. ^0"
+s[1560] = "synaser.TBlockSerial.CTS^synaser.TBlockSerial.html#CTS^^Indicates the presence of the CTS signal ^0"
+s[1561] = "synaser.TBlockSerial.DTR^synaser.TBlockSerial.html#DTR^^Use this property to set the value of the DTR signal. ^0"
+s[1562] = "synaser.TBlockSerial.DSR^synaser.TBlockSerial.html#DSR^^Exposes the status of the DSR signal. ^0"
+s[1563] = "synaser.TBlockSerial.Carrier^synaser.TBlockSerial.html#Carrier^^Indicates the presence of the Carrier signal ^0"
+s[1564] = "synaser.TBlockSerial.Ring^synaser.TBlockSerial.html#Ring^^Reflects the status of the Ring signal. ^0"
+s[1565] = "synaser.TBlockSerial.InstanceActive^synaser.TBlockSerial.html#InstanceActive^^indicates if this instance of SynaSer is active. (Connected to some port) ^0"
+s[1566] = "synaser.TBlockSerial.MaxSendBandwidth^synaser.TBlockSerial.html#MaxSendBandwidth^^Defines maximum bandwidth for all sending operations in bytes per second. If this value is set to 0 (default), bandwidth limitation is not used. ^0"
+s[1567] = "synaser.TBlockSerial.MaxRecvBandwidth^synaser.TBlockSerial.html#MaxRecvBandwidth^^Defines maximum bandwidth for all receiving operations in bytes per second. If this value is set to 0 (default), bandwidth limitation is not used. ^0"
+s[1568] = "synaser.TBlockSerial.MaxBandwidth^synaser.TBlockSerial.html#MaxBandwidth^^Defines maximum bandwidth for all sending and receiving operations in bytes per second. If this value is set to 0 (default), bandwidth limitation is not used. ^0"
+s[1569] = "synaser.TBlockSerial.SizeRecvBuffer^synaser.TBlockSerial.html#SizeRecvBuffer^^Size of the Windows internal receive buffer. Default value is usually 4096 bytes. Note: Valid only in Windows versions! ^0"
+s[1570] = "synaser.TBlockSerial.Tag^synaser.TBlockSerial.html#Tag^^Freely usable property ^0"
+s[1571] = "synaser.TBlockSerial.Handle^synaser.TBlockSerial.html#Handle^^Contains the handle of the open communication port. You may need this value to directly call communication functions outside SynaSer. ^0"
+s[1572] = "synaser.TBlockSerial.LineBuffer^synaser.TBlockSerial.html#LineBuffer^^Internally used read buffer. ^0"
+s[1573] = "synaser.TBlockSerial.RaiseExcept^synaser.TBlockSerial.html#RaiseExcept^^If True
, communication errors raise exceptions. If False
(default), only the LastError value is set. ^0"
+s[1574] = "synaser.TBlockSerial.OnStatus^synaser.TBlockSerial.html#OnStatus^^This event is triggered when the communication status changes. It can be used to monitor communication status. ^0"
+s[1575] = "synaser.TBlockSerial.TestDSR^synaser.TBlockSerial.html#TestDSR^^If you set this property to True
, then the value of the DSR signal is tested before every data transfer. It can be used to detect the presence of a communications device. ^0"
+s[1576] = "synaser.TBlockSerial.TestCTS^synaser.TBlockSerial.html#TestCTS^^If you set this property to True
, then the value of the CTS signal is tested before every data transfer. It can be used to detect the presence of a communications device. Warning: This property cannot be used if you need hardware handshake! ^0"
+s[1577] = "synaser.TBlockSerial.MaxLineLength^synaser.TBlockSerial.html#MaxLineLength^^Use this property you to limit the maximum size of LineBuffer (as a protection against unlimited memory allocation for LineBuffer). Default value is 0 - no limit. ^0"
+s[1578] = "synaser.TBlockSerial.DeadlockTimeout^synaser.TBlockSerial.html#DeadlockTimeout^^This timeout value is used as deadlock protection when trying to send data to (or receive data from) a device that stopped communicating during data transmission (e.g. by physically disconnecting the device). The timeout value is in milliseconds. The default value is 30,000 (30 seconds). ^0"
+s[1579] = "synaser.TBlockSerial.LinuxLock^synaser.TBlockSerial.html#LinuxLock^^If set to True
(default value), port locking is enabled (under Linux only). WARNING: To use this feature, the application must run by a user with full permission to the /var/lock directory! ^0"
+s[1580] = "synaser.TBlockSerial.ConvertLineEnd^synaser.TBlockSerial.html#ConvertLineEnd^^Indicates if non-standard line terminators should be converted to a CR/LF pair (standard DOS line terminator). If True
, line terminators CR, single LF or LF/CR are converted to CR/LF. Defaults to False
. This property has effect only on the behavior of the RecvString method. ^0"
+s[1581] = "synaser.TBlockSerial.AtTimeout^synaser.TBlockSerial.html#AtTimeout^^Timeout for AT modem based operations ^0"
+s[1582] = "synaser.TBlockSerial.InterPacketTimeout^synaser.TBlockSerial.html#InterPacketTimeout^^If True
(default), then all timeouts is timeout between two characters. If False
, then timeout is overall for whoole reading operation. ^0"
+s[1583] = "synaser.CR^synaser.html#CR^^ ^0"
+s[1584] = "synaser.LF^synaser.html#LF^^ ^0"
+s[1585] = "synaser.CRLF^synaser.html#CRLF^^ ^0"
+s[1586] = "synaser.cSerialChunk^synaser.html#cSerialChunk^^ ^0"
+s[1587] = "synaser.LockfileDirectory^synaser.html#LockfileDirectory^^ ^0"
+s[1588] = "synaser.PortIsClosed^synaser.html#PortIsClosed^^ ^0"
+s[1589] = "synaser.ErrAlreadyOwned^synaser.html#ErrAlreadyOwned^^ ^0"
+s[1590] = "synaser.ErrAlreadyInUse^synaser.html#ErrAlreadyInUse^^ ^0"
+s[1591] = "synaser.ErrWrongParameter^synaser.html#ErrWrongParameter^^ ^0"
+s[1592] = "synaser.ErrPortNotOpen^synaser.html#ErrPortNotOpen^^ ^0"
+s[1593] = "synaser.ErrNoDeviceAnswer^synaser.html#ErrNoDeviceAnswer^^ ^0"
+s[1594] = "synaser.ErrMaxBuffer^synaser.html#ErrMaxBuffer^^ ^0"
+s[1595] = "synaser.ErrTimeout^synaser.html#ErrTimeout^^ ^0"
+s[1596] = "synaser.ErrNotRead^synaser.html#ErrNotRead^^ ^0"
+s[1597] = "synaser.ErrFrame^synaser.html#ErrFrame^^ ^0"
+s[1598] = "synaser.ErrOverrun^synaser.html#ErrOverrun^^ ^0"
+s[1599] = "synaser.ErrRxOver^synaser.html#ErrRxOver^^ ^0"
+s[1600] = "synaser.ErrRxParity^synaser.html#ErrRxParity^^ ^0"
+s[1601] = "synaser.ErrTxFull^synaser.html#ErrTxFull^^ ^0"
+s[1602] = "synaser.dcb_Binary^synaser.html#dcb_Binary^^ ^0"
+s[1603] = "synaser.dcb_ParityCheck^synaser.html#dcb_ParityCheck^^ ^0"
+s[1604] = "synaser.dcb_OutxCtsFlow^synaser.html#dcb_OutxCtsFlow^^ ^0"
+s[1605] = "synaser.dcb_OutxDsrFlow^synaser.html#dcb_OutxDsrFlow^^ ^0"
+s[1606] = "synaser.dcb_DtrControlMask^synaser.html#dcb_DtrControlMask^^ ^0"
+s[1607] = "synaser.dcb_DtrControlDisable^synaser.html#dcb_DtrControlDisable^^ ^0"
+s[1608] = "synaser.dcb_DtrControlEnable^synaser.html#dcb_DtrControlEnable^^ ^0"
+s[1609] = "synaser.dcb_DtrControlHandshake^synaser.html#dcb_DtrControlHandshake^^ ^0"
+s[1610] = "synaser.dcb_DsrSensivity^synaser.html#dcb_DsrSensivity^^ ^0"
+s[1611] = "synaser.dcb_TXContinueOnXoff^synaser.html#dcb_TXContinueOnXoff^^ ^0"
+s[1612] = "synaser.dcb_OutX^synaser.html#dcb_OutX^^ ^0"
+s[1613] = "synaser.dcb_InX^synaser.html#dcb_InX^^ ^0"
+s[1614] = "synaser.dcb_ErrorChar^synaser.html#dcb_ErrorChar^^ ^0"
+s[1615] = "synaser.dcb_NullStrip^synaser.html#dcb_NullStrip^^ ^0"
+s[1616] = "synaser.dcb_RtsControlMask^synaser.html#dcb_RtsControlMask^^ ^0"
+s[1617] = "synaser.dcb_RtsControlDisable^synaser.html#dcb_RtsControlDisable^^ ^0"
+s[1618] = "synaser.dcb_RtsControlEnable^synaser.html#dcb_RtsControlEnable^^ ^0"
+s[1619] = "synaser.dcb_RtsControlHandshake^synaser.html#dcb_RtsControlHandshake^^ ^0"
+s[1620] = "synaser.dcb_RtsControlToggle^synaser.html#dcb_RtsControlToggle^^ ^0"
+s[1621] = "synaser.dcb_AbortOnError^synaser.html#dcb_AbortOnError^^ ^0"
+s[1622] = "synaser.dcb_Reserveds^synaser.html#dcb_Reserveds^^ ^0"
+s[1623] = "synaser.SB1^synaser.html#SB1^^stopbit value for 1 stopbit ^0"
+s[1624] = "synaser.SB1andHalf^synaser.html#SB1andHalf^^stopbit value for 1.5 stopbit ^0"
+s[1625] = "synaser.SB2^synaser.html#SB2^^stopbit value for 2 stopbits ^0"
+s[1626] = "synaser.sOK^synaser.html#sOK^^ ^0"
+s[1627] = "synaser.sErr^synaser.html#sErr^^ ^0"
+s[1628] = "synaser.GetSerialPortNames^synaser.html#GetSerialPortNames^^Returns list of existing computer serial ports. Working properly only in Windows! ^0"
+s[1629] = "synaser.THookSerialReason^synaser.html#THookSerialReason^^Possible status event types for THookSerialStatus HR_SerialClose HR_Connect HR_CanRead HR_CanWrite HR_ReadCount HR_WriteCount HR_Wait ^0"
+s[1630] = "synaser.THookSerialStatus^synaser.html#THookSerialStatus^^procedural prototype for status event hooking ^0"
+s[1631] = "synautil^synautil.html^^ ^0"
+s[1632] = "synautil.TimeZoneBias^synautil.html#TimeZoneBias^^Return your timezone bias from UTC time in minutes. ^0"
+s[1633] = "synautil.TimeZone^synautil.html#TimeZone^^Return your timezone bias from UTC time in string representation like "+0200". ^0"
+s[1634] = "synautil.Rfc822DateTime^synautil.html#Rfc822DateTime^^Returns current time in format defined in RFC-822. Useful for SMTP messages, but other protocols use this time format as well. Results contains the timezone specification. Four digit year is used to break any Y2K concerns. (Example 'Fri, 15 Oct 1999 21:14:56 +0200') ^0"
+s[1635] = "synautil.CDateTime^synautil.html#CDateTime^^Returns date and time in format defined in C compilers in format "mmm dd hh:nn:ss" ^0"
+s[1636] = "synautil.SimpleDateTime^synautil.html#SimpleDateTime^^Returns date and time in format defined in format 'yymmdd hhnnss' ^0"
+s[1637] = "synautil.AnsiCDateTime^synautil.html#AnsiCDateTime^^Returns date and time in format defined in ANSI C compilers in format "ddd mmm d hh:nn:ss yyyy" ^0"
+s[1638] = "synautil.GetMonthNumber^synautil.html#GetMonthNumber^^Decode three-letter string with name of month to their month number. If string not match any month name, then is returned 0. For parsing are used predefined names for English, French and German and names from system locale too. ^0"
+s[1639] = "synautil.GetTimeFromStr^synautil.html#GetTimeFromStr^^Return decoded time from given string. Time must be witch separator ':'. You can use "hh:mm" or "hh:mm:ss". ^0"
+s[1640] = "synautil.GetDateMDYFromStr^synautil.html#GetDateMDYFromStr^^Decode string in format "m-d-y" to TDateTime type. ^0"
+s[1641] = "synautil.DecodeRfcDateTime^synautil.html#DecodeRfcDateTime^^Decode various string representations of date and time to Tdatetime type. This function do all timezone corrections too! This function can decode lot of formats like:
ddd, d mmm yyyy hh:mm:ss ddd, d mmm yy hh:mm:ss ddd, mmm d yyyy hh:mm:ss ddd mmm dd hh:mm:ss yyyy
and more with lot of modifications, include:
Sun, 06 Nov 1994 08:49 :37 GMT ; RFC 822 , updated by RFC 1123 Sunday, 06 -Nov-94 08:49 :37 GMT ; RFC 850 , obsoleted by RFC 1036 Sun Nov 6 08:49 :37 1994 ; ANSI C Timezone corrections known lot of symbolic timezone names (like CEST, EDT, etc.) or numeric representation (like +0200). By convention defined in RFC timezone +0000 is GMT and -0000 is current your system timezone. ^0"
+s[1642] = "synautil.GetUTTime^synautil.html#GetUTTime^^Return current system date and time in UTC timezone. ^0"
+s[1643] = "synautil.SetUTTime^synautil.html#SetUTTime^^Set Newdt as current system date and time in UTC timezone. This function work only if you have administrator rights! ^0"
+s[1644] = "synautil.GetTick^synautil.html#GetTick^^Return current value of system timer with precizion 1 millisecond. Good for measure time difference. ^0"
+s[1645] = "synautil.TickDelta^synautil.html#TickDelta^^Return difference between two timestamps. It working fine only for differences smaller then maxint. (difference must be smaller then 24 days.) ^0"
+s[1646] = "synautil.CodeInt^synautil.html#CodeInt^^Return two characters, which ordinal values represents the value in byte format. (High-endian) ^0"
+s[1647] = "synautil.DecodeInt^synautil.html#DecodeInt^^Decodes two characters located at "Index" offset position of the "Value" string to Word values. ^0"
+s[1648] = "synautil.CodeLongInt^synautil.html#CodeLongInt^^Return four characters, which ordinal values represents the value in byte format. (High-endian) ^0"
+s[1649] = "synautil.DecodeLongInt^synautil.html#DecodeLongInt^^Decodes four characters located at "Index" offset position of the "Value" string to LongInt values. ^0"
+s[1650] = "synautil.DumpStr^synautil.html#DumpStr^^Dump binary buffer stored in a string to a result string. ^0"
+s[1651] = "synautil.DumpExStr^synautil.html#DumpExStr^^Dump binary buffer stored in a string to a result string. All bytes with code of character is written as character, not as hexadecimal value. ^0"
+s[1652] = "synautil.Dump^synautil.html#Dump^^Dump binary buffer stored in a string to a file with DumpFile filename. ^0"
+s[1653] = "synautil.DumpEx^synautil.html#DumpEx^^Dump binary buffer stored in a string to a file with DumpFile filename. All bytes with code of character is written as character, not as hexadecimal value. ^0"
+s[1654] = "synautil.TrimSPLeft^synautil.html#TrimSPLeft^^Like TrimLeft, but remove only spaces, not control characters! ^0"
+s[1655] = "synautil.TrimSPRight^synautil.html#TrimSPRight^^Like TrimRight, but remove only spaces, not control characters! ^0"
+s[1656] = "synautil.TrimSP^synautil.html#TrimSP^^Like Trim, but remove only spaces, not control characters! ^0"
+s[1657] = "synautil.SeparateLeft^synautil.html#SeparateLeft^^Returns a portion of the "Value" string located to the left of the "Delimiter" string. If a delimiter is not found, results is original string. ^0"
+s[1658] = "synautil.SeparateRight^synautil.html#SeparateRight^^Returns the portion of the "Value" string located to the right of the "Delimiter" string. If a delimiter is not found, results is original string. ^0"
+s[1659] = "synautil.GetParameter^synautil.html#GetParameter^^Returns parameter value from string in format: parameter1="value1"; parameter2=value2 ^0"
+s[1660] = "synautil.ParseParametersEx^synautil.html#ParseParametersEx^^parse value string with elements differed by Delimiter into stringlist. ^0"
+s[1661] = "synautil.ParseParameters^synautil.html#ParseParameters^^parse value string with elements differed by ';' into stringlist. ^0"
+s[1662] = "synautil.IndexByBegin^synautil.html#IndexByBegin^^Index of string in stringlist with same beginning as Value is returned. ^0"
+s[1663] = "synautil.GetEmailAddr^synautil.html#GetEmailAddr^^Returns only the e-mail portion of an address from the full address format. i.e. returns 'nobody@somewhere.com' from '"someone" <nobody@somewhere.com>' ^0"
+s[1664] = "synautil.GetEmailDesc^synautil.html#GetEmailDesc^^Returns only the description part from a full address format. i.e. returns 'someone' from '"someone" <nobody@somewhere.com>' ^0"
+s[1665] = "synautil.StrToHex^synautil.html#StrToHex^^Returns a string with hexadecimal digits representing the corresponding values of the bytes found in "Value" string. ^0"
+s[1666] = "synautil.IntToBin^synautil.html#IntToBin^^Returns a string of binary "Digits" representing "Value". ^0"
+s[1667] = "synautil.BinToInt^synautil.html#BinToInt^^Returns an integer equivalent of the binary string in "Value". (i.e. ('10001010') returns 138) ^0"
+s[1668] = "synautil.ParseURL^synautil.html#ParseURL^^Parses a URL to its various components. ^0"
+s[1669] = "synautil.ReplaceString^synautil.html#ReplaceString^^Replaces all "Search" string values found within "Value" string, with the "Replace" string value. ^0"
+s[1670] = "synautil.RPosEx^synautil.html#RPosEx^^It is like RPos, but search is from specified possition. ^0"
+s[1671] = "synautil.RPos^synautil.html#RPos^^It is like POS function, but from right side of Value string. ^0"
+s[1672] = "synautil.FetchBin^synautil.html#FetchBin^^Like Fetch , but working with binary strings, not with text. ^0"
+s[1673] = "synautil.Fetch^synautil.html#Fetch^^Fetch string from left of Value string. ^0"
+s[1674] = "synautil.FetchEx^synautil.html#FetchEx^^Fetch string from left of Value string. This function ignore delimitesr inside quotations. ^0"
+s[1675] = "synautil.IsBinaryString^synautil.html#IsBinaryString^^If string is binary string (contains non-printable characters), then is returned true. ^0"
+s[1676] = "synautil.PosCRLF^synautil.html#PosCRLF^^return position of string terminator in string. If terminator found, then is returned in terminator parameter. Possible line terminators are: CRLF, LFCR, CR, LF ^0"
+s[1677] = "synautil.StringsTrim^synautil.html#StringsTrim^^Delete empty strings from end of stringlist. ^0"
+s[1678] = "synautil.PosFrom^synautil.html#PosFrom^^Like Pos function, buf from given string possition. ^0"
+s[1679] = "synautil.IncPoint^synautil.html#IncPoint^^Increase pointer by value. ^0"
+s[1680] = "synautil.GetBetween^synautil.html#GetBetween^^Get string between PairBegin and PairEnd. This function respect nesting. For example:
Value is : 'Hi! (hello(yes!))' pairbegin is : '(' pairend is : ')' In this case result is : 'hello(yes!)' ^0"
+s[1681] = "synautil.CountOfChar^synautil.html#CountOfChar^^Return count of Chr in Value string. ^0"
+s[1682] = "synautil.UnquoteStr^synautil.html#UnquoteStr^^Remove quotation from Value string. If Value is not quoted, then return same string without any modification. ^0"
+s[1683] = "synautil.QuoteStr^synautil.html#QuoteStr^^Quote Value string. If Value contains some Quote chars, then it is doubled. ^0"
+s[1684] = "synautil.HeadersToList^synautil.html#HeadersToList^^Convert lines in stringlist from 'name: value' form to 'name=value' form. ^0"
+s[1685] = "synautil.ListToHeaders^synautil.html#ListToHeaders^^Convert lines in stringlist from 'name=value' form to 'name: value' form. ^0"
+s[1686] = "synautil.SwapBytes^synautil.html#SwapBytes^^swap bytes in integer. ^0"
+s[1687] = "synautil.ReadStrFromStream^synautil.html#ReadStrFromStream^^read string with requested length form stream. ^0"
+s[1688] = "synautil.WriteStrToStream^synautil.html#WriteStrToStream^^write string to stream. ^0"
+s[1689] = "synautil.GetTempFile^synautil.html#GetTempFile^^Return filename of new temporary file in Dir (if empty, then default temporary directory is used) and with optional filename prefix. ^0"
+s[1690] = "synautil.PadString^synautil.html#PadString^^Return padded string. If length is greater, string is truncated. If length is smaller, string is padded by Pad character. ^0"
+s[1691] = "synautil.XorString^synautil.html#XorString^^XOR each byte in the strings ^0"
+s[1692] = "synautil.NormalizeHeader^synautil.html#NormalizeHeader^^Read header from "Value" stringlist beginning at "Index" position. If header is Splitted into multiple lines, then this procedure de-split it into one line. ^0"
+s[1693] = "synautil.SearchForLineBreak^synautil.html#SearchForLineBreak^^Search for one of line terminators CR, LF or NUL. Return position of the line beginning and length of text. ^0"
+s[1694] = "synautil.SkipLineBreak^synautil.html#SkipLineBreak^^Skip both line terminators CR LF (if any). Move APtr position forward. ^0"
+s[1695] = "synautil.SkipNullLines^synautil.html#SkipNullLines^^Skip all blank lines in a buffer starting at APtr and move APtr position forward. ^0"
+s[1696] = "synautil.CopyLinesFromStreamUntilNullLine^synautil.html#CopyLinesFromStreamUntilNullLine^^Copy all lines from a buffer starting at APtr to ALines until empty line or end of the buffer is reached. Move APtr position forward). ^0"
+s[1697] = "synautil.CopyLinesFromStreamUntilBoundary^synautil.html#CopyLinesFromStreamUntilBoundary^^Copy all lines from a buffer starting at APtr to ALines until ABoundary or end of the buffer is reached. Move APtr position forward). ^0"
+s[1698] = "synautil.SearchForBoundary^synautil.html#SearchForBoundary^^Search ABoundary in a buffer starting at APtr. Return beginning of the ABoundary. Move APtr forward behind a trailing CRLF if any). ^0"
+s[1699] = "synautil.MatchBoundary^synautil.html#MatchBoundary^^Compare a text at position ABOL with ABoundary and return position behind the match (including a trailing CRLF if any). ^0"
+s[1700] = "synautil.MatchLastBoundary^synautil.html#MatchLastBoundary^^Compare a text at position ABOL with ABoundary + the last boundary suffix and return position behind the match (including a trailing CRLF if any). ^0"
+s[1701] = "synautil.BuildStringFromBuffer^synautil.html#BuildStringFromBuffer^^Copy data from a buffer starting at position APtr and delimited by AEtx position into ANSIString. ^0"
+s[1702] = "synautil.CustomMonthNames^synautil.html#CustomMonthNames^^can be used for your own months strings for GetMonthNumber ^0"
+s[1703] = "tlntsend^tlntsend.html^Telnet script client^
Used RFC: RFC-854 ^0"
+s[1704] = "tlntsend.TTelnetSend^tlntsend.TTelnetSend.html^Class with implementation of Telnet/SSH script client.^
Note: Are you missing properties for specify server address and port? Look to parent TSynaClient too! ^0"
+s[1705] = "tlntsend.TTelnetSend.Create^tlntsend.TTelnetSend.html#Create^^ ^0"
+s[1706] = "tlntsend.TTelnetSend.Destroy^tlntsend.TTelnetSend.html#Destroy^^ ^0"
+s[1707] = "tlntsend.TTelnetSend.Login^tlntsend.TTelnetSend.html#Login^^Connects to Telnet server. ^0"
+s[1708] = "tlntsend.TTelnetSend.SSHLogin^tlntsend.TTelnetSend.html#SSHLogin^^Connects to SSH2 server and login by Username and Password properties.
You must use some of SSL plugins with SSH support. For exammple CryptLib. ^0"
+s[1709] = "tlntsend.TTelnetSend.Logout^tlntsend.TTelnetSend.html#Logout^^Logout from telnet server. ^0"
+s[1710] = "tlntsend.TTelnetSend.Send^tlntsend.TTelnetSend.html#Send^^Send this data to telnet server. ^0"
+s[1711] = "tlntsend.TTelnetSend.WaitFor^tlntsend.TTelnetSend.html#WaitFor^^Reading data from telnet server until Value is readed. If it is not readed until timeout, result is False
. Otherwise result is True
. ^0"
+s[1712] = "tlntsend.TTelnetSend.RecvTerminated^tlntsend.TTelnetSend.html#RecvTerminated^^Read data terminated by terminator from telnet server. ^0"
+s[1713] = "tlntsend.TTelnetSend.RecvString^tlntsend.TTelnetSend.html#RecvString^^Read string from telnet server. ^0"
+s[1714] = "tlntsend.TTelnetSend.Sock^tlntsend.TTelnetSend.html#Sock^^Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc. ^0"
+s[1715] = "tlntsend.TTelnetSend.SessionLog^tlntsend.TTelnetSend.html#SessionLog^^all readed datas in this session (from connect) is stored in this large string. ^0"
+s[1716] = "tlntsend.TTelnetSend.TermType^tlntsend.TTelnetSend.html#TermType^^Terminal type indentification. By default is 'SYNAPSE'. ^0"
+s[1717] = "tlntsend.cTelnetProtocol^tlntsend.html#cTelnetProtocol^^ ^0"
+s[1718] = "tlntsend.cSSHProtocol^tlntsend.html#cSSHProtocol^^ ^0"
+s[1719] = "tlntsend.TLNT_EOR^tlntsend.html#TLNT_EOR^^ ^0"
+s[1720] = "tlntsend.TLNT_SE^tlntsend.html#TLNT_SE^^ ^0"
+s[1721] = "tlntsend.TLNT_NOP^tlntsend.html#TLNT_NOP^^ ^0"
+s[1722] = "tlntsend.TLNT_DATA_MARK^tlntsend.html#TLNT_DATA_MARK^^ ^0"
+s[1723] = "tlntsend.TLNT_BREAK^tlntsend.html#TLNT_BREAK^^ ^0"
+s[1724] = "tlntsend.TLNT_IP^tlntsend.html#TLNT_IP^^ ^0"
+s[1725] = "tlntsend.TLNT_AO^tlntsend.html#TLNT_AO^^ ^0"
+s[1726] = "tlntsend.TLNT_AYT^tlntsend.html#TLNT_AYT^^ ^0"
+s[1727] = "tlntsend.TLNT_EC^tlntsend.html#TLNT_EC^^ ^0"
+s[1728] = "tlntsend.TLNT_EL^tlntsend.html#TLNT_EL^^ ^0"
+s[1729] = "tlntsend.TLNT_GA^tlntsend.html#TLNT_GA^^ ^0"
+s[1730] = "tlntsend.TLNT_SB^tlntsend.html#TLNT_SB^^ ^0"
+s[1731] = "tlntsend.TLNT_WILL^tlntsend.html#TLNT_WILL^^ ^0"
+s[1732] = "tlntsend.TLNT_WONT^tlntsend.html#TLNT_WONT^^ ^0"
+s[1733] = "tlntsend.TLNT_DO^tlntsend.html#TLNT_DO^^ ^0"
+s[1734] = "tlntsend.TLNT_DONT^tlntsend.html#TLNT_DONT^^ ^0"
+s[1735] = "tlntsend.TLNT_IAC^tlntsend.html#TLNT_IAC^^ ^0"
+s[1736] = "tlntsend.TTelnetState^tlntsend.html#TTelnetState^State of telnet protocol^. Used internaly by TTelnetSend. tsDATA tsIAC tsIAC_SB tsIAC_WILL tsIAC_DO tsIAC_WONT tsIAC_DONT tsIAC_SBIAC tsIAC_SBDATA tsSBDATA_IAC ^0"
ADDED lib/synapse/docs/help/tip_form.js
Index: lib/synapse/docs/help/tip_form.js
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/tip_form.js
@@ -0,0 +1,19 @@
+// Tipue 1.63 (modified for pasdoc)
+
+
+// ---------- script properties ----------
+
+
+var results_location = "_tipue_results.html";
+
+
+// ---------- end of script properties ----------
+
+
+function search_form(tip_Form) {
+ if (tip_Form.d.value.length > 0) {
+ document.cookie = 'tid=' + escape(tip_Form.d.value) + '; path=/';
+ document.cookie = 'tin=0; path=/';
+ parent.content.location.href = results_location;
+ }
+}
ADDED lib/synapse/docs/help/tip_search.js
Index: lib/synapse/docs/help/tip_search.js
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/tip_search.js
@@ -0,0 +1,357 @@
+// Tipue 1.63 (modified for pasdoc)
+
+
+// ---------- script properties ----------
+
+
+var results_location = "_tipue_results.html";
+var return_results = 10;
+var include_num = 1;
+var bold_query = 0;
+var include_url = 0;
+
+
+// ---------- end of script properties ----------
+
+
+var cookies = document.cookie;
+var tp = cookies.indexOf('tid=');
+var pn = cookies.indexOf('tin=');
+
+var lnf = 'Your search did not match any documents.
Make sure all keywords are spelled correctly. Try different or more general keywords.';
+var lp = 'Previous ';
+var ln = 'Next ';
+
+if (tp != -1) {
+ var st = tp + 4;
+ var en = cookies.indexOf(';', st);
+ if (en == -1) {
+ en = cookies.length;
+ }
+ var dit = cookies.substring(st, en);
+ dit = unescape(dit);
+}
+if (pn != -1) {
+ var st = pn + 4;
+ var en = cookies.indexOf(';', st);
+ if (en == -1) {
+ en = cookies.length;
+ }
+ var tn = cookies.substring(st, en);
+}
+
+var od = dit;
+var nr = return_results;
+tn = parseInt(tn);
+var nb = tn + nr;
+var nc = 0;
+var nd = 0;
+var tr = new Array();
+var rt = new Array();
+var co = 0;
+var tm = 0;
+
+if (dit.charAt(0) == '"' && dit.charAt(dit.length - 1) == '"') {
+ tm = 1;
+}
+var rn = dit.search(/ or /i);
+if (rn >= 0) {
+ tm = 2;
+}
+rn = dit.search(/-/i);
+if (rn >= 0 && tm != 1) {
+ rn = dit.search(/ /i);
+ if (rn != 0) {
+ dit = dit.replace(/-/gi, ' -');
+ }
+}
+rn = dit.search(/ not /i);
+if (rn >= 0 && tm != 1) {
+ dit = dit.replace(/ not /gi, ' -');
+}
+rn = dit.search(/\+/i);
+if (rn >= 0) {
+ rn = dit.search(/ /i);
+ if (rn != 0) {
+ dit = dit.replace(/\+/gi, ' +');
+ }
+}
+
+if (tm == 0) {
+ var woin = new Array();
+ dit = dit.replace(/ and /gi, ' ');
+ var wt = dit.split(' ');
+ for (var a = 0; a < wt.length; a++) {
+ woin[a] = 0;
+ if (wt[a].charAt(0) == '-') {
+ woin[a] = 1;
+ }
+ }
+ for (var a = 0; a < wt.length; a++) {
+ wt[a] = wt[a].replace(/^\-|^\+/gi, '');
+ }
+ a = 0;
+ for (var c = 0; c < s.length; c++) {
+ var es = s[c].split('^');
+ var rk = 100;
+ if (es[5] == null) {
+ es[5] = '0';
+ }
+ if (parseInt(es[5]) > 10) {
+ es[5] = '10';
+ }
+ var pa = 0;
+ var nh = 0;
+ for (var i = 0; i < woin.length; i++) {
+ if (woin[i] == 0) {
+ nh++;
+ var nt = 0;
+ var pat = new RegExp(wt[i], 'i');
+ rn = es[0].search(pat);
+ if (rn >= 0) {
+ rk = rk - 11;
+ rk = rk - parseInt(es[5]);
+ nt = 1;
+ }
+ rn = es[2].search(pat);
+ if (rn >= 0) {
+ rk = rk - 11;
+ rk = rk - parseInt(es[5]);
+ nt = 1;
+ }
+ rn = es[3].search(pat);
+ if (rn >= 0) {
+ rk = rk - 11;
+ rk = rk - parseInt(es[5]);
+ nt = 1;
+ }
+ if (nt == 1) {
+ pa++;
+ }
+ }
+ if (woin[i] == 1) {
+ var pat = new RegExp(wt[i], 'i');
+ rn = es[0].search(pat);
+ if (rn >= 0) {
+ pa = 0;
+ }
+ rn = es[2].search(pat);
+ if (rn >= 0) {
+ pa = 0;
+ }
+ rn = es[3].search(pat);
+ if (rn >= 0) {
+ pa = 0;
+ }
+ }
+ }
+ if (pa == nh) {
+ tr[a] = rk + '^' + s[c];
+ a++;
+ }
+ }
+ tr.sort();
+ co = a;
+}
+
+if (tm == 1) {
+ dit = dit.replace(/"/gi, '');
+ var a = 0;
+ var pat = new RegExp(dit, 'i');
+ for (var c = 0; c < s.length; c++) {
+ var es = s[c].split('^');
+ var rk = 100;
+ if (es[5] == null) {
+ es[5] = '0';
+ }
+ if (parseInt(es[5]) > 10) {
+ es[5] = '10';
+ }
+ rn = es[0].search(pat);
+ if (rn >= 0) {
+ rk = rk - 11;
+ rk = rk - parseInt(es[5]);
+ }
+ rn = es[2].search(pat);
+ if (rn >= 0) {
+ rk = rk - 11;
+ rk = rk - parseInt(es[5]);
+ }
+ rn = es[3].search(pat);
+ if (rn >= 0) {
+ rk = rk - 11;
+ rk = rk - parseInt(es[5]);
+ }
+ if (rk < 100) {
+ tr[a] = rk + '^' + s[c];
+ a++;
+ }
+ }
+ tr.sort();
+ co = a;
+}
+
+if (tm == 2) {
+ dit = dit.replace(/ or /gi, ' ');
+ var wt = dit.split(' ');
+ var a = 0;
+ for (var i = 0; i < wt.length; i++) {
+ var pat = new RegExp(wt[i], 'i');
+ for (var c = 0; c < s.length; c++) {
+ var es = s[c].split('^');
+ var rk = 100;
+ if (es[5] == null) {
+ es[5] = '0';
+ }
+ if (parseInt(es[5]) > 10) {
+ es[5] = '10';
+ }
+ var pa = 0;
+ var rn = es[0].search(pat);
+ if (rn >= 0) {
+ rk = rk - 11;
+ rk = rk - parseInt(es[5]);
+ if (rn >= 0) {
+ for (var e = 0; e < rt.length; e++) {
+ if (s[c] == rt[e]) {
+ pa = 1;
+ }
+ }
+ }
+ }
+ rn = es[2].search(pat);
+ if (rn >= 0) {
+ rk = rk - 11;
+ rk = rk - parseInt(es[5]);
+ if (rn >= 0) {
+ for (var e = 0; e < rt.length; e++) {
+ if (s[c] == rt[e]) {
+ pa = 1;
+ }
+ }
+ }
+ }
+ var rn = es[3].search(pat);
+ if (rn >= 0) {
+ rk = rk - 11;
+ rk = rk - parseInt(es[5]);
+ if (rn >= 0) {
+ for (var e = 0; e < rt.length; e++) {
+ if (s[c] == rt[e]) {
+ pa = 1;
+ }
+ }
+ }
+ }
+ if (rk < 100 && pa == 0) {
+ rt[a] = s[c];
+ tr[a] = rk + '^' + s[c];
+ a++;
+ co++;
+ }
+ }
+ }
+ tr.sort();
+}
+
+function write_cookie(nw) {
+ document.cookie = 'tid=' + escape(od) + '; path=/';
+ document.cookie = 'tin=' + nw + '; path=/';
+}
+
+
+// ---------- External references ----------
+
+
+var tip_Num = co;
+
+function tip_query() {
+ if (od != 'undefined' && od != null) document.tip_Form.d.value = od;
+}
+
+function tip_num() {
+ document.write(co);
+}
+
+function tip_out() {
+ if (co == 0) {
+ document.write(lnf);
+ return;
+ }
+ if (tn + nr > co) {
+ nd = co;
+ } else {
+ nd = tn + nr;
+ }
+ for (var a = tn; a < nd; a++) {
+ var os = tr[a].split('^');
+ if (os[5] == null) {
+ os[5] = '0';
+ }
+ if (bold_query == 1 && tm == 0) {
+ for (var i = 0; i < wt.length; i++) {
+ var lw = wt[i].length;
+ var tw = new RegExp(wt[i], 'i');
+ rn = os[3].search(tw);
+ if (rn >= 0) {
+ var o1 = os[3].slice(0, rn);
+ var o2 = os[3].slice(rn, rn + lw);
+ var o3 = os[3].slice(rn + lw);
+ os[3] = o1 + '' + o2 + ' ' + o3;
+ }
+ }
+ }
+ if (bold_query == 1 && tm == 1) {
+ var lw = dit.length;
+ var tw = new RegExp(dit, 'i');
+ rn = os[3].search(tw);
+ if (rn >= 0) {
+ var o1 = os[3].slice(0, rn);
+ var o2 = os[3].slice(rn, rn + lw);
+ var o3 = os[3].slice(rn + lw);
+ os[3] = o1 + '' + o2 + ' ' + o3;
+ }
+ }
+ if (include_num == 1) {
+ document.write(a + 1, '. ');
+ }
+ if (os[5] == '0') {
+ document.write('', os[1], ' ');
+ }
+ if (os[5] == '1') {
+ document.write('', os[1], ' ');
+ }
+ if (os[5] != '0' && os[5] != '1') {
+ document.write('', os[1], ' ');
+ }
+ if (os[3].length > 1) {
+ document.write(' ', os[3]);
+ }
+ if (include_url == 1) {
+ if (os[5] == '0') {
+ document.write('', os[2], '
');
+ }
+ if (os[5] == '1') {
+ document.write('', os[2], '
');
+ }
+ if (os[5] != '0' && os[5] != '1') {
+ document.write('', os[2], '
');
+ }
+ } else {
+ document.write('
');
+ }
+ }
+ if (co > nr) {
+ nc = co - nb;
+ if (nc > nr) {
+ nc = nr;
+ }
+ document.write('
');
+ }
+ if (tn > 1) {
+ document.write('', lp, nr, ' ');
+ }
+ if (nc > 0) {
+ document.write('', ln, nc, ' ');
+ }
+}
ADDED lib/synapse/docs/help/tipue_b1.png
Index: lib/synapse/docs/help/tipue_b1.png
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/tipue_b1.png
cannot compute difference between binary files
ADDED lib/synapse/docs/help/tlntsend.TTelnetSend.html
Index: lib/synapse/docs/help/tlntsend.TTelnetSend.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/tlntsend.TTelnetSend.html
@@ -0,0 +1,184 @@
+
+
+
+
+
+tlntsend: Class TTelnetSend
+
+
+
+Class TTelnetSend
+
+Unit
+
+tlntsend
+Declaration
+
+type TTelnetSend = class(TSynaClient )
+Description
+
+Class with implementation of Telnet/SSH script client.
+
+
+
+
Note: Are you missing properties for specify server address and port? Look to parent TSynaClient too!
+Hierarchy
+Overview
+Methods
+
+
+
+constructor Create ;
+
+
+
+destructor Destroy ; override;
+
+
+
+function Login : Boolean;
+
+
+
+function SSHLogin : Boolean;
+
+
+
+procedure Logout ;
+
+
+
+procedure Send (const Value: string);
+
+
+
+function WaitFor (const Value: string): Boolean;
+
+
+
+function RecvTerminated (const Terminator: string): string;
+
+
+
+function RecvString : string;
+
+
+Properties
+
+
+
+property Sock : TTCPBlockSocket read FSock;
+
+
+
+property SessionLog : Ansistring read FSessionLog write FSessionLog;
+
+
+
+property TermType : Ansistring read FTermType write FTermType;
+
+
+Description
+Methods
+
+
+
+constructor Create ;
+
+
+
+
+
+destructor Destroy ; override;
+
+
+
+
+
+function Login : Boolean;
+
+
+
+Connects to Telnet server.
+
+
+
+function SSHLogin : Boolean;
+
+
+
+Connects to SSH2 server and login by Username and Password properties.
+
+
You must use some of SSL plugins with SSH support. For exammple CryptLib.
+
+
+
+procedure Logout ;
+
+
+
+Logout from telnet server.
+
+
+
+procedure Send (const Value: string);
+
+
+
+Send this data to telnet server.
+
+
+
+function WaitFor (const Value: string): Boolean;
+
+
+
+Reading data from telnet server until Value is readed. If it is not readed until timeout, result is False
. Otherwise result is True
.
+
+
+
+function RecvTerminated (const Terminator: string): string;
+
+
+
+Read data terminated by terminator from telnet server.
+
+
+
+function RecvString : string;
+
+
+
+Read string from telnet server.
+Properties
+
+
+Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.
+
+
+
+property SessionLog : Ansistring read FSessionLog write FSessionLog;
+
+
+
+all readed datas in this session (from connect) is stored in this large string.
+
+
+
+property TermType : Ansistring read FTermType write FTermType;
+
+
+
+Terminal type indentification. By default is 'SYNAPSE'.
+Generated by PasDoc 0.9.0 on 2012-04-23 21:38:52
+
+
ADDED lib/synapse/docs/help/tlntsend.html
Index: lib/synapse/docs/help/tlntsend.html
==================================================================
--- /dev/null
+++ lib/synapse/docs/help/tlntsend.html
@@ -0,0 +1,231 @@
+
+
+
+
+
+tlntsend
+
+
+
+Unit tlntsend
+
+Description
+
+Telnet script client
+
+
+
+
Used RFC: RFC-854
+uses
+Overview
+Classes, Interfaces, Objects and Records
+
+
+
+Class TTelnetSend
+Class with implementation of Telnet/SSH script client.
+
+
+Types
+
+Constants
+
+Description
+Types
+
+
+TTelnetState = (...);
+
+
+
+State of telnet protocol
+
+. Used internaly by TTelnetSend.
+
+
+tsDATA:
+
+tsIAC:
+
+tsIAC_SB:
+
+tsIAC_WILL:
+
+tsIAC_DO:
+
+tsIAC_WONT:
+
+tsIAC_DONT:
+
+tsIAC_SBIAC:
+
+tsIAC_SBDATA:
+
+tsSBDATA_IAC:
+
+Constants
+
+
+cTelnetProtocol = '23';
+
+
+
+
+cSSHProtocol = '22';
+
+
+
+
+
+
+
+TLNT_DATA_MARK = #242;
+
+
+
+
+TLNT_BREAK = #243;
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Generated by PasDoc 0.9.0 on 2012-04-23 21:38:52
+
+
ADDED lib/synapse/docs/svn2html.css
Index: lib/synapse/docs/svn2html.css
==================================================================
--- /dev/null
+++ lib/synapse/docs/svn2html.css
@@ -0,0 +1,79 @@
+body {
+ background-color: white;
+ color: black;
+ margin-left: 1.5em;
+ margin-right: 1.5em;
+ margin-top: 1.5em;
+ margin-bottom: 1em;
+}
+
+ul.changelog_entries {
+ margin-left: 0.7em;
+ margin-right: 0.7em;
+ padding-left: 0.7em;
+ padding-right: 0.7em;
+ padding-bottom: 0.7em;
+ background: #fefefe;
+ border: 1px dashed #88aa88;
+}
+
+li.changelog_entry {
+ list-style-type: none;
+ margin-left: 0px;
+ padding-left: 0px;
+ margin-top: 0.8em;
+ border-top: 1px solid #dddddd;
+ background: #f8f8f8;
+}
+
+li.changelog_change {
+ list-style-type: circle;
+ margin-left: 4em;
+}
+
+span.changelog_date {
+ color: black;
+}
+
+span.changelog_author {
+ color: #111188;
+}
+
+.changelog_revision {
+ font-size: 80%;
+ color: #881111;
+ background: #fff4f4;
+}
+
+.changelog_revision a {
+ color: inherit;
+}
+
+.changelog_files {
+ font-size: 80%;
+ font-family: monospace;
+ color: #116611;
+}
+
+.changelog_files:after {
+ content: ':';
+}
+
+.changelog_message {
+ display: block;
+ color: #220000;
+}
+
+p.changelog_footer {
+ margin-top: 1.5em;
+ margin-left: 0.7em;
+ font-style: italic;
+ line-height: 90%;
+ color: gray;
+ font-family: Helvetica, Arial, sans-serif;
+}
+
+p.changelog_footer a {
+ text-decoration: none;
+ color: inherit;
+}
ADDED lib/synapse/licence.txt
Index: lib/synapse/licence.txt
==================================================================
--- /dev/null
+++ lib/synapse/licence.txt
@@ -0,0 +1,28 @@
+Copyright (c)1999-2002, Lukas Gebauer
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+Redistributions of source code must retain the above copyright notice, this
+list of conditions and the following disclaimer.
+
+Redistributions in binary form must reproduce the above copyright notice,
+this list of conditions and the following disclaimer in the documentation
+and/or other materials provided with the distribution.
+
+Neither the name of Lukas Gebauer nor the names of its contributors may
+be used to endorse or promote products derived from this software without
+specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR
+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
+DAMAGE.
ADDED lib/synapse/source/demo/FreePascal/testdns.pas
Index: lib/synapse/source/demo/FreePascal/testdns.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/FreePascal/testdns.pas
@@ -0,0 +1,28 @@
+{$MODE DELPHI}
+
+Program testdns;
+
+uses
+ dnssend, synamisc, classes;
+
+var
+ l: tstringlist;
+ s: string;
+begin
+ l := TStringList.create;
+ try
+ s := GetDNS;
+ writeln('DNS servers: ', s);
+ l.commatext := s;
+ if l.count > 0 then
+ begin
+ s := l[0];
+ GetMailServers(s, paramstr(1), l);
+ Writeln('MX records for domain ', paramstr(1), ':');
+ writeln(l.text);
+ end;
+ finally
+ l.free;
+ end;
+end.
+
ADDED lib/synapse/source/demo/FreePascal/testhttp.pas
Index: lib/synapse/source/demo/FreePascal/testhttp.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/FreePascal/testhttp.pas
@@ -0,0 +1,34 @@
+{$MODE DELPHI}
+
+Program testhttp;
+
+uses
+ httpsend, classes;
+
+var
+ HTTP: THTTPSend;
+ l: tstringlist;
+begin
+ HTTP := THTTPSend.Create;
+ l := TStringList.create;
+ try
+ if not HTTP.HTTPMethod('GET', Paramstr(1)) then
+ begin
+ writeln('ERROR');
+ writeln(Http.Resultcode);
+ end
+ else
+ begin
+ writeln(Http.Resultcode, ' ', Http.Resultstring);
+ writeln;
+ writeln(Http.headers.text);
+ writeln;
+ l.loadfromstream(Http.Document);
+ writeln(l.text);
+ end;
+ finally
+ HTTP.Free;
+ l.free;
+ end;
+end.
+
ADDED lib/synapse/source/demo/FreePascal/testmime.pas
Index: lib/synapse/source/demo/FreePascal/testmime.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/FreePascal/testmime.pas
@@ -0,0 +1,38 @@
+{$MODE DELPHI}
+
+Program testmime;
+
+uses
+ mimepart, classes;
+
+type
+ Tc = class(TObject)
+ public
+ class procedure ph(const Sender: TMimePart);
+ end;
+
+class procedure Tc.ph(const Sender: TMimePart);
+begin
+ Sender.DecodePart;
+ Sender.EncodePart;
+end;
+
+var
+ l: tstringlist;
+ m:tmimepart;
+begin
+ l := TStringList.create;
+ m := tmimepart.create;
+ try
+ m.OnWalkPart:=tc.ph;
+ m.Lines.LoadFromFile(paramstr(1));
+ m.DecomposeParts;
+ m.WalkPart;
+ m.ComposeParts;
+ m.Lines.SaveToFile(paramstr(1) + '.repack');
+ finally
+ m.free;
+ l.free;
+ end;
+end.
+
ADDED lib/synapse/source/demo/FreePascal/testping.pas
Index: lib/synapse/source/demo/FreePascal/testping.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/FreePascal/testping.pas
@@ -0,0 +1,19 @@
+{$MODE DELPHI}
+
+Program testping;
+
+uses
+ pingsend, sysutils;
+
+var
+ ping:TPingSend;
+begin
+ ping:=TPingSend.Create;
+ try
+ ping.ping(ParamStr(1));
+ Writeln (IntTostr(ping.pingtime));
+ finally
+ ping.Free;
+ end;
+end.
+
ADDED lib/synapse/source/demo/FreePascal/testroute.pas
Index: lib/synapse/source/demo/FreePascal/testroute.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/FreePascal/testroute.pas
@@ -0,0 +1,11 @@
+{$MODE DELPHI}
+
+Program testroute;
+
+uses
+ pingsend;
+
+begin
+ Writeln (TracerouteHost(paramstr(1)));
+end.
+
ADDED lib/synapse/source/demo/FreePascal/testssl.pas
Index: lib/synapse/source/demo/FreePascal/testssl.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/FreePascal/testssl.pas
@@ -0,0 +1,36 @@
+{$MODE DELPHI}
+
+Program testssl;
+
+uses
+ blcksock, synassl;
+
+var
+ sock: TTCPBlockSocket;
+begin
+ sock := TTCPBlockSocket.create;
+ try
+ sock.SSLEnabled:=True;
+ writeln('Used OpenSSL library:');
+ writeln(SSLLibFile);
+ writeln(SSLUtilFile);
+ sock.Connect(paramstr(1),paramstr(2));
+ if sock.lasterror <> 0 then
+ begin
+ writeln('Error connecting!');
+ exit;
+ end;
+ writeln;
+ writeln('SSL version: ', sock.SSLGetSSLVersion);
+ writeln('Cipher: ', sock.SSLGetCiphername);
+ writeln('Cipher bits: ', sock.SSLGetCipherBits);
+ writeln('Cipher alg. bits: ', sock.SSLGetCipherAlgBits);
+ writeln('Certificate verify result: ', sock.SslGetVerifyCert);
+ writeln('Certificate peer name: ', sock.SSLGetPeerName);
+ writeln(sock.SSLGetCertInfo);
+ sock.closesocket;
+ finally
+ sock.free;
+ end;
+end.
+
ADDED lib/synapse/source/demo/MailCheck/MailCheck.dof
Index: lib/synapse/source/demo/MailCheck/MailCheck.dof
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/MailCheck/MailCheck.dof
@@ -0,0 +1,75 @@
+[Compiler]
+A=1
+B=0
+C=1
+D=1
+E=0
+F=0
+G=1
+H=1
+I=1
+J=1
+K=0
+L=1
+M=0
+N=1
+O=1
+P=1
+Q=0
+R=0
+S=0
+T=0
+U=0
+V=1
+W=0
+X=1
+Y=0
+Z=1
+ShowHints=1
+ShowWarnings=1
+UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
+[Linker]
+MapFile=0
+OutputObjs=0
+ConsoleApp=1
+DebugInfo=0
+MinStackSize=16384
+MaxStackSize=1048576
+ImageBase=4194304
+ExeDescription=
+[Directories]
+OutputDir=
+UnitOutputDir=
+SearchPath=
+Packages=vclx30;VCL30;vcldb30;vcldbx30;inetdb30;inet30;VclSmp30;Qrpt30;teeui30;teedb30;tee30;dss30;IBEVNT30
+Conditionals=
+DebugSourceDirs=
+UsePackages=0
+[Parameters]
+RunParams=
+HostApplication=
+[Version Info]
+IncludeVerInfo=0
+AutoIncBuild=0
+MajorVer=1
+MinorVer=0
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=0
+Locale=1029
+CodePage=1250
+[Version Info Keys]
+CompanyName=
+FileDescription=
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
ADDED lib/synapse/source/demo/MailCheck/MailCheck.dpr
Index: lib/synapse/source/demo/MailCheck/MailCheck.dpr
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/MailCheck/MailCheck.dpr
@@ -0,0 +1,14 @@
+program MailCheck;
+
+uses
+ Forms,
+ Unit1 in 'Unit1.pas' {Form1},
+ mailchck in 'mailchck.pas';
+
+{$R *.RES}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TForm1, Form1);
+ Application.Run;
+end.
ADDED lib/synapse/source/demo/MailCheck/MailCheck.res
Index: lib/synapse/source/demo/MailCheck/MailCheck.res
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/MailCheck/MailCheck.res
cannot compute difference between binary files
ADDED lib/synapse/source/demo/MailCheck/Unit1.dfm
Index: lib/synapse/source/demo/MailCheck/Unit1.dfm
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/MailCheck/Unit1.dfm
cannot compute difference between binary files
ADDED lib/synapse/source/demo/MailCheck/Unit1.pas
Index: lib/synapse/source/demo/MailCheck/Unit1.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/MailCheck/Unit1.pas
@@ -0,0 +1,36 @@
+unit Unit1;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+ StdCtrls, mailchck;
+
+type
+ TForm1 = class(TForm)
+ Label1: TLabel;
+ Edit1: TEdit;
+ Label2: TLabel;
+ Button1: TButton;
+ procedure Button1Click(Sender: TObject);
+ private
+ { Private declarations }
+ public
+ { Public declarations }
+ end;
+
+var
+ Form1: TForm1;
+
+implementation
+
+{$R *.DFM}
+
+procedure TForm1.Button1Click(Sender: TObject);
+begin
+ label2.caption := 'testing...';
+ form1.Repaint;
+ Label2.caption := IntToStr(mailcheck(Edit1.text));
+end;
+
+end.
ADDED lib/synapse/source/demo/MailCheck/mailchck.pas
Index: lib/synapse/source/demo/MailCheck/mailchck.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/MailCheck/mailchck.pas
@@ -0,0 +1,107 @@
+unit mailchck;
+
+interface
+
+uses
+ dnssend, smtpsend, synautil, classes, synamisc;
+
+function mailcheck(email:string):integer;
+
+implementation
+
+{
+0 - address exists
+1 - address may exists
+2 - your DNS nannot working (cannot check!)
+3 - your DNS is not defined (cannot check!)
+4 - cannot contact any MX servers (cannot check!);
+5 - domain not have MX record
+6 - address not exists
+7 - address is bad!
+}
+
+function mailcheck(email:string):integer;
+var
+ smtp:TSMTPsend;
+ domain:string;
+ user: string;
+ mailservers:tstringlist;
+ dnsservers:tstringlist;
+ x: integer;
+ n, m: integer;
+ b: boolean;
+begin
+ result:=7;
+ email:=getemailaddr(email);
+ x := pos('@', email);
+ if x <= 0 then
+ exit; //invalid address format
+ domain:=separateright(email,'@');
+ user:=separateLeft(email,'@');
+ if (domain = '') or (user = '') then
+ exit; //invalid address format
+ smtp:=tsmtpsend.create;
+ mailservers:=tstringlist.create;
+ dnsservers:=tstringlist.create;
+ try
+ dnsservers.CommaText := GetDNS;
+ result := 3;
+ if dnsservers.Count = 0 then
+ Exit; // not DNS servers defined
+ result := 2;
+ b := false;
+ for n := 0 to dnsservers.Count -1 do
+ if GetMailServers(dnsservers[n], domain, mailservers) then
+ begin
+ b := true;
+ break;
+ end;
+ if not b then
+ Exit; // DNS cannot be contacted
+ result := 5;
+ if mailservers.Count = 0 then
+ exit; // not defined MX record for requested domain
+ b := false;
+ for n := 0 to mailservers.count - 1 do
+ begin
+ smtp.TargetHost := mailservers[n];
+ if not smtp.Login then
+ Continue;
+ b := true;
+ if smtp.Verify(email) then
+ begin
+ if smtp.ResultCode < 252 then
+ begin
+ Result := 0; // user address confirmed!
+ break;
+ end;
+ end
+ else
+ if smtp.ResultCode = 551 then
+ begin
+ Result := 6; // user address not confirmed!
+ break;
+ end;
+ if not smtp.MailFrom('mailcheck@somewhere.com', 100) then
+ Continue;
+ if not smtp.MailTo(email) then
+ begin
+ Result := 6; // user address not confirmed!
+ break;
+ end
+ else
+ begin
+ Result := 1; // address MAY exists
+ break;
+ end;
+ end;
+ if not b then
+ result := 4; //cannot contact any mailserver;
+ finally
+ dnsservers.free;
+ mailservers.free;
+ smtp.free;
+ end;
+end;
+
+end.
ADDED lib/synapse/source/demo/TFTPClient/MainBox.dfm
Index: lib/synapse/source/demo/TFTPClient/MainBox.dfm
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/TFTPClient/MainBox.dfm
@@ -0,0 +1,130 @@
+object Form1: TForm1
+ Left = 535
+ Top = 430
+ Width = 314
+ Height = 251
+ Caption = 'Simple TFTP-Client'
+ Color = clBtnFace
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'MS Sans Serif'
+ Font.Style = []
+ OldCreateOrder = False
+ Position = poScreenCenter
+ DesignSize = (
+ 306
+ 224)
+ PixelsPerInch = 96
+ TextHeight = 13
+ object Label2: TLabel
+ Left = 8
+ Top = 146
+ Width = 65
+ Height = 13
+ Anchors = [akLeft, akBottom]
+ Caption = 'TargetSystem'
+ end
+ object Label3: TLabel
+ Left = 199
+ Top = 146
+ Width = 50
+ Height = 13
+ Anchors = [akRight, akBottom]
+ Caption = 'TargetPort'
+ end
+ object Label4: TLabel
+ Left = 8
+ Top = 170
+ Width = 76
+ Height = 13
+ Anchors = [akLeft, akBottom]
+ Caption = 'FileName to Get'
+ end
+ object Log: TMemo
+ Left = 8
+ Top = 8
+ Width = 289
+ Height = 129
+ Anchors = [akLeft, akTop, akRight, akBottom]
+ ScrollBars = ssVertical
+ TabOrder = 0
+ end
+ object BExit: TButton
+ Left = 222
+ Top = 194
+ Width = 55
+ Height = 23
+ Anchors = [akBottom]
+ Caption = 'E&xit'
+ TabOrder = 1
+ OnClick = BExitClick
+ end
+ object BAbout: TButton
+ Left = 27
+ Top = 194
+ Width = 55
+ Height = 23
+ Anchors = [akBottom]
+ Caption = '&About'
+ TabOrder = 2
+ OnClick = BAboutClick
+ end
+ object TargetSystemEdit: TEdit
+ Left = 88
+ Top = 143
+ Width = 104
+ Height = 21
+ Anchors = [akLeft, akRight, akBottom]
+ TabOrder = 3
+ Text = '127.0.0.1'
+ end
+ object TargetPortEdit: TEdit
+ Left = 255
+ Top = 143
+ Width = 41
+ Height = 21
+ Anchors = [akRight, akBottom]
+ TabOrder = 4
+ Text = '69'
+ end
+ object TargetFileEdit: TEdit
+ Left = 88
+ Top = 167
+ Width = 208
+ Height = 21
+ Anchors = [akLeft, akRight, akBottom]
+ TabOrder = 5
+ end
+ object BGetFile: TButton
+ Left = 94
+ Top = 194
+ Width = 55
+ Height = 23
+ Anchors = [akBottom]
+ Caption = '&Get File'
+ TabOrder = 6
+ OnClick = BGetFileClick
+ end
+ object BPutFile: TButton
+ Left = 158
+ Top = 194
+ Width = 55
+ Height = 23
+ Anchors = [akBottom]
+ Caption = '&Put File'
+ TabOrder = 7
+ OnClick = BPutFileClick
+ end
+ object OpenDialog: TOpenDialog
+ FilterIndex = 0
+ Title = 'Select File to put ...'
+ Left = 16
+ Top = 16
+ end
+ object SaveDialog: TSaveDialog
+ Title = 'Save File ...'
+ Left = 48
+ Top = 16
+ end
+end
ADDED lib/synapse/source/demo/TFTPClient/MainBox.pas
Index: lib/synapse/source/demo/TFTPClient/MainBox.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/TFTPClient/MainBox.pas
@@ -0,0 +1,124 @@
+unit MainBox;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+ Dialogs, StdCtrls, FTPTSend;
+
+type
+ TForm1 = class(TForm)
+ Log: TMemo;
+ BExit: TButton;
+ BAbout: TButton;
+ Label2: TLabel;
+ Label3: TLabel;
+ Label4: TLabel;
+ TargetSystemEdit: TEdit;
+ TargetPortEdit: TEdit;
+ TargetFileEdit: TEdit;
+ BGetFile: TButton;
+ BPutFile: TButton;
+ OpenDialog: TOpenDialog;
+ SaveDialog: TSaveDialog;
+ procedure BAboutClick(Sender: TObject);
+ procedure BExitClick(Sender: TObject);
+ procedure BPutFileClick(Sender: TObject);
+ procedure BGetFileClick(Sender: TObject);
+ private
+ { Private-Deklarationen }
+ TFTPClient:TTFTPSend;
+ public
+ { Public-Deklarationen }
+ end;
+
+var
+ Form1: TForm1;
+
+implementation
+
+{$R *.dfm}
+
+procedure TForm1.BAboutClick(Sender: TObject);
+begin
+ // Show a little About-Box
+ Application.MessageBox('Synapse Demo Application, (c) 2003 by Christian Brosius','About...',MB_OK);
+end;
+
+procedure TForm1.BExitClick(Sender: TObject);
+begin
+ // Close the TFTP-Client
+ Close;
+end;
+
+procedure TForm1.BPutFileClick(Sender: TObject);
+begin
+ if OpenDialog.Execute
+ then
+ begin
+ // Create TFTPClient
+ TFTPClient := TTFTPSend.Create;
+ Log.Lines.Add('TFTPClient created');
+
+ // Set Target-Parameter
+ TFTPClient.TargetHost := TargetSystemEdit.Text;
+ Log.Lines.Add('TargetSystem is ' + TFTPClient.TargetHost);
+ TFTPClient.TargetPort := TargetPortEdit.Text;
+ Log.Lines.Add('TargetPort is ' + TFTPClient.TargetPort);
+
+ // Try sending file
+ Log.Lines.Add('Try to send ' + OpenDialog.FileName);
+ TFTPClient.Data.LoadFromFile(OpenDialog.FileName);
+ if TFTPClient.SendFile(ExtractFileName(OpenDialog.FileName))
+ then
+ begin
+ // Filetransfer successful
+ Log.Lines.Add('File successfully sent to TFTPServer');
+ end
+ else
+ begin
+ // Filetransfer not successful
+ Log.Lines.Add('Error while sending File to TFTPServer');
+ Log.Lines.Add('Error #' + IntToStr(TFTPClient.ErrorCode) + ' - ' + TFTPClient.ErrorString);
+ end;
+ // Free TFTPClient
+ TFTPClient.Free;
+ Log.Lines.Add('TFTPClient destroyed');
+ end;
+end;
+
+procedure TForm1.BGetFileClick(Sender: TObject);
+begin
+ // Create TFTPClient
+ TFTPClient := TTFTPSend.Create;
+ Log.Lines.Add('TFTPClient created');
+
+ // Set Target-Parameter
+ TFTPClient.TargetHost := TargetSystemEdit.Text;
+ Log.Lines.Add('TargetSystem is ' + TFTPClient.TargetHost);
+ TFTPClient.TargetPort := TargetPortEdit.Text;
+ Log.Lines.Add('TargetPort is ' + TFTPClient.TargetPort);
+
+ // Try sending file
+ Log.Lines.Add('Try to get "' + TargetFileEdit.Text + '"');
+ if TFTPClient.RecvFile(TargetFileEdit.Text)
+ then
+ begin
+ // Filetransfer successful
+ Log.Lines.Add('File successfully get from TFTPServer');
+ SaveDialog.FileName := TargetFileEdit.Text;
+ if SaveDialog.Execute
+ then TFTPClient.Data.SaveToFile(SaveDialog.FileName);
+ end
+ else
+ begin
+ // Filetransfer not successful
+ Log.Lines.Add('Error while getting File from TFTPServer');
+ Log.Lines.Add(IntToStr(TFTPClient.ErrorCode) + ' - ' + TFTPClient.ErrorString);
+ end;
+ // Free TFTPClient
+ TFTPClient.Free;
+ Log.Lines.Add('TFTPClient destroyed');
+end;
+
+end.
ADDED lib/synapse/source/demo/TFTPClient/TFTPClient.dpr
Index: lib/synapse/source/demo/TFTPClient/TFTPClient.dpr
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/TFTPClient/TFTPClient.dpr
@@ -0,0 +1,13 @@
+program TFTPClient;
+
+uses
+ Forms,
+ MainBox in 'MainBox.pas' {Form1};
+
+{$R *.res}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TForm1, Form1);
+ Application.Run;
+end.
ADDED lib/synapse/source/demo/TFTPClient/TFTPClient.res
Index: lib/synapse/source/demo/TFTPClient/TFTPClient.res
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/TFTPClient/TFTPClient.res
cannot compute difference between binary files
ADDED lib/synapse/source/demo/TFTPServer/MainBox.dfm
Index: lib/synapse/source/demo/TFTPServer/MainBox.dfm
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/TFTPServer/MainBox.dfm
@@ -0,0 +1,67 @@
+object MainForm: TMainForm
+ Left = 276
+ Top = 417
+ Width = 503
+ Height = 270
+ Caption = 'Simple TFTP-Server'
+ Color = clBtnFace
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -14
+ Font.Name = 'MS Sans Serif'
+ Font.Style = []
+ OldCreateOrder = False
+ Position = poScreenCenter
+ OnCreate = FormCreate
+ DesignSize = (
+ 495
+ 238)
+ PixelsPerInch = 120
+ TextHeight = 16
+ object Label1: TLabel
+ Left = 10
+ Top = 199
+ Width = 30
+ Height = 16
+ Anchors = [akLeft, akBottom]
+ Caption = 'Path:'
+ end
+ object Log: TMemo
+ Left = 8
+ Top = 0
+ Width = 481
+ Height = 186
+ Anchors = [akLeft, akTop, akRight, akBottom]
+ ScrollBars = ssVertical
+ TabOrder = 0
+ end
+ object BExit: TButton
+ Left = 483
+ Top = 261
+ Width = 86
+ Height = 31
+ Anchors = [akBottom]
+ Caption = 'E&xit'
+ TabOrder = 1
+ OnClick = BExitClick
+ end
+ object BAbout: TButton
+ Left = 37
+ Top = 261
+ Width = 86
+ Height = 31
+ Anchors = [akBottom]
+ Caption = '&About'
+ TabOrder = 2
+ OnClick = BAboutClick
+ end
+ object PathEdit: TEdit
+ Left = 72
+ Top = 196
+ Width = 413
+ Height = 21
+ Anchors = [akLeft, akRight, akBottom]
+ TabOrder = 3
+ Text = 'C:\'
+ end
+end
ADDED lib/synapse/source/demo/TFTPServer/MainBox.pas
Index: lib/synapse/source/demo/TFTPServer/MainBox.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/TFTPServer/MainBox.pas
@@ -0,0 +1,50 @@
+unit MainBox;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+ Dialogs, StdCtrls, TFTPDaemonThread;
+
+type
+ TMainForm = class(TForm)
+ Log: TMemo;
+ BExit: TButton;
+ BAbout: TButton;
+ Label1: TLabel;
+ PathEdit: TEdit;
+ procedure BExitClick(Sender: TObject);
+ procedure BAboutClick(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ private
+ { Private-Deklarationen }
+ TFTPD:TTFTPDaemonThread;
+ public
+ { Public-Deklarationen }
+ end;
+
+var
+ MainForm: TMainForm;
+
+implementation
+
+{$R *.dfm}
+
+procedure TMainForm.BAboutClick(Sender: TObject);
+begin
+ // Show a little About-Box
+ Application.MessageBox('Synapse Demo Application, (c) 2003 by Christian Brosius','About...',MB_OK);
+end;
+
+procedure TMainForm.BExitClick(Sender: TObject);
+begin
+ // Close the TFTP-Server
+ Close;
+end;
+
+procedure TMainForm.FormCreate(Sender: TObject);
+begin
+ TFTPD := TTFTPDaemonThread.Create('0.0.0.0','69');
+end;
+
+end.
ADDED lib/synapse/source/demo/TFTPServer/TFTPDaemonThread.pas
Index: lib/synapse/source/demo/TFTPServer/TFTPDaemonThread.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/TFTPServer/TFTPDaemonThread.pas
@@ -0,0 +1,129 @@
+{
+ TFTP supports five types of packets, all of which have been mentioned
+ above:
+ opcode operation
+
+ 1 Read request (RRQ)
+ 2 Write request (WRQ)
+ 3 Data (DATA)
+ 4 Acknowledgment (ACK)
+ 5 Error (ERROR)
+
+
+ Error Codes
+ Value Meaning
+
+ 0 Not defined, see error message (if any).
+ 1 File not found.
+ 2 Access violation.
+ 3 Disk full or allocation exceeded.
+ 4 Illegal TFTP operation.
+ 5 Unknown transfer ID.
+ 6 File already exists.
+ 7 No such user.
+
+
+}
+
+unit TFTPDaemonThread;
+
+interface
+
+uses Classes, SysUtils, FTPTSend;
+
+type
+ TTFTPDaemonThread = class(TThread)
+ private
+ { Private declarations }
+ TFTPDaemon:TTFTPSend;
+ FIPAdress:String;
+ FPort:String;
+ FLogMessage:String;
+ procedure UpdateLog;
+ protected
+ procedure Execute; override;
+ public
+ constructor Create(IPAdress,Port:String);
+ end;
+
+implementation
+
+uses MainBox;
+
+constructor TTFTPDaemonThread.Create(IPAdress,Port:String);
+begin
+ FIPAdress := IPAdress;
+ FPort := Port;
+ inherited Create(False);
+end;
+
+procedure TTFTPDaemonThread.UpdateLOG;
+begin
+ MainForm.Log.Lines.Add(FLogMessage);
+end;
+
+procedure TTFTPDaemonThread.Execute;
+var RequestType:Word;
+ FileName:String;
+begin
+ TFTPDaemon := TTFTPSend.Create;
+ FLogMessage := 'ServerThread created on Port ' + FPort;
+ Synchronize(UpdateLog);
+ TFTPDaemon.TargetHost := FIPAdress;
+ TFTPDaemon.TargetPort := FPort;
+ try
+ while not terminated do
+ begin
+ if TFTPDaemon.WaitForRequest(RequestType,FileName)
+ then
+ begin
+ // Fill the Log-Memo whith Infos about the request
+ case RequestType of
+ 1:FLogMessage := 'Read-Request from '
+ + TFTPDaemon.RequestIP + ':' + TFTPDaemon.RequestPort;
+ 2:FLogMessage := 'Write-Request from '
+ + TFTPDaemon.RequestIP + ':' + TFTPDaemon.RequestPort;
+ end;
+ Synchronize(UpdateLog);
+ FLogMessage := 'File: ' + Filename;
+ Synchronize(UpdateLog);
+
+ // Process the Request
+ case RequestType of
+ 1:begin // Read request (RRQ)
+ if FileExists(MainForm.PathEdit.Text + FileName)
+ then
+ begin
+ TFTPDaemon.Data.LoadFromFile(MainForm.PathEdit.Text + FileName);
+ if TFTPDaemon.ReplySend
+ then
+ begin
+ FLogMessage := '"' + MainForm.PathEdit.Text + FileName + '" successfully sent.';
+ Synchronize(UpdateLog);
+ end;
+ end
+ else TFTPDaemon.ReplyError(1,'File not Found');
+ end;
+ 2:begin // Write request (WRQ)
+ if not FileExists(MainForm.PathEdit.Text + FileName)
+ then
+ begin
+ if TFTPDaemon.ReplyRecv
+ then
+ begin
+ TFTPDaemon.Data.SaveToFile(MainForm.PathEdit.Text + FileName);
+ FLogMessage := 'File sucessfully stored to ' + MainForm.PathEdit.Text + FileName;
+ Synchronize(UpdateLog);
+ end;
+ end
+ else TFTPDaemon.ReplyError(6,'File already exists');
+ end;
+ end;
+ end;
+ end;
+ finally
+ TFTPDaemon.Free;
+ end;
+end;
+
+end.
ADDED lib/synapse/source/demo/TFTPServer/TFTPServer.dpr
Index: lib/synapse/source/demo/TFTPServer/TFTPServer.dpr
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/TFTPServer/TFTPServer.dpr
@@ -0,0 +1,14 @@
+program TFTPServer;
+
+uses
+ Forms,
+ MainBox in 'MainBox.pas' {MainForm},
+ TFTPDaemonThread in 'TFTPDaemonThread.pas';
+
+{$R *.res}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TMainForm, MainForm);
+ Application.Run;
+end.
ADDED lib/synapse/source/demo/TFTPServer/TFTPServer.res
Index: lib/synapse/source/demo/TFTPServer/TFTPServer.res
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/TFTPServer/TFTPServer.res
cannot compute difference between binary files
ADDED lib/synapse/source/demo/echo/EchoSrv.dof
Index: lib/synapse/source/demo/echo/EchoSrv.dof
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/echo/EchoSrv.dof
@@ -0,0 +1,80 @@
+[Compiler]
+A=1
+B=0
+C=1
+D=1
+E=0
+F=0
+G=1
+H=1
+I=1
+J=1
+K=0
+L=1
+M=0
+N=1
+O=1
+P=1
+Q=0
+R=0
+S=0
+T=0
+U=0
+V=1
+W=0
+X=1
+Y=0
+Z=1
+ShowHints=1
+ShowWarnings=1
+UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
+
+[Linker]
+MapFile=0
+OutputObjs=0
+ConsoleApp=1
+DebugInfo=0
+MinStackSize=16384
+MaxStackSize=1048576
+ImageBase=4194304
+ExeDescription=
+
+[Directories]
+OutputDir=
+UnitOutputDir=
+SearchPath=
+Packages=VCLX30;VCL30;VCLDB30;VCLDBX30;INETDB30;INET30;VCLSMP30;QRPT30;TEEUI30;TEEDB30;TEE30;DSS30;IBEVNT30;RXCTL;RXDB;RXTOOLS
+Conditionals=
+DebugSourceDirs=
+UsePackages=0
+
+[Parameters]
+RunParams=
+HostApplication=
+
+[Version Info]
+IncludeVerInfo=0
+AutoIncBuild=0
+MajorVer=1
+MinorVer=0
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=0
+Locale=1029
+CodePage=1250
+
+[Version Info Keys]
+CompanyName=
+FileDescription=
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
ADDED lib/synapse/source/demo/echo/EchoSrv.dpr
Index: lib/synapse/source/demo/echo/EchoSrv.dpr
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/echo/EchoSrv.dpr
@@ -0,0 +1,14 @@
+program EchoSrv;
+
+uses
+ Forms,
+ main in 'main.pas' {Form1},
+ echo in 'echo.pas';
+
+{$R *.RES}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TForm1, Form1);
+ Application.Run;
+end.
ADDED lib/synapse/source/demo/echo/EchoSrv.res
Index: lib/synapse/source/demo/echo/EchoSrv.res
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/echo/EchoSrv.res
cannot compute difference between binary files
ADDED lib/synapse/source/demo/echo/echo.pas
Index: lib/synapse/source/demo/echo/echo.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/echo/echo.pas
@@ -0,0 +1,96 @@
+unit echo;
+
+interface
+
+uses
+ Classes, blcksock, synsock;
+
+type
+ TTCPEchoDaemon = class(TThread)
+ private
+ Sock:TTCPBlockSocket;
+ public
+ Constructor Create;
+ Destructor Destroy; override;
+ procedure Execute; override;
+ end;
+
+ TTCPEchoThrd = class(TThread)
+ private
+ Sock:TTCPBlockSocket;
+ CSock: TSocket;
+ public
+ Constructor Create (hsock:tSocket);
+ procedure Execute; override;
+ end;
+
+implementation
+
+{ TEchoDaemon }
+
+Constructor TTCPEchoDaemon.Create;
+begin
+ inherited create(false);
+ sock:=TTCPBlockSocket.create;
+ FreeOnTerminate:=true;
+end;
+
+Destructor TTCPEchoDaemon.Destroy;
+begin
+ Sock.free;
+end;
+
+procedure TTCPEchoDaemon.Execute;
+var
+ ClientSock:TSocket;
+begin
+ with sock do
+ begin
+ CreateSocket;
+ setLinger(true,10000);
+ bind('0.0.0.0','8008');
+ listen;
+ repeat
+ if terminated then break;
+ if canread(1000) then
+ begin
+ ClientSock:=accept;
+ if lastError=0 then TTCPEchoThrd.create(ClientSock);
+ end;
+ until false;
+ end;
+end;
+
+{ TEchoThrd }
+
+Constructor TTCPEchoThrd.Create(Hsock:TSocket);
+begin
+ inherited create(false);
+ Csock := Hsock;
+ FreeOnTerminate:=true;
+end;
+
+procedure TTCPEchoThrd.Execute;
+var
+ s: string;
+begin
+ sock:=TTCPBlockSocket.create;
+ try
+ Sock.socket:=CSock;
+ sock.GetSins;
+ with sock do
+ begin
+ repeat
+ if terminated then break;
+ s := RecvPacket(60000);
+ if lastError<>0 then break;
+ SendString(s);
+ if lastError<>0 then break;
+ until false;
+ end;
+ finally
+ Sock.Free;
+ end;
+end;
+
+end.
ADDED lib/synapse/source/demo/echo/main.dfm
Index: lib/synapse/source/demo/echo/main.dfm
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/echo/main.dfm
cannot compute difference between binary files
ADDED lib/synapse/source/demo/echo/main.pas
Index: lib/synapse/source/demo/echo/main.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/echo/main.pas
@@ -0,0 +1,31 @@
+unit main;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+ StdCtrls, echo;
+
+type
+ TForm1 = class(TForm)
+ Button1: TButton;
+ procedure Button1Click(Sender: TObject);
+ private
+ { Private declarations }
+ public
+ { Public declarations }
+ end;
+
+var
+ Form1: TForm1;
+
+implementation
+
+{$R *.DFM}
+
+procedure TForm1.Button1Click(Sender: TObject);
+begin
+ TTCPEchoDaemon.create;
+end;
+
+end.
ADDED lib/synapse/source/demo/ftpserv/data/some_dir/some_third_file.txt
Index: lib/synapse/source/demo/ftpserv/data/some_dir/some_third_file.txt
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/ftpserv/data/some_dir/some_third_file.txt
@@ -0,0 +1,1 @@
+zzz
ADDED lib/synapse/source/demo/ftpserv/data/some_file.txt
Index: lib/synapse/source/demo/ftpserv/data/some_file.txt
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/ftpserv/data/some_file.txt
@@ -0,0 +1,1 @@
+xxx
ADDED lib/synapse/source/demo/ftpserv/data/some_other_file.txt
Index: lib/synapse/source/demo/ftpserv/data/some_other_file.txt
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/ftpserv/data/some_other_file.txt
@@ -0,0 +1,1 @@
+yyy
ADDED lib/synapse/source/demo/ftpserv/ftpmain.pas
Index: lib/synapse/source/demo/ftpserv/ftpmain.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/ftpserv/ftpmain.pas
@@ -0,0 +1,67 @@
+unit ftpmain;
+
+{$IFDEF FPC}
+ {$mode delphi}
+{$endif}
+
+interface
+
+uses
+{$IFDEF LINUX}
+ Libc,
+{$ELSE}
+ Windows,
+{$ENDIF}
+ Classes, SysUtils, ftpthrd, blcksock, synsock;
+
+type
+ TServiceThread = class(TThread)
+ private
+ { Private declarations }
+ protected
+ procedure Execute; override;
+ public
+ constructor Create;
+ end;
+
+
+implementation
+
+{==============================================================================}
+{ TServiceThread }
+
+constructor TServiceThread.create;
+begin
+ inherited create(false);
+ FreeOnTerminate := false;
+// Priority := tpNormal;
+end;
+
+procedure TServiceThread.Execute;
+var
+ ClientSock: TSocket;
+ sock: TTCPBlockSocket;
+begin
+ sock := TTCPBlockSocket.Create;
+ try
+ sock.bind('0.0.0.0','21');
+ sock.setLinger(true, 10000);
+ sock.listen;
+ if sock.LastError <> 0 then
+ exit;
+ while not terminated do
+ begin
+ if sock.canread(1000) then
+ begin
+ ClientSock := sock.accept;
+ if sock. lastError = 0 then
+ TFtpServerThread.create(ClientSock);
+ end;
+ end;
+ finally
+ sock.Free;
+ end;
+end;
+
+{==============================================================================}
+end.
ADDED lib/synapse/source/demo/ftpserv/ftpserv.dpr
Index: lib/synapse/source/demo/ftpserv/ftpserv.dpr
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/ftpserv/ftpserv.dpr
@@ -0,0 +1,15 @@
+program ftpserv;
+
+uses
+ Forms,
+ main in 'main.pas' {Form1},
+ ftpthrd in 'ftpthrd.pas',
+ ftpmain in 'ftpmain.pas';
+
+{$R *.RES}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TForm1, Form1);
+ Application.Run;
+end.
ADDED lib/synapse/source/demo/ftpserv/ftpserv.res
Index: lib/synapse/source/demo/ftpserv/ftpserv.res
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/ftpserv/ftpserv.res
cannot compute difference between binary files
ADDED lib/synapse/source/demo/ftpserv/ftpthrd.pas
Index: lib/synapse/source/demo/ftpserv/ftpthrd.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/ftpserv/ftpthrd.pas
@@ -0,0 +1,373 @@
+unit FtpThrd;
+
+{$IFDEF FPC}
+ {$mode delphi}
+{$endif}
+
+interface
+
+uses
+{$IFDEF LINUX}
+ Libc,
+{$ELSE}
+ Windows,
+{$ENDIF}
+ Classes, SysUtils, blcksock, synsock, synautil, filectrl;
+
+type
+ TFtpServerThread = class(TThread)
+ private
+ clients: TSocket;
+ FDataIP, FDataPort: string;
+ protected
+ procedure Execute; override;
+ procedure send(const sock: TTcpBlocksocket; value: string);
+ procedure ParseRemote(Value: string);
+ function buildname(dir, value: string): string;
+ function buildrealname(value: string): string;
+ function buildlist(value: string): string;
+ public
+ constructor Create(sock: TSocket);
+ end;
+
+implementation
+
+const
+ timeout = 60000;
+ MyMonthNames: array[1..12] of AnsiString =
+ ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
+ 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
+
+
+{==============================================================================}
+{ TFtpServerThread }
+
+constructor TFtpServerThread.create(sock: TSocket);
+begin
+ inherited create(false);
+ FreeOnTerminate := true;
+ clients := sock;
+// Priority := tpNormal;
+end;
+
+procedure TFtpServerThread.send(const sock: TTcpBlocksocket; value: string);
+begin
+ sock.SendString(value + CRLF);
+end;
+
+procedure TFtpServerThread.ParseRemote(Value: string);
+var
+ n: integer;
+ nb, ne: integer;
+ s: string;
+ x: integer;
+begin
+ Value := trim(Value);
+ nb := Pos('(',Value);
+ ne := Pos(')',Value);
+ if (nb = 0) or (ne = 0) then
+ begin
+ nb:=RPos(' ',Value);
+ s:=Copy(Value, nb + 1, Length(Value) - nb);
+ end
+ else
+ begin
+ s:=Copy(Value,nb+1,ne-nb-1);
+ end;
+ for n := 1 to 4 do
+ if n = 1 then
+ FDataIP := Fetch(s, ',')
+ else
+ FDataIP := FDataIP + '.' + Fetch(s, ',');
+ x := StrToIntDef(Fetch(s, ','), 0) * 256;
+ x := x + StrToIntDef(Fetch(s, ','), 0);
+ FDataPort := IntToStr(x);
+end;
+
+function TFtpServerThread.buildname(dir, value: string): string;
+begin
+ if value = '' then
+ begin
+ result := dir;
+ exit;
+ end;
+ if value[1] = '/' then
+ result := value
+ else
+ if (dir <> '') and (dir[length(dir)] = '/') then
+ Result := dir + value
+ else
+ Result := dir + '/' + value;
+end;
+
+function TFtpServerThread.buildrealname(value: string): string;
+begin
+ value := replacestring(value, '..', '.');
+ value := replacestring(value, '/', '\');
+ result := '.\data' + value;
+end;
+
+function fdate(value: integer): string;
+var
+ st: tdatetime;
+ wYear, wMonth, wDay: word;
+begin
+ st := filedatetodatetime(value);
+ DecodeDate(st, wYear, wMonth, wDay);
+ Result:= Format('%d %s %d', [wday, MyMonthNames[wMonth], wyear]);
+end;
+
+function TFtpServerThread.buildlist(value: string): string;
+var
+ SearchRec: TSearchRec;
+ r: integer;
+ s: string;
+begin
+ result := '';
+ if value = '' then
+ exit;
+ if value[length(value)] <> '\' then
+ value := value + '\';
+ R := FindFirst(value + '*.*', faanyfile, SearchRec);
+ while r = 0 do
+ begin
+ if ((searchrec.Attr and faHidden) = 0)
+ and ((searchrec.Attr and faSysFile) = 0)
+ and ((searchrec.Attr and faVolumeID) = 0) then
+ begin
+ s := '';
+ if (searchrec.Attr and faDirectory) > 0 then
+ begin
+ if (searchrec.Name <> '.') and (searchrec.Name <> '..') then
+ begin
+ s := s + 'drwxrwxrwx 1 root root 1 ';
+ s := s + fdate(searchrec.time) + ' ';
+ s := s + searchrec.name;
+ end;
+ end
+ else
+ begin
+ s := s + '-rwxrwxrwx 1 root other ';
+ s := s + inttostr(searchrec.Size) + ' ';
+ s := s + fdate(searchrec.time) + ' ';
+ s := s + searchrec.name;
+ end;
+ if s <> '' then
+ Result := Result + s + CRLF;
+ end;
+ r := findnext(SearchRec);
+ end;
+ Findclose(searchrec);
+end;
+
+procedure TFtpServerThread.Execute;
+var
+ sock, dsock: TTCPBlockSocket;
+ s, t: string;
+ authdone: boolean;
+ user: string;
+ cmd, par: string;
+ pwd: string;
+ st: TFileStream;
+begin
+ sock := TTCPBlockSocket.Create;
+ dsock := TTCPBlockSocket.Create;
+ try
+ sock.Socket := clients;
+ send(sock, '220 welcome ' + sock.GetRemoteSinIP + '!');
+ authdone := false;
+ user := '';
+ repeat
+ s := sock.RecvString(timeout);
+ cmd := uppercase(separateleft(s, ' '));
+ par := separateright(s, ' ');
+ if sock.lasterror <> 0 then
+ exit;
+ if terminated then
+ exit;
+ if cmd = 'USER' then
+ begin
+ user := par;
+ send(sock, '331 Please specify the password.');
+ continue;
+ end;
+ if cmd = 'PASS' then
+ begin
+ //user verification...
+ if ((user = 'username') and (par = 'password'))
+ or (user = 'anonymous') then
+ begin
+ send(sock, '230 Login successful.');
+ authdone := true;
+ continue;
+ end;
+ end;
+ send(sock, '500 Syntax error, command unrecognized.');
+ until authdone;
+
+ pwd := '/';
+ repeat
+ s := sock.RecvString(timeout);
+ cmd := uppercase(separateleft(s, ' '));
+ par := separateright(s, ' ');
+ if par = s then
+ par := '';
+ if sock.lasterror <> 0 then
+ exit;
+ if terminated then
+ exit;
+ if cmd = 'QUIT' then
+ begin
+ send(sock, '221 Service closing control connection.');
+ break;
+ end;
+ if cmd = 'NOOP' then
+ begin
+ send(sock, '200 tjadydadydadydaaaaa!');
+ continue;
+ end;
+ if cmd = 'PWD' then
+ begin
+ send(sock, '257 ' + Quotestr(pwd, '"'));
+ continue;
+ end;
+ if cmd = 'CWD' then
+ begin
+ t := unquotestr(par, '"');
+ t := buildname(pwd, t);
+ if directoryexists(Buildrealname(t)) then
+ begin
+ pwd := t;
+ send(sock, '250 OK ' + t);
+ end
+ else
+ send(sock, '550 Requested action not taken.');
+ continue;
+ end;
+ if cmd = 'MKD' then
+ begin
+ t := unquotestr(par, '"');
+ t := buildname(pwd, t);
+ if CreateDir(Buildrealname(t)) then
+ begin
+ pwd := t;
+ send(sock, '257 "' + t + '" directory created');
+ end
+ else
+ send(sock, '521 "' + t + '" Requested action not taken.');
+ continue;
+ end;
+ if cmd = 'CDUP' then
+ begin
+ pwd := '/';
+ send(sock, '250 OK');
+ continue;
+ end;
+ if (cmd = 'TYPE')
+ or (cmd = 'ALLO')
+ or (cmd = 'STRU')
+ or (cmd = 'MODE') then
+ begin
+ send(sock, '200 OK');
+ continue;
+ end;
+ if cmd = 'PORT' then
+ begin
+ Parseremote(par);
+ send(sock, '200 OK');
+ continue;
+ end;
+ if cmd = 'LIST' then
+ begin
+ t := unquotestr(par, '"');
+ t := buildname(pwd, t);
+ dsock.CloseSocket;
+ dsock.Connect(Fdataip, Fdataport);
+ if dsock.LastError <> 0 then
+ send(sock, '425 Can''t open data connection.')
+ else
+ begin
+ send(sock, '150 OK ' + t);
+ dsock.SendString(buildlist(buildrealname(t)));
+ send(sock, '226 OK ' + t);
+ end;
+ dsock.CloseSocket;
+ continue;
+ end;
+ if cmd = 'RETR' then
+ begin
+ t := unquotestr(par, '"');
+ t := buildname(pwd, t);
+ if fileexists(buildrealname(t)) then
+ begin
+ dsock.CloseSocket;
+ dsock.Connect(Fdataip, Fdataport);
+ dsock.SetLinger(true, 10000);
+ if dsock.LastError <> 0 then
+ send(sock, '425 Can''t open data connection.')
+ else
+ begin
+ send(sock, '150 OK ' + t);
+ try
+ st := TFileStream.Create(buildrealname(t), fmOpenRead or fmShareDenyWrite);
+ try
+ dsock.SendStreamRaw(st);
+ finally
+ st.free;
+ end;
+ send(sock, '226 OK ' + t);
+ except
+ on exception do
+ send(sock, '451 Requested action aborted: local error in processing.');
+ end;
+ end;
+ dsock.CloseSocket;
+ end
+ else
+ send(sock, '550 File unavailable. ' + t);
+ continue;
+ end;
+ if cmd = 'STOR' then
+ begin
+ t := unquotestr(par, '"');
+ t := buildname(pwd, t);
+ if directoryexists(extractfiledir(buildrealname(t))) then
+ begin
+ dsock.CloseSocket;
+ dsock.Connect(Fdataip, Fdataport);
+ dsock.SetLinger(true, 10000);
+ if dsock.LastError <> 0 then
+ send(sock, '425 Can''t open data connection.')
+ else
+ begin
+ send(sock, '150 OK ' + t);
+ try
+ st := TFileStream.Create(buildrealname(t), fmCreate or fmShareDenyWrite);
+ try
+ dsock.RecvStreamRaw(st, timeout);
+ finally
+ st.free;
+ end;
+ send(sock, '226 OK ' + t);
+ except
+ on exception do
+ send(sock, '451 Requested action aborted: local error in processing.');
+ end;
+ end;
+ dsock.CloseSocket;
+ end
+ else
+ send(sock, '553 Directory not exists. ' + t);
+ continue;
+ end;
+ send(sock, '500 Syntax error, command unrecognized.');
+ until false;
+
+ finally
+ dsock.free;
+ sock.free;
+ end;
+end;
+
+{==============================================================================}
+end.
ADDED lib/synapse/source/demo/ftpserv/main.dfm
Index: lib/synapse/source/demo/ftpserv/main.dfm
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/ftpserv/main.dfm
cannot compute difference between binary files
ADDED lib/synapse/source/demo/ftpserv/main.pas
Index: lib/synapse/source/demo/ftpserv/main.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/ftpserv/main.pas
@@ -0,0 +1,31 @@
+unit main;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+ StdCtrls, ftpmain;
+
+type
+ TForm1 = class(TForm)
+ Button1: TButton;
+ procedure Button1Click(Sender: TObject);
+ private
+ { Private declarations }
+ public
+ { Public declarations }
+ end;
+
+var
+ Form1: TForm1;
+
+implementation
+
+{$R *.DFM}
+
+procedure TForm1.Button1Click(Sender: TObject);
+begin
+ TServiceThread.create;
+end;
+
+end.
ADDED lib/synapse/source/demo/http/Unit1.dfm
Index: lib/synapse/source/demo/http/Unit1.dfm
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/http/Unit1.dfm
cannot compute difference between binary files
ADDED lib/synapse/source/demo/http/Unit1.pas
Index: lib/synapse/source/demo/http/Unit1.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/http/Unit1.pas
@@ -0,0 +1,148 @@
+unit Unit1;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+ HTTPSend, StdCtrls, ExtCtrls;
+
+type
+ TForm1 = class(TForm)
+ Panel1: TPanel;
+ Panel2: TPanel;
+ Panel3: TPanel;
+ Panel4: TPanel;
+ Memo1: TMemo;
+ Memo2: TMemo;
+ Label1: TLabel;
+ Edit1: TEdit;
+ Button1: TButton;
+ Label2: TLabel;
+ Label3: TLabel;
+ Edit2: TEdit;
+ Button2: TButton;
+ Label4: TLabel;
+ Label5: TLabel;
+ Edit3: TEdit;
+ Label6: TLabel;
+ Edit4: TEdit;
+ Label7: TLabel;
+ Label8: TLabel;
+ Edit5: TEdit;
+ Button3: TButton;
+ Label9: TLabel;
+ Edit6: TEdit;
+ Edit7: TEdit;
+ Label10: TLabel;
+ Panel5: TPanel;
+ Label11: TLabel;
+ Label12: TLabel;
+ Edit8: TEdit;
+ Edit9: TEdit;
+ Label13: TLabel;
+ procedure Button1Click(Sender: TObject);
+ procedure Button2Click(Sender: TObject);
+ procedure Button3Click(Sender: TObject);
+ private
+ { Private declarations }
+ public
+ { Public declarations }
+ end;
+
+var
+ Form1: TForm1;
+
+implementation
+
+{$R *.DFM}
+
+function ProxyHttpPostURL(const URL, URLData: string; const Data: TStream): Boolean;
+var
+ HTTP: THTTPSend;
+begin
+ HTTP := THTTPSend.Create;
+ try
+ HTTP.ProxyHost := Form1.Edit8.Text;
+ HTTP.ProxyPort := Form1.Edit9.Text;
+ HTTP.Document.Write(Pointer(URLData)^, Length(URLData));
+ HTTP.MimeType := 'application/x-www-form-urlencoded';
+ Result := HTTP.HTTPMethod('POST', URL);
+ Data.CopyFrom(HTTP.Document, 0);
+ finally
+ HTTP.Free;
+ end;
+end;
+
+function ProxyHttpPostFile(const URL, FieldName, FileName: string;
+ const Data: TStream; const ResultData: TStrings): Boolean;
+const
+ CRLF = #$0D + #$0A;
+var
+ HTTP: THTTPSend;
+ Bound, s: string;
+begin
+ Bound := IntToHex(Random(MaxInt), 8) + '_Synapse_boundary';
+ HTTP := THTTPSend.Create;
+ try
+ HTTP.ProxyHost := Form1.Edit8.Text;
+ HTTP.ProxyPort := Form1.Edit9.Text;
+ s := '--' + Bound + CRLF;
+ s := s + 'content-disposition: form-data; name="' + FieldName + '";';
+ s := s + ' filename="' + FileName +'"' + CRLF;
+ s := s + 'Content-Type: Application/octet-string' + CRLF + CRLF;
+ HTTP.Document.Write(Pointer(s)^, Length(s));
+ HTTP.Document.CopyFrom(Data, 0);
+ s := CRLF + '--' + Bound + '--' + CRLF;
+ HTTP.Document.Write(Pointer(s)^, Length(s));
+ HTTP.MimeType := 'multipart/form-data, boundary=' + Bound;
+ Result := HTTP.HTTPMethod('POST', URL);
+ ResultData.LoadFromStream(HTTP.Document);
+ finally
+ HTTP.Free;
+ end;
+end;
+
+
+procedure TForm1.Button1Click(Sender: TObject);
+var
+ HTTP: THTTPSend;
+begin
+ HTTP := THTTPSend.Create;
+ try
+ HTTP.ProxyHost := Edit8.Text;
+ HTTP.ProxyPort := Edit9.Text;
+ HTTP.HTTPMethod('GET', Edit1.text);
+ Memo1.Lines.Assign(HTTP.Headers);
+ Memo2.Lines.LoadFromStream(HTTP.Document);
+ finally
+ HTTP.Free;
+ end;
+end;
+
+procedure TForm1.Button2Click(Sender: TObject);
+var
+ st: TMemoryStream;
+begin
+ st:=TMemoryStream.Create;
+ try
+ ProxyHTTPpostURL(Edit2.Text, Edit3.Text + '=' + Edit4.Text, st);
+ st.Seek(0,soFromBeginning);
+ Memo2.Lines.LoadFromStream(st);
+ finally
+ st.Free;
+ end;
+end;
+
+procedure TForm1.Button3Click(Sender: TObject);
+var
+ st: TFileStream;
+begin
+ st := TFileStream.Create(Edit7.Text, fmOpenRead or fmShareDenyWrite);
+ try
+ ProxyHTTPPostFile(Edit5.Text, Edit6.Text, ExtractFilename(Edit7.Text), st, TStringList(memo2.Lines));
+ finally
+ st.Free;
+ end;
+end;
+
+end.
ADDED lib/synapse/source/demo/http/httpdemo.dof
Index: lib/synapse/source/demo/http/httpdemo.dof
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/http/httpdemo.dof
@@ -0,0 +1,80 @@
+[Compiler]
+A=1
+B=0
+C=1
+D=1
+E=0
+F=0
+G=1
+H=1
+I=1
+J=1
+K=0
+L=1
+M=0
+N=1
+O=1
+P=1
+Q=0
+R=0
+S=0
+T=0
+U=0
+V=1
+W=0
+X=1
+Y=0
+Z=1
+ShowHints=1
+ShowWarnings=1
+UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
+
+[Linker]
+MapFile=0
+OutputObjs=0
+ConsoleApp=1
+DebugInfo=0
+MinStackSize=16384
+MaxStackSize=1048576
+ImageBase=4194304
+ExeDescription=
+
+[Directories]
+OutputDir=
+UnitOutputDir=
+SearchPath=
+Packages=
+Conditionals=
+DebugSourceDirs=
+UsePackages=0
+
+[Parameters]
+RunParams=
+HostApplication=
+
+[Version Info]
+IncludeVerInfo=0
+AutoIncBuild=0
+MajorVer=1
+MinorVer=0
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=0
+Locale=1029
+CodePage=1250
+
+[Version Info Keys]
+CompanyName=
+FileDescription=
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
ADDED lib/synapse/source/demo/http/httpdemo.dpr
Index: lib/synapse/source/demo/http/httpdemo.dpr
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/http/httpdemo.dpr
@@ -0,0 +1,13 @@
+program httpdemo;
+
+uses
+ Forms,
+ Unit1 in 'Unit1.pas' {Form1};
+
+{$R *.RES}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TForm1, Form1);
+ Application.Run;
+end.
ADDED lib/synapse/source/demo/http/httpdemo.res
Index: lib/synapse/source/demo/http/httpdemo.res
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/http/httpdemo.res
cannot compute difference between binary files
ADDED lib/synapse/source/demo/http/web/post.htm
Index: lib/synapse/source/demo/http/web/post.htm
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/http/web/post.htm
@@ -0,0 +1,16 @@
+
+
+
+
+ Untitled
+
+
+
+
+
+
+
+
ADDED lib/synapse/source/demo/http/web/postfile.htm
Index: lib/synapse/source/demo/http/web/postfile.htm
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/http/web/postfile.htm
@@ -0,0 +1,15 @@
+
+
+
+
+ Untitled
+
+
+
+
+
+
+
ADDED lib/synapse/source/demo/http/web/postfileresult.php
Index: lib/synapse/source/demo/http/web/postfileresult.php
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/http/web/postfileresult.php
@@ -0,0 +1,11 @@
+
+
+ Example
+
+
+ Temp filename:
+ Uploaded filename:
+ Uploaded size:
+ Uploaded MIME type:
+
+
ADDED lib/synapse/source/demo/http/web/postresult.php
Index: lib/synapse/source/demo/http/web/postresult.php
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/http/web/postresult.php
@@ -0,0 +1,8 @@
+
+
+ Example
+
+
+
+
+
ADDED lib/synapse/source/demo/httpproxy/ProxyThrd.pas
Index: lib/synapse/source/demo/httpproxy/ProxyThrd.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/httpproxy/ProxyThrd.pas
@@ -0,0 +1,559 @@
+unit ProxyThrd;
+
+interface
+
+uses
+ Classes, SyncObjs, SysUtils, windows,
+ blcksock, synsock, synautil;
+
+type
+ TServiceThread = class(TThread)
+ protected
+ procedure Execute; override;
+ public
+ constructor Create;
+ end;
+
+ TLogRec = record
+ ip: string;
+ dt: TDateTime;
+ req: string;
+ stat: string;
+ len: integer;
+ ref: string;
+ agent: string;
+ end;
+
+ TTCPHttpThrd = class(TThread)
+ private
+ csock: TSocket;
+ public
+ timeout: integer;
+ Headers: TStringList;
+ ProxyHeaders: TStringList;
+ IdStr: string;
+ LogRec: TLogRec;
+ Constructor Create (hsock:tSocket);
+ Destructor Destroy; override;
+ procedure Execute; override;
+ function RelayTCP(const fsock, dsock: TTCPBlockSocket): boolean;
+ function RelaySock(const fsock, dsock: TTCPBlockSocket; Size: integer): boolean;
+ procedure ReturnHTML(const sock: TTCPBlockSocket; const value, stat: string);
+ procedure Return502(const sock: TTCPBlockSocket; host, port: string);
+ procedure WriteAccessLog(const LogRec: TLogRec);
+ end;
+
+
+procedure InitService;
+procedure DestroyService;
+procedure Writelog(value: string);
+
+var
+ CS: TCriticalSection;
+
+implementation
+
+{==============================================================================}
+
+procedure InitService;
+begin
+ CS := TCriticalSection.create;
+end;
+
+procedure DestroyService;
+begin
+ cs.free;
+end;
+
+procedure Writelog(value: string);
+var
+ f: textFile;
+ s: string;
+begin
+ CS.Enter;
+ s := Value;
+ s := extractfilepath(ParamStr(0)) + 'access.log';
+ assignfile(f, s);
+ if fileexists(s)
+ then append(f)
+ else rewrite(f);
+ try
+ writeln(f, Value);
+ finally
+ Closefile(f);
+ CS.Leave;
+ end;
+end;
+
+{==============================================================================}
+{ TServiceThread }
+
+constructor TServiceThread.create;
+begin
+ FreeOnTerminate := false;
+ inherited create(false);
+end;
+
+procedure TServiceThread.Execute;
+var
+ sock: TTCPBlockSocket;
+ ClientSock: TSocket;
+begin
+ sock := TTCPBlockSocket.Create;
+ try
+ sock.bind('0.0.0.0','3128');
+ if sock.LastError <> 0 then
+ begin
+ WriteLog('!!! BIND failed !!!');
+ Exit;
+ end;
+ sock.setLinger(true,10000);
+ sock.listen;
+ repeat
+ if terminated then
+ break;
+ if sock.canread(1000) then
+ begin
+ //new connection... launch TTCPHttpThrd
+ ClientSock := sock.accept;
+ if sock.lastError = 0 then
+ TTCPHttpThrd.create(ClientSock);
+ end;
+ until false;
+ finally
+ sock.free;
+ end;
+end;
+
+{==============================================================================}
+
+{ TTCPHttpThrd }
+
+Constructor TTCPHttpThrd.Create(Hsock:TSocket);
+begin
+ csock := hsock;
+ Headers := TStringList.Create;
+ ProxyHeaders := TStringList.Create;
+ FreeOnTerminate:=true;
+ inherited create(false);
+end;
+
+Destructor TTCPHttpThrd.Destroy;
+begin
+ Headers.Free;
+ Proxyheaders.Free;
+ inherited Destroy;
+end;
+
+//do both direction TCP proxy tunnel. (used by CONNECT method for https proxying)
+function TTCPHttpThrd.RelayTCP(const fsock, dsock: TTCPBlockSocket): boolean;
+var
+ n: integer;
+ buf: string;
+ ql, rl: TList;
+ fgsock, dgsock: TTCPBlockSocket;
+ FDSet: TFDSet;
+ FDSetSave: TFDSet;
+ TimeVal: PTimeVal;
+ TimeV: TTimeVal;
+begin
+ result := false;
+ //buffer maybe contains some pre-readed datas...
+ if fsock.LineBuffer <> '' then
+ begin
+ buf := fsock.RecvPacket(timeout);
+ if fsock.LastError <> 0 then
+ Exit;
+ dsock.SendString(buf);
+ end;
+ //begin relaying of TCP
+ ql := TList.Create;
+ rl := Tlist.create;
+ try
+ TimeV.tv_usec := (Timeout mod 1000) * 1000;
+ TimeV.tv_sec := Timeout div 1000;
+ TimeVal := @TimeV;
+ if Timeout = -1 then
+ TimeVal := nil;
+ FD_ZERO(FDSetSave);
+ FD_SET(fsock.Socket, FDSetSave);
+ FD_SET(dsock.Socket, FDSetSave);
+ FDSet := FDSetSave;
+ while synsock.Select(65535, @FDSet, nil, nil, TimeVal) > 0 do
+ begin
+ rl.clear;
+ if FD_ISSET(fsock.Socket, FDSet) then
+ rl.Add(fsock);
+ if FD_ISSET(dsock.Socket, FDSet) then
+ rl.Add(dsock);
+ for n := 0 to rl.Count - 1 do
+ begin
+ fgsock := TTCPBlockSocket(rl[n]);
+ if fgsock = fsock then
+ dgsock := dsock
+ else
+ dgsock := fsock;
+ if fgsock.WaitingData > 0 then
+ begin
+ buf := fgsock.RecvPacket(0);
+ dgsock.SendString(buf);
+ if dgsock.LastError <> 0 then
+ exit;
+ end
+ else
+ exit;
+ end;
+ FDSet := FDSetSave;
+ end;
+ finally
+ rl.free;
+ ql.free;
+ end;
+ result := true;
+end;
+
+//transmit X bytes from fsock to dsock
+function TTCPHttpThrd.RelaySock(const fsock, dsock: TTCPBlockSocket; Size: integer): boolean;
+var
+ sh, sl: integer;
+ n: integer;
+ buf: string;
+begin
+ result := false;
+ sh := size div c64k;
+ sl := size mod c64k;
+ for n := 1 to sh do
+ begin
+ buf := fsock.RecvBufferStr(c64k, timeout);
+ if fsock.LastError <> 0 then
+ Exit;
+ dsock.SendString(buf);
+ if dsock.LastError <> 0 then
+ Exit;
+ end;
+ if sl > 0 then
+ begin
+ buf := fsock.RecvBufferStr(sl, timeout);
+ if fsock.LastError <> 0 then
+ Exit;
+ dsock.SendString(buf);
+ if dsock.LastError <> 0 then
+ Exit;
+ end;
+ result := true;
+end;
+
+//core of proxy
+procedure TTCPHttpThrd.Execute;
+var
+ Sock: TTCPBlockSocket;
+ QSock: TTCPBlockSocket;
+ s: string;
+ method, uri, protocol: string;
+ size: integer;
+ Prot, User, Pass, Host, Port, Path, Para: string;
+ chunked: boolean;
+ status: integer;
+ proxykeep: boolean;
+ lasthost: String;
+ rprotocol: String;
+begin
+ idstr := inttostr(self.handle) + ' ';
+ sock:=TTCPBlockSocket.create;
+ Qsock:=TTCPBlockSocket.create;
+ try
+ Sock.socket:=CSock;
+ timeout := 120000;
+ lasthost := '';
+ qsock.ConvertLineEnd := true;
+ sock.ConvertLineEnd := true;
+
+ repeat
+ //read request line
+ headers.Clear;
+ proxyheaders.Clear;
+ proxykeep := false;
+ LogRec.ip := sock.GetRemoteSinIP;
+ repeat
+ s := sock.RecvString(timeout);
+ if sock.lasterror <> 0 then
+ Exit;
+ LogRec.dt := now;
+ LogRec.req := s;
+ Logrec.stat := '';
+ LogRec.len := 0;
+ Logrec.Ref := '';
+ Logrec.Agent := '';
+ until s <> '';
+ if s = '' then
+ Exit;
+ method := fetch(s, ' ');
+ if (s = '') or (method = '') then
+ Exit;
+ uri := fetch(s, ' ');
+ if uri = '' then
+ Exit;
+ protocol := fetch(s, ' ');
+ size := 0;
+ //read request headers
+ if protocol <> '' then
+ begin
+ if pos('HTTP/', protocol) <> 1 then
+ Exit;
+ repeat
+ s := sock.RecvString(Timeout);
+ if sock.lasterror <> 0 then
+ Exit;
+ if s <> '' then
+ begin
+ if pos('PROXY-', uppercase(s)) = 1 then
+ proxyHeaders.add(s)
+ else
+ Headers.add(s);
+ end;
+ if Pos('CONTENT-LENGTH:', Uppercase(s)) = 1 then
+ Size := StrToIntDef(SeparateRight(s, ' '), 0);
+ if Pos('PROXY-CONNECTION:', Uppercase(s)) = 1 then
+ if Pos('KEEP', Uppercase(s)) > 0 then
+ begin
+ proxykeep := true;
+ end;
+ if Pos('REFERER:', Uppercase(s)) = 1 then
+ LogRec.ref := Trim(SeparateRight(s, ' '));
+ if Pos('USER-AGENT:', Uppercase(s)) = 1 then
+ LogRec.agent := Trim(SeparateRight(s, ' '));
+ until s = '';
+ end;
+
+ if proxykeep then
+ headers.add('Connection: keep-alive')
+ else
+ headers.add('Connection: close');
+
+ s := ParseURL(uri, Prot, User, Pass, Host, Port, Path, Para);
+ Headers.Insert(0, method + ' ' + s + ' ' + protocol);
+
+ if lasthost <> host then
+ qsock.closesocket;
+ if qsock.Socket = INVALID_SOCKET then
+ begin
+ qsock.Connect(host, port);
+ if qsock.LastError <> 0 then
+ begin
+ return502(sock, host, port);
+ exit;
+ end;
+ lasthost := host;
+ end;
+
+ if method = 'CONNECT' then
+ begin
+ sock.SendString(protocol + ' 200 Connection established' + CRLF + CRLF);
+ LogRec.stat := '200';
+ WriteAccesslog(Logrec);
+ RelayTCP(sock, qsock);
+ Exit;
+ end;
+ qsock.SendString(headers.text + CRLF);
+
+ //upload data from client to server if needed.
+ if size > 0 then
+ begin
+ if not RelaySock(sock, qsock, size) then
+ exit;
+ end;
+
+ //read response line
+ repeat
+ headers.Clear;
+ s := qsock.RecvString(timeout);
+ if qsock.lasterror <> 0 then
+ Exit;
+ if s = '' then
+ Exit;
+ headers.Add(s);
+ rprotocol := fetch(s, ' ');
+ status := StrToIntDef(separateleft(s, ' '), 0);
+ if status = 100 then
+ begin
+ sock.SendString(rprotocol + ' ' + s + CRLF);
+ repeat
+ s := qSock.RecvString(Timeout);
+ if qSock.LastError = 0 then
+ sock.SendString(s + CRLF);
+ until (s = '') or (qSock.LastError <> 0);
+ end;
+ until status <> 100;
+
+
+ //read response headers
+ if pos('HTTP/', rprotocol) <> 1 then
+ Exit;
+ LogRec.stat := IntToStr(status);
+ size := -1;
+ chunked := false;
+ //read response headers
+ repeat
+ s := qsock.RecvString(Timeout);
+ if qsock.lasterror <> 0 then
+ Exit;
+ if s <> '' then
+ Headers.add(s);
+ if Pos('CONTENT-LENGTH:', Uppercase(s)) = 1 then
+ Size := StrToIntDef(SeparateRight(s, ' '), 0);
+ if Pos('TRANSFER-ENCODING:', uppercase(s)) = 1 then
+ chunked:=Pos('CHUNKED', uppercase(s)) > 0;
+ if Pos('CONNECTION:', uppercase(s)) = 1 then
+ if Pos('CLOSE', uppercase(s)) > 0 then
+ proxyKeep := False;
+ until s = '';
+
+ if (not(chunked)) and (size = -1) then
+ proxyKeep := false;
+
+ if proxykeep and (protocol <> 'HTTP/1.1') then
+ proxykeep := false;
+
+ sock.SendString(headers.text + CRLF);
+
+ if method = 'HEAD' then
+ begin
+ LogRec.len := 0;
+ end
+ else
+ begin
+ if size > 0 then
+ begin
+ //identity kodovani
+ if not RelaySock(qsock, sock, size) then
+ exit;
+ LogRec.len := Size;
+ end
+ else
+ begin
+ if chunked then
+ begin
+ repeat
+ repeat
+ s := qSock.RecvString(Timeout);
+ if qSock.LastError = 0 then
+ sock.SendString(s + CRLF);
+ until (s <> '') or (qSock.LastError <> 0);
+ if qSock.LastError <> 0 then
+ Break;
+ s := Trim(SeparateLeft(s, ' '));
+ s := Trim(SeparateLeft(s, ';'));
+ Size := StrToIntDef('$' + s, 0);
+ LogRec.len := LogRec.len + Size;
+ if Size = 0 then
+ begin
+ repeat
+ s := qSock.RecvString(Timeout);
+ if qSock.LastError = 0 then
+ sock.SendString(s + CRLF);
+ until (s = '') or (qSock.LastError <> 0);
+ Break;
+ end;
+ if not RelaySock(qsock, sock, size) then
+ break;
+ until False;
+ end
+ else
+ begin
+ if size = -1 then
+ if method = 'GET' then
+ if (status div 100) = 2 then
+ begin
+ while qsock.LastError = 0 do
+ begin
+ s := qsock.RecvPacket(timeout);
+ if qsock.LastError = 0 then
+ sock.SendString(s);
+ LogRec.len := LogRec.len + length(s);
+ end;
+ end;
+ end;
+ end;
+ end;
+ //done
+ WriteAccesslog(Logrec);
+ if (qsock.LastError <> 0) or (sock.LastError <> 0) then
+ Exit;
+ sleep(1);
+ until not proxykeep;
+ //finish with connection
+ finally
+ sock.Free;
+ Qsock.Free;
+ end;
+end;
+
+procedure TTCPHttpThrd.ReturnHTML(const sock: TTCPBlockSocket; const value, stat: string);
+begin
+ sock.sendstring('HTTP/1.0 ' + stat + CRLF);
+ sock.sendstring('Content-type: text/html' + CRLF);
+ sock.sendstring('Content-length: ' + Inttostr(length(value)) + CRLF);
+ sock.sendstring('proxy-Connection: close' + CRLF);
+ sock.sendstring(CRLF);
+ sock.sendstring(value);
+end;
+
+procedure TTCPHttpThrd.Return502(const sock: TTCPBlockSocket; host, port: string);
+var
+ l: TStringlist;
+begin
+ l := TStringList.Create;
+ try
+ l.Add('');
+ l.Add('Bad address! ');
+ l.Add('');
+ l.Add('Bad address! ');
+ l.Add('');
+ l.Add('Unable to connect with: ' + host + ':' + port);
+ l.Add('
');
+ l.Add('Requested address is bad, or server is not accessible now.');
+ l.Add('
');
+ l.Add('
Error 502 ');
+ l.Add('');
+ l.Add('');
+ l.Add('');
+ ReturnHTML(sock, l.text, '502');
+ finally
+ l.free;
+ end;
+end;
+
+//write Apache compatible access log
+procedure TTCPHttpThrd.WriteAccessLog(const LogRec: TLogRec);
+var
+ day, month, year: word;
+ s: string;
+const
+ MNames: array[1..12] of string =
+ ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
+ 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
+begin
+ Decodedate(LogRec.dt,year, month, day);
+ s := Format('%.2d', [day]) + '/' + MNames[month] + '/' + IntToStr(year);
+ s := '[' + s + FormatDateTime(':hh:nn:ss', LogRec.dt) + ' ' + TimeZone + ']';
+ s := LogRec.ip + ' - - ' + s + ' "' + LogRec.req + '"';
+ if LogRec.stat = '' then
+ s := s + ' -'
+ else
+ s := s + ' ' + LogRec.Stat;
+ if LogRec.len = 0 then
+ s := s + ' -'
+ else
+ s := s + ' ' + IntToStr(LogRec.len);
+ if LogRec.Ref = '' then
+ s := s + ' "-"'
+ else
+ s := s + ' "' + LogRec.Ref + '"';
+ if LogRec.Agent = '' then
+ s := s + ' "-"'
+ else
+ s := s + ' "' + LogRec.Agent + '"';
+ Writelog(s);
+end;
+
+end.
ADDED lib/synapse/source/demo/httpproxy/Unit1.dfm
Index: lib/synapse/source/demo/httpproxy/Unit1.dfm
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/httpproxy/Unit1.dfm
cannot compute difference between binary files
ADDED lib/synapse/source/demo/httpproxy/Unit1.pas
Index: lib/synapse/source/demo/httpproxy/Unit1.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/httpproxy/Unit1.pas
@@ -0,0 +1,38 @@
+unit Unit1;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+ StdCtrls, proxythrd;
+
+type
+ TForm1 = class(TForm)
+ Button1: TButton;
+ procedure Button1Click(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ private
+ { Private declarations }
+ public
+ { Public declarations }
+ end;
+
+var
+ Form1: TForm1;
+
+implementation
+
+{$R *.DFM}
+
+procedure TForm1.Button1Click(Sender: TObject);
+begin
+ Button1.Enabled := False;
+ TServiceThread.Create;
+end;
+
+procedure TForm1.FormCreate(Sender: TObject);
+begin
+ InitService;
+end;
+
+end.
ADDED lib/synapse/source/demo/httpproxy/httpproxy.dof
Index: lib/synapse/source/demo/httpproxy/httpproxy.dof
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/httpproxy/httpproxy.dof
@@ -0,0 +1,75 @@
+[Compiler]
+A=1
+B=0
+C=1
+D=1
+E=0
+F=0
+G=1
+H=1
+I=1
+J=1
+K=0
+L=1
+M=0
+N=1
+O=1
+P=1
+Q=0
+R=0
+S=0
+T=0
+U=0
+V=1
+W=0
+X=1
+Y=0
+Z=1
+ShowHints=1
+ShowWarnings=1
+UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
+[Linker]
+MapFile=0
+OutputObjs=0
+ConsoleApp=1
+DebugInfo=0
+MinStackSize=16384
+MaxStackSize=1048576
+ImageBase=4194304
+ExeDescription=
+[Directories]
+OutputDir=
+UnitOutputDir=
+SearchPath=
+Packages=
+Conditionals=
+DebugSourceDirs=
+UsePackages=0
+[Parameters]
+RunParams=
+HostApplication=
+[Version Info]
+IncludeVerInfo=0
+AutoIncBuild=0
+MajorVer=1
+MinorVer=0
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=0
+Locale=1029
+CodePage=1250
+[Version Info Keys]
+CompanyName=
+FileDescription=
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
ADDED lib/synapse/source/demo/httpproxy/httpproxy.dpr
Index: lib/synapse/source/demo/httpproxy/httpproxy.dpr
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/httpproxy/httpproxy.dpr
@@ -0,0 +1,14 @@
+program httpproxy;
+
+uses
+ Forms,
+ Unit1 in 'Unit1.pas' {Form1},
+ ProxyThrd in 'ProxyThrd.pas';
+
+{$R *.RES}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TForm1, Form1);
+ Application.Run;
+end.
ADDED lib/synapse/source/demo/httpproxy/httpproxy.res
Index: lib/synapse/source/demo/httpproxy/httpproxy.res
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/httpproxy/httpproxy.res
cannot compute difference between binary files
ADDED lib/synapse/source/demo/httpserv/http.pas
Index: lib/synapse/source/demo/httpserv/http.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/httpserv/http.pas
@@ -0,0 +1,202 @@
+unit http;
+
+interface
+
+uses
+ Classes, blcksock, winsock, Synautil, SysUtils;
+
+type
+ TTCPHttpDaemon = class(TThread)
+ private
+ Sock:TTCPBlockSocket;
+ public
+ Constructor Create;
+ Destructor Destroy; override;
+ procedure Execute; override;
+ end;
+
+ TTCPHttpThrd = class(TThread)
+ private
+ Sock:TTCPBlockSocket;
+ public
+ Headers: TStringList;
+ InputData, OutputData: TMemoryStream;
+ Constructor Create (hsock:tSocket);
+ Destructor Destroy; override;
+ procedure Execute; override;
+ function ProcessHttpRequest(Request, URI: string): integer;
+ end;
+
+implementation
+
+{ TTCPHttpDaemon }
+
+Constructor TTCPHttpDaemon.Create;
+begin
+ inherited create(false);
+ sock:=TTCPBlockSocket.create;
+ FreeOnTerminate:=true;
+end;
+
+Destructor TTCPHttpDaemon.Destroy;
+begin
+ Sock.free;
+ inherited Destroy;
+end;
+
+procedure TTCPHttpDaemon.Execute;
+var
+ ClientSock:TSocket;
+begin
+ with sock do
+ begin
+ CreateSocket;
+ setLinger(true,10000);
+ bind('0.0.0.0','80');
+ listen;
+ repeat
+ if terminated then break;
+ if canread(1000) then
+ begin
+ ClientSock:=accept;
+ if lastError=0 then TTCPHttpThrd.create(ClientSock);
+ end;
+ until false;
+ end;
+end;
+
+{ TTCPHttpThrd }
+
+Constructor TTCPHttpThrd.Create(Hsock:TSocket);
+begin
+ sock:=TTCPBlockSocket.create;
+ Headers := TStringList.Create;
+ InputData := TMemoryStream.Create;
+ OutputData := TMemoryStream.Create;
+ Sock.socket:=HSock;
+ FreeOnTerminate:=true;
+ Priority:=tpNormal;
+ inherited create(false);
+end;
+
+Destructor TTCPHttpThrd.Destroy;
+begin
+ Sock.free;
+ Headers.Free;
+ InputData.Free;
+ OutputData.Free;
+ inherited Destroy;
+end;
+
+procedure TTCPHttpThrd.Execute;
+var
+ timeout: integer;
+ s: string;
+ method, uri, protocol: string;
+ size: integer;
+ x, n: integer;
+ resultcode: integer;
+ close: boolean;
+begin
+ timeout := 120000;
+ repeat
+ //read request line
+ s := sock.RecvString(timeout);
+ if sock.lasterror <> 0 then
+ Exit;
+ if s = '' then
+ Exit;
+ method := fetch(s, ' ');
+ if (s = '') or (method = '') then
+ Exit;
+ uri := fetch(s, ' ');
+ if uri = '' then
+ Exit;
+ protocol := fetch(s, ' ');
+ headers.Clear;
+ size := -1;
+ close := false;
+ //read request headers
+ if protocol <> '' then
+ begin
+ if pos('HTTP/', protocol) <> 1 then
+ Exit;
+ if pos('HTTP/1.1', protocol) <> 1 then
+ close := true;
+ repeat
+ s := sock.RecvString(Timeout);
+ if sock.lasterror <> 0 then
+ Exit;
+ if s <> '' then
+ Headers.add(s);
+ if Pos('CONTENT-LENGTH:', Uppercase(s)) = 1 then
+ Size := StrToIntDef(SeparateRight(s, ' '), -1);
+ if Pos('CONNECTION: CLOSE', Uppercase(s)) = 1 then
+ close := true;
+ until s = '';
+ end;
+ //recv document...
+ InputData.Clear;
+ if size >= 0 then
+ begin
+ InputData.SetSize(Size);
+ x := Sock.RecvBufferEx(InputData.Memory, Size, Timeout);
+ InputData.SetSize(x);
+ if sock.lasterror <> 0 then
+ Exit;
+ end;
+ OutputData.Clear;
+ ResultCode := ProcessHttpRequest(method, uri);
+ sock.SendString(protocol + ' ' + IntTostr(ResultCode) + CRLF);
+ if protocol <> '' then
+ begin
+ headers.Add('Content-length: ' + IntTostr(OutputData.Size));
+ if close then
+ headers.Add('Connection: close');
+ headers.Add('Date: ' + Rfc822DateTime(now));
+ headers.Add('Server: Synapse HTTP server demo');
+ headers.Add('');
+ for n := 0 to headers.count - 1 do
+ sock.sendstring(headers[n] + CRLF);
+ end;
+ if sock.lasterror <> 0 then
+ Exit;
+ Sock.SendBuffer(OutputData.Memory, OutputData.Size);
+ if close then
+ Break;
+ until Sock.LastError <> 0;
+end;
+
+function TTCPHttpThrd.ProcessHttpRequest(Request, URI: string): integer;
+var
+ l: TStringlist;
+begin
+//sample of precessing HTTP request:
+// InputData is uploaded document, headers is stringlist with request headers.
+// Request is type of request and URI is URI of request
+// OutputData is document with reply, headers is stringlist with reply headers.
+// Result is result code
+ result := 504;
+ if request = 'GET' then
+ begin
+ headers.Clear;
+ headers.Add('Content-type: Text/Html');
+ l := TStringList.Create;
+ try
+ l.Add('');
+ l.Add('
');
+ l.Add('');
+ l.Add('Request Uri: ' + uri);
+ l.Add(' ');
+ l.Add('This document is generated by Synapse HTTP server demo!');
+ l.Add('');
+ l.Add('');
+ l.SaveToStream(OutputData);
+ finally
+ l.free;
+ end;
+ Result := 200;
+ end;
+end;
+
+end.
ADDED lib/synapse/source/demo/httpserv/httpserv.dof
Index: lib/synapse/source/demo/httpserv/httpserv.dof
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/httpserv/httpserv.dof
@@ -0,0 +1,75 @@
+[Compiler]
+A=1
+B=0
+C=1
+D=1
+E=0
+F=0
+G=1
+H=1
+I=1
+J=1
+K=0
+L=1
+M=0
+N=1
+O=1
+P=1
+Q=0
+R=0
+S=0
+T=0
+U=0
+V=1
+W=0
+X=1
+Y=0
+Z=1
+ShowHints=1
+ShowWarnings=1
+UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
+[Linker]
+MapFile=0
+OutputObjs=0
+ConsoleApp=1
+DebugInfo=0
+MinStackSize=16384
+MaxStackSize=1048576
+ImageBase=4194304
+ExeDescription=
+[Directories]
+OutputDir=
+UnitOutputDir=
+SearchPath=
+Packages=VCLX30;VCL30;VCLDB30;VCLDBX30;INETDB30;INET30;VCLSMP30;QRPT30;TEEUI30;TEEDB30;TEE30;DSS30;IBEVNT30;RXCTL;RXDB;RXTOOLS
+Conditionals=
+DebugSourceDirs=
+UsePackages=0
+[Parameters]
+RunParams=
+HostApplication=
+[Version Info]
+IncludeVerInfo=0
+AutoIncBuild=0
+MajorVer=1
+MinorVer=0
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=0
+Locale=1029
+CodePage=1250
+[Version Info Keys]
+CompanyName=
+FileDescription=
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
ADDED lib/synapse/source/demo/httpserv/httpserv.dpr
Index: lib/synapse/source/demo/httpserv/httpserv.dpr
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/httpserv/httpserv.dpr
@@ -0,0 +1,14 @@
+program httpserv;
+
+uses
+ Forms,
+ main in 'main.pas' {Form1},
+ http in 'http.pas';
+
+{$R *.RES}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TForm1, Form1);
+ Application.Run;
+end.
ADDED lib/synapse/source/demo/httpserv/httpserv.res
Index: lib/synapse/source/demo/httpserv/httpserv.res
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/httpserv/httpserv.res
cannot compute difference between binary files
ADDED lib/synapse/source/demo/httpserv/main.dfm
Index: lib/synapse/source/demo/httpserv/main.dfm
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/httpserv/main.dfm
cannot compute difference between binary files
ADDED lib/synapse/source/demo/httpserv/main.pas
Index: lib/synapse/source/demo/httpserv/main.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/httpserv/main.pas
@@ -0,0 +1,31 @@
+unit main;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+ StdCtrls, http;
+
+type
+ TForm1 = class(TForm)
+ Button1: TButton;
+ procedure Button1Click(Sender: TObject);
+ private
+ { Private declarations }
+ public
+ { Public declarations }
+ end;
+
+var
+ Form1: TForm1;
+
+implementation
+
+{$R *.DFM}
+
+procedure TForm1.Button1Click(Sender: TObject);
+begin
+ TTCPHttpDaemon.create;
+end;
+
+end.
ADDED lib/synapse/source/demo/httpsserv/c_cacert.p12
Index: lib/synapse/source/demo/httpsserv/c_cacert.p12
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/httpsserv/c_cacert.p12
cannot compute difference between binary files
ADDED lib/synapse/source/demo/httpsserv/http.pas
Index: lib/synapse/source/demo/httpsserv/http.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/httpsserv/http.pas
@@ -0,0 +1,225 @@
+unit http;
+
+{ Marked some code with !!!}
+
+interface
+
+uses
+ Classes, blcksock, winsock, Synautil, ssl_openssl, SysUtils, Dialogs;
+
+type
+ TTCPHttpDaemon = class(TThread)
+ private
+ Sock:TTCPBlockSocket;
+ public
+ Constructor Create;
+ Destructor Destroy; override;
+ procedure Execute; override;
+ end;
+
+ TTCPHttpThrd = class(TThread)
+ private
+ Sock:TTCPBlockSocket;
+ public
+ Headers: TStringList;
+ InputData, OutputData: TMemoryStream;
+ Constructor Create (hsock:tSocket);
+ Destructor Destroy; override;
+ procedure Execute; override;
+ function ProcessHttpRequest(Request, URI: string): integer;
+ end;
+
+implementation
+
+{ TTCPHttpDaemon }
+
+Constructor TTCPHttpDaemon.Create;
+begin
+ sock:=TTCPBlockSocket.create;
+ FreeOnTerminate:=true;
+ inherited create(false);
+end;
+
+Destructor TTCPHttpDaemon.Destroy;
+begin
+ Sock.free;
+ inherited Destroy;
+end;
+
+procedure TTCPHttpDaemon.Execute;
+var
+ ClientSock:TSocket;
+begin
+ with sock do
+ begin
+ CreateSocket;
+ setLinger(true,10000);
+ bind('0.0.0.0','443');
+ listen;
+ repeat
+ if terminated then break;
+ if canread(1000) then
+ begin
+ ClientSock:=accept;
+ if lastError=0 then TTCPHttpThrd.create(ClientSock);
+ end;
+ until false;
+ end;
+end;
+
+{ TTCPHttpThrd }
+
+Constructor TTCPHttpThrd.Create(Hsock:TSocket);
+begin
+ sock:=TTCPBlockSocket.create;
+ Headers := TStringList.Create;
+ InputData := TMemoryStream.Create;
+ OutputData := TMemoryStream.Create;
+ Sock.socket:=HSock;
+ FreeOnTerminate:=true;
+ inherited create(false);
+end;
+
+Destructor TTCPHttpThrd.Destroy;
+begin
+ Sock.free;
+ Headers.Free;
+ InputData.Free;
+ OutputData.Free;
+ inherited Destroy;
+end;
+
+procedure TTCPHttpThrd.Execute;
+var
+ timeout: integer;
+ s: string;
+ method, uri, protocol: string;
+ size: integer;
+ x, n: integer;
+ resultcode: integer;
+begin
+ timeout := 120000;
+
+ // Note: There's no need for installing a client certificate in the
+ // webbrowser. The server asks the webbrowser to send a certificate but
+ // if nothing is installed the software will work because the server
+ // doesn't check to see if a client certificate was supplied. If you
+ // want you can install:
+ //
+ // file: c_cacert.p12
+ // password: c_cakey
+ //
+ Sock.SSL.CertCAFile := ExtractFilePath(ParamStr(0)) + 's_cabundle.pem';
+ Sock.SSL.CertificateFile := ExtractFilePath(ParamStr(0)) + 's_cacert.pem';
+ Sock.SSL.PrivateKeyFile := ExtractFilePath(ParamStr(0)) + 's_cakey.pem';
+ Sock.SSL.KeyPassword := 's_cakey';
+ Sock.SSL.verifyCert := True;
+
+ try
+ if (not Sock.SSLAcceptConnection) or
+ (Sock.SSL.LastError <> 0) then
+ begin
+ MessageDlg('Error while accepting SSL connection: ' + Sock.SSL.LastErrorDesc, mtError, [mbAbort], 0);
+ Exit;
+ end;
+ except
+ MessageDlg('Exception while accepting SSL connection', mtError, [mbAbort], 0);
+ Exit;
+ end;
+
+
+ //read request line
+ s := sock.RecvString(timeout);
+ if sock.lasterror <> 0 then
+ Exit;
+ if s = '' then
+ Exit;
+ method := fetch(s, ' ');
+ if (s = '') or (method = '') then
+ Exit;
+ uri := fetch(s, ' ');
+ if uri = '' then
+ Exit;
+ protocol := fetch(s, ' ');
+ headers.Clear;
+ size := -1;
+ //read request headers
+ if protocol <> '' then
+ begin
+ if pos('HTTP/', protocol) <> 1 then
+ Exit;
+ repeat
+ s := sock.RecvString(Timeout);
+ if sock.lasterror <> 0 then
+ Exit;
+ if s <> '' then
+ Headers.add(s);
+ if Pos('CONTENT-LENGTH:', Uppercase(s)) = 1 then
+ Size := StrToIntDef(SeparateRight(s, ' '), -1);
+ until s = '';
+ end;
+ //recv document...
+ InputData.Clear;
+ if size >= 0 then
+ begin
+ InputData.SetSize(Size);
+ x := Sock.RecvBufferEx(InputData.Memory, Size, Timeout);
+ InputData.SetSize(x);
+ if sock.lasterror <> 0 then
+ Exit;
+ end;
+ OutputData.Clear;
+ ResultCode := ProcessHttpRequest(method, uri);
+ sock.SendString('HTTP/1.0 ' + IntTostr(ResultCode) + CRLF);
+ if protocol <> '' then
+ begin
+ headers.Add('Content-length: ' + IntTostr(OutputData.Size));
+ headers.Add('Connection: close');
+ headers.Add('Date: ' + Rfc822DateTime(now));
+ headers.Add('Server: Synapse HTTP server demo');
+ headers.Add('');
+ for n := 0 to headers.count - 1 do
+ sock.sendstring(headers[n] + CRLF);
+ end;
+ if sock.lasterror <> 0 then
+ Exit;
+ Sock.SendBuffer(OutputData.Memory, OutputData.Size);
+end;
+
+function TTCPHttpThrd.ProcessHttpRequest(Request, URI: string): integer;
+var
+ l: TStringlist;
+begin
+//sample of precessing HTTP request:
+// InputData is uploaded document, headers is stringlist with request headers.
+// Request is type of request and URI is URI of request
+// OutputData is document with reply, headers is stringlist with reply headers.
+// Result is result code
+ result := 504;
+ if request = 'GET' then
+ begin
+ headers.Clear;
+ headers.Add('Content-type: Text/Html');
+ l := TStringList.Create;
+ try
+ l.Add('');
+ l.Add('');
+ l.Add('');
+ l.Add('Request Uri: ' + uri);
+ l.Add(' ');
+ l.Add('This document is generated by Synapse HTTPS server demo!');
+ if Sock.SSL.GetPeerName = '' then
+ l.Add('No client certificate received')
+ else
+ l.Add('Client certificate received from ' + Sock.SSL.GetPeerName);
+ l.Add('');
+ l.Add('');
+ l.SaveToStream(OutputData);
+ finally
+ l.free;
+ end;
+ Result := 200;
+ end;
+end;
+
+end.
ADDED lib/synapse/source/demo/httpsserv/httpserv.dof
Index: lib/synapse/source/demo/httpsserv/httpserv.dof
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/httpsserv/httpserv.dof
@@ -0,0 +1,132 @@
+[FileVersion]
+Version=7.0
+[Compiler]
+A=8
+B=0
+C=1
+D=1
+E=0
+F=0
+G=1
+H=1
+I=1
+J=0
+K=0
+L=1
+M=0
+N=1
+O=1
+P=1
+Q=0
+R=0
+S=0
+T=0
+U=0
+V=1
+W=0
+X=1
+Y=1
+Z=1
+ShowHints=1
+ShowWarnings=1
+UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
+NamespacePrefix=
+SymbolDeprecated=1
+SymbolLibrary=1
+SymbolPlatform=1
+UnitLibrary=1
+UnitPlatform=1
+UnitDeprecated=1
+HResultCompat=1
+HidingMember=1
+HiddenVirtual=1
+Garbage=1
+BoundsError=1
+ZeroNilCompat=1
+StringConstTruncated=1
+ForLoopVarVarPar=1
+TypedConstVarPar=1
+AsgToTypedConst=1
+CaseLabelRange=1
+ForVariable=1
+ConstructingAbstract=1
+ComparisonFalse=1
+ComparisonTrue=1
+ComparingSignedUnsigned=1
+CombiningSignedUnsigned=1
+UnsupportedConstruct=1
+FileOpen=1
+FileOpenUnitSrc=1
+BadGlobalSymbol=1
+DuplicateConstructorDestructor=1
+InvalidDirective=1
+PackageNoLink=1
+PackageThreadVar=1
+ImplicitImport=1
+HPPEMITIgnored=1
+NoRetVal=1
+UseBeforeDef=1
+ForLoopVarUndef=1
+UnitNameMismatch=1
+NoCFGFileFound=1
+MessageDirective=1
+ImplicitVariants=1
+UnicodeToLocale=1
+LocaleToUnicode=1
+ImagebaseMultiple=1
+SuspiciousTypecast=1
+PrivatePropAccessor=1
+UnsafeType=0
+UnsafeCode=0
+UnsafeCast=0
+[Linker]
+MapFile=0
+OutputObjs=0
+ConsoleApp=1
+DebugInfo=0
+RemoteSymbols=0
+MinStackSize=16384
+MaxStackSize=1048576
+ImageBase=4194304
+ExeDescription=
+[Directories]
+OutputDir=
+UnitOutputDir=
+PackageDLLOutputDir=
+PackageDCPOutputDir=
+SearchPath=
+Packages=
+Conditionals=
+DebugSourceDirs=
+UsePackages=0
+[Parameters]
+RunParams=
+HostApplication=
+Launcher=
+UseLauncher=0
+DebugCWD=
+[Version Info]
+IncludeVerInfo=0
+AutoIncBuild=0
+MajorVer=1
+MinorVer=0
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=0
+Locale=1029
+CodePage=1250
+[Version Info Keys]
+CompanyName=
+FileDescription=
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
ADDED lib/synapse/source/demo/httpsserv/httpserv.dpr
Index: lib/synapse/source/demo/httpsserv/httpserv.dpr
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/httpsserv/httpserv.dpr
@@ -0,0 +1,14 @@
+program httpserv;
+
+uses
+ Forms,
+ main in 'main.pas' {Form1},
+ http in 'http.pas';
+
+{$R *.RES}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TForm1, Form1);
+ Application.Run;
+end.
ADDED lib/synapse/source/demo/httpsserv/httpserv.res
Index: lib/synapse/source/demo/httpsserv/httpserv.res
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/httpsserv/httpserv.res
cannot compute difference between binary files
ADDED lib/synapse/source/demo/httpsserv/main.dfm
Index: lib/synapse/source/demo/httpsserv/main.dfm
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/httpsserv/main.dfm
@@ -0,0 +1,25 @@
+object Form1: TForm1
+ Left = 370
+ Top = 255
+ Width = 232
+ Height = 127
+ Caption = 'HTTPServ'
+ Color = clBtnFace
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -13
+ Font.Name = 'MS Sans Serif'
+ Font.Style = []
+ OldCreateOrder = True
+ PixelsPerInch = 120
+ TextHeight = 16
+ object Button1: TButton
+ Left = 9
+ Top = 14
+ Width = 192
+ Height = 24
+ Caption = 'Run HTTP Server'
+ TabOrder = 0
+ OnClick = Button1Click
+ end
+end
ADDED lib/synapse/source/demo/httpsserv/main.pas
Index: lib/synapse/source/demo/httpsserv/main.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/httpsserv/main.pas
@@ -0,0 +1,31 @@
+unit main;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+ StdCtrls, http;
+
+type
+ TForm1 = class(TForm)
+ Button1: TButton;
+ procedure Button1Click(Sender: TObject);
+ private
+ { Private declarations }
+ public
+ { Public declarations }
+ end;
+
+var
+ Form1: TForm1;
+
+implementation
+
+{$R *.DFM}
+
+procedure TForm1.Button1Click(Sender: TObject);
+begin
+ TTCPHttpDaemon.create;
+end;
+
+end.
ADDED lib/synapse/source/demo/httpsserv/s_cabundle.pem
Index: lib/synapse/source/demo/httpsserv/s_cabundle.pem
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/httpsserv/s_cabundle.pem
@@ -0,0 +1,54 @@
+-----BEGIN CERTIFICATE-----
+MIIEojCCA4qgAwIBAgIBATANBgkqhkiG9w0BAQQFADCBizELMAkGA1UEBhMCTkwx
+EjAQBgNVBAgTCUZsZXZvbGFuZDEPMA0GA1UEBxMGQWxtZXJlMRAwDgYDVQQKEwdp
+U2VydmVyMQ4wDAYDVQQLEwVTYWxlczESMBAGA1UEAxMJbG9jYWxob3N0MSEwHwYJ
+KoZIhvcNAQkBFhJzZXJ2ZXJAaG90bWFpbC5jb20wHhcNMDUwOTEwMTIyNTQwWhcN
+MDYwOTEwMTIyNTQwWjB6MQswCQYDVQQGEwJOTDESMBAGA1UECBMJRmxldm9sYW5k
+MRAwDgYDVQQKEwdpU2VydmVyMQ4wDAYDVQQLEwVTYWxlczESMBAGA1UEAxMJbG9j
+YWxob3N0MSEwHwYJKoZIhvcNAQkBFhJjbGllbnRAaG90bWFpbC5jb20wggEiMA0G
+CSqGSIb3DQEBAQUAA4IBDwAwggEKAoIBAQCqPV/htC0M7wxnNxcXsfAuVacyvx+G
+minwpCyWJMJdcvACL43jzGA6Ap8QfwXgXR6pZxvFXbal9G0vZQEO/vgNuAhfXBIO
++eGPrQFYg/IIsJzuLlmGiTh4TJS5WLA/t5o55cvrCyT7uyj4u1+5qkAiVqdgaoKp
+vac5Ip0yWNmPBPojvSELDmZ17qheKo6LX/2WG678cESYl1xrVwQubBttsCGxgVlC
+oUVXOSFUqjAtm1ZVk4+sBKqwZ+jUryYW9FHGQNFGlXQp0M/UlHBe9t/YFmswKU47
+EIVHGUCdz02p/77FGu7vWoMBBScOAaaMLBwXjc08s7IJxtj6vRn70EgRAgMBAAGj
+ggEfMIIBGzAJBgNVHRMEAjAAMCwGCWCGSAGG+EIBDQQfFh1PcGVuU1NMIEdlbmVy
+YXRlZCBDZXJ0aWZpY2F0ZTAdBgNVHQ4EFgQUNKzE1cM8luUu3Oh/73qkTNq4VgMw
+gcAGA1UdIwSBuDCBtYAU5fXRDlkYEkrR3AFeoXlNN4GE8A+hgZGkgY4wgYsxCzAJ
+BgNVBAYTAk5MMRIwEAYDVQQIEwlGbGV2b2xhbmQxDzANBgNVBAcTBkFsbWVyZTEQ
+MA4GA1UEChMHaVNlcnZlcjEOMAwGA1UECxMFU2FsZXMxEjAQBgNVBAMTCWxvY2Fs
+aG9zdDEhMB8GCSqGSIb3DQEJARYSc2VydmVyQGhvdG1haWwuY29tggkAi8LqjArw
+jpYwDQYJKoZIhvcNAQEEBQADggEBAI9YwWNlEV420DBKpzeYhQK3MAOSF8IhikzP
+a0MUewi5bsHo8lKpKJCN4f5yRZSx2FxL5NoxR5JEiFY8Nr5it3cgppd0FFWKf8p7
+LN8CIgS6/EmuFcVpe2JpcSBe95QpdloeTq5rygrBJb4UurIFewELpODXjC1MQZSM
+lvIbbLX8PVxpOZrLHjWBNzVBQ1Jfy/53Ova1pp6R/fqBZu6c6I61vB/IragWuQhO
+KQAjjCHUvL6NqZIz9VsNbiDR1NGjLYh7NRbcMr4Qc/HXkFeXugI+UyG+JH7/rYKB
+iNtQ/mPr2R2e5vaJhjmSZr0MjqSrMJ1VMI5AUokVWo8oNJosdMk=
+-----END CERTIFICATE-----
+-----BEGIN CERTIFICATE-----
+MIIEjzCCA3egAwIBAgIJAIvC6owK8I6WMA0GCSqGSIb3DQEBBAUAMIGLMQswCQYD
+VQQGEwJOTDESMBAGA1UECBMJRmxldm9sYW5kMQ8wDQYDVQQHEwZBbG1lcmUxEDAO
+BgNVBAoTB2lTZXJ2ZXIxDjAMBgNVBAsTBVNhbGVzMRIwEAYDVQQDEwlsb2NhbGhv
+c3QxITAfBgkqhkiG9w0BCQEWEnNlcnZlckBob3RtYWlsLmNvbTAeFw0wNTA5MTAx
+MjIyMTJaFw0wODA5MDkxMjIyMTJaMIGLMQswCQYDVQQGEwJOTDESMBAGA1UECBMJ
+Rmxldm9sYW5kMQ8wDQYDVQQHEwZBbG1lcmUxEDAOBgNVBAoTB2lTZXJ2ZXIxDjAM
+BgNVBAsTBVNhbGVzMRIwEAYDVQQDEwlsb2NhbGhvc3QxITAfBgkqhkiG9w0BCQEW
+EnNlcnZlckBob3RtYWlsLmNvbTCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoC
+ggEBANyzvvJiLHEiK9hGJ8ugM5I2tfL0QYDjTgOcfYSmhtrdFJF1M9O2JNLMLvfC
+hROXkPL6mfFhiEKaoXflWLWs/whQKLeDSTIEj5FVDbvnehktSrh8vBt21HVTxovq
+HQ1Qk2wPU62tMnJrkjLLhuimTS90fdWVs6aJhsH4R85XczumIUNzKndqVyWAGzVX
+ImiXRR4P5CTkwzeQ70LbbYoxM+3+0pkAkZxtoQ/ZSaWLnI7wpeJ4/4Z31/1IlYtk
+IFFGY1HsbBy4RFbWIUdQ5c1GaKgLul415HZ3wV3Um9SULSxDIWZkN00/8qWtghVU
+CAQglry8b2GbnziEEWrqRQh0MeUCAwEAAaOB8zCB8DAdBgNVHQ4EFgQU5fXRDlkY
+EkrR3AFeoXlNN4GE8A8wgcAGA1UdIwSBuDCBtYAU5fXRDlkYEkrR3AFeoXlNN4GE
+8A+hgZGkgY4wgYsxCzAJBgNVBAYTAk5MMRIwEAYDVQQIEwlGbGV2b2xhbmQxDzAN
+BgNVBAcTBkFsbWVyZTEQMA4GA1UEChMHaVNlcnZlcjEOMAwGA1UECxMFU2FsZXMx
+EjAQBgNVBAMTCWxvY2FsaG9zdDEhMB8GCSqGSIb3DQEJARYSc2VydmVyQGhvdG1h
+aWwuY29tggkAi8LqjArwjpYwDAYDVR0TBAUwAwEB/zANBgkqhkiG9w0BAQQFAAOC
+AQEAE49cf2BZ0KIbIupJSrerrvD9JgskCvZE2JZu5ogetaqpF607wvpzvqfU5YsK
+HvT3yYaVIqEreiWinpCZzfW7SIKS8M6rPZk8nbv+O2FaY+wkaU8SLVS4ZMdB6BGb
+4Jwc3Y2DVwa8l/TwDE+dNM6jVvzNJAhu17IybIwo+jP6uyYw+E7Y40a3CF2dSkxF
+fUMO/wyQiN7BvqgeVjcfKbhi71rPg8xiJAnt1wjTLhL5WBuDJQw7wNzmMuh8BuR8
+J6exTroDNn8ZRISWX/Pz7da87S+dYLEI5+EjcfIZDtgHk9g37t48mli2ajYkS7WG
+W20dkY+dGSeVEsxLn+DuarseTQ==
+-----END CERTIFICATE-----
ADDED lib/synapse/source/demo/httpsserv/s_cacert.pem
Index: lib/synapse/source/demo/httpsserv/s_cacert.pem
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/httpsserv/s_cacert.pem
@@ -0,0 +1,27 @@
+-----BEGIN CERTIFICATE-----
+MIIEjzCCA3egAwIBAgIJAIvC6owK8I6WMA0GCSqGSIb3DQEBBAUAMIGLMQswCQYD
+VQQGEwJOTDESMBAGA1UECBMJRmxldm9sYW5kMQ8wDQYDVQQHEwZBbG1lcmUxEDAO
+BgNVBAoTB2lTZXJ2ZXIxDjAMBgNVBAsTBVNhbGVzMRIwEAYDVQQDEwlsb2NhbGhv
+c3QxITAfBgkqhkiG9w0BCQEWEnNlcnZlckBob3RtYWlsLmNvbTAeFw0wNTA5MTAx
+MjIyMTJaFw0wODA5MDkxMjIyMTJaMIGLMQswCQYDVQQGEwJOTDESMBAGA1UECBMJ
+Rmxldm9sYW5kMQ8wDQYDVQQHEwZBbG1lcmUxEDAOBgNVBAoTB2lTZXJ2ZXIxDjAM
+BgNVBAsTBVNhbGVzMRIwEAYDVQQDEwlsb2NhbGhvc3QxITAfBgkqhkiG9w0BCQEW
+EnNlcnZlckBob3RtYWlsLmNvbTCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoC
+ggEBANyzvvJiLHEiK9hGJ8ugM5I2tfL0QYDjTgOcfYSmhtrdFJF1M9O2JNLMLvfC
+hROXkPL6mfFhiEKaoXflWLWs/whQKLeDSTIEj5FVDbvnehktSrh8vBt21HVTxovq
+HQ1Qk2wPU62tMnJrkjLLhuimTS90fdWVs6aJhsH4R85XczumIUNzKndqVyWAGzVX
+ImiXRR4P5CTkwzeQ70LbbYoxM+3+0pkAkZxtoQ/ZSaWLnI7wpeJ4/4Z31/1IlYtk
+IFFGY1HsbBy4RFbWIUdQ5c1GaKgLul415HZ3wV3Um9SULSxDIWZkN00/8qWtghVU
+CAQglry8b2GbnziEEWrqRQh0MeUCAwEAAaOB8zCB8DAdBgNVHQ4EFgQU5fXRDlkY
+EkrR3AFeoXlNN4GE8A8wgcAGA1UdIwSBuDCBtYAU5fXRDlkYEkrR3AFeoXlNN4GE
+8A+hgZGkgY4wgYsxCzAJBgNVBAYTAk5MMRIwEAYDVQQIEwlGbGV2b2xhbmQxDzAN
+BgNVBAcTBkFsbWVyZTEQMA4GA1UEChMHaVNlcnZlcjEOMAwGA1UECxMFU2FsZXMx
+EjAQBgNVBAMTCWxvY2FsaG9zdDEhMB8GCSqGSIb3DQEJARYSc2VydmVyQGhvdG1h
+aWwuY29tggkAi8LqjArwjpYwDAYDVR0TBAUwAwEB/zANBgkqhkiG9w0BAQQFAAOC
+AQEAE49cf2BZ0KIbIupJSrerrvD9JgskCvZE2JZu5ogetaqpF607wvpzvqfU5YsK
+HvT3yYaVIqEreiWinpCZzfW7SIKS8M6rPZk8nbv+O2FaY+wkaU8SLVS4ZMdB6BGb
+4Jwc3Y2DVwa8l/TwDE+dNM6jVvzNJAhu17IybIwo+jP6uyYw+E7Y40a3CF2dSkxF
+fUMO/wyQiN7BvqgeVjcfKbhi71rPg8xiJAnt1wjTLhL5WBuDJQw7wNzmMuh8BuR8
+J6exTroDNn8ZRISWX/Pz7da87S+dYLEI5+EjcfIZDtgHk9g37t48mli2ajYkS7WG
+W20dkY+dGSeVEsxLn+DuarseTQ==
+-----END CERTIFICATE-----
ADDED lib/synapse/source/demo/httpsserv/s_cakey.pem
Index: lib/synapse/source/demo/httpsserv/s_cakey.pem
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/httpsserv/s_cakey.pem
@@ -0,0 +1,30 @@
+-----BEGIN RSA PRIVATE KEY-----
+Proc-Type: 4,ENCRYPTED
+DEK-Info: DES-CBC,6E9C19410AE44898
+
+/LmetEQseTTqG2/dNIanjj3xg8b4bBOJRH8kBzB0ZjBXwi0on5bTBIkOOzM6B6YZ
+fOGIHsrI5OS1wVVWF2++ydP8AD/cgPOewKCBEO/92n+OSOLNqgm+Ns2pvDR44lv0
+je7qIpPxj1RUdDuB45UocxFEZ50w38MgL7E2ITtS95nivtZWmMzTMQki1IYm+k4H
+sJcqcq6jQoreiUXkVLL4js2XwJBEh+rAgoaHHPvWKskdaR/tJG35o9h4YTnVmqhv
+SWKWsDW1ezJotD62VCSGU7KzrXmXBNSF9JPqV40fA1VRYp9cg/8qz8LYmAI2FLOy
+cvBXzvOTYhPbjIOo9nrvBdXZFUUnePLyxJFfWoeYzpvWU1kg1TswlMFwYHGu1SwG
+e5CbNpH7X5/BOLZ6xf4kVeaGLhVqR+FZytlITvi3ZewvfpcyDZt7hyDQ2Fgrtddy
+lF4DlC+eeGDB7eUxKwaIp4X5hiXr+1VJf4Grx33WLVW0Vy5zvQRQoxxfPfEGHexu
+Xddm2c1h8b34PiYx5+SDJ3JVDtZmEXXufDTdP6INkHBGt6JrQDT5OFPwNgjsv2x5
+9xwgccrtk2owVlbTqNLYvARmPC41hkBNcuLOf7FzBsrOEepoIcAnx603CL8vKqWp
+hTeF7npa5KgXWrq44aDraZ478wehN2zUo2p6HvRZlgqQl0WGb8JEVBb3rpB9j99i
+P9kF4ewqSzVF7Qa3FGJF6f2qqxCqQT/01V37OSS4YsAQT1r10WQjd+g/LGgZDbPM
+2GuyI+qtywpneyXiXX3JLZisgEES+XhodlH65YCDOT51izs6mATygMc1PMDh+rbh
+TbuU9gvjfev+sxEtbU83A6s3E/br6i6ChUk0O1okeknImeG93IF8f4Cnpq736hpC
+BNn74XXaplvGqKXcpG6r9v626P4SdnXOEDt1GTovdohjvjOWdNHrNbGVLR9GQZMq
+JmkLLTVB+nAECV4tyh5tAj0+w/5sG4QcX8rms1b9DmnvfTDSNbF+mDRQpz+7kL2+
+w9ORmHC+C59lB4h0jZFUoKZn7liKdRJwLRTuy6wmFkxIZiYKdlsUWHEYQ9OWFDTW
+yf073T3AQ21tZTNLypiW6qRhlussOGPdJx7IkEbuC6UXS1h74om1OQoTqq2uQ7Gl
+7v6WL6ZoAhuRdZoslodO9tCCaTizTRYLO4TEsxcJnY9+xLh0RzBY0PZKnZK3l5tH
+kyxOOSDX8Ld1sbSKRBJo7lhxhUGSUq4p6x/yhXz2CrW7LKpqGDstVPbU/33i4HAi
+XM04oDRRSlWcv9ZjcDksEfpb63/Ck323sxURukyzk3OYW7w8JtVZvMw8RD8TWCB1
+Dw89P2/RIdTGmu9xSfWeThjH10aXUVE2p09lK4VE5rVsZr2owdBQnOnc7WYffllB
+FICMgXPUVA50HyJm7d6yH6J2EiK5fGZ/6DNAqw4p8QNxikk78mt5FfuQ7S8sj2hg
++vXLJhs49lbt47IDstTLtmWLz+tUdAdN9veZ91iDuOhNWoAh7EJmaBjt/zCn2LOq
+rirjPY3adAi3OzsBgMNQ1JEdCatHs8PbAQc1rbPo/548SWXqQh4iFQ==
+-----END RSA PRIVATE KEY-----
ADDED lib/synapse/source/demo/mime/MimeDemo.dof
Index: lib/synapse/source/demo/mime/MimeDemo.dof
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/mime/MimeDemo.dof
@@ -0,0 +1,75 @@
+[Compiler]
+A=1
+B=0
+C=1
+D=1
+E=0
+F=0
+G=1
+H=1
+I=1
+J=1
+K=0
+L=1
+M=0
+N=1
+O=1
+P=1
+Q=0
+R=0
+S=0
+T=0
+U=0
+V=1
+W=0
+X=1
+Y=0
+Z=1
+ShowHints=1
+ShowWarnings=1
+UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
+[Linker]
+MapFile=0
+OutputObjs=0
+ConsoleApp=1
+DebugInfo=0
+MinStackSize=16384
+MaxStackSize=1048576
+ImageBase=4194304
+ExeDescription=
+[Directories]
+OutputDir=
+UnitOutputDir=
+SearchPath=
+Packages=
+Conditionals=
+DebugSourceDirs=
+UsePackages=0
+[Parameters]
+RunParams=
+HostApplication=
+[Version Info]
+IncludeVerInfo=0
+AutoIncBuild=0
+MajorVer=1
+MinorVer=0
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=0
+Locale=1029
+CodePage=1250
+[Version Info Keys]
+CompanyName=
+FileDescription=
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
ADDED lib/synapse/source/demo/mime/MimeDemo.dpr
Index: lib/synapse/source/demo/mime/MimeDemo.dpr
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/mime/MimeDemo.dpr
@@ -0,0 +1,15 @@
+program MimeDemo;
+
+uses
+ Forms,
+ Unit1 in 'Unit1.pas' {Form1},
+ MIMEmess in 'MIMEmess.pas',
+ MIMEpart in 'MIMEpart.pas';
+
+{$R *.RES}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TForm1, Form1);
+ Application.Run;
+end.
ADDED lib/synapse/source/demo/mime/MimeDemo.res
Index: lib/synapse/source/demo/mime/MimeDemo.res
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/mime/MimeDemo.res
cannot compute difference between binary files
ADDED lib/synapse/source/demo/mime/Unit1.dfm
Index: lib/synapse/source/demo/mime/Unit1.dfm
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/mime/Unit1.dfm
cannot compute difference between binary files
ADDED lib/synapse/source/demo/mime/Unit1.pas
Index: lib/synapse/source/demo/mime/Unit1.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/mime/Unit1.pas
@@ -0,0 +1,97 @@
+unit Unit1;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+ StdCtrls, mimemess, mimepart, ComCtrls;
+
+type
+ TForm1 = class(TForm)
+ Edit1: TEdit;
+ Button1: TButton;
+ Label1: TLabel;
+ Memo1: TMemo;
+ Button2: TButton;
+ Label2: TLabel;
+ TreeView1: TTreeView;
+ procedure Button1Click(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure FormDestroy(Sender: TObject);
+ procedure Button2Click(Sender: TObject);
+ procedure TreeView1Change(Sender: TObject; Node: TTreeNode);
+ private
+ { Private declarations }
+ procedure AddMimeNode(const parent: TTreeNode; const part: TMimepart);
+ public
+ Mime:TMimemess;
+ { Public declarations }
+ end;
+
+var
+ Form1: TForm1;
+
+implementation
+
+{$R *.DFM}
+
+procedure TForm1.AddMimeNode(const parent: TTreeNode; const part: TMimepart);
+var
+ s: string;
+ node: TTreeNode;
+ n: integer;
+begin
+ s := format('%-24s %-15s %-s',[part.primary + '/' + part.secondary,part.filename,part.description]);
+ node := TreeView1.Items.AddChild(parent, s);
+ node.Data := part;
+ for n := 0 to part.GetSubPartCount - 1 do
+ AddMimeNode(node, part.getsubpart(n));
+end;
+
+procedure TForm1.Button1Click(Sender: TObject);
+var
+ n:integer;
+ s:string;
+begin
+ mime.Clear;
+ memo1.Clear;
+ mime.Lines.LoadFromFile(edit1.text);
+ mime.DecodeMessage;
+ ShowMessage(datetimetostr(mime.Header.Date));
+
+ Treeview1.Items.Clear;
+ AddMimeNode(nil, mime.MessagePart);
+ Treeview1.FullExpand;
+end;
+
+procedure TForm1.FormCreate(Sender: TObject);
+begin
+ mime:=TMimemess.create;
+end;
+
+procedure TForm1.FormDestroy(Sender: TObject);
+begin
+ mime.free;
+end;
+
+procedure TForm1.Button2Click(Sender: TObject);
+var
+ f:string;
+begin
+ with TMimePart(Treeview1.Selected.data) do
+ begin
+ f:=filename;
+ if f=''
+ then f:='mimedemo.txt';
+ f:='c:/'+f;
+ Decodepart;
+ decodedlines.SaveToFile(f);
+ end;
+end;
+
+procedure TForm1.TreeView1Change(Sender: TObject; Node: TTreeNode);
+begin
+ memo1.Lines.assign(TMimepart(Node.Data).Lines);
+end;
+
+end.
ADDED lib/synapse/source/demo/modem/ModemDemo.dof
Index: lib/synapse/source/demo/modem/ModemDemo.dof
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/modem/ModemDemo.dof
@@ -0,0 +1,80 @@
+[Compiler]
+A=1
+B=0
+C=1
+D=1
+E=0
+F=0
+G=1
+H=1
+I=1
+J=1
+K=0
+L=1
+M=0
+N=1
+O=1
+P=1
+Q=0
+R=0
+S=0
+T=0
+U=0
+V=1
+W=0
+X=1
+Y=0
+Z=1
+ShowHints=1
+ShowWarnings=1
+UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
+
+[Linker]
+MapFile=0
+OutputObjs=0
+ConsoleApp=1
+DebugInfo=0
+MinStackSize=16384
+MaxStackSize=1048576
+ImageBase=4194304
+ExeDescription=
+
+[Directories]
+OutputDir=
+UnitOutputDir=
+SearchPath=
+Packages=
+Conditionals=
+DebugSourceDirs=
+UsePackages=0
+
+[Parameters]
+RunParams=
+HostApplication=
+
+[Version Info]
+IncludeVerInfo=0
+AutoIncBuild=0
+MajorVer=1
+MinorVer=0
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=0
+Locale=1029
+CodePage=1250
+
+[Version Info Keys]
+CompanyName=
+FileDescription=
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
ADDED lib/synapse/source/demo/modem/ModemDemo.dpr
Index: lib/synapse/source/demo/modem/ModemDemo.dpr
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/modem/ModemDemo.dpr
@@ -0,0 +1,13 @@
+program ModemDemo;
+
+uses
+ Forms,
+ Unit1 in 'Unit1.pas' {Form1};
+
+{$R *.RES}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TForm1, Form1);
+ Application.Run;
+end.
ADDED lib/synapse/source/demo/modem/ModemDemo.res
Index: lib/synapse/source/demo/modem/ModemDemo.res
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/modem/ModemDemo.res
cannot compute difference between binary files
ADDED lib/synapse/source/demo/modem/Unit1.dfm
Index: lib/synapse/source/demo/modem/Unit1.dfm
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/modem/Unit1.dfm
cannot compute difference between binary files
ADDED lib/synapse/source/demo/modem/Unit1.pas
Index: lib/synapse/source/demo/modem/Unit1.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/modem/Unit1.pas
@@ -0,0 +1,49 @@
+unit Unit1;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+ SynaSer, StdCtrls, ExtCtrls;
+
+type
+ TForm1 = class(TForm)
+ Label1: TLabel;
+ Edit1: TEdit;
+ Label2: TLabel;
+ Edit2: TEdit;
+ Edit3: TEdit;
+ Label3: TLabel;
+ Button1: TButton;
+ Bevel1: TBevel;
+ Memo1: TMemo;
+ procedure Button1Click(Sender: TObject);
+ private
+ { Private declarations }
+ public
+ { Public declarations }
+ end;
+
+var
+ Form1: TForm1;
+
+implementation
+
+{$R *.DFM}
+
+procedure TForm1.Button1Click(Sender: TObject);
+var
+ ser:TBlockSerial;
+begin
+ ser:=TBlockSerial.Create;
+ ser.RaiseExcept:=True;
+ try
+ ser.Connect(Edit1.Text, StrToIntDef(Edit2.Text, 9600),8,'N',0,false,false);
+ memo1.lines.text:=ser.ATCommand(Edit3.Text);
+ finally
+ ser.free;
+ end;
+end;
+
+end.
+
ADDED lib/synapse/source/demo/scan/IPUtils.pas
Index: lib/synapse/source/demo/scan/IPUtils.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/scan/IPUtils.pas
@@ -0,0 +1,117 @@
+unit IPUtils;
+
+interface
+
+uses SysUtils;
+
+type TIPAdresse = record
+ Oct1,
+ Oct2,
+ Oct3,
+ Oct4:Byte;
+ end;
+
+function StrToIP(const Value:String):TIPAdresse;
+function IPToStr(const Adresse:TIPAdresse):String;
+function IPToCardinal(const Adresse:TIPAdresse):Cardinal;
+function CardinalToIP(const Value:Cardinal):TIPAdresse;
+function IsIPAdress(const Value:String):Boolean;
+
+implementation
+
+// IPAdresse in Cardinal umwandeln
+function IPToCardinal(const Adresse:TIPAdresse):Cardinal;
+begin
+ Result := (Adresse.Oct1*16777216)
+ +(Adresse.Oct2*65536)
+ +(Adresse.Oct3*256)
+ +(Adresse.Oct4);
+end;
+
+// Cardinal in IP-Adresse umwandeln
+function CardinalToIP(const Value:Cardinal):TIPAdresse;
+begin
+ Result.Oct1 := Value div 16777216;
+ Result.Oct2 := Value div 65536;
+ Result.Oct3 := Value div 256;
+ Result.Oct4 := Value mod 256;
+end;
+
+// IP-Adresse in String umwandeln
+function IPToStr(const Adresse:TIPAdresse):String;
+begin
+ Result := IntToStr(Adresse.Oct1) + '.' +
+ IntToStr(Adresse.Oct2) + '.' +
+ IntToStr(Adresse.Oct3) + '.' +
+ IntToStr(Adresse.Oct4);
+end;
+
+function StrToIP(const Value:String):TIPAdresse;
+var n,x: Integer;
+ Posi:Array[1..4]of Integer;
+ Oktet:Array[1..4]of String;
+begin
+ x := 0;
+ // es dürfen nur Zahlen und Punkte vorhanden sein
+ for n := 1 to Length(Value) do
+ begin
+ // Zähle die Punkte
+ if Value[n] = '.'
+ then
+ begin
+ Inc(x);
+ Posi[x] := n;
+ end
+ else Oktet[x+1] := Oktet[x+1] + Value[n];
+ end;
+ Result.Oct1 := StrToInt(Oktet[1]);
+ Result.Oct2 := StrToInt(Oktet[2]);
+ Result.Oct3 := StrToInt(Oktet[3]);
+ Result.Oct4 := StrToInt(Oktet[4]);
+end;
+
+function IsIPAdress(const Value:String):Boolean;
+var n,x,i: Integer;
+ Posi:Array[1..4]of Integer;
+ Oktet:Array[1..4]of String;
+begin
+ Result := true;
+ x := 0;
+
+ // es dürfen nur Zahlen und Punkte vorhanden sein
+ for n := 1 to Length(Value) do
+ if not (Value[n] in ['0'..'9','.'])
+ then
+ begin
+ // ungültiges Zeichen -> keine IP-Adresse
+ Result := false;
+ break;
+ end
+ else
+ begin
+ // Zähle die Punkte
+ if Value[n] = '.'
+ then
+ begin
+ Inc(x);
+ Posi[x] := n;
+ end
+ else
+ begin
+ Oktet[x+1] := Oktet[x+1] + Value[n];
+ end;
+ end;
+
+ for i := 1 to 4 do
+ if (StrToInt(Oktet[i])>255)then Result := false;
+
+ // es müssen genau 3 Punkte vorhanden sein
+ if x <> 3
+ then
+ begin
+ // Anzahl der Punkte <> 3 -> keine IP-Adresse
+ Result := false;
+ end;
+end;
+
+end.
ADDED lib/synapse/source/demo/scan/PingThread.pas
Index: lib/synapse/source/demo/scan/PingThread.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/scan/PingThread.pas
@@ -0,0 +1,48 @@
+unit PingThread;
+
+interface
+
+uses Classes, PingSend, IPUtils;
+
+type
+ PPingResult = ^TPingResult;
+ TPingResult = Record
+ IPAdress:String;
+ Exists:Boolean;
+ end;
+
+
+type
+ TPingThread = class(TThread)
+ private
+ { Private declarations }
+ protected
+ procedure Execute; override;
+ public
+ PingResult:TPingResult;
+ Ready:Boolean;
+ constructor Create(Ping:TPingResult);
+ end;
+
+implementation
+
+{ TPingThread }
+
+constructor TPingThread.Create(Ping:TPingResult);
+begin
+ PingResult.IPAdress := Ping.IPAdress;
+ inherited Create(False);
+end;
+
+procedure TPingThread.Execute;
+var Ping:TPingSend;
+begin
+ Ready := false;
+ Ping := TPingSend.Create;
+ Ping.Timeout := 2000;
+ PingResult.Exists := Ping.Ping(PingResult.IPAdress);
+ Ping.Free;
+ Ready := true;
+end;
+
+end.
ADDED lib/synapse/source/demo/scan/Readme.txt
Index: lib/synapse/source/demo/scan/Readme.txt
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/scan/Readme.txt
@@ -0,0 +1,16 @@
+Scan v1.0
+Synapse Demo Application
+(c) 2003 by Christian Brosius (brosius@online.de)
+
+'Scan v1.0' is a multithreaded ping to scan a given networkrange for
+available IP-Adresses.
+
+Usage:
+
+'scan 192.168.50.1 192.168.50.254' scans a complete Class C Network with
+a timeout for each ping of 2 Seconds.
+
+The complete Scan will finish after about 3 Seconds.
+
+The result will be a sorted list of available IP-Adresses.
+
ADDED lib/synapse/source/demo/scan/Scan.dpr
Index: lib/synapse/source/demo/scan/Scan.dpr
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/scan/Scan.dpr
@@ -0,0 +1,95 @@
+program Scan;
+
+{$APPTYPE CONSOLE}
+
+uses SysUtils, IPUtils, PingThread;
+
+var i,j:Cardinal;
+ Ping:Array of TPingResult;
+ PingCount,Cardinal1,Cardinal2:Cardinal;
+ Puffer:String;
+ ThreadArray:Array of TPingThread;
+ ThreadsComplete:Boolean;
+begin
+ WriteLn;
+ WriteLn('Scan v1.0');
+ WriteLn('Synapse Demo Application');
+ WriteLn('(c)2003 by Christian Brosius');
+ WriteLn;
+ if (ParamCount = 2)and // Parse Commandline
+ (IsIPAdress(ParamStr(1)))and
+ (IsIPAdress(ParamStr(2)))
+ then
+ begin
+ Cardinal1 := IPToCardinal(StrToIP(ParamStr(1)));
+ Cardinal2 := IPToCardinal(StrToIP(ParamStr(2)));
+ // Count of Adresses to ping
+ PingCount := (Cardinal2 - Cardinal1) + 1;
+
+ // Show Adresscount to User
+ Write('Pinging ' + IntToStr(PingCount) + ' Adresses');
+ // Initialize dyn. Arrays
+ SetLength(Ping,PingCount);
+ SetLength(ThreadArray,PingCount);
+ j := 0;
+ for i := Cardinal1 to Cardinal2 do
+ begin
+ Ping[j].IPAdress := IPToStr(CardinalToIP(i));
+ Ping[j].Exists := false;
+ Inc(j);
+ end;
+
+ // Create one Thread for each Ping
+ for i := 0 to PingCount-1 do
+ begin
+ ThreadArray[i] := TPingThread.Create(Ping[i]);
+ end;
+
+ Write(' ');
+
+ // Wait till all threads are executed
+ repeat
+ ThreadsComplete := true;
+ Write('.');
+ Sleep(1000);
+ for i := 0 to PingCount-1 do
+ begin
+ if not ThreadArray[i].Ready
+ then
+ begin
+ ThreadsComplete := false;
+ break;
+ end;
+ end;
+ until ThreadsComplete;
+
+ WriteLn;
+ WriteLn;
+
+ // Show Results to User
+ for i := 0 to PingCount-1 do
+ begin
+ if ThreadArray[i].PingResult.Exists
+ then
+ begin
+ Puffer := IntToStr(i+1) + ' ' + ThreadArray[i].PingResult.IPAdress;
+ WriteLn(Puffer);
+ end;
+ end;
+
+ // Free Threads
+ for i := 0 to PingCount-1 do
+ begin
+ ThreadArray[i].Free;
+ end;
+ end
+ else
+ begin
+ WriteLn('Syntax: Scan StartIP StopIP');
+ WriteLn;
+ WriteLn('Description:');
+ WriteLn(' With Scan you can do a very fast scan of Adresses on your Network-Segment.');
+ WriteLn;
+ WriteLn('Example: scan 192.168.50.1 192.168.50.254');
+ end;
+end.
ADDED lib/synapse/source/demo/sftp/Demo/Main.dfm
Index: lib/synapse/source/demo/sftp/Demo/Main.dfm
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/sftp/Demo/Main.dfm
@@ -0,0 +1,181 @@
+object TestSFTPForm: TTestSFTPForm
+ Left = 207
+ Top = 107
+ Width = 696
+ Height = 480
+ Caption = 'Test SFTP'
+ Color = clBtnFace
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'MS Sans Serif'
+ Font.Style = []
+ OldCreateOrder = False
+ OnCreate = FormCreate
+ OnDestroy = FormDestroy
+ PixelsPerInch = 96
+ TextHeight = 13
+ object Label1: TLabel
+ Left = 8
+ Top = 8
+ Width = 22
+ Height = 13
+ Caption = 'Host'
+ end
+ object Label2: TLabel
+ Left = 284
+ Top = 8
+ Width = 19
+ Height = 13
+ Caption = 'Port'
+ end
+ object Label3: TLabel
+ Left = 8
+ Top = 32
+ Width = 26
+ Height = 13
+ Caption = 'Login'
+ end
+ object Label4: TLabel
+ Left = 192
+ Top = 32
+ Width = 46
+ Height = 13
+ Caption = 'Password'
+ end
+ object Label5: TLabel
+ Left = 8
+ Top = 64
+ Width = 48
+ Height = 13
+ Caption = 'Current dir'
+ end
+ object HostEdit: TEdit
+ Left = 48
+ Top = 4
+ Width = 209
+ Height = 21
+ TabOrder = 0
+ Text = '212.24.37.138'
+ end
+ object PortEdit: TEdit
+ Left = 316
+ Top = 4
+ Width = 49
+ Height = 21
+ TabOrder = 1
+ Text = '22'
+ end
+ object LoginEdit: TEdit
+ Left = 48
+ Top = 28
+ Width = 113
+ Height = 21
+ TabOrder = 2
+ Text = 'atv'
+ end
+ object PasswordEdit: TEdit
+ Left = 252
+ Top = 28
+ Width = 113
+ Height = 21
+ PasswordChar = '*'
+ TabOrder = 3
+ Text = 'atv04040702'
+ end
+ object CurrentDirEdit: TEdit
+ Left = 64
+ Top = 60
+ Width = 301
+ Height = 21
+ TabOrder = 5
+ end
+ object ConnectButton: TButton
+ Left = 380
+ Top = 4
+ Width = 93
+ Height = 25
+ Caption = 'Connect'
+ TabOrder = 4
+ OnClick = ConnectButtonClick
+ end
+ object FileListBox: TListBox
+ Left = 8
+ Top = 92
+ Width = 673
+ Height = 353
+ Font.Charset = RUSSIAN_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'Courier New'
+ Font.Style = []
+ ItemHeight = 14
+ ParentFont = False
+ TabOrder = 12
+ OnDblClick = FileListBoxDblClick
+ end
+ object SendFileButton: TButton
+ Left = 476
+ Top = 68
+ Width = 67
+ Height = 21
+ Caption = 'Send file...'
+ TabOrder = 7
+ OnClick = SendFileButtonClick
+ end
+ object GetFileButton: TButton
+ Left = 544
+ Top = 68
+ Width = 67
+ Height = 21
+ Caption = 'Get file'
+ TabOrder = 8
+ OnClick = GetFileButtonClick
+ end
+ object DeleteButton: TButton
+ Left = 612
+ Top = 68
+ Width = 67
+ Height = 21
+ Caption = 'Delete'
+ TabOrder = 9
+ OnClick = DeleteButtonClick
+ end
+ object ReloadButton: TButton
+ Left = 368
+ Top = 60
+ Width = 57
+ Height = 21
+ Caption = 'Reload'
+ TabOrder = 6
+ OnClick = ReloadButtonClick
+ end
+ object ProgressBar: TProgressBar
+ Left = 476
+ Top = 45
+ Width = 153
+ Height = 15
+ Min = 0
+ Max = 100
+ TabOrder = 10
+ end
+ object AbortButton: TButton
+ Left = 632
+ Top = 44
+ Width = 45
+ Height = 17
+ Caption = 'Abort'
+ TabOrder = 11
+ OnClick = AbortButtonClick
+ end
+ object OpenDialog: TOpenDialog
+ Options = [ofHideReadOnly, ofFileMustExist, ofEnableSizing]
+ Left = 492
+ Top = 12
+ end
+ object SaveDialog: TSaveDialog
+ Options = [ofOverwritePrompt, ofHideReadOnly, ofEnableSizing]
+ Left = 572
+ Top = 12
+ end
+end
ADDED lib/synapse/source/demo/sftp/Demo/Main.pas
Index: lib/synapse/source/demo/sftp/Demo/Main.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/sftp/Demo/Main.pas
@@ -0,0 +1,179 @@
+unit Main;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+ StdCtrls, SimpleSFTP, ComCtrls;
+
+type
+ TTestSFTPForm = class(TForm)
+ Label1: TLabel;
+ Label2: TLabel;
+ HostEdit: TEdit;
+ PortEdit: TEdit;
+ Label3: TLabel;
+ LoginEdit: TEdit;
+ Label4: TLabel;
+ PasswordEdit: TEdit;
+ Label5: TLabel;
+ CurrentDirEdit: TEdit;
+ ConnectButton: TButton;
+ FileListBox: TListBox;
+ DeleteButton: TButton;
+ GetFileButton: TButton;
+ SendFileButton: TButton;
+ OpenDialog: TOpenDialog;
+ SaveDialog: TSaveDialog;
+ ReloadButton: TButton;
+ ProgressBar: TProgressBar;
+ AbortButton: TButton;
+ procedure FormCreate(Sender: TObject);
+ procedure FormDestroy(Sender: TObject);
+ procedure ConnectButtonClick(Sender: TObject);
+ procedure FileListBoxDblClick(Sender: TObject);
+ procedure SendFileButtonClick(Sender: TObject);
+ procedure GetFileButtonClick(Sender: TObject);
+ procedure DeleteButtonClick(Sender: TObject);
+ procedure ReloadButtonClick(Sender: TObject);
+ procedure AbortButtonClick(Sender: TObject);
+ private
+ { Private declarations }
+ FSFTP:TSimpleSFTP;
+ FFileList:TSFTPFileList;
+ FConnected:Boolean;
+ FAbortFlag:Boolean;
+ procedure SetCurrentDir(DirName:string);
+ function TransferProgress(UserData:Pointer;Current,Total:Int64):Boolean;
+ public
+ { Public declarations }
+ end;
+
+var
+ TestSFTPForm: TTestSFTPForm;
+
+implementation
+
+{$R *.DFM}
+
+procedure TTestSFTPForm.FormCreate(Sender: TObject);
+begin
+ FSFTP:=TSimpleSFTP.Create;
+ FFileList:=TSFTPFileList.Create;
+ FConnected:=False;
+ FAbortFlag:=False;
+end;
+
+procedure TTestSFTPForm.FormDestroy(Sender: TObject);
+begin
+ FFileList.Free;
+ FSFTP.Free;
+end;
+
+procedure TTestSFTPForm.ConnectButtonClick(Sender: TObject);
+begin
+ if FConnected then
+ begin
+ FSFTP.Disconnect;
+ FConnected:=False;
+ ConnectButton.Caption:='Connect';
+ end
+ else
+ begin
+ FFileList.Clear;
+ FileListBox.Clear;
+ CurrentDirEdit.Text:='';
+ FSFTP.Connect(HostEdit.Text,PortEdit.Text,LoginEdit.Text,PasswordEdit.Text);
+ FConnected:=True;
+ ConnectButton.Caption:='Disconnect';
+ SetCurrentDir('.');
+ end;
+end;
+
+procedure TTestSFTPForm.SetCurrentDir(DirName:string);
+var i:Integer;
+begin
+ CurrentDirEdit.Text:=FSFTP.SetCurrentDir(DirName);
+ FFileList.Clear;
+ FileListBox.Clear;
+ FSFTP.ListDir(CurrentDirEdit.Text,FFileList);
+ for i:=0 to FFileList.Count-1 do FileListBox.Items.Add(FFileList[i].LongName);
+end;
+
+procedure TTestSFTPForm.ReloadButtonClick(Sender: TObject);
+begin
+ SetCurrentDir(CurrentDirEdit.Text);
+end;
+
+procedure TTestSFTPForm.FileListBoxDblClick(Sender: TObject);
+begin
+ if FileListBox.Items.Count=0 then Exit;
+ with FFileList[FileListBox.ItemIndex]^ do
+ if file_type=SSH_FILEXFER_TYPE_DIRECTORY then
+ SetCurrentDir(FileName);
+end;
+
+procedure TTestSFTPForm.AbortButtonClick(Sender: TObject);
+begin
+ FAbortFlag:=True;
+end;
+
+function TTestSFTPForm.TransferProgress(UserData:Pointer;Current,Total:Int64):Boolean;
+begin
+ if Total=0 then ProgressBar.Position:=0
+ else ProgressBar.Position:=Round(Current/Total*ProgressBar.Max);
+ Application.ProcessMessages;
+ Result:=not FAbortFlag;
+end;
+
+procedure TTestSFTPForm.SendFileButtonClick(Sender: TObject);
+begin
+ if OpenDialog.Execute then
+ begin
+ FAbortFlag:=False;
+ TransferProgress(nil,0,0);
+ FSFTP.PutFile(OpenDialog.FileName,CurrentDirEdit.Text,True,True,False,0,TransferProgress,nil);
+ ShowMessage('File transfer completed '+OpenDialog.FileName);
+ SetCurrentDir(CurrentDirEdit.Text);
+ end;
+end;
+
+procedure TTestSFTPForm.GetFileButtonClick(Sender: TObject);
+begin
+ if (FileListBox.Items.Count=0) or (FileListBox.ItemIndex<0) then Exit;
+ with FFileList[FileListBox.ItemIndex]^ do
+ if file_type=SSH_FILEXFER_TYPE_DIRECTORY then ShowMessage('Not a file')
+ else
+ begin
+ SaveDialog.FileName:=FileName;
+ if SaveDialog.Execute then
+ begin
+ FAbortFlag:=False;
+ TransferProgress(nil,0,0);
+ FSFTP.GetFile(CurrentDirEdit.Text,FileName,SaveDialog.FileName,True,True,False,0,
+ TransferProgress,nil);
+ ShowMessage('File transfer completed '+SaveDialog.FileName);
+ end;
+ end;
+end;
+
+procedure TTestSFTPForm.DeleteButtonClick(Sender: TObject);
+begin
+ if (FileListBox.Items.Count=0) then Exit;
+ with FFileList[FileListBox.ItemIndex]^ do
+ begin
+ if file_type=SSH_FILEXFER_TYPE_DIRECTORY then
+ begin
+ if MessageDlg('Delete dir ?',mtConfirmation,[mbOK,mbCancel],0)<>mrOK then Exit;
+ FSFTP.DeleteDir(FileName);
+ end
+ else
+ begin
+ if MessageDlg('Delete file ?',mtConfirmation,[mbOK,mbCancel],0)<>mrOK then Exit;
+ FSFTP.DeleteFile(FileName);
+ end;
+ end;
+ SetCurrentDir(CurrentDirEdit.Text);
+end;
+
+end.
ADDED lib/synapse/source/demo/sftp/Demo/TestSFTP.dpr
Index: lib/synapse/source/demo/sftp/Demo/TestSFTP.dpr
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/sftp/Demo/TestSFTP.dpr
@@ -0,0 +1,14 @@
+program TestSFTP;
+
+uses
+ Forms,
+ Main in 'Main.pas' {TestSFTPForm},
+ SimpleSFTP in '..\SimpleSFTP.pas';
+
+{$R *.RES}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TTestSFTPForm, TestSFTPForm);
+ Application.Run;
+end.
ADDED lib/synapse/source/demo/sftp/SimpleSFTP.pas
Index: lib/synapse/source/demo/sftp/SimpleSFTP.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/sftp/SimpleSFTP.pas
@@ -0,0 +1,1553 @@
+unit SimpleSFTP;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,ssl_cryptlib,
+ StdCtrls, blcksock, syncobjs, winsock, Math, CryptLib;
+
+// Example of SFTP client implementation. Based on
+// http://www.snailbook.com/docs/sftp.txt and PuTTY's source code.
+// Not tested carefully but directory listing and file transfer seems to work.
+// Requires cl32.dll (CryptLib) and Synapse 37b6 or newer !!!
+// If somebody knows how to extract file type information from file attributes
+// packet (I'm not sure that code in TSimpleSFTP.ParseFileNamePacket will work
+// in any case) then please let know to Sergey Gagarin (serg@screens.ru)
+
+const
+ //Really developing was started for version 6 (all constants and file
+ //attributes are from version 6, but server I've had for
+ //testing was version 3, so it was tested for version 3 only !!!
+ //Thanks to PuTTY source code, it was very usefull !
+ //Please note that not all capabilities were tested carefully !!!
+ SFTP_PROTOCOLCURRENTVERSION=3;
+
+ //sftp packet types
+ SSH_FXP_INIT =1;
+ SSH_FXP_VERSION =2;
+ SSH_FXP_OPEN =3;
+ SSH_FXP_CLOSE =4;
+ SSH_FXP_READ =5;
+ SSH_FXP_WRITE =6;
+ SSH_FXP_LSTAT =7;
+ SSH_FXP_FSTAT =8;
+ SSH_FXP_SETSTAT =9;
+ SSH_FXP_FSETSTAT =10;
+ SSH_FXP_OPENDIR =11;
+ SSH_FXP_READDIR =12;
+ SSH_FXP_REMOVE =13;
+ SSH_FXP_MKDIR =14;
+ SSH_FXP_RMDIR =15;
+ SSH_FXP_REALPATH =16;
+ SSH_FXP_STAT =17;
+ SSH_FXP_RENAME =18;
+ SSH_FXP_READLINK =19;
+ SSH_FXP_SYMLINK =20;
+ //server responce types
+ SSH_FXP_STATUS =101;
+ SSH_FXP_HANDLE =102;
+ SSH_FXP_DATA =103;
+ SSH_FXP_NAME =104;
+ SSH_FXP_ATTRS =105;
+ //extended packet types
+ SSH_FXP_EXTENDED =200;
+ SSH_FXP_EXTENDED_REPLY =201;
+// RESERVED_FOR_EXTENSIONS 210-255
+
+ //file attributes flags (for protocol version 6, but processed
+ //SSH_FILEXFER_ATTR_SIZE, SSH_FILEXFER_ATTR_PERMISSIONS
+ //and SSH_FILEXFER_ATTR_ACCESSTIME only !!! (no extensions)
+ //also flag 2 is processed but not used
+ SSH_FILEXFER_ATTR_SIZE =$00000001;
+ SSH_FILEXFER_ATTR_PERMISSIONS =$00000004;
+ SSH_FILEXFER_ATTR_ACCESSTIME =$00000008;
+ SSH_FILEXFER_ATTR_CREATETIME =$00000010;
+ SSH_FILEXFER_ATTR_MODIFYTIME =$00000020;
+ SSH_FILEXFER_ATTR_ACL =$00000040;
+ SSH_FILEXFER_ATTR_OWNERGROUP =$00000080;
+ SSH_FILEXFER_ATTR_SUBSECOND_TIMES =$00000100;
+ SSH_FILEXFER_ATTR_BITS =$00000200;
+ SSH_FILEXFER_ATTR_ALLOCATION_SIZE =$00000400;
+ SSH_FILEXFER_ATTR_TEXT_HINT =$00000800;
+ SSH_FILEXFER_ATTR_MIME_TYPE =$00001000;
+ SSH_FILEXFER_ATTR_LINK_COUNT =$00002000;
+ SSH_FILEXFER_ATTR_UNTRANLATED_NAME =$00004000;
+ SSH_FILEXFER_ATTR_EXTENDED =$80000000;
+
+ //file types (not present in version 3, but roughly "simulated"
+ //in method ParseFileNamePacket (unfortunately, permissions field seems to contain no file type info)
+ SSH_FILEXFER_TYPE_REGULAR =1;
+ SSH_FILEXFER_TYPE_DIRECTORY =2;
+ SSH_FILEXFER_TYPE_SYMLINK =3;
+ SSH_FILEXFER_TYPE_SPECIAL =4;
+ SSH_FILEXFER_TYPE_UNKNOWN =5;
+ SSH_FILEXFER_TYPE_SOCKET =6;
+ SSH_FILEXFER_TYPE_CHAR_DEVICE =7;
+ SSH_FILEXFER_TYPE_BLOCK_DEVICE =8;
+ SSH_FILEXFER_TYPE_FIFO =9;
+
+ //permissions
+ S_IRUSR =$0000400;
+ S_IWUSR =$0000200;
+ S_IXUSR =$0000100;
+ S_IRGRP =$0000040;
+ S_IWGRP =$0000020;
+ S_IXGRP =$0000010;
+ S_IROTH =$0000004;
+ S_IWOTH =$0000002;
+ S_IXOTH =$0000001;
+ S_ISUID =$0004000;
+ S_ISGID =$0002000;
+ S_ISVTX =$0001000;
+ //file type bits in permissions field
+ S_IFMT =$0170000;// bitmask for the file type bitfields
+ S_IFSOCK =$0140000;// socket
+ S_IFLNK =$0120000;// symbolic link
+ S_IFREG =$0100000;// regular file
+ S_IFBLK =$0060000;// block device
+ S_IFDIR =$0040000;// directory
+ S_IFCHR =$0020000;// character device
+ S_IFIFO =$0010000;// fifo
+
+ //file attributes
+ SSH_FILEXFER_ATTR_FLAGS_READONLY =$00000001;
+ SSH_FILEXFER_ATTR_FLAGS_SYSTEM =$00000002;
+ SSH_FILEXFER_ATTR_FLAGS_HIDDEN =$00000004;
+ SSH_FILEXFER_ATTR_FLAGS_CASE_INSENSITIVE =$00000008;
+ SSH_FILEXFER_ATTR_FLAGS_ARCHIVE =$00000010;
+ SSH_FILEXFER_ATTR_FLAGS_ENCRYPTED =$00000020;
+ SSH_FILEXFER_ATTR_FLAGS_COMPRESSED =$00000040;
+ SSH_FILEXFER_ATTR_FLAGS_SPARSE =$00000080;
+ SSH_FILEXFER_ATTR_FLAGS_APPEND_ONLY =$00000100;
+ SSH_FILEXFER_ATTR_FLAGS_IMMUTABLE =$00000200;
+ SSH_FILEXFER_ATTR_FLAGS_SYNC =$00000400;
+ SSH_FILEXFER_ATTR_FLAGS_TRANSLATION_ERR =$00000800;
+
+ //file access type
+ ACE4_READ_DATA =$00000001;
+ ACE4_LIST_DIRECTORY =$00000001;
+ ACE4_WRITE_DATA =$00000002;
+ ACE4_ADD_FILE =$00000002;
+ ACE4_APPEND_DATA =$00000004;
+ ACE4_ADD_SUBDIRECTORY =$00000004;
+ ACE4_READ_NAMED_ATTRS =$00000008;
+ ACE4_WRITE_NAMED_ATTRS =$00000010;
+ ACE4_EXECUTE =$00000020;
+ ACE4_DELETE_CHILD =$00000040;
+ ACE4_READ_ATTRIBUTES =$00000080;
+ ACE4_WRITE_ATTRIBUTES =$00000100;
+ ACE4_DELETE =$00010000;
+ ACE4_READ_ACL =$00020000;
+ ACE4_WRITE_ACL =$00040000;
+ ACE4_WRITE_OWNER =$00080000;
+ ACE4_SYNCHRONIZE =$00100000;
+
+ //open file flags
+ SSH_FXF_ACCESS_DISPOSITION = $00000007;
+ SSH_FXF_CREATE_NEW = $00000000;
+ SSH_FXF_CREATE_TRUNCATE = $00000001;
+ SSH_FXF_OPEN_EXISTING = $00000002;
+ SSH_FXF_OPEN_OR_CREATE = $00000003;
+ SSH_FXF_TRUNCATE_EXISTING = $00000004;
+ SSH_FXF_ACCESS_APPEND_DATA = $00000008;
+ SSH_FXF_ACCESS_APPEND_DATA_ATOMIC = $00000010;
+ SSH_FXF_ACCESS_TEXT_MODE = $00000020;
+ SSH_FXF_ACCESS_READ_LOCK = $00000040;
+ SSH_FXF_ACCESS_WRITE_LOCK = $00000080;
+ SSH_FXF_ACCESS_DELETE_LOCK = $00000100;
+ SSH_FXF_NOFOLLOW = $00000200;
+
+ //open file flags for protocol version 3 (as in PuTTY)
+ SSH_FXF_READ =$00000001;
+ SSH_FXF_WRITE =$00000002;
+ SSH_FXF_APPEND =$00000004;
+ SSH_FXF_CREAT =$00000008;
+ SSH_FXF_TRUNC =$00000010;
+ SSH_FXF_EXCL =$00000020;
+
+ //rename flags
+ SSH_FXP_RENAME_OVERWRITE =$00000001;
+ SSH_FXP_RENAME_ATOMIC =$00000002;
+ SSH_FXP_RENAME_NATIVE =$00000004;
+
+ //error codes
+ SSH_FX_OK =0;
+ SSH_FX_EOF =1;
+ SSH_FX_NO_SUCH_FILE =2;
+ SSH_FX_PERMISSION_DENIED =3;
+ SSH_FX_FAILURE =4;
+ SSH_FX_BAD_MESSAGE =5;
+ SSH_FX_NO_CONNECTION =6;
+ SSH_FX_CONNECTION_LOST =7;
+ SSH_FX_OP_UNSUPPORTED =8;
+ SSH_FX_INVALID_HANDLE =9;
+ SSH_FX_NO_SUCH_PATH =10;
+ SSH_FX_FILE_ALREADY_EXISTS =11;
+ SSH_FX_WRITE_PROTECT =12;
+ SSH_FX_NO_MEDIA =13;
+ SSH_FX_NO_SPACE_ON_FILESYSTEM =14;
+ SSH_FX_QUOTA_EXCEEDED =15;
+ SSH_FX_UNKNOWN_PRINCIPLE =16;
+ SSH_FX_LOCK_CONFlICT =17;
+ SSH_FX_DIR_NOT_EMPTY =18;
+ SSH_FX_NOT_A_DIRECTORY =19;
+ SSH_FX_INVALID_FILENAME =20;
+ SSH_FX_LINK_LOOP =21;
+
+type
+ TSimpleSFTP=class;//main class
+
+ TSFTPFileAttributes=record //complete structure for protocol version 6
+ FileName:string;
+ LongName:string;//present in version 3 only !
+ valid_attribute_flags:DWORD;
+ file_type:byte;// always present
+ size:int64;// present only if flag SIZE
+ allocation_size:int64;// present only if flag ALLOCATION_SIZE
+ owner:string;// present only if flag OWNERGROUP
+ group:string;// present only if flag OWNERGROUP
+ permissions:DWORD;// present only if flag PERMISSIONS
+ atime:int64;// present only if flag ACCESSTIME
+ atime_nseconds:DWORD;// present only if flag SUBSECOND_TIMES
+ createtime:int64;// present only if flag CREATETIME
+ createtime_nseconds:DWORD;// present only if flag SUBSECOND_TIMES
+ mtime:int64;// present only if flag MODIFYTIME
+ mtime_nseconds:DWORD;// present only if flag SUBSECOND_TIMES
+ acl:string;// present only if flag ACL
+ attrib_bits:DWORD;// present only if flag BITS
+ text_hint:byte;// present only if flag TEXT_HINT
+ mime_type:string;// present only if flag MIME_TYPE
+ link_count:DWORD;// present only if flag LINK_COUNT
+ untranslated_name:string;// present only if flag UNTRANSLATED_NAME
+ extended_count:DWORD;// present only if flag EXTENDED - parsed but not used here !
+// extended_type:string;// not used here !
+// extended_data:string;//
+ end;
+ PSFTPFileAttributes=^TSFTPFileAttributes;
+ //'atime', 'createtime', and 'mtime' - seconds from Jan 1, 1970 in UTC
+
+ TSFTPFileList=class(TObject)
+ protected
+ FList:TList;
+ function GetFile(i:Integer):PSFTPFileAttributes;
+ public
+ constructor Create;
+ destructor Destroy;override;
+ procedure Clear;
+ function Count:Integer;
+ procedure Add(FileRecord:TSFTPFileAttributes);
+ procedure Delete(i:Integer);
+ procedure Exchange(i,j:Integer);
+ procedure Sort(Compare:TListSortCompare);
+
+ property Files[i:Integer]:PSFTPFileAttributes read GetFile;default;
+ end;
+
+ TSimpleSFTPProgressCallback=function (UserData:Pointer;
+ Current,Total:Int64):Boolean of object;//returns False to abort
+ TSimpleSMPTEvent=procedure (Sender:TSimpleSFTP) of object;
+
+ TSimpleSFTP=class(TObject)
+ private
+ //just utils to set file times for local files
+ procedure GetLocalFileTimes(FileName:string;var AccessTime,CreateTime,ModifyTime:Int64);
+ procedure SetLocalFileTimes(FileName:string;AccessTime,CreateTime,ModifyTime:Int64);
+ //The only way we read server's data ! Do not use other socket read operations !
+ procedure ReceiveBuffer(Buffer:PChar;BufferSize:Integer);
+ protected
+ FSocket:TTCPBlockSocket;
+ FTimeout:DWORD;// timeout for data waitng (miliseconds)
+ FProtocolVersion:DWORD;
+ FRequestID:DWORD;
+ FEndOfLine:string;//processed but not used
+ FBufferSize:DWORD;
+ FRemotePathSeparator:string;
+ FCurrentDir:string;
+
+ procedure DoError(ErrorMessage:string);
+ procedure ResetSessionParams;
+ //file names and attributes processing
+ function ValidateRemoteDirName(RemoteDir:string):string;
+ function ParseFileNamePacket(FileList:TSFTPFileList;PacketData:string;ProcessAttributes:Boolean=True):Integer;
+ function ParseFileAttributes(AtributesString:string;var FieldOffset:Integer):TSFTPFileAttributes;
+ function BuildAttributesString(FileAttributes:PSFTPFileAttributes):string;
+ function BuildBlankAttributesString(IsDir:Boolean=False):string;
+ //sftp packet constructing and parsing
+ function BuildPacket(PaketType:Byte;Data:array of Pointer;DataSize:array of DWORD;
+ IsFixedSize:array of Boolean;SendRequestID:Boolean=True):string;
+ procedure AddDataToPacket(var PacketString:string;Data:array of Pointer;
+ DataSize:array of DWORD;IsFixedSize:array of Boolean);//to build packet step by step
+ function ParsePacketStrings(Data:string;Offset:Integer=0):TStringList;
+ function GetStatus(PacketData:string):DWORD;//get status from server's SSH_FXP_STATUS packet
+ function CheckStatus(PacketType:DWORD;PacketData:string;ErrorString:string):Boolean;
+
+ procedure SendPacket(Packet:string);
+ function ReceivePacket(RequestID:DWORD;var PacketType:Byte;ReceiveRequestID:Boolean=True):string;
+
+ procedure Init;
+ //internal file/dir operations
+ function SetRealPath(DirName:string):string;
+ function OpenFile(FileName:string;FileOpenFlags:DWORD):string;
+ function CloseFile(FileHandle:string):Boolean;
+ function OpenDir(DirName:string):string;
+ function CloseDir(DirHandle:string):Boolean;
+ function ReadFile(FileHandle:string;FileOffset:Int64;ReadSize:DWORD):string;
+ procedure WriteFile(FileHandle:string;FileOffset:Int64;FileData:Pointer;DataSize:DWORD);
+ procedure ReadDir(DirHandle:string;FileList:TSFTPFileList);
+ //internal file attributes operations
+ procedure InternalGetFileAtributes(PacketType:BYTE;FileID:string;//name or handle
+ AttributeFlags:DWORD;var Attributes:TSFTPFileAttributes);
+ procedure GetFileAtributesByHandle(FileHandle:string;var Attributes:TSFTPFileAttributes);
+ procedure SetFileAtributesByHandle(FileHandle:string;Attributes:PSFTPFileAttributes);
+ procedure GetFileTimesByHandle(FileHandle:string;var AccessTime,CreateTime,ModifyTime:Int64);
+ procedure SetFileTimesByHandle(FileHandle:string;AccessTime,CreateTime,ModifyTime:Int64);
+ function GetFileSizeByHandle(FileHandle:string):Int64;
+ public
+ constructor Create;virtual;
+ destructor Destroy;override;
+
+ procedure Connect(Host,Port,UserName,Password:string);
+ procedure Disconnect;
+
+ //file operation
+ function PutFile(LocalFileName,RemoteDir:string;PreserveFileTimes:Boolean=True;Overwrite:Boolean=True;
+ Append:Boolean=False;SourceStartPos:Int64=0;Callback:TSimpleSFTPProgressCallback=nil;UserData:Pointer=nil):Int64;
+ function GetFile(RemoteDir,RemoteFileName,LocalFileName:string;PreserveFileTimes:Boolean=True;Overwrite:Boolean=True;
+ Append:Boolean=False;SourceStartPos:Int64=0;Callback:TSimpleSFTPProgressCallback=nil;UserData:Pointer=nil):Int64;
+ procedure DeleteFile(FileName:string);
+ procedure RenameFile(OldName,NewName:string;FailIfExists:Boolean);
+ function FileExists(FileName:string):Boolean;
+
+ //dir operation (not all tested :-) )
+ function GetCurrentDir:string;
+ function SetCurrentDir(DirName:string):string;
+ procedure ListDir(DirName:string;FileList:TSFTPFileList);
+ procedure CreateDir(DirName:string;Attributes:PSFTPFileAttributes=nil);
+ procedure DeleteDir(DirName:string);
+
+ //file attributes opearations
+ procedure GetFileAtributes(FileName:string;var Attributes:TSFTPFileAttributes;FollowLink:Boolean=True);
+ procedure SetFileAtributes(FileName:string;Attributes:PSFTPFileAttributes);
+ procedure GetFileTimes(FileName:string;var AccessTime,CreateTime,ModifyTime:Int64);
+ procedure SetFileTimes(FileName:string;AccessTime,CreateTime,ModifyTime:Int64);
+ function GetFileSize(FileName:string):Int64;
+
+ property Socket:TTCPBlockSocket read FSocket;
+ end;
+
+implementation
+
+const //error messages
+ STRING_NOTIMPLEMENTED='Not implemented';
+ STRING_INVALIDOUTPACKETDATA='Invalid out packet data';
+ STRING_INVALIDINPACKETDATA='Invalid in packet data';
+ STRING_UNEXPECTEDPACKETTYPE='Unexpected packet type';
+ STRING_UNABLETOINIT='Unable to init';
+ STRING_INVALIDBUFFERSIZE='Invalid buffer size';
+ STRING_INVALIDFILEPOS='Invalid file position';
+ STRING_FILETRANSFERABORTED='File transfer aborted';
+ STRING_UNABLETOOPENFILE='Unable to open file';
+ STRING_UNABLETOOPENDIR='Unable to open directory';
+ STRING_UNABLETOCLOSEHANDLE='Unable to close handle';
+ STRING_UNABLETOREADFILE='Unable to read file';
+ STRING_UNABLETOREADDIR='Unable to read directory';
+ STRING_UNABLETOWRITETOFILE='Unable to write to file';
+ STRING_UNABLETODELETEFILE='Unable to delete file';
+ STRING_UNABLETORENAMEFILE='Unable to rename file';
+ STRING_UNABLETOCREATEDIR='Unable to create directory';
+ STRING_UNABLETODELETEDIR='Unable to delete directory';
+ STRING_UNABLETOSETFILEATTRIBUTES='Unable to set file attributes';
+ STRING_INVALIDFILENAMECOUNT='Invalid file name count';
+ STRING_RECEIVETIMEOUT='Receive timeout';
+ STRING_UNEXPECTEDSSHMESSAGE='Unexpected SSH message';
+ STRING_INVALIDCHANNELID='Invalid channel ID';
+ STRING_INVALIDPROTOCOLVERSION='Invalid protocol version';
+ STRING_UNABLETOSETPATH='Unable to set path';
+ STRING_UNABLETOSETBUFFERSIZE='Unable to set buffer size';
+ STRING_UNABLETOGETFILEATTRIBUTES='Unable to get file attributes';
+ STRING_UNABLETOGETFILESIZE='Unable to get file size';
+ STRING_UNABLETOGETFILETIMES='Unable to get file times';
+ STRING_UNABLETOSETFILETIMES='Unable to set file times';
+ STRING_UNABLETORECEIVEPACKETDATA='Unable to receive packet data';
+ STRING_UNABLETOSENDPACKETDATA='Unable to receive packet data';
+ STRING_UNKNOWNERROR='Unknown error';
+
+
+//************************************************************************
+//************************ File time converting utils ********************
+//************************************************************************
+// FileTime - number of 100-nanosecond intervals since January 1, 1601
+// SFTPFileTime - number of seconds since January 1, 1970
+// day_diff=134774
+const
+ DAY_DIFF:Int64=134774;
+ SECONDS_IN_DAY:Int64=86400;
+
+function FileTimeToSFTPFileTime(FileTime:Int64):Int64;
+begin
+ Result:=(FileTime div 10000000)-DAY_DIFF*SECONDS_IN_DAY;
+end;
+
+function SFTPFileTimeToFileTime(FileTime:Int64):Int64;
+begin
+ Result:=(FileTime+DAY_DIFF*SECONDS_IN_DAY)*10000000;
+end;
+
+//************************************************************************
+//************** Some utils to work with SFTP packet fields **************
+//************************************************************************
+
+function PutDataToString(Buffer:Pointer;Size:Integer):string;
+begin
+ SetLength(Result,Size);
+ CopyMemory(@Result[1],Buffer,Size);
+end;
+
+function InvertDWORD(Value:DWORD):DWORD;//SFTP uses inverted byte order !!!
+begin
+ Result:=((Value and $FF) shl 24) or ((Value and $FF00) shl 8) or
+ ((Value and $FF0000) shr 8) or ((Value and $FF000000) shr 24);
+end;
+
+function InvertInt64(Value:Int64):Int64;
+begin
+ PDWORD(@Result)^:=InvertDWORD(PDWORD(Integer(@Value)+SizeOf(DWORD))^);
+ PDWORD(Integer(@Result)+SizeOf(DWORD))^:=InvertDWORD(PDWORD(@Value)^);
+end;
+
+function PutDWORD(Value:DWORD):string;
+begin
+ Value:=InvertDWORD(Value);
+ Result:=PutDataToString(@Value,SizeOf(Value));
+end;
+
+function GetDWORD(Buffer:Pointer):DWORD;
+begin
+ Result:=InvertDWORD(PDWORD(Buffer)^);
+end;
+
+function PutFixedPacketField(Buffer:Pointer;FieldSize:Integer):string;
+var CurDWORD:DWORD;
+begin //fixed size fields (DWORD, QWORD) are stored without field size
+ SetLength(Result,FieldSize);
+ case FieldSize of
+ SizeOf(DWORD): Result:=PutDWORD(PDWORD(Buffer)^);
+ SizeOf(Int64):
+ Result:=PutDWORD(PDWORD(PChar(Buffer)+SizeOf(DWORD))^)+PutDWORD(PDWORD(Buffer)^);
+ else Result:=PutDataToString(Buffer,FieldSize);
+ end;
+end;
+
+function PutStringPacketField(Buffer:string):string;
+begin //string fields are stored with their length
+ Result:=PutDWORD(Length(Buffer))+Buffer;
+end;
+
+procedure GetFixedPacketField(PacketData:string;var FieldOffset:Integer;
+ Buffer:Pointer;FieldSize:Integer);
+var CurDWORD:DWORD;
+begin
+ case FieldSize of
+ SizeOf(DWORD):
+ begin
+ CurDWORD:=GetDWORD(@PacketData[FieldOffset]);
+ CopyMemory(Buffer,@CurDWORD,SizeOf(DWORD));
+ end;
+ SizeOf(Int64):
+ begin
+ CurDWORD:=GetDWORD(@PacketData[FieldOffset]);
+ CopyMemory(PChar(Buffer)+SizeOf(DWORD),@CurDWORD,SizeOf(DWORD));
+ CurDWORD:=GetDWORD(@PacketData[FieldOffset+SizeOf(DWORD)]);
+ CopyMemory(Buffer,@CurDWORD,SizeOf(DWORD));
+ end;
+ else CopyMemory(Buffer,@PacketData[FieldOffset],FieldSize);
+ end;
+ Inc(FieldOffset,FieldSize);
+end;
+
+function GetStringPacketField(PacketData:string;var FieldOffset:Integer):string;
+var FieldSize:DWORD;
+begin
+ FieldSize:=GetDWORD(@PacketData[FieldOffset]);
+ Inc(FieldOffset,SizeOf(FieldSize));
+ SetLength(Result,FieldSize);
+ CopyMemory(@Result[1],@PacketData[FieldOffset],FieldSize);
+ Inc(FieldOffset,FieldSize);
+end;
+
+//****************************************************************
+//*********************** TSFTPFileList **************************
+//****************************************************************
+// list of file names and attributes
+
+constructor TSFTPFileList.Create;
+begin
+ inherited Create;
+ FList:=TList.Create;
+end;
+
+destructor TSFTPFileList.Destroy;
+begin
+ Clear;
+ FList.Free;
+ inherited Destroy;
+end;
+
+function TSFTPFileList.GetFile(i:Integer):PSFTPFileAttributes;
+begin
+ Result:=PSFTPFileAttributes(FList[i]);
+end;
+
+procedure TSFTPFileList.Clear;
+var i:Integer;
+begin
+ for i:=FList.Count-1 downto 0 do Delete(i);
+end;
+
+function TSFTPFileList.Count:Integer;
+begin
+ Result:=FList.Count;
+end;
+
+procedure TSFTPFileList.Add(FileRecord:TSFTPFileAttributes);
+var NewRecord:PSFTPFileAttributes;
+begin
+ New(NewRecord);
+ NewRecord^:=FileRecord;
+ FList.Add(NewRecord);
+end;
+
+procedure TSFTPFileList.Delete(i:Integer);
+begin
+ Dispose(PSFTPFileAttributes(FList[i]));
+ FList.Delete(i);
+end;
+
+procedure TSFTPFileList.Exchange(i,j:Integer);
+begin
+ FList.Exchange(i,j);
+end;
+
+procedure TSFTPFileList.Sort(Compare:TListSortCompare);
+begin
+ FList.Sort(Compare);
+end;
+
+//************************************************************************
+//****************************** TSimpleSFTP *****************************
+//************************************************************************
+
+constructor TSimpleSFTP.Create;
+begin
+ inherited Create;
+ FSocket:=TTCPBlockSocket.CreateWithSSL(TSSLCryptLib);
+ FSocket.RaiseExcept:=True;
+ FTimeout:=60000;
+ ResetSessionParams;
+end;
+
+destructor TSimpleSFTP.Destroy;
+begin
+ Disconnect;
+ try
+ FSocket.Free;
+ except
+ end;
+ inherited Destroy;
+end;
+
+procedure TSimpleSFTP.DoError(ErrorMessage:string);
+begin
+ if Trim(ErrorMessage)='' then ErrorMessage:=STRING_UNKNOWNERROR;
+ raise Exception.Create(ErrorMessage);
+end;
+
+procedure TSimpleSFTP.ResetSessionParams;
+begin
+ FProtocolVersion:=SFTP_PROTOCOLCURRENTVERSION;
+ FRequestID:=5;
+ FEndOfLine:=#13#10;
+ FBufferSize:=32768;
+ FRemotePathSeparator:='/';
+ FCurrentDir:='.';
+end;
+
+procedure TSimpleSFTP.Connect(Host,Port,UserName,Password:string);
+var NoDelay:Boolean;
+begin //setup proxy settings, ... before connecting
+ FSocket.RaiseExcept:=True;
+ try
+ FSocket.Connect(Host,Port);
+ //CryptLib manual recommends to disable the Nagle algorithm
+ NoDelay:=True;
+ setsockopt(FSocket.Socket,IPPROTO_TCP,TCP_NODELAY,@NoDelay,SizeOf(NoDelay));
+ //do ssh handshake
+ FSocket.SSL.SSLType:=LT_SSHv2;
+ FSocket.SSL.Username:=UserName;
+ FSocket.SSL.Password:=Password;
+ FSocket.SSL.SSHChannelType:='subsystem';
+ FSocket.SSL.SSHChannelArg1:='sftp';
+ FSocket.SSLDoConnect;
+ //negotiate protocol version
+ ResetSessionParams;
+ Init;
+ except
+ Disconnect;
+ raise;
+ end;
+end;
+
+procedure TSimpleSFTP.Disconnect;
+begin
+ try
+ FSocket.RaiseExcept:=False;
+ if FSocket.Socket<>INVALID_SOCKET then FSocket.CloseSocket;
+ except
+ end;
+end;
+
+procedure TSimpleSFTP.GetLocalFileTimes(FileName:string;var AccessTime,CreateTime,ModifyTime:Int64);
+var Handle:THandle;
+begin //CreateTime is not used in version 3
+ CreateTime:=0;
+ AccessTime:=0;
+ ModifyTime:=0;
+ Handle:=CreateFile(PChar(FileName),GENERIC_READ,FILE_SHARE_READ+FILE_SHARE_WRITE,nil,OPEN_EXISTING,0,0);
+ try
+ if Handle=INVALID_HANDLE_VALUE then DoError(STRING_UNABLETOGETFILETIMES+': '+FileName);
+ if not Windows.GetFileTime(Handle,@CreateTime,@AccessTime,@ModifyTime) then Exit;
+ CreateTime:=FileTimeToSFTPFileTime(CreateTime);
+ AccessTime:=FileTimeToSFTPFileTime(AccessTime);
+ ModifyTime:=FileTimeToSFTPFileTime(ModifyTime);
+ finally
+ CloseHandle(Handle);
+ end;
+end;
+
+procedure TSimpleSFTP.SetLocalFileTimes(FileName:string;AccessTime,CreateTime,ModifyTime:Int64);
+var Handle:THandle;AccessTimeP,CreateTimeP,ModifyTimeP:Pointer;
+begin //CreateTime is not used in version 3 (may be set CreateTime:=ModifyTime ?)
+ if CreateTime<>0 then CreateTime:=SFTPFileTimeToFileTime(CreateTime);
+ if AccessTime<>0 then AccessTime:=SFTPFileTimeToFileTime(AccessTime);
+ if ModifyTime<>0 then ModifyTime:=SFTPFileTimeToFileTime(ModifyTime);
+ if AccessTime=0 then AccessTimeP:=nil else AccessTimeP:=@AccessTime;
+ if CreateTime=0 then CreateTimeP:=nil else CreateTimeP:=@CreateTime;
+ if ModifyTime=0 then ModifyTimeP:=nil else ModifyTimeP:=@ModifyTime;
+ Handle:=CreateFile(PChar(FileName),GENERIC_WRITE,FILE_SHARE_READ+FILE_SHARE_WRITE,nil,OPEN_EXISTING,0,0);
+ try
+ if Handle=INVALID_HANDLE_VALUE then DoError(STRING_UNABLETOSETFILETIMES+': '+FileName);
+ if not Windows.SetFileTime(Handle,CreateTimeP,AccessTimeP,ModifyTimeP) then Exit;
+ finally
+ CloseHandle(Handle);
+ end;
+end;
+
+function TSimpleSFTP.BuildPacket(PaketType:Byte;Data:array of Pointer;
+ DataSize:array of DWORD;IsFixedSize:array of Boolean;SendRequestID:Boolean=True):string;
+var i:Integer;CurField:string;FieldSize:DWORD;
+begin //always increases FRequestID !
+ if (Length(Data)<>Length(DataSize)) or (Length(Data)<>Length(IsFixedSize))
+ then DoError(STRING_INVALIDOUTPACKETDATA);
+ Result:='';
+ //store packet fields
+ for i:=Low(Data) to High(Data) do
+ begin
+ FieldSize:=DataSize[i];
+ if FieldSize>0 then
+ begin
+ CurField:=PutDataToString(Data[i],FieldSize);
+ //if not IsFixedSize then store field size too
+ if not IsFixedSize[i] then CurField:=PutDWORD(FieldSize)+CurField;
+ Result:=Result+CurField;
+ end;
+ end;
+ //store packet request id
+ if SendRequestID then Result:=PutDWORD(FRequestID)+Result;
+ //store packet type
+ Result:=Char(PaketType)+Result;
+ //store packet size
+ Result:=PutDWORD(Length(Result))+Result;
+ Inc(FRequestID);
+end;
+
+procedure TSimpleSFTP.AddDataToPacket(var PacketString:string;Data:array of Pointer;
+ DataSize:array of DWORD;IsFixedSize:array of Boolean);
+var i:Integer;CurField:string;FieldSize:DWORD;
+begin //just add field to packet string (not increases FRequestID , but modifies packet size)
+ if (Length(Data)<>Length(DataSize)) or (Length(Data)<>Length(IsFixedSize))
+ or (PacketString='') then DoError(STRING_INVALIDOUTPACKETDATA);
+ //store packet fields
+ for i:=Low(Data) to High(Data) do
+ begin
+ FieldSize:=DataSize[i];
+ if FieldSize>0 then
+ begin
+ CurField:=PutDataToString(Data[i],FieldSize);
+ if not IsFixedSize[i] then CurField:=PutDWORD(FieldSize)+CurField;
+ PacketString:=PacketString+CurField;
+ end;
+ end;
+ //set new packet size
+ FieldSize:=Length(PacketString);
+ CopyMemory(@PacketString[1],@FieldSize,SizeOf(FieldSize));
+end;
+
+function TSimpleSFTP.ParsePacketStrings(Data:string;Offset:Integer=0):TStringList;
+var CurPos,CurSize:DWORD;
+begin //assumed that packet contains string fields only starting from Offset
+ if Offset>0 then Data:=Copy(Data,Offset,Length(Data));
+ Result:=TStringList.Create;
+ try
+ CurPos:=1;
+ while CurPos<(Length(Data)-SizeOf(CurSize)+1) do
+ begin
+ CurSize:=GetDWORD(@Data[CurPos]);
+ Result.Add(Copy(Data,CurPos+SizeOf(CurSize),CurSize));
+ CurPos:=CurPos+SizeOf(CurSize)+CurSize;
+ end;
+ except
+ Result.Free;
+ raise;
+ end;
+end;
+
+procedure TSimpleSFTP.SendPacket(Packet:string);
+var SentLength,CurDataSize:Integer;StartTime:DWORD;
+begin
+ FSocket.SendBuffer(@Packet[1],Length(Packet));
+end;
+
+procedure TSimpleSFTP.ReceiveBuffer(Buffer:PChar;BufferSize:Integer);
+begin
+ FSocket.RecvBufferEx(Buffer,BufferSize,FTimeout);
+end;
+
+function TSimpleSFTP.ReceivePacket(RequestID:DWORD;var PacketType:Byte;ReceiveRequestID:Boolean=True):string;
+var PacketSize,CurRequestID,CurSize,CurDataSize:DWORD;PacketData:string;CurPacketType:BYTE;
+ CurData:AnsiString;StartTime:DWORD;ReceivedLength:Integer;CurBuffer:string;
+begin
+ Result:='';
+ while True do
+ begin
+ //receive packet size
+ ReceiveBuffer(@PacketSize,SizeOf(PacketSize));
+ PacketSize:=GetDWORD(@PacketSize);
+ //receive packet type
+ ReceiveBuffer(@CurPacketType,SizeOf(CurPacketType));
+ CurSize:=SizeOf(CurPacketType);
+ //receive request id
+ if ReceiveRequestID then
+ begin
+ ReceiveBuffer(@CurRequestID,SizeOf(CurRequestID));
+ CurRequestID:=GetDWORD(@CurRequestID);
+ CurSize:=CurSize+SizeOf(CurRequestID);
+ end;
+ //receive packet data
+ SetLength(Result,PacketSize-CurSize);
+ ReceiveBuffer(@Result[1],Length(Result));
+ //check RequestID and PacketType (-1 and 0 means any ...)
+ if (not ReceiveRequestID) or (RequestID=-1) or (RequestID=CurRequestID) then
+ begin
+ if (PacketType<>0) and (PacketType<>CurPacketType) then
+ DoError(STRING_UNEXPECTEDPACKETTYPE+': '+IntToStr(PacketType)+'<>'+IntToStr(CurPacketType));
+ PacketType:=CurPacketType;
+ Break;
+ end;
+ end;
+end;
+
+procedure TSimpleSFTP.Init;
+var PacketData:string;PacketStrings:TStringList;i,FieldOffset:Integer;PacketType:Byte;
+ TmpProtocolVersion,CurProtocolVersion:DWORD;
+begin //negotiate protocol version (we support version 3 only!)
+ PacketType:=SSH_FXP_INIT;
+ TmpProtocolVersion:=InvertDWORD(FProtocolVersion);
+ SendPacket(BuildPacket(PacketType,[@TmpProtocolVersion],[SizeOf(TmpProtocolVersion)],[True],False));
+ PacketType:=SSH_FXP_VERSION;
+ PacketData:=ReceivePacket(FRequestID-1,PacketType,False);
+ FieldOffset:=1;
+ //get protocol version
+ GetFixedPacketField(PacketData,FieldOffset,@CurProtocolVersion,SizeOf(CurProtocolVersion));
+ if FProtocolVersionFRemotePathSeparator then
+ DirName:=ValidateRemoteDirName(FCurrentDir)+DirName;
+ Result:=SetRealPath(DirName);
+ //try open new dir (just to check if it exists)
+ DirHandle:=OpenDir(Result);
+ CloseDir(DirHandle);
+ FCurrentDir:=Result;
+end;
+
+function TSimpleSFTP.GetCurrentDir:string;
+begin
+ Result:=SetCurrentDir('.');
+end;
+
+function TSimpleSFTP.SetRealPath(DirName:string):string;
+var PacketType:BYTE;PacketString,PacketData:string;FileList:TSFTPFileList;
+begin
+ PacketType:=SSH_FXP_REALPATH;
+ DirName:=DirName;
+ PacketString:=BuildPacket(PacketType,[@DirName[1]],[Length(DirName)],[False]);
+ SendPacket(PacketString);
+ PacketType:=0;
+ PacketData:=ReceivePacket(FRequestID-1,PacketType,True);
+ CheckStatus(PacketType,PacketData,STRING_UNABLETOSETPATH+': '+DirName);
+ if PacketType<>SSH_FXP_NAME then DoError(STRING_UNABLETOSETPATH+': '+DirName);
+ FileList:=TSFTPFileList.Create;
+ try
+ ParseFileNamePacket(FileList,PacketData,False);
+ if FileList.Count=0 then DoError(STRING_UNABLETOSETPATH+': '+DirName);
+ Result:=FileList[0].FileName;
+ finally
+ FileList.Free;
+ end;
+end;
+
+function TSimpleSFTP.FileExists(FileName:string):Boolean;
+var Attributes:TSFTPFileAttributes;FileOpenFlags:DWORD;FileHandle:string;
+begin //catches exception !
+ try
+ if FProtocolVersion>3 then FileOpenFlags:=SSH_FXF_OPEN_EXISTING
+ else FileOpenFlags:=SSH_FXF_READ;
+ FileHandle:=OpenFile(FileName,FileOpenFlags);
+ CloseFile(FileHandle);
+ Result:=True;
+ except
+ Result:=False;
+ end;
+end;
+
+function TSimpleSFTP.GetFileSizeByHandle(FileHandle:string):Int64;
+var Attributes:TSFTPFileAttributes;
+begin
+ GetFileAtributesByHandle(FileHandle,Attributes);
+ if (Attributes.valid_attribute_flags and SSH_FILEXFER_ATTR_SIZE)<>0 then Result:=Attributes.size
+ else DoError(STRING_UNABLETOGETFILESIZE);
+end;
+
+function TSimpleSFTP.GetFileSize(FileName:string):Int64;
+var Attributes:TSFTPFileAttributes;
+begin
+ GetFileAtributes(FileName,Attributes);
+ if (Attributes.valid_attribute_flags and SSH_FILEXFER_ATTR_SIZE)<>0 then Result:=Attributes.size
+ else DoError(STRING_UNABLETOGETFILESIZE);
+end;
+
+procedure TSimpleSFTP.GetFileTimes(FileName:string;var AccessTime,CreateTime,ModifyTime:Int64);
+var Attributes:TSFTPFileAttributes;
+begin
+ GetFileAtributes(FileName,Attributes);
+ AccessTime:=0;
+ CreateTime:=0;
+ ModifyTime:=0;
+ if FProtocolVersion>3 then
+ begin
+ if (Attributes.valid_attribute_flags and SSH_FILEXFER_ATTR_ACCESSTIME)<>0 then
+ AccessTime:=Attributes.atime;
+ if (Attributes.valid_attribute_flags and SSH_FILEXFER_ATTR_CREATETIME)<>0 then
+ CreateTime:=Attributes.createtime;
+ if (Attributes.valid_attribute_flags and SSH_FILEXFER_ATTR_MODIFYTIME)<>0 then
+ ModifyTime:=Attributes.mtime;
+ end
+ else
+ begin
+ if (Attributes.valid_attribute_flags and SSH_FILEXFER_ATTR_ACCESSTIME)<>0 then
+ begin
+ AccessTime:=Attributes.atime;
+ ModifyTime:=Attributes.mtime;
+ end;
+ end;
+end;
+
+procedure TSimpleSFTP.GetFileTimesByHandle(FileHandle:string;var AccessTime,CreateTime,ModifyTime:Int64);
+var Attributes:TSFTPFileAttributes;
+begin
+ GetFileAtributesByHandle(FileHandle,Attributes);
+ AccessTime:=0;
+ CreateTime:=0;
+ ModifyTime:=0;
+ if FProtocolVersion>3 then
+ begin
+ if (Attributes.valid_attribute_flags and SSH_FILEXFER_ATTR_ACCESSTIME)<>0 then
+ AccessTime:=Attributes.atime;
+ if (Attributes.valid_attribute_flags and SSH_FILEXFER_ATTR_CREATETIME)<>0 then
+ CreateTime:=Attributes.createtime;
+ if (Attributes.valid_attribute_flags and SSH_FILEXFER_ATTR_MODIFYTIME)<>0 then
+ ModifyTime:=Attributes.mtime;
+ end
+ else
+ begin
+ if (Attributes.valid_attribute_flags and SSH_FILEXFER_ATTR_ACCESSTIME)<>0 then
+ begin
+ AccessTime:=Attributes.atime;
+ ModifyTime:=Attributes.mtime;
+ end;
+ end;
+end;
+
+function TSimpleSFTP.ValidateRemoteDirName(RemoteDir:string):string;
+begin //just add trailing '/' if needed
+ if (RemoteDir<>'') and (Copy(RemoteDir,Length(RemoteDir)-Length(FRemotePathSeparator)+1,
+ Length(FRemotePathSeparator))<>FRemotePathSeparator)
+ then Result:=RemoteDir+FRemotePathSeparator else Result:=RemoteDir;
+end;
+
+function TSimpleSFTP.PutFile(LocalFileName,RemoteDir:string;PreserveFileTimes:Boolean=True;Overwrite:Boolean=True;
+ Append:Boolean=False;SourceStartPos:Int64=0;Callback:TSimpleSFTPProgressCallback=nil;UserData:Pointer=nil):Int64;
+var FileHandle,Buffer:string;FileStream:TFileStream;CurrentRemoteOffset,TotalSize:Int64;CurRead:Integer;
+ FileOpenFlags:DWORD;AccessTime,CreateTime,ModifyTime:Int64;RemoteFileName:string;
+begin //returns sent size (indeed if sent size is not file size then raise exception :-) )
+ Result:=0;
+ FileOpenFlags:=0;
+ if FProtocolVersion>3 then
+ begin
+ if Overwrite then FileOpenFlags:=(FileOpenFlags or SSH_FXF_CREATE_NEW)
+ else FileOpenFlags:=(FileOpenFlags or SSH_FXF_OPEN_OR_CREATE);
+ if Append and not Overwrite then FileOpenFlags:=FileOpenFlags or SSH_FXF_ACCESS_APPEND_DATA;
+ end
+ else
+ begin //as in PuTTY
+ FileOpenFlags:=SSH_FXF_WRITE;
+ if Overwrite then FileOpenFlags:=FileOpenFlags or SSH_FXF_WRITE or SSH_FXF_CREAT;
+ if not Append then FileOpenFlags:=FileOpenFlags or SSH_FXF_TRUNC;
+ end;
+ RemoteFileName:=ValidateRemoteDirName(RemoteDir)+ExtractFileName(LocalFileName);
+ //open remote file
+ FileHandle:=OpenFile(RemoteFileName,FileOpenFlags);
+ try
+ if Append then CurrentRemoteOffset:=GetFileSizeByHandle(FileHandle) else CurrentRemoteOffset:=0;
+ if FBufferSize<=0 then DoError(STRING_INVALIDBUFFERSIZE);
+ SetLength(Buffer,FBufferSize);
+ //open local file
+ FileStream:=TFileStream.Create(LocalFileName,fmOpenRead or fmShareDenyNone);
+ try
+ TotalSize:=FileStream.Size-SourceStartPos;
+ //local file offset
+ FileStream.Seek(SourceStartPos,soFromBeginning);
+ if FileStream.Position<>SourceStartPos then
+ DoError(STRING_INVALIDFILEPOS+': '+LocalFileName+' ('+IntToStr(SourceStartPos)+')');
+ while Result0 then //write remote file
+ WriteFile(FileHandle,CurrentRemoteOffset,@Buffer[1],CurRead);
+ CurrentRemoteOffset:=CurrentRemoteOffset+CurRead;
+ Result:=Result+CurRead;
+ if CurRead3 then FileOpenFlags:=SSH_FXF_OPEN_EXISTING
+ else FileOpenFlags:=SSH_FXF_READ;
+ RemoteFileName:=ValidateRemoteDirName(RemoteDir)+RemoteFileName;
+ //open remote file
+ FileHandle:=OpenFile(RemoteFileName,FileOpenFlags);
+ try
+ if FBufferSize<=0 then DoError(STRING_INVALIDBUFFERSIZE);
+ FileOpenFlags:=0;
+ if Overwrite then
+ begin
+ SysUtils.DeleteFile(LocalFileName);
+ FileOpenFlags:=fmCreate;
+ end
+ else FileOpenFlags:=fmOpenWrite;
+ //open local file
+ FileStream:=TFileStream.Create(LocalFileName,FileOpenFlags);
+ try
+ //local file offset
+ if Append and not Overwrite then FileStream.Seek(0,soFromEnd);
+ //remote file size
+ TotalSize:=GetFileSizeByHandle(FileHandle)-SourceStartPos;
+ if TotalSize<0 then DoError(STRING_INVALIDFILEPOS+': '+RemoteFileName+' ('+IntToStr(SourceStartPos)+')');
+ while Result0 then //write local file
+ FileStream.Write(Buffer[1],CurRead);
+ Inc(SourceStartPos,CurRead);
+ Inc(Result,CurRead);
+ if CurRead3 then FileAccessSize:=SizeOf(FileAccess) else FileAccessSize:=0;
+ FileAccess:=ACE4_WRITE_DATA+ACE4_WRITE_ATTRIBUTES;
+ AtributesString:=BuildBlankAttributesString;
+ FileAccess:=InvertDWORD(FileAccess);
+ FileOpenFlags:=InvertDWORD(FileOpenFlags);
+ PacketString:=BuildPacket(PacketType,[@FileName[1],@FileAccess,@FileOpenFlags,@AtributesString[1]],
+ [Length(FileName),FileAccessSize,SizeOf(FileOpenFlags),Length(AtributesString)],
+ [False,True,True,True]);
+ SendPacket(PacketString);
+ PacketType:=0;
+ PacketData:=ReceivePacket(FRequestID-1,PacketType);
+ CheckStatus(PacketType,PacketData,STRING_UNABLETOOPENFILE+': '+FileName);
+ if (PacketType<>SSH_FXP_HANDLE) then DoError(STRING_UNABLETOOPENFILE+': '+FileName);
+ //get file handle
+ FieldOffset:=1;
+ Result:=GetStringPacketField(PacketData,FieldOffset);
+end;
+
+function TSimpleSFTP.OpenDir(DirName:string):string;
+var PacketType:BYTE;PacketString,PacketData:string;FieldOffset:Integer;
+begin
+ PacketType:=SSH_FXP_OPENDIR;
+ PacketString:=BuildPacket(PacketType,[@DirName[1]],[Length(DirName)],[False]);
+ SendPacket(PacketString);
+ PacketType:=0;
+ PacketData:=ReceivePacket(FRequestID-1,PacketType);
+ CheckStatus(PacketType,PacketData,STRING_UNABLETOOPENDIR+': '+DirName);
+ if (PacketType<>SSH_FXP_HANDLE) then DoError(STRING_UNABLETOOPENDIR+': '+DirName);
+ //get dir handle
+ FieldOffset:=1;
+ Result:=GetStringPacketField(PacketData,FieldOffset);
+end;
+
+function TSimpleSFTP.CloseFile(FileHandle:string):Boolean;
+var PacketType:BYTE;PacketString,PacketData:string;
+begin
+ PacketType:=SSH_FXP_CLOSE;
+ PacketString:=BuildPacket(PacketType,[@FileHandle[1]],[Length(FileHandle)],[False]);
+ SendPacket(PacketString);
+ PacketType:=0;
+ PacketData:=ReceivePacket(FRequestID-1,PacketType);
+ CheckStatus(PacketType,PacketData,STRING_UNABLETOCLOSEHANDLE+': '+FileHandle);
+ Result:=True;
+end;
+
+function TSimpleSFTP.CloseDir(DirHandle:string):Boolean;
+begin
+ Result:=CloseFile(DirHandle);
+end;
+
+function TSimpleSFTP.ReadFile(FileHandle:string;FileOffset:Int64;ReadSize:DWORD):string;
+var PacketType:BYTE;PacketString,PacketData:string;FieldOffset:Integer;
+begin
+ Result:='';
+ PacketType:=SSH_FXP_READ;
+ FileOffset:=InvertInt64(FileOffset);
+ ReadSize:=InvertDWORD(ReadSize);
+ PacketString:=BuildPacket(PacketType,[@FileHandle[1],@FileOffset,@ReadSize],
+ [Length(FileHandle),SizeOf(FileOffset),SizeOf(ReadSize)],[False,True,True]);
+ SendPacket(PacketString);
+ PacketType:=0;
+ PacketData:=ReceivePacket(FRequestID-1,PacketType);
+ case PacketType of
+ SSH_FXP_STATUS:
+ begin //server can say "EOF" or error
+ if GetStatus(PacketData)=SSH_FX_EOF then Exit
+ else CheckStatus(PacketType,PacketData,STRING_UNABLETOREADFILE+': '+FileHandle);
+ end;
+ SSH_FXP_DATA:
+ begin
+ FieldOffset:=1;
+ Result:=GetStringPacketField(PacketData,FieldOffset);
+ end;
+ else DoError(STRING_UNABLETOREADFILE+': '+FileHandle);
+ end;
+end;
+
+procedure TSimpleSFTP.ReadDir(DirHandle:string;FileList:TSFTPFileList);
+var PacketType:BYTE;PacketString,PacketData:string;
+begin
+ FileList.Clear;
+ PacketType:=SSH_FXP_READDIR;
+ PacketString:=BuildPacket(PacketType,[@DirHandle[1]],[Length(DirHandle)],[False]);
+ while True do
+ begin
+ SendPacket(PacketString);
+ PacketType:=0;
+ PacketData:=ReceivePacket(FRequestID-1,PacketType);
+ case PacketType of
+ SSH_FXP_STATUS:
+ begin //server can say "EOF" or error
+ if GetStatus(PacketData)=SSH_FX_EOF then Break
+ else CheckStatus(PacketType,PacketData,STRING_UNABLETOREADDIR+': '+DirHandle);
+ end;
+ SSH_FXP_NAME:
+ begin //PacketData can contain 1 or more file info
+ ParseFileNamePacket(FileList,PacketData);
+ end;
+ else DoError(STRING_UNABLETOREADDIR+': '+DirHandle+' ('+STRING_UNEXPECTEDPACKETTYPE+
+ ' '+IntToStr(PacketType)+')');
+ end;
+ end;
+end;
+
+function TSimpleSFTP.ParseFileNamePacket(FileList:TSFTPFileList;PacketData:string;
+ ProcessAttributes:Boolean=True):Integer;
+var NameCount,i:DWORD;FileAttributes:TSFTPFileAttributes;FileName,LongName:string;FieldOffset:Integer;
+begin //returns count of file records added to FileList
+ Result:=0;
+ FieldOffset:=1;
+ //get file record count
+ GetFixedPacketField(PacketData,FieldOffset,@NameCount,SizeOf(NameCount));
+ //get names and attributes
+ for i:=1 to NameCount do
+ begin
+ FileName:=GetStringPacketField(PacketData,FieldOffset);
+ if FProtocolVersion<=3 then LongName:=GetStringPacketField(PacketData,FieldOffset);
+ if ProcessAttributes then FileAttributes:=ParseFileAttributes(PacketData,FieldOffset);
+ FileAttributes.FileName:=FileName;
+ if (FileAttributes.permissions and S_IFMT)<>0 then
+ begin //we trying to check file type bits in permissions, but it seems to contain no file type bits
+ if (FileAttributes.permissions and S_IFLNK)<>0 then FileAttributes.file_type:=SSH_FILEXFER_TYPE_SYMLINK
+ else if (FileAttributes.permissions and S_IFREG)<>0 then FileAttributes.file_type:=SSH_FILEXFER_TYPE_REGULAR
+ else if (FileAttributes.permissions and S_IFDIR)<>0 then FileAttributes.file_type:=SSH_FILEXFER_TYPE_DIRECTORY
+ else FileAttributes.file_type:=SSH_FILEXFER_TYPE_UNKNOWN;
+ end
+ else
+ begin
+ if (FProtocolVersion<=3) and (LongName<>'') then
+ begin //try to parse long file name (assumed it has the form of "ls -l" listing);
+ FileAttributes.LongName:=LongName;
+ case LongName[1] of //just simple file_type emulation :-) (it works with my server)
+ '-': FileAttributes.file_type:=SSH_FILEXFER_TYPE_REGULAR;
+ 'd': FileAttributes.file_type:=SSH_FILEXFER_TYPE_DIRECTORY;
+ 'l': FileAttributes.file_type:=SSH_FILEXFER_TYPE_SYMLINK;
+ '/': FileAttributes.file_type:=SSH_FILEXFER_TYPE_DIRECTORY;//in SetRealPath
+ else FileAttributes.file_type:=SSH_FILEXFER_TYPE_UNKNOWN;
+ end;
+ end;
+ end;
+ FileList.Add(FileAttributes);
+ Inc(Result);
+ end;
+end;
+
+procedure ResetFileAttributes(FileAttributes:PSFTPFileAttributes);
+begin
+ with FileAttributes^ do
+ begin
+ FileName:='';
+ LongName:='';
+ valid_attribute_flags:=0;
+ file_type:=0;// always present (not in version 3)
+ size:=0;// present only if flag SIZE
+ allocation_size:=0;// present only if flag ALLOCATION_SIZE
+ owner:='';// present only if flag OWNERGROUP
+ group:='';// present only if flag OWNERGROUP
+ permissions:=0;// present only if flag PERMISSIONS
+ atime:=0;// present only if flag ACCESSTIME
+ atime_nseconds:=0;// present only if flag SUBSECOND_TIMES
+ createtime:=0;// present only if flag CREATETIME
+ createtime_nseconds:=0;// present only if flag SUBSECOND_TIMES
+ mtime:=0;// present only if flag MODIFYTIME
+ mtime_nseconds:=0;// present only if flag SUBSECOND_TIMES
+ acl:='';// present only if flag ACL
+ attrib_bits:=0;// present only if flag BITS
+ text_hint:=0;// present only if flag TEXT_HINT
+ mime_type:='';// present only if flag MIME_TYPE
+ link_count:=0;// present only if flag LINK_COUNT
+ untranslated_name:='';// present only if flag UNTRANSLATED_NAME
+ extended_count:=0;// present only if flag EXTENDED
+// extended_type:string;
+// extended_data:string;
+ end;
+end;
+
+function TSimpleSFTP.ParseFileAttributes(AtributesString:string;var FieldOffset:Integer):TSFTPFileAttributes;
+var TmpInt64:Int64;TmpDWORD:DWORD;TmpString:string;i:Integer;
+ procedure CopyFixedAttribute(CopyFlag:DWORD;CopyTo:Pointer;CopySize:Integer);
+ begin
+ if (Result.valid_attribute_flags and CopyFlag)<>0 then
+ GetFixedPacketField(AtributesString,FieldOffset,CopyTo,CopySize);
+ end;
+ procedure CopyStringAttribute(CopyFlag:DWORD;var CopyTo:string);
+ begin
+ if (Result.valid_attribute_flags and CopyFlag)<>0 then
+ CopyTo:=GetStringPacketField(AtributesString,FieldOffset);
+ end;
+begin //version 3 parsing - like in PuTTY
+ ResetFileAttributes(@Result);
+ with Result do
+ begin
+ GetFixedPacketField(AtributesString,FieldOffset,@valid_attribute_flags,SizeOf(valid_attribute_flags));
+ if FProtocolVersion>3 then
+ GetFixedPacketField(AtributesString,FieldOffset,@file_type,SizeOf(file_type));
+ CopyFixedAttribute(SSH_FILEXFER_ATTR_SIZE,@size,SizeOf(size));
+ if FProtocolVersion<=3 then
+ CopyFixedAttribute(2,@TmpInt64,SizeOf(TmpInt64));
+ if FProtocolVersion>3 then
+ begin
+ CopyFixedAttribute(SSH_FILEXFER_ATTR_ALLOCATION_SIZE,@allocation_size,SizeOf(allocation_size));
+ CopyStringAttribute(SSH_FILEXFER_ATTR_OWNERGROUP,owner);
+ CopyStringAttribute(SSH_FILEXFER_ATTR_OWNERGROUP,group);
+ end;
+ CopyFixedAttribute(SSH_FILEXFER_ATTR_PERMISSIONS,@permissions,SizeOf(permissions));
+ if FProtocolVersion>3 then
+ begin
+ CopyFixedAttribute(SSH_FILEXFER_ATTR_ACCESSTIME,@atime,SizeOf(atime));
+ CopyFixedAttribute(SSH_FILEXFER_ATTR_ACCESSTIME or SSH_FILEXFER_ATTR_SUBSECOND_TIMES,@atime_nseconds,SizeOf(atime_nseconds));
+ CopyFixedAttribute(SSH_FILEXFER_ATTR_CREATETIME,@createtime,SizeOf(createtime));
+ CopyFixedAttribute(SSH_FILEXFER_ATTR_CREATETIME or SSH_FILEXFER_ATTR_SUBSECOND_TIMES,@createtime_nseconds,SizeOf(createtime_nseconds));
+ CopyFixedAttribute(SSH_FILEXFER_ATTR_MODIFYTIME,@mtime,SizeOf(mtime));
+ CopyFixedAttribute(SSH_FILEXFER_ATTR_MODIFYTIME or SSH_FILEXFER_ATTR_SUBSECOND_TIMES,@mtime_nseconds,SizeOf(mtime_nseconds));
+ end
+ else
+ begin
+ TmpDWORD:=0;
+ CopyFixedAttribute(SSH_FILEXFER_ATTR_ACCESSTIME,@TmpDWORD,SizeOf(TmpDWORD));
+ atime:=TmpDWORD;
+ TmpDWORD:=0;
+ CopyFixedAttribute(SSH_FILEXFER_ATTR_ACCESSTIME,@TmpDWORD,SizeOf(TmpDWORD));
+ mtime:=TmpDWORD;
+ end;
+ if FProtocolVersion>3 then
+ begin
+ CopyStringAttribute(SSH_FILEXFER_ATTR_ACL,acl);
+ if FProtocolVersion>4 then
+ CopyFixedAttribute(SSH_FILEXFER_ATTR_BITS,@attrib_bits,SizeOf(attrib_bits));
+ CopyFixedAttribute(SSH_FILEXFER_ATTR_TEXT_HINT,@text_hint,SizeOf(text_hint));
+ CopyStringAttribute(SSH_FILEXFER_ATTR_MIME_TYPE,mime_type);
+ CopyFixedAttribute(SSH_FILEXFER_ATTR_LINK_COUNT,@link_count,SizeOf(link_count));
+ CopyStringAttribute(SSH_FILEXFER_ATTR_UNTRANLATED_NAME,untranslated_name);
+ end;
+ extended_count:=0;
+ CopyFixedAttribute(SSH_FILEXFER_ATTR_EXTENDED,@extended_count,SizeOf(extended_count));
+ for i:=1 to extended_count do
+ begin //parsed but not used
+ GetStringPacketField(AtributesString,FieldOffset);//extended_type
+ GetStringPacketField(AtributesString,FieldOffset);//extended_data
+ end;
+ end;
+end;
+
+function TSimpleSFTP.BuildBlankAttributesString(IsDir:Boolean=False):string;
+var FileAttributes:TSFTPFileAttributes;
+begin
+ ResetFileAttributes(@FileAttributes);
+ if IsDir then FileAttributes.file_type:=SSH_FILEXFER_TYPE_DIRECTORY
+ else FileAttributes.file_type:=SSH_FILEXFER_TYPE_REGULAR;
+ Result:=BuildAttributesString(@FileAttributes);
+end;
+
+function TSimpleSFTP.BuildAttributesString(FileAttributes:PSFTPFileAttributes):string;
+var TmpInt64:Int64;TmpDWORD:DWORD;
+ procedure AddFixedAttributeString(CopyFlag:DWORD;CurAttribute:Pointer;CurSize:Integer);
+ begin
+ if (FileAttributes^.valid_attribute_flags and CopyFlag)<>0 then
+ Result:=Result+PutFixedPacketField(CurAttribute,CurSize);
+ end;
+ procedure AddStringAttributeString(CopyFlag:DWORD;CurAttribute:string);
+ begin
+ if (FileAttributes^.valid_attribute_flags and CopyFlag)<>0 then
+ Result:=Result+PutStringPacketField(CurAttribute);
+ end;
+begin //version 3 - like in PuTTY
+ Result:='';
+ with FileAttributes^ do
+ begin
+ Result:=Result+PutFixedPacketField(@valid_attribute_flags,SizeOf(valid_attribute_flags));
+ if FProtocolVersion>3 then
+ Result:=Result+PutFixedPacketField(@file_type,SizeOf(file_type));
+ AddFixedAttributeString(SSH_FILEXFER_ATTR_SIZE,@size,SizeOf(size));
+ if FProtocolVersion<=3 then
+ AddFixedAttributeString(2,@TmpInt64,SizeOf(TmpInt64));
+ if FProtocolVersion>3 then
+ begin
+ AddFixedAttributeString(SSH_FILEXFER_ATTR_ALLOCATION_SIZE,@allocation_size,SizeOf(allocation_size));
+ AddStringAttributeString(SSH_FILEXFER_ATTR_OWNERGROUP,owner);
+ AddStringAttributeString(SSH_FILEXFER_ATTR_OWNERGROUP,group);
+ end;
+ AddFixedAttributeString(SSH_FILEXFER_ATTR_PERMISSIONS,@permissions,SizeOf(permissions));
+ if FProtocolVersion>3 then
+ begin
+ AddFixedAttributeString(SSH_FILEXFER_ATTR_ACCESSTIME,@atime,SizeOf(atime));
+ AddFixedAttributeString(SSH_FILEXFER_ATTR_ACCESSTIME or SSH_FILEXFER_ATTR_SUBSECOND_TIMES,@atime_nseconds,SizeOf(atime_nseconds));
+ AddFixedAttributeString(SSH_FILEXFER_ATTR_CREATETIME,@createtime,SizeOf(createtime));
+ AddFixedAttributeString(SSH_FILEXFER_ATTR_CREATETIME or SSH_FILEXFER_ATTR_SUBSECOND_TIMES,@createtime_nseconds,SizeOf(createtime_nseconds));
+ AddFixedAttributeString(SSH_FILEXFER_ATTR_MODIFYTIME,@mtime,SizeOf(mtime));
+ AddFixedAttributeString(SSH_FILEXFER_ATTR_MODIFYTIME or SSH_FILEXFER_ATTR_SUBSECOND_TIMES,@mtime_nseconds,SizeOf(mtime_nseconds));
+ end
+ else
+ begin
+ TmpDWORD:=atime;
+ AddFixedAttributeString(SSH_FILEXFER_ATTR_ACCESSTIME,@TmpDWORD,SizeOf(TmpDWORD));
+ TmpDWORD:=mtime;
+ AddFixedAttributeString(SSH_FILEXFER_ATTR_ACCESSTIME,@TmpDWORD,SizeOf(TmpDWORD));
+ end;
+ if FProtocolVersion>3 then
+ begin
+ AddStringAttributeString(SSH_FILEXFER_ATTR_ACL,acl);
+ AddFixedAttributeString(SSH_FILEXFER_ATTR_BITS,@attrib_bits,SizeOf(attrib_bits));
+ AddFixedAttributeString(SSH_FILEXFER_ATTR_TEXT_HINT,@text_hint,SizeOf(text_hint));
+ AddStringAttributeString(SSH_FILEXFER_ATTR_MIME_TYPE,mime_type);
+ AddFixedAttributeString(SSH_FILEXFER_ATTR_LINK_COUNT,@link_count,SizeOf(link_count));
+ AddStringAttributeString(SSH_FILEXFER_ATTR_UNTRANLATED_NAME,untranslated_name);
+ end;
+ extended_count:=0;
+ AddFixedAttributeString(SSH_FILEXFER_ATTR_EXTENDED,@extended_count,SizeOf(extended_count));
+ end;
+end;
+
+procedure TSimpleSFTP.WriteFile(FileHandle:string;FileOffset:Int64;FileData:Pointer;DataSize:DWORD);
+var PacketType:BYTE;PacketString,PacketData:string;InvertedDataSize:DWORD;
+begin
+ PacketType:=SSH_FXP_WRITE;
+ FileOffset:=InvertInt64(FileOffset);
+ InvertedDataSize:=InvertDWORD(DataSize);
+ PacketString:=BuildPacket(PacketType,[@FileHandle[1],@FileOffset,@InvertedDataSize,FileData],
+ [Length(FileHandle),SizeOf(FileOffset),SizeOf(DataSize),DataSize],[False,True,True,True]);
+ SendPacket(PacketString);
+ PacketType:=SSH_FXP_STATUS;
+ PacketData:=ReceivePacket(FRequestID-1,PacketType);
+ CheckStatus(PacketType,PacketData,STRING_UNABLETOWRITETOFILE+': '+FileHandle);
+end;
+
+procedure TSimpleSFTP.DeleteFile(FileName:string);
+var PacketType:BYTE;PacketString,PacketData:string;
+begin
+ PacketType:=SSH_FXP_REMOVE;
+ PacketString:=BuildPacket(PacketType,[@FileName[1]],[Length(FileName)],[False]);
+ SendPacket(PacketString);
+ PacketType:=SSH_FXP_STATUS;
+ PacketData:=ReceivePacket(FRequestID-1,PacketType);
+ CheckStatus(PacketType,PacketData,STRING_UNABLETODELETEFILE+': '+FileName);
+end;
+
+procedure TSimpleSFTP.RenameFile(OldName,NewName:string;FailIfExists:Boolean);
+var PacketType:BYTE;PacketString,PacketData:string;RenameFlags:DWORD;
+begin
+ PacketType:=SSH_FXP_RENAME;
+ RenameFlags:=SSH_FXP_RENAME_NATIVE;
+ if not FailIfExists then RenameFlags:=RenameFlags+SSH_FXP_RENAME_OVERWRITE;
+ RenameFlags:=InvertDWORD(RenameFlags);
+ PacketString:=BuildPacket(PacketType,[@OldName[1],@NewName[1],@RenameFlags],
+ [Length(OldName),Length(NewName),SizeOf(RenameFlags)],[False,False,True]);
+ SendPacket(PacketString);
+ PacketType:=SSH_FXP_STATUS;
+ PacketData:=ReceivePacket(FRequestID-1,PacketType);
+ CheckStatus(PacketType,PacketData,STRING_UNABLETORENAMEFILE+': '+OldName+
+ ' -> '+NewName);
+end;
+
+procedure TSimpleSFTP.CreateDir(DirName:string;Attributes:PSFTPFileAttributes=nil);
+var PacketType:BYTE;PacketString,AttributesString,PacketData:string;
+begin
+ PacketType:=SSH_FXP_MKDIR;
+ if Assigned(Attributes) then AttributesString:=BuildAttributesString(Attributes)
+ else AttributesString:=BuildBlankAttributesString(True);
+ PacketString:=BuildPacket(PacketType,[@DirName[1],@AttributesString[1]],
+ [Length(DirName),Length(AttributesString)],[False,True]);
+ SendPacket(PacketString);
+ PacketType:=SSH_FXP_STATUS;
+ PacketData:=ReceivePacket(FRequestID-1,PacketType);
+ CheckStatus(PacketType,PacketData,STRING_UNABLETOCREATEDIR+': '+DirName);
+end;
+
+procedure TSimpleSFTP.DeleteDir(DirName:string);
+var PacketType:BYTE;PacketString,PacketData:string;
+begin
+ PacketType:=SSH_FXP_RMDIR;
+ PacketString:=BuildPacket(PacketType,[@DirName[1]],[Length(DirName)],[False]);
+ SendPacket(PacketString);
+ PacketType:=SSH_FXP_STATUS;
+ PacketData:=ReceivePacket(FRequestID-1,PacketType);
+ CheckStatus(PacketType,PacketData,STRING_UNABLETODELETEDIR+': '+DirName);
+end;
+
+procedure TSimpleSFTP.ListDir(DirName:string;FileList:TSFTPFileList);
+var DirHandle:string;
+begin
+ DirHandle:=OpenDir(DirName);
+ try
+ ReadDir(DirHandle,FileList);
+ finally
+ try
+ CloseDir(DirHandle);
+ except
+ end;
+ end;
+end;
+
+procedure TSimpleSFTP.InternalGetFileAtributes(PacketType:BYTE;FileID:string;//name or handle
+ AttributeFlags:DWORD;var Attributes:TSFTPFileAttributes);
+var PacketString,AttributesString,PacketData:string;FieldOffset,AttributeFlagsSize:Integer;
+begin
+ if FProtocolVersion>3 then AttributeFlagsSize:=SizeOf(AttributeFlags) else AttributeFlagsSize:=0;
+ AttributeFlags:=InvertDWORD(AttributeFlags);
+ PacketString:=BuildPacket(PacketType,[@FileID[1],@AttributeFlags],
+ [Length(FileID),AttributeFlagsSize],[False,True]);
+ SendPacket(PacketString);
+ PacketType:=0;
+ PacketData:=ReceivePacket(FRequestID-1,PacketType);
+ CheckStatus(PacketType,PacketData,STRING_UNABLETOGETFILEATTRIBUTES+': '+FileID);
+ if PacketType<>SSH_FXP_ATTRS then DoError(STRING_UNABLETOGETFILEATTRIBUTES+': '+FileID);
+ FieldOffset:=1;
+ Attributes:=ParseFileAttributes(PacketData,FieldOffset);
+end;
+
+procedure TSimpleSFTP.GetFileAtributes(FileName:string;var Attributes:TSFTPFileAttributes;FollowLink:Boolean=True);
+var PacketType:BYTE;AttributeFlags:DWORD;
+begin
+ if FollowLink then PacketType:=SSH_FXP_STAT else PacketType:=SSH_FXP_LSTAT;
+ AttributeFlags:=SSH_FILEXFER_ATTR_SIZE or SSH_FILEXFER_ATTR_PERMISSIONS
+ or SSH_FILEXFER_ATTR_ACCESSTIME;
+ InternalGetFileAtributes(PacketType,FileName,AttributeFlags,Attributes);
+end;
+
+procedure TSimpleSFTP.GetFileAtributesByHandle(FileHandle:string;var Attributes:TSFTPFileAttributes);
+var AttributeFlags:DWORD;
+begin
+ AttributeFlags:=SSH_FILEXFER_ATTR_SIZE or SSH_FILEXFER_ATTR_PERMISSIONS
+ or SSH_FILEXFER_ATTR_ACCESSTIME;
+ InternalGetFileAtributes(SSH_FXP_FSTAT,FileHandle,AttributeFlags,Attributes);
+end;
+
+procedure TSimpleSFTP.SetFileAtributes(FileName:string;Attributes:PSFTPFileAttributes);
+var PacketType:BYTE;PacketString,AttributesString,PacketData:string;
+begin
+ PacketType:=SSH_FXP_SETSTAT;
+ AttributesString:=BuildAttributesString(Attributes);
+ PacketString:=BuildPacket(PacketType,[@FileName[1],@AttributesString[1]],
+ [Length(FileName),Length(AttributesString)],[False,True]);
+ SendPacket(PacketString);
+ PacketType:=SSH_FXP_STATUS ;
+ PacketData:=ReceivePacket(FRequestID-1,PacketType);
+ CheckStatus(PacketType,PacketData,STRING_UNABLETOSETFILEATTRIBUTES+': '+FileName);
+end;
+
+procedure TSimpleSFTP.SetFileAtributesByHandle(FileHandle:string;Attributes:PSFTPFileAttributes);
+var PacketType:BYTE;PacketString,AttributesString,PacketData:string;
+begin
+ PacketType:=SSH_FXP_FSETSTAT;
+ AttributesString:=BuildAttributesString(Attributes);
+ PacketString:=BuildPacket(PacketType,[@FileHandle[1],@AttributesString[1]],
+ [Length(FileHandle),Length(AttributesString)],[False,True]);
+ SendPacket(PacketString);
+ PacketType:=SSH_FXP_STATUS ;
+ PacketData:=ReceivePacket(FRequestID-1,PacketType);
+ CheckStatus(PacketType,PacketData,STRING_UNABLETOSETFILEATTRIBUTES+': '+FileHandle);
+end;
+
+procedure TSimpleSFTP.SetFileTimes(FileName:string;AccessTime,CreateTime,ModifyTime:Int64);
+var PacketType:BYTE;PacketString,AttributesString,PacketData:string;Attributes:TSFTPFileAttributes;
+begin
+ ResetFileAttributes(@Attributes);
+ Attributes.valid_attribute_flags:=SSH_FILEXFER_ATTR_ACCESSTIME;
+ if FProtocolVersion>3 then
+ Attributes.valid_attribute_flags:=Attributes.valid_attribute_flags or
+ SSH_FILEXFER_ATTR_CREATETIME or SSH_FILEXFER_ATTR_MODIFYTIME;
+ Attributes.atime:=AccessTime;
+ Attributes.createtime:=CreateTime;
+ Attributes.mtime:=ModifyTime;
+ SetFileAtributes(FileName,@Attributes);
+end;
+
+procedure TSimpleSFTP.SetFileTimesByHandle(FileHandle:string;AccessTime,CreateTime,ModifyTime:Int64);
+var PacketType:BYTE;PacketString,AttributesString,PacketData:string;Attributes:TSFTPFileAttributes;
+begin
+ ResetFileAttributes(@Attributes);
+ Attributes.valid_attribute_flags:=SSH_FILEXFER_ATTR_ACCESSTIME;
+ if FProtocolVersion>3 then
+ Attributes.valid_attribute_flags:=Attributes.valid_attribute_flags or
+ SSH_FILEXFER_ATTR_CREATETIME or SSH_FILEXFER_ATTR_MODIFYTIME;
+ Attributes.atime:=AccessTime;
+ Attributes.createtime:=CreateTime;
+ Attributes.mtime:=ModifyTime;
+ SetFileAtributesByHandle(FileHandle,@Attributes);
+end;
+
+function TSimpleSFTP.GetStatus(PacketData:string):DWORD;
+begin //assumed PacketType=SSH_FXP_STATUS
+ Result:=GetDWORD(@PacketData[1]);
+end;
+
+function TSimpleSFTP.CheckStatus(PacketType:DWORD;PacketData:string;ErrorString:string):Boolean;
+var Status:DWORD;i,FieldOffset:Integer;
+begin
+ Result:=False;
+ if PacketType<>SSH_FXP_STATUS then Exit;
+ FieldOffset:=1;
+ GetFixedPacketField(PacketData,FieldOffset,@Status,SizeOf(Status));
+ if Status<>SSH_FX_OK then
+ begin //expected strings with error description ?
+ while FieldOffset0 then
+ exit;
+ repeat
+ if terminated then break;
+ buf := sock.RecvPacket(1000);
+ if sock.lasterror = 0 then
+ begin
+ snmprec.Clear;
+ snmprec.DecodeBuf(buf);
+ for n := 0 to snmprec.MIBCount - 1 do
+ begin
+ mib := snmprec.MIBByIndex(n);
+ if mib <> nil then
+ begin
+ oid := mib.OID;
+ value := mib.Value;
+ valuetype := mib.valuetype;
+ ProcessSnmpRequest(snmprec.PDUType, oid, value, valuetype);
+ mib.OID := oid;
+ mib.Value := value;
+ mib.valuetype := valuetype;
+ end;
+ end;
+ snmprec.PDUType := PDUGetResponse;
+ snmprec.ErrorStatus := 0;
+ Buf := snmprec.EncodeBuf;
+ sock.SendString(Buf);
+ end;
+ until false;
+ end;
+end;
+
+procedure TUDPSnmpDaemon.ProcessSnmpRequest(PDU: integer; var OID, Value: string;
+ var valuetype: integer);
+begin
+ if PDU = PDUGetRequest then
+ begin
+ if OID = '1.3.6.1.2.1.1.1.0' then
+ begin
+ Value := 'Synapse SNMP agent demo';
+ Valuetype := ASN1_OCTSTR;
+ end;
+ end;
+end;
+
+end.
ADDED lib/synapse/source/demo/snmpserv/snmpserv.dof
Index: lib/synapse/source/demo/snmpserv/snmpserv.dof
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/snmpserv/snmpserv.dof
@@ -0,0 +1,75 @@
+[Compiler]
+A=1
+B=0
+C=1
+D=1
+E=0
+F=0
+G=1
+H=1
+I=1
+J=1
+K=0
+L=1
+M=0
+N=1
+O=1
+P=1
+Q=0
+R=0
+S=0
+T=0
+U=0
+V=1
+W=0
+X=1
+Y=0
+Z=1
+ShowHints=1
+ShowWarnings=1
+UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
+[Linker]
+MapFile=0
+OutputObjs=0
+ConsoleApp=1
+DebugInfo=0
+MinStackSize=16384
+MaxStackSize=1048576
+ImageBase=4194304
+ExeDescription=
+[Directories]
+OutputDir=
+UnitOutputDir=
+SearchPath=
+Packages=VCLX30;VCL30;VCLDB30;VCLDBX30;INETDB30;INET30;VCLSMP30;QRPT30;TEEUI30;TEEDB30;TEE30;DSS30;IBEVNT30;RXCTL;RXDB;RXTOOLS
+Conditionals=
+DebugSourceDirs=
+UsePackages=0
+[Parameters]
+RunParams=
+HostApplication=
+[Version Info]
+IncludeVerInfo=0
+AutoIncBuild=0
+MajorVer=1
+MinorVer=0
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=0
+Locale=1029
+CodePage=1250
+[Version Info Keys]
+CompanyName=
+FileDescription=
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
ADDED lib/synapse/source/demo/snmpserv/snmpserv.dpr
Index: lib/synapse/source/demo/snmpserv/snmpserv.dpr
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/snmpserv/snmpserv.dpr
@@ -0,0 +1,16 @@
+program snmpserv;
+
+uses
+ Forms,
+ main in 'main.pas' {Form1},
+ snmp in 'snmp.pas',
+ SNMPSend in 'SNMPSend.pas',
+ ASN1Util in 'ASN1Util.pas';
+
+{$R *.RES}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TForm1, Form1);
+ Application.Run;
+end.
ADDED lib/synapse/source/demo/snmpserv/snmpserv.res
Index: lib/synapse/source/demo/snmpserv/snmpserv.res
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/snmpserv/snmpserv.res
cannot compute difference between binary files
ADDED lib/synapse/source/demo/sntp/SntpTest.dpr
Index: lib/synapse/source/demo/sntp/SntpTest.dpr
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/sntp/SntpTest.dpr
@@ -0,0 +1,14 @@
+program SntpTest;
+
+uses
+ Forms,
+ Unit1 in 'Unit1.pas' {Form1};
+
+{$R *.RES}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TForm1, Form1);
+ Application.Run;
+end.
+
ADDED lib/synapse/source/demo/sntp/SntpTest.res
Index: lib/synapse/source/demo/sntp/SntpTest.res
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/sntp/SntpTest.res
cannot compute difference between binary files
ADDED lib/synapse/source/demo/sntp/Unit1.dfm
Index: lib/synapse/source/demo/sntp/Unit1.dfm
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/sntp/Unit1.dfm
cannot compute difference between binary files
ADDED lib/synapse/source/demo/sntp/Unit1.pas
Index: lib/synapse/source/demo/sntp/Unit1.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/demo/sntp/Unit1.pas
@@ -0,0 +1,45 @@
+unit Unit1;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+ SNTPsend, StdCtrls;
+
+type
+ TForm1 = class(TForm)
+ Edit1: TEdit;
+ Label1: TLabel;
+ Button1: TButton;
+ Label2: TLabel;
+ procedure Button1Click(Sender: TObject);
+ private
+ { Private declarations }
+ public
+ { Public declarations }
+ end;
+
+var
+ Form1: TForm1;
+
+implementation
+
+{$R *.DFM}
+
+procedure TForm1.Button1Click(Sender: TObject);
+var
+ sntp:TSntpSend;
+begin
+ sntp:=TSntpSend.Create;
+ try
+ sntp.TargetHost:=Edit1.Text;
+ if sntp.GetSNTP
+ then label2.Caption:=Datetimetostr(sntp.NTPTime)+' UTC'
+ else label2.Caption:='Not contacted!';
+ finally
+ sntp.Free;
+ end;
+end;
+
+end.
+
ADDED lib/synapse/source/lib/asn1util.pas
Index: lib/synapse/source/lib/asn1util.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/lib/asn1util.pas
@@ -0,0 +1,510 @@
+{==============================================================================|
+| Project : Ararat Synapse | 001.004.004 |
+|==============================================================================|
+| Content: support for ASN.1 BER coding and decoding |
+|==============================================================================|
+| Copyright (c)1999-2003, Lukas Gebauer |
+| All rights reserved. |
+| |
+| Redistribution and use in source and binary forms, with or without |
+| modification, are permitted provided that the following conditions are met: |
+| |
+| Redistributions of source code must retain the above copyright notice, this |
+| list of conditions and the following disclaimer. |
+| |
+| Redistributions in binary form must reproduce the above copyright notice, |
+| this list of conditions and the following disclaimer in the documentation |
+| and/or other materials provided with the distribution. |
+| |
+| Neither the name of Lukas Gebauer nor the names of its contributors may |
+| be used to endorse or promote products derived from this software without |
+| specific prior written permission. |
+| |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
+| DAMAGE. |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c) 1999-2003 |
+| Portions created by Hernan Sanchez are Copyright (c) 2000. |
+| All Rights Reserved. |
+|==============================================================================|
+| Contributor(s): |
+| Hernan Sanchez (hernan.sanchez@iname.com) |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package |
+| (Found at URL: http://www.ararat.cz/synapse/) |
+|==============================================================================}
+
+{: @abstract(Utilities for handling ASN.1 BER encoding)
+By this unit you can parse ASN.1 BER encoded data to elements or build back any
+ elements to ASN.1 BER encoded buffer. You can dump ASN.1 BER encoded data to
+ human readable form for easy debugging, too.
+
+Supported element types are: ASN1_BOOL, ASN1_INT, ASN1_OCTSTR, ASN1_NULL,
+ ASN1_OBJID, ASN1_ENUM, ASN1_SEQ, ASN1_SETOF, ASN1_IPADDR, ASN1_COUNTER,
+ ASN1_GAUGE, ASN1_TIMETICKS, ASN1_OPAQUE
+
+For sample of using, look to @link(TSnmpSend) or @link(TLdapSend)class.
+}
+
+{$Q-}
+{$H+}
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+
+{$IFDEF UNICODE}
+ {$WARN IMPLICIT_STRING_CAST OFF}
+ {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+unit asn1util;
+
+interface
+
+uses
+ SysUtils, Classes, synautil;
+
+const
+ ASN1_BOOL = $01;
+ ASN1_INT = $02;
+ ASN1_OCTSTR = $04;
+ ASN1_NULL = $05;
+ ASN1_OBJID = $06;
+ ASN1_ENUM = $0a;
+ ASN1_SEQ = $30;
+ ASN1_SETOF = $31;
+ ASN1_IPADDR = $40;
+ ASN1_COUNTER = $41;
+ ASN1_GAUGE = $42;
+ ASN1_TIMETICKS = $43;
+ ASN1_OPAQUE = $44;
+
+{:Encodes OID item to binary form.}
+function ASNEncOIDItem(Value: Integer): AnsiString;
+
+{:Decodes an OID item of the next element in the "Buffer" from the "Start"
+ position.}
+function ASNDecOIDItem(var Start: Integer; const Buffer: AnsiString): Integer;
+
+{:Encodes the length of ASN.1 element to binary.}
+function ASNEncLen(Len: Integer): AnsiString;
+
+{:Decodes length of next element in "Buffer" from the "Start" position.}
+function ASNDecLen(var Start: Integer; const Buffer: AnsiString): Integer;
+
+{:Encodes a signed integer to ASN.1 binary}
+function ASNEncInt(Value: Integer): AnsiString;
+
+{:Encodes unsigned integer into ASN.1 binary}
+function ASNEncUInt(Value: Integer): AnsiString;
+
+{:Encodes ASN.1 object to binary form.}
+function ASNObject(const Data: AnsiString; ASNType: Integer): AnsiString;
+
+{:Beginning with the "Start" position, decode the ASN.1 item of the next element
+ in "Buffer". Type of item is stored in "ValueType."}
+function ASNItem(var Start: Integer; const Buffer: AnsiString;
+ var ValueType: Integer): AnsiString;
+
+{:Encodes an MIB OID string to binary form.}
+function MibToId(Mib: String): AnsiString;
+
+{:Decodes MIB OID from binary form to string form.}
+function IdToMib(const Id: AnsiString): String;
+
+{:Encodes an one number from MIB OID to binary form. (used internally from
+@link(MibToId))}
+function IntMibToStr(const Value: AnsiString): AnsiString;
+
+{:Convert ASN.1 BER encoded buffer to human readable form for debugging.}
+function ASNdump(const Value: AnsiString): AnsiString;
+
+implementation
+
+{==============================================================================}
+function ASNEncOIDItem(Value: Integer): AnsiString;
+var
+ x, xm: Integer;
+ b: Boolean;
+begin
+ x := Value;
+ b := False;
+ Result := '';
+ repeat
+ xm := x mod 128;
+ x := x div 128;
+ if b then
+ xm := xm or $80;
+ if x > 0 then
+ b := True;
+ Result := AnsiChar(xm) + Result;
+ until x = 0;
+end;
+
+{==============================================================================}
+function ASNDecOIDItem(var Start: Integer; const Buffer: AnsiString): Integer;
+var
+ x: Integer;
+ b: Boolean;
+begin
+ Result := 0;
+ repeat
+ Result := Result * 128;
+ x := Ord(Buffer[Start]);
+ Inc(Start);
+ b := x > $7F;
+ x := x and $7F;
+ Result := Result + x;
+ until not b;
+end;
+
+{==============================================================================}
+function ASNEncLen(Len: Integer): AnsiString;
+var
+ x, y: Integer;
+begin
+ if Len < $80 then
+ Result := AnsiChar(Len)
+ else
+ begin
+ x := Len;
+ Result := '';
+ repeat
+ y := x mod 256;
+ x := x div 256;
+ Result := AnsiChar(y) + Result;
+ until x = 0;
+ y := Length(Result);
+ y := y or $80;
+ Result := AnsiChar(y) + Result;
+ end;
+end;
+
+{==============================================================================}
+function ASNDecLen(var Start: Integer; const Buffer: AnsiString): Integer;
+var
+ x, n: Integer;
+begin
+ x := Ord(Buffer[Start]);
+ Inc(Start);
+ if x < $80 then
+ Result := x
+ else
+ begin
+ Result := 0;
+ x := x and $7F;
+ for n := 1 to x do
+ begin
+ Result := Result * 256;
+ x := Ord(Buffer[Start]);
+ Inc(Start);
+ Result := Result + x;
+ end;
+ end;
+end;
+
+{==============================================================================}
+function ASNEncInt(Value: Integer): AnsiString;
+var
+ x, y: Cardinal;
+ neg: Boolean;
+begin
+ neg := Value < 0;
+ x := Abs(Value);
+ if neg then
+ x := not (x - 1);
+ Result := '';
+ repeat
+ y := x mod 256;
+ x := x div 256;
+ Result := AnsiChar(y) + Result;
+ until x = 0;
+ if (not neg) and (Result[1] > #$7F) then
+ Result := #0 + Result;
+end;
+
+{==============================================================================}
+function ASNEncUInt(Value: Integer): AnsiString;
+var
+ x, y: Integer;
+ neg: Boolean;
+begin
+ neg := Value < 0;
+ x := Value;
+ if neg then
+ x := x and $7FFFFFFF;
+ Result := '';
+ repeat
+ y := x mod 256;
+ x := x div 256;
+ Result := AnsiChar(y) + Result;
+ until x = 0;
+ if neg then
+ Result[1] := AnsiChar(Ord(Result[1]) or $80);
+end;
+
+{==============================================================================}
+function ASNObject(const Data: AnsiString; ASNType: Integer): AnsiString;
+begin
+ Result := AnsiChar(ASNType) + ASNEncLen(Length(Data)) + Data;
+end;
+
+{==============================================================================}
+function ASNItem(var Start: Integer; const Buffer: AnsiString;
+ var ValueType: Integer): AnsiString;
+var
+ ASNType: Integer;
+ ASNSize: Integer;
+ y, n: Integer;
+ x: byte;
+ s: AnsiString;
+ c: AnsiChar;
+ neg: Boolean;
+ l: Integer;
+begin
+ Result := '';
+ ValueType := ASN1_NULL;
+ l := Length(Buffer);
+ if l < (Start + 1) then
+ Exit;
+ ASNType := Ord(Buffer[Start]);
+ ValueType := ASNType;
+ Inc(Start);
+ ASNSize := ASNDecLen(Start, Buffer);
+ if (Start + ASNSize - 1) > l then
+ Exit;
+ if (ASNType and $20) > 0 then
+// Result := '$' + IntToHex(ASNType, 2)
+ Result := Copy(Buffer, Start, ASNSize)
+ else
+ case ASNType of
+ ASN1_INT, ASN1_ENUM, ASN1_BOOL:
+ begin
+ y := 0;
+ neg := False;
+ for n := 1 to ASNSize do
+ begin
+ x := Ord(Buffer[Start]);
+ if (n = 1) and (x > $7F) then
+ neg := True;
+ if neg then
+ x := not x;
+ y := y * 256 + x;
+ Inc(Start);
+ end;
+ if neg then
+ y := -(y + 1);
+ Result := IntToStr(y);
+ end;
+ ASN1_COUNTER, ASN1_GAUGE, ASN1_TIMETICKS:
+ begin
+ y := 0;
+ for n := 1 to ASNSize do
+ begin
+ y := y * 256 + Ord(Buffer[Start]);
+ Inc(Start);
+ end;
+ Result := IntToStr(y);
+ end;
+ ASN1_OCTSTR, ASN1_OPAQUE:
+ begin
+ for n := 1 to ASNSize do
+ begin
+ c := AnsiChar(Buffer[Start]);
+ Inc(Start);
+ s := s + c;
+ end;
+ Result := s;
+ end;
+ ASN1_OBJID:
+ begin
+ for n := 1 to ASNSize do
+ begin
+ c := AnsiChar(Buffer[Start]);
+ Inc(Start);
+ s := s + c;
+ end;
+ Result := IdToMib(s);
+ end;
+ ASN1_IPADDR:
+ begin
+ s := '';
+ for n := 1 to ASNSize do
+ begin
+ if (n <> 1) then
+ s := s + '.';
+ y := Ord(Buffer[Start]);
+ Inc(Start);
+ s := s + IntToStr(y);
+ end;
+ Result := s;
+ end;
+ ASN1_NULL:
+ begin
+ Result := '';
+ Start := Start + ASNSize;
+ end;
+ else // unknown
+ begin
+ for n := 1 to ASNSize do
+ begin
+ c := AnsiChar(Buffer[Start]);
+ Inc(Start);
+ s := s + c;
+ end;
+ Result := s;
+ end;
+ end;
+end;
+
+{==============================================================================}
+function MibToId(Mib: String): AnsiString;
+var
+ x: Integer;
+
+ function WalkInt(var s: String): Integer;
+ var
+ x: Integer;
+ t: AnsiString;
+ begin
+ x := Pos('.', s);
+ if x < 1 then
+ begin
+ t := s;
+ s := '';
+ end
+ else
+ begin
+ t := Copy(s, 1, x - 1);
+ s := Copy(s, x + 1, Length(s) - x);
+ end;
+ Result := StrToIntDef(t, 0);
+ end;
+
+begin
+ Result := '';
+ x := WalkInt(Mib);
+ x := x * 40 + WalkInt(Mib);
+ Result := ASNEncOIDItem(x);
+ while Mib <> '' do
+ begin
+ x := WalkInt(Mib);
+ Result := Result + ASNEncOIDItem(x);
+ end;
+end;
+
+{==============================================================================}
+function IdToMib(const Id: AnsiString): String;
+var
+ x, y, n: Integer;
+begin
+ Result := '';
+ n := 1;
+ while Length(Id) + 1 > n do
+ begin
+ x := ASNDecOIDItem(n, Id);
+ if (n - 1) = 1 then
+ begin
+ y := x div 40;
+ x := x mod 40;
+ Result := IntToStr(y);
+ end;
+ Result := Result + '.' + IntToStr(x);
+ end;
+end;
+
+{==============================================================================}
+function IntMibToStr(const Value: AnsiString): AnsiString;
+var
+ n, y: Integer;
+begin
+ y := 0;
+ for n := 1 to Length(Value) - 1 do
+ y := y * 256 + Ord(Value[n]);
+ Result := IntToStr(y);
+end;
+
+{==============================================================================}
+function ASNdump(const Value: AnsiString): AnsiString;
+var
+ i, at, x, n: integer;
+ s, indent: AnsiString;
+ il: TStringList;
+begin
+ il := TStringList.Create;
+ try
+ Result := '';
+ i := 1;
+ indent := '';
+ while i < Length(Value) do
+ begin
+ for n := il.Count - 1 downto 0 do
+ begin
+ x := StrToIntDef(il[n], 0);
+ if x <= i then
+ begin
+ il.Delete(n);
+ Delete(indent, 1, 2);
+ end;
+ end;
+ s := ASNItem(i, Value, at);
+ Result := Result + indent + '$' + IntToHex(at, 2);
+ if (at and $20) > 0 then
+ begin
+ x := Length(s);
+ Result := Result + ' constructed: length ' + IntToStr(x);
+ indent := indent + ' ';
+ il.Add(IntToStr(x + i - 1));
+ end
+ else
+ begin
+ case at of
+ ASN1_BOOL:
+ Result := Result + ' BOOL: ';
+ ASN1_INT:
+ Result := Result + ' INT: ';
+ ASN1_ENUM:
+ Result := Result + ' ENUM: ';
+ ASN1_COUNTER:
+ Result := Result + ' COUNTER: ';
+ ASN1_GAUGE:
+ Result := Result + ' GAUGE: ';
+ ASN1_TIMETICKS:
+ Result := Result + ' TIMETICKS: ';
+ ASN1_OCTSTR:
+ Result := Result + ' OCTSTR: ';
+ ASN1_OPAQUE:
+ Result := Result + ' OPAQUE: ';
+ ASN1_OBJID:
+ Result := Result + ' OBJID: ';
+ ASN1_IPADDR:
+ Result := Result + ' IPADDR: ';
+ ASN1_NULL:
+ Result := Result + ' NULL: ';
+ else // other
+ Result := Result + ' unknown: ';
+ end;
+ if IsBinaryString(s) then
+ s := DumpExStr(s);
+ Result := Result + s;
+ end;
+ Result := Result + #$0d + #$0a;
+ end;
+ finally
+ il.Free;
+ end;
+end;
+
+{==============================================================================}
+
+end.
ADDED lib/synapse/source/lib/blcksock.pas
Index: lib/synapse/source/lib/blcksock.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/lib/blcksock.pas
@@ -0,0 +1,4333 @@
+{==============================================================================|
+| Project : Ararat Synapse | 009.008.005 |
+|==============================================================================|
+| Content: Library base |
+|==============================================================================|
+| Copyright (c)1999-2012, Lukas Gebauer |
+| All rights reserved. |
+| |
+| Redistribution and use in source and binary forms, with or without |
+| modification, are permitted provided that the following conditions are met: |
+| |
+| Redistributions of source code must retain the above copyright notice, this |
+| list of conditions and the following disclaimer. |
+| |
+| Redistributions in binary form must reproduce the above copyright notice, |
+| this list of conditions and the following disclaimer in the documentation |
+| and/or other materials provided with the distribution. |
+| |
+| Neither the name of Lukas Gebauer nor the names of its contributors may |
+| be used to endorse or promote products derived from this software without |
+| specific prior written permission. |
+| |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
+| DAMAGE. |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)1999-2012. |
+| All Rights Reserved. |
+|==============================================================================|
+| Contributor(s): |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package |
+| (Found at URL: http://www.ararat.cz/synapse/) |
+|==============================================================================}
+
+{
+Special thanks to Gregor Ibic
+ (Intelicom d.o.o., http://www.intelicom.si)
+ for good inspiration about SSL programming.
+}
+
+{$DEFINE ONCEWINSOCK}
+{Note about define ONCEWINSOCK:
+If you remove this compiler directive, then socket interface is loaded and
+initialized on constructor of TBlockSocket class for each socket separately.
+Socket interface is used only if your need it.
+
+If you leave this directive here, then socket interface is loaded and
+initialized only once at start of your program! It boost performace on high
+count of created and destroyed sockets. It eliminate possible small resource
+leak on Windows systems too.
+}
+
+//{$DEFINE RAISEEXCEPT}
+{When you enable this define, then is Raiseexcept property is on by default
+}
+
+{:@abstract(Synapse's library core)
+
+Core with implementation basic socket classes.
+}
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+{$IFDEF VER125}
+ {$DEFINE BCB}
+{$ENDIF}
+{$IFDEF BCB}
+ {$ObjExportAll On}
+{$ENDIF}
+{$Q-}
+{$H+}
+{$M+}
+{$TYPEDADDRESS OFF}
+
+
+//old Delphi does not have MSWINDOWS define.
+{$IFDEF WIN32}
+ {$IFNDEF MSWINDOWS}
+ {$DEFINE MSWINDOWS}
+ {$ENDIF}
+{$ENDIF}
+
+{$IFDEF UNICODE}
+ {$WARN IMPLICIT_STRING_CAST OFF}
+ {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+unit blcksock;
+
+interface
+
+uses
+ SysUtils, Classes,
+ synafpc,
+ synsock, synautil, synacode, synaip
+{$IFDEF CIL}
+ ,System.Net
+ ,System.Net.Sockets
+ ,System.Text
+{$ENDIF}
+ ;
+
+const
+
+ SynapseRelease = '38';
+
+ cLocalhost = '127.0.0.1';
+ cAnyHost = '0.0.0.0';
+ cBroadcast = '255.255.255.255';
+ c6Localhost = '::1';
+ c6AnyHost = '::0';
+ c6Broadcast = 'ffff::1';
+ cAnyPort = '0';
+ CR = #$0d;
+ LF = #$0a;
+ CRLF = CR + LF;
+ c64k = 65536;
+
+type
+
+ {:@abstract(Exception clas used by Synapse)
+ When you enable generating of exceptions, this exception is raised by
+ Synapse's units.}
+ ESynapseError = class(Exception)
+ private
+ FErrorCode: Integer;
+ FErrorMessage: string;
+ published
+ {:Code of error. Value depending on used operating system}
+ property ErrorCode: Integer read FErrorCode Write FErrorCode;
+ {:Human readable description of error.}
+ property ErrorMessage: string read FErrorMessage Write FErrorMessage;
+ end;
+
+ {:Types of OnStatus events}
+ THookSocketReason = (
+ {:Resolving is begin. Resolved IP and port is in parameter in format like:
+ 'localhost.somewhere.com:25'.}
+ HR_ResolvingBegin,
+ {:Resolving is done. Resolved IP and port is in parameter in format like:
+ 'localhost.somewhere.com:25'. It is always same as in HR_ResolvingBegin!}
+ HR_ResolvingEnd,
+ {:Socket created by CreateSocket method. It reporting Family of created
+ socket too!}
+ HR_SocketCreate,
+ {:Socket closed by CloseSocket method.}
+ HR_SocketClose,
+ {:Socket binded to IP and Port. Binded IP and Port is in parameter in format
+ like: 'localhost.somewhere.com:25'.}
+ HR_Bind,
+ {:Socket connected to IP and Port. Connected IP and Port is in parameter in
+ format like: 'localhost.somewhere.com:25'.}
+ HR_Connect,
+ {:Called when CanRead method is used with @True result.}
+ HR_CanRead,
+ {:Called when CanWrite method is used with @True result.}
+ HR_CanWrite,
+ {:Socket is swithed to Listen mode. (TCP socket only)}
+ HR_Listen,
+ {:Socket Accepting client connection. (TCP socket only)}
+ HR_Accept,
+ {:report count of bytes readed from socket. Number is in parameter string.
+ If you need is in integer, you must use StrToInt function!}
+ HR_ReadCount,
+ {:report count of bytes writed to socket. Number is in parameter string. If
+ you need is in integer, you must use StrToInt function!}
+ HR_WriteCount,
+ {:If is limiting of bandwidth on, then this reason is called when sending or
+ receiving is stopped for satisfy bandwidth limit. Parameter is count of
+ waiting milliseconds.}
+ HR_Wait,
+ {:report situation where communication error occured. When raiseexcept is
+ @true, then exception is called after this Hook reason.}
+ HR_Error
+ );
+
+ {:Procedural type for OnStatus event. Sender is calling TBlockSocket object,
+ Reason is one of set Status events and value is optional data.}
+ THookSocketStatus = procedure(Sender: TObject; Reason: THookSocketReason;
+ const Value: String) of object;
+
+ {:This procedural type is used for DataFilter hooks.}
+ THookDataFilter = procedure(Sender: TObject; var Value: AnsiString) of object;
+
+ {:This procedural type is used for hook OnCreateSocket. By this hook you can
+ insert your code after initialisation of socket. (you can set special socket
+ options, etc.)}
+ THookCreateSocket = procedure(Sender: TObject) of object;
+
+ {:This procedural type is used for monitoring of communication.}
+ THookMonitor = procedure(Sender: TObject; Writing: Boolean;
+ const Buffer: TMemory; Len: Integer) of object;
+
+ {:This procedural type is used for hook OnAfterConnect. By this hook you can
+ insert your code after TCP socket has been sucessfully connected.}
+ THookAfterConnect = procedure(Sender: TObject) of object;
+
+ {:This procedural type is used for hook OnVerifyCert. By this hook you can
+ insert your additional certificate verification code. Usefull to verify server
+ CN against URL. }
+
+ THookVerifyCert = function(Sender: TObject):boolean of object;
+
+ {:This procedural type is used for hook OnHeartbeat. By this hook you can
+ call your code repeately during long socket operations.
+ You must enable heartbeats by @Link(HeartbeatRate) property!}
+ THookHeartbeat = procedure(Sender: TObject) of object;
+
+ {:Specify family of socket.}
+ TSocketFamily = (
+ {:Default mode. Socket family is defined by target address for connection.
+ It allows instant access to IPv4 and IPv6 nodes. When you need IPv6 address
+ as destination, then is used IPv6 mode. othervise is used IPv4 mode.
+ However this mode not working properly with preliminary IPv6 supports!}
+ SF_Any,
+ {:Turn this class to pure IPv4 mode. This mode is totally compatible with
+ previous Synapse releases.}
+ SF_IP4,
+ {:Turn to only IPv6 mode.}
+ SF_IP6
+ );
+
+ {:specify possible values of SOCKS modes.}
+ TSocksType = (
+ ST_Socks5,
+ ST_Socks4
+ );
+
+ {:Specify requested SSL/TLS version for secure connection.}
+ TSSLType = (
+ LT_all,
+ LT_SSLv2,
+ LT_SSLv3,
+ LT_TLSv1,
+ LT_TLSv1_1,
+ LT_SSHv2
+ );
+
+ {:Specify type of socket delayed option.}
+ TSynaOptionType = (
+ SOT_Linger,
+ SOT_RecvBuff,
+ SOT_SendBuff,
+ SOT_NonBlock,
+ SOT_RecvTimeout,
+ SOT_SendTimeout,
+ SOT_Reuse,
+ SOT_TTL,
+ SOT_Broadcast,
+ SOT_MulticastTTL,
+ SOT_MulticastLoop
+ );
+
+ {:@abstract(this object is used for remember delayed socket option set.)}
+ TSynaOption = class(TObject)
+ public
+ Option: TSynaOptionType;
+ Enabled: Boolean;
+ Value: Integer;
+ end;
+
+ TCustomSSL = class;
+ TSSLClass = class of TCustomSSL;
+
+ {:@abstract(Basic IP object.)
+ This is parent class for other class with protocol implementations. Do not
+ use this class directly! Use @link(TICMPBlockSocket), @link(TRAWBlockSocket),
+ @link(TTCPBlockSocket) or @link(TUDPBlockSocket) instead.}
+ TBlockSocket = class(TObject)
+ private
+ FOnStatus: THookSocketStatus;
+ FOnReadFilter: THookDataFilter;
+ FOnCreateSocket: THookCreateSocket;
+ FOnMonitor: THookMonitor;
+ FOnHeartbeat: THookHeartbeat;
+ FLocalSin: TVarSin;
+ FRemoteSin: TVarSin;
+ FTag: integer;
+ FBuffer: AnsiString;
+ FRaiseExcept: Boolean;
+ FNonBlockMode: Boolean;
+ FMaxLineLength: Integer;
+ FMaxSendBandwidth: Integer;
+ FNextSend: LongWord;
+ FMaxRecvBandwidth: Integer;
+ FNextRecv: LongWord;
+ FConvertLineEnd: Boolean;
+ FLastCR: Boolean;
+ FLastLF: Boolean;
+ FBinded: Boolean;
+ FFamily: TSocketFamily;
+ FFamilySave: TSocketFamily;
+ FIP6used: Boolean;
+ FPreferIP4: Boolean;
+ FDelayedOptions: TList;
+ FInterPacketTimeout: Boolean;
+ {$IFNDEF CIL}
+ FFDSet: TFDSet;
+ {$ENDIF}
+ FRecvCounter: Integer;
+ FSendCounter: Integer;
+ FSendMaxChunk: Integer;
+ FStopFlag: Boolean;
+ FNonblockSendTimeout: Integer;
+ FHeartbeatRate: integer;
+ {$IFNDEF ONCEWINSOCK}
+ FWsaDataOnce: TWSADATA;
+ {$ENDIF}
+ function GetSizeRecvBuffer: Integer;
+ procedure SetSizeRecvBuffer(Size: Integer);
+ function GetSizeSendBuffer: Integer;
+ procedure SetSizeSendBuffer(Size: Integer);
+ procedure SetNonBlockMode(Value: Boolean);
+ procedure SetTTL(TTL: integer);
+ function GetTTL:integer;
+ procedure SetFamily(Value: TSocketFamily); virtual;
+ procedure SetSocket(Value: TSocket); virtual;
+ function GetWsaData: TWSAData;
+ function FamilyToAF(f: TSocketFamily): TAddrFamily;
+ protected
+ FSocket: TSocket;
+ FLastError: Integer;
+ FLastErrorDesc: string;
+ FOwner: TObject;
+ procedure SetDelayedOption(const Value: TSynaOption);
+ procedure DelayedOption(const Value: TSynaOption);
+ procedure ProcessDelayedOptions;
+ procedure InternalCreateSocket(Sin: TVarSin);
+ procedure SetSin(var Sin: TVarSin; IP, Port: string);
+ function GetSinIP(Sin: TVarSin): string;
+ function GetSinPort(Sin: TVarSin): Integer;
+ procedure DoStatus(Reason: THookSocketReason; const Value: string);
+ procedure DoReadFilter(Buffer: TMemory; var Len: Integer);
+ procedure DoMonitor(Writing: Boolean; const Buffer: TMemory; Len: Integer);
+ procedure DoCreateSocket;
+ procedure DoHeartbeat;
+ procedure LimitBandwidth(Length: Integer; MaxB: integer; var Next: LongWord);
+ procedure SetBandwidth(Value: Integer);
+ function TestStopFlag: Boolean;
+ procedure InternalSendStream(const Stream: TStream; WithSize, Indy: boolean); virtual;
+ function InternalCanRead(Timeout: Integer): Boolean; virtual;
+ public
+ constructor Create;
+
+ {:Create object and load all necessary socket library. What library is
+ loaded is described by STUB parameter. If STUB is empty string, then is
+ loaded default libraries.}
+ constructor CreateAlternate(Stub: string);
+ destructor Destroy; override;
+
+ {:If @link(family) is not SF_Any, then create socket with type defined in
+ @link(Family) property. If family is SF_Any, then do nothing! (socket is
+ created automaticly when you know what type of socket you need to create.
+ (i.e. inside @link(Connect) or @link(Bind) call.) When socket is created,
+ then is aplyed all stored delayed socket options.}
+ procedure CreateSocket;
+
+ {:It create socket. Address resolving of Value tells what type of socket is
+ created. If Value is resolved as IPv4 IP, then is created IPv4 socket. If
+ value is resolved as IPv6 address, then is created IPv6 socket.}
+ procedure CreateSocketByName(const Value: String);
+
+ {:Destroy socket in use. This method is also automatically called from
+ object destructor.}
+ procedure CloseSocket; virtual;
+
+ {:Abort any work on Socket and destroy them.}
+ procedure AbortSocket; virtual;
+
+ {:Connects socket to local IP address and PORT. IP address may be numeric or
+ symbolic ('192.168.74.50', 'cosi.nekde.cz', 'ff08::1'). The same for PORT
+ - it may be number or mnemonic port ('23', 'telnet').
+
+ If port value is '0', system chooses itself and conects unused port in the
+ range 1024 to 4096 (this depending by operating system!). Structure
+ LocalSin is filled after calling this method.
+
+ Note: If you call this on non-created socket, then socket is created
+ automaticly.
+
+ Warning: when you call : Bind('0.0.0.0','0'); then is nothing done! In this
+ case is used implicit system bind instead.}
+ procedure Bind(IP, Port: string);
+
+ {:Connects socket to remote IP address and PORT. The same rules as with
+ @link(BIND) method are valid. The only exception is that PORT with 0 value
+ will not be connected!
+
+ Structures LocalSin and RemoteSin will be filled with valid values.
+
+ When you call this on non-created socket, then socket is created
+ automaticly. Type of created socket is by @link(Family) property. If is
+ used SF_IP4, then is created socket for IPv4. If is used SF_IP6, then is
+ created socket for IPv6. When you have family on SF_Any (default!), then
+ type of created socket is determined by address resolving of destination
+ address. (Not work properly on prilimitary winsock IPv6 support!)}
+ procedure Connect(IP, Port: string); virtual;
+
+ {:Sets socket to receive mode for new incoming connections. It is necessary
+ to use @link(TBlockSocket.BIND) function call before this method to select
+ receiving port!}
+ procedure Listen; virtual;
+
+ {:Waits until new incoming connection comes. After it comes a new socket is
+ automatically created (socket handler is returned by this function as
+ result).}
+ function Accept: TSocket; virtual;
+
+ {:Sends data of LENGTH from BUFFER address via connected socket. System
+ automatically splits data to packets.}
+ function SendBuffer(Buffer: Tmemory; Length: Integer): Integer; virtual;
+
+ {:One data BYTE is sent via connected socket.}
+ procedure SendByte(Data: Byte); virtual;
+
+ {:Send data string via connected socket. Any terminator is not added! If you
+ need send true string with CR-LF termination, you must add CR-LF characters
+ to sended string! Because any termination is not added automaticly, you can
+ use this function for sending any binary data in binary string.}
+ procedure SendString(Data: AnsiString); virtual;
+
+ {:Send integer as four bytes to socket.}
+ procedure SendInteger(Data: integer); virtual;
+
+ {:Send data as one block to socket. Each block begin with 4 bytes with
+ length of data in block. This 4 bytes is added automaticly by this
+ function.}
+ procedure SendBlock(const Data: AnsiString); virtual;
+
+ {:Send data from stream to socket.}
+ procedure SendStreamRaw(const Stream: TStream); virtual;
+
+ {:Send content of stream to socket. It using @link(SendBlock) method}
+ procedure SendStream(const Stream: TStream); virtual;
+
+ {:Send content of stream to socket. It using @link(SendBlock) method and
+ this is compatible with streams in Indy library.}
+ procedure SendStreamIndy(const Stream: TStream); virtual;
+
+ {:Note: This is low-level receive function. You must be sure if data is
+ waiting for read before call this function for avoid deadlock!
+
+ Waits until allocated buffer is filled by received data. Returns number of
+ data received, which equals to LENGTH value under normal operation. If it
+ is not equal the communication channel is possibly broken.
+
+ On stream oriented sockets if is received 0 bytes, it mean 'socket is
+ closed!"
+
+ On datagram socket is readed first waiting datagram.}
+ function RecvBuffer(Buffer: TMemory; Length: Integer): Integer; virtual;
+
+ {:Note: This is high-level receive function. It using internal
+ @link(LineBuffer) and you can combine this function freely with other
+ high-level functions!
+
+ Method waits until data is received. If no data is received within TIMEOUT
+ (in milliseconds) period, @link(LastError) is set to WSAETIMEDOUT. Methods
+ serves for reading any size of data (i.e. one megabyte...). This method is
+ preffered for reading from stream sockets (like TCP).}
+ function RecvBufferEx(Buffer: Tmemory; Len: Integer;
+ Timeout: Integer): Integer; virtual;
+
+ {:Similar to @link(RecvBufferEx), but readed data is stored in binary
+ string, not in memory buffer.}
+ function RecvBufferStr(Len: Integer; Timeout: Integer): AnsiString; virtual;
+
+ {:Note: This is high-level receive function. It using internal
+ @link(LineBuffer) and you can combine this function freely with other
+ high-level functions.
+
+ Waits until one data byte is received which is also returned as function
+ result. If no data is received within TIMEOUT (in milliseconds)period,
+ @link(LastError) is set to WSAETIMEDOUT and result have value 0.}
+ function RecvByte(Timeout: Integer): Byte; virtual;
+
+ {:Note: This is high-level receive function. It using internal
+ @link(LineBuffer) and you can combine this function freely with other
+ high-level functions.
+
+ Waits until one four bytes are received and return it as one Ineger Value.
+ If no data is received within TIMEOUT (in milliseconds)period,
+ @link(LastError) is set to WSAETIMEDOUT and result have value 0.}
+ function RecvInteger(Timeout: Integer): Integer; virtual;
+
+ {:Note: This is high-level receive function. It using internal
+ @link(LineBuffer) and you can combine this function freely with other
+ high-level functions.
+
+ Method waits until data string is received. This string is terminated by
+ CR-LF characters. The resulting string is returned without this termination
+ (CR-LF)! If @link(ConvertLineEnd) is used, then CR-LF sequence may not be
+ exactly CR-LF. See @link(ConvertLineEnd) description. If no data is
+ received within TIMEOUT (in milliseconds) period, @link(LastError) is set
+ to WSAETIMEDOUT. You may also specify maximum length of reading data by
+ @link(MaxLineLength) property.}
+ function RecvString(Timeout: Integer): AnsiString; virtual;
+
+ {:Note: This is high-level receive function. It using internal
+ @link(LineBuffer) and you can combine this function freely with other
+ high-level functions.
+
+ Method waits until data string is received. This string is terminated by
+ Terminator string. The resulting string is returned without this
+ termination. If no data is received within TIMEOUT (in milliseconds)
+ period, @link(LastError) is set to WSAETIMEDOUT. You may also specify
+ maximum length of reading data by @link(MaxLineLength) property.}
+ function RecvTerminated(Timeout: Integer; const Terminator: AnsiString): AnsiString; virtual;
+
+ {:Note: This is high-level receive function. It using internal
+ @link(LineBuffer) and you can combine this function freely with other
+ high-level functions.
+
+ Method reads all data waiting for read. If no data is received within
+ TIMEOUT (in milliseconds) period, @link(LastError) is set to WSAETIMEDOUT.
+ Methods serves for reading unknown size of data. Because before call this
+ function you don't know size of received data, returned data is stored in
+ dynamic size binary string. This method is preffered for reading from
+ stream sockets (like TCP). It is very goot for receiving datagrams too!
+ (UDP protocol)}
+ function RecvPacket(Timeout: Integer): AnsiString; virtual;
+
+ {:Read one block of data from socket. Each block begin with 4 bytes with
+ length of data in block. This function read first 4 bytes for get lenght,
+ then it wait for reported count of bytes.}
+ function RecvBlock(Timeout: Integer): AnsiString; virtual;
+
+ {:Read all data from socket to stream until socket is closed (or any error
+ occured.)}
+ procedure RecvStreamRaw(const Stream: TStream; Timeout: Integer); virtual;
+ {:Read requested count of bytes from socket to stream.}
+ procedure RecvStreamSize(const Stream: TStream; Timeout: Integer; Size: Integer);
+
+ {:Receive data to stream. It using @link(RecvBlock) method.}
+ procedure RecvStream(const Stream: TStream; Timeout: Integer); virtual;
+
+ {:Receive data to stream. This function is compatible with similar function
+ in Indy library. It using @link(RecvBlock) method.}
+ procedure RecvStreamIndy(const Stream: TStream; Timeout: Integer); virtual;
+
+ {:Same as @link(RecvBuffer), but readed data stays in system input buffer.
+ Warning: this function not respect data in @link(LineBuffer)! Is not
+ recommended to use this function!}
+ function PeekBuffer(Buffer: TMemory; Length: Integer): Integer; virtual;
+
+ {:Same as @link(RecvByte), but readed data stays in input system buffer.
+ Warning: this function not respect data in @link(LineBuffer)! Is not
+ recommended to use this function!}
+ function PeekByte(Timeout: Integer): Byte; virtual;
+
+ {:On stream sockets it returns number of received bytes waiting for picking.
+ 0 is returned when there is no such data. On datagram socket it returns
+ length of the first waiting datagram. Returns 0 if no datagram is waiting.}
+ function WaitingData: Integer; virtual;
+
+ {:Same as @link(WaitingData), but if exists some of data in @link(Linebuffer),
+ return their length instead.}
+ function WaitingDataEx: Integer;
+
+ {:Clear all waiting data for read from buffers.}
+ procedure Purge;
+
+ {:Sets linger. Enabled linger means that the system waits another LINGER
+ (in milliseconds) time for delivery of sent data. This function is only for
+ stream type of socket! (TCP)}
+ procedure SetLinger(Enable: Boolean; Linger: Integer);
+
+ {:Actualize values in @link(LocalSin).}
+ procedure GetSinLocal;
+
+ {:Actualize values in @link(RemoteSin).}
+ procedure GetSinRemote;
+
+ {:Actualize values in @link(LocalSin) and @link(RemoteSin).}
+ procedure GetSins;
+
+ {:Reset @link(LastError) and @link(LastErrorDesc) to non-error state.}
+ procedure ResetLastError;
+
+ {:If you "manually" call Socket API functions, forward their return code as
+ parameter to this function, which evaluates it, eventually calls
+ GetLastError and found error code returns and stores to @link(LastError).}
+ function SockCheck(SockResult: Integer): Integer; virtual;
+
+ {:If @link(LastError) contains some error code and @link(RaiseExcept)
+ property is @true, raise adequate exception.}
+ procedure ExceptCheck;
+
+ {:Returns local computer name as numerical or symbolic value. It try get
+ fully qualified domain name. Name is returned in the format acceptable by
+ functions demanding IP as input parameter.}
+ function LocalName: string;
+
+ {:Try resolve name to all possible IP address. i.e. If you pass as name
+ result of @link(LocalName) method, you get all IP addresses used by local
+ system.}
+ procedure ResolveNameToIP(Name: string; const IPList: TStrings);
+
+ {:Try resolve name to primary IP address. i.e. If you pass as name result of
+ @link(LocalName) method, you get primary IP addresses used by local system.}
+ function ResolveName(Name: string): string;
+
+ {:Try resolve IP to their primary domain name. If IP not have domain name,
+ then is returned original IP.}
+ function ResolveIPToName(IP: string): string;
+
+ {:Try resolve symbolic port name to port number. (i.e. 'Echo' to 8)}
+ function ResolvePort(Port: string): Word;
+
+ {:Set information about remote side socket. It is good for seting remote
+ side for sending UDP packet, etc.}
+ procedure SetRemoteSin(IP, Port: string);
+
+ {:Picks IP socket address from @link(LocalSin).}
+ function GetLocalSinIP: string; virtual;
+
+ {:Picks IP socket address from @link(RemoteSin).}
+ function GetRemoteSinIP: string; virtual;
+
+ {:Picks socket PORT number from @link(LocalSin).}
+ function GetLocalSinPort: Integer; virtual;
+
+ {:Picks socket PORT number from @link(RemoteSin).}
+ function GetRemoteSinPort: Integer; virtual;
+
+ {:Return @TRUE, if you can read any data from socket or is incoming
+ connection on TCP based socket. Status is tested for time Timeout (in
+ milliseconds). If value in Timeout is 0, status is only tested and
+ continue. If value in Timeout is -1, run is breaked and waiting for read
+ data maybe forever.
+
+ This function is need only on special cases, when you need use
+ @link(RecvBuffer) function directly! read functioms what have timeout as
+ calling parameter, calling this function internally.}
+ function CanRead(Timeout: Integer): Boolean; virtual;
+
+ {:Same as @link(CanRead), but additionally return @TRUE if is some data in
+ @link(LineBuffer).}
+ function CanReadEx(Timeout: Integer): Boolean; virtual;
+
+ {:Return @TRUE, if you can to socket write any data (not full sending
+ buffer). Status is tested for time Timeout (in milliseconds). If value in
+ Timeout is 0, status is only tested and continue. If value in Timeout is
+ -1, run is breaked and waiting for write data maybe forever.
+
+ This function is need only on special cases!}
+ function CanWrite(Timeout: Integer): Boolean; virtual;
+
+ {:Same as @link(SendBuffer), but send datagram to address from
+ @link(RemoteSin). Usefull for sending reply to datagram received by
+ function @link(RecvBufferFrom).}
+ function SendBufferTo(Buffer: TMemory; Length: Integer): Integer; virtual;
+
+ {:Note: This is low-lever receive function. You must be sure if data is
+ waiting for read before call this function for avoid deadlock!
+
+ Receives first waiting datagram to allocated buffer. If there is no waiting
+ one, then waits until one comes. Returns length of datagram stored in
+ BUFFER. If length exceeds buffer datagram is truncated. After this
+ @link(RemoteSin) structure contains information about sender of UDP packet.}
+ function RecvBufferFrom(Buffer: TMemory; Length: Integer): Integer; virtual;
+{$IFNDEF CIL}
+ {:This function is for check for incoming data on set of sockets. Whitch
+ sockets is checked is decribed by SocketList Tlist with TBlockSocket
+ objects. TList may have maximal number of objects defined by FD_SETSIZE
+ constant. Return @TRUE, if you can from some socket read any data or is
+ incoming connection on TCP based socket. Status is tested for time Timeout
+ (in milliseconds). If value in Timeout is 0, status is only tested and
+ continue. If value in Timeout is -1, run is breaked and waiting for read
+ data maybe forever. If is returned @TRUE, CanReadList TList is filled by all
+ TBlockSocket objects what waiting for read.}
+ function GroupCanRead(const SocketList: TList; Timeout: Integer;
+ const CanReadList: TList): Boolean;
+{$ENDIF}
+ {:By this method you may turn address reuse mode for local @link(bind). It
+ is good specially for UDP protocol. Using this with TCP protocol is
+ hazardous!}
+ procedure EnableReuse(Value: Boolean);
+
+ {:Try set timeout for all sending and receiving operations, if socket
+ provider can do it. (It not supported by all socket providers!)}
+ procedure SetTimeout(Timeout: Integer);
+
+ {:Try set timeout for all sending operations, if socket provider can do it.
+ (It not supported by all socket providers!)}
+ procedure SetSendTimeout(Timeout: Integer);
+
+ {:Try set timeout for all receiving operations, if socket provider can do
+ it. (It not supported by all socket providers!)}
+ procedure SetRecvTimeout(Timeout: Integer);
+
+ {:Return value of socket type.}
+ function GetSocketType: integer; Virtual;
+
+ {:Return value of protocol type for socket creation.}
+ function GetSocketProtocol: integer; Virtual;
+
+ {:WSA structure with information about socket provider. On non-windows
+ platforms this structure is simulated!}
+ property WSAData: TWSADATA read GetWsaData;
+
+ {:FDset structure prepared for usage with this socket.}
+ property FDset: TFDSet read FFDset;
+
+ {:Structure describing local socket side.}
+ property LocalSin: TVarSin read FLocalSin write FLocalSin;
+
+ {:Structure describing remote socket side.}
+ property RemoteSin: TVarSin read FRemoteSin write FRemoteSin;
+
+ {:Socket handler. Suitable for "manual" calls to socket API or manual
+ connection of socket to a previously created socket (i.e by Accept method
+ on TCP socket)}
+ property Socket: TSocket read FSocket write SetSocket;
+
+ {:Last socket operation error code. Error codes are described in socket
+ documentation. Human readable error description is stored in
+ @link(LastErrorDesc) property.}
+ property LastError: Integer read FLastError;
+
+ {:Human readable error description of @link(LastError) code.}
+ property LastErrorDesc: string read FLastErrorDesc;
+
+ {:Buffer used by all high-level receiving functions. This buffer is used for
+ optimized reading of data from socket. In normal cases you not need access
+ to this buffer directly!}
+ property LineBuffer: AnsiString read FBuffer write FBuffer;
+
+ {:Size of Winsock receive buffer. If it is not supported by socket provider,
+ it return as size one kilobyte.}
+ property SizeRecvBuffer: Integer read GetSizeRecvBuffer write SetSizeRecvBuffer;
+
+ {:Size of Winsock send buffer. If it is not supported by socket provider, it
+ return as size one kilobyte.}
+ property SizeSendBuffer: Integer read GetSizeSendBuffer write SetSizeSendBuffer;
+
+ {:If @True, turn class to non-blocking mode. Not all functions are working
+ properly in this mode, you must know exactly what you are doing! However
+ when you have big experience with non-blocking programming, then you can
+ optimise your program by non-block mode!}
+ property NonBlockMode: Boolean read FNonBlockMode Write SetNonBlockMode;
+
+ {:Set Time-to-live value. (if system supporting it!)}
+ property TTL: Integer read GetTTL Write SetTTL;
+
+ {:If is @true, then class in in IPv6 mode.}
+ property IP6used: Boolean read FIP6used;
+
+ {:Return count of received bytes on this socket from begin of current
+ connection.}
+ property RecvCounter: Integer read FRecvCounter;
+
+ {:Return count of sended bytes on this socket from begin of current
+ connection.}
+ property SendCounter: Integer read FSendCounter;
+ published
+ {:Return descriptive string for given error code. This is class function.
+ You may call it without created object!}
+ class function GetErrorDesc(ErrorCode: Integer): string;
+
+ {:Return descriptive string for @link(LastError).}
+ function GetErrorDescEx: string; virtual;
+
+ {:this value is for free use.}
+ property Tag: Integer read FTag write FTag;
+
+ {:If @true, winsock errors raises exception. Otherwise is setted
+ @link(LastError) value only and you must check it from your program! Default
+ value is @false.}
+ property RaiseExcept: Boolean read FRaiseExcept write FRaiseExcept;
+
+ {:Define maximum length in bytes of @link(LineBuffer) for high-level
+ receiving functions. If this functions try to read more data then this
+ limit, error is returned! If value is 0 (default), no limitation is used.
+ This is very good protection for stupid attacks to your server by sending
+ lot of data without proper terminator... until all your memory is allocated
+ by LineBuffer!
+
+ Note: This maximum length is checked only in functions, what read unknown
+ number of bytes! (like @link(RecvString) or @link(RecvTerminated))}
+ property MaxLineLength: Integer read FMaxLineLength Write FMaxLineLength;
+
+ {:Define maximal bandwidth for all sending operations in bytes per second.
+ If value is 0 (default), bandwidth limitation is not used.}
+ property MaxSendBandwidth: Integer read FMaxSendBandwidth Write FMaxSendBandwidth;
+
+ {:Define maximal bandwidth for all receiving operations in bytes per second.
+ If value is 0 (default), bandwidth limitation is not used.}
+ property MaxRecvBandwidth: Integer read FMaxRecvBandwidth Write FMaxRecvBandwidth;
+
+ {:Define maximal bandwidth for all sending and receiving operations in bytes
+ per second. If value is 0 (default), bandwidth limitation is not used.}
+ property MaxBandwidth: Integer Write SetBandwidth;
+
+ {:Do a conversion of non-standard line terminators to CRLF. (Off by default)
+ If @True, then terminators like sigle CR, single LF or LFCR are converted
+ to CRLF internally. This have effect only in @link(RecvString) method!}
+ property ConvertLineEnd: Boolean read FConvertLineEnd Write FConvertLineEnd;
+
+ {:Specified Family of this socket. When you are using Windows preliminary
+ support for IPv6, then I recommend to set this property!}
+ property Family: TSocketFamily read FFamily Write SetFamily;
+
+ {:When resolving of domain name return both IPv4 and IPv6 addresses, then
+ specify if is used IPv4 (dafault - @true) or IPv6.}
+ property PreferIP4: Boolean read FPreferIP4 Write FPreferIP4;
+
+ {:By default (@true) is all timeouts used as timeout between two packets in
+ reading operations. If you set this to @false, then Timeouts is for overall
+ reading operation!}
+ property InterPacketTimeout: Boolean read FInterPacketTimeout Write FInterPacketTimeout;
+
+ {:All sended datas was splitted by this value.}
+ property SendMaxChunk: Integer read FSendMaxChunk Write FSendMaxChunk;
+
+ {:By setting this property to @true you can stop any communication. You can
+ use this property for soft abort of communication.}
+ property StopFlag: Boolean read FStopFlag Write FStopFlag;
+
+ {:Timeout for data sending by non-blocking socket mode.}
+ property NonblockSendTimeout: Integer read FNonblockSendTimeout Write FNonblockSendTimeout;
+
+ {:This event is called by various reasons. It is good for monitoring socket,
+ create gauges for data transfers, etc.}
+ property OnStatus: THookSocketStatus read FOnStatus write FOnStatus;
+
+ {:this event is good for some internal thinks about filtering readed datas.
+ It is used by telnet client by example.}
+ property OnReadFilter: THookDataFilter read FOnReadFilter write FOnReadFilter;
+
+ {:This event is called after real socket creation for setting special socket
+ options, because you not know when socket is created. (it is depended on
+ Ipv4, IPv6 or automatic mode)}
+ property OnCreateSocket: THookCreateSocket read FOnCreateSocket write FOnCreateSocket;
+
+ {:This event is good for monitoring content of readed or writed datas.}
+ property OnMonitor: THookMonitor read FOnMonitor write FOnMonitor;
+
+ {:This event is good for calling your code during long socket operations.
+ (Example, for refresing UI if class in not called within the thread.)
+ Rate of heartbeats can be modified by @link(HeartbeatRate) property.}
+ property OnHeartbeat: THookHeartbeat read FOnHeartbeat write FOnHeartbeat;
+
+ {:Specify typical rate of @link(OnHeartbeat) event and @link(StopFlag) testing.
+ Default value 0 disabling heartbeats! Value is in milliseconds.
+ Real rate can be higher or smaller then this value, because it depending
+ on real socket operations too!
+ Note: Each heartbeat slowing socket processing.}
+ property HeartbeatRate: integer read FHeartbeatRate Write FHeartbeatRate;
+ {:What class own this socket? Used by protocol implementation classes.}
+ property Owner: TObject read FOwner Write FOwner;
+ end;
+
+ {:@abstract(Support for SOCKS4 and SOCKS5 proxy)
+ Layer with definition all necessary properties and functions for
+ implementation SOCKS proxy client. Do not use this class directly.}
+ TSocksBlockSocket = class(TBlockSocket)
+ protected
+ FSocksIP: string;
+ FSocksPort: string;
+ FSocksTimeout: integer;
+ FSocksUsername: string;
+ FSocksPassword: string;
+ FUsingSocks: Boolean;
+ FSocksResolver: Boolean;
+ FSocksLastError: integer;
+ FSocksResponseIP: string;
+ FSocksResponsePort: string;
+ FSocksLocalIP: string;
+ FSocksLocalPort: string;
+ FSocksRemoteIP: string;
+ FSocksRemotePort: string;
+ FBypassFlag: Boolean;
+ FSocksType: TSocksType;
+ function SocksCode(IP, Port: string): Ansistring;
+ function SocksDecode(Value: Ansistring): integer;
+ public
+ constructor Create;
+
+ {:Open connection to SOCKS proxy and if @link(SocksUsername) is set, do
+ authorisation to proxy. This is needed only in special cases! (it is called
+ internally!)}
+ function SocksOpen: Boolean;
+
+ {:Send specified request to SOCKS proxy. This is needed only in special
+ cases! (it is called internally!)}
+ function SocksRequest(Cmd: Byte; const IP, Port: string): Boolean;
+
+ {:Receive response to previosly sended request. This is needed only in
+ special cases! (it is called internally!)}
+ function SocksResponse: Boolean;
+
+ {:Is @True when class is using SOCKS proxy.}
+ property UsingSocks: Boolean read FUsingSocks;
+
+ {:If SOCKS proxy failed, here is error code returned from SOCKS proxy.}
+ property SocksLastError: integer read FSocksLastError;
+ published
+ {:Address of SOCKS server. If value is empty string, SOCKS support is
+ disabled. Assingning any value to this property enable SOCKS mode.
+ Warning: You cannot combine this mode with HTTP-tunneling mode!}
+ property SocksIP: string read FSocksIP write FSocksIP;
+
+ {:Port of SOCKS server. Default value is '1080'.}
+ property SocksPort: string read FSocksPort write FSocksPort;
+
+ {:If you need authorisation on SOCKS server, set username here.}
+ property SocksUsername: string read FSocksUsername write FSocksUsername;
+
+ {:If you need authorisation on SOCKS server, set password here.}
+ property SocksPassword: string read FSocksPassword write FSocksPassword;
+
+ {:Specify timeout for communicatin with SOCKS server. Default is one minute.}
+ property SocksTimeout: integer read FSocksTimeout write FSocksTimeout;
+
+ {:If @True, all symbolic names of target hosts is not translated to IP's
+ locally, but resolving is by SOCKS proxy. Default is @True.}
+ property SocksResolver: Boolean read FSocksResolver write FSocksResolver;
+
+ {:Specify SOCKS type. By default is used SOCKS5, but you can use SOCKS4 too.
+ When you select SOCKS4, then if @link(SOCKSResolver) is enabled, then is
+ used SOCKS4a. Othervise is used pure SOCKS4.}
+ property SocksType: TSocksType read FSocksType write FSocksType;
+ end;
+
+ {:@abstract(Implementation of TCP socket.)
+ Supported features: IPv4, IPv6, SSL/TLS or SSH (depending on used plugin),
+ SOCKS5 proxy (outgoing connections and limited incomming), SOCKS4/4a proxy
+ (outgoing connections and limited incomming), TCP through HTTP proxy tunnel.}
+ TTCPBlockSocket = class(TSocksBlockSocket)
+ protected
+ FOnAfterConnect: THookAfterConnect;
+ FSSL: TCustomSSL;
+ FHTTPTunnelIP: string;
+ FHTTPTunnelPort: string;
+ FHTTPTunnel: Boolean;
+ FHTTPTunnelRemoteIP: string;
+ FHTTPTunnelRemotePort: string;
+ FHTTPTunnelUser: string;
+ FHTTPTunnelPass: string;
+ FHTTPTunnelTimeout: integer;
+ procedure SocksDoConnect(IP, Port: string);
+ procedure HTTPTunnelDoConnect(IP, Port: string);
+ procedure DoAfterConnect;
+ public
+ {:Create TCP socket class with default plugin for SSL/TSL/SSH implementation
+ (see @link(SSLImplementation))}
+ constructor Create;
+
+ {:Create TCP socket class with desired plugin for SSL/TSL/SSH implementation}
+ constructor CreateWithSSL(SSLPlugin: TSSLClass);
+ destructor Destroy; override;
+
+ {:See @link(TBlockSocket.CloseSocket)}
+ procedure CloseSocket; override;
+
+ {:See @link(TBlockSocket.WaitingData)}
+ function WaitingData: Integer; override;
+
+ {:Sets socket to receive mode for new incoming connections. It is necessary
+ to use @link(TBlockSocket.BIND) function call before this method to select
+ receiving port!
+
+ If you use SOCKS, activate incoming TCP connection by this proxy. (By BIND
+ method of SOCKS.)}
+ procedure Listen; override;
+
+ {:Waits until new incoming connection comes. After it comes a new socket is
+ automatically created (socket handler is returned by this function as
+ result).
+
+ If you use SOCKS, new socket is not created! In this case is used same
+ socket as socket for listening! So, you can accept only one connection in
+ SOCKS mode.}
+ function Accept: TSocket; override;
+
+ {:Connects socket to remote IP address and PORT. The same rules as with
+ @link(TBlockSocket.BIND) method are valid. The only exception is that PORT
+ with 0 value will not be connected. After call to this method
+ a communication channel between local and remote socket is created. Local
+ socket is assigned automatically if not controlled by previous call to
+ @link(TBlockSocket.BIND) method. Structures @link(TBlockSocket.LocalSin)
+ and @link(TBlockSocket.RemoteSin) will be filled with valid values.
+
+ If you use SOCKS, activate outgoing TCP connection by SOCKS proxy specified
+ in @link(TSocksBlockSocket.SocksIP). (By CONNECT method of SOCKS.)
+
+ If you use HTTP-tunnel mode, activate outgoing TCP connection by HTTP
+ tunnel specified in @link(HTTPTunnelIP). (By CONNECT method of HTTP
+ protocol.)
+
+ Note: If you call this on non-created socket, then socket is created
+ automaticly.}
+ procedure Connect(IP, Port: string); override;
+
+ {:If you need upgrade existing TCP connection to SSL/TLS (or SSH2, if plugin
+ allows it) mode, then call this method. This method switch this class to
+ SSL mode and do SSL/TSL handshake.}
+ procedure SSLDoConnect;
+
+ {:By this method you can downgrade existing SSL/TLS connection to normal TCP
+ connection.}
+ procedure SSLDoShutdown;
+
+ {:If you need use this component as SSL/TLS TCP server, then after accepting
+ of inbound connection you need start SSL/TLS session by this method. Before
+ call this function, you must have assigned all neeeded certificates and
+ keys!}
+ function SSLAcceptConnection: Boolean;
+
+ {:See @link(TBlockSocket.GetLocalSinIP)}
+ function GetLocalSinIP: string; override;
+
+ {:See @link(TBlockSocket.GetRemoteSinIP)}
+ function GetRemoteSinIP: string; override;
+
+ {:See @link(TBlockSocket.GetLocalSinPort)}
+ function GetLocalSinPort: Integer; override;
+
+ {:See @link(TBlockSocket.GetRemoteSinPort)}
+ function GetRemoteSinPort: Integer; override;
+
+ {:See @link(TBlockSocket.SendBuffer)}
+ function SendBuffer(Buffer: TMemory; Length: Integer): Integer; override;
+
+ {:See @link(TBlockSocket.RecvBuffer)}
+ function RecvBuffer(Buffer: TMemory; Len: Integer): Integer; override;
+
+ {:Return value of socket type. For TCP return SOCK_STREAM.}
+ function GetSocketType: integer; override;
+
+ {:Return value of protocol type for socket creation. For TCP return
+ IPPROTO_TCP.}
+ function GetSocketProtocol: integer; override;
+
+ {:Class implementing SSL/TLS support. It is allways some descendant
+ of @link(TCustomSSL) class. When programmer not select some SSL plugin
+ class, then is used @link(TSSLNone)}
+ property SSL: TCustomSSL read FSSL;
+
+ {:@True if is used HTTP tunnel mode.}
+ property HTTPTunnel: Boolean read FHTTPTunnel;
+ published
+ {:Return descriptive string for @link(LastError). On case of error
+ in SSL/TLS subsystem, it returns right error description.}
+ function GetErrorDescEx: string; override;
+
+ {:Specify IP address of HTTP proxy. Assingning non-empty value to this
+ property enable HTTP-tunnel mode. This mode is for tunnelling any outgoing
+ TCP connection through HTTP proxy server. (If policy on HTTP proxy server
+ allow this!) Warning: You cannot combine this mode with SOCK5 mode!}
+ property HTTPTunnelIP: string read FHTTPTunnelIP Write FHTTPTunnelIP;
+
+ {:Specify port of HTTP proxy for HTTP-tunneling.}
+ property HTTPTunnelPort: string read FHTTPTunnelPort Write FHTTPTunnelPort;
+
+ {:Specify authorisation username for access to HTTP proxy in HTTP-tunnel
+ mode. If you not need authorisation, then let this property empty.}
+ property HTTPTunnelUser: string read FHTTPTunnelUser Write FHTTPTunnelUser;
+
+ {:Specify authorisation password for access to HTTP proxy in HTTP-tunnel
+ mode.}
+ property HTTPTunnelPass: string read FHTTPTunnelPass Write FHTTPTunnelPass;
+
+ {:Specify timeout for communication with HTTP proxy in HTTPtunnel mode.}
+ property HTTPTunnelTimeout: integer read FHTTPTunnelTimeout Write FHTTPTunnelTimeout;
+
+ {:This event is called after sucessful TCP socket connection.}
+ property OnAfterConnect: THookAfterConnect read FOnAfterConnect write FOnAfterConnect;
+ end;
+
+ {:@abstract(Datagram based communication)
+ This class implementing datagram based communication instead default stream
+ based communication style.}
+ TDgramBlockSocket = class(TSocksBlockSocket)
+ public
+ {:Fill @link(TBlockSocket.RemoteSin) structure. This address is used for
+ sending data.}
+ procedure Connect(IP, Port: string); override;
+
+ {:Silently redirected to @link(TBlockSocket.SendBufferTo).}
+ function SendBuffer(Buffer: TMemory; Length: Integer): Integer; override;
+
+ {:Silently redirected to @link(TBlockSocket.RecvBufferFrom).}
+ function RecvBuffer(Buffer: TMemory; Length: Integer): Integer; override;
+ end;
+
+ {:@abstract(Implementation of UDP socket.)
+ NOTE: in this class is all receiving redirected to RecvBufferFrom. You can
+ use for reading any receive function. Preffered is RecvPacket! Similary all
+ sending is redirected to SendbufferTo. You can use for sending UDP packet any
+ sending function, like SendString.
+
+ Supported features: IPv4, IPv6, unicasts, broadcasts, multicasts, SOCKS5
+ proxy (only unicasts! Outgoing and incomming.)}
+ TUDPBlockSocket = class(TDgramBlockSocket)
+ protected
+ FSocksControlSock: TTCPBlockSocket;
+ function UdpAssociation: Boolean;
+ procedure SetMulticastTTL(TTL: integer);
+ function GetMulticastTTL:integer;
+ public
+ destructor Destroy; override;
+
+ {:Enable or disable sending of broadcasts. If seting OK, result is @true.
+ This method is not supported in SOCKS5 mode! IPv6 does not support
+ broadcasts! In this case you must use Multicasts instead.}
+ procedure EnableBroadcast(Value: Boolean);
+
+ {:See @link(TBlockSocket.SendBufferTo)}
+ function SendBufferTo(Buffer: TMemory; Length: Integer): Integer; override;
+
+ {:See @link(TBlockSocket.RecvBufferFrom)}
+ function RecvBufferFrom(Buffer: TMemory; Length: Integer): Integer; override;
+{$IFNDEF CIL}
+ {:Add this socket to given multicast group. You cannot use Multicasts in
+ SOCKS mode!}
+ procedure AddMulticast(MCastIP:string);
+
+ {:Remove this socket from given multicast group.}
+ procedure DropMulticast(MCastIP:string);
+{$ENDIF}
+ {:All sended multicast datagrams is loopbacked to your interface too. (you
+ can read your sended datas.) You can disable this feature by this function.
+ This function not working on some Windows systems!}
+ procedure EnableMulticastLoop(Value: Boolean);
+
+ {:Return value of socket type. For UDP return SOCK_DGRAM.}
+ function GetSocketType: integer; override;
+
+ {:Return value of protocol type for socket creation. For UDP return
+ IPPROTO_UDP.}
+ function GetSocketProtocol: integer; override;
+
+ {:Set Time-to-live value for multicasts packets. It define number of routers
+ for transfer of datas. If you set this to 1 (dafault system value), then
+ multicasts packet goes only to you local network. If you need transport
+ multicast packet to worldwide, then increase this value, but be carefull,
+ lot of routers on internet does not transport multicasts packets!}
+ property MulticastTTL: Integer read GetMulticastTTL Write SetMulticastTTL;
+ end;
+
+ {:@abstract(Implementation of RAW ICMP socket.)
+ For this object you must have rights for creating RAW sockets!}
+ TICMPBlockSocket = class(TDgramBlockSocket)
+ public
+ {:Return value of socket type. For RAW and ICMP return SOCK_RAW.}
+ function GetSocketType: integer; override;
+
+ {:Return value of protocol type for socket creation. For ICMP returns
+ IPPROTO_ICMP or IPPROTO_ICMPV6}
+ function GetSocketProtocol: integer; override;
+ end;
+
+ {:@abstract(Implementation of RAW socket.)
+ For this object you must have rights for creating RAW sockets!}
+ TRAWBlockSocket = class(TBlockSocket)
+ public
+ {:Return value of socket type. For RAW and ICMP return SOCK_RAW.}
+ function GetSocketType: integer; override;
+
+ {:Return value of protocol type for socket creation. For RAW returns
+ IPPROTO_RAW.}
+ function GetSocketProtocol: integer; override;
+ end;
+
+ {:@abstract(Implementation of PGM-message socket.)
+ Not all systems supports this protocol!}
+ TPGMMessageBlockSocket = class(TBlockSocket)
+ public
+ {:Return value of socket type. For PGM-message return SOCK_RDM.}
+ function GetSocketType: integer; override;
+
+ {:Return value of protocol type for socket creation. For PGM-message returns
+ IPPROTO_RM.}
+ function GetSocketProtocol: integer; override;
+ end;
+
+ {:@abstract(Implementation of PGM-stream socket.)
+ Not all systems supports this protocol!}
+ TPGMStreamBlockSocket = class(TBlockSocket)
+ public
+ {:Return value of socket type. For PGM-stream return SOCK_STREAM.}
+ function GetSocketType: integer; override;
+
+ {:Return value of protocol type for socket creation. For PGM-stream returns
+ IPPROTO_RM.}
+ function GetSocketProtocol: integer; override;
+ end;
+
+ {:@abstract(Parent class for all SSL plugins.)
+ This is abstract class defining interface for other SSL plugins.
+
+ Instance of this class will be created for each @link(TTCPBlockSocket).
+
+ Warning: not all methods and propertis can work in all existing SSL plugins!
+ Please, read documentation of used SSL plugin.}
+ TCustomSSL = class(TObject)
+ private
+ protected
+ FOnVerifyCert: THookVerifyCert;
+ FSocket: TTCPBlockSocket;
+ FSSLEnabled: Boolean;
+ FLastError: integer;
+ FLastErrorDesc: string;
+ FSSLType: TSSLType;
+ FKeyPassword: string;
+ FCiphers: string;
+ FCertificateFile: string;
+ FPrivateKeyFile: string;
+ FCertificate: Ansistring;
+ FPrivateKey: Ansistring;
+ FPFX: Ansistring;
+ FPFXfile: string;
+ FCertCA: Ansistring;
+ FCertCAFile: string;
+ FTrustCertificate: Ansistring;
+ FTrustCertificateFile: string;
+ FVerifyCert: Boolean;
+ FUsername: string;
+ FPassword: string;
+ FSSHChannelType: string;
+ FSSHChannelArg1: string;
+ FSSHChannelArg2: string;
+ FCertComplianceLevel: integer;
+ FSNIHost: string;
+ procedure ReturnError;
+ procedure SetCertCAFile(const Value: string); virtual;
+ function DoVerifyCert:boolean;
+ function CreateSelfSignedCert(Host: string): Boolean; virtual;
+ public
+ {: Create plugin class. it is called internally from @link(TTCPBlockSocket)}
+ constructor Create(const Value: TTCPBlockSocket); virtual;
+
+ {: Assign settings (certificates and configuration) from another SSL plugin
+ class.}
+ procedure Assign(const Value: TCustomSSL); virtual;
+
+ {: return description of used plugin. It usually return name and version
+ of used SSL library.}
+ function LibVersion: String; virtual;
+
+ {: return name of used plugin.}
+ function LibName: String; virtual;
+
+ {: Do not call this directly. It is used internally by @link(TTCPBlockSocket)!
+
+ Here is needed code for start SSL connection.}
+ function Connect: boolean; virtual;
+
+ {: Do not call this directly. It is used internally by @link(TTCPBlockSocket)!
+
+ Here is needed code for acept new SSL connection.}
+ function Accept: boolean; virtual;
+
+ {: Do not call this directly. It is used internally by @link(TTCPBlockSocket)!
+
+ Here is needed code for hard shutdown of SSL connection. (for example,
+ before socket is closed)}
+ function Shutdown: boolean; virtual;
+
+ {: Do not call this directly. It is used internally by @link(TTCPBlockSocket)!
+
+ Here is needed code for soft shutdown of SSL connection. (for example,
+ when you need to continue with unprotected connection.)}
+ function BiShutdown: boolean; virtual;
+
+ {: Do not call this directly. It is used internally by @link(TTCPBlockSocket)!
+
+ Here is needed code for sending some datas by SSL connection.}
+ function SendBuffer(Buffer: TMemory; Len: Integer): Integer; virtual;
+
+ {: Do not call this directly. It is used internally by @link(TTCPBlockSocket)!
+
+ Here is needed code for receiving some datas by SSL connection.}
+ function RecvBuffer(Buffer: TMemory; Len: Integer): Integer; virtual;
+
+ {: Do not call this directly. It is used internally by @link(TTCPBlockSocket)!
+
+ Here is needed code for getting count of datas what waiting for read.
+ If SSL plugin not allows this, then it should return 0.}
+ function WaitingData: Integer; virtual;
+
+ {:Return string with identificator of SSL/TLS version of existing
+ connection.}
+ function GetSSLVersion: string; virtual;
+
+ {:Return subject of remote SSL peer.}
+ function GetPeerSubject: string; virtual;
+
+ {:Return Serial number if remote X509 certificate.}
+ function GetPeerSerialNo: integer; virtual;
+
+ {:Return issuer certificate of remote SSL peer.}
+ function GetPeerIssuer: string; virtual;
+
+ {:Return peer name from remote side certificate. This is good for verify,
+ if certificate is generated for remote side IP name.}
+ function GetPeerName: string; virtual;
+
+ {:Returns has of peer name from remote side certificate. This is good
+ for fast remote side authentication.}
+ function GetPeerNameHash: cardinal; virtual;
+
+ {:Return fingerprint of remote SSL peer.}
+ function GetPeerFingerprint: string; virtual;
+
+ {:Return all detailed information about certificate from remote side of
+ SSL/TLS connection. Result string can be multilined! Each plugin can return
+ this informations in different format!}
+ function GetCertInfo: string; virtual;
+
+ {:Return currently used Cipher.}
+ function GetCipherName: string; virtual;
+
+ {:Return currently used number of bits in current Cipher algorythm.}
+ function GetCipherBits: integer; virtual;
+
+ {:Return number of bits in current Cipher algorythm.}
+ function GetCipherAlgBits: integer; virtual;
+
+ {:Return result value of verify remote side certificate. Look to OpenSSL
+ documentation for possible values. For example 0 is successfuly verified
+ certificate, or 18 is self-signed certificate.}
+ function GetVerifyCert: integer; virtual;
+
+ {: Resurn @true if SSL mode is enabled on existing cvonnection.}
+ property SSLEnabled: Boolean read FSSLEnabled;
+
+ {:Return error code of last SSL operation. 0 is OK.}
+ property LastError: integer read FLastError;
+
+ {:Return error description of last SSL operation.}
+ property LastErrorDesc: string read FLastErrorDesc;
+ published
+ {:Here you can specify requested SSL/TLS mode. Default is autodetection, but
+ on some servers autodetection not working properly. In this case you must
+ specify requested SSL/TLS mode by your hand!}
+ property SSLType: TSSLType read FSSLType write FSSLType;
+
+ {:Password for decrypting of encoded certificate or key.}
+ property KeyPassword: string read FKeyPassword write FKeyPassword;
+
+ {:Username for possible credentials.}
+ property Username: string read FUsername write FUsername;
+
+ {:password for possible credentials.}
+ property Password: string read FPassword write FPassword;
+
+ {:By this property you can modify default set of SSL/TLS ciphers.}
+ property Ciphers: string read FCiphers write FCiphers;
+
+ {:Used for loading certificate from disk file. See to plugin documentation
+ if this method is supported and how!}
+ property CertificateFile: string read FCertificateFile write FCertificateFile;
+
+ {:Used for loading private key from disk file. See to plugin documentation
+ if this method is supported and how!}
+ property PrivateKeyFile: string read FPrivateKeyFile write FPrivateKeyFile;
+
+ {:Used for loading certificate from binary string. See to plugin documentation
+ if this method is supported and how!}
+ property Certificate: Ansistring read FCertificate write FCertificate;
+
+ {:Used for loading private key from binary string. See to plugin documentation
+ if this method is supported and how!}
+ property PrivateKey: Ansistring read FPrivateKey write FPrivateKey;
+
+ {:Used for loading PFX from binary string. See to plugin documentation
+ if this method is supported and how!}
+ property PFX: Ansistring read FPFX write FPFX;
+
+ {:Used for loading PFX from disk file. See to plugin documentation
+ if this method is supported and how!}
+ property PFXfile: string read FPFXfile write FPFXfile;
+
+ {:Used for loading trusted certificates from disk file. See to plugin documentation
+ if this method is supported and how!}
+ property TrustCertificateFile: string read FTrustCertificateFile write FTrustCertificateFile;
+
+ {:Used for loading trusted certificates from binary string. See to plugin documentation
+ if this method is supported and how!}
+ property TrustCertificate: Ansistring read FTrustCertificate write FTrustCertificate;
+
+ {:Used for loading CA certificates from binary string. See to plugin documentation
+ if this method is supported and how!}
+ property CertCA: Ansistring read FCertCA write FCertCA;
+
+ {:Used for loading CA certificates from disk file. See to plugin documentation
+ if this method is supported and how!}
+ property CertCAFile: string read FCertCAFile write SetCertCAFile;
+
+ {:If @true, then is verified client certificate. (it is good for writing
+ SSL/TLS servers.) When you are not server, but you are client, then if this
+ property is @true, verify servers certificate.}
+ property VerifyCert: Boolean read FVerifyCert write FVerifyCert;
+
+ {:channel type for possible SSH connections}
+ property SSHChannelType: string read FSSHChannelType write FSSHChannelType;
+
+ {:First argument of channel type for possible SSH connections}
+ property SSHChannelArg1: string read FSSHChannelArg1 write FSSHChannelArg1;
+
+ {:Second argument of channel type for possible SSH connections}
+ property SSHChannelArg2: string read FSSHChannelArg2 write FSSHChannelArg2;
+
+ {: Level of standards compliance level
+ (CryptLib: values in cryptlib.pas, -1: use default value ) }
+ property CertComplianceLevel:integer read FCertComplianceLevel write FCertComplianceLevel;
+
+ {:This event is called when verifying the server certificate immediatally after
+ a successfull verification in the ssl library.}
+ property OnVerifyCert: THookVerifyCert read FOnVerifyCert write FOnVerifyCert;
+
+ {: Server Name Identification. Host name to send to server. If empty the host name
+ found in URL will be used, which should be the normal use (http Header Host = SNI Host).
+ The value is cleared after the connection is established.
+ (SNI support requires OpenSSL 0.9.8k or later. Cryptlib not supported, yet ) }
+ property SNIHost:string read FSNIHost write FSNIHost;
+ end;
+
+ {:@abstract(Default SSL plugin with no SSL support.)
+ Dummy SSL plugin implementation for applications without SSL/TLS support.}
+ TSSLNone = class (TCustomSSL)
+ public
+ {:See @inherited}
+ function LibVersion: String; override;
+ {:See @inherited}
+ function LibName: String; override;
+ end;
+
+ {:@abstract(Record with definition of IP packet header.)
+ For reading data from ICMP or RAW sockets.}
+ TIPHeader = record
+ VerLen: Byte;
+ TOS: Byte;
+ TotalLen: Word;
+ Identifer: Word;
+ FragOffsets: Word;
+ TTL: Byte;
+ Protocol: Byte;
+ CheckSum: Word;
+ SourceIp: LongWord;
+ DestIp: LongWord;
+ Options: LongWord;
+ end;
+
+ {:@abstract(Parent class of application protocol implementations.)
+ By this class is defined common properties.}
+ TSynaClient = Class(TObject)
+ protected
+ FTargetHost: string;
+ FTargetPort: string;
+ FIPInterface: string;
+ FTimeout: integer;
+ FUserName: string;
+ FPassword: string;
+ public
+ constructor Create;
+ published
+ {:Specify terget server IP (or symbolic name). Default is 'localhost'.}
+ property TargetHost: string read FTargetHost Write FTargetHost;
+
+ {:Specify terget server port (or symbolic name).}
+ property TargetPort: string read FTargetPort Write FTargetPort;
+
+ {:Defined local socket address. (outgoing IP address). By default is used
+ '0.0.0.0' as wildcard for default IP.}
+ property IPInterface: string read FIPInterface Write FIPInterface;
+
+ {:Specify default timeout for socket operations.}
+ property Timeout: integer read FTimeout Write FTimeout;
+
+ {:If protocol need user authorization, then fill here username.}
+ property UserName: string read FUserName Write FUserName;
+
+ {:If protocol need user authorization, then fill here password.}
+ property Password: string read FPassword Write FPassword;
+ end;
+
+var
+ {:Selected SSL plugin. Default is @link(TSSLNone).
+
+ Do not change this value directly!!!
+
+ Just add your plugin unit to your project uses instead. Each plugin unit have
+ initialization code what modify this variable.}
+ SSLImplementation: TSSLClass = TSSLNone;
+
+implementation
+
+{$IFDEF ONCEWINSOCK}
+var
+ WsaDataOnce: TWSADATA;
+ e: ESynapseError;
+{$ENDIF}
+
+
+constructor TBlockSocket.Create;
+begin
+ CreateAlternate('');
+end;
+
+constructor TBlockSocket.CreateAlternate(Stub: string);
+{$IFNDEF ONCEWINSOCK}
+var
+ e: ESynapseError;
+{$ENDIF}
+begin
+ inherited Create;
+ FDelayedOptions := TList.Create;
+ FRaiseExcept := False;
+{$IFDEF RAISEEXCEPT}
+ FRaiseExcept := True;
+{$ENDIF}
+ FSocket := INVALID_SOCKET;
+ FBuffer := '';
+ FLastCR := False;
+ FLastLF := False;
+ FBinded := False;
+ FNonBlockMode := False;
+ FMaxLineLength := 0;
+ FMaxSendBandwidth := 0;
+ FNextSend := 0;
+ FMaxRecvBandwidth := 0;
+ FNextRecv := 0;
+ FConvertLineEnd := False;
+ FFamily := SF_Any;
+ FFamilySave := SF_Any;
+ FIP6used := False;
+ FPreferIP4 := True;
+ FInterPacketTimeout := True;
+ FRecvCounter := 0;
+ FSendCounter := 0;
+ FSendMaxChunk := c64k;
+ FStopFlag := False;
+ FNonblockSendTimeout := 15000;
+ FHeartbeatRate := 0;
+ FOwner := nil;
+{$IFNDEF ONCEWINSOCK}
+ if Stub = '' then
+ Stub := DLLStackName;
+ if not InitSocketInterface(Stub) then
+ begin
+ e := ESynapseError.Create('Error loading Socket interface (' + Stub + ')!');
+ e.ErrorCode := 0;
+ e.ErrorMessage := 'Error loading Socket interface (' + Stub + ')!';
+ raise e;
+ end;
+ SockCheck(synsock.WSAStartup(WinsockLevel, FWsaDataOnce));
+ ExceptCheck;
+{$ENDIF}
+end;
+
+destructor TBlockSocket.Destroy;
+var
+ n: integer;
+ p: TSynaOption;
+begin
+ CloseSocket;
+{$IFNDEF ONCEWINSOCK}
+ synsock.WSACleanup;
+ DestroySocketInterface;
+{$ENDIF}
+ for n := FDelayedOptions.Count - 1 downto 0 do
+ begin
+ p := TSynaOption(FDelayedOptions[n]);
+ p.Free;
+ end;
+ FDelayedOptions.Free;
+ inherited Destroy;
+end;
+
+function TBlockSocket.FamilyToAF(f: TSocketFamily): TAddrFamily;
+begin
+ case f of
+ SF_ip4:
+ Result := AF_INET;
+ SF_ip6:
+ Result := AF_INET6;
+ else
+ Result := AF_UNSPEC;
+ end;
+end;
+
+procedure TBlockSocket.SetDelayedOption(const Value: TSynaOption);
+var
+ li: TLinger;
+ x: integer;
+ buf: TMemory;
+{$IFNDEF MSWINDOWS}
+ timeval: TTimeval;
+{$ENDIF}
+begin
+ case value.Option of
+ SOT_Linger:
+ begin
+ {$IFDEF CIL}
+ li := TLinger.Create(Value.Enabled, Value.Value div 1000);
+ synsock.SetSockOptObj(FSocket, integer(SOL_SOCKET), integer(SO_LINGER), li);
+ {$ELSE}
+ li.l_onoff := Ord(Value.Enabled);
+ li.l_linger := Value.Value div 1000;
+ buf := @li;
+ synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_LINGER), buf, SizeOf(li));
+ {$ENDIF}
+ end;
+ SOT_RecvBuff:
+ begin
+ {$IFDEF CIL}
+ buf := System.BitConverter.GetBytes(value.Value);
+ {$ELSE}
+ buf := @Value.Value;
+ {$ENDIF}
+ synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_RCVBUF),
+ buf, SizeOf(Value.Value));
+ end;
+ SOT_SendBuff:
+ begin
+ {$IFDEF CIL}
+ buf := System.BitConverter.GetBytes(value.Value);
+ {$ELSE}
+ buf := @Value.Value;
+ {$ENDIF}
+ synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_SNDBUF),
+ buf, SizeOf(Value.Value));
+ end;
+ SOT_NonBlock:
+ begin
+ FNonBlockMode := Value.Enabled;
+ x := Ord(FNonBlockMode);
+ synsock.IoctlSocket(FSocket, FIONBIO, x);
+ end;
+ SOT_RecvTimeout:
+ begin
+ {$IFDEF CIL}
+ buf := System.BitConverter.GetBytes(value.Value);
+ synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_RCVTIMEO),
+ buf, SizeOf(Value.Value));
+ {$ELSE}
+ {$IFDEF MSWINDOWS}
+ buf := @Value.Value;
+ synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_RCVTIMEO),
+ buf, SizeOf(Value.Value));
+ {$ELSE}
+ timeval.tv_sec:=Value.Value div 1000;
+ timeval.tv_usec:=(Value.Value mod 1000) * 1000;
+ synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_RCVTIMEO),
+ @timeval, SizeOf(timeval));
+ {$ENDIF}
+ {$ENDIF}
+ end;
+ SOT_SendTimeout:
+ begin
+ {$IFDEF CIL}
+ buf := System.BitConverter.GetBytes(value.Value);
+ {$ELSE}
+ {$IFDEF MSWINDOWS}
+ buf := @Value.Value;
+ synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_SNDTIMEO),
+ buf, SizeOf(Value.Value));
+ {$ELSE}
+ timeval.tv_sec:=Value.Value div 1000;
+ timeval.tv_usec:=(Value.Value mod 1000) * 1000;
+ synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_SNDTIMEO),
+ @timeval, SizeOf(timeval));
+ {$ENDIF}
+ {$ENDIF}
+ end;
+ SOT_Reuse:
+ begin
+ x := Ord(Value.Enabled);
+ {$IFDEF CIL}
+ buf := System.BitConverter.GetBytes(x);
+ {$ELSE}
+ buf := @x;
+ {$ENDIF}
+ synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_REUSEADDR), buf, SizeOf(x));
+ end;
+ SOT_TTL:
+ begin
+ {$IFDEF CIL}
+ buf := System.BitConverter.GetBytes(value.Value);
+ {$ELSE}
+ buf := @Value.Value;
+ {$ENDIF}
+ if FIP6Used then
+ synsock.SetSockOpt(FSocket, integer(IPPROTO_IPV6), integer(IPV6_UNICAST_HOPS),
+ buf, SizeOf(Value.Value))
+ else
+ synsock.SetSockOpt(FSocket, integer(IPPROTO_IP), integer(IP_TTL),
+ buf, SizeOf(Value.Value));
+ end;
+ SOT_Broadcast:
+ begin
+//#todo1 broadcasty na IP6
+ x := Ord(Value.Enabled);
+ {$IFDEF CIL}
+ buf := System.BitConverter.GetBytes(x);
+ {$ELSE}
+ buf := @x;
+ {$ENDIF}
+ synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_BROADCAST), buf, SizeOf(x));
+ end;
+ SOT_MulticastTTL:
+ begin
+ {$IFDEF CIL}
+ buf := System.BitConverter.GetBytes(value.Value);
+ {$ELSE}
+ buf := @Value.Value;
+ {$ENDIF}
+ if FIP6Used then
+ synsock.SetSockOpt(FSocket, integer(IPPROTO_IPV6), integer(IPV6_MULTICAST_HOPS),
+ buf, SizeOf(Value.Value))
+ else
+ synsock.SetSockOpt(FSocket, integer(IPPROTO_IP), integer(IP_MULTICAST_TTL),
+ buf, SizeOf(Value.Value));
+ end;
+ SOT_MulticastLoop:
+ begin
+ x := Ord(Value.Enabled);
+ {$IFDEF CIL}
+ buf := System.BitConverter.GetBytes(x);
+ {$ELSE}
+ buf := @x;
+ {$ENDIF}
+ if FIP6Used then
+ synsock.SetSockOpt(FSocket, integer(IPPROTO_IPV6), integer(IPV6_MULTICAST_LOOP), buf, SizeOf(x))
+ else
+ synsock.SetSockOpt(FSocket, integer(IPPROTO_IP), integer(IP_MULTICAST_LOOP), buf, SizeOf(x));
+ end;
+ end;
+ Value.free;
+end;
+
+procedure TBlockSocket.DelayedOption(const Value: TSynaOption);
+begin
+ if FSocket = INVALID_SOCKET then
+ begin
+ FDelayedOptions.Insert(0, Value);
+ end
+ else
+ SetDelayedOption(Value);
+end;
+
+procedure TBlockSocket.ProcessDelayedOptions;
+var
+ n: integer;
+ d: TSynaOption;
+begin
+ for n := FDelayedOptions.Count - 1 downto 0 do
+ begin
+ d := TSynaOption(FDelayedOptions[n]);
+ SetDelayedOption(d);
+ end;
+ FDelayedOptions.Clear;
+end;
+
+procedure TBlockSocket.SetSin(var Sin: TVarSin; IP, Port: string);
+var
+ f: TSocketFamily;
+begin
+ DoStatus(HR_ResolvingBegin, IP + ':' + Port);
+ ResetLastError;
+ //if socket exists, then use their type, else use users selection
+ f := SF_Any;
+ if (FSocket = INVALID_SOCKET) and (FFamily = SF_any) then
+ begin
+ if IsIP(IP) then
+ f := SF_IP4
+ else
+ if IsIP6(IP) then
+ f := SF_IP6;
+ end
+ else
+ f := FFamily;
+ FLastError := synsock.SetVarSin(sin, ip, port, FamilyToAF(f),
+ GetSocketprotocol, GetSocketType, FPreferIP4);
+ DoStatus(HR_ResolvingEnd, GetSinIP(sin) + ':' + IntTostr(GetSinPort(sin)));
+end;
+
+function TBlockSocket.GetSinIP(Sin: TVarSin): string;
+begin
+ Result := synsock.GetSinIP(sin);
+end;
+
+function TBlockSocket.GetSinPort(Sin: TVarSin): Integer;
+begin
+ Result := synsock.GetSinPort(sin);
+end;
+
+procedure TBlockSocket.CreateSocket;
+var
+ sin: TVarSin;
+begin
+ //dummy for SF_Any Family mode
+ ResetLastError;
+ if (FFamily <> SF_Any) and (FSocket = INVALID_SOCKET) then
+ begin
+ {$IFDEF CIL}
+ if FFamily = SF_IP6 then
+ sin := TVarSin.Create(IPAddress.Parse('::0'), 0)
+ else
+ sin := TVarSin.Create(IPAddress.Parse('0.0.0.0'), 0);
+ {$ELSE}
+ FillChar(Sin, Sizeof(Sin), 0);
+ if FFamily = SF_IP6 then
+ sin.sin_family := AF_INET6
+ else
+ sin.sin_family := AF_INET;
+ {$ENDIF}
+ InternalCreateSocket(Sin);
+ end;
+end;
+
+procedure TBlockSocket.CreateSocketByName(const Value: String);
+var
+ sin: TVarSin;
+begin
+ ResetLastError;
+ if FSocket = INVALID_SOCKET then
+ begin
+ SetSin(sin, value, '0');
+ if FLastError = 0 then
+ InternalCreateSocket(Sin);
+ end;
+end;
+
+procedure TBlockSocket.InternalCreateSocket(Sin: TVarSin);
+begin
+ FStopFlag := False;
+ FRecvCounter := 0;
+ FSendCounter := 0;
+ ResetLastError;
+ if FSocket = INVALID_SOCKET then
+ begin
+ FBuffer := '';
+ FBinded := False;
+ FIP6Used := Sin.AddressFamily = AF_INET6;
+ FSocket := synsock.Socket(integer(Sin.AddressFamily), GetSocketType, GetSocketProtocol);
+ if FSocket = INVALID_SOCKET then
+ FLastError := synsock.WSAGetLastError;
+ {$IFNDEF CIL}
+ FD_ZERO(FFDSet);
+ FD_SET(FSocket, FFDSet);
+ {$ENDIF}
+ ExceptCheck;
+ if FIP6used then
+ DoStatus(HR_SocketCreate, 'IPv6')
+ else
+ DoStatus(HR_SocketCreate, 'IPv4');
+ ProcessDelayedOptions;
+ DoCreateSocket;
+ end;
+end;
+
+procedure TBlockSocket.CloseSocket;
+begin
+ AbortSocket;
+end;
+
+procedure TBlockSocket.AbortSocket;
+var
+ n: integer;
+ p: TSynaOption;
+begin
+ if FSocket <> INVALID_SOCKET then
+ synsock.CloseSocket(FSocket);
+ FSocket := INVALID_SOCKET;
+ for n := FDelayedOptions.Count - 1 downto 0 do
+ begin
+ p := TSynaOption(FDelayedOptions[n]);
+ p.Free;
+ end;
+ FDelayedOptions.Clear;
+ FFamily := FFamilySave;
+ DoStatus(HR_SocketClose, '');
+end;
+
+procedure TBlockSocket.Bind(IP, Port: string);
+var
+ Sin: TVarSin;
+begin
+ ResetLastError;
+ if (FSocket <> INVALID_SOCKET)
+ or not((FFamily = SF_ANY) and (IP = cAnyHost) and (Port = cAnyPort)) then
+ begin
+ SetSin(Sin, IP, Port);
+ if FLastError = 0 then
+ begin
+ if FSocket = INVALID_SOCKET then
+ InternalCreateSocket(Sin);
+ SockCheck(synsock.Bind(FSocket, Sin));
+ GetSinLocal;
+ FBuffer := '';
+ FBinded := True;
+ end;
+ ExceptCheck;
+ DoStatus(HR_Bind, IP + ':' + Port);
+ end;
+end;
+
+procedure TBlockSocket.Connect(IP, Port: string);
+var
+ Sin: TVarSin;
+begin
+ SetSin(Sin, IP, Port);
+ if FLastError = 0 then
+ begin
+ if FSocket = INVALID_SOCKET then
+ InternalCreateSocket(Sin);
+ SockCheck(synsock.Connect(FSocket, Sin));
+ if FLastError = 0 then
+ GetSins;
+ FBuffer := '';
+ FLastCR := False;
+ FLastLF := False;
+ end;
+ ExceptCheck;
+ DoStatus(HR_Connect, IP + ':' + Port);
+end;
+
+procedure TBlockSocket.Listen;
+begin
+ SockCheck(synsock.Listen(FSocket, SOMAXCONN));
+ GetSins;
+ ExceptCheck;
+ DoStatus(HR_Listen, '');
+end;
+
+function TBlockSocket.Accept: TSocket;
+begin
+ Result := synsock.Accept(FSocket, FRemoteSin);
+/// SockCheck(Result);
+ ExceptCheck;
+ DoStatus(HR_Accept, '');
+end;
+
+procedure TBlockSocket.GetSinLocal;
+begin
+ synsock.GetSockName(FSocket, FLocalSin);
+end;
+
+procedure TBlockSocket.GetSinRemote;
+begin
+ synsock.GetPeerName(FSocket, FRemoteSin);
+end;
+
+procedure TBlockSocket.GetSins;
+begin
+ GetSinLocal;
+ GetSinRemote;
+end;
+
+procedure TBlockSocket.SetBandwidth(Value: Integer);
+begin
+ MaxSendBandwidth := Value;
+ MaxRecvBandwidth := Value;
+end;
+
+procedure TBlockSocket.LimitBandwidth(Length: Integer; MaxB: integer; var Next: LongWord);
+var
+ x: LongWord;
+ y: LongWord;
+ n: integer;
+begin
+ if FStopFlag then
+ exit;
+ if MaxB > 0 then
+ begin
+ y := GetTick;
+ if Next > y then
+ begin
+ x := Next - y;
+ if x > 0 then
+ begin
+ DoStatus(HR_Wait, IntToStr(x));
+ sleep(x mod 250);
+ for n := 1 to x div 250 do
+ if FStopFlag then
+ Break
+ else
+ sleep(250);
+ end;
+ end;
+ Next := GetTick + Trunc((Length / MaxB) * 1000);
+ end;
+end;
+
+function TBlockSocket.TestStopFlag: Boolean;
+begin
+ DoHeartbeat;
+ Result := FStopFlag;
+ if Result then
+ begin
+ FStopFlag := False;
+ FLastError := WSAECONNABORTED;
+ ExceptCheck;
+ end;
+end;
+
+
+function TBlockSocket.SendBuffer(Buffer: TMemory; Length: Integer): Integer;
+{$IFNDEF CIL}
+var
+ x, y: integer;
+ l, r: integer;
+ p: Pointer;
+{$ENDIF}
+begin
+ Result := 0;
+ if TestStopFlag then
+ Exit;
+ DoMonitor(True, Buffer, Length);
+{$IFDEF CIL}
+ Result := synsock.Send(FSocket, Buffer, Length, 0);
+{$ELSE}
+ l := Length;
+ x := 0;
+ while x < l do
+ begin
+ y := l - x;
+ if y > FSendMaxChunk then
+ y := FSendMaxChunk;
+ if y > 0 then
+ begin
+ LimitBandwidth(y, FMaxSendBandwidth, FNextsend);
+ p := IncPoint(Buffer, x);
+ r := synsock.Send(FSocket, p, y, MSG_NOSIGNAL);
+ SockCheck(r);
+ if FLastError = WSAEWOULDBLOCK then
+ begin
+ if CanWrite(FNonblockSendTimeout) then
+ begin
+ r := synsock.Send(FSocket, p, y, MSG_NOSIGNAL);
+ SockCheck(r);
+ end
+ else
+ FLastError := WSAETIMEDOUT;
+ end;
+ if FLastError <> 0 then
+ Break;
+ Inc(x, r);
+ Inc(Result, r);
+ Inc(FSendCounter, r);
+ DoStatus(HR_WriteCount, IntToStr(r));
+ end
+ else
+ break;
+ end;
+{$ENDIF}
+ ExceptCheck;
+end;
+
+procedure TBlockSocket.SendByte(Data: Byte);
+{$IFDEF CIL}
+var
+ buf: TMemory;
+{$ENDIF}
+begin
+{$IFDEF CIL}
+ setlength(buf, 1);
+ buf[0] := Data;
+ SendBuffer(buf, 1);
+{$ELSE}
+ SendBuffer(@Data, 1);
+{$ENDIF}
+end;
+
+procedure TBlockSocket.SendString(Data: AnsiString);
+var
+ buf: TMemory;
+begin
+ {$IFDEF CIL}
+ buf := BytesOf(Data);
+ {$ELSE}
+ buf := Pointer(data);
+ {$ENDIF}
+ SendBuffer(buf, Length(Data));
+end;
+
+procedure TBlockSocket.SendInteger(Data: integer);
+var
+ buf: TMemory;
+begin
+ {$IFDEF CIL}
+ buf := System.BitConverter.GetBytes(Data);
+ {$ELSE}
+ buf := @Data;
+ {$ENDIF}
+ SendBuffer(buf, SizeOf(Data));
+end;
+
+procedure TBlockSocket.SendBlock(const Data: AnsiString);
+var
+ i: integer;
+begin
+ i := SwapBytes(Length(data));
+ SendString(Codelongint(i) + Data);
+end;
+
+procedure TBlockSocket.InternalSendStream(const Stream: TStream; WithSize, Indy: boolean);
+var
+ l: integer;
+ yr: integer;
+ s: AnsiString;
+ b: boolean;
+{$IFDEF CIL}
+ buf: TMemory;
+{$ENDIF}
+begin
+ b := true;
+ l := 0;
+ if WithSize then
+ begin
+ l := Stream.Size - Stream.Position;;
+ if not Indy then
+ l := synsock.HToNL(l);
+ end;
+ repeat
+ {$IFDEF CIL}
+ Setlength(buf, FSendMaxChunk);
+ yr := Stream.read(buf, FSendMaxChunk);
+ if yr > 0 then
+ begin
+ if WithSize and b then
+ begin
+ b := false;
+ SendString(CodeLongInt(l));
+ end;
+ SendBuffer(buf, yr);
+ if FLastError <> 0 then
+ break;
+ end
+ {$ELSE}
+ Setlength(s, FSendMaxChunk);
+ yr := Stream.read(Pointer(s)^, FSendMaxChunk);
+ if yr > 0 then
+ begin
+ SetLength(s, yr);
+ if WithSize and b then
+ begin
+ b := false;
+ SendString(CodeLongInt(l) + s);
+ end
+ else
+ SendString(s);
+ if FLastError <> 0 then
+ break;
+ end
+ {$ENDIF}
+ until yr <= 0;
+end;
+
+procedure TBlockSocket.SendStreamRaw(const Stream: TStream);
+begin
+ InternalSendStream(Stream, false, false);
+end;
+
+procedure TBlockSocket.SendStreamIndy(const Stream: TStream);
+begin
+ InternalSendStream(Stream, true, true);
+end;
+
+procedure TBlockSocket.SendStream(const Stream: TStream);
+begin
+ InternalSendStream(Stream, true, false);
+end;
+
+function TBlockSocket.RecvBuffer(Buffer: TMemory; Length: Integer): Integer;
+begin
+ Result := 0;
+ if TestStopFlag then
+ Exit;
+ LimitBandwidth(Length, FMaxRecvBandwidth, FNextRecv);
+// Result := synsock.Recv(FSocket, Buffer^, Length, MSG_NOSIGNAL);
+ Result := synsock.Recv(FSocket, Buffer, Length, MSG_NOSIGNAL);
+ if Result = 0 then
+ FLastError := WSAECONNRESET
+ else
+ SockCheck(Result);
+ ExceptCheck;
+ if Result > 0 then
+ begin
+ Inc(FRecvCounter, Result);
+ DoStatus(HR_ReadCount, IntToStr(Result));
+ DoMonitor(False, Buffer, Result);
+ DoReadFilter(Buffer, Result);
+ end;
+end;
+
+function TBlockSocket.RecvBufferEx(Buffer: TMemory; Len: Integer;
+ Timeout: Integer): Integer;
+var
+ s: AnsiString;
+ rl, l: integer;
+ ti: LongWord;
+{$IFDEF CIL}
+ n: integer;
+ b: TMemory;
+{$ENDIF}
+begin
+ ResetLastError;
+ Result := 0;
+ if Len > 0 then
+ begin
+ rl := 0;
+ repeat
+ ti := GetTick;
+ s := RecvPacket(Timeout);
+ l := Length(s);
+ if (rl + l) > Len then
+ l := Len - rl;
+ {$IFDEF CIL}
+ b := BytesOf(s);
+ for n := 0 to l do
+ Buffer[rl + n] := b[n];
+ {$ELSE}
+ Move(Pointer(s)^, IncPoint(Buffer, rl)^, l);
+ {$ENDIF}
+ rl := rl + l;
+ if FLastError <> 0 then
+ Break;
+ if rl >= Len then
+ Break;
+ if not FInterPacketTimeout then
+ begin
+ Timeout := Timeout - integer(TickDelta(ti, GetTick));
+ if Timeout <= 0 then
+ begin
+ FLastError := WSAETIMEDOUT;
+ Break;
+ end;
+ end;
+ until False;
+ delete(s, 1, l);
+ FBuffer := s;
+ Result := rl;
+ end;
+end;
+
+function TBlockSocket.RecvBufferStr(Len: Integer; Timeout: Integer): AnsiString;
+var
+ x: integer;
+{$IFDEF CIL}
+ buf: Tmemory;
+{$ENDIF}
+begin
+ Result := '';
+ if Len > 0 then
+ begin
+ {$IFDEF CIL}
+ Setlength(Buf, Len);
+ x := RecvBufferEx(buf, Len , Timeout);
+ if FLastError = 0 then
+ begin
+ SetLength(Buf, x);
+ Result := StringOf(buf);
+ end
+ else
+ Result := '';
+ {$ELSE}
+ Setlength(Result, Len);
+ x := RecvBufferEx(Pointer(Result), Len , Timeout);
+ if FLastError = 0 then
+ SetLength(Result, x)
+ else
+ Result := '';
+ {$ENDIF}
+ end;
+end;
+
+function TBlockSocket.RecvPacket(Timeout: Integer): AnsiString;
+var
+ x: integer;
+{$IFDEF CIL}
+ buf: TMemory;
+{$ENDIF}
+begin
+ Result := '';
+ ResetLastError;
+ if FBuffer <> '' then
+ begin
+ Result := FBuffer;
+ FBuffer := '';
+ end
+ else
+ begin
+ {$IFDEF MSWINDOWS}
+ //not drain CPU on large downloads...
+ Sleep(0);
+ {$ENDIF}
+ x := WaitingData;
+ if x > 0 then
+ begin
+ {$IFDEF CIL}
+ SetLength(Buf, x);
+ x := RecvBuffer(Buf, x);
+ if x >= 0 then
+ begin
+ SetLength(Buf, x);
+ Result := StringOf(Buf);
+ end;
+ {$ELSE}
+ SetLength(Result, x);
+ x := RecvBuffer(Pointer(Result), x);
+ if x >= 0 then
+ SetLength(Result, x);
+ {$ENDIF}
+ end
+ else
+ begin
+ if CanRead(Timeout) then
+ begin
+ x := WaitingData;
+ if x = 0 then
+ FLastError := WSAECONNRESET;
+ if x > 0 then
+ begin
+ {$IFDEF CIL}
+ SetLength(Buf, x);
+ x := RecvBuffer(Buf, x);
+ if x >= 0 then
+ begin
+ SetLength(Buf, x);
+ result := StringOf(Buf);
+ end;
+ {$ELSE}
+ SetLength(Result, x);
+ x := RecvBuffer(Pointer(Result), x);
+ if x >= 0 then
+ SetLength(Result, x);
+ {$ENDIF}
+ end;
+ end
+ else
+ FLastError := WSAETIMEDOUT;
+ end;
+ end;
+ if FConvertLineEnd and (Result <> '') then
+ begin
+ if FLastCR and (Result[1] = LF) then
+ Delete(Result, 1, 1);
+ if FLastLF and (Result[1] = CR) then
+ Delete(Result, 1, 1);
+ FLastCR := False;
+ FLastLF := False;
+ end;
+ ExceptCheck;
+end;
+
+
+function TBlockSocket.RecvByte(Timeout: Integer): Byte;
+begin
+ Result := 0;
+ ResetLastError;
+ if FBuffer = '' then
+ FBuffer := RecvPacket(Timeout);
+ if (FLastError = 0) and (FBuffer <> '') then
+ begin
+ Result := Ord(FBuffer[1]);
+ Delete(FBuffer, 1, 1);
+ end;
+ ExceptCheck;
+end;
+
+function TBlockSocket.RecvInteger(Timeout: Integer): Integer;
+var
+ s: AnsiString;
+begin
+ Result := 0;
+ s := RecvBufferStr(4, Timeout);
+ if FLastError = 0 then
+ Result := (ord(s[1]) + ord(s[2]) * 256) + (ord(s[3]) + ord(s[4]) * 256) * 65536;
+end;
+
+function TBlockSocket.RecvTerminated(Timeout: Integer; const Terminator: AnsiString): AnsiString;
+var
+ x: Integer;
+ s: AnsiString;
+ l: Integer;
+ CorCRLF: Boolean;
+ t: AnsiString;
+ tl: integer;
+ ti: LongWord;
+begin
+ ResetLastError;
+ Result := '';
+ l := Length(Terminator);
+ if l = 0 then
+ Exit;
+ tl := l;
+ CorCRLF := FConvertLineEnd and (Terminator = CRLF);
+ s := '';
+ x := 0;
+ repeat
+ //get rest of FBuffer or incomming new data...
+ ti := GetTick;
+ s := s + RecvPacket(Timeout);
+ if FLastError <> 0 then
+ Break;
+ x := 0;
+ if Length(s) > 0 then
+ if CorCRLF then
+ begin
+ t := '';
+ x := PosCRLF(s, t);
+ tl := Length(t);
+ if t = CR then
+ FLastCR := True;
+ if t = LF then
+ FLastLF := True;
+ end
+ else
+ begin
+ x := pos(Terminator, s);
+ tl := l;
+ end;
+ if (FMaxLineLength <> 0) and (Length(s) > FMaxLineLength) then
+ begin
+ FLastError := WSAENOBUFS;
+ Break;
+ end;
+ if x > 0 then
+ Break;
+ if not FInterPacketTimeout then
+ begin
+ Timeout := Timeout - integer(TickDelta(ti, GetTick));
+ if Timeout <= 0 then
+ begin
+ FLastError := WSAETIMEDOUT;
+ Break;
+ end;
+ end;
+ until False;
+ if x > 0 then
+ begin
+ Result := Copy(s, 1, x - 1);
+ Delete(s, 1, x + tl - 1);
+ end;
+ FBuffer := s;
+ ExceptCheck;
+end;
+
+function TBlockSocket.RecvString(Timeout: Integer): AnsiString;
+var
+ s: AnsiString;
+begin
+ Result := '';
+ s := RecvTerminated(Timeout, CRLF);
+ if FLastError = 0 then
+ Result := s;
+end;
+
+function TBlockSocket.RecvBlock(Timeout: Integer): AnsiString;
+var
+ x: integer;
+begin
+ Result := '';
+ x := RecvInteger(Timeout);
+ if FLastError = 0 then
+ Result := RecvBufferStr(x, Timeout);
+end;
+
+procedure TBlockSocket.RecvStreamRaw(const Stream: TStream; Timeout: Integer);
+var
+ s: AnsiString;
+begin
+ repeat
+ s := RecvPacket(Timeout);
+ if FLastError = 0 then
+ WriteStrToStream(Stream, s);
+ until FLastError <> 0;
+end;
+
+procedure TBlockSocket.RecvStreamSize(const Stream: TStream; Timeout: Integer; Size: Integer);
+var
+ s: AnsiString;
+ n: integer;
+{$IFDEF CIL}
+ buf: TMemory;
+{$ENDIF}
+begin
+ for n := 1 to (Size div FSendMaxChunk) do
+ begin
+ {$IFDEF CIL}
+ SetLength(buf, FSendMaxChunk);
+ RecvBufferEx(buf, FSendMaxChunk, Timeout);
+ if FLastError <> 0 then
+ Exit;
+ Stream.Write(buf, FSendMaxChunk);
+ {$ELSE}
+ s := RecvBufferStr(FSendMaxChunk, Timeout);
+ if FLastError <> 0 then
+ Exit;
+ WriteStrToStream(Stream, s);
+ {$ENDIF}
+ end;
+ n := Size mod FSendMaxChunk;
+ if n > 0 then
+ begin
+ {$IFDEF CIL}
+ SetLength(buf, n);
+ RecvBufferEx(buf, n, Timeout);
+ if FLastError <> 0 then
+ Exit;
+ Stream.Write(buf, n);
+ {$ELSE}
+ s := RecvBufferStr(n, Timeout);
+ if FLastError <> 0 then
+ Exit;
+ WriteStrToStream(Stream, s);
+ {$ENDIF}
+ end;
+end;
+
+procedure TBlockSocket.RecvStreamIndy(const Stream: TStream; Timeout: Integer);
+var
+ x: integer;
+begin
+ x := RecvInteger(Timeout);
+ x := synsock.NToHL(x);
+ if FLastError = 0 then
+ RecvStreamSize(Stream, Timeout, x);
+end;
+
+procedure TBlockSocket.RecvStream(const Stream: TStream; Timeout: Integer);
+var
+ x: integer;
+begin
+ x := RecvInteger(Timeout);
+ if FLastError = 0 then
+ RecvStreamSize(Stream, Timeout, x);
+end;
+
+function TBlockSocket.PeekBuffer(Buffer: TMemory; Length: Integer): Integer;
+begin
+ {$IFNDEF CIL}
+// Result := synsock.Recv(FSocket, Buffer^, Length, MSG_PEEK + MSG_NOSIGNAL);
+ Result := synsock.Recv(FSocket, Buffer, Length, MSG_PEEK + MSG_NOSIGNAL);
+ SockCheck(Result);
+ ExceptCheck;
+ {$ENDIF}
+end;
+
+function TBlockSocket.PeekByte(Timeout: Integer): Byte;
+var
+ s: string;
+begin
+ {$IFNDEF CIL}
+ Result := 0;
+ if CanRead(Timeout) then
+ begin
+ SetLength(s, 1);
+ PeekBuffer(Pointer(s), 1);
+ if s <> '' then
+ Result := Ord(s[1]);
+ end
+ else
+ FLastError := WSAETIMEDOUT;
+ ExceptCheck;
+ {$ENDIF}
+end;
+
+procedure TBlockSocket.ResetLastError;
+begin
+ FLastError := 0;
+ FLastErrorDesc := '';
+end;
+
+function TBlockSocket.SockCheck(SockResult: Integer): Integer;
+begin
+ ResetLastError;
+ if SockResult = integer(SOCKET_ERROR) then
+ begin
+ FLastError := synsock.WSAGetLastError;
+ FLastErrorDesc := GetErrorDescEx;
+ end;
+ Result := FLastError;
+end;
+
+procedure TBlockSocket.ExceptCheck;
+var
+ e: ESynapseError;
+begin
+ FLastErrorDesc := GetErrorDescEx;
+ if (LastError <> 0) and (LastError <> WSAEINPROGRESS)
+ and (LastError <> WSAEWOULDBLOCK) then
+ begin
+ DoStatus(HR_Error, IntToStr(FLastError) + ',' + FLastErrorDesc);
+ if FRaiseExcept then
+ begin
+ e := ESynapseError.Create(Format('Synapse TCP/IP Socket error %d: %s',
+ [FLastError, FLastErrorDesc]));
+ e.ErrorCode := FLastError;
+ e.ErrorMessage := FLastErrorDesc;
+ raise e;
+ end;
+ end;
+end;
+
+function TBlockSocket.WaitingData: Integer;
+var
+ x: Integer;
+begin
+ Result := 0;
+ if synsock.IoctlSocket(FSocket, FIONREAD, x) = 0 then
+ Result := x;
+ if Result > c64k then
+ Result := c64k;
+end;
+
+function TBlockSocket.WaitingDataEx: Integer;
+begin
+ if FBuffer <> '' then
+ Result := Length(FBuffer)
+ else
+ Result := WaitingData;
+end;
+
+procedure TBlockSocket.Purge;
+begin
+ Sleep(1);
+ try
+ while (Length(FBuffer) > 0) or (WaitingData > 0) do
+ begin
+ RecvPacket(0);
+ if FLastError <> 0 then
+ break;
+ end;
+ except
+ on exception do;
+ end;
+ ResetLastError;
+end;
+
+procedure TBlockSocket.SetLinger(Enable: Boolean; Linger: Integer);
+var
+ d: TSynaOption;
+begin
+ d := TSynaOption.Create;
+ d.Option := SOT_Linger;
+ d.Enabled := Enable;
+ d.Value := Linger;
+ DelayedOption(d);
+end;
+
+function TBlockSocket.LocalName: string;
+begin
+ Result := synsock.GetHostName;
+ if Result = '' then
+ Result := '127.0.0.1';
+end;
+
+procedure TBlockSocket.ResolveNameToIP(Name: string; const IPList: TStrings);
+begin
+ IPList.Clear;
+ synsock.ResolveNameToIP(Name, FamilyToAF(FFamily), GetSocketprotocol, GetSocketType, IPList);
+ if IPList.Count = 0 then
+ IPList.Add(cAnyHost);
+end;
+
+function TBlockSocket.ResolveName(Name: string): string;
+var
+ l: TStringList;
+begin
+ l := TStringList.Create;
+ try
+ ResolveNameToIP(Name, l);
+ Result := l[0];
+ finally
+ l.Free;
+ end;
+end;
+
+function TBlockSocket.ResolvePort(Port: string): Word;
+begin
+ Result := synsock.ResolvePort(Port, FamilyToAF(FFamily), GetSocketProtocol, GetSocketType);
+end;
+
+function TBlockSocket.ResolveIPToName(IP: string): string;
+begin
+ if not IsIP(IP) and not IsIp6(IP) then
+ IP := ResolveName(IP);
+ Result := synsock.ResolveIPToName(IP, FamilyToAF(FFamily), GetSocketProtocol, GetSocketType);
+end;
+
+procedure TBlockSocket.SetRemoteSin(IP, Port: string);
+begin
+ SetSin(FRemoteSin, IP, Port);
+end;
+
+function TBlockSocket.GetLocalSinIP: string;
+begin
+ Result := GetSinIP(FLocalSin);
+end;
+
+function TBlockSocket.GetRemoteSinIP: string;
+begin
+ Result := GetSinIP(FRemoteSin);
+end;
+
+function TBlockSocket.GetLocalSinPort: Integer;
+begin
+ Result := GetSinPort(FLocalSin);
+end;
+
+function TBlockSocket.GetRemoteSinPort: Integer;
+begin
+ Result := GetSinPort(FRemoteSin);
+end;
+
+function TBlockSocket.InternalCanRead(Timeout: Integer): Boolean;
+{$IFDEF CIL}
+begin
+ Result := FSocket.Poll(Timeout * 1000, SelectMode.SelectRead);
+{$ELSE}
+var
+ TimeVal: PTimeVal;
+ TimeV: TTimeVal;
+ x: Integer;
+ FDSet: TFDSet;
+begin
+ TimeV.tv_usec := (Timeout mod 1000) * 1000;
+ TimeV.tv_sec := Timeout div 1000;
+ TimeVal := @TimeV;
+ if Timeout = -1 then
+ TimeVal := nil;
+ FDSet := FFdSet;
+ x := synsock.Select(FSocket + 1, @FDSet, nil, nil, TimeVal);
+ SockCheck(x);
+ if FLastError <> 0 then
+ x := 0;
+ Result := x > 0;
+{$ENDIF}
+end;
+
+function TBlockSocket.CanRead(Timeout: Integer): Boolean;
+var
+ ti, tr: Integer;
+ n: integer;
+begin
+ if (FHeartbeatRate <> 0) and (Timeout <> -1) then
+ begin
+ ti := Timeout div FHeartbeatRate;
+ tr := Timeout mod FHeartbeatRate;
+ end
+ else
+ begin
+ ti := 0;
+ tr := Timeout;
+ end;
+ Result := InternalCanRead(tr);
+ if not Result then
+ for n := 0 to ti do
+ begin
+ DoHeartbeat;
+ if FStopFlag then
+ begin
+ Result := False;
+ FStopFlag := False;
+ Break;
+ end;
+ Result := InternalCanRead(FHeartbeatRate);
+ if Result then
+ break;
+ end;
+ ExceptCheck;
+ if Result then
+ DoStatus(HR_CanRead, '');
+end;
+
+function TBlockSocket.CanWrite(Timeout: Integer): Boolean;
+{$IFDEF CIL}
+begin
+ Result := FSocket.Poll(Timeout * 1000, SelectMode.SelectWrite);
+{$ELSE}
+var
+ TimeVal: PTimeVal;
+ TimeV: TTimeVal;
+ x: Integer;
+ FDSet: TFDSet;
+begin
+ TimeV.tv_usec := (Timeout mod 1000) * 1000;
+ TimeV.tv_sec := Timeout div 1000;
+ TimeVal := @TimeV;
+ if Timeout = -1 then
+ TimeVal := nil;
+ FDSet := FFdSet;
+ x := synsock.Select(FSocket + 1, nil, @FDSet, nil, TimeVal);
+ SockCheck(x);
+ if FLastError <> 0 then
+ x := 0;
+ Result := x > 0;
+{$ENDIF}
+ ExceptCheck;
+ if Result then
+ DoStatus(HR_CanWrite, '');
+end;
+
+function TBlockSocket.CanReadEx(Timeout: Integer): Boolean;
+begin
+ if FBuffer <> '' then
+ Result := True
+ else
+ Result := CanRead(Timeout);
+end;
+
+function TBlockSocket.SendBufferTo(Buffer: TMemory; Length: Integer): Integer;
+begin
+ Result := 0;
+ if TestStopFlag then
+ Exit;
+ DoMonitor(True, Buffer, Length);
+ LimitBandwidth(Length, FMaxSendBandwidth, FNextsend);
+ Result := synsock.SendTo(FSocket, Buffer, Length, MSG_NOSIGNAL, FRemoteSin);
+ SockCheck(Result);
+ ExceptCheck;
+ Inc(FSendCounter, Result);
+ DoStatus(HR_WriteCount, IntToStr(Result));
+end;
+
+function TBlockSocket.RecvBufferFrom(Buffer: TMemory; Length: Integer): Integer;
+begin
+ Result := 0;
+ if TestStopFlag then
+ Exit;
+ LimitBandwidth(Length, FMaxRecvBandwidth, FNextRecv);
+ Result := synsock.RecvFrom(FSocket, Buffer, Length, MSG_NOSIGNAL, FRemoteSin);
+ SockCheck(Result);
+ ExceptCheck;
+ Inc(FRecvCounter, Result);
+ DoStatus(HR_ReadCount, IntToStr(Result));
+ DoMonitor(False, Buffer, Result);
+end;
+
+function TBlockSocket.GetSizeRecvBuffer: Integer;
+var
+ l: Integer;
+{$IFDEF CIL}
+ buf: TMemory;
+{$ENDIF}
+begin
+{$IFDEF CIL}
+ setlength(buf, 4);
+ SockCheck(synsock.GetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_RCVBUF), buf, l));
+ Result := System.BitConverter.ToInt32(buf,0);
+{$ELSE}
+ l := SizeOf(Result);
+ SockCheck(synsock.GetSockOpt(FSocket, SOL_SOCKET, SO_RCVBUF, @Result, l));
+ if FLastError <> 0 then
+ Result := 1024;
+ ExceptCheck;
+{$ENDIF}
+end;
+
+procedure TBlockSocket.SetSizeRecvBuffer(Size: Integer);
+var
+ d: TSynaOption;
+begin
+ d := TSynaOption.Create;
+ d.Option := SOT_RecvBuff;
+ d.Value := Size;
+ DelayedOption(d);
+end;
+
+function TBlockSocket.GetSizeSendBuffer: Integer;
+var
+ l: Integer;
+{$IFDEF CIL}
+ buf: TMemory;
+{$ENDIF}
+begin
+{$IFDEF CIL}
+ setlength(buf, 4);
+ SockCheck(synsock.GetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_SNDBUF), buf, l));
+ Result := System.BitConverter.ToInt32(buf,0);
+{$ELSE}
+ l := SizeOf(Result);
+ SockCheck(synsock.GetSockOpt(FSocket, SOL_SOCKET, SO_SNDBUF, @Result, l));
+ if FLastError <> 0 then
+ Result := 1024;
+ ExceptCheck;
+{$ENDIF}
+end;
+
+procedure TBlockSocket.SetSizeSendBuffer(Size: Integer);
+var
+ d: TSynaOption;
+begin
+ d := TSynaOption.Create;
+ d.Option := SOT_SendBuff;
+ d.Value := Size;
+ DelayedOption(d);
+end;
+
+procedure TBlockSocket.SetNonBlockMode(Value: Boolean);
+var
+ d: TSynaOption;
+begin
+ d := TSynaOption.Create;
+ d.Option := SOT_nonblock;
+ d.Enabled := Value;
+ DelayedOption(d);
+end;
+
+procedure TBlockSocket.SetTimeout(Timeout: Integer);
+begin
+ SetSendTimeout(Timeout);
+ SetRecvTimeout(Timeout);
+end;
+
+procedure TBlockSocket.SetSendTimeout(Timeout: Integer);
+var
+ d: TSynaOption;
+begin
+ d := TSynaOption.Create;
+ d.Option := SOT_sendtimeout;
+ d.Value := Timeout;
+ DelayedOption(d);
+end;
+
+procedure TBlockSocket.SetRecvTimeout(Timeout: Integer);
+var
+ d: TSynaOption;
+begin
+ d := TSynaOption.Create;
+ d.Option := SOT_recvtimeout;
+ d.Value := Timeout;
+ DelayedOption(d);
+end;
+
+{$IFNDEF CIL}
+function TBlockSocket.GroupCanRead(const SocketList: TList; Timeout: Integer;
+ const CanReadList: TList): boolean;
+var
+ FDSet: TFDSet;
+ TimeVal: PTimeVal;
+ TimeV: TTimeVal;
+ x, n: Integer;
+ Max: Integer;
+begin
+ TimeV.tv_usec := (Timeout mod 1000) * 1000;
+ TimeV.tv_sec := Timeout div 1000;
+ TimeVal := @TimeV;
+ if Timeout = -1 then
+ TimeVal := nil;
+ FD_ZERO(FDSet);
+ Max := 0;
+ for n := 0 to SocketList.Count - 1 do
+ if TObject(SocketList.Items[n]) is TBlockSocket then
+ begin
+ if TBlockSocket(SocketList.Items[n]).Socket > Max then
+ Max := TBlockSocket(SocketList.Items[n]).Socket;
+ FD_SET(TBlockSocket(SocketList.Items[n]).Socket, FDSet);
+ end;
+ x := synsock.Select(Max + 1, @FDSet, nil, nil, TimeVal);
+ SockCheck(x);
+ ExceptCheck;
+ if FLastError <> 0 then
+ x := 0;
+ Result := x > 0;
+ CanReadList.Clear;
+ if Result then
+ for n := 0 to SocketList.Count - 1 do
+ if TObject(SocketList.Items[n]) is TBlockSocket then
+ if FD_ISSET(TBlockSocket(SocketList.Items[n]).Socket, FDSet) then
+ CanReadList.Add(TBlockSocket(SocketList.Items[n]));
+end;
+{$ENDIF}
+
+procedure TBlockSocket.EnableReuse(Value: Boolean);
+var
+ d: TSynaOption;
+begin
+ d := TSynaOption.Create;
+ d.Option := SOT_reuse;
+ d.Enabled := Value;
+ DelayedOption(d);
+end;
+
+procedure TBlockSocket.SetTTL(TTL: integer);
+var
+ d: TSynaOption;
+begin
+ d := TSynaOption.Create;
+ d.Option := SOT_TTL;
+ d.Value := TTL;
+ DelayedOption(d);
+end;
+
+function TBlockSocket.GetTTL:integer;
+var
+ l: Integer;
+begin
+{$IFNDEF CIL}
+ l := SizeOf(Result);
+ if FIP6Used then
+ synsock.GetSockOpt(FSocket, IPPROTO_IPV6, IPV6_UNICAST_HOPS, @Result, l)
+ else
+ synsock.GetSockOpt(FSocket, IPPROTO_IP, IP_TTL, @Result, l);
+{$ENDIF}
+end;
+
+procedure TBlockSocket.SetFamily(Value: TSocketFamily);
+begin
+ FFamily := Value;
+ FFamilySave := Value;
+end;
+
+procedure TBlockSocket.SetSocket(Value: TSocket);
+begin
+ FRecvCounter := 0;
+ FSendCounter := 0;
+ FSocket := Value;
+{$IFNDEF CIL}
+ FD_ZERO(FFDSet);
+ FD_SET(FSocket, FFDSet);
+{$ENDIF}
+ GetSins;
+ FIP6Used := FRemoteSin.AddressFamily = AF_INET6;
+end;
+
+function TBlockSocket.GetWsaData: TWSAData;
+begin
+ {$IFDEF ONCEWINSOCK}
+ Result := WsaDataOnce;
+ {$ELSE}
+ Result := FWsaDataOnce;
+ {$ENDIF}
+end;
+
+function TBlockSocket.GetSocketType: integer;
+begin
+ Result := 0;
+end;
+
+function TBlockSocket.GetSocketProtocol: integer;
+begin
+ Result := integer(IPPROTO_IP);
+end;
+
+procedure TBlockSocket.DoStatus(Reason: THookSocketReason; const Value: string);
+begin
+ if assigned(OnStatus) then
+ OnStatus(Self, Reason, Value);
+end;
+
+procedure TBlockSocket.DoReadFilter(Buffer: TMemory; var Len: Integer);
+var
+ s: AnsiString;
+begin
+ if assigned(OnReadFilter) then
+ if Len > 0 then
+ begin
+ {$IFDEF CIL}
+ s := StringOf(Buffer);
+ {$ELSE}
+ SetLength(s, Len);
+ Move(Buffer^, Pointer(s)^, Len);
+ {$ENDIF}
+ OnReadFilter(Self, s);
+ if Length(s) > Len then
+ SetLength(s, Len);
+ Len := Length(s);
+ {$IFDEF CIL}
+ Buffer := BytesOf(s);
+ {$ELSE}
+ Move(Pointer(s)^, Buffer^, Len);
+ {$ENDIF}
+ end;
+end;
+
+procedure TBlockSocket.DoCreateSocket;
+begin
+ if assigned(OnCreateSocket) then
+ OnCreateSocket(Self);
+end;
+
+procedure TBlockSocket.DoMonitor(Writing: Boolean; const Buffer: TMemory; Len: Integer);
+begin
+ if assigned(OnMonitor) then
+ begin
+ OnMonitor(Self, Writing, Buffer, Len);
+ end;
+end;
+
+procedure TBlockSocket.DoHeartbeat;
+begin
+ if assigned(OnHeartbeat) and (FHeartbeatRate <> 0) then
+ begin
+ OnHeartbeat(Self);
+ end;
+end;
+
+function TBlockSocket.GetErrorDescEx: string;
+begin
+ Result := GetErrorDesc(FLastError);
+end;
+
+class function TBlockSocket.GetErrorDesc(ErrorCode: Integer): string;
+begin
+{$IFDEF CIL}
+ if ErrorCode = 0 then
+ Result := ''
+ else
+ begin
+ Result := WSAGetLastErrorDesc;
+ if Result = '' then
+ Result := 'Other Winsock error (' + IntToStr(ErrorCode) + ')';
+ end;
+{$ELSE}
+ case ErrorCode of
+ 0:
+ Result := '';
+ WSAEINTR: {10004}
+ Result := 'Interrupted system call';
+ WSAEBADF: {10009}
+ Result := 'Bad file number';
+ WSAEACCES: {10013}
+ Result := 'Permission denied';
+ WSAEFAULT: {10014}
+ Result := 'Bad address';
+ WSAEINVAL: {10022}
+ Result := 'Invalid argument';
+ WSAEMFILE: {10024}
+ Result := 'Too many open files';
+ WSAEWOULDBLOCK: {10035}
+ Result := 'Operation would block';
+ WSAEINPROGRESS: {10036}
+ Result := 'Operation now in progress';
+ WSAEALREADY: {10037}
+ Result := 'Operation already in progress';
+ WSAENOTSOCK: {10038}
+ Result := 'Socket operation on nonsocket';
+ WSAEDESTADDRREQ: {10039}
+ Result := 'Destination address required';
+ WSAEMSGSIZE: {10040}
+ Result := 'Message too long';
+ WSAEPROTOTYPE: {10041}
+ Result := 'Protocol wrong type for Socket';
+ WSAENOPROTOOPT: {10042}
+ Result := 'Protocol not available';
+ WSAEPROTONOSUPPORT: {10043}
+ Result := 'Protocol not supported';
+ WSAESOCKTNOSUPPORT: {10044}
+ Result := 'Socket not supported';
+ WSAEOPNOTSUPP: {10045}
+ Result := 'Operation not supported on Socket';
+ WSAEPFNOSUPPORT: {10046}
+ Result := 'Protocol family not supported';
+ WSAEAFNOSUPPORT: {10047}
+ Result := 'Address family not supported';
+ WSAEADDRINUSE: {10048}
+ Result := 'Address already in use';
+ WSAEADDRNOTAVAIL: {10049}
+ Result := 'Can''t assign requested address';
+ WSAENETDOWN: {10050}
+ Result := 'Network is down';
+ WSAENETUNREACH: {10051}
+ Result := 'Network is unreachable';
+ WSAENETRESET: {10052}
+ Result := 'Network dropped connection on reset';
+ WSAECONNABORTED: {10053}
+ Result := 'Software caused connection abort';
+ WSAECONNRESET: {10054}
+ Result := 'Connection reset by peer';
+ WSAENOBUFS: {10055}
+ Result := 'No Buffer space available';
+ WSAEISCONN: {10056}
+ Result := 'Socket is already connected';
+ WSAENOTCONN: {10057}
+ Result := 'Socket is not connected';
+ WSAESHUTDOWN: {10058}
+ Result := 'Can''t send after Socket shutdown';
+ WSAETOOMANYREFS: {10059}
+ Result := 'Too many references:can''t splice';
+ WSAETIMEDOUT: {10060}
+ Result := 'Connection timed out';
+ WSAECONNREFUSED: {10061}
+ Result := 'Connection refused';
+ WSAELOOP: {10062}
+ Result := 'Too many levels of symbolic links';
+ WSAENAMETOOLONG: {10063}
+ Result := 'File name is too long';
+ WSAEHOSTDOWN: {10064}
+ Result := 'Host is down';
+ WSAEHOSTUNREACH: {10065}
+ Result := 'No route to host';
+ WSAENOTEMPTY: {10066}
+ Result := 'Directory is not empty';
+ WSAEPROCLIM: {10067}
+ Result := 'Too many processes';
+ WSAEUSERS: {10068}
+ Result := 'Too many users';
+ WSAEDQUOT: {10069}
+ Result := 'Disk quota exceeded';
+ WSAESTALE: {10070}
+ Result := 'Stale NFS file handle';
+ WSAEREMOTE: {10071}
+ Result := 'Too many levels of remote in path';
+ WSASYSNOTREADY: {10091}
+ Result := 'Network subsystem is unusable';
+ WSAVERNOTSUPPORTED: {10092}
+ Result := 'Winsock DLL cannot support this application';
+ WSANOTINITIALISED: {10093}
+ Result := 'Winsock not initialized';
+ WSAEDISCON: {10101}
+ Result := 'Disconnect';
+ WSAHOST_NOT_FOUND: {11001}
+ Result := 'Host not found';
+ WSATRY_AGAIN: {11002}
+ Result := 'Non authoritative - host not found';
+ WSANO_RECOVERY: {11003}
+ Result := 'Non recoverable error';
+ WSANO_DATA: {11004}
+ Result := 'Valid name, no data record of requested type'
+ else
+ Result := 'Other Winsock error (' + IntToStr(ErrorCode) + ')';
+ end;
+{$ENDIF}
+end;
+
+{======================================================================}
+
+constructor TSocksBlockSocket.Create;
+begin
+ inherited Create;
+ FSocksIP:= '';
+ FSocksPort:= '1080';
+ FSocksTimeout:= 60000;
+ FSocksUsername:= '';
+ FSocksPassword:= '';
+ FUsingSocks := False;
+ FSocksResolver := True;
+ FSocksLastError := 0;
+ FSocksResponseIP := '';
+ FSocksResponsePort := '';
+ FSocksLocalIP := '';
+ FSocksLocalPort := '';
+ FSocksRemoteIP := '';
+ FSocksRemotePort := '';
+ FBypassFlag := False;
+ FSocksType := ST_Socks5;
+end;
+
+function TSocksBlockSocket.SocksOpen: boolean;
+var
+ Buf: AnsiString;
+ n: integer;
+begin
+ Result := False;
+ FUsingSocks := False;
+ if FSocksType <> ST_Socks5 then
+ begin
+ FUsingSocks := True;
+ Result := True;
+ end
+ else
+ begin
+ FBypassFlag := True;
+ try
+ if FSocksUsername = '' then
+ Buf := #5 + #1 + #0
+ else
+ Buf := #5 + #2 + #2 +#0;
+ SendString(Buf);
+ Buf := RecvBufferStr(2, FSocksTimeout);
+ if Length(Buf) < 2 then
+ Exit;
+ if Buf[1] <> #5 then
+ Exit;
+ n := Ord(Buf[2]);
+ case n of
+ 0: //not need authorisation
+ ;
+ 2:
+ begin
+ Buf := #1 + AnsiChar(Length(FSocksUsername)) + FSocksUsername
+ + AnsiChar(Length(FSocksPassword)) + FSocksPassword;
+ SendString(Buf);
+ Buf := RecvBufferStr(2, FSocksTimeout);
+ if Length(Buf) < 2 then
+ Exit;
+ if Buf[2] <> #0 then
+ Exit;
+ end;
+ else
+ //other authorisation is not supported!
+ Exit;
+ end;
+ FUsingSocks := True;
+ Result := True;
+ finally
+ FBypassFlag := False;
+ end;
+ end;
+end;
+
+function TSocksBlockSocket.SocksRequest(Cmd: Byte;
+ const IP, Port: string): Boolean;
+var
+ Buf: AnsiString;
+begin
+ FBypassFlag := True;
+ try
+ if FSocksType <> ST_Socks5 then
+ Buf := #4 + AnsiChar(Cmd) + SocksCode(IP, Port)
+ else
+ Buf := #5 + AnsiChar(Cmd) + #0 + SocksCode(IP, Port);
+ SendString(Buf);
+ Result := FLastError = 0;
+ finally
+ FBypassFlag := False;
+ end;
+end;
+
+function TSocksBlockSocket.SocksResponse: Boolean;
+var
+ Buf, s: AnsiString;
+ x: integer;
+begin
+ Result := False;
+ FBypassFlag := True;
+ try
+ FSocksResponseIP := '';
+ FSocksResponsePort := '';
+ FSocksLastError := -1;
+ if FSocksType <> ST_Socks5 then
+ begin
+ Buf := RecvBufferStr(8, FSocksTimeout);
+ if FLastError <> 0 then
+ Exit;
+ if Buf[1] <> #0 then
+ Exit;
+ FSocksLastError := Ord(Buf[2]);
+ end
+ else
+ begin
+ Buf := RecvBufferStr(4, FSocksTimeout);
+ if FLastError <> 0 then
+ Exit;
+ if Buf[1] <> #5 then
+ Exit;
+ case Ord(Buf[4]) of
+ 1:
+ s := RecvBufferStr(4, FSocksTimeout);
+ 3:
+ begin
+ x := RecvByte(FSocksTimeout);
+ if FLastError <> 0 then
+ Exit;
+ s := AnsiChar(x) + RecvBufferStr(x, FSocksTimeout);
+ end;
+ 4:
+ s := RecvBufferStr(16, FSocksTimeout);
+ else
+ Exit;
+ end;
+ Buf := Buf + s + RecvBufferStr(2, FSocksTimeout);
+ if FLastError <> 0 then
+ Exit;
+ FSocksLastError := Ord(Buf[2]);
+ end;
+ if ((FSocksLastError <> 0) and (FSocksLastError <> 90)) then
+ Exit;
+ SocksDecode(Buf);
+ Result := True;
+ finally
+ FBypassFlag := False;
+ end;
+end;
+
+function TSocksBlockSocket.SocksCode(IP, Port: string): Ansistring;
+var
+ ip6: TIp6Bytes;
+ n: integer;
+begin
+ if FSocksType <> ST_Socks5 then
+ begin
+ Result := CodeInt(ResolvePort(Port));
+ if not FSocksResolver then
+ IP := ResolveName(IP);
+ if IsIP(IP) then
+ begin
+ Result := Result + IPToID(IP);
+ Result := Result + FSocksUsername + #0;
+ end
+ else
+ begin
+ Result := Result + IPToID('0.0.0.1');
+ Result := Result + FSocksUsername + #0;
+ Result := Result + IP + #0;
+ end;
+ end
+ else
+ begin
+ if not FSocksResolver then
+ IP := ResolveName(IP);
+ if IsIP(IP) then
+ Result := #1 + IPToID(IP)
+ else
+ if IsIP6(IP) then
+ begin
+ ip6 := StrToIP6(IP);
+ Result := #4;
+ for n := 0 to 15 do
+ Result := Result + AnsiChar(ip6[n]);
+ end
+ else
+ Result := #3 + AnsiChar(Length(IP)) + IP;
+ Result := Result + CodeInt(ResolvePort(Port));
+ end;
+end;
+
+function TSocksBlockSocket.SocksDecode(Value: Ansistring): integer;
+var
+ Atyp: Byte;
+ y, n: integer;
+ w: Word;
+ ip6: TIp6Bytes;
+begin
+ FSocksResponsePort := '0';
+ Result := 0;
+ if FSocksType <> ST_Socks5 then
+ begin
+ if Length(Value) < 8 then
+ Exit;
+ Result := 3;
+ w := DecodeInt(Value, Result);
+ FSocksResponsePort := IntToStr(w);
+ FSocksResponseIP := Format('%d.%d.%d.%d',
+ [Ord(Value[5]), Ord(Value[6]), Ord(Value[7]), Ord(Value[8])]);
+ Result := 9;
+ end
+ else
+ begin
+ if Length(Value) < 4 then
+ Exit;
+ Atyp := Ord(Value[4]);
+ Result := 5;
+ case Atyp of
+ 1:
+ begin
+ if Length(Value) < 10 then
+ Exit;
+ FSocksResponseIP := Format('%d.%d.%d.%d',
+ [Ord(Value[5]), Ord(Value[6]), Ord(Value[7]), Ord(Value[8])]);
+ Result := 9;
+ end;
+ 3:
+ begin
+ y := Ord(Value[5]);
+ if Length(Value) < (5 + y + 2) then
+ Exit;
+ for n := 6 to 6 + y - 1 do
+ FSocksResponseIP := FSocksResponseIP + Value[n];
+ Result := 5 + y + 1;
+ end;
+ 4:
+ begin
+ if Length(Value) < 22 then
+ Exit;
+ for n := 0 to 15 do
+ ip6[n] := ord(Value[n + 5]);
+ FSocksResponseIP := IP6ToStr(ip6);
+ Result := 21;
+ end;
+ else
+ Exit;
+ end;
+ w := DecodeInt(Value, Result);
+ FSocksResponsePort := IntToStr(w);
+ Result := Result + 2;
+ end;
+end;
+
+{======================================================================}
+
+procedure TDgramBlockSocket.Connect(IP, Port: string);
+begin
+ SetRemoteSin(IP, Port);
+ InternalCreateSocket(FRemoteSin);
+ FBuffer := '';
+ DoStatus(HR_Connect, IP + ':' + Port);
+end;
+
+function TDgramBlockSocket.RecvBuffer(Buffer: TMemory; Length: Integer): Integer;
+begin
+ Result := RecvBufferFrom(Buffer, Length);
+end;
+
+function TDgramBlockSocket.SendBuffer(Buffer: TMemory; Length: Integer): Integer;
+begin
+ Result := SendBufferTo(Buffer, Length);
+end;
+
+{======================================================================}
+
+destructor TUDPBlockSocket.Destroy;
+begin
+ if Assigned(FSocksControlSock) then
+ FSocksControlSock.Free;
+ inherited;
+end;
+
+procedure TUDPBlockSocket.EnableBroadcast(Value: Boolean);
+var
+ d: TSynaOption;
+begin
+ d := TSynaOption.Create;
+ d.Option := SOT_Broadcast;
+ d.Enabled := Value;
+ DelayedOption(d);
+end;
+
+function TUDPBlockSocket.UdpAssociation: Boolean;
+var
+ b: Boolean;
+begin
+ Result := True;
+ FUsingSocks := False;
+ if FSocksIP <> '' then
+ begin
+ Result := False;
+ if not Assigned(FSocksControlSock) then
+ FSocksControlSock := TTCPBlockSocket.Create;
+ FSocksControlSock.CloseSocket;
+ FSocksControlSock.CreateSocketByName(FSocksIP);
+ FSocksControlSock.Connect(FSocksIP, FSocksPort);
+ if FSocksControlSock.LastError <> 0 then
+ Exit;
+ // if not assigned local port, assign it!
+ if not FBinded then
+ Bind(cAnyHost, cAnyPort);
+ //open control TCP connection to SOCKS
+ FSocksControlSock.FSocksUsername := FSocksUsername;
+ FSocksControlSock.FSocksPassword := FSocksPassword;
+ b := FSocksControlSock.SocksOpen;
+ if b then
+ b := FSocksControlSock.SocksRequest(3, GetLocalSinIP, IntToStr(GetLocalSinPort));
+ if b then
+ b := FSocksControlSock.SocksResponse;
+ if not b and (FLastError = 0) then
+ FLastError := WSANO_RECOVERY;
+ FUsingSocks :=FSocksControlSock.UsingSocks;
+ FSocksRemoteIP := FSocksControlSock.FSocksResponseIP;
+ FSocksRemotePort := FSocksControlSock.FSocksResponsePort;
+ Result := b and (FLastError = 0);
+ end;
+end;
+
+function TUDPBlockSocket.SendBufferTo(Buffer: TMemory; Length: Integer): Integer;
+var
+ SIp: string;
+ SPort: integer;
+ Buf: Ansistring;
+begin
+ Result := 0;
+ FUsingSocks := False;
+ if (FSocksIP <> '') and (not UdpAssociation) then
+ FLastError := WSANO_RECOVERY
+ else
+ begin
+ if FUsingSocks then
+ begin
+{$IFNDEF CIL}
+ Sip := GetRemoteSinIp;
+ SPort := GetRemoteSinPort;
+ SetRemoteSin(FSocksRemoteIP, FSocksRemotePort);
+ SetLength(Buf,Length);
+ Move(Buffer^, Pointer(Buf)^, Length);
+ Buf := #0 + #0 + #0 + SocksCode(Sip, IntToStr(SPort)) + Buf;
+ Result := inherited SendBufferTo(Pointer(Buf), System.Length(buf));
+ SetRemoteSin(Sip, IntToStr(SPort));
+{$ENDIF}
+ end
+ else
+ Result := inherited SendBufferTo(Buffer, Length);
+ end;
+end;
+
+function TUDPBlockSocket.RecvBufferFrom(Buffer: TMemory; Length: Integer): Integer;
+var
+ Buf: Ansistring;
+ x: integer;
+begin
+ Result := inherited RecvBufferFrom(Buffer, Length);
+ if FUsingSocks then
+ begin
+{$IFNDEF CIL}
+ SetLength(Buf, Result);
+ Move(Buffer^, Pointer(Buf)^, Result);
+ x := SocksDecode(Buf);
+ Result := Result - x + 1;
+ Buf := Copy(Buf, x, Result);
+ Move(Pointer(Buf)^, Buffer^, Result);
+ SetRemoteSin(FSocksResponseIP, FSocksResponsePort);
+{$ENDIF}
+ end;
+end;
+
+{$IFNDEF CIL}
+procedure TUDPBlockSocket.AddMulticast(MCastIP: string);
+var
+ Multicast: TIP_mreq;
+ Multicast6: TIPv6_mreq;
+ n: integer;
+ ip6: Tip6bytes;
+begin
+ if FIP6Used then
+ begin
+ ip6 := StrToIp6(MCastIP);
+ for n := 0 to 15 do
+ Multicast6.ipv6mr_multiaddr.u6_addr8[n] := Ip6[n];
+ Multicast6.ipv6mr_interface := 0;
+ SockCheck(synsock.SetSockOpt(FSocket, IPPROTO_IPV6, IPV6_JOIN_GROUP,
+ PAnsiChar(@Multicast6), SizeOf(Multicast6)));
+ end
+ else
+ begin
+ Multicast.imr_multiaddr.S_addr := swapbytes(strtoip(MCastIP));
+ Multicast.imr_interface.S_addr := INADDR_ANY;
+ SockCheck(synsock.SetSockOpt(FSocket, IPPROTO_IP, IP_ADD_MEMBERSHIP,
+ PAnsiChar(@Multicast), SizeOf(Multicast)));
+ end;
+ ExceptCheck;
+end;
+
+procedure TUDPBlockSocket.DropMulticast(MCastIP: string);
+var
+ Multicast: TIP_mreq;
+ Multicast6: TIPv6_mreq;
+ n: integer;
+ ip6: Tip6bytes;
+begin
+ if FIP6Used then
+ begin
+ ip6 := StrToIp6(MCastIP);
+ for n := 0 to 15 do
+ Multicast6.ipv6mr_multiaddr.u6_addr8[n] := Ip6[n];
+ Multicast6.ipv6mr_interface := 0;
+ SockCheck(synsock.SetSockOpt(FSocket, IPPROTO_IPV6, IPV6_LEAVE_GROUP,
+ PAnsiChar(@Multicast6), SizeOf(Multicast6)));
+ end
+ else
+ begin
+ Multicast.imr_multiaddr.S_addr := swapbytes(strtoip(MCastIP));
+ Multicast.imr_interface.S_addr := INADDR_ANY;
+ SockCheck(synsock.SetSockOpt(FSocket, IPPROTO_IP, IP_DROP_MEMBERSHIP,
+ PAnsiChar(@Multicast), SizeOf(Multicast)));
+ end;
+ ExceptCheck;
+end;
+{$ENDIF}
+
+procedure TUDPBlockSocket.SetMulticastTTL(TTL: integer);
+var
+ d: TSynaOption;
+begin
+ d := TSynaOption.Create;
+ d.Option := SOT_MulticastTTL;
+ d.Value := TTL;
+ DelayedOption(d);
+end;
+
+function TUDPBlockSocket.GetMulticastTTL:integer;
+var
+ l: Integer;
+begin
+{$IFNDEF CIL}
+ l := SizeOf(Result);
+ if FIP6Used then
+ synsock.GetSockOpt(FSocket, IPPROTO_IPV6, IPV6_MULTICAST_HOPS, @Result, l)
+ else
+ synsock.GetSockOpt(FSocket, IPPROTO_IP, IP_MULTICAST_TTL, @Result, l);
+{$ENDIF}
+end;
+
+procedure TUDPBlockSocket.EnableMulticastLoop(Value: Boolean);
+var
+ d: TSynaOption;
+begin
+ d := TSynaOption.Create;
+ d.Option := SOT_MulticastLoop;
+ d.Enabled := Value;
+ DelayedOption(d);
+end;
+
+function TUDPBlockSocket.GetSocketType: integer;
+begin
+ Result := integer(SOCK_DGRAM);
+end;
+
+function TUDPBlockSocket.GetSocketProtocol: integer;
+begin
+ Result := integer(IPPROTO_UDP);
+end;
+
+{======================================================================}
+constructor TTCPBlockSocket.CreateWithSSL(SSLPlugin: TSSLClass);
+begin
+ inherited Create;
+ FSSL := SSLPlugin.Create(self);
+ FHTTPTunnelIP := '';
+ FHTTPTunnelPort := '';
+ FHTTPTunnel := False;
+ FHTTPTunnelRemoteIP := '';
+ FHTTPTunnelRemotePort := '';
+ FHTTPTunnelUser := '';
+ FHTTPTunnelPass := '';
+ FHTTPTunnelTimeout := 30000;
+end;
+
+constructor TTCPBlockSocket.Create;
+begin
+ CreateWithSSL(SSLImplementation);
+end;
+
+destructor TTCPBlockSocket.Destroy;
+begin
+ inherited Destroy;
+ FSSL.Free;
+end;
+
+function TTCPBlockSocket.GetErrorDescEx: string;
+begin
+ Result := inherited GetErrorDescEx;
+ if (FLastError = WSASYSNOTREADY) and (self.SSL.LastError <> 0) then
+ begin
+ Result := self.SSL.LastErrorDesc;
+ end;
+end;
+
+procedure TTCPBlockSocket.CloseSocket;
+begin
+ if FSSL.SSLEnabled then
+ FSSL.Shutdown;
+ if (FSocket <> INVALID_SOCKET) and (FLastError = 0) then
+ begin
+ Synsock.Shutdown(FSocket, 1);
+ Purge;
+ end;
+ inherited CloseSocket;
+end;
+
+procedure TTCPBlockSocket.DoAfterConnect;
+begin
+ if assigned(OnAfterConnect) then
+ begin
+ OnAfterConnect(Self);
+ end;
+end;
+
+function TTCPBlockSocket.WaitingData: Integer;
+begin
+ Result := 0;
+ if FSSL.SSLEnabled and (FSocket <> INVALID_SOCKET) then
+ Result := FSSL.WaitingData;
+ if Result = 0 then
+ Result := inherited WaitingData;
+end;
+
+procedure TTCPBlockSocket.Listen;
+var
+ b: Boolean;
+ Sip,SPort: string;
+begin
+ if FSocksIP = '' then
+ begin
+ inherited Listen;
+ end
+ else
+ begin
+ Sip := GetLocalSinIP;
+ if Sip = cAnyHost then
+ Sip := LocalName;
+ SPort := IntToStr(GetLocalSinPort);
+ inherited Connect(FSocksIP, FSocksPort);
+ b := SocksOpen;
+ if b then
+ b := SocksRequest(2, Sip, SPort);
+ if b then
+ b := SocksResponse;
+ if not b and (FLastError = 0) then
+ FLastError := WSANO_RECOVERY;
+ FSocksLocalIP := FSocksResponseIP;
+ if FSocksLocalIP = cAnyHost then
+ FSocksLocalIP := FSocksIP;
+ FSocksLocalPort := FSocksResponsePort;
+ FSocksRemoteIP := '';
+ FSocksRemotePort := '';
+ ExceptCheck;
+ DoStatus(HR_Listen, '');
+ end;
+end;
+
+function TTCPBlockSocket.Accept: TSocket;
+begin
+ if FUsingSocks then
+ begin
+ if not SocksResponse and (FLastError = 0) then
+ FLastError := WSANO_RECOVERY;
+ FSocksRemoteIP := FSocksResponseIP;
+ FSocksRemotePort := FSocksResponsePort;
+ Result := FSocket;
+ ExceptCheck;
+ DoStatus(HR_Accept, '');
+ end
+ else
+ begin
+ result := inherited Accept;
+ end;
+end;
+
+procedure TTCPBlockSocket.Connect(IP, Port: string);
+begin
+ if FSocksIP <> '' then
+ SocksDoConnect(IP, Port)
+ else
+ if FHTTPTunnelIP <> '' then
+ HTTPTunnelDoConnect(IP, Port)
+ else
+ inherited Connect(IP, Port);
+ if FLasterror = 0 then
+ DoAfterConnect;
+end;
+
+procedure TTCPBlockSocket.SocksDoConnect(IP, Port: string);
+var
+ b: Boolean;
+begin
+ inherited Connect(FSocksIP, FSocksPort);
+ if FLastError = 0 then
+ begin
+ b := SocksOpen;
+ if b then
+ b := SocksRequest(1, IP, Port);
+ if b then
+ b := SocksResponse;
+ if not b and (FLastError = 0) then
+ FLastError := WSASYSNOTREADY;
+ FSocksLocalIP := FSocksResponseIP;
+ FSocksLocalPort := FSocksResponsePort;
+ FSocksRemoteIP := IP;
+ FSocksRemotePort := Port;
+ end;
+ ExceptCheck;
+ DoStatus(HR_Connect, IP + ':' + Port);
+end;
+
+procedure TTCPBlockSocket.HTTPTunnelDoConnect(IP, Port: string);
+//bugfixed by Mike Green (mgreen@emixode.com)
+var
+ s: string;
+begin
+ Port := IntToStr(ResolvePort(Port));
+ inherited Connect(FHTTPTunnelIP, FHTTPTunnelPort);
+ if FLastError <> 0 then
+ Exit;
+ FHTTPTunnel := False;
+ if IsIP6(IP) then
+ IP := '[' + IP + ']';
+ SendString('CONNECT ' + IP + ':' + Port + ' HTTP/1.0' + CRLF);
+ if FHTTPTunnelUser <> '' then
+ Sendstring('Proxy-Authorization: Basic ' +
+ EncodeBase64(FHTTPTunnelUser + ':' + FHTTPTunnelPass) + CRLF);
+ SendString(CRLF);
+ repeat
+ s := RecvTerminated(FHTTPTunnelTimeout, #$0a);
+ if FLastError <> 0 then
+ Break;
+ if (Pos('HTTP/', s) = 1) and (Length(s) > 11) then
+ FHTTPTunnel := s[10] = '2';
+ until (s = '') or (s = #$0d);
+ if (FLasterror = 0) and not FHTTPTunnel then
+ FLastError := WSASYSNOTREADY;
+ FHTTPTunnelRemoteIP := IP;
+ FHTTPTunnelRemotePort := Port;
+ ExceptCheck;
+end;
+
+procedure TTCPBlockSocket.SSLDoConnect;
+begin
+ ResetLastError;
+ if not FSSL.Connect then
+ FLastError := WSASYSNOTREADY;
+ ExceptCheck;
+end;
+
+procedure TTCPBlockSocket.SSLDoShutdown;
+begin
+ ResetLastError;
+ FSSL.BiShutdown;
+end;
+
+function TTCPBlockSocket.GetLocalSinIP: string;
+begin
+ if FUsingSocks then
+ Result := FSocksLocalIP
+ else
+ Result := inherited GetLocalSinIP;
+end;
+
+function TTCPBlockSocket.GetRemoteSinIP: string;
+begin
+ if FUsingSocks then
+ Result := FSocksRemoteIP
+ else
+ if FHTTPTunnel then
+ Result := FHTTPTunnelRemoteIP
+ else
+ Result := inherited GetRemoteSinIP;
+end;
+
+function TTCPBlockSocket.GetLocalSinPort: Integer;
+begin
+ if FUsingSocks then
+ Result := StrToIntDef(FSocksLocalPort, 0)
+ else
+ Result := inherited GetLocalSinPort;
+end;
+
+function TTCPBlockSocket.GetRemoteSinPort: Integer;
+begin
+ if FUsingSocks then
+ Result := ResolvePort(FSocksRemotePort)
+ else
+ if FHTTPTunnel then
+ Result := StrToIntDef(FHTTPTunnelRemotePort, 0)
+ else
+ Result := inherited GetRemoteSinPort;
+end;
+
+function TTCPBlockSocket.RecvBuffer(Buffer: TMemory; Len: Integer): Integer;
+begin
+ if FSSL.SSLEnabled then
+ begin
+ Result := 0;
+ if TestStopFlag then
+ Exit;
+ ResetLastError;
+ LimitBandwidth(Len, FMaxRecvBandwidth, FNextRecv);
+ Result := FSSL.RecvBuffer(Buffer, Len);
+ if FSSL.LastError <> 0 then
+ FLastError := WSASYSNOTREADY;
+ ExceptCheck;
+ Inc(FRecvCounter, Result);
+ DoStatus(HR_ReadCount, IntToStr(Result));
+ DoMonitor(False, Buffer, Result);
+ DoReadFilter(Buffer, Result);
+ end
+ else
+ Result := inherited RecvBuffer(Buffer, Len);
+end;
+
+function TTCPBlockSocket.SendBuffer(Buffer: TMemory; Length: Integer): Integer;
+var
+ x, y: integer;
+ l, r: integer;
+{$IFNDEF CIL}
+ p: Pointer;
+{$ENDIF}
+begin
+ if FSSL.SSLEnabled then
+ begin
+ Result := 0;
+ if TestStopFlag then
+ Exit;
+ ResetLastError;
+ DoMonitor(True, Buffer, Length);
+{$IFDEF CIL}
+ Result := FSSL.SendBuffer(Buffer, Length);
+ if FSSL.LastError <> 0 then
+ FLastError := WSASYSNOTREADY;
+ Inc(FSendCounter, Result);
+ DoStatus(HR_WriteCount, IntToStr(Result));
+{$ELSE}
+ l := Length;
+ x := 0;
+ while x < l do
+ begin
+ y := l - x;
+ if y > FSendMaxChunk then
+ y := FSendMaxChunk;
+ if y > 0 then
+ begin
+ LimitBandwidth(y, FMaxSendBandwidth, FNextsend);
+ p := IncPoint(Buffer, x);
+ r := FSSL.SendBuffer(p, y);
+ if FSSL.LastError <> 0 then
+ FLastError := WSASYSNOTREADY;
+ if Flasterror <> 0 then
+ Break;
+ Inc(x, r);
+ Inc(Result, r);
+ Inc(FSendCounter, r);
+ DoStatus(HR_WriteCount, IntToStr(r));
+ end
+ else
+ break;
+ end;
+{$ENDIF}
+ ExceptCheck;
+ end
+ else
+ Result := inherited SendBuffer(Buffer, Length);
+end;
+
+function TTCPBlockSocket.SSLAcceptConnection: Boolean;
+begin
+ ResetLastError;
+ if not FSSL.Accept then
+ FLastError := WSASYSNOTREADY;
+ ExceptCheck;
+ Result := FLastError = 0;
+end;
+
+function TTCPBlockSocket.GetSocketType: integer;
+begin
+ Result := integer(SOCK_STREAM);
+end;
+
+function TTCPBlockSocket.GetSocketProtocol: integer;
+begin
+ Result := integer(IPPROTO_TCP);
+end;
+
+{======================================================================}
+
+function TICMPBlockSocket.GetSocketType: integer;
+begin
+ Result := integer(SOCK_RAW);
+end;
+
+function TICMPBlockSocket.GetSocketProtocol: integer;
+begin
+ if FIP6Used then
+ Result := integer(IPPROTO_ICMPV6)
+ else
+ Result := integer(IPPROTO_ICMP);
+end;
+
+{======================================================================}
+
+function TRAWBlockSocket.GetSocketType: integer;
+begin
+ Result := integer(SOCK_RAW);
+end;
+
+function TRAWBlockSocket.GetSocketProtocol: integer;
+begin
+ Result := integer(IPPROTO_RAW);
+end;
+
+{======================================================================}
+
+function TPGMmessageBlockSocket.GetSocketType: integer;
+begin
+ Result := integer(SOCK_RDM);
+end;
+
+function TPGMmessageBlockSocket.GetSocketProtocol: integer;
+begin
+ Result := integer(IPPROTO_RM);
+end;
+
+{======================================================================}
+
+function TPGMstreamBlockSocket.GetSocketType: integer;
+begin
+ Result := integer(SOCK_STREAM);
+end;
+
+function TPGMstreamBlockSocket.GetSocketProtocol: integer;
+begin
+ Result := integer(IPPROTO_RM);
+end;
+
+{======================================================================}
+
+constructor TSynaClient.Create;
+begin
+ inherited Create;
+ FIPInterface := cAnyHost;
+ FTargetHost := cLocalhost;
+ FTargetPort := cAnyPort;
+ FTimeout := 5000;
+ FUsername := '';
+ FPassword := '';
+end;
+
+{======================================================================}
+
+constructor TCustomSSL.Create(const Value: TTCPBlockSocket);
+begin
+ inherited Create;
+ FSocket := Value;
+ FSSLEnabled := False;
+ FUsername := '';
+ FPassword := '';
+ FLastError := 0;
+ FLastErrorDesc := '';
+ FVerifyCert := False;
+ FSSLType := LT_all;
+ FKeyPassword := '';
+ FCiphers := '';
+ FCertificateFile := '';
+ FPrivateKeyFile := '';
+ FCertCAFile := '';
+ FCertCA := '';
+ FTrustCertificate := '';
+ FTrustCertificateFile := '';
+ FCertificate := '';
+ FPrivateKey := '';
+ FPFX := '';
+ FPFXfile := '';
+ FSSHChannelType := '';
+ FSSHChannelArg1 := '';
+ FSSHChannelArg2 := '';
+ FCertComplianceLevel := -1; //default
+ FSNIHost := '';
+end;
+
+procedure TCustomSSL.Assign(const Value: TCustomSSL);
+begin
+ FUsername := Value.Username;
+ FPassword := Value.Password;
+ FVerifyCert := Value.VerifyCert;
+ FSSLType := Value.SSLType;
+ FKeyPassword := Value.KeyPassword;
+ FCiphers := Value.Ciphers;
+ FCertificateFile := Value.CertificateFile;
+ FPrivateKeyFile := Value.PrivateKeyFile;
+ FCertCAFile := Value.CertCAFile;
+ FCertCA := Value.CertCA;
+ FTrustCertificate := Value.TrustCertificate;
+ FTrustCertificateFile := Value.TrustCertificateFile;
+ FCertificate := Value.Certificate;
+ FPrivateKey := Value.PrivateKey;
+ FPFX := Value.PFX;
+ FPFXfile := Value.PFXfile;
+ FCertComplianceLevel := Value.CertComplianceLevel;
+ FSNIHost := Value.FSNIHost;
+end;
+
+procedure TCustomSSL.ReturnError;
+begin
+ FLastError := -1;
+ FLastErrorDesc := 'SSL/TLS support is not compiled!';
+end;
+
+function TCustomSSL.LibVersion: String;
+begin
+ Result := '';
+end;
+
+function TCustomSSL.LibName: String;
+begin
+ Result := '';
+end;
+
+function TCustomSSL.CreateSelfSignedCert(Host: string): Boolean;
+begin
+ Result := False;
+end;
+
+function TCustomSSL.Connect: boolean;
+begin
+ ReturnError;
+ Result := False;
+end;
+
+function TCustomSSL.Accept: boolean;
+begin
+ ReturnError;
+ Result := False;
+end;
+
+function TCustomSSL.Shutdown: boolean;
+begin
+ ReturnError;
+ Result := False;
+end;
+
+function TCustomSSL.BiShutdown: boolean;
+begin
+ ReturnError;
+ Result := False;
+end;
+
+function TCustomSSL.SendBuffer(Buffer: TMemory; Len: Integer): Integer;
+begin
+ ReturnError;
+ Result := integer(SOCKET_ERROR);
+end;
+
+procedure TCustomSSL.SetCertCAFile(const Value: string);
+begin
+ FCertCAFile := Value;
+end;
+
+function TCustomSSL.RecvBuffer(Buffer: TMemory; Len: Integer): Integer;
+begin
+ ReturnError;
+ Result := integer(SOCKET_ERROR);
+end;
+
+function TCustomSSL.WaitingData: Integer;
+begin
+ ReturnError;
+ Result := 0;
+end;
+
+function TCustomSSL.GetSSLVersion: string;
+begin
+ Result := '';
+end;
+
+function TCustomSSL.GetPeerSubject: string;
+begin
+ Result := '';
+end;
+
+function TCustomSSL.GetPeerSerialNo: integer;
+begin
+ Result := -1;
+end;
+
+function TCustomSSL.GetPeerName: string;
+begin
+ Result := '';
+end;
+
+function TCustomSSL.GetPeerNameHash: cardinal;
+begin
+ Result := 0;
+end;
+
+function TCustomSSL.GetPeerIssuer: string;
+begin
+ Result := '';
+end;
+
+function TCustomSSL.GetPeerFingerprint: string;
+begin
+ Result := '';
+end;
+
+function TCustomSSL.GetCertInfo: string;
+begin
+ Result := '';
+end;
+
+function TCustomSSL.GetCipherName: string;
+begin
+ Result := '';
+end;
+
+function TCustomSSL.GetCipherBits: integer;
+begin
+ Result := 0;
+end;
+
+function TCustomSSL.GetCipherAlgBits: integer;
+begin
+ Result := 0;
+end;
+
+function TCustomSSL.GetVerifyCert: integer;
+begin
+ Result := 1;
+end;
+
+function TCustomSSL.DoVerifyCert:boolean;
+begin
+ if assigned(OnVerifyCert) then
+ begin
+ result:=OnVerifyCert(Self);
+ end
+ else
+ result:=true;
+end;
+
+
+{======================================================================}
+
+function TSSLNone.LibVersion: String;
+begin
+ Result := 'Without SSL support';
+end;
+
+function TSSLNone.LibName: String;
+begin
+ Result := 'ssl_none';
+end;
+
+{======================================================================}
+
+initialization
+begin
+{$IFDEF ONCEWINSOCK}
+ if not InitSocketInterface(DLLStackName) then
+ begin
+ e := ESynapseError.Create('Error loading Socket interface (' + DLLStackName + ')!');
+ e.ErrorCode := 0;
+ e.ErrorMessage := 'Error loading Socket interface (' + DLLStackName + ')!';
+ raise e;
+ end;
+ synsock.WSAStartup(WinsockLevel, WsaDataOnce);
+{$ENDIF}
+end;
+
+finalization
+begin
+{$IFDEF ONCEWINSOCK}
+ synsock.WSACleanup;
+ DestroySocketInterface;
+{$ENDIF}
+end;
+
+end.
ADDED lib/synapse/source/lib/clamsend.pas
Index: lib/synapse/source/lib/clamsend.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/lib/clamsend.pas
@@ -0,0 +1,277 @@
+{==============================================================================|
+| Project : Ararat Synapse | 001.001.001 |
+|==============================================================================|
+| Content: ClamAV-daemon client |
+|==============================================================================|
+| Copyright (c)2005-2010, Lukas Gebauer |
+| All rights reserved. |
+| |
+| Redistribution and use in source and binary forms, with or without |
+| modification, are permitted provided that the following conditions are met: |
+| |
+| Redistributions of source code must retain the above copyright notice, this |
+| list of conditions and the following disclaimer. |
+| |
+| Redistributions in binary form must reproduce the above copyright notice, |
+| this list of conditions and the following disclaimer in the documentation |
+| and/or other materials provided with the distribution. |
+| |
+| Neither the name of Lukas Gebauer nor the names of its contributors may |
+| be used to endorse or promote products derived from this software without |
+| specific prior written permission. |
+| |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
+| DAMAGE. |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2005-2010. |
+| All Rights Reserved. |
+|==============================================================================|
+| Contributor(s): |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package |
+| (Found at URL: http://www.ararat.cz/synapse/) |
+|==============================================================================}
+
+{:@abstract( ClamAV-daemon client)
+
+This unit is capable to do antivirus scan of your data by TCP channel to ClamD
+daemon from ClamAV. See more about ClamAV on @LINK(http://www.clamav.net)
+}
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+{$Q-}
+{$H+}
+
+{$IFDEF UNICODE}
+ {$WARN IMPLICIT_STRING_CAST OFF}
+ {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+unit clamsend;
+
+interface
+
+uses
+ SysUtils, Classes,
+ synsock, blcksock, synautil;
+
+const
+ cClamProtocol = '3310';
+
+type
+
+ {:@abstract(Implementation of ClamAV-daemon client protocol)
+ By this class you can scan any your data by ClamAV opensource antivirus.
+
+ This class can connect to ClamD by TCP channel, send your data to ClamD
+ and read result.}
+ TClamSend = class(TSynaClient)
+ private
+ FSock: TTCPBlockSocket;
+ FDSock: TTCPBlockSocket;
+ FSession: boolean;
+ function Login: boolean; virtual;
+ function Logout: Boolean; virtual;
+ function OpenStream: Boolean; virtual;
+ public
+ constructor Create;
+ destructor Destroy; override;
+
+ {:Call any command to ClamD. Used internally by other methods.}
+ function DoCommand(const Value: AnsiString): AnsiString; virtual;
+
+ {:Return ClamAV version and version of loaded databases.}
+ function GetVersion: AnsiString; virtual;
+
+ {:Scan content of TStrings.}
+ function ScanStrings(const Value: TStrings): AnsiString; virtual;
+
+ {:Scan content of TStream.}
+ function ScanStream(const Value: TStream): AnsiString; virtual;
+
+ {:Scan content of TStrings by new 0.95 API.}
+ function ScanStrings2(const Value: TStrings): AnsiString; virtual;
+
+ {:Scan content of TStream by new 0.95 API.}
+ function ScanStream2(const Value: TStream): AnsiString; virtual;
+ published
+ {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.}
+ property Sock: TTCPBlockSocket read FSock;
+
+ {:Socket object used for TCP data transfer operation. Good for seting OnStatus hook, etc.}
+ property DSock: TTCPBlockSocket read FDSock;
+
+ {:Can turn-on session mode of communication with ClamD. Default is @false,
+ because ClamAV developers design their TCP code very badly and session mode
+ is broken now (CVS-20051031). Maybe ClamAV developers fix their bugs
+ and this mode will be possible in future.}
+ property Session: boolean read FSession write FSession;
+ end;
+
+implementation
+
+constructor TClamSend.Create;
+begin
+ inherited Create;
+ FSock := TTCPBlockSocket.Create;
+ FSock.Owner := self;
+ FDSock := TTCPBlockSocket.Create;
+ FDSock.Owner := self;
+ FTimeout := 60000;
+ FTargetPort := cClamProtocol;
+ FSession := false;
+end;
+
+destructor TClamSend.Destroy;
+begin
+ Logout;
+ FDSock.Free;
+ FSock.Free;
+ inherited Destroy;
+end;
+
+function TClamSend.DoCommand(const Value: AnsiString): AnsiString;
+begin
+ Result := '';
+ if not FSession then
+ FSock.CloseSocket
+ else
+ FSock.SendString(Value + LF);
+ if not FSession or (FSock.LastError <> 0) then
+ begin
+ if Login then
+ FSock.SendString(Value + LF)
+ else
+ Exit;
+ end;
+ Result := FSock.RecvTerminated(FTimeout, LF);
+end;
+
+function TClamSend.Login: boolean;
+begin
+ Result := False;
+ Sock.CloseSocket;
+ FSock.Bind(FIPInterface, cAnyPort);
+ if FSock.LastError <> 0 then
+ Exit;
+ FSock.Connect(FTargetHost, FTargetPort);
+ if FSock.LastError <> 0 then
+ Exit;
+ if FSession then
+ FSock.SendString('SESSION' + LF);
+ Result := FSock.LastError = 0;
+end;
+
+function TClamSend.Logout: Boolean;
+begin
+ FSock.SendString('END' + LF);
+ Result := FSock.LastError = 0;
+ FSock.CloseSocket;
+end;
+
+function TClamSend.GetVersion: AnsiString;
+begin
+ Result := DoCommand('nVERSION');
+end;
+
+function TClamSend.OpenStream: Boolean;
+var
+ S: AnsiString;
+begin
+ Result := False;
+ s := DoCommand('nSTREAM');
+ if (s <> '') and (Copy(s, 1, 4) = 'PORT') then
+ begin
+ s := SeparateRight(s, ' ');
+ FDSock.CloseSocket;
+ FDSock.Bind(FIPInterface, cAnyPort);
+ if FDSock.LastError <> 0 then
+ Exit;
+ FDSock.Connect(FTargetHost, s);
+ if FDSock.LastError <> 0 then
+ Exit;
+ Result := True;
+ end;
+end;
+
+function TClamSend.ScanStrings(const Value: TStrings): AnsiString;
+begin
+ Result := '';
+ if OpenStream then
+ begin
+ DSock.SendString(Value.Text);
+ DSock.CloseSocket;
+ Result := FSock.RecvTerminated(FTimeout, LF);
+ end;
+end;
+
+function TClamSend.ScanStream(const Value: TStream): AnsiString;
+begin
+ Result := '';
+ if OpenStream then
+ begin
+ DSock.SendStreamRaw(Value);
+ DSock.CloseSocket;
+ Result := FSock.RecvTerminated(FTimeout, LF);
+ end;
+end;
+
+function TClamSend.ScanStrings2(const Value: TStrings): AnsiString;
+var
+ i: integer;
+ s: AnsiString;
+begin
+ Result := '';
+ if not FSession then
+ FSock.CloseSocket
+ else
+ FSock.sendstring('nINSTREAM' + LF);
+ if not FSession or (FSock.LastError <> 0) then
+ begin
+ if Login then
+ FSock.sendstring('nINSTREAM' + LF)
+ else
+ Exit;
+ end;
+ s := Value.text;
+ i := length(s);
+ FSock.SendString(CodeLongint(i) + s + #0#0#0#0);
+ Result := FSock.RecvTerminated(FTimeout, LF);
+end;
+
+function TClamSend.ScanStream2(const Value: TStream): AnsiString;
+var
+ i: integer;
+begin
+ Result := '';
+ if not FSession then
+ FSock.CloseSocket
+ else
+ FSock.sendstring('nINSTREAM' + LF);
+ if not FSession or (FSock.LastError <> 0) then
+ begin
+ if Login then
+ FSock.sendstring('nINSTREAM' + LF)
+ else
+ Exit;
+ end;
+ i := value.Size;
+ FSock.SendString(CodeLongint(i));
+ FSock.SendStreamRaw(Value);
+ FSock.SendString(#0#0#0#0);
+ Result := FSock.RecvTerminated(FTimeout, LF);
+end;
+
+end.
ADDED lib/synapse/source/lib/dnssend.pas
Index: lib/synapse/source/lib/dnssend.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/lib/dnssend.pas
@@ -0,0 +1,603 @@
+{==============================================================================|
+| Project : Ararat Synapse | 002.007.006 |
+|==============================================================================|
+| Content: DNS client |
+|==============================================================================|
+| Copyright (c)1999-2010, Lukas Gebauer |
+| All rights reserved. |
+| |
+| Redistribution and use in source and binary forms, with or without |
+| modification, are permitted provided that the following conditions are met: |
+| |
+| Redistributions of source code must retain the above copyright notice, this |
+| list of conditions and the following disclaimer. |
+| |
+| Redistributions in binary form must reproduce the above copyright notice, |
+| this list of conditions and the following disclaimer in the documentation |
+| and/or other materials provided with the distribution. |
+| |
+| Neither the name of Lukas Gebauer nor the names of its contributors may |
+| be used to endorse or promote products derived from this software without |
+| specific prior written permission. |
+| |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
+| DAMAGE. |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2000-2010. |
+| All Rights Reserved. |
+|==============================================================================|
+| Contributor(s): |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package |
+| (Found at URL: http://www.ararat.cz/synapse/) |
+|==============================================================================}
+{: @abstract(DNS client by UDP or TCP)
+Support for sending DNS queries by UDP or TCP protocol. It can retrieve zone
+ transfers too!
+
+Used RFC: RFC-1035, RFC-1183, RFC1706, RFC1712, RFC2163, RFC2230
+}
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+{$Q-}
+{$H+}
+
+{$IFDEF UNICODE}
+ {$WARN IMPLICIT_STRING_CAST OFF}
+ {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+unit dnssend;
+
+interface
+
+uses
+ SysUtils, Classes,
+ blcksock, synautil, synaip, synsock;
+
+const
+ cDnsProtocol = '53';
+
+ QTYPE_A = 1;
+ QTYPE_NS = 2;
+ QTYPE_MD = 3;
+ QTYPE_MF = 4;
+ QTYPE_CNAME = 5;
+ QTYPE_SOA = 6;
+ QTYPE_MB = 7;
+ QTYPE_MG = 8;
+ QTYPE_MR = 9;
+ QTYPE_NULL = 10;
+ QTYPE_WKS = 11; //
+ QTYPE_PTR = 12;
+ QTYPE_HINFO = 13;
+ QTYPE_MINFO = 14;
+ QTYPE_MX = 15;
+ QTYPE_TXT = 16;
+
+ QTYPE_RP = 17;
+ QTYPE_AFSDB = 18;
+ QTYPE_X25 = 19;
+ QTYPE_ISDN = 20;
+ QTYPE_RT = 21;
+ QTYPE_NSAP = 22;
+ QTYPE_NSAPPTR = 23;
+ QTYPE_SIG = 24; // RFC-2065
+ QTYPE_KEY = 25; // RFC-2065
+ QTYPE_PX = 26;
+ QTYPE_GPOS = 27;
+ QTYPE_AAAA = 28;
+ QTYPE_LOC = 29; // RFC-1876
+ QTYPE_NXT = 30; // RFC-2065
+
+ QTYPE_SRV = 33;
+ QTYPE_NAPTR = 35; // RFC-2168
+ QTYPE_KX = 36;
+ QTYPE_SPF = 99;
+
+ QTYPE_AXFR = 252;
+ QTYPE_MAILB = 253; //
+ QTYPE_MAILA = 254; //
+ QTYPE_ALL = 255;
+
+type
+ {:@abstract(Implementation of DNS protocol by UDP or TCP protocol.)
+
+ Note: Are you missing properties for specify server address and port? Look to
+ parent @link(TSynaClient) too!}
+ TDNSSend = class(TSynaClient)
+ private
+ FID: Word;
+ FRCode: Integer;
+ FBuffer: AnsiString;
+ FSock: TUDPBlockSocket;
+ FTCPSock: TTCPBlockSocket;
+ FUseTCP: Boolean;
+ FAnswerInfo: TStringList;
+ FNameserverInfo: TStringList;
+ FAdditionalInfo: TStringList;
+ FAuthoritative: Boolean;
+ FTruncated: Boolean;
+ function CompressName(const Value: AnsiString): AnsiString;
+ function CodeHeader: AnsiString;
+ function CodeQuery(const Name: AnsiString; QType: Integer): AnsiString;
+ function DecodeLabels(var From: Integer): AnsiString;
+ function DecodeString(var From: Integer): AnsiString;
+ function DecodeResource(var i: Integer; const Info: TStringList;
+ QType: Integer): AnsiString;
+ function RecvTCPResponse(const WorkSock: TBlockSocket): AnsiString;
+ function DecodeResponse(const Buf: AnsiString; const Reply: TStrings;
+ QType: Integer):boolean;
+ public
+ constructor Create;
+ destructor Destroy; override;
+
+ {:Query a DNSHost for QType resources correspond to a name. Supported QType
+ values are: Qtype_A, Qtype_NS, Qtype_MD, Qtype_MF, Qtype_CNAME, Qtype_SOA,
+ Qtype_MB, Qtype_MG, Qtype_MR, Qtype_NULL, Qtype_PTR, Qtype_HINFO,
+ Qtype_MINFO, Qtype_MX, Qtype_TXT, Qtype_RP, Qtype_AFSDB, Qtype_X25,
+ Qtype_ISDN, Qtype_RT, Qtype_NSAP, Qtype_NSAPPTR, Qtype_PX, Qtype_GPOS,
+ Qtype_KX.
+
+ Type for zone transfers QTYPE_AXFR is supported too, but only in TCP mode!
+
+ "Name" is domain name or host name for queried resource. If "name" is
+ IP address, automatically convert to reverse domain form (.in-addr.arpa).
+
+ If result is @true, Reply contains resource records. One record on one line.
+ If Resource record have multiple fields, they are stored on line divided by
+ comma. (example: MX record contains value 'rs.cesnet.cz' with preference
+ number 10, string in Reply is: '10,rs.cesnet.cz'). All numbers or IP address
+ in resource are converted to string form.}
+ function DNSQuery(Name: AnsiString; QType: Integer;
+ const Reply: TStrings): Boolean;
+ published
+
+ {:Socket object used for UDP operation. Good for seting OnStatus hook, etc.}
+ property Sock: TUDPBlockSocket read FSock;
+
+ {:Socket object used for TCP operation. Good for seting OnStatus hook, etc.}
+ property TCPSock: TTCPBlockSocket read FTCPSock;
+
+ {:if @true, then is used TCP protocol instead UDP. It is needed for zone
+ transfers, etc.}
+ property UseTCP: Boolean read FUseTCP Write FUseTCP;
+
+ {:After DNS operation contains ResultCode of DNS operation.
+ Values are: 0-no error, 1-format error, 2-server failure, 3-name error,
+ 4-not implemented, 5-refused.}
+ property RCode: Integer read FRCode;
+
+ {:@True, if answer is authoritative.}
+ property Authoritative: Boolean read FAuthoritative;
+
+ {:@True, if answer is truncated to 512 bytes.}
+ property Truncated: Boolean read FTRuncated;
+
+ {:Detailed informations from name server reply. One record per line. Record
+ have comma delimited entries with type number, TTL and data filelds.
+ This information contains detailed information about query reply.}
+ property AnswerInfo: TStringList read FAnswerInfo;
+
+ {:Detailed informations from name server reply. One record per line. Record
+ have comma delimited entries with type number, TTL and data filelds.
+ This information contains detailed information about nameserver.}
+ property NameserverInfo: TStringList read FNameserverInfo;
+
+ {:Detailed informations from name server reply. One record per line. Record
+ have comma delimited entries with type number, TTL and data filelds.
+ This information contains detailed additional information.}
+ property AdditionalInfo: TStringList read FAdditionalInfo;
+ end;
+
+{:A very useful function, and example of it's use is found in the TDNSSend object.
+ This function is used to get mail servers for a domain and sort them by
+ preference numbers. "Servers" contains only the domain names of the mail
+ servers in the right order (without preference number!). The first domain name
+ will always be the highest preferenced mail server. Returns boolean @TRUE if
+ all went well.}
+function GetMailServers(const DNSHost, Domain: AnsiString;
+ const Servers: TStrings): Boolean;
+
+implementation
+
+constructor TDNSSend.Create;
+begin
+ inherited Create;
+ FSock := TUDPBlockSocket.Create;
+ FSock.Owner := self;
+ FTCPSock := TTCPBlockSocket.Create;
+ FTCPSock.Owner := self;
+ FUseTCP := False;
+ FTimeout := 10000;
+ FTargetPort := cDnsProtocol;
+ FAnswerInfo := TStringList.Create;
+ FNameserverInfo := TStringList.Create;
+ FAdditionalInfo := TStringList.Create;
+ Randomize;
+end;
+
+destructor TDNSSend.Destroy;
+begin
+ FAnswerInfo.Free;
+ FNameserverInfo.Free;
+ FAdditionalInfo.Free;
+ FTCPSock.Free;
+ FSock.Free;
+ inherited Destroy;
+end;
+
+function TDNSSend.CompressName(const Value: AnsiString): AnsiString;
+var
+ n: Integer;
+ s: AnsiString;
+begin
+ Result := '';
+ if Value = '' then
+ Result := #0
+ else
+ begin
+ s := '';
+ for n := 1 to Length(Value) do
+ if Value[n] = '.' then
+ begin
+ Result := Result + AnsiChar(Length(s)) + s;
+ s := '';
+ end
+ else
+ s := s + Value[n];
+ if s <> '' then
+ Result := Result + AnsiChar(Length(s)) + s;
+ Result := Result + #0;
+ end;
+end;
+
+function TDNSSend.CodeHeader: AnsiString;
+begin
+ FID := Random(32767);
+ Result := CodeInt(FID); // ID
+ Result := Result + CodeInt($0100); // flags
+ Result := Result + CodeInt(1); // QDCount
+ Result := Result + CodeInt(0); // ANCount
+ Result := Result + CodeInt(0); // NSCount
+ Result := Result + CodeInt(0); // ARCount
+end;
+
+function TDNSSend.CodeQuery(const Name: AnsiString; QType: Integer): AnsiString;
+begin
+ Result := CompressName(Name);
+ Result := Result + CodeInt(QType);
+ Result := Result + CodeInt(1); // Type INTERNET
+end;
+
+function TDNSSend.DecodeString(var From: Integer): AnsiString;
+var
+ Len: integer;
+begin
+ Len := Ord(FBuffer[From]);
+ Inc(From);
+ Result := Copy(FBuffer, From, Len);
+ Inc(From, Len);
+end;
+
+function TDNSSend.DecodeLabels(var From: Integer): AnsiString;
+var
+ l, f: Integer;
+begin
+ Result := '';
+ while True do
+ begin
+ if From >= Length(FBuffer) then
+ Break;
+ l := Ord(FBuffer[From]);
+ Inc(From);
+ if l = 0 then
+ Break;
+ if Result <> '' then
+ Result := Result + '.';
+ if (l and $C0) = $C0 then
+ begin
+ f := l and $3F;
+ f := f * 256 + Ord(FBuffer[From]) + 1;
+ Inc(From);
+ Result := Result + DecodeLabels(f);
+ Break;
+ end
+ else
+ begin
+ Result := Result + Copy(FBuffer, From, l);
+ Inc(From, l);
+ end;
+ end;
+end;
+
+function TDNSSend.DecodeResource(var i: Integer; const Info: TStringList;
+ QType: Integer): AnsiString;
+var
+ Rname: AnsiString;
+ RType, Len, j, x, y, z, n: Integer;
+ R: AnsiString;
+ t1, t2, ttl: integer;
+ ip6: TIp6bytes;
+begin
+ Result := '';
+ R := '';
+ Rname := DecodeLabels(i);
+ RType := DecodeInt(FBuffer, i);
+ Inc(i, 4);
+ t1 := DecodeInt(FBuffer, i);
+ Inc(i, 2);
+ t2 := DecodeInt(FBuffer, i);
+ Inc(i, 2);
+ ttl := t1 * 65536 + t2;
+ Len := DecodeInt(FBuffer, i);
+ Inc(i, 2); // i point to begin of data
+ j := i;
+ i := i + len; // i point to next record
+ if Length(FBuffer) >= (i - 1) then
+ case RType of
+ QTYPE_A:
+ begin
+ R := IntToStr(Ord(FBuffer[j]));
+ Inc(j);
+ R := R + '.' + IntToStr(Ord(FBuffer[j]));
+ Inc(j);
+ R := R + '.' + IntToStr(Ord(FBuffer[j]));
+ Inc(j);
+ R := R + '.' + IntToStr(Ord(FBuffer[j]));
+ end;
+ QTYPE_AAAA:
+ begin
+ for n := 0 to 15 do
+ ip6[n] := ord(FBuffer[j + n]);
+ R := IP6ToStr(ip6);
+ end;
+ QTYPE_NS, QTYPE_MD, QTYPE_MF, QTYPE_CNAME, QTYPE_MB,
+ QTYPE_MG, QTYPE_MR, QTYPE_PTR, QTYPE_X25, QTYPE_NSAP,
+ QTYPE_NSAPPTR:
+ R := DecodeLabels(j);
+ QTYPE_SOA:
+ begin
+ R := DecodeLabels(j);
+ R := R + ',' + DecodeLabels(j);
+ for n := 1 to 5 do
+ begin
+ x := DecodeInt(FBuffer, j) * 65536 + DecodeInt(FBuffer, j + 2);
+ Inc(j, 4);
+ R := R + ',' + IntToStr(x);
+ end;
+ end;
+ QTYPE_NULL:
+ begin
+ end;
+ QTYPE_WKS:
+ begin
+ end;
+ QTYPE_HINFO:
+ begin
+ R := DecodeString(j);
+ R := R + ',' + DecodeString(j);
+ end;
+ QTYPE_MINFO, QTYPE_RP, QTYPE_ISDN:
+ begin
+ R := DecodeLabels(j);
+ R := R + ',' + DecodeLabels(j);
+ end;
+ QTYPE_MX, QTYPE_AFSDB, QTYPE_RT, QTYPE_KX:
+ begin
+ x := DecodeInt(FBuffer, j);
+ Inc(j, 2);
+ R := IntToStr(x);
+ R := R + ',' + DecodeLabels(j);
+ end;
+ QTYPE_TXT, QTYPE_SPF:
+ begin
+ R := '';
+ while j < i do
+ R := R + DecodeString(j);
+ end;
+ QTYPE_GPOS:
+ begin
+ R := DecodeLabels(j);
+ R := R + ',' + DecodeLabels(j);
+ R := R + ',' + DecodeLabels(j);
+ end;
+ QTYPE_PX:
+ begin
+ x := DecodeInt(FBuffer, j);
+ Inc(j, 2);
+ R := IntToStr(x);
+ R := R + ',' + DecodeLabels(j);
+ R := R + ',' + DecodeLabels(j);
+ end;
+ QTYPE_SRV:
+ // Author: Dan
+ begin
+ x := DecodeInt(FBuffer, j);
+ Inc(j, 2);
+ y := DecodeInt(FBuffer, j);
+ Inc(j, 2);
+ z := DecodeInt(FBuffer, j);
+ Inc(j, 2);
+ R := IntToStr(x); // Priority
+ R := R + ',' + IntToStr(y); // Weight
+ R := R + ',' + IntToStr(z); // Port
+ R := R + ',' + DecodeLabels(j); // Server DNS Name
+ end;
+ end;
+ if R <> '' then
+ Info.Add(RName + ',' + IntToStr(RType) + ',' + IntToStr(ttl) + ',' + R);
+ if QType = RType then
+ Result := R;
+end;
+
+function TDNSSend.RecvTCPResponse(const WorkSock: TBlockSocket): AnsiString;
+var
+ l: integer;
+begin
+ Result := '';
+ l := WorkSock.recvbyte(FTimeout) * 256 + WorkSock.recvbyte(FTimeout);
+ if l > 0 then
+ Result := WorkSock.RecvBufferStr(l, FTimeout);
+end;
+
+function TDNSSend.DecodeResponse(const Buf: AnsiString; const Reply: TStrings;
+ QType: Integer):boolean;
+var
+ n, i: Integer;
+ flag, qdcount, ancount, nscount, arcount: Integer;
+ s: AnsiString;
+begin
+ Result := False;
+ Reply.Clear;
+ FAnswerInfo.Clear;
+ FNameserverInfo.Clear;
+ FAdditionalInfo.Clear;
+ FAuthoritative := False;
+ if (Length(Buf) > 13) and (FID = DecodeInt(Buf, 1)) then
+ begin
+ Result := True;
+ flag := DecodeInt(Buf, 3);
+ FRCode := Flag and $000F;
+ FAuthoritative := (Flag and $0400) > 0;
+ FTruncated := (Flag and $0200) > 0;
+ if FRCode = 0 then
+ begin
+ qdcount := DecodeInt(Buf, 5);
+ ancount := DecodeInt(Buf, 7);
+ nscount := DecodeInt(Buf, 9);
+ arcount := DecodeInt(Buf, 11);
+ i := 13; //begin of body
+ if (qdcount > 0) and (Length(Buf) > i) then //skip questions
+ for n := 1 to qdcount do
+ begin
+ while (Buf[i] <> #0) and ((Ord(Buf[i]) and $C0) <> $C0) do
+ Inc(i);
+ Inc(i, 5);
+ end;
+ if (ancount > 0) and (Length(Buf) > i) then // decode reply
+ for n := 1 to ancount do
+ begin
+ s := DecodeResource(i, FAnswerInfo, QType);
+ if s <> '' then
+ Reply.Add(s);
+ end;
+ if (nscount > 0) and (Length(Buf) > i) then // decode nameserver info
+ for n := 1 to nscount do
+ DecodeResource(i, FNameserverInfo, QType);
+ if (arcount > 0) and (Length(Buf) > i) then // decode additional info
+ for n := 1 to arcount do
+ DecodeResource(i, FAdditionalInfo, QType);
+ end;
+ end;
+end;
+
+function TDNSSend.DNSQuery(Name: AnsiString; QType: Integer;
+ const Reply: TStrings): Boolean;
+var
+ WorkSock: TBlockSocket;
+ t: TStringList;
+ b: boolean;
+begin
+ Result := False;
+ if IsIP(Name) then
+ Name := ReverseIP(Name) + '.in-addr.arpa';
+ if IsIP6(Name) then
+ Name := ReverseIP6(Name) + '.ip6.arpa';
+ FBuffer := CodeHeader + CodeQuery(Name, QType);
+ if FUseTCP then
+ WorkSock := FTCPSock
+ else
+ WorkSock := FSock;
+ WorkSock.Bind(FIPInterface, cAnyPort);
+ WorkSock.Connect(FTargetHost, FTargetPort);
+ if FUseTCP then
+ FBuffer := Codeint(length(FBuffer)) + FBuffer;
+ WorkSock.SendString(FBuffer);
+ if FUseTCP then
+ FBuffer := RecvTCPResponse(WorkSock)
+ else
+ FBuffer := WorkSock.RecvPacket(FTimeout);
+ if FUseTCP and (QType = QTYPE_AXFR) then //zone transfer
+ begin
+ t := TStringList.Create;
+ try
+ repeat
+ b := DecodeResponse(FBuffer, Reply, QType);
+ if (t.Count > 1) and (AnswerInfo.Count > 0) then //find end of transfer
+ b := b and (t[0] <> AnswerInfo[AnswerInfo.count - 1]);
+ if b then
+ begin
+ t.AddStrings(AnswerInfo);
+ FBuffer := RecvTCPResponse(WorkSock);
+ if FBuffer = '' then
+ Break;
+ if WorkSock.LastError <> 0 then
+ Break;
+ end;
+ until not b;
+ Reply.Assign(t);
+ Result := True;
+ finally
+ t.free;
+ end;
+ end
+ else //normal query
+ if WorkSock.LastError = 0 then
+ Result := DecodeResponse(FBuffer, Reply, QType);
+end;
+
+{==============================================================================}
+
+function GetMailServers(const DNSHost, Domain: AnsiString;
+ const Servers: TStrings): Boolean;
+var
+ DNS: TDNSSend;
+ t: TStringList;
+ n, m, x: Integer;
+begin
+ Result := False;
+ Servers.Clear;
+ t := TStringList.Create;
+ DNS := TDNSSend.Create;
+ try
+ DNS.TargetHost := DNSHost;
+ if DNS.DNSQuery(Domain, QType_MX, t) then
+ begin
+ { normalize preference number to 5 digits }
+ for n := 0 to t.Count - 1 do
+ begin
+ x := Pos(',', t[n]);
+ if x > 0 then
+ for m := 1 to 6 - x do
+ t[n] := '0' + t[n];
+ end;
+ { sort server list }
+ t.Sorted := True;
+ { result is sorted list without preference numbers }
+ for n := 0 to t.Count - 1 do
+ begin
+ x := Pos(',', t[n]);
+ Servers.Add(Copy(t[n], x + 1, Length(t[n]) - x));
+ end;
+ Result := True;
+ end;
+ finally
+ DNS.Free;
+ t.Free;
+ end;
+end;
+
+end.
ADDED lib/synapse/source/lib/ftpsend.pas
Index: lib/synapse/source/lib/ftpsend.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/lib/ftpsend.pas
@@ -0,0 +1,1964 @@
+{==============================================================================|
+| Project : Ararat Synapse | 004.000.000 |
+|==============================================================================|
+| Content: FTP client |
+|==============================================================================|
+| Copyright (c)1999-2011, Lukas Gebauer |
+| All rights reserved. |
+| |
+| Redistribution and use in source and binary forms, with or without |
+| modification, are permitted provided that the following conditions are met: |
+| |
+| Redistributions of source code must retain the above copyright notice, this |
+| list of conditions and the following disclaimer. |
+| |
+| Redistributions in binary form must reproduce the above copyright notice, |
+| this list of conditions and the following disclaimer in the documentation |
+| and/or other materials provided with the distribution. |
+| |
+| Neither the name of Lukas Gebauer nor the names of its contributors may |
+| be used to endorse or promote products derived from this software without |
+| specific prior written permission. |
+| |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
+| DAMAGE. |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c) 1999-2010. |
+| All Rights Reserved. |
+|==============================================================================|
+| Contributor(s): |
+| Petr Esner |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package |
+| (Found at URL: http://www.ararat.cz/synapse/) |
+|==============================================================================}
+
+{: @abstract(FTP client protocol)
+
+Used RFC: RFC-959, RFC-2228, RFC-2428
+}
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+{$TYPEINFO ON}// Borland changed defualt Visibility from Public to Published
+ // and it requires RTTI to be generated $M+
+{$M+}
+
+{$IFDEF UNICODE}
+ {$WARN IMPLICIT_STRING_CAST OFF}
+ {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+unit ftpsend;
+
+interface
+
+uses
+ SysUtils, Classes,
+ blcksock, synautil, synaip, synsock;
+
+const
+ cFtpProtocol = '21';
+ cFtpDataProtocol = '20';
+
+ {:Terminating value for TLogonActions}
+ FTP_OK = 255;
+ {:Terminating value for TLogonActions}
+ FTP_ERR = 254;
+
+type
+ {:Array for holding definition of logon sequence.}
+ TLogonActions = array [0..17] of byte;
+
+ {:Procedural type for OnStatus event. Sender is calling @link(TFTPSend) object.
+ Value is FTP command or reply to this comand. (if it is reply, Response
+ is @True).}
+ TFTPStatus = procedure(Sender: TObject; Response: Boolean;
+ const Value: string) of object;
+
+ {: @abstract(Object for holding file information) parsed from directory
+ listing of FTP server.}
+ TFTPListRec = class(TObject)
+ private
+ FFileName: String;
+ FDirectory: Boolean;
+ FReadable: Boolean;
+ FFileSize: int64;
+ FFileTime: TDateTime;
+ FOriginalLine: string;
+ FMask: string;
+ FPermission: String;
+ public
+ {: You can assign another TFTPListRec to this object.}
+ procedure Assign(Value: TFTPListRec); virtual;
+ {:name of file}
+ property FileName: string read FFileName write FFileName;
+ {:if name is subdirectory not file.}
+ property Directory: Boolean read FDirectory write FDirectory;
+ {:if you have rights to read}
+ property Readable: Boolean read FReadable write FReadable;
+ {:size of file in bytes}
+ property FileSize: int64 read FFileSize write FFileSize;
+ {:date and time of file. Local server timezone is used. Any timezone
+ conversions was not done!}
+ property FileTime: TDateTime read FFileTime write FFileTime;
+ {:original unparsed line}
+ property OriginalLine: string read FOriginalLine write FOriginalLine;
+ {:mask what was used for parsing}
+ property Mask: string read FMask write FMask;
+ {:permission string (depending on used mask!)}
+ property Permission: string read FPermission write FPermission;
+ end;
+
+ {:@abstract(This is TList of TFTPListRec objects.)
+ This object is used for holding lististing of all files information in listed
+ directory on FTP server.}
+ TFTPList = class(TObject)
+ protected
+ FList: TList;
+ FLines: TStringList;
+ FMasks: TStringList;
+ FUnparsedLines: TStringList;
+ Monthnames: string;
+ BlockSize: string;
+ DirFlagValue: string;
+ FileName: string;
+ VMSFileName: string;
+ Day: string;
+ Month: string;
+ ThreeMonth: string;
+ YearTime: string;
+ Year: string;
+ Hours: string;
+ HoursModif: Ansistring;
+ Minutes: string;
+ Seconds: string;
+ Size: Ansistring;
+ Permissions: Ansistring;
+ DirFlag: string;
+ function GetListItem(Index: integer): TFTPListRec; virtual;
+ function ParseEPLF(Value: string): Boolean; virtual;
+ procedure ClearStore; virtual;
+ function ParseByMask(Value, NextValue, Mask: ansistring): Integer; virtual;
+ function CheckValues: Boolean; virtual;
+ procedure FillRecord(const Value: TFTPListRec); virtual;
+ public
+ {:Constructor. You not need create this object, it is created by TFTPSend
+ class as their property.}
+ constructor Create;
+ destructor Destroy; override;
+
+ {:Clear list.}
+ procedure Clear; virtual;
+
+ {:count of holded @link(TFTPListRec) objects}
+ function Count: integer; virtual;
+
+ {:Assigns one list to another}
+ procedure Assign(Value: TFTPList); virtual;
+
+ {:try to parse raw directory listing in @link(lines) to list of
+ @link(TFTPListRec).}
+ procedure ParseLines; virtual;
+
+ {:By this property you have access to list of @link(TFTPListRec).
+ This is for compatibility only. Please, use @link(Items) instead.}
+ property List: TList read FList;
+
+ {:By this property you have access to list of @link(TFTPListRec).}
+ property Items[Index: Integer]: TFTPListRec read GetListItem; default;
+
+ {:Set of lines with RAW directory listing for @link(parseLines)}
+ property Lines: TStringList read FLines;
+
+ {:Set of masks for directory listing parser. It is predefined by default,
+ however you can modify it as you need. (for example, you can add your own
+ definition mask.) Mask is same as mask used in TotalCommander.}
+ property Masks: TStringList read FMasks;
+
+ {:After @link(ParseLines) it holding lines what was not sucessfully parsed.}
+ property UnparsedLines: TStringList read FUnparsedLines;
+ end;
+
+ {:@abstract(Implementation of FTP protocol.)
+ Note: Are you missing properties for setting Username and Password? Look to
+ parent @link(TSynaClient) object! (Username and Password have default values
+ for "anonymous" FTP login)
+
+ Are you missing properties for specify server address and port? Look to
+ parent @link(TSynaClient) too!}
+ TFTPSend = class(TSynaClient)
+ protected
+ FOnStatus: TFTPStatus;
+ FSock: TTCPBlockSocket;
+ FDSock: TTCPBlockSocket;
+ FResultCode: Integer;
+ FResultString: string;
+ FFullResult: TStringList;
+ FAccount: string;
+ FFWHost: string;
+ FFWPort: string;
+ FFWUsername: string;
+ FFWPassword: string;
+ FFWMode: integer;
+ FDataStream: TMemoryStream;
+ FDataIP: string;
+ FDataPort: string;
+ FDirectFile: Boolean;
+ FDirectFileName: string;
+ FCanResume: Boolean;
+ FPassiveMode: Boolean;
+ FForceDefaultPort: Boolean;
+ FForceOldPort: Boolean;
+ FFtpList: TFTPList;
+ FBinaryMode: Boolean;
+ FAutoTLS: Boolean;
+ FIsTLS: Boolean;
+ FIsDataTLS: Boolean;
+ FTLSonData: Boolean;
+ FFullSSL: Boolean;
+ function Auth(Mode: integer): Boolean; virtual;
+ function Connect: Boolean; virtual;
+ function InternalStor(const Command: string; RestoreAt: int64): Boolean; virtual;
+ function DataSocket: Boolean; virtual;
+ function AcceptDataSocket: Boolean; virtual;
+ procedure DoStatus(Response: Boolean; const Value: string); virtual;
+ public
+ {:Custom definition of login sequence. You can use this when you set
+ @link(FWMode) to value -1.}
+ CustomLogon: TLogonActions;
+
+ constructor Create;
+ destructor Destroy; override;
+
+ {:Waits and read FTP server response. You need this only in special cases!}
+ function ReadResult: Integer; virtual;
+
+ {:Parse remote side information of data channel from value string (returned
+ by PASV command). This function you need only in special cases!}
+ procedure ParseRemote(Value: string); virtual;
+
+ {:Parse remote side information of data channel from value string (returned
+ by EPSV command). This function you need only in special cases!}
+ procedure ParseRemoteEPSV(Value: string); virtual;
+
+ {:Send Value as FTP command to FTP server. Returned result code is result of
+ this function.
+ This command is good for sending site specific command, or non-standard
+ commands.}
+ function FTPCommand(const Value: string): integer; virtual;
+
+ {:Connect and logon to FTP server. If you specify any FireWall, connect to
+ firewall and throw them connect to FTP server. Login sequence depending on
+ @link(FWMode).}
+ function Login: Boolean; virtual;
+
+ {:Logoff and disconnect from FTP server.}
+ function Logout: Boolean; virtual;
+
+ {:Break current transmission of data. (You can call this method from
+ Sock.OnStatus event, or from another thread.)}
+ procedure Abort; virtual;
+
+ {:Break current transmission of data. It is same as Abort, but it send abort
+ telnet commands prior ABOR FTP command. Some servers need it. (You can call
+ this method from Sock.OnStatus event, or from another thread.)}
+ procedure TelnetAbort; virtual;
+
+ {:Download directory listing of Directory on FTP server. If Directory is
+ empty string, download listing of current working directory.
+ If NameList is @true, download only names of files in directory.
+ (internally use NLST command instead LIST command)
+ If NameList is @false, returned list is also parsed to @link(FTPList)
+ property.}
+ function List(Directory: string; NameList: Boolean): Boolean; virtual;
+
+ {:Read data from FileName on FTP server. If Restore is @true and server
+ supports resume dowloads, download is resumed. (received is only rest
+ of file)}
+ function RetrieveFile(const FileName: string; Restore: Boolean): Boolean; virtual;
+
+ {:Send data to FileName on FTP server. If Restore is @true and server
+ supports resume upload, upload is resumed. (send only rest of file)
+ In this case if remote file is same length as local file, nothing will be
+ done. If remote file is larger then local, resume is disabled and file is
+ transfered from begin!}
+ function StoreFile(const FileName: string; Restore: Boolean): Boolean; virtual;
+
+ {:Send data to FTP server and assing unique name for this file.}
+ function StoreUniqueFile: Boolean; virtual;
+
+ {:Append data to FileName on FTP server.}
+ function AppendFile(const FileName: string): Boolean; virtual;
+
+ {:Rename on FTP server file with OldName to NewName.}
+ function RenameFile(const OldName, NewName: string): Boolean; virtual;
+
+ {:Delete file FileName on FTP server.}
+ function DeleteFile(const FileName: string): Boolean; virtual;
+
+ {:Return size of Filename file on FTP server. If command failed (i.e. not
+ implemented), return -1.}
+ function FileSize(const FileName: string): int64; virtual;
+
+ {:Send NOOP command to FTP server for preserve of disconnect by inactivity
+ timeout.}
+ function NoOp: Boolean; virtual;
+
+ {:Change currect working directory to Directory on FTP server.}
+ function ChangeWorkingDir(const Directory: string): Boolean; virtual;
+
+ {:walk to upper directory on FTP server.}
+ function ChangeToParentDir: Boolean; virtual;
+
+ {:walk to root directory on FTP server. (May not work with all servers properly!)}
+ function ChangeToRootDir: Boolean; virtual;
+
+ {:Delete Directory on FTP server.}
+ function DeleteDir(const Directory: string): Boolean; virtual;
+
+ {:Create Directory on FTP server.}
+ function CreateDir(const Directory: string): Boolean; virtual;
+
+ {:Return current working directory on FTP server.}
+ function GetCurrentDir: String; virtual;
+
+ {:Establish data channel to FTP server and retrieve data.
+ This function you need only in special cases, i.e. when you need to implement
+ some special unsupported FTP command!}
+ function DataRead(const DestStream: TStream): Boolean; virtual;
+
+ {:Establish data channel to FTP server and send data.
+ This function you need only in special cases, i.e. when you need to implement
+ some special unsupported FTP command.}
+ function DataWrite(const SourceStream: TStream): Boolean; virtual;
+ published
+ {:After FTP command contains result number of this operation.}
+ property ResultCode: Integer read FResultCode;
+
+ {:After FTP command contains main line of result.}
+ property ResultString: string read FResultString;
+
+ {:After any FTP command it contains all lines of FTP server reply.}
+ property FullResult: TStringList read FFullResult;
+
+ {:Account information used in some cases inside login sequence.}
+ property Account: string read FAccount Write FAccount;
+
+ {:Address of firewall. If empty string (default), firewall not used.}
+ property FWHost: string read FFWHost Write FFWHost;
+
+ {:port of firewall. standard value is same port as ftp server used. (21)}
+ property FWPort: string read FFWPort Write FFWPort;
+
+ {:Username for login to firewall. (if needed)}
+ property FWUsername: string read FFWUsername Write FFWUsername;
+
+ {:password for login to firewall. (if needed)}
+ property FWPassword: string read FFWPassword Write FFWPassword;
+
+ {:Type of Firewall. Used only if you set some firewall address. Supported
+ predefined firewall login sequences are described by comments in source
+ file where you can see pseudocode decribing each sequence.}
+ property FWMode: integer read FFWMode Write FFWMode;
+
+ {:Socket object used for TCP/IP operation on control channel. Good for
+ seting OnStatus hook, etc.}
+ property Sock: TTCPBlockSocket read FSock;
+
+ {:Socket object used for TCP/IP operation on data channel. Good for seting
+ OnStatus hook, etc.}
+ property DSock: TTCPBlockSocket read FDSock;
+
+ {:If you not use @link(DirectFile) mode, all data transfers is made to or
+ from this stream.}
+ property DataStream: TMemoryStream read FDataStream;
+
+ {:After data connection is established, contains remote side IP of this
+ connection.}
+ property DataIP: string read FDataIP;
+
+ {:After data connection is established, contains remote side port of this
+ connection.}
+ property DataPort: string read FDataPort;
+
+ {:Mode of data handling by data connection. If @False, all data operations
+ are made to or from @link(DataStream) TMemoryStream.
+ If @true, data operations is made directly to file in your disk. (filename
+ is specified by @link(DirectFileName) property.) Dafault is @False!}
+ property DirectFile: Boolean read FDirectFile Write FDirectFile;
+
+ {:Filename for direct disk data operations.}
+ property DirectFileName: string read FDirectFileName Write FDirectFileName;
+
+ {:Indicate after @link(Login) if remote server support resume downloads and
+ uploads.}
+ property CanResume: Boolean read FCanResume;
+
+ {:If true (default value), all transfers is made by passive method.
+ It is safer method for various firewalls.}
+ property PassiveMode: Boolean read FPassiveMode Write FPassiveMode;
+
+ {:Force to listen for dataconnection on standard port (20). Default is @false,
+ dataconnections will be made to any non-standard port reported by PORT FTP
+ command. This setting is not used, if you use passive mode.}
+ property ForceDefaultPort: Boolean read FForceDefaultPort Write FForceDefaultPort;
+
+ {:When is @true, then is disabled EPSV and EPRT support. However without this
+ commands you cannot use IPv6! (Disabling of this commands is needed only
+ when you are behind some crap firewall/NAT.}
+ property ForceOldPort: Boolean read FForceOldPort Write FForceOldPort;
+
+ {:You may set this hook for monitoring FTP commands and replies.}
+ property OnStatus: TFTPStatus read FOnStatus write FOnStatus;
+
+ {:After LIST command is here parsed list of files in given directory.}
+ property FtpList: TFTPList read FFtpList;
+
+ {:if @true (default), then data transfers is in binary mode. If this is set
+ to @false, then ASCII mode is used.}
+ property BinaryMode: Boolean read FBinaryMode Write FBinaryMode;
+
+ {:if is true, then if server support upgrade to SSL/TLS mode, then use them.}
+ property AutoTLS: Boolean read FAutoTLS Write FAutoTLS;
+
+ {:if server listen on SSL/TLS port, then you set this to true.}
+ property FullSSL: Boolean read FFullSSL Write FFullSSL;
+
+ {:Signalise, if control channel is in SSL/TLS mode.}
+ property IsTLS: Boolean read FIsTLS;
+
+ {:Signalise, if data transfers is in SSL/TLS mode.}
+ property IsDataTLS: Boolean read FIsDataTLS;
+
+ {:If @true (default), then try to use SSL/TLS on data transfers too.
+ If @false, then SSL/TLS is used only for control connection.}
+ property TLSonData: Boolean read FTLSonData write FTLSonData;
+ end;
+
+{:A very useful function, and example of use can be found in the TFtpSend object.
+ Dowload specified file from FTP server to LocalFile.}
+function FtpGetFile(const IP, Port, FileName, LocalFile,
+ User, Pass: string): Boolean;
+
+{:A very useful function, and example of use can be found in the TFtpSend object.
+ Upload specified LocalFile to FTP server.}
+function FtpPutFile(const IP, Port, FileName, LocalFile,
+ User, Pass: string): Boolean;
+
+{:A very useful function, and example of use can be found in the TFtpSend object.
+ Initiate transfer of file between two FTP servers.}
+function FtpInterServerTransfer(
+ const FromIP, FromPort, FromFile, FromUser, FromPass: string;
+ const ToIP, ToPort, ToFile, ToUser, ToPass: string): Boolean;
+
+implementation
+
+constructor TFTPSend.Create;
+begin
+ inherited Create;
+ FFullResult := TStringList.Create;
+ FDataStream := TMemoryStream.Create;
+ FSock := TTCPBlockSocket.Create;
+ FSock.Owner := self;
+ FSock.ConvertLineEnd := True;
+ FDSock := TTCPBlockSocket.Create;
+ FDSock.Owner := self;
+ FFtpList := TFTPList.Create;
+ FTimeout := 300000;
+ FTargetPort := cFtpProtocol;
+ FUsername := 'anonymous';
+ FPassword := 'anonymous@' + FSock.LocalName;
+ FDirectFile := False;
+ FPassiveMode := True;
+ FForceDefaultPort := False;
+ FForceOldPort := false;
+ FAccount := '';
+ FFWHost := '';
+ FFWPort := cFtpProtocol;
+ FFWUsername := '';
+ FFWPassword := '';
+ FFWMode := 0;
+ FBinaryMode := True;
+ FAutoTLS := False;
+ FFullSSL := False;
+ FIsTLS := False;
+ FIsDataTLS := False;
+ FTLSonData := True;
+end;
+
+destructor TFTPSend.Destroy;
+begin
+ FDSock.Free;
+ FSock.Free;
+ FFTPList.Free;
+ FDataStream.Free;
+ FFullResult.Free;
+ inherited Destroy;
+end;
+
+procedure TFTPSend.DoStatus(Response: Boolean; const Value: string);
+begin
+ if assigned(OnStatus) then
+ OnStatus(Self, Response, Value);
+end;
+
+function TFTPSend.ReadResult: Integer;
+var
+ s, c: AnsiString;
+begin
+ FFullResult.Clear;
+ c := '';
+ repeat
+ s := FSock.RecvString(FTimeout);
+ if c = '' then
+ if length(s) > 3 then
+ if s[4] in [' ', '-'] then
+ c :=Copy(s, 1, 3);
+ FResultString := s;
+ FFullResult.Add(s);
+ DoStatus(True, s);
+ if FSock.LastError <> 0 then
+ Break;
+ until (c <> '') and (Pos(c + ' ', s) = 1);
+ Result := StrToIntDef(c, 0);
+ FResultCode := Result;
+end;
+
+function TFTPSend.FTPCommand(const Value: string): integer;
+begin
+ FSock.Purge;
+ FSock.SendString(Value + CRLF);
+ DoStatus(False, Value);
+ Result := ReadResult;
+end;
+
+// based on idea by Petr Esner
+function TFTPSend.Auth(Mode: integer): Boolean;
+const
+ //if not USER then
+ // if not PASS then
+ // if not ACCT then ERROR!
+ //OK!
+ Action0: TLogonActions =
+ (0, FTP_OK, 3,
+ 1, FTP_OK, 6,
+ 2, FTP_OK, FTP_ERR,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0);
+
+ //if not USER then
+ // if not PASS then ERROR!
+ //if SITE then ERROR!
+ //if not USER then
+ // if not PASS then
+ // if not ACCT then ERROR!
+ //OK!
+ Action1: TLogonActions =
+ (3, 6, 3,
+ 4, 6, FTP_ERR,
+ 5, FTP_ERR, 9,
+ 0, FTP_OK, 12,
+ 1, FTP_OK, 15,
+ 2, FTP_OK, FTP_ERR);
+
+ //if not USER then
+ // if not PASS then ERROR!
+ //if USER '@' then OK!
+ //if not PASS then
+ // if not ACCT then ERROR!
+ //OK!
+ Action2: TLogonActions =
+ (3, 6, 3,
+ 4, 6, FTP_ERR,
+ 6, FTP_OK, 9,
+ 1, FTP_OK, 12,
+ 2, FTP_OK, FTP_ERR,
+ 0, 0, 0);
+
+ //if not USER then
+ // if not PASS then ERROR!
+ //if not USER then
+ // if not PASS then
+ // if not ACCT then ERROR!
+ //OK!
+ Action3: TLogonActions =
+ (3, 6, 3,
+ 4, 6, FTP_ERR,
+ 0, FTP_OK, 9,
+ 1, FTP_OK, 12,
+ 2, FTP_OK, FTP_ERR,
+ 0, 0, 0);
+
+ //OPEN
+ //if not USER then
+ // if not PASS then
+ // if not ACCT then ERROR!
+ //OK!
+ Action4: TLogonActions =
+ (7, 3, 3,
+ 0, FTP_OK, 6,
+ 1, FTP_OK, 9,
+ 2, FTP_OK, FTP_ERR,
+ 0, 0, 0, 0, 0, 0);
+
+ //if USER '@' then OK!
+ //if not PASS then
+ // if not ACCT then ERROR!
+ //OK!
+ Action5: TLogonActions =
+ (6, FTP_OK, 3,
+ 1, FTP_OK, 6,
+ 2, FTP_OK, FTP_ERR,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0);
+
+ //if not USER @ then
+ // if not PASS then ERROR!
+ //if not USER then
+ // if not PASS then
+ // if not ACCT then ERROR!
+ //OK!
+ Action6: TLogonActions =
+ (8, 6, 3,
+ 4, 6, FTP_ERR,
+ 0, FTP_OK, 9,
+ 1, FTP_OK, 12,
+ 2, FTP_OK, FTP_ERR,
+ 0, 0, 0);
+
+ //if USER @ then ERROR!
+ //if not PASS then
+ // if not ACCT then ERROR!
+ //OK!
+ Action7: TLogonActions =
+ (9, FTP_ERR, 3,
+ 1, FTP_OK, 6,
+ 2, FTP_OK, FTP_ERR,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0);
+
+ //if not USER @@ then
+ // if not PASS @ then
+ // if not ACCT then ERROR!
+ //OK!
+ Action8: TLogonActions =
+ (10, FTP_OK, 3,
+ 11, FTP_OK, 6,
+ 2, FTP_OK, FTP_ERR,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0);
+var
+ FTPServer: string;
+ LogonActions: TLogonActions;
+ i: integer;
+ s: string;
+ x: integer;
+begin
+ Result := False;
+ if FFWHost = '' then
+ Mode := 0;
+ if (FTargetPort = cFtpProtocol) or (FTargetPort = '21') then
+ FTPServer := FTargetHost
+ else
+ FTPServer := FTargetHost + ':' + FTargetPort;
+ case Mode of
+ -1:
+ LogonActions := CustomLogon;
+ 1:
+ LogonActions := Action1;
+ 2:
+ LogonActions := Action2;
+ 3:
+ LogonActions := Action3;
+ 4:
+ LogonActions := Action4;
+ 5:
+ LogonActions := Action5;
+ 6:
+ LogonActions := Action6;
+ 7:
+ LogonActions := Action7;
+ 8:
+ LogonActions := Action8;
+ else
+ LogonActions := Action0;
+ end;
+ i := 0;
+ repeat
+ case LogonActions[i] of
+ 0: s := 'USER ' + FUserName;
+ 1: s := 'PASS ' + FPassword;
+ 2: s := 'ACCT ' + FAccount;
+ 3: s := 'USER ' + FFWUserName;
+ 4: s := 'PASS ' + FFWPassword;
+ 5: s := 'SITE ' + FTPServer;
+ 6: s := 'USER ' + FUserName + '@' + FTPServer;
+ 7: s := 'OPEN ' + FTPServer;
+ 8: s := 'USER ' + FFWUserName + '@' + FTPServer;
+ 9: s := 'USER ' + FUserName + '@' + FTPServer + ' ' + FFWUserName;
+ 10: s := 'USER ' + FUserName + '@' + FFWUserName + '@' + FTPServer;
+ 11: s := 'PASS ' + FPassword + '@' + FFWPassword;
+ end;
+ x := FTPCommand(s);
+ x := x div 100;
+ if (x <> 2) and (x <> 3) then
+ Exit;
+ i := LogonActions[i + x - 1];
+ case i of
+ FTP_ERR:
+ Exit;
+ FTP_OK:
+ begin
+ Result := True;
+ Exit;
+ end;
+ end;
+ until False;
+end;
+
+
+function TFTPSend.Connect: Boolean;
+begin
+ FSock.CloseSocket;
+ FSock.Bind(FIPInterface, cAnyPort);
+ if FSock.LastError = 0 then
+ if FFWHost = '' then
+ FSock.Connect(FTargetHost, FTargetPort)
+ else
+ FSock.Connect(FFWHost, FFWPort);
+ if FSock.LastError = 0 then
+ if FFullSSL then
+ FSock.SSLDoConnect;
+ Result := FSock.LastError = 0;
+end;
+
+function TFTPSend.Login: Boolean;
+var
+ x: integer;
+begin
+ Result := False;
+ FCanResume := False;
+ if not Connect then
+ Exit;
+ FIsTLS := FFullSSL;
+ FIsDataTLS := False;
+ repeat
+ x := ReadResult div 100;
+ until x <> 1;
+ if x <> 2 then
+ Exit;
+ if FAutoTLS and not(FIsTLS) then
+ if (FTPCommand('AUTH TLS') div 100) = 2 then
+ begin
+ FSock.SSLDoConnect;
+ FIsTLS := FSock.LastError = 0;
+ if not FIsTLS then
+ begin
+ Result := False;
+ Exit;
+ end;
+ end;
+ if not Auth(FFWMode) then
+ Exit;
+ if FIsTLS then
+ begin
+ FTPCommand('PBSZ 0');
+ if FTLSonData then
+ FIsDataTLS := (FTPCommand('PROT P') div 100) = 2;
+ if not FIsDataTLS then
+ FTPCommand('PROT C');
+ end;
+ FTPCommand('TYPE I');
+ FTPCommand('STRU F');
+ FTPCommand('MODE S');
+ if FTPCommand('REST 0') = 350 then
+ if FTPCommand('REST 1') = 350 then
+ begin
+ FTPCommand('REST 0');
+ FCanResume := True;
+ end;
+ Result := True;
+end;
+
+function TFTPSend.Logout: Boolean;
+begin
+ Result := (FTPCommand('QUIT') div 100) = 2;
+ FSock.CloseSocket;
+end;
+
+procedure TFTPSend.ParseRemote(Value: string);
+var
+ n: integer;
+ nb, ne: integer;
+ s: string;
+ x: integer;
+begin
+ Value := trim(Value);
+ nb := Pos('(',Value);
+ ne := Pos(')',Value);
+ if (nb = 0) or (ne = 0) then
+ begin
+ nb:=RPos(' ',Value);
+ s:=Copy(Value, nb + 1, Length(Value) - nb);
+ end
+ else
+ begin
+ s:=Copy(Value,nb+1,ne-nb-1);
+ end;
+ for n := 1 to 4 do
+ if n = 1 then
+ FDataIP := Fetch(s, ',')
+ else
+ FDataIP := FDataIP + '.' + Fetch(s, ',');
+ x := StrToIntDef(Fetch(s, ','), 0) * 256;
+ x := x + StrToIntDef(Fetch(s, ','), 0);
+ FDataPort := IntToStr(x);
+end;
+
+procedure TFTPSend.ParseRemoteEPSV(Value: string);
+var
+ n: integer;
+ s, v: AnsiString;
+begin
+ s := SeparateRight(Value, '(');
+ s := Trim(SeparateLeft(s, ')'));
+ Delete(s, Length(s), 1);
+ v := '';
+ for n := Length(s) downto 1 do
+ if s[n] in ['0'..'9'] then
+ v := s[n] + v
+ else
+ Break;
+ FDataPort := v;
+ FDataIP := FTargetHost;
+end;
+
+function TFTPSend.DataSocket: boolean;
+var
+ s: string;
+begin
+ Result := False;
+ if FIsDataTLS then
+ FPassiveMode := True;
+ if FPassiveMode then
+ begin
+ if FSock.IP6used then
+ s := '2'
+ else
+ s := '1';
+ if FSock.IP6used and not(FForceOldPort) and ((FTPCommand('EPSV ' + s) div 100) = 2) then
+ begin
+ ParseRemoteEPSV(FResultString);
+ end
+ else
+ if FSock.IP6used then
+ Exit
+ else
+ begin
+ if (FTPCommand('PASV') div 100) <> 2 then
+ Exit;
+ ParseRemote(FResultString);
+ end;
+ FDSock.CloseSocket;
+ FDSock.Bind(FIPInterface, cAnyPort);
+ FDSock.Connect(FDataIP, FDataPort);
+ Result := FDSock.LastError = 0;
+ end
+ else
+ begin
+ FDSock.CloseSocket;
+ if FForceDefaultPort then
+ s := cFtpDataProtocol
+ else
+ s := '0';
+ //data conection from same interface as command connection
+ FDSock.Bind(FSock.GetLocalSinIP, s);
+ if FDSock.LastError <> 0 then
+ Exit;
+ FDSock.SetLinger(True, 10000);
+ FDSock.Listen;
+ FDSock.GetSins;
+ FDataIP := FDSock.GetLocalSinIP;
+ FDataIP := FDSock.ResolveName(FDataIP);
+ FDataPort := IntToStr(FDSock.GetLocalSinPort);
+ if FSock.IP6used and (not FForceOldPort) then
+ begin
+ if IsIp6(FDataIP) then
+ s := '2'
+ else
+ s := '1';
+ s := 'EPRT |' + s +'|' + FDataIP + '|' + FDataPort + '|';
+ Result := (FTPCommand(s) div 100) = 2;
+ end;
+ if not Result and IsIP(FDataIP) then
+ begin
+ s := ReplaceString(FDataIP, '.', ',');
+ s := 'PORT ' + s + ',' + IntToStr(FDSock.GetLocalSinPort div 256)
+ + ',' + IntToStr(FDSock.GetLocalSinPort mod 256);
+ Result := (FTPCommand(s) div 100) = 2;
+ end;
+ end;
+end;
+
+function TFTPSend.AcceptDataSocket: Boolean;
+var
+ x: TSocket;
+begin
+ if FPassiveMode then
+ Result := True
+ else
+ begin
+ Result := False;
+ if FDSock.CanRead(FTimeout) then
+ begin
+ x := FDSock.Accept;
+ if not FDSock.UsingSocks then
+ FDSock.CloseSocket;
+ FDSock.Socket := x;
+ Result := True;
+ end;
+ end;
+ if Result and FIsDataTLS then
+ begin
+ FDSock.SSL.Assign(FSock.SSL);
+ FDSock.SSLDoConnect;
+ Result := FDSock.LastError = 0;
+ end;
+end;
+
+function TFTPSend.DataRead(const DestStream: TStream): Boolean;
+var
+ x: integer;
+begin
+ Result := False;
+ try
+ if not AcceptDataSocket then
+ Exit;
+ FDSock.RecvStreamRaw(DestStream, FTimeout);
+ FDSock.CloseSocket;
+ x := ReadResult;
+ Result := (x div 100) = 2;
+ finally
+ FDSock.CloseSocket;
+ end;
+end;
+
+function TFTPSend.DataWrite(const SourceStream: TStream): Boolean;
+var
+ x: integer;
+ b: Boolean;
+begin
+ Result := False;
+ try
+ if not AcceptDataSocket then
+ Exit;
+ FDSock.SendStreamRaw(SourceStream);
+ b := FDSock.LastError = 0;
+ FDSock.CloseSocket;
+ x := ReadResult;
+ Result := b and ((x div 100) = 2);
+ finally
+ FDSock.CloseSocket;
+ end;
+end;
+
+function TFTPSend.List(Directory: string; NameList: Boolean): Boolean;
+var
+ x: integer;
+begin
+ Result := False;
+ FDataStream.Clear;
+ FFTPList.Clear;
+ if Directory <> '' then
+ Directory := ' ' + Directory;
+ FTPCommand('TYPE A');
+ if not DataSocket then
+ Exit;
+ if NameList then
+ x := FTPCommand('NLST' + Directory)
+ else
+ x := FTPCommand('LIST' + Directory);
+ if (x div 100) <> 1 then
+ Exit;
+ Result := DataRead(FDataStream);
+ if (not NameList) and Result then
+ begin
+ FDataStream.Position := 0;
+ FFTPList.Lines.LoadFromStream(FDataStream);
+ FFTPList.ParseLines;
+ end;
+ FDataStream.Position := 0;
+end;
+
+function TFTPSend.RetrieveFile(const FileName: string; Restore: Boolean): Boolean;
+var
+ RetrStream: TStream;
+begin
+ Result := False;
+ if FileName = '' then
+ Exit;
+ if not DataSocket then
+ Exit;
+ Restore := Restore and FCanResume;
+ if FDirectFile then
+ if Restore and FileExists(FDirectFileName) then
+ RetrStream := TFileStream.Create(FDirectFileName,
+ fmOpenReadWrite or fmShareExclusive)
+ else
+ RetrStream := TFileStream.Create(FDirectFileName,
+ fmCreate or fmShareDenyWrite)
+ else
+ RetrStream := FDataStream;
+ try
+ if FBinaryMode then
+ FTPCommand('TYPE I')
+ else
+ FTPCommand('TYPE A');
+ if Restore then
+ begin
+ RetrStream.Position := RetrStream.Size;
+ if (FTPCommand('REST ' + IntToStr(RetrStream.Size)) div 100) <> 3 then
+ Exit;
+ end
+ else
+ if RetrStream is TMemoryStream then
+ TMemoryStream(RetrStream).Clear;
+ if (FTPCommand('RETR ' + FileName) div 100) <> 1 then
+ Exit;
+ Result := DataRead(RetrStream);
+ if not FDirectFile then
+ RetrStream.Position := 0;
+ finally
+ if FDirectFile then
+ RetrStream.Free;
+ end;
+end;
+
+function TFTPSend.InternalStor(const Command: string; RestoreAt: int64): Boolean;
+var
+ SendStream: TStream;
+ StorSize: int64;
+begin
+ Result := False;
+ if FDirectFile then
+ if not FileExists(FDirectFileName) then
+ Exit
+ else
+ SendStream := TFileStream.Create(FDirectFileName,
+ fmOpenRead or fmShareDenyWrite)
+ else
+ SendStream := FDataStream;
+ try
+ if not DataSocket then
+ Exit;
+ if FBinaryMode then
+ FTPCommand('TYPE I')
+ else
+ FTPCommand('TYPE A');
+ StorSize := SendStream.Size;
+ if not FCanResume then
+ RestoreAt := 0;
+ if (StorSize > 0) and (RestoreAt = StorSize) then
+ begin
+ Result := True;
+ Exit;
+ end;
+ if RestoreAt > StorSize then
+ RestoreAt := 0;
+ FTPCommand('ALLO ' + IntToStr(StorSize - RestoreAt));
+ if FCanResume then
+ if (FTPCommand('REST ' + IntToStr(RestoreAt)) div 100) <> 3 then
+ Exit;
+ SendStream.Position := RestoreAt;
+ if (FTPCommand(Command) div 100) <> 1 then
+ Exit;
+ Result := DataWrite(SendStream);
+ finally
+ if FDirectFile then
+ SendStream.Free;
+ end;
+end;
+
+function TFTPSend.StoreFile(const FileName: string; Restore: Boolean): Boolean;
+var
+ RestoreAt: int64;
+begin
+ Result := False;
+ if FileName = '' then
+ Exit;
+ RestoreAt := 0;
+ Restore := Restore and FCanResume;
+ if Restore then
+ begin
+ RestoreAt := Self.FileSize(FileName);
+ if RestoreAt < 0 then
+ RestoreAt := 0;
+ end;
+ Result := InternalStor('STOR ' + FileName, RestoreAt);
+end;
+
+function TFTPSend.StoreUniqueFile: Boolean;
+begin
+ Result := InternalStor('STOU', 0);
+end;
+
+function TFTPSend.AppendFile(const FileName: string): Boolean;
+begin
+ Result := False;
+ if FileName = '' then
+ Exit;
+ Result := InternalStor('APPE ' + FileName, 0);
+end;
+
+function TFTPSend.NoOp: Boolean;
+begin
+ Result := (FTPCommand('NOOP') div 100) = 2;
+end;
+
+function TFTPSend.RenameFile(const OldName, NewName: string): Boolean;
+begin
+ Result := False;
+ if (FTPCommand('RNFR ' + OldName) div 100) <> 3 then
+ Exit;
+ Result := (FTPCommand('RNTO ' + NewName) div 100) = 2;
+end;
+
+function TFTPSend.DeleteFile(const FileName: string): Boolean;
+begin
+ Result := (FTPCommand('DELE ' + FileName) div 100) = 2;
+end;
+
+function TFTPSend.FileSize(const FileName: string): int64;
+var
+ s: string;
+begin
+ Result := -1;
+ if (FTPCommand('SIZE ' + FileName) div 100) = 2 then
+ begin
+ s := Trim(SeparateRight(ResultString, ' '));
+ s := Trim(SeparateLeft(s, ' '));
+ {$IFDEF VER100}
+ Result := StrToIntDef(s, -1);
+ {$ELSE}
+ Result := StrToInt64Def(s, -1);
+ {$ENDIF}
+ end;
+end;
+
+function TFTPSend.ChangeWorkingDir(const Directory: string): Boolean;
+begin
+ Result := (FTPCommand('CWD ' + Directory) div 100) = 2;
+end;
+
+function TFTPSend.ChangeToParentDir: Boolean;
+begin
+ Result := (FTPCommand('CDUP') div 100) = 2;
+end;
+
+function TFTPSend.ChangeToRootDir: Boolean;
+begin
+ Result := ChangeWorkingDir('/');
+end;
+
+function TFTPSend.DeleteDir(const Directory: string): Boolean;
+begin
+ Result := (FTPCommand('RMD ' + Directory) div 100) = 2;
+end;
+
+function TFTPSend.CreateDir(const Directory: string): Boolean;
+begin
+ Result := (FTPCommand('MKD ' + Directory) div 100) = 2;
+end;
+
+function TFTPSend.GetCurrentDir: String;
+begin
+ Result := '';
+ if (FTPCommand('PWD') div 100) = 2 then
+ begin
+ Result := SeparateRight(FResultString, '"');
+ Result := Trim(Separateleft(Result, '"'));
+ end;
+end;
+
+procedure TFTPSend.Abort;
+begin
+ FSock.SendString('ABOR' + CRLF);
+ FDSock.StopFlag := True;
+end;
+
+procedure TFTPSend.TelnetAbort;
+begin
+ FSock.SendString(#$FF + #$F4 + #$FF + #$F2);
+ Abort;
+end;
+
+{==============================================================================}
+
+procedure TFTPListRec.Assign(Value: TFTPListRec);
+begin
+ FFileName := Value.FileName;
+ FDirectory := Value.Directory;
+ FReadable := Value.Readable;
+ FFileSize := Value.FileSize;
+ FFileTime := Value.FileTime;
+ FOriginalLine := Value.OriginalLine;
+ FMask := Value.Mask;
+end;
+
+constructor TFTPList.Create;
+begin
+ inherited Create;
+ FList := TList.Create;
+ FLines := TStringList.Create;
+ FMasks := TStringList.Create;
+ FUnparsedLines := TStringList.Create;
+ //various UNIX
+ FMasks.add('pppppppppp $!!!S*$TTT$DD$hh mm ss$YYYY$n*');
+ FMasks.add('pppppppppp $!!!S*$DD$TTT$hh mm ss$YYYY$n*');
+ FMasks.add('pppppppppp $!!!S*$TTT$DD$UUUUU$n*'); //mostly used UNIX format
+ FMasks.add('pppppppppp $!!!S*$DD$TTT$UUUUU$n*');
+ //MacOS
+ FMasks.add('pppppppppp $!!S*$TTT$DD$UUUUU$n*');
+ FMasks.add('pppppppppp $!S*$TTT$DD$UUUUU$n*');
+ //Novell
+ FMasks.add('d $!S*$TTT$DD$UUUUU$n*');
+ //Windows
+ FMasks.add('MM DD YY hh mmH !S* n*');
+ FMasks.add('MM DD YY hh mmH $ d!n*');
+ FMasks.add('MM DD YYYY hh mmH !S* n*');
+ FMasks.add('MM DD YYYY hh mmH $ d!n*');
+ FMasks.add('DD MM YYYY hh mmH !S* n*');
+ FMasks.add('DD MM YYYY hh mmH $ d!n*');
+ //VMS
+ FMasks.add('v*$ DD TTT YYYY hh mm');
+ FMasks.add('v*$!DD TTT YYYY hh mm');
+ FMasks.add('n*$ YYYY MM DD hh mm$S*');
+ //AS400
+ FMasks.add('!S*$MM DD YY hh mm ss !n*');
+ FMasks.add('!S*$DD MM YY hh mm ss !n*');
+ FMasks.add('n*!S*$MM DD YY hh mm ss d');
+ FMasks.add('n*!S*$DD MM YY hh mm ss d');
+ //VxWorks
+ FMasks.add('$S* TTT DD YYYY hh mm ss $n* $ d');
+ FMasks.add('$S* TTT DD YYYY hh mm ss $n*');
+ //Distinct
+ FMasks.add('d $S*$TTT DD YYYY hh mm$n*');
+ FMasks.add('d $S*$TTT DD$hh mm$n*');
+ //PC-NFSD
+ FMasks.add('nnnnnnnn.nnn dSSSSSSSSSSS MM DD YY hh mmH');
+ //VOS
+ FMasks.add('- SSSSS YY MM DD hh mm ss n*');
+ FMasks.add('- d= SSSSS YY MM DD hh mm ss n*');
+ //Unissys ClearPath
+ FMasks.add('nnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn SSSSSSSSS MM DD YYYY hh mm');
+ FMasks.add('n*\x SSSSSSSSS MM DD YYYY hh mm');
+ //IBM
+ FMasks.add('- SSSSSSSSSSSS d MM DD YYYY hh mm n*');
+ //OS9
+ FMasks.add('- YY MM DD hhmm d SSSSSSSSS n*');
+ //tandem
+ FMasks.add('nnnnnnnn SSSSSSS DD TTT YY hh mm ss');
+ //MVS
+ FMasks.add('- YYYY MM DD SSSSS d=O n*');
+ //BullGCOS8
+ FMasks.add(' $S* MM DD YY hh mm ss !n*');
+ FMasks.add('d $S* MM DD YY !n*');
+ //BullGCOS7
+ FMasks.add(' TTT DD YYYY n*');
+ FMasks.add(' d n*');
+end;
+
+destructor TFTPList.Destroy;
+begin
+ Clear;
+ FList.Free;
+ FLines.Free;
+ FMasks.Free;
+ FUnparsedLines.Free;
+ inherited Destroy;
+end;
+
+procedure TFTPList.Clear;
+var
+ n:integer;
+begin
+ for n := 0 to FList.Count - 1 do
+ if Assigned(FList[n]) then
+ TFTPListRec(FList[n]).Free;
+ FList.Clear;
+ FLines.Clear;
+ FUnparsedLines.Clear;
+end;
+
+function TFTPList.Count: integer;
+begin
+ Result := FList.Count;
+end;
+
+function TFTPList.GetListItem(Index: integer): TFTPListRec;
+begin
+ Result := nil;
+ if Index < Count then
+ Result := TFTPListRec(FList[Index]);
+end;
+
+procedure TFTPList.Assign(Value: TFTPList);
+var
+ flr: TFTPListRec;
+ n: integer;
+begin
+ Clear;
+ for n := 0 to Value.Count - 1 do
+ begin
+ flr := TFTPListRec.Create;
+ flr.Assign(Value[n]);
+ Flist.Add(flr);
+ end;
+ Lines.Assign(Value.Lines);
+ Masks.Assign(Value.Masks);
+ UnparsedLines.Assign(Value.UnparsedLines);
+end;
+
+procedure TFTPList.ClearStore;
+begin
+ Monthnames := '';
+ BlockSize := '';
+ DirFlagValue := '';
+ FileName := '';
+ VMSFileName := '';
+ Day := '';
+ Month := '';
+ ThreeMonth := '';
+ YearTime := '';
+ Year := '';
+ Hours := '';
+ HoursModif := '';
+ Minutes := '';
+ Seconds := '';
+ Size := '';
+ Permissions := '';
+ DirFlag := '';
+end;
+
+function TFTPList.ParseByMask(Value, NextValue, Mask: AnsiString): Integer;
+var
+ Ivalue, IMask: integer;
+ MaskC, LastMaskC: AnsiChar;
+ c: AnsiChar;
+ s: string;
+begin
+ ClearStore;
+ Result := 0;
+ if Value = '' then
+ Exit;
+ if Mask = '' then
+ Exit;
+ Ivalue := 1;
+ IMask := 1;
+ Result := 1;
+ LastMaskC := ' ';
+ while Imask <= Length(mask) do
+ begin
+ if (Mask[Imask] <> '*') and (Ivalue > Length(Value)) then
+ begin
+ Result := 0;
+ Exit;
+ end;
+ MaskC := Mask[Imask];
+ if Ivalue > Length(Value) then
+ Exit;
+ c := Value[Ivalue];
+ case MaskC of
+ 'n':
+ FileName := FileName + c;
+ 'v':
+ VMSFileName := VMSFileName + c;
+ '.':
+ begin
+ if c in ['.', ' '] then
+ FileName := TrimSP(FileName) + '.'
+ else
+ begin
+ Result := 0;
+ Exit;
+ end;
+ end;
+ 'D':
+ Day := Day + c;
+ 'M':
+ Month := Month + c;
+ 'T':
+ ThreeMonth := ThreeMonth + c;
+ 'U':
+ YearTime := YearTime + c;
+ 'Y':
+ Year := Year + c;
+ 'h':
+ Hours := Hours + c;
+ 'H':
+ HoursModif := HoursModif + c;
+ 'm':
+ Minutes := Minutes + c;
+ 's':
+ Seconds := Seconds + c;
+ 'S':
+ Size := Size + c;
+ 'p':
+ Permissions := Permissions + c;
+ 'd':
+ DirFlag := DirFlag + c;
+ 'x':
+ if c <> ' ' then
+ begin
+ Result := 0;
+ Exit;
+ end;
+ '*':
+ begin
+ s := '';
+ if LastMaskC in ['n', 'v'] then
+ begin
+ if Imask = Length(Mask) then
+ s := Copy(Value, IValue, Maxint)
+ else
+ while IValue <= Length(Value) do
+ begin
+ if Value[Ivalue] = ' ' then
+ break;
+ s := s + Value[Ivalue];
+ Inc(Ivalue);
+ end;
+ if LastMaskC = 'n' then
+ FileName := FileName + s
+ else
+ VMSFileName := VMSFileName + s;
+ end
+ else
+ begin
+ while IValue <= Length(Value) do
+ begin
+ if not(Value[Ivalue] in ['0'..'9']) then
+ break;
+ s := s + Value[Ivalue];
+ Inc(Ivalue);
+ end;
+ case LastMaskC of
+ 'S':
+ Size := Size + s;
+ end;
+ end;
+ Dec(IValue);
+ end;
+ '!':
+ begin
+ while IValue <= Length(Value) do
+ begin
+ if Value[Ivalue] = ' ' then
+ break;
+ Inc(Ivalue);
+ end;
+ while IValue <= Length(Value) do
+ begin
+ if Value[Ivalue] <> ' ' then
+ break;
+ Inc(Ivalue);
+ end;
+ Dec(IValue);
+ end;
+ '$':
+ begin
+ while IValue <= Length(Value) do
+ begin
+ if not(Value[Ivalue] in [' ', #9]) then
+ break;
+ Inc(Ivalue);
+ end;
+ Dec(IValue);
+ end;
+ '=':
+ begin
+ s := '';
+ case LastmaskC of
+ 'S':
+ begin
+ while Imask <= Length(Mask) do
+ begin
+ if not(Mask[Imask] in ['0'..'9']) then
+ break;
+ s := s + Mask[Imask];
+ Inc(Imask);
+ end;
+ Dec(Imask);
+ BlockSize := s;
+ end;
+ 'T':
+ begin
+ Monthnames := Copy(Mask, IMask, 12 * 3);
+ Inc(IMask, 12 * 3);
+ end;
+ 'd':
+ begin
+ Inc(Imask);
+ DirFlagValue := Mask[Imask];
+ end;
+ end;
+ end;
+ '\':
+ begin
+ Value := NextValue;
+ IValue := 0;
+ Result := 2;
+ end;
+ end;
+ Inc(Ivalue);
+ Inc(Imask);
+ LastMaskC := MaskC;
+ end;
+end;
+
+function TFTPList.CheckValues: Boolean;
+var
+ x, n: integer;
+begin
+ Result := false;
+ if FileName <> '' then
+ begin
+ if pos('?', VMSFilename) > 0 then
+ Exit;
+ if pos('*', VMSFilename) > 0 then
+ Exit;
+ end;
+ if VMSFileName <> '' then
+ if pos(';', VMSFilename) <= 0 then
+ Exit;
+ if (FileName = '') and (VMSFileName = '') then
+ Exit;
+ if Permissions <> '' then
+ begin
+ if length(Permissions) <> 10 then
+ Exit;
+ for n := 1 to 10 do
+ if not(Permissions[n] in
+ ['a', 'b', 'c', 'd', 'h', 'l', 'p', 'r', 's', 't', 'w', 'x', 'y', '-']) then
+ Exit;
+ end;
+ if Day <> '' then
+ begin
+ Day := TrimSP(Day);
+ x := StrToIntDef(day, -1);
+ if (x < 1) or (x > 31) then
+ Exit;
+ end;
+ if Month <> '' then
+ begin
+ Month := TrimSP(Month);
+ x := StrToIntDef(Month, -1);
+ if (x < 1) or (x > 12) then
+ Exit;
+ end;
+ if Hours <> '' then
+ begin
+ Hours := TrimSP(Hours);
+ x := StrToIntDef(Hours, -1);
+ if (x < 0) or (x > 24) then
+ Exit;
+ end;
+ if HoursModif <> '' then
+ begin
+ if not (HoursModif[1] in ['a', 'A', 'p', 'P']) then
+ Exit;
+ end;
+ if Minutes <> '' then
+ begin
+ Minutes := TrimSP(Minutes);
+ x := StrToIntDef(Minutes, -1);
+ if (x < 0) or (x > 59) then
+ Exit;
+ end;
+ if Seconds <> '' then
+ begin
+ Seconds := TrimSP(Seconds);
+ x := StrToIntDef(Seconds, -1);
+ if (x < 0) or (x > 59) then
+ Exit;
+ end;
+ if Size <> '' then
+ begin
+ Size := TrimSP(Size);
+ for n := 1 to Length(Size) do
+ if not (Size[n] in ['0'..'9']) then
+ Exit;
+ end;
+
+ if length(Monthnames) = (12 * 3) then
+ for n := 1 to 12 do
+ CustomMonthNames[n] := Copy(Monthnames, ((n - 1) * 3) + 1, 3);
+ if ThreeMonth <> '' then
+ begin
+ x := GetMonthNumber(ThreeMonth);
+ if (x = 0) then
+ Exit;
+ end;
+ if YearTime <> '' then
+ begin
+ YearTime := ReplaceString(YearTime, '-', ':');
+ if pos(':', YearTime) > 0 then
+ begin
+ if (GetTimeFromstr(YearTime) = -1) then
+ Exit;
+ end
+ else
+ begin
+ YearTime := TrimSP(YearTime);
+ x := StrToIntDef(YearTime, -1);
+ if (x = -1) then
+ Exit;
+ if (x < 1900) or (x > 2100) then
+ Exit;
+ end;
+ end;
+ if Year <> '' then
+ begin
+ Year := TrimSP(Year);
+ x := StrToIntDef(Year, -1);
+ if (x = -1) then
+ Exit;
+ if Length(Year) = 4 then
+ begin
+ if not((x > 1900) and (x < 2100)) then
+ Exit;
+ end
+ else
+ if Length(Year) = 2 then
+ begin
+ if not((x >= 0) and (x <= 99)) then
+ Exit;
+ end
+ else
+ if Length(Year) = 3 then
+ begin
+ if not((x >= 100) and (x <= 110)) then
+ Exit;
+ end
+ else
+ Exit;
+ end;
+ Result := True;
+end;
+
+procedure TFTPList.FillRecord(const Value: TFTPListRec);
+var
+ s: string;
+ x: integer;
+ myear: Word;
+ mmonth: Word;
+ mday: Word;
+ mhours, mminutes, mseconds: word;
+ n: integer;
+begin
+ s := DirFlagValue;
+ if s = '' then
+ s := 'D';
+ s := Uppercase(s);
+ Value.Directory := s = Uppercase(DirFlag);
+ if FileName <> '' then
+ Value.FileName := SeparateLeft(Filename, ' -> ');
+ if VMSFileName <> '' then
+ begin
+ Value.FileName := VMSFilename;
+ Value.Directory := Pos('.DIR;',VMSFilename) > 0;
+ end;
+ Value.FileName := TrimSPRight(Value.FileName);
+ Value.Readable := not Value.Directory;
+ if BlockSize <> '' then
+ x := StrToIntDef(BlockSize, 1)
+ else
+ x := 1;
+ {$IFDEF VER100}
+ Value.FileSize := x * StrToIntDef(Size, 0);
+ {$ELSE}
+ Value.FileSize := x * StrToInt64Def(Size, 0);
+ {$ENDIF}
+
+ DecodeDate(Date,myear,mmonth,mday);
+ mhours := 0;
+ mminutes := 0;
+ mseconds := 0;
+
+ if Day <> '' then
+ mday := StrToIntDef(day, 1);
+ if Month <> '' then
+ mmonth := StrToIntDef(Month, 1);
+ if length(Monthnames) = (12 * 3) then
+ for n := 1 to 12 do
+ CustomMonthNames[n] := Copy(Monthnames, ((n - 1) * 3) + 1, 3);
+ if ThreeMonth <> '' then
+ mmonth := GetMonthNumber(ThreeMonth);
+ if Year <> '' then
+ begin
+ myear := StrToIntDef(Year, 0);
+ if (myear <= 99) and (myear > 50) then
+ myear := myear + 1900;
+ if myear <= 50 then
+ myear := myear + 2000;
+ end;
+ if YearTime <> '' then
+ begin
+ if pos(':', YearTime) > 0 then
+ begin
+ YearTime := TrimSP(YearTime);
+ mhours := StrToIntDef(Separateleft(YearTime, ':'), 0);
+ mminutes := StrToIntDef(SeparateRight(YearTime, ':'), 0);
+ if (Encodedate(myear, mmonth, mday)
+ + EncodeTime(mHours, mminutes, 0, 0)) > now then
+ Dec(mYear);
+ end
+ else
+ myear := StrToIntDef(YearTime, 0);
+ end;
+ if Minutes <> '' then
+ mminutes := StrToIntDef(Minutes, 0);
+ if Seconds <> '' then
+ mseconds := StrToIntDef(Seconds, 0);
+ if Hours <> '' then
+ begin
+ mHours := StrToIntDef(Hours, 0);
+ if HoursModif <> '' then
+ if Uppercase(HoursModif[1]) = 'P' then
+ if mHours <> 12 then
+ mHours := MHours + 12;
+ end;
+ Value.FileTime := Encodedate(myear, mmonth, mday)
+ + EncodeTime(mHours, mminutes, mseconds, 0);
+ if Permissions <> '' then
+ begin
+ Value.Permission := Permissions;
+ Value.Readable := Uppercase(permissions)[2] = 'R';
+ if Uppercase(permissions)[1] = 'D' then
+ begin
+ Value.Directory := True;
+ Value.Readable := false;
+ end
+ else
+ if Uppercase(permissions)[1] = 'L' then
+ Value.Directory := True;
+ end;
+end;
+
+function TFTPList.ParseEPLF(Value: string): Boolean;
+var
+ s, os: string;
+ flr: TFTPListRec;
+begin
+ Result := False;
+ if Value <> '' then
+ if Value[1] = '+' then
+ begin
+ os := Value;
+ Delete(Value, 1, 1);
+ flr := TFTPListRec.create;
+ flr.FileName := SeparateRight(Value, #9);
+ s := Fetch(Value, ',');
+ while s <> '' do
+ begin
+ if s[1] = #9 then
+ Break;
+ case s[1] of
+ '/':
+ flr.Directory := true;
+ 'r':
+ flr.Readable := true;
+ 's':
+ {$IFDEF VER100}
+ flr.FileSize := StrToIntDef(Copy(s, 2, Length(s) - 1), 0);
+ {$ELSE}
+ flr.FileSize := StrToInt64Def(Copy(s, 2, Length(s) - 1), 0);
+ {$ENDIF}
+ 'm':
+ flr.FileTime := (StrToIntDef(Copy(s, 2, Length(s) - 1), 0) / 86400)
+ + 25569;
+ end;
+ s := Fetch(Value, ',');
+ end;
+ if flr.FileName <> '' then
+ if (flr.Directory and ((flr.FileName = '.') or (flr.FileName = '..')))
+ or (flr.FileName = '') then
+ flr.free
+ else
+ begin
+ flr.OriginalLine := os;
+ flr.Mask := 'EPLF';
+ Flist.Add(flr);
+ Result := True;
+ end;
+ end;
+end;
+
+procedure TFTPList.ParseLines;
+var
+ flr: TFTPListRec;
+ n, m: Integer;
+ S: string;
+ x: integer;
+ b: Boolean;
+begin
+ n := 0;
+ while n < Lines.Count do
+ begin
+ if n = Lines.Count - 1 then
+ s := ''
+ else
+ s := Lines[n + 1];
+ b := False;
+ x := 0;
+ if ParseEPLF(Lines[n]) then
+ begin
+ b := True;
+ x := 1;
+ end
+ else
+ for m := 0 to Masks.Count - 1 do
+ begin
+ x := ParseByMask(Lines[n], s, Masks[m]);
+ if x > 0 then
+ if CheckValues then
+ begin
+ flr := TFTPListRec.create;
+ FillRecord(flr);
+ flr.OriginalLine := Lines[n];
+ flr.Mask := Masks[m];
+ if flr.Directory and ((flr.FileName = '.') or (flr.FileName = '..')) then
+ flr.free
+ else
+ Flist.Add(flr);
+ b := True;
+ Break;
+ end;
+ end;
+ if not b then
+ FUnparsedLines.Add(Lines[n]);
+ Inc(n);
+ if x > 1 then
+ Inc(n, x - 1);
+ end;
+end;
+
+{==============================================================================}
+
+function FtpGetFile(const IP, Port, FileName, LocalFile,
+ User, Pass: string): Boolean;
+begin
+ Result := False;
+ with TFTPSend.Create do
+ try
+ if User <> '' then
+ begin
+ Username := User;
+ Password := Pass;
+ end;
+ TargetHost := IP;
+ TargetPort := Port;
+ if not Login then
+ Exit;
+ DirectFileName := LocalFile;
+ DirectFile:=True;
+ Result := RetrieveFile(FileName, False);
+ Logout;
+ finally
+ Free;
+ end;
+end;
+
+function FtpPutFile(const IP, Port, FileName, LocalFile,
+ User, Pass: string): Boolean;
+begin
+ Result := False;
+ with TFTPSend.Create do
+ try
+ if User <> '' then
+ begin
+ Username := User;
+ Password := Pass;
+ end;
+ TargetHost := IP;
+ TargetPort := Port;
+ if not Login then
+ Exit;
+ DirectFileName := LocalFile;
+ DirectFile:=True;
+ Result := StoreFile(FileName, False);
+ Logout;
+ finally
+ Free;
+ end;
+end;
+
+function FtpInterServerTransfer(
+ const FromIP, FromPort, FromFile, FromUser, FromPass: string;
+ const ToIP, ToPort, ToFile, ToUser, ToPass: string): Boolean;
+var
+ FromFTP, ToFTP: TFTPSend;
+ s: string;
+ x: integer;
+begin
+ Result := False;
+ FromFTP := TFTPSend.Create;
+ toFTP := TFTPSend.Create;
+ try
+ if FromUser <> '' then
+ begin
+ FromFTP.Username := FromUser;
+ FromFTP.Password := FromPass;
+ end;
+ if ToUser <> '' then
+ begin
+ ToFTP.Username := ToUser;
+ ToFTP.Password := ToPass;
+ end;
+ FromFTP.TargetHost := FromIP;
+ FromFTP.TargetPort := FromPort;
+ ToFTP.TargetHost := ToIP;
+ ToFTP.TargetPort := ToPort;
+ if not FromFTP.Login then
+ Exit;
+ if not ToFTP.Login then
+ Exit;
+ if (FromFTP.FTPCommand('PASV') div 100) <> 2 then
+ Exit;
+ FromFTP.ParseRemote(FromFTP.ResultString);
+ s := ReplaceString(FromFTP.DataIP, '.', ',');
+ s := 'PORT ' + s + ',' + IntToStr(StrToIntDef(FromFTP.DataPort, 0) div 256)
+ + ',' + IntToStr(StrToIntDef(FromFTP.DataPort, 0) mod 256);
+ if (ToFTP.FTPCommand(s) div 100) <> 2 then
+ Exit;
+ x := ToFTP.FTPCommand('RETR ' + FromFile);
+ if (x div 100) <> 1 then
+ Exit;
+ x := FromFTP.FTPCommand('STOR ' + ToFile);
+ if (x div 100) <> 1 then
+ Exit;
+ FromFTP.Timeout := 21600000;
+ x := FromFTP.ReadResult;
+ if (x div 100) <> 2 then
+ Exit;
+ ToFTP.Timeout := 21600000;
+ x := ToFTP.ReadResult;
+ if (x div 100) <> 2 then
+ Exit;
+ Result := True;
+ finally
+ ToFTP.Free;
+ FromFTP.Free;
+ end;
+end;
+
+end.
ADDED lib/synapse/source/lib/ftptsend.pas
Index: lib/synapse/source/lib/ftptsend.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/lib/ftptsend.pas
@@ -0,0 +1,403 @@
+{==============================================================================|
+| Project : Ararat Synapse | 001.001.001 |
+|==============================================================================|
+| Content: Trivial FTP (TFTP) client and server |
+|==============================================================================|
+| Copyright (c)1999-2010, Lukas Gebauer |
+| All rights reserved. |
+| |
+| Redistribution and use in source and binary forms, with or without |
+| modification, are permitted provided that the following conditions are met: |
+| |
+| Redistributions of source code must retain the above copyright notice, this |
+| list of conditions and the following disclaimer. |
+| |
+| Redistributions in binary form must reproduce the above copyright notice, |
+| this list of conditions and the following disclaimer in the documentation |
+| and/or other materials provided with the distribution. |
+| |
+| Neither the name of Lukas Gebauer nor the names of its contributors may |
+| be used to endorse or promote products derived from this software without |
+| specific prior written permission. |
+| |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
+| DAMAGE. |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2003-2010. |
+| All Rights Reserved. |
+|==============================================================================|
+| Contributor(s): |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package |
+| (Found at URL: http://www.ararat.cz/synapse/) |
+|==============================================================================}
+
+{: @abstract(TFTP client and server protocol)
+
+Used RFC: RFC-1350
+}
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+{$Q-}
+{$H+}
+
+{$IFDEF UNICODE}
+ {$WARN IMPLICIT_STRING_CAST OFF}
+ {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+unit ftptsend;
+
+interface
+
+uses
+ SysUtils, Classes,
+ blcksock, synautil;
+
+const
+ cTFTPProtocol = '69';
+
+ cTFTP_RRQ = word(1);
+ cTFTP_WRQ = word(2);
+ cTFTP_DTA = word(3);
+ cTFTP_ACK = word(4);
+ cTFTP_ERR = word(5);
+
+type
+ {:@abstract(Implementation of TFTP client and server)
+ Note: Are you missing properties for specify server address and port? Look to
+ parent @link(TSynaClient) too!}
+ TTFTPSend = class(TSynaClient)
+ private
+ FSock: TUDPBlockSocket;
+ FErrorCode: integer;
+ FErrorString: string;
+ FData: TMemoryStream;
+ FRequestIP: string;
+ FRequestPort: string;
+ function SendPacket(Cmd: word; Serial: word; const Value: string): Boolean;
+ function RecvPacket(Serial: word; var Value: string): Boolean;
+ public
+ constructor Create;
+ destructor Destroy; override;
+
+ {:Upload @link(data) as file to TFTP server.}
+ function SendFile(const Filename: string): Boolean;
+
+ {:Download file from TFTP server to @link(data).}
+ function RecvFile(const Filename: string): Boolean;
+
+ {:Acts as TFTP server and wait for client request. When some request
+ incoming within Timeout, result is @true and parametres is filled with
+ information from request. You must handle this request, validate it, and
+ call @link(ReplyError), @link(ReplyRecv) or @link(ReplySend) for send reply
+ to TFTP Client.}
+ function WaitForRequest(var Req: word; var filename: string): Boolean;
+
+ {:send error to TFTP client, when you acts as TFTP server.}
+ procedure ReplyError(Error: word; Description: string);
+
+ {:Accept uploaded file from TFTP client to @link(data), when you acts as
+ TFTP server.}
+ function ReplyRecv: Boolean;
+
+ {:Accept download request file from TFTP client and send content of
+ @link(data), when you acts as TFTP server.}
+ function ReplySend: Boolean;
+ published
+ {:Code of TFTP error.}
+ property ErrorCode: integer read FErrorCode;
+
+ {:Human readable decription of TFTP error. (if is sended by remote side)}
+ property ErrorString: string read FErrorString;
+
+ {:MemoryStream with datas for sending or receiving}
+ property Data: TMemoryStream read FData;
+
+ {:Address of TFTP remote side.}
+ property RequestIP: string read FRequestIP write FRequestIP;
+
+ {:Port of TFTP remote side.}
+ property RequestPort: string read FRequestPort write FRequestPort;
+ end;
+
+implementation
+
+constructor TTFTPSend.Create;
+begin
+ inherited Create;
+ FSock := TUDPBlockSocket.Create;
+ FSock.Owner := self;
+ FTargetPort := cTFTPProtocol;
+ FData := TMemoryStream.Create;
+ FErrorCode := 0;
+ FErrorString := '';
+end;
+
+destructor TTFTPSend.Destroy;
+begin
+ FSock.Free;
+ FData.Free;
+ inherited Destroy;
+end;
+
+function TTFTPSend.SendPacket(Cmd: word; Serial: word; const Value: string): Boolean;
+var
+ s, sh: string;
+begin
+ FErrorCode := 0;
+ FErrorString := '';
+ Result := false;
+ if Cmd <> 2 then
+ s := CodeInt(Cmd) + CodeInt(Serial) + Value
+ else
+ s := CodeInt(Cmd) + Value;
+ FSock.SendString(s);
+ s := FSock.RecvPacket(FTimeout);
+ if FSock.LastError = 0 then
+ if length(s) >= 4 then
+ begin
+ sh := CodeInt(4) + CodeInt(Serial);
+ if Pos(sh, s) = 1 then
+ Result := True
+ else
+ if s[1] = #5 then
+ begin
+ FErrorCode := DecodeInt(s, 3);
+ Delete(s, 1, 4);
+ FErrorString := SeparateLeft(s, #0);
+ end;
+ end;
+end;
+
+function TTFTPSend.RecvPacket(Serial: word; var Value: string): Boolean;
+var
+ s: string;
+ ser: word;
+begin
+ FErrorCode := 0;
+ FErrorString := '';
+ Result := False;
+ Value := '';
+ s := FSock.RecvPacket(FTimeout);
+ if FSock.LastError = 0 then
+ if length(s) >= 4 then
+ if DecodeInt(s, 1) = 3 then
+ begin
+ ser := DecodeInt(s, 3);
+ if ser = Serial then
+ begin
+ Delete(s, 1, 4);
+ Value := s;
+ S := CodeInt(4) + CodeInt(ser);
+ FSock.SendString(s);
+ Result := FSock.LastError = 0;
+ end
+ else
+ begin
+ S := CodeInt(5) + CodeInt(5) + 'Unexcepted serial#' + #0;
+ FSock.SendString(s);
+ end;
+ end;
+ if DecodeInt(s, 1) = 5 then
+ begin
+ FErrorCode := DecodeInt(s, 3);
+ Delete(s, 1, 4);
+ FErrorString := SeparateLeft(s, #0);
+ end;
+end;
+
+function TTFTPSend.SendFile(const Filename: string): Boolean;
+var
+ s: string;
+ ser: word;
+ n, n1, n2: integer;
+begin
+ Result := False;
+ FErrorCode := 0;
+ FErrorString := '';
+ FSock.CloseSocket;
+ FSock.Connect(FTargetHost, FTargetPort);
+ try
+ if FSock.LastError = 0 then
+ begin
+ s := Filename + #0 + 'octet' + #0;
+ if not Sendpacket(2, 0, s) then
+ Exit;
+ ser := 1;
+ FData.Position := 0;
+ n1 := FData.Size div 512;
+ n2 := FData.Size mod 512;
+ for n := 1 to n1 do
+ begin
+ s := ReadStrFromStream(FData, 512);
+// SetLength(s, 512);
+// FData.Read(pointer(s)^, 512);
+ if not Sendpacket(3, ser, s) then
+ Exit;
+ inc(ser);
+ end;
+ s := ReadStrFromStream(FData, n2);
+// SetLength(s, n2);
+// FData.Read(pointer(s)^, n2);
+ if not Sendpacket(3, ser, s) then
+ Exit;
+ Result := True;
+ end;
+ finally
+ FSock.CloseSocket;
+ end;
+end;
+
+function TTFTPSend.RecvFile(const Filename: string): Boolean;
+var
+ s: string;
+ ser: word;
+begin
+ Result := False;
+ FErrorCode := 0;
+ FErrorString := '';
+ FSock.CloseSocket;
+ FSock.Connect(FTargetHost, FTargetPort);
+ try
+ if FSock.LastError = 0 then
+ begin
+ s := CodeInt(1) + Filename + #0 + 'octet' + #0;
+ FSock.SendString(s);
+ if FSock.LastError <> 0 then
+ Exit;
+ FData.Clear;
+ ser := 1;
+ repeat
+ if not RecvPacket(ser, s) then
+ Exit;
+ inc(ser);
+ WriteStrToStream(FData, s);
+// FData.Write(pointer(s)^, length(s));
+ until length(s) <> 512;
+ FData.Position := 0;
+ Result := true;
+ end;
+ finally
+ FSock.CloseSocket;
+ end;
+end;
+
+function TTFTPSend.WaitForRequest(var Req: word; var filename: string): Boolean;
+var
+ s: string;
+begin
+ Result := False;
+ FErrorCode := 0;
+ FErrorString := '';
+ FSock.CloseSocket;
+ FSock.Bind('0.0.0.0', FTargetPort);
+ if FSock.LastError = 0 then
+ begin
+ s := FSock.RecvPacket(FTimeout);
+ if FSock.LastError = 0 then
+ if Length(s) >= 4 then
+ begin
+ FRequestIP := FSock.GetRemoteSinIP;
+ FRequestPort := IntToStr(FSock.GetRemoteSinPort);
+ Req := DecodeInt(s, 1);
+ delete(s, 1, 2);
+ filename := Trim(SeparateLeft(s, #0));
+ s := SeparateRight(s, #0);
+ s := SeparateLeft(s, #0);
+ Result := lowercase(trim(s)) = 'octet';
+ end;
+ end;
+end;
+
+procedure TTFTPSend.ReplyError(Error: word; Description: string);
+var
+ s: string;
+begin
+ FSock.CloseSocket;
+ FSock.Connect(FRequestIP, FRequestPort);
+ s := CodeInt(5) + CodeInt(Error) + Description + #0;
+ FSock.SendString(s);
+ FSock.CloseSocket;
+end;
+
+function TTFTPSend.ReplyRecv: Boolean;
+var
+ s: string;
+ ser: integer;
+begin
+ Result := False;
+ FErrorCode := 0;
+ FErrorString := '';
+ FSock.CloseSocket;
+ FSock.Connect(FRequestIP, FRequestPort);
+ try
+ s := CodeInt(4) + CodeInt(0);
+ FSock.SendString(s);
+ FData.Clear;
+ ser := 1;
+ repeat
+ if not RecvPacket(ser, s) then
+ Exit;
+ inc(ser);
+ WriteStrToStream(FData, s);
+// FData.Write(pointer(s)^, length(s));
+ until length(s) <> 512;
+ FData.Position := 0;
+ Result := true;
+ finally
+ FSock.CloseSocket;
+ end;
+end;
+
+function TTFTPSend.ReplySend: Boolean;
+var
+ s: string;
+ ser: word;
+ n, n1, n2: integer;
+begin
+ Result := False;
+ FErrorCode := 0;
+ FErrorString := '';
+ FSock.CloseSocket;
+ FSock.Connect(FRequestIP, FRequestPort);
+ try
+ ser := 1;
+ FData.Position := 0;
+ n1 := FData.Size div 512;
+ n2 := FData.Size mod 512;
+ for n := 1 to n1 do
+ begin
+ s := ReadStrFromStream(FData, 512);
+// SetLength(s, 512);
+// FData.Read(pointer(s)^, 512);
+ if not Sendpacket(3, ser, s) then
+ Exit;
+ inc(ser);
+ end;
+ s := ReadStrFromStream(FData, n2);
+// SetLength(s, n2);
+// FData.Read(pointer(s)^, n2);
+ if not Sendpacket(3, ser, s) then
+ Exit;
+ Result := True;
+ finally
+ FSock.CloseSocket;
+ end;
+end;
+
+{==============================================================================}
+
+end.
ADDED lib/synapse/source/lib/httpsend.pas
Index: lib/synapse/source/lib/httpsend.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/lib/httpsend.pas
@@ -0,0 +1,845 @@
+{==============================================================================|
+| Project : Ararat Synapse | 003.012.006 |
+|==============================================================================|
+| Content: HTTP client |
+|==============================================================================|
+| Copyright (c)1999-2011, Lukas Gebauer |
+| All rights reserved. |
+| |
+| Redistribution and use in source and binary forms, with or without |
+| modification, are permitted provided that the following conditions are met: |
+| |
+| Redistributions of source code must retain the above copyright notice, this |
+| list of conditions and the following disclaimer. |
+| |
+| Redistributions in binary form must reproduce the above copyright notice, |
+| this list of conditions and the following disclaimer in the documentation |
+| and/or other materials provided with the distribution. |
+| |
+| Neither the name of Lukas Gebauer nor the names of its contributors may |
+| be used to endorse or promote products derived from this software without |
+| specific prior written permission. |
+| |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
+| DAMAGE. |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c) 1999-2011. |
+| All Rights Reserved. |
+|==============================================================================|
+| Contributor(s): |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package |
+| (Found at URL: http://www.ararat.cz/synapse/) |
+|==============================================================================}
+
+{:@abstract(HTTP protocol client)
+
+Used RFC: RFC-1867, RFC-1947, RFC-2388, RFC-2616
+}
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+//old Delphi does not have MSWINDOWS define.
+{$IFDEF WIN32}
+ {$IFNDEF MSWINDOWS}
+ {$DEFINE MSWINDOWS}
+ {$ENDIF}
+{$ENDIF}
+
+{$IFDEF UNICODE}
+ {$WARN IMPLICIT_STRING_CAST OFF}
+ {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+unit httpsend;
+
+interface
+
+uses
+ SysUtils, Classes,
+ blcksock, synautil, synaip, synacode, synsock;
+
+const
+ cHttpProtocol = '80';
+
+type
+ {:These encoding types are used internally by the THTTPSend object to identify
+ the transfer data types.}
+ TTransferEncoding = (TE_UNKNOWN, TE_IDENTITY, TE_CHUNKED);
+
+ {:abstract(Implementation of HTTP protocol.)}
+ THTTPSend = class(TSynaClient)
+ protected
+ FSock: TTCPBlockSocket;
+ FTransferEncoding: TTransferEncoding;
+ FAliveHost: string;
+ FAlivePort: string;
+ FHeaders: TStringList;
+ FDocument: TMemoryStream;
+ FMimeType: string;
+ FProtocol: string;
+ FKeepAlive: Boolean;
+ FKeepAliveTimeout: integer;
+ FStatus100: Boolean;
+ FProxyHost: string;
+ FProxyPort: string;
+ FProxyUser: string;
+ FProxyPass: string;
+ FResultCode: Integer;
+ FResultString: string;
+ FUserAgent: string;
+ FCookies: TStringList;
+ FDownloadSize: integer;
+ FUploadSize: integer;
+ FRangeStart: integer;
+ FRangeEnd: integer;
+ FAddPortNumberToHost: Boolean;
+ function ReadUnknown: Boolean;
+ function ReadIdentity(Size: Integer): Boolean;
+ function ReadChunked: Boolean;
+ procedure ParseCookies;
+ function PrepareHeaders: AnsiString;
+ function InternalDoConnect(needssl: Boolean): Boolean;
+ function InternalConnect(needssl: Boolean): Boolean;
+ public
+ constructor Create;
+ destructor Destroy; override;
+
+ {:Reset headers and document and Mimetype.}
+ procedure Clear;
+
+ {:Decode ResultCode and ResultString from Value.}
+ procedure DecodeStatus(const Value: string);
+
+ {:Connects to host define in URL and access to resource defined in URL by
+ method. If Document is not empty, send it to server as part of HTTP request.
+ Server response is in Document and headers. Connection may be authorised
+ by username and password in URL. If you define proxy properties, connection
+ is made by this proxy. If all OK, result is @true, else result is @false.
+
+ If you use in URL 'https:' instead only 'http:', then your request is made
+ by SSL/TLS connection (if you not specify port, then port 443 is used
+ instead standard port 80). If you use SSL/TLS request and you have defined
+ HTTP proxy, then HTTP-tunnel mode is automaticly used .}
+ function HTTPMethod(const Method, URL: string): Boolean;
+
+ {:You can call this method from OnStatus event for break current data
+ transfer. (or from another thread.)}
+ procedure Abort;
+ published
+ {:Before HTTP operation you may define any non-standard headers for HTTP
+ request, except of: 'Expect: 100-continue', 'Content-Length', 'Content-Type',
+ 'Connection', 'Authorization', 'Proxy-Authorization' and 'Host' headers.
+ After HTTP operation contains full headers of returned document.}
+ property Headers: TStringList read FHeaders;
+
+ {:This is stringlist with name-value stringlist pairs. Each this pair is one
+ cookie. After HTTP request is returned cookies parsed to this stringlist.
+ You can leave this cookies untouched for next HTTP request. You can also
+ save this stringlist for later use.}
+ property Cookies: TStringList read FCookies;
+
+ {:Stream with document to send (before request, or with document received
+ from HTTP server (after request).}
+ property Document: TMemoryStream read FDocument;
+
+ {:If you need download only part of requested document, here specify
+ possition of subpart begin. If here 0, then is requested full document.}
+ property RangeStart: integer read FRangeStart Write FRangeStart;
+
+ {:If you need download only part of requested document, here specify
+ possition of subpart end. If here 0, then is requested document from
+ rangeStart to end of document. (for broken download restoration,
+ for example.)}
+ property RangeEnd: integer read FRangeEnd Write FRangeEnd;
+
+ {:Mime type of sending data. Default is: 'text/html'.}
+ property MimeType: string read FMimeType Write FMimeType;
+
+ {:Define protocol version. Possible values are: '1.1', '1.0' (default)
+ and '0.9'.}
+ property Protocol: string read FProtocol Write FProtocol;
+
+ {:If @true (default value), keepalives in HTTP protocol 1.1 is enabled.}
+ property KeepAlive: Boolean read FKeepAlive Write FKeepAlive;
+
+ {:Define timeout for keepalives in seconds!}
+ property KeepAliveTimeout: integer read FKeepAliveTimeout Write FKeepAliveTimeout;
+
+ {:if @true, then server is requested for 100status capability when uploading
+ data. Default is @false (off).}
+ property Status100: Boolean read FStatus100 Write FStatus100;
+
+ {:Address of proxy server (IP address or domain name) where you want to
+ connect in @link(HTTPMethod) method.}
+ property ProxyHost: string read FProxyHost Write FProxyHost;
+
+ {:Port number for proxy connection. Default value is 8080.}
+ property ProxyPort: string read FProxyPort Write FProxyPort;
+
+ {:Username for connect to proxy server where you want to connect in
+ HTTPMethod method.}
+ property ProxyUser: string read FProxyUser Write FProxyUser;
+
+ {:Password for connect to proxy server where you want to connect in
+ HTTPMethod method.}
+ property ProxyPass: string read FProxyPass Write FProxyPass;
+
+ {:Here you can specify custom User-Agent indentification. By default is
+ used: 'Mozilla/4.0 (compatible; Synapse)'}
+ property UserAgent: string read FUserAgent Write FUserAgent;
+
+ {:After successful @link(HTTPMethod) method contains result code of
+ operation.}
+ property ResultCode: Integer read FResultCode;
+
+ {:After successful @link(HTTPMethod) method contains string after result code.}
+ property ResultString: string read FResultString;
+
+ {:if this value is not 0, then data download pending. In this case you have
+ here total sice of downloaded data. It is good for draw download
+ progressbar from OnStatus event.}
+ property DownloadSize: integer read FDownloadSize;
+
+ {:if this value is not 0, then data upload pending. In this case you have
+ here total sice of uploaded data. It is good for draw upload progressbar
+ from OnStatus event.}
+ property UploadSize: integer read FUploadSize;
+ {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.}
+ property Sock: TTCPBlockSocket read FSock;
+
+ {:To have possibility to switch off port number in 'Host:' HTTP header, by
+ default @TRUE. Some buggy servers not like port informations in this header.}
+ property AddPortNumberToHost: Boolean read FAddPortNumberToHost write FAddPortNumberToHost;
+ end;
+
+{:A very usefull function, and example of use can be found in the THTTPSend
+ object. It implements the GET method of the HTTP protocol. This function sends
+ the GET method for URL document to an HTTP server. Returned document is in the
+ "Response" stringlist (without any headers). Returns boolean TRUE if all went
+ well.}
+function HttpGetText(const URL: string; const Response: TStrings): Boolean;
+
+{:A very usefull function, and example of use can be found in the THTTPSend
+ object. It implements the GET method of the HTTP protocol. This function sends
+ the GET method for URL document to an HTTP server. Returned document is in the
+ "Response" stream. Returns boolean TRUE if all went well.}
+function HttpGetBinary(const URL: string; const Response: TStream): Boolean;
+
+{:A very useful function, and example of use can be found in the THTTPSend
+ object. It implements the POST method of the HTTP protocol. This function sends
+ the SEND method for a URL document to an HTTP server. The document to be sent
+ is located in "Data" stream. The returned document is in the "Data" stream.
+ Returns boolean TRUE if all went well.}
+function HttpPostBinary(const URL: string; const Data: TStream): Boolean;
+
+{:A very useful function, and example of use can be found in the THTTPSend
+ object. It implements the POST method of the HTTP protocol. This function is
+ good for POSTing form data. It sends the POST method for a URL document to
+ an HTTP server. You must prepare the form data in the same manner as you would
+ the URL data, and pass this prepared data to "URLdata". The following is
+ a sample of how the data would appear: 'name=Lukas&field1=some%20data'.
+ The information in the field must be encoded by EncodeURLElement function.
+ The returned document is in the "Data" stream. Returns boolean TRUE if all
+ went well.}
+function HttpPostURL(const URL, URLData: string; const Data: TStream): Boolean;
+
+{:A very useful function, and example of use can be found in the THTTPSend
+ object. It implements the POST method of the HTTP protocol. This function sends
+ the POST method for a URL document to an HTTP server. This function simulate
+ posting of file by HTML form used method 'multipart/form-data'. Posting file
+ is in DATA stream. Its name is Filename string. Fieldname is for name of
+ formular field with file. (simulate HTML INPUT FILE) The returned document is
+ in the ResultData Stringlist. Returns boolean TRUE if all went well.}
+function HttpPostFile(const URL, FieldName, FileName: string;
+ const Data: TStream; const ResultData: TStrings): Boolean;
+
+implementation
+
+constructor THTTPSend.Create;
+begin
+ inherited Create;
+ FHeaders := TStringList.Create;
+ FCookies := TStringList.Create;
+ FDocument := TMemoryStream.Create;
+ FSock := TTCPBlockSocket.Create;
+ FSock.Owner := self;
+ FSock.ConvertLineEnd := True;
+ FSock.SizeRecvBuffer := c64k;
+ FSock.SizeSendBuffer := c64k;
+ FTimeout := 90000;
+ FTargetPort := cHttpProtocol;
+ FProxyHost := '';
+ FProxyPort := '8080';
+ FProxyUser := '';
+ FProxyPass := '';
+ FAliveHost := '';
+ FAlivePort := '';
+ FProtocol := '1.0';
+ FKeepAlive := True;
+ FStatus100 := False;
+ FUserAgent := 'Mozilla/4.0 (compatible; Synapse)';
+ FDownloadSize := 0;
+ FUploadSize := 0;
+ FAddPortNumberToHost := true;
+ FKeepAliveTimeout := 300;
+ Clear;
+end;
+
+destructor THTTPSend.Destroy;
+begin
+ FSock.Free;
+ FDocument.Free;
+ FCookies.Free;
+ FHeaders.Free;
+ inherited Destroy;
+end;
+
+procedure THTTPSend.Clear;
+begin
+ FRangeStart := 0;
+ FRangeEnd := 0;
+ FDocument.Clear;
+ FHeaders.Clear;
+ FMimeType := 'text/html';
+end;
+
+procedure THTTPSend.DecodeStatus(const Value: string);
+var
+ s, su: string;
+begin
+ s := Trim(SeparateRight(Value, ' '));
+ su := Trim(SeparateLeft(s, ' '));
+ FResultCode := StrToIntDef(su, 0);
+ FResultString := Trim(SeparateRight(s, ' '));
+ if FResultString = s then
+ FResultString := '';
+end;
+
+function THTTPSend.PrepareHeaders: AnsiString;
+begin
+ if FProtocol = '0.9' then
+ Result := FHeaders[0] + CRLF
+ else
+{$IFNDEF MSWINDOWS}
+ Result := {$IFDEF UNICODE}AnsiString{$ENDIF}(AdjustLineBreaks(FHeaders.Text, tlbsCRLF));
+{$ELSE}
+ Result := FHeaders.Text;
+{$ENDIF}
+end;
+
+function THTTPSend.InternalDoConnect(needssl: Boolean): Boolean;
+begin
+ Result := False;
+ FSock.CloseSocket;
+ FSock.Bind(FIPInterface, cAnyPort);
+ if FSock.LastError <> 0 then
+ Exit;
+ FSock.Connect(FTargetHost, FTargetPort);
+ if FSock.LastError <> 0 then
+ Exit;
+ if needssl then
+ begin
+ if (FSock.SSL.SNIHost='') then
+ FSock.SSL.SNIHost:=FTargetHost;
+ FSock.SSLDoConnect;
+ FSock.SSL.SNIHost:=''; //don't need it anymore and don't wan't to reuse it in next connection
+ if FSock.LastError <> 0 then
+ Exit;
+ end;
+ FAliveHost := FTargetHost;
+ FAlivePort := FTargetPort;
+ Result := True;
+end;
+
+function THTTPSend.InternalConnect(needssl: Boolean): Boolean;
+begin
+ if FSock.Socket = INVALID_SOCKET then
+ Result := InternalDoConnect(needssl)
+ else
+ if (FAliveHost <> FTargetHost) or (FAlivePort <> FTargetPort)
+ or FSock.CanRead(0) then
+ Result := InternalDoConnect(needssl)
+ else
+ Result := True;
+end;
+
+function THTTPSend.HTTPMethod(const Method, URL: string): Boolean;
+var
+ Sending, Receiving: Boolean;
+ status100: Boolean;
+ status100error: string;
+ ToClose: Boolean;
+ Size: Integer;
+ Prot, User, Pass, Host, Port, Path, Para, URI: string;
+ s, su: AnsiString;
+ HttpTunnel: Boolean;
+ n: integer;
+ pp: string;
+ UsingProxy: boolean;
+ l: TStringList;
+ x: integer;
+begin
+ {initial values}
+ Result := False;
+ FResultCode := 500;
+ FResultString := '';
+ FDownloadSize := 0;
+ FUploadSize := 0;
+
+ URI := ParseURL(URL, Prot, User, Pass, Host, Port, Path, Para);
+ User := DecodeURL(user);
+ Pass := DecodeURL(pass);
+ if User = '' then
+ begin
+ User := FUsername;
+ Pass := FPassword;
+ end;
+ if UpperCase(Prot) = 'HTTPS' then
+ begin
+ HttpTunnel := FProxyHost <> '';
+ FSock.HTTPTunnelIP := FProxyHost;
+ FSock.HTTPTunnelPort := FProxyPort;
+ FSock.HTTPTunnelUser := FProxyUser;
+ FSock.HTTPTunnelPass := FProxyPass;
+ end
+ else
+ begin
+ HttpTunnel := False;
+ FSock.HTTPTunnelIP := '';
+ FSock.HTTPTunnelPort := '';
+ FSock.HTTPTunnelUser := '';
+ FSock.HTTPTunnelPass := '';
+ end;
+ UsingProxy := (FProxyHost <> '') and not(HttpTunnel);
+ Sending := FDocument.Size > 0;
+ {Headers for Sending data}
+ status100 := FStatus100 and Sending and (FProtocol = '1.1');
+ if status100 then
+ FHeaders.Insert(0, 'Expect: 100-continue');
+ if Sending then
+ begin
+ FHeaders.Insert(0, 'Content-Length: ' + IntToStr(FDocument.Size));
+ if FMimeType <> '' then
+ FHeaders.Insert(0, 'Content-Type: ' + FMimeType);
+ end;
+ { setting User-agent }
+ if FUserAgent <> '' then
+ FHeaders.Insert(0, 'User-Agent: ' + FUserAgent);
+ { setting Ranges }
+ if (FRangeStart > 0) or (FRangeEnd > 0) then
+ begin
+ if FRangeEnd >= FRangeStart then
+ FHeaders.Insert(0, 'Range: bytes=' + IntToStr(FRangeStart) + '-' + IntToStr(FRangeEnd))
+ else
+ FHeaders.Insert(0, 'Range: bytes=' + IntToStr(FRangeStart) + '-');
+ end;
+ { setting Cookies }
+ s := '';
+ for n := 0 to FCookies.Count - 1 do
+ begin
+ if s <> '' then
+ s := s + '; ';
+ s := s + FCookies[n];
+ end;
+ if s <> '' then
+ FHeaders.Insert(0, 'Cookie: ' + s);
+ { setting KeepAlives }
+ pp := '';
+ if UsingProxy then
+ pp := 'Proxy-';
+ if FKeepAlive then
+ begin
+ FHeaders.Insert(0, pp + 'Connection: keep-alive');
+ FHeaders.Insert(0, 'Keep-Alive: ' + IntToStr(FKeepAliveTimeout));
+ end
+ else
+ FHeaders.Insert(0, pp + 'Connection: close');
+ { set target servers/proxy, authorizations, etc... }
+ if User <> '' then
+ FHeaders.Insert(0, 'Authorization: Basic ' + EncodeBase64(User + ':' + Pass));
+ if UsingProxy and (FProxyUser <> '') then
+ FHeaders.Insert(0, 'Proxy-Authorization: Basic ' +
+ EncodeBase64(FProxyUser + ':' + FProxyPass));
+ if isIP6(Host) then
+ s := '[' + Host + ']'
+ else
+ s := Host;
+ if FAddPortNumberToHost and (Port <> '80') then
+ FHeaders.Insert(0, 'Host: ' + s + ':' + Port)
+ else
+ FHeaders.Insert(0, 'Host: ' + s);
+ if UsingProxy then
+ URI := Prot + '://' + s + ':' + Port + URI;
+ if URI = '/*' then
+ URI := '*';
+ if FProtocol = '0.9' then
+ FHeaders.Insert(0, UpperCase(Method) + ' ' + URI)
+ else
+ FHeaders.Insert(0, UpperCase(Method) + ' ' + URI + ' HTTP/' + FProtocol);
+ if UsingProxy then
+ begin
+ FTargetHost := FProxyHost;
+ FTargetPort := FProxyPort;
+ end
+ else
+ begin
+ FTargetHost := Host;
+ FTargetPort := Port;
+ end;
+ if FHeaders[FHeaders.Count - 1] <> '' then
+ FHeaders.Add('');
+
+ { connect }
+ if not InternalConnect(UpperCase(Prot) = 'HTTPS') then
+ begin
+ FAliveHost := '';
+ FAlivePort := '';
+ Exit;
+ end;
+
+ { reading Status }
+ FDocument.Position := 0;
+ Status100Error := '';
+ if status100 then
+ begin
+ { send Headers }
+ FSock.SendString(PrepareHeaders);
+ if FSock.LastError <> 0 then
+ Exit;
+ repeat
+ s := FSock.RecvString(FTimeout);
+ if s <> '' then
+ Break;
+ until FSock.LastError <> 0;
+ DecodeStatus(s);
+ Status100Error := s;
+ repeat
+ s := FSock.recvstring(FTimeout);
+ if s = '' then
+ Break;
+ until FSock.LastError <> 0;
+ if (FResultCode >= 100) and (FResultCode < 200) then
+ begin
+ { we can upload content }
+ Status100Error := '';
+ FUploadSize := FDocument.Size;
+ FSock.SendBuffer(FDocument.Memory, FDocument.Size);
+ end;
+ end
+ else
+ { upload content }
+ if sending then
+ begin
+ if FDocument.Size >= c64k then
+ begin
+ FSock.SendString(PrepareHeaders);
+ FUploadSize := FDocument.Size;
+ FSock.SendBuffer(FDocument.Memory, FDocument.Size);
+ end
+ else
+ begin
+ s := PrepareHeaders + ReadStrFromStream(FDocument, FDocument.Size);
+ FUploadSize := Length(s);
+ FSock.SendString(s);
+ end;
+ end
+ else
+ begin
+ { we not need to upload document, send headers only }
+ FSock.SendString(PrepareHeaders);
+ end;
+
+ if FSock.LastError <> 0 then
+ Exit;
+
+ Clear;
+ Size := -1;
+ FTransferEncoding := TE_UNKNOWN;
+
+ { read status }
+ if Status100Error = '' then
+ begin
+ repeat
+ repeat
+ s := FSock.RecvString(FTimeout);
+ if s <> '' then
+ Break;
+ until FSock.LastError <> 0;
+ if Pos('HTTP/', UpperCase(s)) = 1 then
+ begin
+ FHeaders.Add(s);
+ DecodeStatus(s);
+ end
+ else
+ begin
+ { old HTTP 0.9 and some buggy servers not send result }
+ s := s + CRLF;
+ WriteStrToStream(FDocument, s);
+ FResultCode := 0;
+ end;
+ until (FSock.LastError <> 0) or (FResultCode <> 100);
+ end
+ else
+ FHeaders.Add(Status100Error);
+
+ { if need receive headers, receive and parse it }
+ ToClose := FProtocol <> '1.1';
+ if FHeaders.Count > 0 then
+ begin
+ l := TStringList.Create;
+ try
+ repeat
+ s := FSock.RecvString(FTimeout);
+ l.Add(s);
+ if s = '' then
+ Break;
+ until FSock.LastError <> 0;
+ x := 0;
+ while l.Count > x do
+ begin
+ s := NormalizeHeader(l, x);
+ FHeaders.Add(s);
+ su := UpperCase(s);
+ if Pos('CONTENT-LENGTH:', su) = 1 then
+ begin
+ Size := StrToIntDef(Trim(SeparateRight(s, ' ')), -1);
+ if (Size <> -1) and (FTransferEncoding = TE_UNKNOWN) then
+ FTransferEncoding := TE_IDENTITY;
+ end;
+ if Pos('CONTENT-TYPE:', su) = 1 then
+ FMimeType := Trim(SeparateRight(s, ' '));
+ if Pos('TRANSFER-ENCODING:', su) = 1 then
+ begin
+ s := Trim(SeparateRight(su, ' '));
+ if Pos('CHUNKED', s) > 0 then
+ FTransferEncoding := TE_CHUNKED;
+ end;
+ if UsingProxy then
+ begin
+ if Pos('PROXY-CONNECTION:', su) = 1 then
+ if Pos('CLOSE', su) > 0 then
+ ToClose := True;
+ end
+ else
+ begin
+ if Pos('CONNECTION:', su) = 1 then
+ if Pos('CLOSE', su) > 0 then
+ ToClose := True;
+ end;
+ end;
+ finally
+ l.free;
+ end;
+ end;
+
+ Result := FSock.LastError = 0;
+ if not Result then
+ Exit;
+
+ {if need receive response body, read it}
+ Receiving := Method <> 'HEAD';
+ Receiving := Receiving and (FResultCode <> 204);
+ Receiving := Receiving and (FResultCode <> 304);
+ if Receiving then
+ case FTransferEncoding of
+ TE_UNKNOWN:
+ Result := ReadUnknown;
+ TE_IDENTITY:
+ Result := ReadIdentity(Size);
+ TE_CHUNKED:
+ Result := ReadChunked;
+ end;
+
+ FDocument.Seek(0, soFromBeginning);
+ if ToClose then
+ begin
+ FSock.CloseSocket;
+ FAliveHost := '';
+ FAlivePort := '';
+ end;
+ ParseCookies;
+end;
+
+function THTTPSend.ReadUnknown: Boolean;
+var
+ s: ansistring;
+begin
+ Result := false;
+ repeat
+ s := FSock.RecvPacket(FTimeout);
+ if FSock.LastError = 0 then
+ WriteStrToStream(FDocument, s);
+ until FSock.LastError <> 0;
+ if FSock.LastError = WSAECONNRESET then
+ begin
+ Result := true;
+ FSock.ResetLastError;
+ end;
+end;
+
+function THTTPSend.ReadIdentity(Size: Integer): Boolean;
+begin
+ if Size > 0 then
+ begin
+ FDownloadSize := Size;
+ FSock.RecvStreamSize(FDocument, FTimeout, Size);
+ FDocument.Position := FDocument.Size;
+ Result := FSock.LastError = 0;
+ end
+ else
+ Result := true;
+end;
+
+function THTTPSend.ReadChunked: Boolean;
+var
+ s: ansistring;
+ Size: Integer;
+begin
+ repeat
+ repeat
+ s := FSock.RecvString(FTimeout);
+ until (s <> '') or (FSock.LastError <> 0);
+ if FSock.LastError <> 0 then
+ Break;
+ s := Trim(SeparateLeft(s, ' '));
+ s := Trim(SeparateLeft(s, ';'));
+ Size := StrToIntDef('$' + s, 0);
+ if Size = 0 then
+ Break;
+ if not ReadIdentity(Size) then
+ break;
+ until False;
+ Result := FSock.LastError = 0;
+end;
+
+procedure THTTPSend.ParseCookies;
+var
+ n: integer;
+ s: string;
+ sn, sv: string;
+begin
+ for n := 0 to FHeaders.Count - 1 do
+ if Pos('set-cookie:', lowercase(FHeaders[n])) = 1 then
+ begin
+ s := SeparateRight(FHeaders[n], ':');
+ s := trim(SeparateLeft(s, ';'));
+ sn := trim(SeparateLeft(s, '='));
+ sv := trim(SeparateRight(s, '='));
+ FCookies.Values[sn] := sv;
+ end;
+end;
+
+procedure THTTPSend.Abort;
+begin
+ FSock.StopFlag := True;
+end;
+
+{==============================================================================}
+
+function HttpGetText(const URL: string; const Response: TStrings): Boolean;
+var
+ HTTP: THTTPSend;
+begin
+ HTTP := THTTPSend.Create;
+ try
+ Result := HTTP.HTTPMethod('GET', URL);
+ if Result then
+ Response.LoadFromStream(HTTP.Document);
+ finally
+ HTTP.Free;
+ end;
+end;
+
+function HttpGetBinary(const URL: string; const Response: TStream): Boolean;
+var
+ HTTP: THTTPSend;
+begin
+ HTTP := THTTPSend.Create;
+ try
+ Result := HTTP.HTTPMethod('GET', URL);
+ if Result then
+ begin
+ Response.Seek(0, soFromBeginning);
+ Response.CopyFrom(HTTP.Document, 0);
+ end;
+ finally
+ HTTP.Free;
+ end;
+end;
+
+function HttpPostBinary(const URL: string; const Data: TStream): Boolean;
+var
+ HTTP: THTTPSend;
+begin
+ HTTP := THTTPSend.Create;
+ try
+ HTTP.Document.CopyFrom(Data, 0);
+ HTTP.MimeType := 'Application/octet-stream';
+ Result := HTTP.HTTPMethod('POST', URL);
+ Data.Size := 0;
+ if Result then
+ begin
+ Data.Seek(0, soFromBeginning);
+ Data.CopyFrom(HTTP.Document, 0);
+ end;
+ finally
+ HTTP.Free;
+ end;
+end;
+
+function HttpPostURL(const URL, URLData: string; const Data: TStream): Boolean;
+var
+ HTTP: THTTPSend;
+begin
+ HTTP := THTTPSend.Create;
+ try
+ WriteStrToStream(HTTP.Document, URLData);
+ HTTP.MimeType := 'application/x-www-form-urlencoded';
+ Result := HTTP.HTTPMethod('POST', URL);
+ if Result then
+ Data.CopyFrom(HTTP.Document, 0);
+ finally
+ HTTP.Free;
+ end;
+end;
+
+function HttpPostFile(const URL, FieldName, FileName: string;
+ const Data: TStream; const ResultData: TStrings): Boolean;
+var
+ HTTP: THTTPSend;
+ Bound, s: string;
+begin
+ Bound := IntToHex(Random(MaxInt), 8) + '_Synapse_boundary';
+ HTTP := THTTPSend.Create;
+ try
+ s := '--' + Bound + CRLF;
+ s := s + 'content-disposition: form-data; name="' + FieldName + '";';
+ s := s + ' filename="' + FileName +'"' + CRLF;
+ s := s + 'Content-Type: Application/octet-string' + CRLF + CRLF;
+ WriteStrToStream(HTTP.Document, s);
+ HTTP.Document.CopyFrom(Data, 0);
+ s := CRLF + '--' + Bound + '--' + CRLF;
+ WriteStrToStream(HTTP.Document, s);
+ HTTP.MimeType := 'multipart/form-data; boundary=' + Bound;
+ Result := HTTP.HTTPMethod('POST', URL);
+ if Result then
+ ResultData.LoadFromStream(HTTP.Document);
+ finally
+ HTTP.Free;
+ end;
+end;
+
+end.
ADDED lib/synapse/source/lib/imapsend.pas
Index: lib/synapse/source/lib/imapsend.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/lib/imapsend.pas
@@ -0,0 +1,869 @@
+{==============================================================================|
+| Project : Ararat Synapse | 002.005.003 |
+|==============================================================================|
+| Content: IMAP4rev1 client |
+|==============================================================================|
+| Copyright (c)1999-2012, Lukas Gebauer |
+| All rights reserved. |
+| |
+| Redistribution and use in source and binary forms, with or without |
+| modification, are permitted provided that the following conditions are met: |
+| |
+| Redistributions of source code must retain the above copyright notice, this |
+| list of conditions and the following disclaimer. |
+| |
+| Redistributions in binary form must reproduce the above copyright notice, |
+| this list of conditions and the following disclaimer in the documentation |
+| and/or other materials provided with the distribution. |
+| |
+| Neither the name of Lukas Gebauer nor the names of its contributors may |
+| be used to endorse or promote products derived from this software without |
+| specific prior written permission. |
+| |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
+| DAMAGE. |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2001-2012. |
+| All Rights Reserved. |
+|==============================================================================|
+| Contributor(s): |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package |
+| (Found at URL: http://www.ararat.cz/synapse/) |
+|==============================================================================}
+
+{:@abstract(IMAP4 rev1 protocol client)
+
+Used RFC: RFC-2060, RFC-2595
+}
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+
+{$IFDEF UNICODE}
+ {$WARN IMPLICIT_STRING_CAST OFF}
+ {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+unit imapsend;
+
+interface
+
+uses
+ SysUtils, Classes,
+ blcksock, synautil;
+
+const
+ cIMAPProtocol = '143';
+
+type
+ {:@abstract(Implementation of IMAP4 protocol.)
+ Note: Are you missing properties for setting Username and Password? Look to
+ parent @link(TSynaClient) object!
+
+ Are you missing properties for specify server address and port? Look to
+ parent @link(TSynaClient) too!}
+ TIMAPSend = class(TSynaClient)
+ protected
+ FSock: TTCPBlockSocket;
+ FTagCommand: integer;
+ FResultString: string;
+ FFullResult: TStringList;
+ FIMAPcap: TStringList;
+ FAuthDone: Boolean;
+ FSelectedFolder: string;
+ FSelectedCount: integer;
+ FSelectedRecent: integer;
+ FSelectedUIDvalidity: integer;
+ FUID: Boolean;
+ FAutoTLS: Boolean;
+ FFullSSL: Boolean;
+ function ReadResult: string;
+ function AuthLogin: Boolean;
+ function Connect: Boolean;
+ procedure ParseMess(Value:TStrings);
+ procedure ParseFolderList(Value:TStrings);
+ procedure ParseSelect;
+ procedure ParseSearch(Value:TStrings);
+ procedure ProcessLiterals;
+ public
+ constructor Create;
+ destructor Destroy; override;
+
+ {:By this function you can call any IMAP command. Result of this command is
+ in adequate properties.}
+ function IMAPcommand(Value: string): string;
+
+ {:By this function you can call any IMAP command what need upload any data.
+ Result of this command is in adequate properties.}
+ function IMAPuploadCommand(Value: string; const Data:TStrings): string;
+
+ {:Call CAPABILITY command and fill IMAPcap property by new values.}
+ function Capability: Boolean;
+
+ {:Connect to IMAP server and do login to this server. This command begin
+ session.}
+ function Login: Boolean;
+
+ {:Disconnect from IMAP server and terminate session session. If exists some
+ deleted and non-purged messages, these messages are not deleted!}
+ function Logout: Boolean;
+
+ {:Do NOOP. It is for prevent disconnect by timeout.}
+ function NoOp: Boolean;
+
+ {:Lists folder names. You may specify level of listing. If you specify
+ FromFolder as empty string, return is all folders in system.}
+ function List(FromFolder: string; const FolderList: TStrings): Boolean;
+
+ {:Lists folder names what match search criteria. You may specify level of
+ listing. If you specify FromFolder as empty string, return is all folders
+ in system.}
+ function ListSearch(FromFolder, Search: string; const FolderList: TStrings): Boolean;
+
+ {:Lists subscribed folder names. You may specify level of listing. If you
+ specify FromFolder as empty string, return is all subscribed folders in
+ system.}
+ function ListSubscribed(FromFolder: string; const FolderList: TStrings): Boolean;
+
+ {:Lists subscribed folder names what matching search criteria. You may
+ specify level of listing. If you specify FromFolder as empty string, return
+ is all subscribed folders in system.}
+ function ListSearchSubscribed(FromFolder, Search: string; const FolderList: TStrings): Boolean;
+
+ {:Create a new folder.}
+ function CreateFolder(FolderName: string): Boolean;
+
+ {:Delete a folder.}
+ function DeleteFolder(FolderName: string): Boolean;
+
+ {:Rename folder names.}
+ function RenameFolder(FolderName, NewFolderName: string): Boolean;
+
+ {:Subscribe folder.}
+ function SubscribeFolder(FolderName: string): Boolean;
+
+ {:Unsubscribe folder.}
+ function UnsubscribeFolder(FolderName: string): Boolean;
+
+ {:Select folder.}
+ function SelectFolder(FolderName: string): Boolean;
+
+ {:Select folder, but only for reading. Any changes are not allowed!}
+ function SelectROFolder(FolderName: string): Boolean;
+
+ {:Close a folder. (end of Selected state)}
+ function CloseFolder: Boolean;
+
+ {:Ask for given status of folder. I.e. if you specify as value 'UNSEEN',
+ result is number of unseen messages in folder. For another status
+ indentificator check IMAP documentation and documentation of your IMAP
+ server (each IMAP server can have their own statuses.)}
+ function StatusFolder(FolderName, Value: string): integer;
+
+ {:Hardly delete all messages marked as 'deleted' in current selected folder.}
+ function ExpungeFolder: Boolean;
+
+ {:Touch to folder. (use as update status of folder, etc.)}
+ function CheckFolder: Boolean;
+
+ {:Append given message to specified folder.}
+ function AppendMess(ToFolder: string; const Mess: TStrings): Boolean;
+
+ {:'Delete' message from current selected folder. It mark message as Deleted.
+ Real deleting will be done after sucessfull @link(CloseFolder) or
+ @link(ExpungeFolder)}
+ function DeleteMess(MessID: integer): boolean;
+
+ {:Get full message from specified message in selected folder.}
+ function FetchMess(MessID: integer; const Mess: TStrings): Boolean;
+
+ {:Get message headers only from specified message in selected folder.}
+ function FetchHeader(MessID: integer; const Headers: TStrings): Boolean;
+
+ {:Return message size of specified message from current selected folder.}
+ function MessageSize(MessID: integer): integer;
+
+ {:Copy message from current selected folder to another folder.}
+ function CopyMess(MessID: integer; ToFolder: string): Boolean;
+
+ {:Return message numbers from currently selected folder as result
+ of searching. Search criteria is very complex language (see to IMAP
+ specification) similar to SQL (but not same syntax!).}
+ function SearchMess(Criteria: string; const FoundMess: TStrings): Boolean;
+
+ {:Sets flags of message from current selected folder.}
+ function SetFlagsMess(MessID: integer; Flags: string): Boolean;
+
+ {:Gets flags of message from current selected folder.}
+ function GetFlagsMess(MessID: integer; var Flags: string): Boolean;
+
+ {:Add flags to message's flags.}
+ function AddFlagsMess(MessID: integer; Flags: string): Boolean;
+
+ {:Remove flags from message's flags.}
+ function DelFlagsMess(MessID: integer; Flags: string): Boolean;
+
+ {:Call STARTTLS command for upgrade connection to SSL/TLS mode.}
+ function StartTLS: Boolean;
+
+ {:return UID of requested message ID.}
+ function GetUID(MessID: integer; var UID : Integer): Boolean;
+
+ {:Try to find given capabily in capabilty string returned from IMAP server.}
+ function FindCap(const Value: string): string;
+ published
+ {:Status line with result of last operation.}
+ property ResultString: string read FResultString;
+
+ {:Full result of last IMAP operation.}
+ property FullResult: TStringList read FFullResult;
+
+ {:List of server capabilites.}
+ property IMAPcap: TStringList read FIMAPcap;
+
+ {:Authorization is successful done.}
+ property AuthDone: Boolean read FAuthDone;
+
+ {:Turn on or off usage of UID (unicate identificator) of messages instead
+ only sequence numbers.}
+ property UID: Boolean read FUID Write FUID;
+
+ {:Name of currently selected folder.}
+ property SelectedFolder: string read FSelectedFolder;
+
+ {:Count of messages in currently selected folder.}
+ property SelectedCount: integer read FSelectedCount;
+
+ {:Count of not-visited messages in currently selected folder.}
+ property SelectedRecent: integer read FSelectedRecent;
+
+ {:This number with name of folder is unique indentificator of folder.
+ (If someone delete folder and next create new folder with exactly same name
+ of folder, this number is must be different!)}
+ property SelectedUIDvalidity: integer read FSelectedUIDvalidity;
+
+ {:If is set to true, then upgrade to SSL/TLS mode if remote server support it.}
+ property AutoTLS: Boolean read FAutoTLS Write FAutoTLS;
+
+ {:SSL/TLS mode is used from first contact to server. Servers with full
+ SSL/TLS mode usualy using non-standard TCP port!}
+ property FullSSL: Boolean read FFullSSL Write FFullSSL;
+
+ {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.}
+ property Sock: TTCPBlockSocket read FSock;
+ end;
+
+implementation
+
+constructor TIMAPSend.Create;
+begin
+ inherited Create;
+ FFullResult := TStringList.Create;
+ FIMAPcap := TStringList.Create;
+ FSock := TTCPBlockSocket.Create;
+ FSock.Owner := self;
+ FSock.ConvertLineEnd := True;
+ FSock.SizeRecvBuffer := 32768;
+ FSock.SizeSendBuffer := 32768;
+ FTimeout := 60000;
+ FTargetPort := cIMAPProtocol;
+ FTagCommand := 0;
+ FSelectedFolder := '';
+ FSelectedCount := 0;
+ FSelectedRecent := 0;
+ FSelectedUIDvalidity := 0;
+ FUID := False;
+ FAutoTLS := False;
+ FFullSSL := False;
+end;
+
+destructor TIMAPSend.Destroy;
+begin
+ FSock.Free;
+ FIMAPcap.Free;
+ FFullResult.Free;
+ inherited Destroy;
+end;
+
+
+function TIMAPSend.ReadResult: string;
+var
+ s: string;
+ x, l: integer;
+begin
+ Result := '';
+ FFullResult.Clear;
+ FResultString := '';
+ repeat
+ s := FSock.RecvString(FTimeout);
+ if Pos('S' + IntToStr(FTagCommand) + ' ', s) = 1 then
+ begin
+ FResultString := s;
+ break;
+ end
+ else
+ FFullResult.Add(s);
+ if (s <> '') and (s[Length(s)]='}') then
+ begin
+ s := Copy(s, 1, Length(s) - 1);
+ x := RPos('{', s);
+ s := Copy(s, x + 1, Length(s) - x);
+ l := StrToIntDef(s, -1);
+ if l <> -1 then
+ begin
+ s := FSock.RecvBufferStr(l, FTimeout);
+ FFullResult.Add(s);
+ end;
+ end;
+ until FSock.LastError <> 0;
+ s := Trim(separateright(FResultString, ' '));
+ Result:=uppercase(Trim(separateleft(s, ' ')));
+end;
+
+procedure TIMAPSend.ProcessLiterals;
+var
+ l: TStringList;
+ n, x: integer;
+ b: integer;
+ s: string;
+begin
+ l := TStringList.Create;
+ try
+ l.Assign(FFullResult);
+ FFullResult.Clear;
+ b := 0;
+ for n := 0 to l.Count - 1 do
+ begin
+ s := l[n];
+ if b > 0 then
+ begin
+ FFullResult[FFullresult.Count - 1] :=
+ FFullResult[FFullresult.Count - 1] + s;
+ inc(b);
+ if b > 2 then
+ b := 0;
+ end
+ else
+ begin
+ if (s <> '') and (s[Length(s)]='}') then
+ begin
+ x := RPos('{', s);
+ Delete(s, x, Length(s) - x + 1);
+ b := 1;
+ end
+ else
+ b := 0;
+ FFullResult.Add(s);
+ end;
+ end;
+ finally
+ l.Free;
+ end;
+end;
+
+function TIMAPSend.IMAPcommand(Value: string): string;
+begin
+ Inc(FTagCommand);
+ FSock.SendString('S' + IntToStr(FTagCommand) + ' ' + Value + CRLF);
+ Result := ReadResult;
+end;
+
+function TIMAPSend.IMAPuploadCommand(Value: string; const Data:TStrings): string;
+var
+ l: integer;
+begin
+ Inc(FTagCommand);
+ l := Length(Data.Text);
+ FSock.SendString('S' + IntToStr(FTagCommand) + ' ' + Value + ' {'+ IntToStr(l) + '}' + CRLF);
+ FSock.RecvString(FTimeout);
+ FSock.SendString(Data.Text + CRLF);
+ Result := ReadResult;
+end;
+
+procedure TIMAPSend.ParseMess(Value:TStrings);
+var
+ n: integer;
+begin
+ Value.Clear;
+ for n := 0 to FFullResult.Count - 2 do
+ if (length(FFullResult[n]) > 0) and (FFullResult[n][Length(FFullResult[n])] = '}') then
+ begin
+ Value.Text := FFullResult[n + 1];
+ Break;
+ end;
+end;
+
+procedure TIMAPSend.ParseFolderList(Value:TStrings);
+var
+ n, x: integer;
+ s: string;
+begin
+ ProcessLiterals;
+ Value.Clear;
+ for n := 0 to FFullResult.Count - 1 do
+ begin
+ s := FFullResult[n];
+ if (s <> '') and (Pos('\NOSELECT', UpperCase(s)) = 0) then
+ begin
+ if s[Length(s)] = '"' then
+ begin
+ Delete(s, Length(s), 1);
+ x := RPos('"', s);
+ end
+ else
+ x := RPos(' ', s);
+ if (x > 0) then
+ Value.Add(Copy(s, x + 1, Length(s) - x));
+ end;
+ end;
+end;
+
+procedure TIMAPSend.ParseSelect;
+var
+ n: integer;
+ s, t: string;
+begin
+ ProcessLiterals;
+ FSelectedCount := 0;
+ FSelectedRecent := 0;
+ FSelectedUIDvalidity := 0;
+ for n := 0 to FFullResult.Count - 1 do
+ begin
+ s := uppercase(FFullResult[n]);
+ if Pos(' EXISTS', s) > 0 then
+ begin
+ t := Trim(separateleft(s, ' EXISTS'));
+ t := Trim(separateright(t, '* '));
+ FSelectedCount := StrToIntDef(t, 0);
+ end;
+ if Pos(' RECENT', s) > 0 then
+ begin
+ t := Trim(separateleft(s, ' RECENT'));
+ t := Trim(separateright(t, '* '));
+ FSelectedRecent := StrToIntDef(t, 0);
+ end;
+ if Pos('UIDVALIDITY', s) > 0 then
+ begin
+ t := Trim(separateright(s, 'UIDVALIDITY '));
+ t := Trim(separateleft(t, ']'));
+ FSelectedUIDvalidity := StrToIntDef(t, 0);
+ end;
+ end;
+end;
+
+procedure TIMAPSend.ParseSearch(Value:TStrings);
+var
+ n: integer;
+ s: string;
+begin
+ ProcessLiterals;
+ Value.Clear;
+ for n := 0 to FFullResult.Count - 1 do
+ begin
+ s := uppercase(FFullResult[n]);
+ if Pos('* SEARCH', s) = 1 then
+ begin
+ s := Trim(SeparateRight(s, '* SEARCH'));
+ while s <> '' do
+ Value.Add(Fetch(s, ' '));
+ end;
+ end;
+end;
+
+function TIMAPSend.FindCap(const Value: string): string;
+var
+ n: Integer;
+ s: string;
+begin
+ s := UpperCase(Value);
+ Result := '';
+ for n := 0 to FIMAPcap.Count - 1 do
+ if Pos(s, UpperCase(FIMAPcap[n])) = 1 then
+ begin
+ Result := FIMAPcap[n];
+ Break;
+ end;
+end;
+
+function TIMAPSend.AuthLogin: Boolean;
+begin
+ Result := IMAPcommand('LOGIN "' + FUsername + '" "' + FPassword + '"') = 'OK';
+end;
+
+function TIMAPSend.Connect: Boolean;
+begin
+ FSock.CloseSocket;
+ FSock.Bind(FIPInterface, cAnyPort);
+ if FSock.LastError = 0 then
+ FSock.Connect(FTargetHost, FTargetPort);
+ if FSock.LastError = 0 then
+ if FFullSSL then
+ FSock.SSLDoConnect;
+ Result := FSock.LastError = 0;
+end;
+
+function TIMAPSend.Capability: Boolean;
+var
+ n: Integer;
+ s, t: string;
+begin
+ Result := False;
+ FIMAPcap.Clear;
+ s := IMAPcommand('CAPABILITY');
+ if s = 'OK' then
+ begin
+ ProcessLiterals;
+ for n := 0 to FFullResult.Count - 1 do
+ if Pos('* CAPABILITY ', FFullResult[n]) = 1 then
+ begin
+ s := Trim(SeparateRight(FFullResult[n], '* CAPABILITY '));
+ while not (s = '') do
+ begin
+ t := Trim(separateleft(s, ' '));
+ s := Trim(separateright(s, ' '));
+ if s = t then
+ s := '';
+ FIMAPcap.Add(t);
+ end;
+ end;
+ Result := True;
+ end;
+end;
+
+function TIMAPSend.Login: Boolean;
+var
+ s: string;
+begin
+ FSelectedFolder := '';
+ FSelectedCount := 0;
+ FSelectedRecent := 0;
+ FSelectedUIDvalidity := 0;
+ Result := False;
+ FAuthDone := False;
+ if not Connect then
+ Exit;
+ s := FSock.RecvString(FTimeout);
+ if Pos('* PREAUTH', s) = 1 then
+ FAuthDone := True
+ else
+ if Pos('* OK', s) = 1 then
+ FAuthDone := False
+ else
+ Exit;
+ if Capability then
+ begin
+ if Findcap('IMAP4rev1') = '' then
+ Exit;
+ if FAutoTLS and (Findcap('STARTTLS') <> '') then
+ if StartTLS then
+ Capability;
+ end;
+ Result := AuthLogin;
+end;
+
+function TIMAPSend.Logout: Boolean;
+begin
+ Result := IMAPcommand('LOGOUT') = 'OK';
+ FSelectedFolder := '';
+ FSock.CloseSocket;
+end;
+
+function TIMAPSend.NoOp: Boolean;
+begin
+ Result := IMAPcommand('NOOP') = 'OK';
+end;
+
+function TIMAPSend.List(FromFolder: string; const FolderList: TStrings): Boolean;
+begin
+ Result := IMAPcommand('LIST "' + FromFolder + '" *') = 'OK';
+ ParseFolderList(FolderList);
+end;
+
+function TIMAPSend.ListSearch(FromFolder, Search: string; const FolderList: TStrings): Boolean;
+begin
+ Result := IMAPcommand('LIST "' + FromFolder + '" "' + Search +'"') = 'OK';
+ ParseFolderList(FolderList);
+end;
+
+function TIMAPSend.ListSubscribed(FromFolder: string; const FolderList: TStrings): Boolean;
+begin
+ Result := IMAPcommand('LSUB "' + FromFolder + '" *') = 'OK';
+ ParseFolderList(FolderList);
+end;
+
+function TIMAPSend.ListSearchSubscribed(FromFolder, Search: string; const FolderList: TStrings): Boolean;
+begin
+ Result := IMAPcommand('LSUB "' + FromFolder + '" "' + Search +'"') = 'OK';
+ ParseFolderList(FolderList);
+end;
+
+function TIMAPSend.CreateFolder(FolderName: string): Boolean;
+begin
+ Result := IMAPcommand('CREATE "' + FolderName + '"') = 'OK';
+end;
+
+function TIMAPSend.DeleteFolder(FolderName: string): Boolean;
+begin
+ Result := IMAPcommand('DELETE "' + FolderName + '"') = 'OK';
+end;
+
+function TIMAPSend.RenameFolder(FolderName, NewFolderName: string): Boolean;
+begin
+ Result := IMAPcommand('RENAME "' + FolderName + '" "' + NewFolderName + '"') = 'OK';
+end;
+
+function TIMAPSend.SubscribeFolder(FolderName: string): Boolean;
+begin
+ Result := IMAPcommand('SUBSCRIBE "' + FolderName + '"') = 'OK';
+end;
+
+function TIMAPSend.UnsubscribeFolder(FolderName: string): Boolean;
+begin
+ Result := IMAPcommand('UNSUBSCRIBE "' + FolderName + '"') = 'OK';
+end;
+
+function TIMAPSend.SelectFolder(FolderName: string): Boolean;
+begin
+ Result := IMAPcommand('SELECT "' + FolderName + '"') = 'OK';
+ FSelectedFolder := FolderName;
+ ParseSelect;
+end;
+
+function TIMAPSend.SelectROFolder(FolderName: string): Boolean;
+begin
+ Result := IMAPcommand('EXAMINE "' + FolderName + '"') = 'OK';
+ FSelectedFolder := FolderName;
+ ParseSelect;
+end;
+
+function TIMAPSend.CloseFolder: Boolean;
+begin
+ Result := IMAPcommand('CLOSE') = 'OK';
+ FSelectedFolder := '';
+end;
+
+function TIMAPSend.StatusFolder(FolderName, Value: string): integer;
+var
+ n: integer;
+ s, t: string;
+begin
+ Result := -1;
+ Value := Uppercase(Value);
+ if IMAPcommand('STATUS "' + FolderName + '" (' + Value + ')' ) = 'OK' then
+ begin
+ ProcessLiterals;
+ for n := 0 to FFullResult.Count - 1 do
+ begin
+ s := FFullResult[n];
+// s := UpperCase(FFullResult[n]);
+ if (Pos('* ', s) = 1) and (Pos(FolderName, s) >= 1) and (Pos(Value, s) > 0 ) then
+ begin
+ t := SeparateRight(s, Value);
+ t := SeparateLeft(t, ')');
+ t := trim(t);
+ Result := StrToIntDef(t, -1);
+ Break;
+ end;
+ end;
+ end;
+end;
+
+function TIMAPSend.ExpungeFolder: Boolean;
+begin
+ Result := IMAPcommand('EXPUNGE') = 'OK';
+end;
+
+function TIMAPSend.CheckFolder: Boolean;
+begin
+ Result := IMAPcommand('CHECK') = 'OK';
+end;
+
+function TIMAPSend.AppendMess(ToFolder: string; const Mess: TStrings): Boolean;
+begin
+ Result := IMAPuploadCommand('APPEND "' + ToFolder + '"', Mess) = 'OK';
+end;
+
+function TIMAPSend.DeleteMess(MessID: integer): boolean;
+var
+ s: string;
+begin
+ s := 'STORE ' + IntToStr(MessID) + ' +FLAGS.SILENT (\Deleted)';
+ if FUID then
+ s := 'UID ' + s;
+ Result := IMAPcommand(s) = 'OK';
+end;
+
+function TIMAPSend.FetchMess(MessID: integer; const Mess: TStrings): Boolean;
+var
+ s: string;
+begin
+ s := 'FETCH ' + IntToStr(MessID) + ' (RFC822)';
+ if FUID then
+ s := 'UID ' + s;
+ Result := IMAPcommand(s) = 'OK';
+ ParseMess(Mess);
+end;
+
+function TIMAPSend.FetchHeader(MessID: integer; const Headers: TStrings): Boolean;
+var
+ s: string;
+begin
+ s := 'FETCH ' + IntToStr(MessID) + ' (RFC822.HEADER)';
+ if FUID then
+ s := 'UID ' + s;
+ Result := IMAPcommand(s) = 'OK';
+ ParseMess(Headers);
+end;
+
+function TIMAPSend.MessageSize(MessID: integer): integer;
+var
+ n: integer;
+ s, t: string;
+begin
+ Result := -1;
+ s := 'FETCH ' + IntToStr(MessID) + ' (RFC822.SIZE)';
+ if FUID then
+ s := 'UID ' + s;
+ if IMAPcommand(s) = 'OK' then
+ begin
+ ProcessLiterals;
+ for n := 0 to FFullResult.Count - 1 do
+ begin
+ s := UpperCase(FFullResult[n]);
+ if (Pos('* ', s) = 1) and (Pos('RFC822.SIZE', s) > 0 ) then
+ begin
+ t := SeparateRight(s, 'RFC822.SIZE ');
+ t := Trim(SeparateLeft(t, ')'));
+ t := Trim(SeparateLeft(t, ' '));
+ Result := StrToIntDef(t, -1);
+ Break;
+ end;
+ end;
+ end;
+end;
+
+function TIMAPSend.CopyMess(MessID: integer; ToFolder: string): Boolean;
+var
+ s: string;
+begin
+ s := 'COPY ' + IntToStr(MessID) + ' "' + ToFolder + '"';
+ if FUID then
+ s := 'UID ' + s;
+ Result := IMAPcommand(s) = 'OK';
+end;
+
+function TIMAPSend.SearchMess(Criteria: string; const FoundMess: TStrings): Boolean;
+var
+ s: string;
+begin
+ s := 'SEARCH ' + Criteria;
+ if FUID then
+ s := 'UID ' + s;
+ Result := IMAPcommand(s) = 'OK';
+ ParseSearch(FoundMess);
+end;
+
+function TIMAPSend.SetFlagsMess(MessID: integer; Flags: string): Boolean;
+var
+ s: string;
+begin
+ s := 'STORE ' + IntToStr(MessID) + ' FLAGS.SILENT (' + Flags + ')';
+ if FUID then
+ s := 'UID ' + s;
+ Result := IMAPcommand(s) = 'OK';
+end;
+
+function TIMAPSend.AddFlagsMess(MessID: integer; Flags: string): Boolean;
+var
+ s: string;
+begin
+ s := 'STORE ' + IntToStr(MessID) + ' +FLAGS.SILENT (' + Flags + ')';
+ if FUID then
+ s := 'UID ' + s;
+ Result := IMAPcommand(s) = 'OK';
+end;
+
+function TIMAPSend.DelFlagsMess(MessID: integer; Flags: string): Boolean;
+var
+ s: string;
+begin
+ s := 'STORE ' + IntToStr(MessID) + ' -FLAGS.SILENT (' + Flags + ')';
+ if FUID then
+ s := 'UID ' + s;
+ Result := IMAPcommand(s) = 'OK';
+end;
+
+function TIMAPSend.GetFlagsMess(MessID: integer; var Flags: string): Boolean;
+var
+ s: string;
+ n: integer;
+begin
+ Flags := '';
+ s := 'FETCH ' + IntToStr(MessID) + ' (FLAGS)';
+ if FUID then
+ s := 'UID ' + s;
+ Result := IMAPcommand(s) = 'OK';
+ ProcessLiterals;
+ for n := 0 to FFullResult.Count - 1 do
+ begin
+ s := uppercase(FFullResult[n]);
+ if (Pos('* ', s) = 1) and (Pos('FLAGS', s) > 0 ) then
+ begin
+ s := SeparateRight(s, 'FLAGS');
+ s := Separateright(s, '(');
+ Flags := Trim(SeparateLeft(s, ')'));
+ end;
+ end;
+end;
+
+function TIMAPSend.StartTLS: Boolean;
+begin
+ Result := False;
+ if FindCap('STARTTLS') <> '' then
+ begin
+ if IMAPcommand('STARTTLS') = 'OK' then
+ begin
+ Fsock.SSLDoConnect;
+ Result := FSock.LastError = 0;
+ end;
+ end;
+end;
+
+//Paul Buskermolen
+function TIMAPSend.GetUID(MessID: integer; var UID : Integer): boolean;
+var
+ s, sUid: string;
+ n: integer;
+begin
+ sUID := '';
+ s := 'FETCH ' + IntToStr(MessID) + ' UID';
+ Result := IMAPcommand(s) = 'OK';
+ ProcessLiterals;
+ for n := 0 to FFullResult.Count - 1 do
+ begin
+ s := uppercase(FFullResult[n]);
+ if Pos('FETCH (UID', s) >= 1 then
+ begin
+ s := Separateright(s, '(UID ');
+ sUID := Trim(SeparateLeft(s, ')'));
+ end;
+ end;
+ UID := StrToIntDef(sUID, 0);
+end;
+
+{==============================================================================}
+
+end.
ADDED lib/synapse/source/lib/laz_synapse.lpk
Index: lib/synapse/source/lib/laz_synapse.lpk
==================================================================
--- /dev/null
+++ lib/synapse/source/lib/laz_synapse.lpk
@@ -0,0 +1,170 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
ADDED lib/synapse/source/lib/laz_synapse.pas
Index: lib/synapse/source/lib/laz_synapse.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/lib/laz_synapse.pas
@@ -0,0 +1,24 @@
+{ This file was automatically created by Lazarus. Do not edit!
+ This source is only used to compile and install the package.
+ }
+
+unit laz_synapse;
+
+interface
+
+uses
+ asn1util, blcksock, clamsend, dnssend, ftpsend, ftptsend, httpsend,
+ imapsend, ldapsend, mimeinln, mimemess, mimepart, nntpsend, pingsend,
+ pop3send, slogsend, smtpsend, snmpsend, sntpsend, synachar, synacode,
+ synacrypt, synadbg, synafpc, synaicnv, synaip, synamisc, synaser, synautil,
+ synsock, tlntsend, LazarusPackageIntf;
+
+implementation
+
+procedure Register;
+begin
+end;
+
+initialization
+ RegisterPackage('laz_synapse', @Register);
+end.
ADDED lib/synapse/source/lib/ldapsend.pas
Index: lib/synapse/source/lib/ldapsend.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/lib/ldapsend.pas
@@ -0,0 +1,1208 @@
+{==============================================================================|
+| Project : Ararat Synapse | 001.007.000 |
+|==============================================================================|
+| Content: LDAP client |
+|==============================================================================|
+| Copyright (c)1999-2010, Lukas Gebauer |
+| All rights reserved. |
+| |
+| Redistribution and use in source and binary forms, with or without |
+| modification, are permitted provided that the following conditions are met: |
+| |
+| Redistributions of source code must retain the above copyright notice, this |
+| list of conditions and the following disclaimer. |
+| |
+| Redistributions in binary form must reproduce the above copyright notice, |
+| this list of conditions and the following disclaimer in the documentation |
+| and/or other materials provided with the distribution. |
+| |
+| Neither the name of Lukas Gebauer nor the names of its contributors may |
+| be used to endorse or promote products derived from this software without |
+| specific prior written permission. |
+| |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
+| DAMAGE. |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2003-2010. |
+| All Rights Reserved. |
+|==============================================================================|
+| Contributor(s): |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package |
+| (Found at URL: http://www.ararat.cz/synapse/) |
+|==============================================================================}
+
+{:@abstract(LDAP client)
+
+Used RFC: RFC-2251, RFC-2254, RFC-2829, RFC-2830
+}
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+
+{$IFDEF UNICODE}
+ {$WARN IMPLICIT_STRING_CAST OFF}
+ {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+unit ldapsend;
+
+interface
+
+uses
+ SysUtils, Classes,
+ blcksock, synautil, asn1util, synacode;
+
+const
+ cLDAPProtocol = '389';
+
+ LDAP_ASN1_BIND_REQUEST = $60;
+ LDAP_ASN1_BIND_RESPONSE = $61;
+ LDAP_ASN1_UNBIND_REQUEST = $42;
+ LDAP_ASN1_SEARCH_REQUEST = $63;
+ LDAP_ASN1_SEARCH_ENTRY = $64;
+ LDAP_ASN1_SEARCH_DONE = $65;
+ LDAP_ASN1_SEARCH_REFERENCE = $73;
+ LDAP_ASN1_MODIFY_REQUEST = $66;
+ LDAP_ASN1_MODIFY_RESPONSE = $67;
+ LDAP_ASN1_ADD_REQUEST = $68;
+ LDAP_ASN1_ADD_RESPONSE = $69;
+ LDAP_ASN1_DEL_REQUEST = $4A;
+ LDAP_ASN1_DEL_RESPONSE = $6B;
+ LDAP_ASN1_MODIFYDN_REQUEST = $6C;
+ LDAP_ASN1_MODIFYDN_RESPONSE = $6D;
+ LDAP_ASN1_COMPARE_REQUEST = $6E;
+ LDAP_ASN1_COMPARE_RESPONSE = $6F;
+ LDAP_ASN1_ABANDON_REQUEST = $70;
+ LDAP_ASN1_EXT_REQUEST = $77;
+ LDAP_ASN1_EXT_RESPONSE = $78;
+
+
+type
+
+ {:@abstract(LDAP attribute with list of their values)
+ This class holding name of LDAP attribute and list of their values. This is
+ descendant of TStringList class enhanced by some new properties.}
+ TLDAPAttribute = class(TStringList)
+ private
+ FAttributeName: AnsiString;
+ FIsBinary: Boolean;
+ protected
+ function Get(Index: integer): string; override;
+ procedure Put(Index: integer; const Value: string); override;
+ procedure SetAttributeName(Value: AnsiString);
+ published
+ {:Name of LDAP attribute.}
+ property AttributeName: AnsiString read FAttributeName Write SetAttributeName;
+ {:Return @true when attribute contains binary data.}
+ property IsBinary: Boolean read FIsBinary;
+ end;
+
+ {:@abstract(List of @link(TLDAPAttribute))
+ This object can hold list of TLDAPAttribute objects.}
+ TLDAPAttributeList = class(TObject)
+ private
+ FAttributeList: TList;
+ function GetAttribute(Index: integer): TLDAPAttribute;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ {:Clear list.}
+ procedure Clear;
+ {:Return count of TLDAPAttribute objects in list.}
+ function Count: integer;
+ {:Add new TLDAPAttribute object to list.}
+ function Add: TLDAPAttribute;
+ {:Delete one TLDAPAttribute object from list.}
+ procedure Del(Index: integer);
+ {:Find and return attribute with requested name. Returns nil if not found.}
+ function Find(AttributeName: AnsiString): TLDAPAttribute;
+ {:Find and return attribute value with requested name. Returns empty string if not found.}
+ function Get(AttributeName: AnsiString): string;
+ {:List of TLDAPAttribute objects.}
+ property Items[Index: Integer]: TLDAPAttribute read GetAttribute; default;
+ end;
+
+ {:@abstract(LDAP result object)
+ This object can hold LDAP object. (their name and all their attributes with
+ values)}
+ TLDAPResult = class(TObject)
+ private
+ FObjectName: AnsiString;
+ FAttributes: TLDAPAttributeList;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ published
+ {:Name of this LDAP object.}
+ property ObjectName: AnsiString read FObjectName write FObjectName;
+ {:Here is list of object attributes.}
+ property Attributes: TLDAPAttributeList read FAttributes;
+ end;
+
+ {:@abstract(List of LDAP result objects)
+ This object can hold list of LDAP objects. (for example result of LDAP SEARCH.)}
+ TLDAPResultList = class(TObject)
+ private
+ FResultList: TList;
+ function GetResult(Index: integer): TLDAPResult;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ {:Clear all TLDAPResult objects in list.}
+ procedure Clear;
+ {:Return count of TLDAPResult objects in list.}
+ function Count: integer;
+ {:Create and add new TLDAPResult object to list.}
+ function Add: TLDAPResult;
+ {:List of TLDAPResult objects.}
+ property Items[Index: Integer]: TLDAPResult read GetResult; default;
+ end;
+
+ {:Define possible operations for LDAP MODIFY operations.}
+ TLDAPModifyOp = (
+ MO_Add,
+ MO_Delete,
+ MO_Replace
+ );
+
+ {:Specify possible values for search scope.}
+ TLDAPSearchScope = (
+ SS_BaseObject,
+ SS_SingleLevel,
+ SS_WholeSubtree
+ );
+
+ {:Specify possible values about alias dereferencing.}
+ TLDAPSearchAliases = (
+ SA_NeverDeref,
+ SA_InSearching,
+ SA_FindingBaseObj,
+ SA_Always
+ );
+
+ {:@abstract(Implementation of LDAP client)
+ (version 2 and 3)
+
+ Note: Are you missing properties for setting Username and Password? Look to
+ parent @link(TSynaClient) object!
+
+ Are you missing properties for specify server address and port? Look to
+ parent @link(TSynaClient) too!}
+ TLDAPSend = class(TSynaClient)
+ private
+ FSock: TTCPBlockSocket;
+ FResultCode: Integer;
+ FResultString: AnsiString;
+ FFullResult: AnsiString;
+ FAutoTLS: Boolean;
+ FFullSSL: Boolean;
+ FSeq: integer;
+ FResponseCode: integer;
+ FResponseDN: AnsiString;
+ FReferals: TStringList;
+ FVersion: integer;
+ FSearchScope: TLDAPSearchScope;
+ FSearchAliases: TLDAPSearchAliases;
+ FSearchSizeLimit: integer;
+ FSearchTimeLimit: integer;
+ FSearchResult: TLDAPResultList;
+ FExtName: AnsiString;
+ FExtValue: AnsiString;
+ function Connect: Boolean;
+ function BuildPacket(const Value: AnsiString): AnsiString;
+ function ReceiveResponse: AnsiString;
+ function DecodeResponse(const Value: AnsiString): AnsiString;
+ function LdapSasl(Value: AnsiString): AnsiString;
+ function TranslateFilter(Value: AnsiString): AnsiString;
+ function GetErrorString(Value: integer): AnsiString;
+ public
+ constructor Create;
+ destructor Destroy; override;
+
+ {:Try to connect to LDAP server and start secure channel, when it is required.}
+ function Login: Boolean;
+
+ {:Try to bind to LDAP server with @link(TSynaClient.Username) and
+ @link(TSynaClient.Password). If this is empty strings, then it do annonymous
+ Bind. When you not call Bind on LDAPv3, then is automaticly used anonymous
+ mode.
+
+ This method using plaintext transport of password! It is not secure!}
+ function Bind: Boolean;
+
+ {:Try to bind to LDAP server with @link(TSynaClient.Username) and
+ @link(TSynaClient.Password). If this is empty strings, then it do annonymous
+ Bind. When you not call Bind on LDAPv3, then is automaticly used anonymous
+ mode.
+
+ This method using SASL with DIGEST-MD5 method for secure transfer of your
+ password.}
+ function BindSasl: Boolean;
+
+ {:Close connection to LDAP server.}
+ function Logout: Boolean;
+
+ {:Modify content of LDAP attribute on this object.}
+ function Modify(obj: AnsiString; Op: TLDAPModifyOp; const Value: TLDAPAttribute): Boolean;
+
+ {:Add list of attributes to specified object.}
+ function Add(obj: AnsiString; const Value: TLDAPAttributeList): Boolean;
+
+ {:Delete this LDAP object from server.}
+ function Delete(obj: AnsiString): Boolean;
+
+ {:Modify object name of this LDAP object.}
+ function ModifyDN(obj, newRDN, newSuperior: AnsiString; DeleteoldRDN: Boolean): Boolean;
+
+ {:Try to compare Attribute value with this LDAP object.}
+ function Compare(obj, AttributeValue: AnsiString): Boolean;
+
+ {:Search LDAP base for LDAP objects by Filter.}
+ function Search(obj: AnsiString; TypesOnly: Boolean; Filter: AnsiString;
+ const Attributes: TStrings): Boolean;
+
+ {:Call any LDAPv3 extended command.}
+ function Extended(const Name, Value: AnsiString): Boolean;
+
+ {:Try to start SSL/TLS connection to LDAP server.}
+ function StartTLS: Boolean;
+ published
+ {:Specify version of used LDAP protocol. Default value is 3.}
+ property Version: integer read FVersion Write FVersion;
+
+ {:Result code of last LDAP operation.}
+ property ResultCode: Integer read FResultCode;
+
+ {:Human readable description of result code of last LDAP operation.}
+ property ResultString: AnsiString read FResultString;
+
+ {:Binary string with full last response of LDAP server. This string is
+ encoded by ASN.1 BER encoding! You need this only for debugging.}
+ property FullResult: AnsiString read FFullResult;
+
+ {:If @true, then try to start TSL mode in Login procedure.}
+ property AutoTLS: Boolean read FAutoTLS Write FAutoTLS;
+
+ {:If @true, then use connection to LDAP server through SSL/TLS tunnel.}
+ property FullSSL: Boolean read FFullSSL Write FFullSSL;
+
+ {:Sequence number of last LDAp command. It is incremented by any LDAP command.}
+ property Seq: integer read FSeq;
+
+ {:Specify what search scope is used in search command.}
+ property SearchScope: TLDAPSearchScope read FSearchScope Write FSearchScope;
+
+ {:Specify how to handle aliases in search command.}
+ property SearchAliases: TLDAPSearchAliases read FSearchAliases Write FSearchAliases;
+
+ {:Specify result size limit in search command. Value 0 means without limit.}
+ property SearchSizeLimit: integer read FSearchSizeLimit Write FSearchSizeLimit;
+
+ {:Specify search time limit in search command (seconds). Value 0 means
+ without limit.}
+ property SearchTimeLimit: integer read FSearchTimeLimit Write FSearchTimeLimit;
+
+ {:Here is result of search command.}
+ property SearchResult: TLDAPResultList read FSearchResult;
+
+ {:On each LDAP operation can LDAP server return some referals URLs. Here is
+ their list.}
+ property Referals: TStringList read FReferals;
+
+ {:When you call @link(Extended) operation, then here is result Name returned
+ by server.}
+ property ExtName: AnsiString read FExtName;
+
+ {:When you call @link(Extended) operation, then here is result Value returned
+ by server.}
+ property ExtValue: AnsiString read FExtValue;
+
+ {:TCP socket used by all LDAP operations.}
+ property Sock: TTCPBlockSocket read FSock;
+ end;
+
+{:Dump result of LDAP SEARCH into human readable form. Good for debugging.}
+function LDAPResultDump(const Value: TLDAPResultList): AnsiString;
+
+implementation
+
+{==============================================================================}
+function TLDAPAttribute.Get(Index: integer): string;
+begin
+ Result := inherited Get(Index);
+ if FIsbinary then
+ Result := DecodeBase64(Result);
+end;
+
+procedure TLDAPAttribute.Put(Index: integer; const Value: string);
+var
+ s: AnsiString;
+begin
+ s := Value;
+ if FIsbinary then
+ s := EncodeBase64(Value)
+ else
+ s :=UnquoteStr(s, '"');
+ inherited Put(Index, s);
+end;
+
+procedure TLDAPAttribute.SetAttributeName(Value: AnsiString);
+begin
+ FAttributeName := Value;
+ FIsBinary := Pos(';binary', Lowercase(value)) > 0;
+end;
+
+{==============================================================================}
+constructor TLDAPAttributeList.Create;
+begin
+ inherited Create;
+ FAttributeList := TList.Create;
+end;
+
+destructor TLDAPAttributeList.Destroy;
+begin
+ Clear;
+ FAttributeList.Free;
+ inherited Destroy;
+end;
+
+procedure TLDAPAttributeList.Clear;
+var
+ n: integer;
+ x: TLDAPAttribute;
+begin
+ for n := Count - 1 downto 0 do
+ begin
+ x := GetAttribute(n);
+ if Assigned(x) then
+ x.Free;
+ end;
+ FAttributeList.Clear;
+end;
+
+function TLDAPAttributeList.Count: integer;
+begin
+ Result := FAttributeList.Count;
+end;
+
+function TLDAPAttributeList.Get(AttributeName: AnsiString): string;
+var
+ x: TLDAPAttribute;
+begin
+ Result := '';
+ x := self.Find(AttributeName);
+ if x <> nil then
+ if x.Count > 0 then
+ Result := x[0];
+end;
+
+function TLDAPAttributeList.GetAttribute(Index: integer): TLDAPAttribute;
+begin
+ Result := nil;
+ if Index < Count then
+ Result := TLDAPAttribute(FAttributeList[Index]);
+end;
+
+function TLDAPAttributeList.Add: TLDAPAttribute;
+begin
+ Result := TLDAPAttribute.Create;
+ FAttributeList.Add(Result);
+end;
+
+procedure TLDAPAttributeList.Del(Index: integer);
+var
+ x: TLDAPAttribute;
+begin
+ x := GetAttribute(Index);
+ if Assigned(x) then
+ x.free;
+ FAttributeList.Delete(Index);
+end;
+
+function TLDAPAttributeList.Find(AttributeName: AnsiString): TLDAPAttribute;
+var
+ n: integer;
+ x: TLDAPAttribute;
+begin
+ Result := nil;
+ AttributeName := lowercase(AttributeName);
+ for n := 0 to Count - 1 do
+ begin
+ x := GetAttribute(n);
+ if Assigned(x) then
+ if lowercase(x.AttributeName) = Attributename then
+ begin
+ result := x;
+ break;
+ end;
+ end;
+end;
+
+{==============================================================================}
+constructor TLDAPResult.Create;
+begin
+ inherited Create;
+ FAttributes := TLDAPAttributeList.Create;
+end;
+
+destructor TLDAPResult.Destroy;
+begin
+ FAttributes.Free;
+ inherited Destroy;
+end;
+
+{==============================================================================}
+constructor TLDAPResultList.Create;
+begin
+ inherited Create;
+ FResultList := TList.Create;
+end;
+
+destructor TLDAPResultList.Destroy;
+begin
+ Clear;
+ FResultList.Free;
+ inherited Destroy;
+end;
+
+procedure TLDAPResultList.Clear;
+var
+ n: integer;
+ x: TLDAPResult;
+begin
+ for n := Count - 1 downto 0 do
+ begin
+ x := GetResult(n);
+ if Assigned(x) then
+ x.Free;
+ end;
+ FResultList.Clear;
+end;
+
+function TLDAPResultList.Count: integer;
+begin
+ Result := FResultList.Count;
+end;
+
+function TLDAPResultList.GetResult(Index: integer): TLDAPResult;
+begin
+ Result := nil;
+ if Index < Count then
+ Result := TLDAPResult(FResultList[Index]);
+end;
+
+function TLDAPResultList.Add: TLDAPResult;
+begin
+ Result := TLDAPResult.Create;
+ FResultList.Add(Result);
+end;
+
+{==============================================================================}
+constructor TLDAPSend.Create;
+begin
+ inherited Create;
+ FReferals := TStringList.Create;
+ FFullResult := '';
+ FSock := TTCPBlockSocket.Create;
+ FSock.Owner := self;
+ FTimeout := 60000;
+ FTargetPort := cLDAPProtocol;
+ FAutoTLS := False;
+ FFullSSL := False;
+ FSeq := 0;
+ FVersion := 3;
+ FSearchScope := SS_WholeSubtree;
+ FSearchAliases := SA_Always;
+ FSearchSizeLimit := 0;
+ FSearchTimeLimit := 0;
+ FSearchResult := TLDAPResultList.Create;
+end;
+
+destructor TLDAPSend.Destroy;
+begin
+ FSock.Free;
+ FSearchResult.Free;
+ FReferals.Free;
+ inherited Destroy;
+end;
+
+function TLDAPSend.GetErrorString(Value: integer): AnsiString;
+begin
+ case Value of
+ 0:
+ Result := 'Success';
+ 1:
+ Result := 'Operations error';
+ 2:
+ Result := 'Protocol error';
+ 3:
+ Result := 'Time limit Exceeded';
+ 4:
+ Result := 'Size limit Exceeded';
+ 5:
+ Result := 'Compare FALSE';
+ 6:
+ Result := 'Compare TRUE';
+ 7:
+ Result := 'Auth method not supported';
+ 8:
+ Result := 'Strong auth required';
+ 9:
+ Result := '-- reserved --';
+ 10:
+ Result := 'Referal';
+ 11:
+ Result := 'Admin limit exceeded';
+ 12:
+ Result := 'Unavailable critical extension';
+ 13:
+ Result := 'Confidentality required';
+ 14:
+ Result := 'Sasl bind in progress';
+ 16:
+ Result := 'No such attribute';
+ 17:
+ Result := 'Undefined attribute type';
+ 18:
+ Result := 'Inappropriate matching';
+ 19:
+ Result := 'Constraint violation';
+ 20:
+ Result := 'Attribute or value exists';
+ 21:
+ Result := 'Invalid attribute syntax';
+ 32:
+ Result := 'No such object';
+ 33:
+ Result := 'Alias problem';
+ 34:
+ Result := 'Invalid DN syntax';
+ 36:
+ Result := 'Alias dereferencing problem';
+ 48:
+ Result := 'Inappropriate authentication';
+ 49:
+ Result := 'Invalid credentials';
+ 50:
+ Result := 'Insufficient access rights';
+ 51:
+ Result := 'Busy';
+ 52:
+ Result := 'Unavailable';
+ 53:
+ Result := 'Unwilling to perform';
+ 54:
+ Result := 'Loop detect';
+ 64:
+ Result := 'Naming violation';
+ 65:
+ Result := 'Object class violation';
+ 66:
+ Result := 'Not allowed on non leaf';
+ 67:
+ Result := 'Not allowed on RDN';
+ 68:
+ Result := 'Entry already exists';
+ 69:
+ Result := 'Object class mods prohibited';
+ 71:
+ Result := 'Affects multiple DSAs';
+ 80:
+ Result := 'Other';
+ else
+ Result := '--unknown--';
+ end;
+end;
+
+function TLDAPSend.Connect: Boolean;
+begin
+ // Do not call this function! It is calling by LOGIN method!
+ FSock.CloseSocket;
+ FSock.LineBuffer := '';
+ FSeq := 0;
+ FSock.Bind(FIPInterface, cAnyPort);
+ if FSock.LastError = 0 then
+ FSock.Connect(FTargetHost, FTargetPort);
+ if FSock.LastError = 0 then
+ if FFullSSL then
+ FSock.SSLDoConnect;
+ Result := FSock.LastError = 0;
+end;
+
+function TLDAPSend.BuildPacket(const Value: AnsiString): AnsiString;
+begin
+ Inc(FSeq);
+ Result := ASNObject(ASNObject(ASNEncInt(FSeq), ASN1_INT) + Value, ASN1_SEQ);
+end;
+
+function TLDAPSend.ReceiveResponse: AnsiString;
+var
+ x: Byte;
+ i,j: integer;
+begin
+ Result := '';
+ FFullResult := '';
+ x := FSock.RecvByte(FTimeout);
+ if x <> ASN1_SEQ then
+ Exit;
+ Result := AnsiChar(x);
+ x := FSock.RecvByte(FTimeout);
+ Result := Result + AnsiChar(x);
+ if x < $80 then
+ i := 0
+ else
+ i := x and $7F;
+ if i > 0 then
+ Result := Result + FSock.RecvBufferStr(i, Ftimeout);
+ if FSock.LastError <> 0 then
+ begin
+ Result := '';
+ Exit;
+ end;
+ //get length of LDAP packet
+ j := 2;
+ i := ASNDecLen(j, Result);
+ //retreive rest of LDAP packet
+ if i > 0 then
+ Result := Result + FSock.RecvBufferStr(i, Ftimeout);
+ if FSock.LastError <> 0 then
+ begin
+ Result := '';
+ Exit;
+ end;
+ FFullResult := Result;
+end;
+
+function TLDAPSend.DecodeResponse(const Value: AnsiString): AnsiString;
+var
+ i, x: integer;
+ Svt: Integer;
+ s, t: AnsiString;
+begin
+ Result := '';
+ FResultCode := -1;
+ FResultstring := '';
+ FResponseCode := -1;
+ FResponseDN := '';
+ FReferals.Clear;
+ i := 1;
+ ASNItem(i, Value, Svt);
+ x := StrToIntDef(ASNItem(i, Value, Svt), 0);
+ if (svt <> ASN1_INT) or (x <> FSeq) then
+ Exit;
+ s := ASNItem(i, Value, Svt);
+ FResponseCode := svt;
+ if FResponseCode in [LDAP_ASN1_BIND_RESPONSE, LDAP_ASN1_SEARCH_DONE,
+ LDAP_ASN1_MODIFY_RESPONSE, LDAP_ASN1_ADD_RESPONSE, LDAP_ASN1_DEL_RESPONSE,
+ LDAP_ASN1_MODIFYDN_RESPONSE, LDAP_ASN1_COMPARE_RESPONSE,
+ LDAP_ASN1_EXT_RESPONSE] then
+ begin
+ FResultCode := StrToIntDef(ASNItem(i, Value, Svt), -1);
+ FResponseDN := ASNItem(i, Value, Svt);
+ FResultString := ASNItem(i, Value, Svt);
+ if FResultString = '' then
+ FResultString := GetErrorString(FResultCode);
+ if FResultCode = 10 then
+ begin
+ s := ASNItem(i, Value, Svt);
+ if svt = $A3 then
+ begin
+ x := 1;
+ while x < Length(s) do
+ begin
+ t := ASNItem(x, s, Svt);
+ FReferals.Add(t);
+ end;
+ end;
+ end;
+ end;
+ Result := Copy(Value, i, Length(Value) - i + 1);
+end;
+
+function TLDAPSend.LdapSasl(Value: AnsiString): AnsiString;
+var
+ nonce, cnonce, nc, realm, qop, uri, response: AnsiString;
+ s: AnsiString;
+ a1, a2: AnsiString;
+ l: TStringList;
+ n: integer;
+begin
+ l := TStringList.Create;
+ try
+ nonce := '';
+ realm := '';
+ l.CommaText := Value;
+ n := IndexByBegin('nonce=', l);
+ if n >= 0 then
+ nonce := UnQuoteStr(Trim(SeparateRight(l[n], 'nonce=')), '"');
+ n := IndexByBegin('realm=', l);
+ if n >= 0 then
+ realm := UnQuoteStr(Trim(SeparateRight(l[n], 'realm=')), '"');
+ cnonce := IntToHex(GetTick, 8);
+ nc := '00000001';
+ qop := 'auth';
+ uri := 'ldap/' + FSock.ResolveIpToName(FSock.GetRemoteSinIP);
+ a1 := md5(FUsername + ':' + realm + ':' + FPassword)
+ + ':' + nonce + ':' + cnonce;
+ a2 := 'AUTHENTICATE:' + uri;
+ s := strtohex(md5(a1))+':' + nonce + ':' + nc + ':' + cnonce + ':'
+ + qop +':'+strtohex(md5(a2));
+ response := strtohex(md5(s));
+
+ Result := 'username="' + Fusername + '",realm="' + realm + '",nonce="';
+ Result := Result + nonce + '",cnonce="' + cnonce + '",nc=' + nc + ',qop=';
+ Result := Result + qop + ',digest-uri="' + uri + '",response=' + response;
+ finally
+ l.Free;
+ end;
+end;
+
+function TLDAPSend.TranslateFilter(Value: AnsiString): AnsiString;
+var
+ x: integer;
+ s, t, l: AnsiString;
+ r: string;
+ c: Ansichar;
+ attr, rule: AnsiString;
+ dn: Boolean;
+begin
+ Result := '';
+ if Value = '' then
+ Exit;
+ s := Value;
+ if Value[1] = '(' then
+ begin
+ x := RPos(')', Value);
+ s := Copy(Value, 2, x - 2);
+ end;
+ if s = '' then
+ Exit;
+ case s[1] of
+ '!':
+ // NOT rule (recursive call)
+ begin
+ Result := ASNOBject(TranslateFilter(GetBetween('(', ')', s)), $A2);
+ end;
+ '&':
+ // AND rule (recursive call)
+ begin
+ repeat
+ t := GetBetween('(', ')', s);
+ s := Trim(SeparateRight(s, t));
+ if s <> '' then
+ if s[1] = ')' then
+ {$IFDEF CIL}Borland.Delphi.{$ENDIF}System.Delete(s, 1, 1);
+ Result := Result + TranslateFilter(t);
+ until s = '';
+ Result := ASNOBject(Result, $A0);
+ end;
+ '|':
+ // OR rule (recursive call)
+ begin
+ repeat
+ t := GetBetween('(', ')', s);
+ s := Trim(SeparateRight(s, t));
+ if s <> '' then
+ if s[1] = ')' then
+ {$IFDEF CIL}Borland.Delphi.{$ENDIF}System.Delete(s, 1, 1);
+ Result := Result + TranslateFilter(t);
+ until s = '';
+ Result := ASNOBject(Result, $A1);
+ end;
+ else
+ begin
+ l := Trim(SeparateLeft(s, '='));
+ r := Trim(SeparateRight(s, '='));
+ if l <> '' then
+ begin
+ c := l[Length(l)];
+ case c of
+ ':':
+ // Extensible match
+ begin
+ {$IFDEF CIL}Borland.Delphi.{$ENDIF}System.Delete(l, Length(l), 1);
+ dn := False;
+ attr := '';
+ rule := '';
+ if Pos(':dn', l) > 0 then
+ begin
+ dn := True;
+ l := ReplaceString(l, ':dn', '');
+ end;
+ attr := Trim(SeparateLeft(l, ':'));
+ rule := Trim(SeparateRight(l, ':'));
+ if rule = l then
+ rule := '';
+ if rule <> '' then
+ Result := ASNObject(rule, $81);
+ if attr <> '' then
+ Result := Result + ASNObject(attr, $82);
+ Result := Result + ASNObject(DecodeTriplet(r, '\'), $83);
+ if dn then
+ Result := Result + ASNObject(AsnEncInt($ff), $84)
+ else
+ Result := Result + ASNObject(AsnEncInt(0), $84);
+ Result := ASNOBject(Result, $a9);
+ end;
+ '~':
+ // Approx match
+ begin
+ {$IFDEF CIL}Borland.Delphi.{$ENDIF}System.Delete(l, Length(l), 1);
+ Result := ASNOBject(l, ASN1_OCTSTR)
+ + ASNOBject(DecodeTriplet(r, '\'), ASN1_OCTSTR);
+ Result := ASNOBject(Result, $a8);
+ end;
+ '>':
+ // Greater or equal match
+ begin
+ {$IFDEF CIL}Borland.Delphi.{$ENDIF}System.Delete(l, Length(l), 1);
+ Result := ASNOBject(l, ASN1_OCTSTR)
+ + ASNOBject(DecodeTriplet(r, '\'), ASN1_OCTSTR);
+ Result := ASNOBject(Result, $a5);
+ end;
+ '<':
+ // Less or equal match
+ begin
+ {$IFDEF CIL}Borland.Delphi.{$ENDIF}System.Delete(l, Length(l), 1);
+ Result := ASNOBject(l, ASN1_OCTSTR)
+ + ASNOBject(DecodeTriplet(r, '\'), ASN1_OCTSTR);
+ Result := ASNOBject(Result, $a6);
+ end;
+ else
+ // present
+ if r = '*' then
+ Result := ASNOBject(l, $87)
+ else
+ if Pos('*', r) > 0 then
+ // substrings
+ begin
+ s := Fetch(r, '*');
+ if s <> '' then
+ Result := ASNOBject(DecodeTriplet(s, '\'), $80);
+ while r <> '' do
+ begin
+ if Pos('*', r) <= 0 then
+ break;
+ s := Fetch(r, '*');
+ Result := Result + ASNOBject(DecodeTriplet(s, '\'), $81);
+ end;
+ if r <> '' then
+ Result := Result + ASNOBject(DecodeTriplet(r, '\'), $82);
+ Result := ASNOBject(l, ASN1_OCTSTR)
+ + ASNOBject(Result, ASN1_SEQ);
+ Result := ASNOBject(Result, $a4);
+ end
+ else
+ begin
+ // Equality match
+ Result := ASNOBject(l, ASN1_OCTSTR)
+ + ASNOBject(DecodeTriplet(r, '\'), ASN1_OCTSTR);
+ Result := ASNOBject(Result, $a3);
+ end;
+ end;
+ end;
+ end;
+ end;
+end;
+
+function TLDAPSend.Login: Boolean;
+begin
+ Result := False;
+ if not Connect then
+ Exit;
+ Result := True;
+ if FAutoTLS then
+ Result := StartTLS;
+end;
+
+function TLDAPSend.Bind: Boolean;
+var
+ s: AnsiString;
+begin
+ s := ASNObject(ASNEncInt(FVersion), ASN1_INT)
+ + ASNObject(FUsername, ASN1_OCTSTR)
+ + ASNObject(FPassword, $80);
+ s := ASNObject(s, LDAP_ASN1_BIND_REQUEST);
+ Fsock.SendString(BuildPacket(s));
+ s := ReceiveResponse;
+ DecodeResponse(s);
+ Result := FResultCode = 0;
+end;
+
+function TLDAPSend.BindSasl: Boolean;
+var
+ s, t: AnsiString;
+ x, xt: integer;
+ digreq: AnsiString;
+begin
+ Result := False;
+ if FPassword = '' then
+ Result := Bind
+ else
+ begin
+ digreq := ASNObject(ASNEncInt(FVersion), ASN1_INT)
+ + ASNObject('', ASN1_OCTSTR)
+ + ASNObject(ASNObject('DIGEST-MD5', ASN1_OCTSTR), $A3);
+ digreq := ASNObject(digreq, LDAP_ASN1_BIND_REQUEST);
+ Fsock.SendString(BuildPacket(digreq));
+ s := ReceiveResponse;
+ t := DecodeResponse(s);
+ if FResultCode = 14 then
+ begin
+ s := t;
+ x := 1;
+ t := ASNItem(x, s, xt);
+ s := ASNObject(ASNEncInt(FVersion), ASN1_INT)
+ + ASNObject('', ASN1_OCTSTR)
+ + ASNObject(ASNObject('DIGEST-MD5', ASN1_OCTSTR)
+ + ASNObject(LdapSasl(t), ASN1_OCTSTR), $A3);
+ s := ASNObject(s, LDAP_ASN1_BIND_REQUEST);
+ Fsock.SendString(BuildPacket(s));
+ s := ReceiveResponse;
+ DecodeResponse(s);
+ if FResultCode = 14 then
+ begin
+ Fsock.SendString(BuildPacket(digreq));
+ s := ReceiveResponse;
+ DecodeResponse(s);
+ end;
+ Result := FResultCode = 0;
+ end;
+ end;
+end;
+
+function TLDAPSend.Logout: Boolean;
+begin
+ Fsock.SendString(BuildPacket(ASNObject('', LDAP_ASN1_UNBIND_REQUEST)));
+ FSock.CloseSocket;
+ Result := True;
+end;
+
+function TLDAPSend.Modify(obj: AnsiString; Op: TLDAPModifyOp; const Value: TLDAPAttribute): Boolean;
+var
+ s: AnsiString;
+ n: integer;
+begin
+ s := '';
+ for n := 0 to Value.Count -1 do
+ s := s + ASNObject(Value[n], ASN1_OCTSTR);
+ s := ASNObject(Value.AttributeName, ASN1_OCTSTR) + ASNObject(s, ASN1_SETOF);
+ s := ASNObject(ASNEncInt(Ord(Op)), ASN1_ENUM) + ASNObject(s, ASN1_SEQ);
+ s := ASNObject(s, ASN1_SEQ);
+ s := ASNObject(obj, ASN1_OCTSTR) + ASNObject(s, ASN1_SEQ);
+ s := ASNObject(s, LDAP_ASN1_MODIFY_REQUEST);
+ Fsock.SendString(BuildPacket(s));
+ s := ReceiveResponse;
+ DecodeResponse(s);
+ Result := FResultCode = 0;
+end;
+
+function TLDAPSend.Add(obj: AnsiString; const Value: TLDAPAttributeList): Boolean;
+var
+ s, t: AnsiString;
+ n, m: integer;
+begin
+ s := '';
+ for n := 0 to Value.Count - 1 do
+ begin
+ t := '';
+ for m := 0 to Value[n].Count - 1 do
+ t := t + ASNObject(Value[n][m], ASN1_OCTSTR);
+ t := ASNObject(Value[n].AttributeName, ASN1_OCTSTR)
+ + ASNObject(t, ASN1_SETOF);
+ s := s + ASNObject(t, ASN1_SEQ);
+ end;
+ s := ASNObject(obj, ASN1_OCTSTR) + ASNObject(s, ASN1_SEQ);
+ s := ASNObject(s, LDAP_ASN1_ADD_REQUEST);
+ Fsock.SendString(BuildPacket(s));
+ s := ReceiveResponse;
+ DecodeResponse(s);
+ Result := FResultCode = 0;
+end;
+
+function TLDAPSend.Delete(obj: AnsiString): Boolean;
+var
+ s: AnsiString;
+begin
+ s := ASNObject(obj, LDAP_ASN1_DEL_REQUEST);
+ Fsock.SendString(BuildPacket(s));
+ s := ReceiveResponse;
+ DecodeResponse(s);
+ Result := FResultCode = 0;
+end;
+
+function TLDAPSend.ModifyDN(obj, newRDN, newSuperior: AnsiString; DeleteOldRDN: Boolean): Boolean;
+var
+ s: AnsiString;
+begin
+ s := ASNObject(obj, ASN1_OCTSTR) + ASNObject(newRDN, ASN1_OCTSTR);
+ if DeleteOldRDN then
+ s := s + ASNObject(ASNEncInt($ff), ASN1_BOOL)
+ else
+ s := s + ASNObject(ASNEncInt(0), ASN1_BOOL);
+ if newSuperior <> '' then
+ s := s + ASNObject(newSuperior, $80);
+ s := ASNObject(s, LDAP_ASN1_MODIFYDN_REQUEST);
+ Fsock.SendString(BuildPacket(s));
+ s := ReceiveResponse;
+ DecodeResponse(s);
+ Result := FResultCode = 0;
+end;
+
+function TLDAPSend.Compare(obj, AttributeValue: AnsiString): Boolean;
+var
+ s: AnsiString;
+begin
+ s := ASNObject(Trim(SeparateLeft(AttributeValue, '=')), ASN1_OCTSTR)
+ + ASNObject(Trim(SeparateRight(AttributeValue, '=')), ASN1_OCTSTR);
+ s := ASNObject(obj, ASN1_OCTSTR) + ASNObject(s, ASN1_SEQ);
+ s := ASNObject(s, LDAP_ASN1_COMPARE_REQUEST);
+ Fsock.SendString(BuildPacket(s));
+ s := ReceiveResponse;
+ DecodeResponse(s);
+ Result := FResultCode = 0;
+end;
+
+function TLDAPSend.Search(obj: AnsiString; TypesOnly: Boolean; Filter: AnsiString;
+ const Attributes: TStrings): Boolean;
+var
+ s, t, u: AnsiString;
+ n, i, x: integer;
+ r: TLDAPResult;
+ a: TLDAPAttribute;
+begin
+ FSearchResult.Clear;
+ FReferals.Clear;
+ s := ASNObject(obj, ASN1_OCTSTR);
+ s := s + ASNObject(ASNEncInt(Ord(FSearchScope)), ASN1_ENUM);
+ s := s + ASNObject(ASNEncInt(Ord(FSearchAliases)), ASN1_ENUM);
+ s := s + ASNObject(ASNEncInt(FSearchSizeLimit), ASN1_INT);
+ s := s + ASNObject(ASNEncInt(FSearchTimeLimit), ASN1_INT);
+ if TypesOnly then
+ s := s + ASNObject(ASNEncInt($ff), ASN1_BOOL)
+ else
+ s := s + ASNObject(ASNEncInt(0), ASN1_BOOL);
+ if Filter = '' then
+ Filter := '(objectclass=*)';
+ t := TranslateFilter(Filter);
+ if t = '' then
+ s := s + ASNObject('', ASN1_NULL)
+ else
+ s := s + t;
+ t := '';
+ for n := 0 to Attributes.Count - 1 do
+ t := t + ASNObject(Attributes[n], ASN1_OCTSTR);
+ s := s + ASNObject(t, ASN1_SEQ);
+ s := ASNObject(s, LDAP_ASN1_SEARCH_REQUEST);
+ Fsock.SendString(BuildPacket(s));
+ repeat
+ s := ReceiveResponse;
+ t := DecodeResponse(s);
+ if FResponseCode = LDAP_ASN1_SEARCH_ENTRY then
+ begin
+ //dekoduj zaznam
+ r := FSearchResult.Add;
+ n := 1;
+ r.ObjectName := ASNItem(n, t, x);
+ ASNItem(n, t, x);
+ if x = ASN1_SEQ then
+ begin
+ while n < Length(t) do
+ begin
+ s := ASNItem(n, t, x);
+ if x = ASN1_SEQ then
+ begin
+ i := n + Length(s);
+ a := r.Attributes.Add;
+ u := ASNItem(n, t, x);
+ a.AttributeName := u;
+ ASNItem(n, t, x);
+ if x = ASN1_SETOF then
+ while n < i do
+ begin
+ u := ASNItem(n, t, x);
+ a.Add(u);
+ end;
+ end;
+ end;
+ end;
+ end;
+ if FResponseCode = LDAP_ASN1_SEARCH_REFERENCE then
+ begin
+ n := 1;
+ while n < Length(t) do
+ FReferals.Add(ASNItem(n, t, x));
+ end;
+ until FResponseCode = LDAP_ASN1_SEARCH_DONE;
+ Result := FResultCode = 0;
+end;
+
+function TLDAPSend.Extended(const Name, Value: AnsiString): Boolean;
+var
+ s, t: AnsiString;
+ x, xt: integer;
+begin
+ s := ASNObject(Name, $80);
+ if Value <> '' then
+ s := s + ASNObject(Value, $81);
+ s := ASNObject(s, LDAP_ASN1_EXT_REQUEST);
+ Fsock.SendString(BuildPacket(s));
+ s := ReceiveResponse;
+ t := DecodeResponse(s);
+ Result := FResultCode = 0;
+ if Result then
+ begin
+ x := 1;
+ FExtName := ASNItem(x, t, xt);
+ FExtValue := ASNItem(x, t, xt);
+ end;
+end;
+
+
+function TLDAPSend.StartTLS: Boolean;
+begin
+ Result := Extended('1.3.6.1.4.1.1466.20037', '');
+ if Result then
+ begin
+ Fsock.SSLDoConnect;
+ Result := FSock.LastError = 0;
+ end;
+end;
+
+{==============================================================================}
+function LDAPResultDump(const Value: TLDAPResultList): AnsiString;
+var
+ n, m, o: integer;
+ r: TLDAPResult;
+ a: TLDAPAttribute;
+begin
+ Result := 'Results: ' + IntToStr(Value.Count) + CRLF +CRLF;
+ for n := 0 to Value.Count - 1 do
+ begin
+ Result := Result + 'Result: ' + IntToStr(n) + CRLF;
+ r := Value[n];
+ Result := Result + ' Object: ' + r.ObjectName + CRLF;
+ for m := 0 to r.Attributes.Count - 1 do
+ begin
+ a := r.Attributes[m];
+ Result := Result + ' Attribute: ' + a.AttributeName + CRLF;
+ for o := 0 to a.Count - 1 do
+ Result := Result + ' ' + a[o] + CRLF;
+ end;
+ end;
+end;
+
+end.
ADDED lib/synapse/source/lib/mimeinln.pas
Index: lib/synapse/source/lib/mimeinln.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/lib/mimeinln.pas
@@ -0,0 +1,263 @@
+{==============================================================================|
+| Project : Ararat Synapse | 001.001.011 |
+|==============================================================================|
+| Content: Inline MIME support procedures and functions |
+|==============================================================================|
+| Copyright (c)1999-2006, Lukas Gebauer |
+| All rights reserved. |
+| |
+| Redistribution and use in source and binary forms, with or without |
+| modification, are permitted provided that the following conditions are met: |
+| |
+| Redistributions of source code must retain the above copyright notice, this |
+| list of conditions and the following disclaimer. |
+| |
+| Redistributions in binary form must reproduce the above copyright notice, |
+| this list of conditions and the following disclaimer in the documentation |
+| and/or other materials provided with the distribution. |
+| |
+| Neither the name of Lukas Gebauer nor the names of its contributors may |
+| be used to endorse or promote products derived from this software without |
+| specific prior written permission. |
+| |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
+| DAMAGE. |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2000-2006. |
+| All Rights Reserved. |
+|==============================================================================|
+| Contributor(s): |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package |
+| (Found at URL: http://www.ararat.cz/synapse/) |
+|==============================================================================}
+
+{:@abstract(Utilities for inline MIME)
+Support for Inline MIME encoding and decoding.
+
+Used RFC: RFC-2047, RFC-2231
+}
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+
+{$IFDEF UNICODE}
+ {$WARN IMPLICIT_STRING_CAST OFF}
+ {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+unit mimeinln;
+
+interface
+
+uses
+ SysUtils, Classes,
+ synachar, synacode, synautil;
+
+{:Decodes mime inline encoding (i.e. in headers) uses target characterset "CP".}
+function InlineDecode(const Value: string; CP: TMimeChar): string;
+
+{:Encodes string to MIME inline encoding. The source characterset is "CP", and
+ the target charset is "MimeP".}
+function InlineEncode(const Value: string; CP, MimeP: TMimeChar): string;
+
+{:Returns @true, if "Value" contains characters needed for inline coding.}
+function NeedInline(const Value: AnsiString): boolean;
+
+{:Inline mime encoding similar to @link(InlineEncode), but you can specify
+ source charset, and the target characterset is automatically assigned.}
+function InlineCodeEx(const Value: string; FromCP: TMimeChar): string;
+
+{:Inline MIME encoding similar to @link(InlineEncode), but the source charset
+ is automatically set to the system default charset, and the target charset is
+ automatically assigned from set of allowed encoding for MIME.}
+function InlineCode(const Value: string): string;
+
+{:Converts e-mail address to canonical mime form. You can specify source charset.}
+function InlineEmailEx(const Value: string; FromCP: TMimeChar): string;
+
+{:Converts e-mail address to canonical mime form. Source charser it system
+ default charset.}
+function InlineEmail(const Value: string): string;
+
+implementation
+
+{==============================================================================}
+
+function InlineDecode(const Value: string; CP: TMimeChar): string;
+var
+ s, su, v: string;
+ x, y, z, n: Integer;
+ ichar: TMimeChar;
+ c: Char;
+
+ function SearchEndInline(const Value: string; be: Integer): Integer;
+ var
+ n, q: Integer;
+ begin
+ q := 0;
+ Result := 0;
+ for n := be + 2 to Length(Value) - 1 do
+ if Value[n] = '?' then
+ begin
+ Inc(q);
+ if (q > 2) and (Value[n + 1] = '=') then
+ begin
+ Result := n;
+ Break;
+ end;
+ end;
+ end;
+
+begin
+ Result := '';
+ v := Value;
+ x := Pos('=?', v);
+ y := SearchEndInline(v, x);
+ //fix for broken coding with begin, but not with end.
+ if (x > 0) and (y <= 0) then
+ y := Length(Result);
+ while (y > x) and (x > 0) do
+ begin
+ s := Copy(v, 1, x - 1);
+ if Trim(s) <> '' then
+ Result := Result + s;
+ s := Copy(v, x, y - x + 2);
+ Delete(v, 1, y + 1);
+ su := Copy(s, 3, Length(s) - 4);
+ z := Pos('?', su);
+ if (Length(su) >= (z + 2)) and (su[z + 2] = '?') then
+ begin
+ ichar := GetCPFromID(SeparateLeft(Copy(su, 1, z - 1), '*'));
+ c := UpperCase(su)[z + 1];
+ su := Copy(su, z + 3, Length(su) - z - 2);
+ if c = 'B' then
+ begin
+ s := DecodeBase64(su);
+ s := CharsetConversion(s, ichar, CP);
+ end;
+ if c = 'Q' then
+ begin
+ s := '';
+ for n := 1 to Length(su) do
+ if su[n] = '_' then
+ s := s + ' '
+ else
+ s := s + su[n];
+ s := DecodeQuotedPrintable(s);
+ s := CharsetConversion(s, ichar, CP);
+ end;
+ end;
+ Result := Result + s;
+ x := Pos('=?', v);
+ y := SearchEndInline(v, x);
+ end;
+ Result := Result + v;
+end;
+
+{==============================================================================}
+
+function InlineEncode(const Value: string; CP, MimeP: TMimeChar): string;
+var
+ s, s1, e: string;
+ n: Integer;
+begin
+ s := CharsetConversion(Value, CP, MimeP);
+ s := EncodeSafeQuotedPrintable(s);
+ e := GetIdFromCP(MimeP);
+ s1 := '';
+ Result := '';
+ for n := 1 to Length(s) do
+ if s[n] = ' ' then
+ begin
+// s1 := s1 + '=20';
+ s1 := s1 + '_';
+ if Length(s1) > 32 then
+ begin
+ if Result <> '' then
+ Result := Result + ' ';
+ Result := Result + '=?' + e + '?Q?' + s1 + '?=';
+ s1 := '';
+ end;
+ end
+ else
+ s1 := s1 + s[n];
+ if s1 <> '' then
+ begin
+ if Result <> '' then
+ Result := Result + ' ';
+ Result := Result + '=?' + e + '?Q?' + s1 + '?=';
+ end;
+end;
+
+{==============================================================================}
+
+function NeedInline(const Value: AnsiString): boolean;
+var
+ n: Integer;
+begin
+ Result := False;
+ for n := 1 to Length(Value) do
+ if Value[n] in (SpecialChar + NonAsciiChar - ['_']) then
+ begin
+ Result := True;
+ Break;
+ end;
+end;
+
+{==============================================================================}
+
+function InlineCodeEx(const Value: string; FromCP: TMimeChar): string;
+var
+ c: TMimeChar;
+begin
+ if NeedInline(Value) then
+ begin
+ c := IdealCharsetCoding(Value, FromCP, IdealCharsets);
+ Result := InlineEncode(Value, FromCP, c);
+ end
+ else
+ Result := Value;
+end;
+
+{==============================================================================}
+
+function InlineCode(const Value: string): string;
+begin
+ Result := InlineCodeEx(Value, GetCurCP);
+end;
+
+{==============================================================================}
+
+function InlineEmailEx(const Value: string; FromCP: TMimeChar): string;
+var
+ sd, se: string;
+begin
+ sd := GetEmailDesc(Value);
+ se := GetEmailAddr(Value);
+ if sd = '' then
+ Result := se
+ else
+ Result := '"' + InlineCodeEx(sd, FromCP) + '" <' + se + '>';
+end;
+
+{==============================================================================}
+
+function InlineEmail(const Value: string): string;
+begin
+ Result := InlineEmailEx(Value, GetCurCP);
+end;
+
+end.
ADDED lib/synapse/source/lib/mimemess.pas
Index: lib/synapse/source/lib/mimemess.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/lib/mimemess.pas
@@ -0,0 +1,851 @@
+{==============================================================================|
+| Project : Ararat Synapse | 002.006.000 |
+|==============================================================================|
+| Content: MIME message object |
+|==============================================================================|
+| Copyright (c)1999-2012, Lukas Gebauer |
+| All rights reserved. |
+| |
+| Redistribution and use in source and binary forms, with or without |
+| modification, are permitted provided that the following conditions are met: |
+| |
+| Redistributions of source code must retain the above copyright notice, this |
+| list of conditions and the following disclaimer. |
+| |
+| Redistributions in binary form must reproduce the above copyright notice, |
+| this list of conditions and the following disclaimer in the documentation |
+| and/or other materials provided with the distribution. |
+| |
+| Neither the name of Lukas Gebauer nor the names of its contributors may |
+| be used to endorse or promote products derived from this software without |
+| specific prior written permission. |
+| |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
+| DAMAGE. |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2000-2012. |
+| Portions created by Petr Fejfar are Copyright (c)2011-2012. |
+| All Rights Reserved. |
+|==============================================================================|
+| Contributor(s): |
+|==============================================================================|
+| History: see HISTORY.HTM From distribution package |
+| (Found at URL: http://www.ararat.cz/synapse/) |
+|==============================================================================}
+
+{:@abstract(MIME message handling)
+Classes for easy handling with e-mail message.
+}
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+{$M+}
+
+unit mimemess;
+
+interface
+
+uses
+ Classes, SysUtils,
+ mimepart, synachar, synautil, mimeinln;
+
+type
+
+ {:Possible values for message priority}
+ TMessPriority = (MP_unknown, MP_low, MP_normal, MP_high);
+
+ {:@abstract(Object for basic e-mail header fields.)}
+ TMessHeader = class(TObject)
+ private
+ FFrom: string;
+ FToList: TStringList;
+ FCCList: TStringList;
+ FSubject: string;
+ FOrganization: string;
+ FCustomHeaders: TStringList;
+ FDate: TDateTime;
+ FXMailer: string;
+ FCharsetCode: TMimeChar;
+ FReplyTo: string;
+ FMessageID: string;
+ FPriority: TMessPriority;
+ Fpri: TMessPriority;
+ Fxpri: TMessPriority;
+ Fxmspri: TMessPriority;
+ protected
+ function ParsePriority(value: string): TMessPriority;
+ function DecodeHeader(value: string): boolean; virtual;
+ public
+ constructor Create; virtual;
+ destructor Destroy; override;
+
+ {:Clears all data fields.}
+ procedure Clear; virtual;
+
+ {Add headers from from this object to Value.}
+ procedure EncodeHeaders(const Value: TStrings); virtual;
+
+ {:Parse header from Value to this object.}
+ procedure DecodeHeaders(const Value: TStrings);
+
+ {:Try find specific header in CustomHeader. Search is case insensitive.
+ This is good for reading any non-parsed header.}
+ function FindHeader(Value: string): string;
+
+ {:Try find specific headers in CustomHeader. This metod is for repeatly used
+ headers like 'received' header, etc. Search is case insensitive.
+ This is good for reading ano non-parsed header.}
+ procedure FindHeaderList(Value: string; const HeaderList: TStrings);
+ published
+ {:Sender of message.}
+ property From: string read FFrom Write FFrom;
+
+ {:Stringlist with receivers of message. (one per line)}
+ property ToList: TStringList read FToList;
+
+ {:Stringlist with Carbon Copy receivers of message. (one per line)}
+ property CCList: TStringList read FCCList;
+
+ {:Subject of message.}
+ property Subject: string read FSubject Write FSubject;
+
+ {:Organization string.}
+ property Organization: string read FOrganization Write FOrganization;
+
+ {:After decoding contains all headers lines witch not have parsed to any
+ other structures in this object. It mean: this conatins all other headers
+ except:
+
+ X-MAILER, FROM, SUBJECT, ORGANIZATION, TO, CC, DATE, MIME-VERSION,
+ CONTENT-TYPE, CONTENT-DESCRIPTION, CONTENT-DISPOSITION, CONTENT-ID,
+ CONTENT-TRANSFER-ENCODING, REPLY-TO, MESSAGE-ID, X-MSMAIL-PRIORITY,
+ X-PRIORITY, PRIORITY
+
+ When you encode headers, all this lines is added as headers. Be carefull
+ for duplicites!}
+ property CustomHeaders: TStringList read FCustomHeaders;
+
+ {:Date and time of message.}
+ property Date: TDateTime read FDate Write FDate;
+
+ {:Mailer identification.}
+ property XMailer: string read FXMailer Write FXMailer;
+
+ {:Address for replies}
+ property ReplyTo: string read FReplyTo Write FReplyTo;
+
+ {:message indetifier}
+ property MessageID: string read FMessageID Write FMessageID;
+
+ {:message priority}
+ property Priority: TMessPriority read FPriority Write FPriority;
+
+ {:Specify base charset. By default is used system charset.}
+ property CharsetCode: TMimeChar read FCharsetCode Write FCharsetCode;
+ end;
+
+ TMessHeaderClass = class of TMessHeader;
+
+ {:@abstract(Object for handling of e-mail message.)}
+ TMimeMess = class(TObject)
+ private
+ FMessagePart: TMimePart;
+ FLines: TStringList;
+ FHeader: TMessHeader;
+ public
+ constructor Create;
+ {:create this object and assign your own descendant of @link(TMessHeader)
+ object to @link(header) property. So, you can create your own message
+ headers parser and use it by this object.}
+ constructor CreateAltHeaders(HeadClass: TMessHeaderClass);
+ destructor Destroy; override;
+
+ {:Reset component to default state.}
+ procedure Clear; virtual;
+
+ {:Add MIME part as subpart of PartParent. If you need set root MIME part,
+ then set as PartParent @NIL value. If you need set more then one subpart,
+ you must have PartParent of multipart type!}
+ function AddPart(const PartParent: TMimePart): TMimePart;
+
+ {:Add MIME part as subpart of PartParent. If you need set root MIME part,
+ then set as PartParent @NIL value. If you need set more then 1 subpart, you
+ must have PartParent of multipart type!
+
+ This part is marked as multipart with secondary MIME type specified by
+ MultipartType parameter. (typical value is 'mixed')
+
+ This part can be used as PartParent for another parts (include next
+ multipart). If you need only one part, then you not need Multipart part.}
+ function AddPartMultipart(const MultipartType: String; const PartParent: TMimePart): TMimePart;
+
+ {:Add MIME part as subpart of PartParent. If you need set root MIME part,
+ then set as PartParent @NIL value. If you need set more then 1 subpart, you
+ must have PartParent of multipart type!
+
+ After creation of part set type to text part and set all necessary
+ properties. Content of part is readed from value stringlist.}
+ function AddPartText(const Value: TStrings; const PartParent: TMimePart): TMimepart;
+
+ {:Add MIME part as subpart of PartParent. If you need set root MIME part,
+ then set as PartParent @NIL value. If you need set more then 1 subpart, you
+ must have PartParent of multipart type!
+
+ After creation of part set type to text part and set all necessary
+ properties. Content of part is readed from value stringlist. You can select
+ your charset and your encoding type. If Raw is @true, then it not doing
+ charset conversion!}
+ function AddPartTextEx(const Value: TStrings; const PartParent: TMimePart;
+ PartCharset: TMimeChar; Raw: Boolean; PartEncoding: TMimeEncoding): TMimepart;
+
+ {:Add MIME part as subpart of PartParent. If you need set root MIME part,
+ then set as PartParent @NIL value. If you need set more then 1 subpart, you
+ must have PartParent of multipart type!
+
+ After creation of part set type to text part to HTML type and set all
+ necessary properties. Content of HTML part is readed from Value stringlist.}
+ function AddPartHTML(const Value: TStrings; const PartParent: TMimePart): TMimepart;
+
+ {:Same as @link(AddPartText), but content is readed from file}
+ function AddPartTextFromFile(const FileName: String; const PartParent: TMimePart): TMimepart;
+
+ {:Same as @link(AddPartHTML), but content is readed from file}
+ function AddPartHTMLFromFile(const FileName: String; const PartParent: TMimePart): TMimepart;
+
+ {:Add MIME part as subpart of PartParent. If you need set root MIME part,
+ then set as PartParent @NIL value. If you need set more then 1 subpart,
+ you must have PartParent of multipart type!
+
+ After creation of part set type to binary and set all necessary properties.
+ MIME primary and secondary types defined automaticly by filename extension.
+ Content of binary part is readed from Stream. This binary part is encoded
+ as file attachment.}
+ function AddPartBinary(const Stream: TStream; const FileName: string; const PartParent: TMimePart): TMimepart;
+
+ {:Same as @link(AddPartBinary), but content is readed from file}
+ function AddPartBinaryFromFile(const FileName: string; const PartParent: TMimePart): TMimepart;
+
+ {:Add MIME part as subpart of PartParent. If you need set root MIME part,
+ then set as PartParent @NIL value. If you need set more then 1 subpart, you
+ must have PartParent of multipart type!
+
+ After creation of part set type to binary and set all necessary properties.
+ MIME primary and secondary types defined automaticly by filename extension.
+ Content of binary part is readed from Stream.
+
+ This binary part is encoded as inline data with given Conten ID (cid).
+ Content ID can be used as reference ID in HTML source in HTML part.}
+ function AddPartHTMLBinary(const Stream: TStream; const FileName, Cid: string; const PartParent: TMimePart): TMimepart;
+
+ {:Same as @link(AddPartHTMLBinary), but content is readed from file}
+ function AddPartHTMLBinaryFromFile(const FileName, Cid: string; const PartParent: TMimePart): TMimepart;
+
+ {:Add MIME part as subpart of PartParent. If you need set root MIME part,
+ then set as PartParent @NIL value. If you need set more then 1 subpart, you
+ must have PartParent of multipart type!
+
+ After creation of part set type to message and set all necessary properties.
+ MIME primary and secondary types are setted to 'message/rfc822'.
+ Content of raw RFC-822 message is readed from Stream.}
+ function AddPartMess(const Value: TStrings; const PartParent: TMimePart): TMimepart;
+
+ {:Same as @link(AddPartMess), but content is readed from file}
+ function AddPartMessFromFile(const FileName: string; const PartParent: TMimePart): TMimepart;
+
+ {:Compose message from @link(MessagePart) to @link(Lines). Headers from
+ @link(Header) object is added also.}
+ procedure EncodeMessage;
+
+ {:Decode message from @link(Lines) to @link(MessagePart). Massage headers
+ are parsed into @link(Header) object.}
+ procedure DecodeMessage;
+
+ {pf}
+ {: HTTP message is received by @link(THTTPSend) component in two parts:
+ headers are stored in @link(THTTPSend.Headers) and a body in memory stream
+ @link(THTTPSend.Document).
+
+ On the top of it, HTTP connections are always 8-bit, hence data are
+ transferred in native format i.e. no transfer encoding is applied.
+
+ This method operates the similiar way and produces the same
+ result as @link(DecodeMessage).
+ }
+ procedure DecodeMessageBinary(AHeader:TStrings; AData:TMemoryStream);
+ {/pf}
+ published
+ {:@link(TMimePart) object with decoded MIME message. This object can handle
+ any number of nested @link(TMimePart) objects itself. It is used for handle
+ any tree of MIME subparts.}
+ property MessagePart: TMimePart read FMessagePart;
+
+ {:Raw MIME encoded message.}
+ property Lines: TStringList read FLines;
+
+ {:Object for e-mail header fields. This object is created automaticly.
+ Do not free this object!}
+ property Header: TMessHeader read FHeader;
+ end;
+
+implementation
+
+{==============================================================================}
+
+constructor TMessHeader.Create;
+begin
+ inherited Create;
+ FToList := TStringList.Create;
+ FCCList := TStringList.Create;
+ FCustomHeaders := TStringList.Create;
+ FCharsetCode := GetCurCP;
+end;
+
+destructor TMessHeader.Destroy;
+begin
+ FCustomHeaders.Free;
+ FCCList.Free;
+ FToList.Free;
+ inherited Destroy;
+end;
+
+{==============================================================================}
+
+procedure TMessHeader.Clear;
+begin
+ FFrom := '';
+ FToList.Clear;
+ FCCList.Clear;
+ FSubject := '';
+ FOrganization := '';
+ FCustomHeaders.Clear;
+ FDate := 0;
+ FXMailer := '';
+ FReplyTo := '';
+ FMessageID := '';
+ FPriority := MP_unknown;
+end;
+
+procedure TMessHeader.EncodeHeaders(const Value: TStrings);
+var
+ n: Integer;
+ s: string;
+begin
+ if FDate = 0 then
+ FDate := Now;
+ for n := FCustomHeaders.Count - 1 downto 0 do
+ if FCustomHeaders[n] <> '' then
+ Value.Insert(0, FCustomHeaders[n]);
+ if FPriority <> MP_unknown then
+ case FPriority of
+ MP_high:
+ begin
+ Value.Insert(0, 'X-MSMAIL-Priority: High');
+ Value.Insert(0, 'X-Priority: 1');
+ Value.Insert(0, 'Priority: urgent');
+ end;
+ MP_low:
+ begin
+ Value.Insert(0, 'X-MSMAIL-Priority: low');
+ Value.Insert(0, 'X-Priority: 5');
+ Value.Insert(0, 'Priority: non-urgent');
+ end;
+ end;
+ if FReplyTo <> '' then
+ Value.Insert(0, 'Reply-To: ' + GetEmailAddr(FReplyTo));
+ if FMessageID <> '' then
+ Value.Insert(0, 'Message-ID: <' + trim(FMessageID) + '>');
+ if FXMailer = '' then
+ Value.Insert(0, 'X-mailer: Synapse - Pascal TCP/IP library by Lukas Gebauer')
+ else
+ Value.Insert(0, 'X-mailer: ' + FXMailer);
+ Value.Insert(0, 'MIME-Version: 1.0 (produced by Synapse)');
+ if FOrganization <> '' then
+ Value.Insert(0, 'Organization: ' + InlineCodeEx(FOrganization, FCharsetCode));
+ s := '';
+ for n := 0 to FCCList.Count - 1 do
+ if s = '' then
+ s := InlineEmailEx(FCCList[n], FCharsetCode)
+ else
+ s := s + ', ' + InlineEmailEx(FCCList[n], FCharsetCode);
+ if s <> '' then
+ Value.Insert(0, 'CC: ' + s);
+ Value.Insert(0, 'Date: ' + Rfc822DateTime(FDate));
+ if FSubject <> '' then
+ Value.Insert(0, 'Subject: ' + InlineCodeEx(FSubject, FCharsetCode));
+ s := '';
+ for n := 0 to FToList.Count - 1 do
+ if s = '' then
+ s := InlineEmailEx(FToList[n], FCharsetCode)
+ else
+ s := s + ', ' + InlineEmailEx(FToList[n], FCharsetCode);
+ if s <> '' then
+ Value.Insert(0, 'To: ' + s);
+ Value.Insert(0, 'From: ' + InlineEmailEx(FFrom, FCharsetCode));
+end;
+
+function TMessHeader.ParsePriority(value: string): TMessPriority;
+var
+ s: string;
+ x: integer;
+begin
+ Result := MP_unknown;
+ s := Trim(separateright(value, ':'));
+ s := Separateleft(s, ' ');
+ x := StrToIntDef(s, -1);
+ if x >= 0 then
+ case x of
+ 1, 2:
+ Result := MP_High;
+ 3:
+ Result := MP_Normal;
+ 4, 5:
+ Result := MP_Low;
+ end
+ else
+ begin
+ s := lowercase(s);
+ if (s = 'urgent') or (s = 'high') or (s = 'highest') then
+ Result := MP_High;
+ if (s = 'normal') or (s = 'medium') then
+ Result := MP_Normal;
+ if (s = 'low') or (s = 'lowest')
+ or (s = 'no-priority') or (s = 'non-urgent') then
+ Result := MP_Low;
+ end;
+end;
+
+function TMessHeader.DecodeHeader(value: string): boolean;
+var
+ s, t: string;
+ cp: TMimeChar;
+begin
+ Result := True;
+ cp := FCharsetCode;
+ s := uppercase(value);
+ if Pos('X-MAILER:', s) = 1 then
+ begin
+ FXMailer := Trim(SeparateRight(Value, ':'));
+ Exit;
+ end;
+ if Pos('FROM:', s) = 1 then
+ begin
+ FFrom := InlineDecode(Trim(SeparateRight(Value, ':')), cp);
+ Exit;
+ end;
+ if Pos('SUBJECT:', s) = 1 then
+ begin
+ FSubject := InlineDecode(Trim(SeparateRight(Value, ':')), cp);
+ Exit;
+ end;
+ if Pos('ORGANIZATION:', s) = 1 then
+ begin
+ FOrganization := InlineDecode(Trim(SeparateRight(Value, ':')), cp);
+ Exit;
+ end;
+ if Pos('TO:', s) = 1 then
+ begin
+ s := Trim(SeparateRight(Value, ':'));
+ repeat
+ t := InlineDecode(Trim(FetchEx(s, ',', '"')), cp);
+ if t <> '' then
+ FToList.Add(t);
+ until s = '';
+ Exit;
+ end;
+ if Pos('CC:', s) = 1 then
+ begin
+ s := Trim(SeparateRight(Value, ':'));
+ repeat
+ t := InlineDecode(Trim(FetchEx(s, ',', '"')), cp);
+ if t <> '' then
+ FCCList.Add(t);
+ until s = '';
+ Exit;
+ end;
+ if Pos('DATE:', s) = 1 then
+ begin
+ FDate := DecodeRfcDateTime(Trim(SeparateRight(Value, ':')));
+ Exit;
+ end;
+ if Pos('REPLY-TO:', s) = 1 then
+ begin
+ FReplyTo := InlineDecode(Trim(SeparateRight(Value, ':')), cp);
+ Exit;
+ end;
+ if Pos('MESSAGE-ID:', s) = 1 then
+ begin
+ FMessageID := GetEmailAddr(Trim(SeparateRight(Value, ':')));
+ Exit;
+ end;
+ if Pos('PRIORITY:', s) = 1 then
+ begin
+ FPri := ParsePriority(value);
+ Exit;
+ end;
+ if Pos('X-PRIORITY:', s) = 1 then
+ begin
+ FXPri := ParsePriority(value);
+ Exit;
+ end;
+ if Pos('X-MSMAIL-PRIORITY:', s) = 1 then
+ begin
+ FXmsPri := ParsePriority(value);
+ Exit;
+ end;
+ if Pos('MIME-VERSION:', s) = 1 then
+ Exit;
+ if Pos('CONTENT-TYPE:', s) = 1 then
+ Exit;
+ if Pos('CONTENT-DESCRIPTION:', s) = 1 then
+ Exit;
+ if Pos('CONTENT-DISPOSITION:', s) = 1 then
+ Exit;
+ if Pos('CONTENT-ID:', s) = 1 then
+ Exit;
+ if Pos('CONTENT-TRANSFER-ENCODING:', s) = 1 then
+ Exit;
+ Result := False;
+end;
+
+procedure TMessHeader.DecodeHeaders(const Value: TStrings);
+var
+ s: string;
+ x: Integer;
+begin
+ Clear;
+ Fpri := MP_unknown;
+ Fxpri := MP_unknown;
+ Fxmspri := MP_unknown;
+ x := 0;
+ while Value.Count > x do
+ begin
+ s := NormalizeHeader(Value, x);
+ if s = '' then
+ Break;
+ if not DecodeHeader(s) then
+ FCustomHeaders.Add(s);
+ end;
+ if Fpri <> MP_unknown then
+ FPriority := Fpri
+ else
+ if Fxpri <> MP_unknown then
+ FPriority := Fxpri
+ else
+ if Fxmspri <> MP_unknown then
+ FPriority := Fxmspri
+end;
+
+function TMessHeader.FindHeader(Value: string): string;
+var
+ n: integer;
+begin
+ Result := '';
+ for n := 0 to FCustomHeaders.Count - 1 do
+ if Pos(UpperCase(Value), UpperCase(FCustomHeaders[n])) = 1 then
+ begin
+ Result := Trim(SeparateRight(FCustomHeaders[n], ':'));
+ break;
+ end;
+end;
+
+procedure TMessHeader.FindHeaderList(Value: string; const HeaderList: TStrings);
+var
+ n: integer;
+begin
+ HeaderList.Clear;
+ for n := 0 to FCustomHeaders.Count - 1 do
+ if Pos(UpperCase(Value), UpperCase(FCustomHeaders[n])) = 1 then
+ begin
+ HeaderList.Add(Trim(SeparateRight(FCustomHeaders[n], ':')));
+ end;
+end;
+
+{==============================================================================}
+
+constructor TMimeMess.Create;
+begin
+ CreateAltHeaders(TMessHeader);
+end;
+
+constructor TMimeMess.CreateAltHeaders(HeadClass: TMessHeaderClass);
+begin
+ inherited Create;
+ FMessagePart := TMimePart.Create;
+ FLines := TStringList.Create;
+ FHeader := HeadClass.Create;
+end;
+
+destructor TMimeMess.Destroy;
+begin
+ FMessagePart.Free;
+ FHeader.Free;
+ FLines.Free;
+ inherited Destroy;
+end;
+
+{==============================================================================}
+
+procedure TMimeMess.Clear;
+begin
+ FMessagePart.Clear;
+ FLines.Clear;
+ FHeader.Clear;
+end;
+
+{==============================================================================}
+
+function TMimeMess.AddPart(const PartParent: TMimePart): TMimePart;
+begin
+ if PartParent = nil then
+ Result := FMessagePart
+ else
+ Result := PartParent.AddSubPart;
+ Result.Clear;
+end;
+
+{==============================================================================}
+
+function TMimeMess.AddPartMultipart(const MultipartType: String; const PartParent: TMimePart): TMimePart;
+begin
+ Result := AddPart(PartParent);
+ with Result do
+ begin
+ Primary := 'Multipart';
+ Secondary := MultipartType;
+ Description := 'Multipart message';
+ Boundary := GenerateBoundary;
+ EncodePartHeader;
+ end;
+end;
+
+function TMimeMess.AddPartText(const Value: TStrings; const PartParent: TMimePart): TMimepart;
+begin
+ Result := AddPart(PartParent);
+ with Result do
+ begin
+ Value.SaveToStream(DecodedLines);
+ Primary := 'text';
+ Secondary := 'plain';
+ Description := 'Message text';
+ Disposition := 'inline';
+ CharsetCode := IdealCharsetCoding(Value.Text, TargetCharset, IdealCharsets);
+ EncodingCode := ME_QUOTED_PRINTABLE;
+ EncodePart;
+ EncodePartHeader;
+ end;
+end;
+
+function TMimeMess.AddPartTextEx(const Value: TStrings; const PartParent: TMimePart;
+ PartCharset: TMimeChar; Raw: Boolean; PartEncoding: TMimeEncoding): TMimepart;
+begin
+ Result := AddPart(PartParent);
+ with Result do
+ begin
+ Value.SaveToStream(DecodedLines);
+ Primary := 'text';
+ Secondary := 'plain';
+ Description := 'Message text';
+ Disposition := 'inline';
+ CharsetCode := PartCharset;
+ EncodingCode := PartEncoding;
+ ConvertCharset := not Raw;
+ EncodePart;
+ EncodePartHeader;
+ end;
+end;
+
+function TMimeMess.AddPartHTML(const Value: TStrings; const PartParent: TMimePart): TMimepart;
+begin
+ Result := AddPart(PartParent);
+ with Result do
+ begin
+ Value.SaveToStream(DecodedLines);
+ Primary := 'text';
+ Secondary := 'html';
+ Description := 'HTML text';
+ Disposition := 'inline';
+ CharsetCode := UTF_8;
+ EncodingCode := ME_QUOTED_PRINTABLE;
+ EncodePart;
+ EncodePartHeader;
+ end;
+end;
+
+function TMimeMess.AddPartTextFromFile(const FileName: String; const PartParent: TMimePart): TMimepart;
+var
+ tmp: TStrings;
+begin
+ tmp := TStringList.Create;
+ try
+ tmp.LoadFromFile(FileName);
+ Result := AddPartText(tmp, PartParent);
+ Finally
+ tmp.Free;
+ end;
+end;
+
+function TMimeMess.AddPartHTMLFromFile(const FileName: String; const PartParent: TMimePart): TMimepart;
+var
+ tmp: TStrings;
+begin
+ tmp := TStringList.Create;
+ try
+ tmp.LoadFromFile(FileName);
+ Result := AddPartHTML(tmp, PartParent);
+ Finally
+ tmp.Free;
+ end;
+end;
+
+function TMimeMess.AddPartBinary(const Stream: TStream; const FileName: string; const PartParent: TMimePart): TMimepart;
+begin
+ Result := AddPart(PartParent);
+ Result.DecodedLines.LoadFromStream(Stream);
+ Result.MimeTypeFromExt(FileName);
+ Result.Description := 'Attached file: ' + FileName;
+ Result.Disposition := 'attachment';
+ Result.FileName := FileName;
+ Result.EncodingCode := ME_BASE64;
+ Result.EncodePart;
+ Result.EncodePartHeader;
+end;
+
+function TMimeMess.AddPartBinaryFromFile(const FileName: string; const PartParent: TMimePart): TMimepart;
+var
+ tmp: TMemoryStream;
+begin
+ tmp := TMemoryStream.Create;
+ try
+ tmp.LoadFromFile(FileName);
+ Result := AddPartBinary(tmp, ExtractFileName(FileName), PartParent);
+ finally
+ tmp.Free;
+ end;
+end;
+
+function TMimeMess.AddPartHTMLBinary(const Stream: TStream; const FileName, Cid: string; const PartParent: TMimePart): TMimepart;
+begin
+ Result := AddPart(PartParent);
+ Result.DecodedLines.LoadFromStream(Stream);
+ Result.MimeTypeFromExt(FileName);
+ Result.Description := 'Included file: ' + FileName;
+ Result.Disposition := 'inline';
+ Result.ContentID := Cid;
+ Result.FileName := FileName;
+ Result.EncodingCode := ME_BASE64;
+ Result.EncodePart;
+ Result.EncodePartHeader;
+end;
+
+function TMimeMess.AddPartHTMLBinaryFromFile(const FileName, Cid: string; const PartParent: TMimePart): TMimepart;
+var
+ tmp: TMemoryStream;
+begin
+ tmp := TMemoryStream.Create;
+ try
+ tmp.LoadFromFile(FileName);
+ Result :=AddPartHTMLBinary(tmp, ExtractFileName(FileName), Cid, PartParent);
+ finally
+ tmp.Free;
+ end;
+end;
+
+function TMimeMess.AddPartMess(const Value: TStrings; const PartParent: TMimePart): TMimepart;
+var
+ part: Tmimepart;
+begin
+ Result := AddPart(PartParent);
+ part := AddPart(result);
+ part.lines.addstrings(Value);
+ part.DecomposeParts;
+ with Result do
+ begin
+ Primary := 'message';
+ Secondary := 'rfc822';
+ Description := 'E-mail Message';
+ EncodePart;
+ EncodePartHeader;
+ end;
+end;
+
+function TMimeMess.AddPartMessFromFile(const FileName: String; const PartParent: TMimePart): TMimepart;
+var
+ tmp: TStrings;
+begin
+ tmp := TStringList.Create;
+ try
+ tmp.LoadFromFile(FileName);
+ Result := AddPartMess(tmp, PartParent);
+ Finally
+ tmp.Free;
+ end;
+end;
+
+{==============================================================================}
+
+procedure TMimeMess.EncodeMessage;
+var
+ l: TStringList;
+ x: integer;
+begin
+ //merge headers from THeaders and header field from MessagePart
+ l := TStringList.Create;
+ try
+ FHeader.EncodeHeaders(l);
+ x := IndexByBegin('CONTENT-TYPE', FMessagePart.Headers);
+ if x >= 0 then
+ l.add(FMessagePart.Headers[x]);
+ x := IndexByBegin('CONTENT-DESCRIPTION', FMessagePart.Headers);
+ if x >= 0 then
+ l.add(FMessagePart.Headers[x]);
+ x := IndexByBegin('CONTENT-DISPOSITION', FMessagePart.Headers);
+ if x >= 0 then
+ l.add(FMessagePart.Headers[x]);
+ x := IndexByBegin('CONTENT-ID', FMessagePart.Headers);
+ if x >= 0 then
+ l.add(FMessagePart.Headers[x]);
+ x := IndexByBegin('CONTENT-TRANSFER-ENCODING', FMessagePart.Headers);
+ if x >= 0 then
+ l.add(FMessagePart.Headers[x]);
+ FMessagePart.Headers.Assign(l);
+ finally
+ l.Free;
+ end;
+ FMessagePart.ComposeParts;
+ FLines.Assign(FMessagePart.Lines);
+end;
+
+{==============================================================================}
+
+procedure TMimeMess.DecodeMessage;
+begin
+ FHeader.Clear;
+ FHeader.DecodeHeaders(FLines);
+ FMessagePart.Lines.Assign(FLines);
+ FMessagePart.DecomposeParts;
+end;
+
+{pf}
+procedure TMimeMess.DecodeMessageBinary(AHeader:TStrings; AData:TMemoryStream);
+begin
+ FHeader.Clear;
+ FLines.Clear;
+ FLines.Assign(AHeader);
+ FHeader.DecodeHeaders(FLines);
+ FMessagePart.DecomposePartsBinary(AHeader,PANSIChar(AData.Memory),PANSIChar(AData.Memory)+AData.Size);
+end;
+{/pf}
+
+end.
ADDED lib/synapse/source/lib/mimepart.pas
Index: lib/synapse/source/lib/mimepart.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/lib/mimepart.pas
@@ -0,0 +1,1227 @@
+{==============================================================================|
+| Project : Ararat Synapse | 002.009.000 |
+|==============================================================================|
+| Content: MIME support procedures and functions |
+|==============================================================================|
+| Copyright (c)1999-200812 |
+| |
+| Redistribution and use in source and binary forms, with or without |
+| modification, are permitted provided that the following conditions are met: |
+| |
+| Redistributions of source code must retain the above copyright notice, this |
+| list of conditions and the following disclaimer. |
+| |
+| Redistributions in binary form must reproduce the above copyright notice, |
+| this list of conditions and the following disclaimer in the documentation |
+| and/or other materials provided with the distribution. |
+| |
+| Neither the name of Lukas Gebauer nor the names of its contributors may |
+| be used to endorse or promote products derived from this software without |
+| specific prior written permission. |
+| |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
+| DAMAGE. |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2000-2012. |
+| Portions created by Petr Fejfar are Copyright (c)2011-2012. |
+| All Rights Reserved. |
+|==============================================================================|
+| Contributor(s): |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package |
+| (Found at URL: http://www.ararat.cz/synapse/) |
+|==============================================================================}
+
+{:@abstract(MIME part handling)
+Handling with MIME parts.
+
+Used RFC: RFC-2045
+}
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+{$Q-}
+{$R-}
+{$M+}
+
+{$IFDEF UNICODE}
+ {$WARN IMPLICIT_STRING_CAST OFF}
+ {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+unit mimepart;
+
+interface
+
+uses
+ SysUtils, Classes,
+ synafpc,
+ synachar, synacode, synautil, mimeinln;
+
+type
+
+ TMimePart = class;
+
+ {:@abstract(Procedural type for @link(TMimepart.Walkpart) hook). This hook is used for
+ easy walking through MIME subparts.}
+ THookWalkPart = procedure(const Sender: TMimePart) of object;
+
+ {:The four types of MIME parts. (textual, multipart, message or any other
+ binary data.)}
+ TMimePrimary = (MP_TEXT, MP_MULTIPART, MP_MESSAGE, MP_BINARY);
+
+ {:The various types of possible part encodings.}
+ TMimeEncoding = (ME_7BIT, ME_8BIT, ME_QUOTED_PRINTABLE,
+ ME_BASE64, ME_UU, ME_XX);
+
+ {:@abstract(Object for working with parts of MIME e-mail.)
+ Each TMimePart object can handle any number of nested subparts as new
+ TMimepart objects. It can handle any tree hierarchy structure of nested MIME
+ subparts itself.
+
+ Basic tasks are:
+
+ Decoding of MIME message:
+ - store message into Lines property
+ - call DecomposeParts. Now you have decomposed MIME parts in all nested levels!
+ - now you can explore all properties and subparts. (You can use WalkPart method)
+ - if you need decode part, call DecodePart.
+
+ Encoding of MIME message:
+
+ - if you need multipart message, you must create subpart by AddSubPart.
+ - set all properties of all parts.
+ - set content of part into DecodedLines stream
+ - encode this stream by EncodePart.
+ - compose full message by ComposeParts. (it build full MIME message from all subparts. Do not call this method for each subpart! It is needed on root part!)
+ - encoded MIME message is stored in Lines property.
+ }
+ TMimePart = class(TObject)
+ private
+ FPrimary: string;
+ FPrimaryCode: TMimePrimary;
+ FSecondary: string;
+ FEncoding: string;
+ FEncodingCode: TMimeEncoding;
+ FDefaultCharset: string;
+ FCharset: string;
+ FCharsetCode: TMimeChar;
+ FTargetCharset: TMimeChar;
+ FDescription: string;
+ FDisposition: string;
+ FContentID: string;
+ FBoundary: string;
+ FFileName: string;
+ FLines: TStringList;
+ FPartBody: TStringList;
+ FHeaders: TStringList;
+ FPrePart: TStringList;
+ FPostPart: TStringList;
+ FDecodedLines: TMemoryStream;
+ FSubParts: TList;
+ FOnWalkPart: THookWalkPart;
+ FMaxLineLength: integer;
+ FSubLevel: integer;
+ FMaxSubLevel: integer;
+ FAttachInside: boolean;
+ FConvertCharset: Boolean;
+ FForcedHTMLConvert: Boolean;
+ FBinaryDecomposer: boolean;
+ procedure SetPrimary(Value: string);
+ procedure SetEncoding(Value: string);
+ procedure SetCharset(Value: string);
+ function IsUUcode(Value: string): boolean;
+ public
+ constructor Create;
+ destructor Destroy; override;
+
+ {:Assign content of another object to this object. (Only this part,
+ not subparts!)}
+ procedure Assign(Value: TMimePart);
+
+ {:Assign content of another object to this object. (With all subparts!)}
+ procedure AssignSubParts(Value: TMimePart);
+
+ {:Clear all data values to default values. It also call @link(ClearSubparts).}
+ procedure Clear;
+
+ {:Decode Mime part from @link(Lines) to @link(DecodedLines).}
+ procedure DecodePart;
+
+ {:Parse header lines from Headers property into another properties.}
+ procedure DecodePartHeader;
+
+ {:Encode mime part from @link(DecodedLines) to @link(Lines) and build mime
+ headers.}
+ procedure EncodePart;
+
+ {:Build header lines in Headers property from another properties.}
+ procedure EncodePartHeader;
+
+ {:generate primary and secondary mime type from filename extension in value.
+ If type not recognised, it return 'Application/octet-string' type.}
+ procedure MimeTypeFromExt(Value: string);
+
+ {:Return number of decomposed subparts. (On this level! Each of this
+ subparts can hold any number of their own nested subparts!)}
+ function GetSubPartCount: integer;
+
+ {:Get nested subpart object as new TMimePart. For getting maximum possible
+ index you can use @link(GetSubPartCount) method.}
+ function GetSubPart(index: integer): TMimePart;
+
+ {:delete subpart on given index.}
+ procedure DeleteSubPart(index: integer);
+
+ {:Clear and destroy all subpart TMimePart objects.}
+ procedure ClearSubParts;
+
+ {:Add and create new subpart.}
+ function AddSubPart: TMimePart;
+
+ {:E-mail message in @link(Lines) property is parsed into this object.
+ E-mail headers are stored in @link(Headers) property and is parsed into
+ another properties automaticly. Not need call @link(DecodePartHeader)!
+ Content of message (part) is stored into @link(PartBody) property. This
+ part is in undecoded form! If you need decode it, then you must call
+ @link(DecodePart) method by your hands. Lot of another properties is filled
+ also.
+
+ Decoding of parts you must call separately due performance reasons. (Not
+ needed to decode all parts in all reasons.)
+
+ For each MIME subpart is created new TMimepart object (accessible via
+ method @link(GetSubPart)).}
+ procedure DecomposeParts;
+
+ {pf}
+ {: HTTP message is received by @link(THTTPSend) component in two parts:
+ headers are stored in @link(THTTPSend.Headers) and a body in memory stream
+ @link(THTTPSend.Document).
+
+ On the top of it, HTTP connections are always 8-bit, hence data are
+ transferred in native format i.e. no transfer encoding is applied.
+
+ This method operates the similiar way and produces the same
+ result as @link(DecomposeParts).
+ }
+ procedure DecomposePartsBinary(AHeader:TStrings; AStx,AEtx:PANSIChar);
+ {/pf}
+
+ {:This part and all subparts is composed into one MIME message stored in
+ @link(Lines) property.}
+ procedure ComposeParts;
+
+ {:By calling this method is called @link(OnWalkPart) event for each part
+ and their subparts. It is very good for calling some code for each part in
+ MIME message}
+ procedure WalkPart;
+
+ {:Return @true when is possible create next subpart. (@link(maxSublevel)
+ is still not reached)}
+ function CanSubPart: boolean;
+ published
+ {:Primary Mime type of part. (i.e. 'application') Writing to this property
+ automaticly generate value of @link(PrimaryCode).}
+ property Primary: string read FPrimary write SetPrimary;
+
+ {:String representation of used Mime encoding in part. (i.e. 'base64')
+ Writing to this property automaticly generate value of @link(EncodingCode).}
+ property Encoding: string read FEncoding write SetEncoding;
+
+ {:String representation of used Mime charset in part. (i.e. 'iso-8859-1')
+ Writing to this property automaticly generate value of @link(CharsetCode).
+ Charset is used only for text parts.}
+ property Charset: string read FCharset write SetCharset;
+
+ {:Define default charset for decoding text MIME parts without charset
+ specification. Default value is 'ISO-8859-1' by RCF documents.
+ But Microsoft Outlook use windows codings as default. This property allows
+ properly decode textual parts from some broken versions of Microsoft
+ Outlook. (this is bad software!)}
+ property DefaultCharset: string read FDefaultCharset write FDefaultCharset;
+
+ {:Decoded primary type. Possible values are: MP_TEXT, MP_MULTIPART,
+ MP_MESSAGE and MP_BINARY. If type not recognised, result is MP_BINARY.}
+ property PrimaryCode: TMimePrimary read FPrimaryCode Write FPrimaryCode;
+
+ {:Decoded encoding type. Possible values are: ME_7BIT, ME_8BIT,
+ ME_QUOTED_PRINTABLE and ME_BASE64. If type not recognised, result is
+ ME_7BIT.}
+ property EncodingCode: TMimeEncoding read FEncodingCode Write FEncodingCode;
+
+ {:Decoded charset type. Possible values are defined in @link(SynaChar) unit.}
+ property CharsetCode: TMimeChar read FCharsetCode Write FCharsetCode;
+
+ {:System charset type. Default value is charset used by default in your
+ operating system.}
+ property TargetCharset: TMimeChar read FTargetCharset Write FTargetCharset;
+
+ {:If @true, then do internal charset translation of part content between @link(CharsetCode)
+ and @link(TargetCharset)}
+ property ConvertCharset: Boolean read FConvertCharset Write FConvertCharset;
+
+ {:If @true, then allways do internal charset translation of HTML parts
+ by MIME even it have their own charset in META tag. Default is @false.}
+ property ForcedHTMLConvert: Boolean read FForcedHTMLConvert Write FForcedHTMLConvert;
+
+ {:Secondary Mime type of part. (i.e. 'mixed')}
+ property Secondary: string read FSecondary Write FSecondary;
+
+ {:Description of Mime part.}
+ property Description: string read FDescription Write FDescription;
+
+ {:Value of content disposition field. (i.e. 'inline' or 'attachment')}
+ property Disposition: string read FDisposition Write FDisposition;
+
+ {:Content ID.}
+ property ContentID: string read FContentID Write FContentID;
+
+ {:Boundary delimiter of multipart Mime part. Used only in multipart part.}
+ property Boundary: string read FBoundary Write FBoundary;
+
+ {:Filename of file in binary part.}
+ property FileName: string read FFileName Write FFileName;
+
+ {:String list with lines contains mime part (It can be a full message).}
+ property Lines: TStringList read FLines;
+
+ {:Encoded form of MIME part data.}
+ property PartBody: TStringList read FPartBody;
+
+ {:All header lines of MIME part.}
+ property Headers: TStringList read FHeaders;
+
+ {:On multipart this contains part of message between first line of message
+ and first boundary.}
+ property PrePart: TStringList read FPrePart;
+
+ {:On multipart this contains part of message between last boundary and end
+ of message.}
+ property PostPart: TStringList read FPostPart;
+
+ {:Stream with decoded form of budy part.}
+ property DecodedLines: TMemoryStream read FDecodedLines;
+
+ {:Show nested level in subpart tree. Value 0 means root part. 1 means
+ subpart from this root. etc.}
+ property SubLevel: integer read FSubLevel write FSubLevel;
+
+ {:Specify maximum sublevel value for decomposing.}
+ property MaxSubLevel: integer read FMaxSubLevel write FMaxSubLevel;
+
+ {:When is @true, then this part maybe(!) have included some uuencoded binary
+ data.}
+ property AttachInside: boolean read FAttachInside;
+
+ {:Here you can assign hook procedure for walking through all part and their
+ subparts.}
+ property OnWalkPart: THookWalkPart read FOnWalkPart write FOnWalkPart;
+
+ {:Here you can specify maximum line length for encoding of MIME part.
+ If line is longer, then is splitted by standard of MIME. Correct MIME
+ mailers can de-split this line into original length.}
+ property MaxLineLength: integer read FMaxLineLength Write FMaxLineLength;
+ end;
+
+const
+ MaxMimeType = 25;
+ MimeType: array[0..MaxMimeType, 0..2] of string =
+ (
+ ('AU', 'audio', 'basic'),
+ ('AVI', 'video', 'x-msvideo'),
+ ('BMP', 'image', 'BMP'),
+ ('DOC', 'application', 'MSWord'),
+ ('EPS', 'application', 'Postscript'),
+ ('GIF', 'image', 'GIF'),
+ ('JPEG', 'image', 'JPEG'),
+ ('JPG', 'image', 'JPEG'),
+ ('MID', 'audio', 'midi'),
+ ('MOV', 'video', 'quicktime'),
+ ('MPEG', 'video', 'MPEG'),
+ ('MPG', 'video', 'MPEG'),
+ ('MP2', 'audio', 'mpeg'),
+ ('MP3', 'audio', 'mpeg'),
+ ('PDF', 'application', 'PDF'),
+ ('PNG', 'image', 'PNG'),
+ ('PS', 'application', 'Postscript'),
+ ('QT', 'video', 'quicktime'),
+ ('RA', 'audio', 'x-realaudio'),
+ ('RTF', 'application', 'RTF'),
+ ('SND', 'audio', 'basic'),
+ ('TIF', 'image', 'TIFF'),
+ ('TIFF', 'image', 'TIFF'),
+ ('WAV', 'audio', 'x-wav'),
+ ('WPD', 'application', 'Wordperfect5.1'),
+ ('ZIP', 'application', 'ZIP')
+ );
+
+{:Generates a unique boundary string.}
+function GenerateBoundary: string;
+
+implementation
+
+{==============================================================================}
+
+constructor TMIMEPart.Create;
+begin
+ inherited Create;
+ FOnWalkPart := nil;
+ FLines := TStringList.Create;
+ FPartBody := TStringList.Create;
+ FHeaders := TStringList.Create;
+ FPrePart := TStringList.Create;
+ FPostPart := TStringList.Create;
+ FDecodedLines := TMemoryStream.Create;
+ FSubParts := TList.Create;
+ FTargetCharset := GetCurCP;
+ //was 'US-ASCII' before, but RFC-ignorant Outlook sometimes using default
+ //system charset instead.
+ FDefaultCharset := GetIDFromCP(GetCurCP);
+ FMaxLineLength := 78;
+ FSubLevel := 0;
+ FMaxSubLevel := -1;
+ FAttachInside := false;
+ FConvertCharset := true;
+ FForcedHTMLConvert := false;
+end;
+
+destructor TMIMEPart.Destroy;
+begin
+ ClearSubParts;
+ FSubParts.Free;
+ FDecodedLines.Free;
+ FPartBody.Free;
+ FLines.Free;
+ FHeaders.Free;
+ FPrePart.Free;
+ FPostPart.Free;
+ inherited Destroy;
+end;
+
+{==============================================================================}
+
+procedure TMIMEPart.Clear;
+begin
+ FPrimary := '';
+ FEncoding := '';
+ FCharset := '';
+ FPrimaryCode := MP_TEXT;
+ FEncodingCode := ME_7BIT;
+ FCharsetCode := ISO_8859_1;
+ FTargetCharset := GetCurCP;
+ FSecondary := '';
+ FDisposition := '';
+ FContentID := '';
+ FDescription := '';
+ FBoundary := '';
+ FFileName := '';
+ FAttachInside := False;
+ FPartBody.Clear;
+ FHeaders.Clear;
+ FPrePart.Clear;
+ FPostPart.Clear;
+ FDecodedLines.Clear;
+ FConvertCharset := true;
+ FForcedHTMLConvert := false;
+ ClearSubParts;
+end;
+
+{==============================================================================}
+
+procedure TMIMEPart.Assign(Value: TMimePart);
+begin
+ Primary := Value.Primary;
+ Encoding := Value.Encoding;
+ Charset := Value.Charset;
+ DefaultCharset := Value.DefaultCharset;
+ PrimaryCode := Value.PrimaryCode;
+ EncodingCode := Value.EncodingCode;
+ CharsetCode := Value.CharsetCode;
+ TargetCharset := Value.TargetCharset;
+ Secondary := Value.Secondary;
+ Description := Value.Description;
+ Disposition := Value.Disposition;
+ ContentID := Value.ContentID;
+ Boundary := Value.Boundary;
+ FileName := Value.FileName;
+ Lines.Assign(Value.Lines);
+ PartBody.Assign(Value.PartBody);
+ Headers.Assign(Value.Headers);
+ PrePart.Assign(Value.PrePart);
+ PostPart.Assign(Value.PostPart);
+ MaxLineLength := Value.MaxLineLength;
+ FAttachInside := Value.AttachInside;
+ FConvertCharset := Value.ConvertCharset;
+end;
+
+{==============================================================================}
+
+procedure TMIMEPart.AssignSubParts(Value: TMimePart);
+var
+ n: integer;
+ p: TMimePart;
+begin
+ Assign(Value);
+ for n := 0 to Value.GetSubPartCount - 1 do
+ begin
+ p := AddSubPart;
+ p.AssignSubParts(Value.GetSubPart(n));
+ end;
+end;
+
+{==============================================================================}
+
+function TMIMEPart.GetSubPartCount: integer;
+begin
+ Result := FSubParts.Count;
+end;
+
+{==============================================================================}
+
+function TMIMEPart.GetSubPart(index: integer): TMimePart;
+begin
+ Result := nil;
+ if Index < GetSubPartCount then
+ Result := TMimePart(FSubParts[Index]);
+end;
+
+{==============================================================================}
+
+procedure TMIMEPart.DeleteSubPart(index: integer);
+begin
+ if Index < GetSubPartCount then
+ begin
+ GetSubPart(Index).Free;
+ FSubParts.Delete(Index);
+ end;
+end;
+
+{==============================================================================}
+
+procedure TMIMEPart.ClearSubParts;
+var
+ n: integer;
+begin
+ for n := 0 to GetSubPartCount - 1 do
+ TMimePart(FSubParts[n]).Free;
+ FSubParts.Clear;
+end;
+
+{==============================================================================}
+
+function TMIMEPart.AddSubPart: TMimePart;
+begin
+ Result := TMimePart.Create;
+ Result.DefaultCharset := FDefaultCharset;
+ FSubParts.Add(Result);
+ Result.SubLevel := FSubLevel + 1;
+ Result.MaxSubLevel := FMaxSubLevel;
+end;
+
+{==============================================================================}
+
+procedure TMIMEPart.DecomposeParts;
+var
+ x: integer;
+ s: string;
+ Mime: TMimePart;
+
+ procedure SkipEmpty;
+ begin
+ while FLines.Count > x do
+ begin
+ s := TrimRight(FLines[x]);
+ if s <> '' then
+ Break;
+ Inc(x);
+ end;
+ end;
+
+begin
+ FBinaryDecomposer := false;
+ x := 0;
+ Clear;
+ //extract headers
+ while FLines.Count > x do
+ begin
+ s := NormalizeHeader(FLines, x);
+ if s = '' then
+ Break;
+ FHeaders.Add(s);
+ end;
+ DecodePartHeader;
+ //extract prepart
+ if FPrimaryCode = MP_MULTIPART then
+ begin
+ while FLines.Count > x do
+ begin
+ s := FLines[x];
+ Inc(x);
+ if TrimRight(s) = '--' + FBoundary then
+ Break;
+ FPrePart.Add(s);
+ if not FAttachInside then
+ FAttachInside := IsUUcode(s);
+ end;
+ end;
+ //extract body part
+ if FPrimaryCode = MP_MULTIPART then
+ begin
+ repeat
+ if CanSubPart then
+ begin
+ Mime := AddSubPart;
+ while FLines.Count > x do
+ begin
+ s := FLines[x];
+ Inc(x);
+ if Pos('--' + FBoundary, s) = 1 then
+ Break;
+ Mime.Lines.Add(s);
+ end;
+ Mime.DecomposeParts;
+ end
+ else
+ begin
+ s := FLines[x];
+ Inc(x);
+ FPartBody.Add(s);
+ end;
+ if x >= FLines.Count then
+ break;
+ until s = '--' + FBoundary + '--';
+ end;
+ if (FPrimaryCode = MP_MESSAGE) and CanSubPart then
+ begin
+ Mime := AddSubPart;
+ SkipEmpty;
+ while FLines.Count > x do
+ begin
+ s := TrimRight(FLines[x]);
+ Inc(x);
+ Mime.Lines.Add(s);
+ end;
+ Mime.DecomposeParts;
+ end
+ else
+ begin
+ while FLines.Count > x do
+ begin
+ s := FLines[x];
+ Inc(x);
+ FPartBody.Add(s);
+ if not FAttachInside then
+ FAttachInside := IsUUcode(s);
+ end;
+ end;
+ //extract postpart
+ if FPrimaryCode = MP_MULTIPART then
+ begin
+ while FLines.Count > x do
+ begin
+ s := TrimRight(FLines[x]);
+ Inc(x);
+ FPostPart.Add(s);
+ if not FAttachInside then
+ FAttachInside := IsUUcode(s);
+ end;
+ end;
+end;
+
+procedure TMIMEPart.DecomposePartsBinary(AHeader:TStrings; AStx,AEtx:PANSIChar);
+var
+ x: integer;
+ s: ANSIString;
+ Mime: TMimePart;
+ BOP: PANSIChar; // Beginning of Part
+ EOP: PANSIChar; // End of Part
+
+ function ___HasUUCode(ALines:TStrings): boolean;
+ var
+ x: integer;
+ begin
+ Result := FALSE;
+ for x:=0 to ALines.Count-1 do
+ if IsUUcode(ALInes[x]) then
+ begin
+ Result := TRUE;
+ exit;
+ end;
+ end;
+
+begin
+ FBinaryDecomposer := true;
+ Clear;
+ // Parse passed headers (THTTPSend returns HTTP headers and body separately)
+ x := 0;
+ while x 0 then
+ x := d1
+ else
+ if d3 > 0 then
+ x := d3
+ else
+ x := d2 - 1;
+ t := Copy(s, 1, x);
+ Delete(s, 1, x);
+ end;
+ Flines.Add(t);
+ until s = '';
+ end;
+
+ Flines.Add('');
+ //add body
+ //if multipart
+ if FPrimaryCode = MP_MULTIPART then
+ begin
+ Flines.AddStrings(FPrePart);
+ for n := 0 to GetSubPartCount - 1 do
+ begin
+ Flines.Add('--' + FBoundary);
+ mime := GetSubPart(n);
+ mime.ComposeParts;
+ FLines.AddStrings(mime.Lines);
+ end;
+ Flines.Add('--' + FBoundary + '--');
+ Flines.AddStrings(FPostPart);
+ end;
+ //if message
+ if FPrimaryCode = MP_MESSAGE then
+ begin
+ if GetSubPartCount > 0 then
+ begin
+ mime := GetSubPart(0);
+ mime.ComposeParts;
+ FLines.AddStrings(mime.Lines);
+ end;
+ end
+ else
+ //if normal part
+ begin
+ FLines.AddStrings(FPartBody);
+ end;
+end;
+
+{==============================================================================}
+
+procedure TMIMEPart.DecodePart;
+var
+ n: Integer;
+ s, t, t2: string;
+ b: Boolean;
+begin
+ FDecodedLines.Clear;
+ {pf}
+ // The part decomposer passes data via TStringList which appends trailing line
+ // break inherently. But in a case of native 8-bit data transferred withouth
+ // encoding (default e.g. for HTTP protocol), the redundant line terminators
+ // has to be removed
+ if FBinaryDecomposer and (FPartBody.Count=1) then
+ begin
+ case FEncodingCode of
+ ME_QUOTED_PRINTABLE:
+ s := DecodeQuotedPrintable(FPartBody[0]);
+ ME_BASE64:
+ s := DecodeBase64(FPartBody[0]);
+ ME_UU, ME_XX:
+ begin
+ s := '';
+ for n := 0 to FPartBody.Count - 1 do
+ if FEncodingCode = ME_UU then
+ s := s + DecodeUU(FPartBody[n])
+ else
+ s := s + DecodeXX(FPartBody[n]);
+ end;
+ else
+ s := FPartBody[0];
+ end;
+ end
+ else
+ {/pf}
+ case FEncodingCode of
+ ME_QUOTED_PRINTABLE:
+ s := DecodeQuotedPrintable(FPartBody.Text);
+ ME_BASE64:
+ s := DecodeBase64(FPartBody.Text);
+ ME_UU, ME_XX:
+ begin
+ s := '';
+ for n := 0 to FPartBody.Count - 1 do
+ if FEncodingCode = ME_UU then
+ s := s + DecodeUU(FPartBody[n])
+ else
+ s := s + DecodeXX(FPartBody[n]);
+ end;
+ else
+ s := FPartBody.Text;
+ end;
+ if FConvertCharset and (FPrimaryCode = MP_TEXT) then
+ if (not FForcedHTMLConvert) and (uppercase(FSecondary) = 'HTML') then
+ begin
+ b := false;
+ t2 := uppercase(s);
+ t := SeparateLeft(t2, '');
+ if length(t) <> length(s) then
+ begin
+ t := SeparateRight(t, '');
+ t := ReplaceString(t, '"', '');
+ t := ReplaceString(t, ' ', '');
+ b := Pos('HTTP-EQUIV=CONTENT-TYPE', t) > 0;
+ end;
+ //workaround for shitty M$ Outlook 11 which is placing this information
+ //outside section
+ if not b then
+ begin
+ t := Copy(t2, 1, 2048);
+ t := ReplaceString(t, '"', '');
+ t := ReplaceString(t, ' ', '');
+ b := Pos('HTTP-EQUIV=CONTENT-TYPE', t) > 0;
+ end;
+ if not b then
+ s := CharsetConversion(s, FCharsetCode, FTargetCharset);
+ end
+ else
+ s := CharsetConversion(s, FCharsetCode, FTargetCharset);
+ WriteStrToStream(FDecodedLines, s);
+ FDecodedLines.Seek(0, soFromBeginning);
+end;
+
+{==============================================================================}
+
+procedure TMIMEPart.DecodePartHeader;
+var
+ n: integer;
+ s, su, fn: string;
+ st, st2: string;
+begin
+ Primary := 'text';
+ FSecondary := 'plain';
+ FDescription := '';
+ Charset := FDefaultCharset;
+ FFileName := '';
+ //was 7bit before, but this is more compatible with RFC-ignorant outlook
+ Encoding := '8BIT';
+ FDisposition := '';
+ FContentID := '';
+ fn := '';
+ for n := 0 to FHeaders.Count - 1 do
+ if FHeaders[n] <> '' then
+ begin
+ s := FHeaders[n];
+ su := UpperCase(s);
+ if Pos('CONTENT-TYPE:', su) = 1 then
+ begin
+ st := Trim(SeparateRight(su, ':'));
+ st2 := Trim(SeparateLeft(st, ';'));
+ Primary := Trim(SeparateLeft(st2, '/'));
+ FSecondary := Trim(SeparateRight(st2, '/'));
+ if (FSecondary = Primary) and (Pos('/', st2) < 1) then
+ FSecondary := '';
+ case FPrimaryCode of
+ MP_TEXT:
+ begin
+ Charset := UpperCase(GetParameter(s, 'charset'));
+ FFileName := GetParameter(s, 'name');
+ end;
+ MP_MULTIPART:
+ FBoundary := GetParameter(s, 'Boundary');
+ MP_MESSAGE:
+ begin
+ end;
+ MP_BINARY:
+ FFileName := GetParameter(s, 'name');
+ end;
+ end;
+ if Pos('CONTENT-TRANSFER-ENCODING:', su) = 1 then
+ Encoding := Trim(SeparateRight(su, ':'));
+ if Pos('CONTENT-DESCRIPTION:', su) = 1 then
+ FDescription := Trim(SeparateRight(s, ':'));
+ if Pos('CONTENT-DISPOSITION:', su) = 1 then
+ begin
+ FDisposition := SeparateRight(su, ':');
+ FDisposition := Trim(SeparateLeft(FDisposition, ';'));
+ fn := GetParameter(s, 'FileName');
+ end;
+ if Pos('CONTENT-ID:', su) = 1 then
+ FContentID := Trim(SeparateRight(s, ':'));
+ end;
+ if fn <> '' then
+ FFileName := fn;
+ FFileName := InlineDecode(FFileName, FTargetCharset);
+ FFileName := ExtractFileName(FFileName);
+end;
+
+{==============================================================================}
+
+procedure TMIMEPart.EncodePart;
+var
+ l: TStringList;
+ s, t: string;
+ n, x: Integer;
+ d1, d2: integer;
+begin
+ if (FEncodingCode = ME_UU) or (FEncodingCode = ME_XX) then
+ Encoding := 'base64';
+ l := TStringList.Create;
+ FPartBody.Clear;
+ FDecodedLines.Seek(0, soFromBeginning);
+ try
+ case FPrimaryCode of
+ MP_MULTIPART, MP_MESSAGE:
+ FPartBody.LoadFromStream(FDecodedLines);
+ MP_TEXT, MP_BINARY:
+ begin
+ s := ReadStrFromStream(FDecodedLines, FDecodedLines.Size);
+ if FConvertCharset and (FPrimaryCode = MP_TEXT) and (FEncodingCode <> ME_7BIT) then
+ s := GetBOM(FCharSetCode) + CharsetConversion(s, FTargetCharset, FCharsetCode);
+ if FEncodingCode = ME_BASE64 then
+ begin
+ x := 1;
+ while x <= length(s) do
+ begin
+ t := copy(s, x, 54);
+ x := x + length(t);
+ t := EncodeBase64(t);
+ FPartBody.Add(t);
+ end;
+ end
+ else
+ begin
+ if FPrimaryCode = MP_BINARY then
+ l.Add(s)
+ else
+ l.Text := s;
+ for n := 0 to l.Count - 1 do
+ begin
+ s := l[n];
+ if FEncodingCode = ME_QUOTED_PRINTABLE then
+ begin
+ s := EncodeQuotedPrintable(s);
+ repeat
+ if Length(s) < FMaxLineLength then
+ begin
+ t := s;
+ s := '';
+ end
+ else
+ begin
+ d1 := RPosEx('=', s, FMaxLineLength);
+ d2 := RPosEx(' ', s, FMaxLineLength);
+ if (d1 = 0) and (d2 = 0) then
+ x := FMaxLineLength
+ else
+ if d1 > d2 then
+ x := d1 - 1
+ else
+ x := d2 - 1;
+ if x = 0 then
+ x := FMaxLineLength;
+ t := Copy(s, 1, x);
+ Delete(s, 1, x);
+ if s <> '' then
+ t := t + '=';
+ end;
+ FPartBody.Add(t);
+ until s = '';
+ end
+ else
+ FPartBody.Add(s);
+ end;
+ if (FPrimaryCode = MP_BINARY)
+ and (FEncodingCode = ME_QUOTED_PRINTABLE) then
+ FPartBody[FPartBody.Count - 1] := FPartBody[FPartBody.Count - 1] + '=';
+ end;
+ end;
+ end;
+ finally
+ l.Free;
+ end;
+end;
+
+{==============================================================================}
+
+procedure TMIMEPart.EncodePartHeader;
+var
+ s: string;
+begin
+ FHeaders.Clear;
+ if FSecondary = '' then
+ case FPrimaryCode of
+ MP_TEXT:
+ FSecondary := 'plain';
+ MP_MULTIPART:
+ FSecondary := 'mixed';
+ MP_MESSAGE:
+ FSecondary := 'rfc822';
+ MP_BINARY:
+ FSecondary := 'octet-stream';
+ end;
+ if FDescription <> '' then
+ FHeaders.Insert(0, 'Content-Description: ' + FDescription);
+ if FDisposition <> '' then
+ begin
+ s := '';
+ if FFileName <> '' then
+ s := '; FileName=' + QuoteStr(InlineCodeEx(FileName, FTargetCharset), '"');
+ FHeaders.Insert(0, 'Content-Disposition: ' + LowerCase(FDisposition) + s);
+ end;
+ if FContentID <> '' then
+ FHeaders.Insert(0, 'Content-ID: ' + FContentID);
+
+ case FEncodingCode of
+ ME_7BIT:
+ s := '7bit';
+ ME_8BIT:
+ s := '8bit';
+ ME_QUOTED_PRINTABLE:
+ s := 'Quoted-printable';
+ ME_BASE64:
+ s := 'Base64';
+ end;
+ case FPrimaryCode of
+ MP_TEXT,
+ MP_BINARY: FHeaders.Insert(0, 'Content-Transfer-Encoding: ' + s);
+ end;
+ case FPrimaryCode of
+ MP_TEXT:
+ s := FPrimary + '/' + FSecondary + '; charset=' + GetIDfromCP(FCharsetCode);
+ MP_MULTIPART:
+ s := FPrimary + '/' + FSecondary + '; boundary="' + FBoundary + '"';
+ MP_MESSAGE, MP_BINARY:
+ s := FPrimary + '/' + FSecondary;
+ end;
+ if FFileName <> '' then
+ s := s + '; name=' + QuoteStr(InlineCodeEx(FileName, FTargetCharset), '"');
+ FHeaders.Insert(0, 'Content-type: ' + s);
+end;
+
+{==============================================================================}
+
+procedure TMIMEPart.MimeTypeFromExt(Value: string);
+var
+ s: string;
+ n: Integer;
+begin
+ Primary := '';
+ FSecondary := '';
+ s := UpperCase(ExtractFileExt(Value));
+ if s = '' then
+ s := UpperCase(Value);
+ s := SeparateRight(s, '.');
+ for n := 0 to MaxMimeType do
+ if MimeType[n, 0] = s then
+ begin
+ Primary := MimeType[n, 1];
+ FSecondary := MimeType[n, 2];
+ Break;
+ end;
+ if Primary = '' then
+ Primary := 'application';
+ if FSecondary = '' then
+ FSecondary := 'octet-stream';
+end;
+
+{==============================================================================}
+
+procedure TMIMEPart.WalkPart;
+var
+ n: integer;
+ m: TMimepart;
+begin
+ if assigned(OnWalkPart) then
+ begin
+ OnWalkPart(self);
+ for n := 0 to GetSubPartCount - 1 do
+ begin
+ m := GetSubPart(n);
+ m.OnWalkPart := OnWalkPart;
+ m.WalkPart;
+ end;
+ end;
+end;
+
+{==============================================================================}
+
+procedure TMIMEPart.SetPrimary(Value: string);
+var
+ s: string;
+begin
+ FPrimary := Value;
+ s := UpperCase(Value);
+ FPrimaryCode := MP_BINARY;
+ if Pos('TEXT', s) = 1 then
+ FPrimaryCode := MP_TEXT;
+ if Pos('MULTIPART', s) = 1 then
+ FPrimaryCode := MP_MULTIPART;
+ if Pos('MESSAGE', s) = 1 then
+ FPrimaryCode := MP_MESSAGE;
+end;
+
+procedure TMIMEPart.SetEncoding(Value: string);
+var
+ s: string;
+begin
+ FEncoding := Value;
+ s := UpperCase(Value);
+ FEncodingCode := ME_7BIT;
+ if Pos('8BIT', s) = 1 then
+ FEncodingCode := ME_8BIT;
+ if Pos('QUOTED-PRINTABLE', s) = 1 then
+ FEncodingCode := ME_QUOTED_PRINTABLE;
+ if Pos('BASE64', s) = 1 then
+ FEncodingCode := ME_BASE64;
+ if Pos('X-UU', s) = 1 then
+ FEncodingCode := ME_UU;
+ if Pos('X-XX', s) = 1 then
+ FEncodingCode := ME_XX;
+end;
+
+procedure TMIMEPart.SetCharset(Value: string);
+begin
+ if value <> '' then
+ begin
+ FCharset := Value;
+ FCharsetCode := GetCPFromID(Value);
+ end;
+end;
+
+function TMIMEPart.CanSubPart: boolean;
+begin
+ Result := True;
+ if FMaxSubLevel <> -1 then
+ Result := FMaxSubLevel > FSubLevel;
+end;
+
+function TMIMEPart.IsUUcode(Value: string): boolean;
+begin
+ Value := UpperCase(Value);
+ Result := (pos('BEGIN ', Value) = 1) and (Trim(SeparateRight(Value, ' ')) <> '');
+end;
+
+{==============================================================================}
+
+function GenerateBoundary: string;
+var
+ x, y: Integer;
+begin
+ y := GetTick;
+ x := y;
+ while TickDelta(y, x) = 0 do
+ begin
+ Sleep(1);
+ x := GetTick;
+ end;
+ Randomize;
+ y := Random(MaxInt);
+ Result := IntToHex(x, 8) + '_' + IntToHex(y, 8) + '_Synapse_boundary';
+end;
+
+end.
ADDED lib/synapse/source/lib/nntpsend.pas
Index: lib/synapse/source/lib/nntpsend.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/lib/nntpsend.pas
@@ -0,0 +1,483 @@
+{==============================================================================|
+| Project : Ararat Synapse | 001.005.003 |
+|==============================================================================|
+| Content: NNTP client |
+|==============================================================================|
+| Copyright (c)1999-2011, Lukas Gebauer |
+| All rights reserved. |
+| |
+| Redistribution and use in source and binary forms, with or without |
+| modification, are permitted provided that the following conditions are met: |
+| |
+| Redistributions of source code must retain the above copyright notice, this |
+| list of conditions and the following disclaimer. |
+| |
+| Redistributions in binary form must reproduce the above copyright notice, |
+| this list of conditions and the following disclaimer in the documentation |
+| and/or other materials provided with the distribution. |
+| |
+| Neither the name of Lukas Gebauer nor the names of its contributors may |
+| be used to endorse or promote products derived from this software without |
+| specific prior written permission. |
+| |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
+| DAMAGE. |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c) 1999-2011. |
+| All Rights Reserved. |
+|==============================================================================|
+| Contributor(s): |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package |
+| (Found at URL: http://www.ararat.cz/synapse/) |
+|==============================================================================}
+
+{:@abstract(NNTP client)
+NNTP (network news transfer protocol)
+
+Used RFC: RFC-977, RFC-2980
+}
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+
+{$IFDEF UNICODE}
+ {$WARN IMPLICIT_STRING_CAST OFF}
+ {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+ {$WARN SUSPICIOUS_TYPECAST OFF}
+{$ENDIF}
+
+unit nntpsend;
+
+interface
+
+uses
+ SysUtils, Classes,
+ blcksock, synautil;
+
+const
+ cNNTPProtocol = '119';
+
+type
+
+ {:abstract(Implementation of Network News Transfer Protocol.
+
+ Note: Are you missing properties for setting Username and Password? Look to
+ parent @link(TSynaClient) object!
+
+ Are you missing properties for specify server address and port? Look to
+ parent @link(TSynaClient) too!}
+ TNNTPSend = class(TSynaClient)
+ private
+ FSock: TTCPBlockSocket;
+ FResultCode: Integer;
+ FResultString: string;
+ FData: TStringList;
+ FDataToSend: TStringList;
+ FAutoTLS: Boolean;
+ FFullSSL: Boolean;
+ FNNTPcap: TStringList;
+ function ReadResult: Integer;
+ function ReadData: boolean;
+ function SendData: boolean;
+ function Connect: Boolean;
+ public
+ constructor Create;
+ destructor Destroy; override;
+
+ {:Connects to NNTP server and begin session.}
+ function Login: Boolean;
+
+ {:Logout from NNTP server and terminate session.}
+ function Logout: Boolean;
+
+ {:By this you can call any NNTP command.}
+ function DoCommand(const Command: string): boolean;
+
+ {:by this you can call any NNTP command. This variant is used for commands
+ for download information from server.}
+ function DoCommandRead(const Command: string): boolean;
+
+ {:by this you can call any NNTP command. This variant is used for commands
+ for upload information to server.}
+ function DoCommandWrite(const Command: string): boolean;
+
+ {:Download full message to @link(data) property. Value can be number of
+ message or message-id (in brackets).}
+ function GetArticle(const Value: string): Boolean;
+
+ {:Download only body of message to @link(data) property. Value can be number
+ of message or message-id (in brackets).}
+ function GetBody(const Value: string): Boolean;
+
+ {:Download only headers of message to @link(data) property. Value can be
+ number of message or message-id (in brackets).}
+ function GetHead(const Value: string): Boolean;
+
+ {:Get message status. Value can be number of message or message-id
+ (in brackets).}
+ function GetStat(const Value: string): Boolean;
+
+ {:Select given group.}
+ function SelectGroup(const Value: string): Boolean;
+
+ {:Tell to server 'I have mesage with given message-ID.' If server need this
+ message, message is uploaded to server.}
+ function IHave(const MessID: string): Boolean;
+
+ {:Move message pointer to last item in group.}
+ function GotoLast: Boolean;
+
+ {:Move message pointer to next item in group.}
+ function GotoNext: Boolean;
+
+ {:Download to @link(data) property list of all groups on NNTP server.}
+ function ListGroups: Boolean;
+
+ {:Download to @link(data) property list of all groups created after given time.}
+ function ListNewGroups(Since: TDateTime): Boolean;
+
+ {:Download to @link(data) property list of message-ids in given group since
+ given time.}
+ function NewArticles(const Group: string; Since: TDateTime): Boolean;
+
+ {:Upload new article to server. (for new messages by you)}
+ function PostArticle: Boolean;
+
+ {:Tells to remote NNTP server 'I am not NNTP client, but I am another NNTP
+ server'.}
+ function SwitchToSlave: Boolean;
+
+ {:Call NNTP XOVER command.}
+ function Xover(xoStart, xoEnd: string): boolean;
+
+ {:Call STARTTLS command for upgrade connection to SSL/TLS mode.}
+ function StartTLS: Boolean;
+
+ {:Try to find given capability in extension list. This list is getted after
+ successful login to NNTP server. If extension capability is not found,
+ then return is empty string.}
+ function FindCap(const Value: string): string;
+
+ {:Try get list of server extensions. List is returned in @link(data) property.}
+ function ListExtensions: Boolean;
+ published
+ {:Result code number of last operation.}
+ property ResultCode: Integer read FResultCode;
+
+ {:String description of last result code from NNTP server.}
+ property ResultString: string read FResultString;
+
+ {:Readed data. (message, etc.)}
+ property Data: TStringList read FData;
+
+ {:If is set to @true, then upgrade to SSL/TLS mode after login if remote
+ server support it.}
+ property AutoTLS: Boolean read FAutoTLS Write FAutoTLS;
+
+ {:SSL/TLS mode is used from first contact to server. Servers with full
+ SSL/TLS mode usualy using non-standard TCP port!}
+ property FullSSL: Boolean read FFullSSL Write FFullSSL;
+
+ {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.}
+ property Sock: TTCPBlockSocket read FSock;
+ end;
+
+implementation
+
+constructor TNNTPSend.Create;
+begin
+ inherited Create;
+ FSock := TTCPBlockSocket.Create;
+ FSock.Owner := self;
+ FData := TStringList.Create;
+ FDataToSend := TStringList.Create;
+ FNNTPcap := TStringList.Create;
+ FSock.ConvertLineEnd := True;
+ FTimeout := 60000;
+ FTargetPort := cNNTPProtocol;
+ FAutoTLS := False;
+ FFullSSL := False;
+end;
+
+destructor TNNTPSend.Destroy;
+begin
+ FSock.Free;
+ FDataToSend.Free;
+ FData.Free;
+ FNNTPcap.Free;
+ inherited Destroy;
+end;
+
+function TNNTPSend.ReadResult: Integer;
+var
+ s: string;
+begin
+ Result := 0;
+ FData.Clear;
+ s := FSock.RecvString(FTimeout);
+ FResultString := Copy(s, 5, Length(s) - 4);
+ if FSock.LastError <> 0 then
+ Exit;
+ if Length(s) >= 3 then
+ Result := StrToIntDef(Copy(s, 1, 3), 0);
+ FResultCode := Result;
+end;
+
+function TNNTPSend.ReadData: boolean;
+var
+ s: string;
+begin
+ repeat
+ s := FSock.RecvString(FTimeout);
+ if s = '.' then
+ break;
+ if (s <> '') and (s[1] = '.') then
+ s := Copy(s, 2, Length(s) - 1);
+ FData.Add(s);
+ until FSock.LastError <> 0;
+ Result := FSock.LastError = 0;
+end;
+
+function TNNTPSend.SendData: boolean;
+var
+ s: string;
+ n: integer;
+begin
+ for n := 0 to FDataToSend.Count - 1 do
+ begin
+ s := FDataToSend[n];
+ if (s <> '') and (s[1] = '.') then
+ s := s + '.';
+ FSock.SendString(s + CRLF);
+ if FSock.LastError <> 0 then
+ break;
+ end;
+ if FDataToSend.Count = 0 then
+ FSock.SendString(CRLF);
+ if FSock.LastError = 0 then
+ FSock.SendString('.' + CRLF);
+ FDataToSend.Clear;
+ Result := FSock.LastError = 0;
+end;
+
+function TNNTPSend.Connect: Boolean;
+begin
+ FSock.CloseSocket;
+ FSock.Bind(FIPInterface, cAnyPort);
+ if FSock.LastError = 0 then
+ FSock.Connect(FTargetHost, FTargetPort);
+ if FSock.LastError = 0 then
+ if FFullSSL then
+ FSock.SSLDoConnect;
+ Result := FSock.LastError = 0;
+end;
+
+function TNNTPSend.Login: Boolean;
+begin
+ Result := False;
+ FNNTPcap.Clear;
+ if not Connect then
+ Exit;
+ Result := (ReadResult div 100) = 2;
+ if Result then
+ begin
+ ListExtensions;
+ FNNTPcap.Assign(Fdata);
+ if (not FullSSL) and FAutoTLS and (FindCap('STARTTLS') <> '') then
+ Result := StartTLS;
+ end;
+ if (FUsername <> '') and Result then
+ begin
+ FSock.SendString('AUTHINFO USER ' + FUsername + CRLF);
+ if (ReadResult div 100) = 3 then
+ begin
+ FSock.SendString('AUTHINFO PASS ' + FPassword + CRLF);
+ Result := (ReadResult div 100) = 2;
+ end;
+ end;
+end;
+
+function TNNTPSend.Logout: Boolean;
+begin
+ FSock.SendString('QUIT' + CRLF);
+ Result := (ReadResult div 100) = 2;
+ FSock.CloseSocket;
+end;
+
+function TNNTPSend.DoCommand(const Command: string): Boolean;
+begin
+ FSock.SendString(Command + CRLF);
+ Result := (ReadResult div 100) = 2;
+ Result := Result and (FSock.LastError = 0);
+end;
+
+function TNNTPSend.DoCommandRead(const Command: string): Boolean;
+begin
+ Result := DoCommand(Command);
+ if Result then
+ begin
+ Result := ReadData;
+ Result := Result and (FSock.LastError = 0);
+ end;
+end;
+
+function TNNTPSend.DoCommandWrite(const Command: string): Boolean;
+var
+ x: integer;
+begin
+ FDataToSend.Assign(FData);
+ FSock.SendString(Command + CRLF);
+ x := (ReadResult div 100);
+ if x = 3 then
+ begin
+ SendData;
+ x := (ReadResult div 100);
+ end;
+ Result := x = 2;
+ Result := Result and (FSock.LastError = 0);
+end;
+
+function TNNTPSend.GetArticle(const Value: string): Boolean;
+var
+ s: string;
+begin
+ s := 'ARTICLE';
+ if Value <> '' then
+ s := s + ' ' + Value;
+ Result := DoCommandRead(s);
+end;
+
+function TNNTPSend.GetBody(const Value: string): Boolean;
+var
+ s: string;
+begin
+ s := 'BODY';
+ if Value <> '' then
+ s := s + ' ' + Value;
+ Result := DoCommandRead(s);
+end;
+
+function TNNTPSend.GetHead(const Value: string): Boolean;
+var
+ s: string;
+begin
+ s := 'HEAD';
+ if Value <> '' then
+ s := s + ' ' + Value;
+ Result := DoCommandRead(s);
+end;
+
+function TNNTPSend.GetStat(const Value: string): Boolean;
+var
+ s: string;
+begin
+ s := 'STAT';
+ if Value <> '' then
+ s := s + ' ' + Value;
+ Result := DoCommand(s);
+end;
+
+function TNNTPSend.SelectGroup(const Value: string): Boolean;
+begin
+ Result := DoCommand('GROUP ' + Value);
+end;
+
+function TNNTPSend.IHave(const MessID: string): Boolean;
+begin
+ Result := DoCommandWrite('IHAVE ' + MessID);
+end;
+
+function TNNTPSend.GotoLast: Boolean;
+begin
+ Result := DoCommand('LAST');
+end;
+
+function TNNTPSend.GotoNext: Boolean;
+begin
+ Result := DoCommand('NEXT');
+end;
+
+function TNNTPSend.ListGroups: Boolean;
+begin
+ Result := DoCommandRead('LIST');
+end;
+
+function TNNTPSend.ListNewGroups(Since: TDateTime): Boolean;
+begin
+ Result := DoCommandRead('NEWGROUPS ' + SimpleDateTime(Since) + ' GMT');
+end;
+
+function TNNTPSend.NewArticles(const Group: string; Since: TDateTime): Boolean;
+begin
+ Result := DoCommandRead('NEWNEWS ' + Group + ' ' + SimpleDateTime(Since) + ' GMT');
+end;
+
+function TNNTPSend.PostArticle: Boolean;
+begin
+ Result := DoCommandWrite('POST');
+end;
+
+function TNNTPSend.SwitchToSlave: Boolean;
+begin
+ Result := DoCommand('SLAVE');
+end;
+
+function TNNTPSend.Xover(xoStart, xoEnd: string): Boolean;
+var
+ s: string;
+begin
+ s := 'XOVER ' + xoStart;
+ if xoEnd <> xoStart then
+ s := s + '-' + xoEnd;
+ Result := DoCommandRead(s);
+end;
+
+function TNNTPSend.StartTLS: Boolean;
+begin
+ Result := False;
+ if FindCap('STARTTLS') <> '' then
+ begin
+ if DoCommand('STARTTLS') then
+ begin
+ Fsock.SSLDoConnect;
+ Result := FSock.LastError = 0;
+ end;
+ end;
+end;
+
+function TNNTPSend.ListExtensions: Boolean;
+begin
+ Result := DoCommandRead('LIST EXTENSIONS');
+end;
+
+function TNNTPSend.FindCap(const Value: string): string;
+var
+ n: Integer;
+ s: string;
+begin
+ s := UpperCase(Value);
+ Result := '';
+ for n := 0 to FNNTPcap.Count - 1 do
+ if Pos(s, UpperCase(FNNTPcap[n])) = 1 then
+ begin
+ Result := FNNTPcap[n];
+ Break;
+ end;
+end;
+
+{==============================================================================}
+
+end.
ADDED lib/synapse/source/lib/pingsend.pas
Index: lib/synapse/source/lib/pingsend.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/lib/pingsend.pas
@@ -0,0 +1,720 @@
+{==============================================================================|
+| Project : Ararat Synapse | 004.000.002 |
+|==============================================================================|
+| Content: PING sender |
+|==============================================================================|
+| Copyright (c)1999-2010, Lukas Gebauer |
+| All rights reserved. |
+| |
+| Redistribution and use in source and binary forms, with or without |
+| modification, are permitted provided that the following conditions are met: |
+| |
+| Redistributions of source code must retain the above copyright notice, this |
+| list of conditions and the following disclaimer. |
+| |
+| Redistributions in binary form must reproduce the above copyright notice, |
+| this list of conditions and the following disclaimer in the documentation |
+| and/or other materials provided with the distribution. |
+| |
+| Neither the name of Lukas Gebauer nor the names of its contributors may |
+| be used to endorse or promote products derived from this software without |
+| specific prior written permission. |
+| |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
+| DAMAGE. |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2000-2010. |
+| All Rights Reserved. |
+|==============================================================================|
+| Contributor(s): |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package |
+| (Found at URL: http://www.ararat.cz/synapse/) |
+|==============================================================================}
+
+{:@abstract(ICMP PING implementation.)
+Allows create PING and TRACEROUTE. Or you can diagnose your network.
+
+This unit using IpHlpApi (on WinXP or higher) if available. Otherwise it trying
+ to use RAW sockets.
+
+Warning: For use of RAW sockets you must have some special rights on some
+ systems. So, it working allways when you have administator/root rights.
+ Otherwise you can have problems!
+
+Note: This unit is NOT portable to .NET!
+ Use native .NET classes for Ping instead.
+}
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+{$Q-}
+{$R-}
+{$H+}
+
+{$IFDEF CIL}
+ Sorry, this unit is not for .NET!
+{$ENDIF}
+//old Delphi does not have MSWINDOWS define.
+{$IFDEF WIN32}
+ {$IFNDEF MSWINDOWS}
+ {$DEFINE MSWINDOWS}
+ {$ENDIF}
+{$ENDIF}
+
+{$IFDEF UNICODE}
+ {$WARN IMPLICIT_STRING_CAST OFF}
+ {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+unit pingsend;
+
+interface
+
+uses
+ SysUtils,
+ synsock, blcksock, synautil, synafpc, synaip
+{$IFDEF MSWINDOWS}
+ , windows
+{$ENDIF}
+ ;
+
+const
+ ICMP_ECHO = 8;
+ ICMP_ECHOREPLY = 0;
+ ICMP_UNREACH = 3;
+ ICMP_TIME_EXCEEDED = 11;
+//rfc-2292
+ ICMP6_ECHO = 128;
+ ICMP6_ECHOREPLY = 129;
+ ICMP6_UNREACH = 1;
+ ICMP6_TIME_EXCEEDED = 3;
+
+type
+ {:List of possible ICMP reply packet types.}
+ TICMPError = (
+ IE_NoError,
+ IE_Other,
+ IE_TTLExceed,
+ IE_UnreachOther,
+ IE_UnreachRoute,
+ IE_UnreachAdmin,
+ IE_UnreachAddr,
+ IE_UnreachPort
+ );
+
+ {:@abstract(Implementation of ICMP PING and ICMPv6 PING.)}
+ TPINGSend = class(TSynaClient)
+ private
+ FSock: TICMPBlockSocket;
+ FBuffer: Ansistring;
+ FSeq: Integer;
+ FId: Integer;
+ FPacketSize: Integer;
+ FPingTime: Integer;
+ FIcmpEcho: Byte;
+ FIcmpEchoReply: Byte;
+ FIcmpUnreach: Byte;
+ FReplyFrom: string;
+ FReplyType: byte;
+ FReplyCode: byte;
+ FReplyError: TICMPError;
+ FReplyErrorDesc: string;
+ FTTL: Byte;
+ Fsin: TVarSin;
+ function Checksum(Value: AnsiString): Word;
+ function Checksum6(Value: AnsiString): Word;
+ function ReadPacket: Boolean;
+ procedure TranslateError;
+ procedure TranslateErrorIpHlp(value: integer);
+ function InternalPing(const Host: string): Boolean;
+ function InternalPingIpHlp(const Host: string): Boolean;
+ function IsHostIP6(const Host: string): Boolean;
+ procedure GenErrorDesc;
+ public
+ {:Send ICMP ping to host and count @link(pingtime). If ping OK, result is
+ @true.}
+ function Ping(const Host: string): Boolean;
+ constructor Create;
+ destructor Destroy; override;
+ published
+ {:Size of PING packet. Default size is 32 bytes.}
+ property PacketSize: Integer read FPacketSize Write FPacketSize;
+
+ {:Time between request and reply.}
+ property PingTime: Integer read FPingTime;
+
+ {:From this address is sended reply for your PING request. It maybe not your
+ requested destination, when some error occured!}
+ property ReplyFrom: string read FReplyFrom;
+
+ {:ICMP type of PING reply. Each protocol using another values! For IPv4 and
+ IPv6 are used different values!}
+ property ReplyType: byte read FReplyType;
+
+ {:ICMP code of PING reply. Each protocol using another values! For IPv4 and
+ IPv6 are used different values! For protocol independent value look to
+ @link(ReplyError)}
+ property ReplyCode: byte read FReplyCode;
+
+ {:Return type of returned ICMP message. This value is independent on used
+ protocol!}
+ property ReplyError: TICMPError read FReplyError;
+
+ {:Return human readable description of returned packet type.}
+ property ReplyErrorDesc: string read FReplyErrorDesc;
+
+ {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.}
+ property Sock: TICMPBlockSocket read FSock;
+
+ {:TTL value for ICMP query}
+ property TTL: byte read FTTL write FTTL;
+ end;
+
+{:A very useful function and example of its use would be found in the TPINGSend
+ object. Use it to ping to any host. If successful, returns the ping time in
+ milliseconds. Returns -1 if an error occurred.}
+function PingHost(const Host: string): Integer;
+
+{:A very useful function and example of its use would be found in the TPINGSend
+ object. Use it to TraceRoute to any host.}
+function TraceRouteHost(const Host: string): string;
+
+implementation
+
+type
+ {:Record for ICMP ECHO packet header.}
+ TIcmpEchoHeader = packed record
+ i_type: Byte;
+ i_code: Byte;
+ i_checkSum: Word;
+ i_Id: Word;
+ i_seq: Word;
+ TimeStamp: integer;
+ end;
+
+ {:record used internally by TPingSend for compute checksum of ICMPv6 packet
+ pseudoheader.}
+ TICMP6Packet = packed record
+ in_source: TInAddr6;
+ in_dest: TInAddr6;
+ Length: integer;
+ free0: Byte;
+ free1: Byte;
+ free2: Byte;
+ proto: Byte;
+ end;
+
+{$IFDEF MSWINDOWS}
+const
+ DLLIcmpName = 'iphlpapi.dll';
+type
+ TIP_OPTION_INFORMATION = record
+ TTL: Byte;
+ TOS: Byte;
+ Flags: Byte;
+ OptionsSize: Byte;
+ OptionsData: PAnsiChar;
+ end;
+ PIP_OPTION_INFORMATION = ^TIP_OPTION_INFORMATION;
+
+ TICMP_ECHO_REPLY = record
+ Address: TInAddr;
+ Status: integer;
+ RoundTripTime: integer;
+ DataSize: Word;
+ Reserved: Word;
+ Data: pointer;
+ Options: TIP_OPTION_INFORMATION;
+ end;
+ PICMP_ECHO_REPLY = ^TICMP_ECHO_REPLY;
+
+ TICMPV6_ECHO_REPLY = record
+ Address: TSockAddrIn6;
+ Status: integer;
+ RoundTripTime: integer;
+ end;
+ PICMPV6_ECHO_REPLY = ^TICMPV6_ECHO_REPLY;
+
+ TIcmpCreateFile = function: integer; stdcall;
+ TIcmpCloseHandle = function(handle: integer): boolean; stdcall;
+ TIcmpSendEcho2 = function(handle: integer; Event: pointer; ApcRoutine: pointer;
+ ApcContext: pointer; DestinationAddress: TInAddr; RequestData: pointer;
+ RequestSize: integer; RequestOptions: PIP_OPTION_INFORMATION;
+ ReplyBuffer: pointer; ReplySize: integer; Timeout: Integer): integer; stdcall;
+ TIcmp6CreateFile = function: integer; stdcall;
+ TIcmp6SendEcho2 = function(handle: integer; Event: pointer; ApcRoutine: pointer;
+ ApcContext: pointer; SourceAddress: PSockAddrIn6; DestinationAddress: PSockAddrIn6;
+ RequestData: pointer; RequestSize: integer; RequestOptions: PIP_OPTION_INFORMATION;
+ ReplyBuffer: pointer; ReplySize: integer; Timeout: Integer): integer; stdcall;
+
+var
+ IcmpDllHandle: TLibHandle = 0;
+ IcmpHelper4: boolean = false;
+ IcmpHelper6: boolean = false;
+ IcmpCreateFile: TIcmpCreateFile = nil;
+ IcmpCloseHandle: TIcmpCloseHandle = nil;
+ IcmpSendEcho2: TIcmpSendEcho2 = nil;
+ Icmp6CreateFile: TIcmp6CreateFile = nil;
+ Icmp6SendEcho2: TIcmp6SendEcho2 = nil;
+{$ENDIF}
+{==============================================================================}
+
+constructor TPINGSend.Create;
+begin
+ inherited Create;
+ FSock := TICMPBlockSocket.Create;
+ FSock.Owner := self;
+ FTimeout := 5000;
+ FPacketSize := 32;
+ FSeq := 0;
+ Randomize;
+ FTTL := 128;
+end;
+
+destructor TPINGSend.Destroy;
+begin
+ FSock.Free;
+ inherited Destroy;
+end;
+
+function TPINGSend.ReadPacket: Boolean;
+begin
+ FBuffer := FSock.RecvPacket(Ftimeout);
+ Result := FSock.LastError = 0;
+end;
+
+procedure TPINGSend.GenErrorDesc;
+begin
+ case FReplyError of
+ IE_NoError:
+ FReplyErrorDesc := '';
+ IE_Other:
+ FReplyErrorDesc := 'Unknown error';
+ IE_TTLExceed:
+ FReplyErrorDesc := 'TTL Exceeded';
+ IE_UnreachOther:
+ FReplyErrorDesc := 'Unknown unreachable';
+ IE_UnreachRoute:
+ FReplyErrorDesc := 'No route to destination';
+ IE_UnreachAdmin:
+ FReplyErrorDesc := 'Administratively prohibited';
+ IE_UnreachAddr:
+ FReplyErrorDesc := 'Address unreachable';
+ IE_UnreachPort:
+ FReplyErrorDesc := 'Port unreachable';
+ end;
+end;
+
+function TPINGSend.IsHostIP6(const Host: string): Boolean;
+var
+ f: integer;
+begin
+ f := AF_UNSPEC;
+ if IsIp(Host) then
+ f := AF_INET
+ else
+ if IsIp6(Host) then
+ f := AF_INET6;
+ synsock.SetVarSin(Fsin, host, '0', f,
+ IPPROTO_UDP, SOCK_DGRAM, Fsock.PreferIP4);
+ result := Fsin.sin_family = AF_INET6;
+end;
+
+function TPINGSend.Ping(const Host: string): Boolean;
+var
+ b: boolean;
+begin
+ FPingTime := -1;
+ FReplyFrom := '';
+ FReplyType := 0;
+ FReplyCode := 0;
+ FReplyError := IE_Other;
+ GenErrorDesc;
+ FBuffer := StringOfChar(#55, SizeOf(TICMPEchoHeader) + FPacketSize);
+{$IFDEF MSWINDOWS}
+ b := IsHostIP6(host);
+ if not(b) and IcmpHelper4 then
+ result := InternalPingIpHlp(host)
+ else
+ if b and IcmpHelper6 then
+ result := InternalPingIpHlp(host)
+ else
+ result := InternalPing(host);
+{$ELSE}
+ result := InternalPing(host);
+{$ENDIF}
+end;
+
+function TPINGSend.InternalPing(const Host: string): Boolean;
+var
+ IPHeadPtr: ^TIPHeader;
+ IpHdrLen: Integer;
+ IcmpEchoHeaderPtr: ^TICMPEchoHeader;
+ t: Boolean;
+ x: cardinal;
+ IcmpReqHead: string;
+begin
+ Result := False;
+ FSock.TTL := FTTL;
+ FSock.Bind(FIPInterface, cAnyPort);
+ FSock.Connect(Host, '0');
+ if FSock.LastError <> 0 then
+ Exit;
+ FSock.SizeRecvBuffer := 60 * 1024;
+ if FSock.IP6used then
+ begin
+ FIcmpEcho := ICMP6_ECHO;
+ FIcmpEchoReply := ICMP6_ECHOREPLY;
+ FIcmpUnreach := ICMP6_UNREACH;
+ end
+ else
+ begin
+ FIcmpEcho := ICMP_ECHO;
+ FIcmpEchoReply := ICMP_ECHOREPLY;
+ FIcmpUnreach := ICMP_UNREACH;
+ end;
+ IcmpEchoHeaderPtr := Pointer(FBuffer);
+ with IcmpEchoHeaderPtr^ do
+ begin
+ i_type := FIcmpEcho;
+ i_code := 0;
+ i_CheckSum := 0;
+ FId := System.Random(32767);
+ i_Id := FId;
+ TimeStamp := GetTick;
+ Inc(FSeq);
+ i_Seq := FSeq;
+ if fSock.IP6used then
+ i_CheckSum := CheckSum6(FBuffer)
+ else
+ i_CheckSum := CheckSum(FBuffer);
+ end;
+ FSock.SendString(FBuffer);
+ // remember first 8 bytes of ICMP packet
+ IcmpReqHead := Copy(FBuffer, 1, 8);
+ x := GetTick;
+ repeat
+ t := ReadPacket;
+ if not t then
+ break;
+ if fSock.IP6used then
+ begin
+{$IFNDEF MSWINDOWS}
+ IcmpEchoHeaderPtr := Pointer(FBuffer);
+{$ELSE}
+//WinXP SP1 with networking update doing this think by another way ;-O
+// FBuffer := StringOfChar(#0, 4) + FBuffer;
+ IcmpEchoHeaderPtr := Pointer(FBuffer);
+// IcmpEchoHeaderPtr^.i_type := FIcmpEchoReply;
+{$ENDIF}
+ end
+ else
+ begin
+ IPHeadPtr := Pointer(FBuffer);
+ IpHdrLen := (IPHeadPtr^.VerLen and $0F) * 4;
+ IcmpEchoHeaderPtr := @FBuffer[IpHdrLen + 1];
+ end;
+ //check for timeout
+ if TickDelta(x, GetTick) > FTimeout then
+ begin
+ t := false;
+ Break;
+ end;
+ //it discard sometimes possible 'echoes' of previosly sended packet
+ //or other unwanted ICMP packets...
+ until (IcmpEchoHeaderPtr^.i_type <> FIcmpEcho)
+ and ((IcmpEchoHeaderPtr^.i_id = FId)
+ or (Pos(IcmpReqHead, FBuffer) > 0));
+ if t then
+ begin
+ FPingTime := TickDelta(x, GetTick);
+ FReplyFrom := FSock.GetRemoteSinIP;
+ FReplyType := IcmpEchoHeaderPtr^.i_type;
+ FReplyCode := IcmpEchoHeaderPtr^.i_code;
+ TranslateError;
+ Result := True;
+ end;
+end;
+
+function TPINGSend.Checksum(Value: AnsiString): Word;
+var
+ CkSum: integer;
+ Num, Remain: Integer;
+ n, i: Integer;
+begin
+ Num := Length(Value) div 2;
+ Remain := Length(Value) mod 2;
+ CkSum := 0;
+ i := 1;
+ for n := 0 to Num - 1 do
+ begin
+ CkSum := CkSum + Synsock.HtoNs(DecodeInt(Value, i));
+ inc(i, 2);
+ end;
+ if Remain <> 0 then
+ CkSum := CkSum + Ord(Value[Length(Value)]);
+ CkSum := (CkSum shr 16) + (CkSum and $FFFF);
+ CkSum := CkSum + (CkSum shr 16);
+ Result := Word(not CkSum);
+end;
+
+function TPINGSend.Checksum6(Value: AnsiString): Word;
+const
+ IOC_OUT = $40000000;
+ IOC_IN = $80000000;
+ IOC_INOUT = (IOC_IN or IOC_OUT);
+ IOC_WS2 = $08000000;
+ SIO_ROUTING_INTERFACE_QUERY = 20 or IOC_WS2 or IOC_INOUT;
+var
+ ICMP6Ptr: ^TICMP6Packet;
+ s: AnsiString;
+ b: integer;
+ ip6: TSockAddrIn6;
+ x: integer;
+begin
+ Result := 0;
+{$IFDEF MSWINDOWS}
+ s := StringOfChar(#0, SizeOf(TICMP6Packet)) + Value;
+ ICMP6Ptr := Pointer(s);
+ x := synsock.WSAIoctl(FSock.Socket, SIO_ROUTING_INTERFACE_QUERY,
+ @FSock.RemoteSin, SizeOf(FSock.RemoteSin),
+ @ip6, SizeOf(ip6), @b, nil, nil);
+ if x <> -1 then
+ ICMP6Ptr^.in_dest := ip6.sin6_addr
+ else
+ ICMP6Ptr^.in_dest := FSock.LocalSin.sin6_addr;
+ ICMP6Ptr^.in_source := FSock.RemoteSin.sin6_addr;
+ ICMP6Ptr^.Length := synsock.htonl(Length(Value));
+ ICMP6Ptr^.proto := IPPROTO_ICMPV6;
+ Result := Checksum(s);
+{$ENDIF}
+end;
+
+procedure TPINGSend.TranslateError;
+begin
+ if fSock.IP6used then
+ begin
+ case FReplyType of
+ ICMP6_ECHOREPLY:
+ FReplyError := IE_NoError;
+ ICMP6_TIME_EXCEEDED:
+ FReplyError := IE_TTLExceed;
+ ICMP6_UNREACH:
+ case FReplyCode of
+ 0:
+ FReplyError := IE_UnreachRoute;
+ 3:
+ FReplyError := IE_UnreachAddr;
+ 4:
+ FReplyError := IE_UnreachPort;
+ 1:
+ FReplyError := IE_UnreachAdmin;
+ else
+ FReplyError := IE_UnreachOther;
+ end;
+ else
+ FReplyError := IE_Other;
+ end;
+ end
+ else
+ begin
+ case FReplyType of
+ ICMP_ECHOREPLY:
+ FReplyError := IE_NoError;
+ ICMP_TIME_EXCEEDED:
+ FReplyError := IE_TTLExceed;
+ ICMP_UNREACH:
+ case FReplyCode of
+ 0:
+ FReplyError := IE_UnreachRoute;
+ 1:
+ FReplyError := IE_UnreachAddr;
+ 3:
+ FReplyError := IE_UnreachPort;
+ 13:
+ FReplyError := IE_UnreachAdmin;
+ else
+ FReplyError := IE_UnreachOther;
+ end;
+ else
+ FReplyError := IE_Other;
+ end;
+ end;
+ GenErrorDesc;
+end;
+
+procedure TPINGSend.TranslateErrorIpHlp(value: integer);
+begin
+ case value of
+ 11000, 0:
+ FReplyError := IE_NoError;
+ 11013:
+ FReplyError := IE_TTLExceed;
+ 11002:
+ FReplyError := IE_UnreachRoute;
+ 11003:
+ FReplyError := IE_UnreachAddr;
+ 11005:
+ FReplyError := IE_UnreachPort;
+ 11004:
+ FReplyError := IE_UnreachAdmin;
+ else
+ FReplyError := IE_Other;
+ end;
+ GenErrorDesc;
+end;
+
+function TPINGSend.InternalPingIpHlp(const Host: string): Boolean;
+{$IFDEF MSWINDOWS}
+var
+ PingIp6: boolean;
+ PingHandle: integer;
+ r: integer;
+ ipo: TIP_OPTION_INFORMATION;
+ RBuff: Ansistring;
+ ip4reply: PICMP_ECHO_REPLY;
+ ip6reply: PICMPV6_ECHO_REPLY;
+ ip6: TSockAddrIn6;
+begin
+ Result := False;
+ PingIp6 := Fsin.sin_family = AF_INET6;
+ if pingIp6 then
+ PingHandle := Icmp6CreateFile
+ else
+ PingHandle := IcmpCreateFile;
+ if PingHandle <> -1 then
+ begin
+ try
+ ipo.TTL := FTTL;
+ ipo.TOS := 0;
+ ipo.Flags := 0;
+ ipo.OptionsSize := 0;
+ ipo.OptionsData := nil;
+ setlength(RBuff, 4096);
+ if pingIp6 then
+ begin
+ FillChar(ip6, sizeof(ip6), 0);
+ r := Icmp6SendEcho2(PingHandle, nil, nil, nil, @ip6, @Fsin,
+ PAnsichar(FBuffer), length(FBuffer), @ipo, pAnsichar(RBuff), length(RBuff), FTimeout);
+ if r > 0 then
+ begin
+ RBuff := #0 + #0 + RBuff;
+ ip6reply := PICMPV6_ECHO_REPLY(pointer(RBuff));
+ FPingTime := ip6reply^.RoundTripTime;
+ ip6reply^.Address.sin6_family := AF_INET6;
+ FReplyFrom := GetSinIp(TVarSin(ip6reply^.Address));
+ TranslateErrorIpHlp(ip6reply^.Status);
+ Result := True;
+ end;
+ end
+ else
+ begin
+ r := IcmpSendEcho2(PingHandle, nil, nil, nil, Fsin.sin_addr,
+ PAnsichar(FBuffer), length(FBuffer), @ipo, pAnsichar(RBuff), length(RBuff), FTimeout);
+ if r > 0 then
+ begin
+ ip4reply := PICMP_ECHO_REPLY(pointer(RBuff));
+ FPingTime := ip4reply^.RoundTripTime;
+ FReplyFrom := IpToStr(swapbytes(ip4reply^.Address.S_addr));
+ TranslateErrorIpHlp(ip4reply^.Status);
+ Result := True;
+ end;
+ end
+ finally
+ IcmpCloseHandle(PingHandle);
+ end;
+ end;
+end;
+{$ELSE}
+begin
+ result := false;
+end;
+{$ENDIF}
+
+{==============================================================================}
+
+function PingHost(const Host: string): Integer;
+begin
+ with TPINGSend.Create do
+ try
+ Result := -1;
+ if Ping(Host) then
+ if ReplyError = IE_NoError then
+ Result := PingTime;
+ finally
+ Free;
+ end;
+end;
+
+function TraceRouteHost(const Host: string): string;
+var
+ Ping: TPingSend;
+ ttl : byte;
+begin
+ Result := '';
+ Ping := TPINGSend.Create;
+ try
+ ttl := 1;
+ repeat
+ ping.TTL := ttl;
+ inc(ttl);
+ if ttl > 30 then
+ Break;
+ if not ping.Ping(Host) then
+ begin
+ Result := Result + cAnyHost+ ' Timeout' + CRLF;
+ continue;
+ end;
+ if (ping.ReplyError <> IE_NoError)
+ and (ping.ReplyError <> IE_TTLExceed) then
+ begin
+ Result := Result + Ping.ReplyFrom + ' ' + Ping.ReplyErrorDesc + CRLF;
+ break;
+ end;
+ Result := Result + Ping.ReplyFrom + ' ' + IntToStr(Ping.PingTime) + CRLF;
+ until ping.ReplyError = IE_NoError;
+ finally
+ Ping.Free;
+ end;
+end;
+
+{$IFDEF MSWINDOWS}
+initialization
+begin
+ IcmpHelper4 := false;
+ IcmpHelper6 := false;
+ IcmpDllHandle := LoadLibrary(DLLIcmpName);
+ if IcmpDllHandle <> 0 then
+ begin
+ IcmpCreateFile := GetProcAddress(IcmpDLLHandle, 'IcmpCreateFile');
+ IcmpCloseHandle := GetProcAddress(IcmpDLLHandle, 'IcmpCloseHandle');
+ IcmpSendEcho2 := GetProcAddress(IcmpDLLHandle, 'IcmpSendEcho2');
+ Icmp6CreateFile := GetProcAddress(IcmpDLLHandle, 'Icmp6CreateFile');
+ Icmp6SendEcho2 := GetProcAddress(IcmpDLLHandle, 'Icmp6SendEcho2');
+ IcmpHelper4 := assigned(IcmpCreateFile)
+ and assigned(IcmpCloseHandle)
+ and assigned(IcmpSendEcho2);
+ IcmpHelper6 := assigned(Icmp6CreateFile)
+ and assigned(Icmp6SendEcho2);
+ end;
+end;
+
+finalization
+begin
+ FreeLibrary(IcmpDllHandle);
+end;
+{$ENDIF}
+
+end.
ADDED lib/synapse/source/lib/pop3send.pas
Index: lib/synapse/source/lib/pop3send.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/lib/pop3send.pas
@@ -0,0 +1,483 @@
+{==============================================================================|
+| Project : Ararat Synapse | 002.006.002 |
+|==============================================================================|
+| Content: POP3 client |
+|==============================================================================|
+| Copyright (c)1999-2010, Lukas Gebauer |
+| All rights reserved. |
+| |
+| Redistribution and use in source and binary forms, with or without |
+| modification, are permitted provided that the following conditions are met: |
+| |
+| Redistributions of source code must retain the above copyright notice, this |
+| list of conditions and the following disclaimer. |
+| |
+| Redistributions in binary form must reproduce the above copyright notice, |
+| this list of conditions and the following disclaimer in the documentation |
+| and/or other materials provided with the distribution. |
+| |
+| Neither the name of Lukas Gebauer nor the names of its contributors may |
+| be used to endorse or promote products derived from this software without |
+| specific prior written permission. |
+| |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
+| DAMAGE. |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2001-2010. |
+| All Rights Reserved. |
+|==============================================================================|
+| Contributor(s): |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package |
+| (Found at URL: http://www.ararat.cz/synapse/) |
+|==============================================================================}
+
+{:@abstract(POP3 protocol client)
+
+Used RFC: RFC-1734, RFC-1939, RFC-2195, RFC-2449, RFC-2595
+}
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+{$M+}
+
+{$IFDEF UNICODE}
+ {$WARN IMPLICIT_STRING_CAST OFF}
+ {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+unit pop3send;
+
+interface
+
+uses
+ SysUtils, Classes,
+ blcksock, synautil, synacode;
+
+const
+ cPop3Protocol = '110';
+
+type
+
+ {:The three types of possible authorization methods for "logging in" to a POP3
+ server.}
+ TPOP3AuthType = (POP3AuthAll, POP3AuthLogin, POP3AuthAPOP);
+
+ {:@abstract(Implementation of POP3 client protocol.)
+
+ Note: Are you missing properties for setting Username and Password? Look to
+ parent @link(TSynaClient) object!
+
+ Are you missing properties for specify server address and port? Look to
+ parent @link(TSynaClient) too!}
+ TPOP3Send = class(TSynaClient)
+ private
+ FSock: TTCPBlockSocket;
+ FResultCode: Integer;
+ FResultString: string;
+ FFullResult: TStringList;
+ FStatCount: Integer;
+ FStatSize: Integer;
+ FListSize: Integer;
+ FTimeStamp: string;
+ FAuthType: TPOP3AuthType;
+ FPOP3cap: TStringList;
+ FAutoTLS: Boolean;
+ FFullSSL: Boolean;
+ function ReadResult(Full: Boolean): Integer;
+ function Connect: Boolean;
+ function AuthLogin: Boolean;
+ function AuthApop: Boolean;
+ public
+ constructor Create;
+ destructor Destroy; override;
+
+ {:You can call any custom by this method. Call Command without trailing CRLF.
+ If MultiLine parameter is @true, multilined response are expected.
+ Result is @true on sucess.}
+ function CustomCommand(const Command: string; MultiLine: Boolean): boolean;
+
+ {:Call CAPA command for get POP3 server capabilites.
+ note: not all servers support this command!}
+ function Capability: Boolean;
+
+ {:Connect to remote POP3 host. If all OK, result is @true.}
+ function Login: Boolean;
+
+ {:Disconnects from POP3 server.}
+ function Logout: Boolean;
+
+ {:Send RSET command. If all OK, result is @true.}
+ function Reset: Boolean;
+
+ {:Send NOOP command. If all OK, result is @true.}
+ function NoOp: Boolean;
+
+ {:Send STAT command and fill @link(StatCount) and @link(StatSize) property.
+ If all OK, result is @true.}
+ function Stat: Boolean;
+
+ {:Send LIST command. If Value is 0, LIST is for all messages. After
+ successful operation is listing in FullResult. If all OK, result is @True.}
+ function List(Value: Integer): Boolean;
+
+ {:Send RETR command. After successful operation dowloaded message in
+ @link(FullResult). If all OK, result is @true.}
+ function Retr(Value: Integer): Boolean;
+
+ {:Send RETR command. After successful operation dowloaded message in
+ @link(Stream). If all OK, result is @true.}
+ function RetrStream(Value: Integer; Stream: TStream): Boolean;
+
+ {:Send DELE command for delete specified message. If all OK, result is @true.}
+ function Dele(Value: Integer): Boolean;
+
+ {:Send TOP command. After successful operation dowloaded headers of message
+ and maxlines count of message in @link(FullResult). If all OK, result is
+ @true.}
+ function Top(Value, Maxlines: Integer): Boolean;
+
+ {:Send UIDL command. If Value is 0, UIDL is for all messages. After
+ successful operation is listing in FullResult. If all OK, result is @True.}
+ function Uidl(Value: Integer): Boolean;
+
+ {:Call STLS command for upgrade connection to SSL/TLS mode.}
+ function StartTLS: Boolean;
+
+ {:Try to find given capabily in capabilty string returned from POP3 server
+ by CAPA command.}
+ function FindCap(const Value: string): string;
+ published
+ {:Result code of last POP3 operation. 0 - error, 1 - OK.}
+ property ResultCode: Integer read FResultCode;
+
+ {:Result string of last POP3 operation.}
+ property ResultString: string read FResultString;
+
+ {:Stringlist with full lines returned as result of POP3 operation. I.e. if
+ operation is LIST, this property is filled by list of messages. If
+ operation is RETR, this property have downloaded message.}
+ property FullResult: TStringList read FFullResult;
+
+ {:After STAT command is there count of messages in inbox.}
+ property StatCount: Integer read FStatCount;
+
+ {:After STAT command is there size of all messages in inbox.}
+ property StatSize: Integer read FStatSize;
+
+ {:After LIST 0 command size of all messages on server, After LIST x size of message x on server}
+ property ListSize: Integer read FListSize;
+
+ {:If server support this, after comnnect is in this property timestamp of
+ remote server.}
+ property TimeStamp: string read FTimeStamp;
+
+ {:Type of authorisation for login to POP3 server. Dafault is autodetect one
+ of possible authorisation. Autodetect do this:
+
+ If remote POP3 server support APOP, try login by APOP method. If APOP is
+ not supported, or if APOP login failed, try classic USER+PASS login method.}
+ property AuthType: TPOP3AuthType read FAuthType Write FAuthType;
+
+ {:If is set to @true, then upgrade to SSL/TLS mode if remote server support it.}
+ property AutoTLS: Boolean read FAutoTLS Write FAutoTLS;
+
+ {:SSL/TLS mode is used from first contact to server. Servers with full
+ SSL/TLS mode usualy using non-standard TCP port!}
+ property FullSSL: Boolean read FFullSSL Write FFullSSL;
+ {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.}
+ property Sock: TTCPBlockSocket read FSock;
+ end;
+
+implementation
+
+constructor TPOP3Send.Create;
+begin
+ inherited Create;
+ FFullResult := TStringList.Create;
+ FPOP3cap := TStringList.Create;
+ FSock := TTCPBlockSocket.Create;
+ FSock.Owner := self;
+ FSock.ConvertLineEnd := true;
+ FTimeout := 60000;
+ FTargetPort := cPop3Protocol;
+ FStatCount := 0;
+ FStatSize := 0;
+ FListSize := 0;
+ FAuthType := POP3AuthAll;
+ FAutoTLS := False;
+ FFullSSL := False;
+end;
+
+destructor TPOP3Send.Destroy;
+begin
+ FSock.Free;
+ FPOP3cap.Free;
+ FullResult.Free;
+ inherited Destroy;
+end;
+
+function TPOP3Send.ReadResult(Full: Boolean): Integer;
+var
+ s: AnsiString;
+begin
+ Result := 0;
+ FFullResult.Clear;
+ s := FSock.RecvString(FTimeout);
+ if Pos('+OK', s) = 1 then
+ Result := 1;
+ FResultString := s;
+ if Full and (Result = 1) then
+ repeat
+ s := FSock.RecvString(FTimeout);
+ if s = '.' then
+ Break;
+ if s <> '' then
+ if s[1] = '.' then
+ Delete(s, 1, 1);
+ FFullResult.Add(s);
+ until FSock.LastError <> 0;
+ if not Full and (Result = 1) then
+ FFullResult.Add(SeparateRight(FResultString, ' '));
+ if FSock.LastError <> 0 then
+ Result := 0;
+ FResultCode := Result;
+end;
+
+function TPOP3Send.CustomCommand(const Command: string; MultiLine: Boolean): boolean;
+begin
+ FSock.SendString(Command + CRLF);
+ Result := ReadResult(MultiLine) <> 0;
+end;
+
+function TPOP3Send.AuthLogin: Boolean;
+begin
+ Result := False;
+ if not CustomCommand('USER ' + FUserName, False) then
+ exit;
+ Result := CustomCommand('PASS ' + FPassword, False)
+end;
+
+function TPOP3Send.AuthAPOP: Boolean;
+var
+ s: string;
+begin
+ s := StrToHex(MD5(FTimeStamp + FPassWord));
+ Result := CustomCommand('APOP ' + FUserName + ' ' + s, False);
+end;
+
+function TPOP3Send.Connect: Boolean;
+begin
+ // Do not call this function! It is calling by LOGIN method!
+ FStatCount := 0;
+ FStatSize := 0;
+ FSock.CloseSocket;
+ FSock.LineBuffer := '';
+ FSock.Bind(FIPInterface, cAnyPort);
+ if FSock.LastError = 0 then
+ FSock.Connect(FTargetHost, FTargetPort);
+ if FSock.LastError = 0 then
+ if FFullSSL then
+ FSock.SSLDoConnect;
+ Result := FSock.LastError = 0;
+end;
+
+function TPOP3Send.Capability: Boolean;
+begin
+ FPOP3cap.Clear;
+ Result := CustomCommand('CAPA', True);
+ if Result then
+ FPOP3cap.AddStrings(FFullResult);
+end;
+
+function TPOP3Send.Login: Boolean;
+var
+ s, s1: string;
+begin
+ Result := False;
+ FTimeStamp := '';
+ if not Connect then
+ Exit;
+ if ReadResult(False) <> 1 then
+ Exit;
+ s := SeparateRight(FResultString, '<');
+ if s <> FResultString then
+ begin
+ s1 := Trim(SeparateLeft(s, '>'));
+ if s1 <> s then
+ FTimeStamp := '<' + s1 + '>';
+ end;
+ Result := False;
+ if Capability then
+ if FAutoTLS and (Findcap('STLS') <> '') then
+ if StartTLS then
+ Capability
+ else
+ begin
+ Result := False;
+ Exit;
+ end;
+ if (FTimeStamp <> '') and not (FAuthType = POP3AuthLogin) then
+ begin
+ Result := AuthApop;
+ if not Result then
+ begin
+ if not Connect then
+ Exit;
+ if ReadResult(False) <> 1 then
+ Exit;
+ end;
+ end;
+ if not Result and not (FAuthType = POP3AuthAPOP) then
+ Result := AuthLogin;
+end;
+
+function TPOP3Send.Logout: Boolean;
+begin
+ Result := CustomCommand('QUIT', False);
+ FSock.CloseSocket;
+end;
+
+function TPOP3Send.Reset: Boolean;
+begin
+ Result := CustomCommand('RSET', False);
+end;
+
+function TPOP3Send.NoOp: Boolean;
+begin
+ Result := CustomCommand('NOOP', False);
+end;
+
+function TPOP3Send.Stat: Boolean;
+var
+ s: string;
+begin
+ Result := CustomCommand('STAT', False);
+ if Result then
+ begin
+ s := SeparateRight(ResultString, '+OK ');
+ FStatCount := StrToIntDef(Trim(SeparateLeft(s, ' ')), 0);
+ FStatSize := StrToIntDef(Trim(SeparateRight(s, ' ')), 0);
+ end;
+end;
+
+function TPOP3Send.List(Value: Integer): Boolean;
+var
+ s: string;
+ n: integer;
+begin
+ if Value = 0 then
+ s := 'LIST'
+ else
+ s := 'LIST ' + IntToStr(Value);
+ Result := CustomCommand(s, Value = 0);
+ FListSize := 0;
+ if Result then
+ if Value <> 0 then
+ begin
+ s := SeparateRight(ResultString, '+OK ');
+ FListSize := StrToIntDef(SeparateLeft(SeparateRight(s, ' '), ' '), 0);
+ end
+ else
+ for n := 0 to FFullResult.Count - 1 do
+ FListSize := FListSize + StrToIntDef(SeparateLeft(SeparateRight(s, ' '), ' '), 0);
+end;
+
+function TPOP3Send.Retr(Value: Integer): Boolean;
+begin
+ Result := CustomCommand('RETR ' + IntToStr(Value), True);
+end;
+
+//based on code by Miha Vrhovnik
+function TPOP3Send.RetrStream(Value: Integer; Stream: TStream): Boolean;
+var
+ s: string;
+begin
+ Result := False;
+ FFullResult.Clear;
+ Stream.Size := 0;
+ FSock.SendString('RETR ' + IntToStr(Value) + CRLF);
+
+ s := FSock.RecvString(FTimeout);
+ if Pos('+OK', s) = 1 then
+ Result := True;
+ FResultString := s;
+ if Result then begin
+ repeat
+ s := FSock.RecvString(FTimeout);
+ if s = '.' then
+ Break;
+ if s <> '' then begin
+ if s[1] = '.' then
+ Delete(s, 1, 1);
+ end;
+ WriteStrToStream(Stream, s);
+ WriteStrToStream(Stream, CRLF);
+ until FSock.LastError <> 0;
+ end;
+
+ if Result then
+ FResultCode := 1
+ else
+ FResultCode := 0;
+end;
+
+function TPOP3Send.Dele(Value: Integer): Boolean;
+begin
+ Result := CustomCommand('DELE ' + IntToStr(Value), False);
+end;
+
+function TPOP3Send.Top(Value, Maxlines: Integer): Boolean;
+begin
+ Result := CustomCommand('TOP ' + IntToStr(Value) + ' ' + IntToStr(Maxlines), True);
+end;
+
+function TPOP3Send.Uidl(Value: Integer): Boolean;
+var
+ s: string;
+begin
+ if Value = 0 then
+ s := 'UIDL'
+ else
+ s := 'UIDL ' + IntToStr(Value);
+ Result := CustomCommand(s, Value = 0);
+end;
+
+function TPOP3Send.StartTLS: Boolean;
+begin
+ Result := False;
+ if CustomCommand('STLS', False) then
+ begin
+ Fsock.SSLDoConnect;
+ Result := FSock.LastError = 0;
+ end;
+end;
+
+function TPOP3Send.FindCap(const Value: string): string;
+var
+ n: Integer;
+ s: string;
+begin
+ s := UpperCase(Value);
+ Result := '';
+ for n := 0 to FPOP3cap.Count - 1 do
+ if Pos(s, UpperCase(FPOP3cap[n])) = 1 then
+ begin
+ Result := FPOP3cap[n];
+ Break;
+ end;
+end;
+
+end.
ADDED lib/synapse/source/lib/slogsend.pas
Index: lib/synapse/source/lib/slogsend.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/lib/slogsend.pas
@@ -0,0 +1,320 @@
+{==============================================================================|
+| Project : Ararat Synapse | 001.002.003 |
+|==============================================================================|
+| Content: SysLog client |
+|==============================================================================|
+| Copyright (c)1999-2010, Lukas Gebauer |
+| All rights reserved. |
+| |
+| Redistribution and use in source and binary forms, with or without |
+| modification, are permitted provided that the following conditions are met: |
+| |
+| Redistributions of source code must retain the above copyright notice, this |
+| list of conditions and the following disclaimer. |
+| |
+| Redistributions in binary form must reproduce the above copyright notice, |
+| this list of conditions and the following disclaimer in the documentation |
+| and/or other materials provided with the distribution. |
+| |
+| Neither the name of Lukas Gebauer nor the names of its contributors may |
+| be used to endorse or promote products derived from this software without |
+| specific prior written permission. |
+| |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
+| DAMAGE. |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2001-2010. |
+| All Rights Reserved. |
+|==============================================================================|
+| Contributor(s): |
+| Christian Brosius |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package |
+| (Found at URL: http://www.ararat.cz/synapse/) |
+|==============================================================================}
+
+{:@abstract(BSD SYSLOG protocol)
+
+Used RFC: RFC-3164
+}
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+{$Q-}
+{$H+}
+
+unit slogsend;
+
+interface
+
+uses
+ SysUtils, Classes,
+ blcksock, synautil;
+
+const
+ cSysLogProtocol = '514';
+
+ FCL_Kernel = 0;
+ FCL_UserLevel = 1;
+ FCL_MailSystem = 2;
+ FCL_System = 3;
+ FCL_Security = 4;
+ FCL_Syslogd = 5;
+ FCL_Printer = 6;
+ FCL_News = 7;
+ FCL_UUCP = 8;
+ FCL_Clock = 9;
+ FCL_Authorization = 10;
+ FCL_FTP = 11;
+ FCL_NTP = 12;
+ FCL_LogAudit = 13;
+ FCL_LogAlert = 14;
+ FCL_Time = 15;
+ FCL_Local0 = 16;
+ FCL_Local1 = 17;
+ FCL_Local2 = 18;
+ FCL_Local3 = 19;
+ FCL_Local4 = 20;
+ FCL_Local5 = 21;
+ FCL_Local6 = 22;
+ FCL_Local7 = 23;
+
+type
+ {:@abstract(Define possible priority of Syslog message)}
+ TSyslogSeverity = (Emergency, Alert, Critical, Error, Warning, Notice, Info,
+ Debug);
+
+ {:@abstract(encoding or decoding of SYSLOG message)}
+ TSyslogMessage = class(TObject)
+ private
+ FFacility:Byte;
+ FSeverity:TSyslogSeverity;
+ FDateTime:TDateTime;
+ FTag:String;
+ FMessage:String;
+ FLocalIP:String;
+ function GetPacketBuf:String;
+ procedure SetPacketBuf(Value:String);
+ public
+ {:Reset values to defaults}
+ procedure Clear;
+ published
+ {:Define facilicity of Syslog message. For specify you may use predefined
+ FCL_* constants. Default is "FCL_Local0".}
+ property Facility:Byte read FFacility write FFacility;
+
+ {:Define possible priority of Syslog message. Default is "Debug".}
+ property Severity:TSyslogSeverity read FSeverity write FSeverity;
+
+ {:date and time of Syslog message}
+ property DateTime:TDateTime read FDateTime write FDateTime;
+
+ {:This is used for identify process of this message. Default is filename
+ of your executable file.}
+ property Tag:String read FTag write FTag;
+
+ {:Text of your message for log.}
+ property LogMessage:String read FMessage write FMessage;
+
+ {:IP address of message sender.}
+ property LocalIP:String read FLocalIP write FLocalIP;
+
+ {:This property holds encoded binary SYSLOG packet}
+ property PacketBuf:String read GetPacketBuf write SetPacketBuf;
+ end;
+
+ {:@abstract(This object implement BSD SysLog client)
+
+ Note: Are you missing properties for specify server address and port? Look to
+ parent @link(TSynaClient) too!}
+ TSyslogSend = class(TSynaClient)
+ private
+ FSock: TUDPBlockSocket;
+ FSysLogMessage: TSysLogMessage;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ {:Send Syslog UDP packet defined by @link(SysLogMessage).}
+ function DoIt: Boolean;
+ published
+ {:Syslog message for send}
+ property SysLogMessage:TSysLogMessage read FSysLogMessage write FSysLogMessage;
+ end;
+
+{:Simply send packet to specified Syslog server.}
+function ToSysLog(const SyslogServer: string; Facil: Byte;
+ Sever: TSyslogSeverity; const Content: string): Boolean;
+
+implementation
+
+function TSyslogMessage.GetPacketBuf:String;
+begin
+ Result := '<' + IntToStr((FFacility * 8) + Ord(FSeverity)) + '>';
+ Result := Result + CDateTime(FDateTime) + ' ';
+ Result := Result + FLocalIP + ' ';
+ Result := Result + FTag + ': ' + FMessage;
+end;
+
+procedure TSyslogMessage.SetPacketBuf(Value:String);
+var StrBuf:String;
+ IntBuf,Pos:Integer;
+begin
+ if Length(Value) < 1 then exit;
+ Pos := 1;
+ if Value[Pos] <> '<' then exit;
+ Inc(Pos);
+ // Facility and Severity
+ StrBuf := '';
+ while (Value[Pos] <> '>')do
+ begin
+ StrBuf := StrBuf + Value[Pos];
+ Inc(Pos);
+ end;
+ IntBuf := StrToInt(StrBuf);
+ FFacility := IntBuf div 8;
+ case (IntBuf mod 8)of
+ 0:FSeverity := Emergency;
+ 1:FSeverity := Alert;
+ 2:FSeverity := Critical;
+ 3:FSeverity := Error;
+ 4:FSeverity := Warning;
+ 5:FSeverity := Notice;
+ 6:FSeverity := Info;
+ 7:FSeverity := Debug;
+ end;
+ // DateTime
+ Inc(Pos);
+ StrBuf := '';
+ // Month
+ while (Value[Pos] <> ' ')do
+ begin
+ StrBuf := StrBuf + Value[Pos];
+ Inc(Pos);
+ end;
+ StrBuf := StrBuf + Value[Pos];
+ Inc(Pos);
+ // Day
+ while (Value[Pos] <> ' ')do
+ begin
+ StrBuf := StrBuf + Value[Pos];
+ Inc(Pos);
+ end;
+ StrBuf := StrBuf + Value[Pos];
+ Inc(Pos);
+ // Time
+ while (Value[Pos] <> ' ')do
+ begin
+ StrBuf := StrBuf + Value[Pos];
+ Inc(Pos);
+ end;
+ FDateTime := DecodeRFCDateTime(StrBuf);
+ Inc(Pos);
+
+ // LocalIP
+ StrBuf := '';
+ while (Value[Pos] <> ' ')do
+ begin
+ StrBuf := StrBuf + Value[Pos];
+ Inc(Pos);
+ end;
+ FLocalIP := StrBuf;
+ Inc(Pos);
+ // Tag
+ StrBuf := '';
+ while (Value[Pos] <> ':')do
+ begin
+ StrBuf := StrBuf + Value[Pos];
+ Inc(Pos);
+ end;
+ FTag := StrBuf;
+ // LogMessage
+ Inc(Pos);
+ StrBuf := '';
+ while (Pos <= Length(Value))do
+ begin
+ StrBuf := StrBuf + Value[Pos];
+ Inc(Pos);
+ end;
+ FMessage := TrimSP(StrBuf);
+end;
+
+procedure TSysLogMessage.Clear;
+begin
+ FFacility := FCL_Local0;
+ FSeverity := Debug;
+ FTag := ExtractFileName(ParamStr(0));
+ FMessage := '';
+ FLocalIP := '0.0.0.0';
+end;
+
+//------------------------------------------------------------------------------
+
+constructor TSyslogSend.Create;
+begin
+ inherited Create;
+ FSock := TUDPBlockSocket.Create;
+ FSock.Owner := self;
+ FSysLogMessage := TSysLogMessage.Create;
+ FTargetPort := cSysLogProtocol;
+end;
+
+destructor TSyslogSend.Destroy;
+begin
+ FSock.Free;
+ FSysLogMessage.Free;
+ inherited Destroy;
+end;
+
+function TSyslogSend.DoIt: Boolean;
+var
+ L: TStringList;
+begin
+ Result := False;
+ L := TStringList.Create;
+ try
+ FSock.ResolveNameToIP(FSock.Localname, L);
+ if L.Count < 1 then
+ FSysLogMessage.LocalIP := '0.0.0.0'
+ else
+ FSysLogMessage.LocalIP := L[0];
+ finally
+ L.Free;
+ end;
+ FSysLogMessage.DateTime := Now;
+ if Length(FSysLogMessage.PacketBuf) <= 1024 then
+ begin
+ FSock.Connect(FTargetHost, FTargetPort);
+ FSock.SendString(FSysLogMessage.PacketBuf);
+ Result := FSock.LastError = 0;
+ end;
+end;
+
+{==============================================================================}
+
+function ToSysLog(const SyslogServer: string; Facil: Byte;
+ Sever: TSyslogSeverity; const Content: string): Boolean;
+begin
+ with TSyslogSend.Create do
+ try
+ TargetHost :=SyslogServer;
+ SysLogMessage.Facility := Facil;
+ SysLogMessage.Severity := Sever;
+ SysLogMessage.LogMessage := Content;
+ Result := DoIt;
+ finally
+ Free;
+ end;
+end;
+
+end.
ADDED lib/synapse/source/lib/smtpsend.pas
Index: lib/synapse/source/lib/smtpsend.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/lib/smtpsend.pas
@@ -0,0 +1,724 @@
+{==============================================================================|
+| Project : Ararat Synapse | 003.005.001 |
+|==============================================================================|
+| Content: SMTP client |
+|==============================================================================|
+| Copyright (c)1999-2010, Lukas Gebauer |
+| All rights reserved. |
+| |
+| Redistribution and use in source and binary forms, with or without |
+| modification, are permitted provided that the following conditions are met: |
+| |
+| Redistributions of source code must retain the above copyright notice, this |
+| list of conditions and the following disclaimer. |
+| |
+| Redistributions in binary form must reproduce the above copyright notice, |
+| this list of conditions and the following disclaimer in the documentation |
+| and/or other materials provided with the distribution. |
+| |
+| Neither the name of Lukas Gebauer nor the names of its contributors may |
+| be used to endorse or promote products derived from this software without |
+| specific prior written permission. |
+| |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
+| DAMAGE. |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c) 1999-2010. |
+| All Rights Reserved. |
+|==============================================================================|
+| Contributor(s): |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package |
+| (Found at URL: http://www.ararat.cz/synapse/) |
+|==============================================================================}
+
+{:@abstract(SMTP client)
+
+Used RFC: RFC-1869, RFC-1870, RFC-1893, RFC-2034, RFC-2104, RFC-2195, RFC-2487,
+ RFC-2554, RFC-2821
+}
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+
+{$IFDEF UNICODE}
+ {$WARN IMPLICIT_STRING_CAST OFF}
+ {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+unit smtpsend;
+
+interface
+
+uses
+ SysUtils, Classes,
+ blcksock, synautil, synacode;
+
+const
+ cSmtpProtocol = '25';
+
+type
+ {:@abstract(Implementation of SMTP and ESMTP procotol),
+ include some ESMTP extensions, include SSL/TLS too.
+
+ Note: Are you missing properties for setting Username and Password for ESMTP?
+ Look to parent @link(TSynaClient) object!
+
+ Are you missing properties for specify server address and port? Look to
+ parent @link(TSynaClient) too!}
+ TSMTPSend = class(TSynaClient)
+ private
+ FSock: TTCPBlockSocket;
+ FResultCode: Integer;
+ FResultString: string;
+ FFullResult: TStringList;
+ FESMTPcap: TStringList;
+ FESMTP: Boolean;
+ FAuthDone: Boolean;
+ FESMTPSize: Boolean;
+ FMaxSize: Integer;
+ FEnhCode1: Integer;
+ FEnhCode2: Integer;
+ FEnhCode3: Integer;
+ FSystemName: string;
+ FAutoTLS: Boolean;
+ FFullSSL: Boolean;
+ procedure EnhancedCode(const Value: string);
+ function ReadResult: Integer;
+ function AuthLogin: Boolean;
+ function AuthCram: Boolean;
+ function AuthPlain: Boolean;
+ function Helo: Boolean;
+ function Ehlo: Boolean;
+ function Connect: Boolean;
+ public
+ constructor Create;
+ destructor Destroy; override;
+
+ {:Connects to SMTP server (defined in @link(TSynaClient.TargetHost)) and
+ begin SMTP session. (First try ESMTP EHLO, next old HELO handshake). Parses
+ ESMTP capabilites and if you specified Username and password and remote
+ server can handle AUTH command, try login by AUTH command. Preffered login
+ method is CRAM-MD5 (if safer!). If all OK, result is @true, else result is
+ @false.}
+ function Login: Boolean;
+
+ {:Close SMTP session (QUIT command) and disconnect from SMTP server.}
+ function Logout: Boolean;
+
+ {:Send RSET SMTP command for reset SMTP session. If all OK, result is @true,
+ else result is @false.}
+ function Reset: Boolean;
+
+ {:Send NOOP SMTP command for keep SMTP session. If all OK, result is @true,
+ else result is @false.}
+ function NoOp: Boolean;
+
+ {:Send MAIL FROM SMTP command for set sender e-mail address. If sender's
+ e-mail address is empty string, transmited message is error message.
+
+ If size not 0 and remote server can handle SIZE parameter, append SIZE
+ parameter to request. If all OK, result is @true, else result is @false.}
+ function MailFrom(const Value: string; Size: Integer): Boolean;
+
+ {:Send RCPT TO SMTP command for set receiver e-mail address. It cannot be an
+ empty string. If all OK, result is @true, else result is @false.}
+ function MailTo(const Value: string): Boolean;
+
+ {:Send DATA SMTP command and transmit message data. If all OK, result is
+ @true, else result is @false.}
+ function MailData(const Value: Tstrings): Boolean;
+
+ {:Send ETRN SMTP command for start sending of remote queue for domain in
+ Value. If all OK, result is @true, else result is @false.}
+ function Etrn(const Value: string): Boolean;
+
+ {:Send VRFY SMTP command for check receiver e-mail address. It cannot be
+ an empty string. If all OK, result is @true, else result is @false.}
+ function Verify(const Value: string): Boolean;
+
+ {:Call STARTTLS command for upgrade connection to SSL/TLS mode.}
+ function StartTLS: Boolean;
+
+ {:Return string descriptive text for enhanced result codes stored in
+ @link(EnhCode1), @link(EnhCode2) and @link(EnhCode3).}
+ function EnhCodeString: string;
+
+ {:Try to find specified capability in ESMTP response.}
+ function FindCap(const Value: string): string;
+ published
+ {:result code of last SMTP command.}
+ property ResultCode: Integer read FResultCode;
+
+ {:result string of last SMTP command (begin with string representation of
+ result code).}
+ property ResultString: string read FResultString;
+
+ {:All result strings of last SMTP command (result is maybe multiline!).}
+ property FullResult: TStringList read FFullResult;
+
+ {:List of ESMTP capabilites of remote ESMTP server. (If you connect to ESMTP
+ server only!).}
+ property ESMTPcap: TStringList read FESMTPcap;
+
+ {:@TRUE if you successfuly logged to ESMTP server.}
+ property ESMTP: Boolean read FESMTP;
+
+ {:@TRUE if you successfuly pass authorisation to remote server.}
+ property AuthDone: Boolean read FAuthDone;
+
+ {:@TRUE if remote server can handle SIZE parameter.}
+ property ESMTPSize: Boolean read FESMTPSize;
+
+ {:When @link(ESMTPsize) is @TRUE, contains max length of message that remote
+ server can handle.}
+ property MaxSize: Integer read FMaxSize;
+
+ {:First digit of Enhanced result code. If last operation does not have
+ enhanced result code, values is 0.}
+ property EnhCode1: Integer read FEnhCode1;
+
+ {:Second digit of Enhanced result code. If last operation does not have
+ enhanced result code, values is 0.}
+ property EnhCode2: Integer read FEnhCode2;
+
+ {:Third digit of Enhanced result code. If last operation does not have
+ enhanced result code, values is 0.}
+ property EnhCode3: Integer read FEnhCode3;
+
+ {:name of our system used in HELO and EHLO command. Implicit value is
+ internet address of your machine.}
+ property SystemName: string read FSystemName Write FSystemName;
+
+ {:If is set to true, then upgrade to SSL/TLS mode if remote server support it.}
+ property AutoTLS: Boolean read FAutoTLS Write FAutoTLS;
+
+ {:SSL/TLS mode is used from first contact to server. Servers with full
+ SSL/TLS mode usualy using non-standard TCP port!}
+ property FullSSL: Boolean read FFullSSL Write FFullSSL;
+
+ {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.}
+ property Sock: TTCPBlockSocket read FSock;
+ end;
+
+{:A very useful function and example of its use would be found in the TSMTPsend
+ object. Send maildata (text of e-mail with all SMTP headers! For example when
+ text of message is created by @link(TMimemess) object) from "MailFrom" e-mail
+ address to "MailTo" e-mail address (If you need more then one receiver, then
+ separate their addresses by comma).
+
+ Function sends e-mail to a SMTP server defined in "SMTPhost" parameter.
+ Username and password are used for authorization to the "SMTPhost". If you
+ don't want authorization, set "Username" and "Password" to empty strings. If
+ e-mail message is successfully sent, the result returns @true.
+
+ If you need use different port number then standard, then add this port number
+ to SMTPhost after colon. (i.e. '127.0.0.1:1025')}
+function SendToRaw(const MailFrom, MailTo, SMTPHost: string;
+ const MailData: TStrings; const Username, Password: string): Boolean;
+
+{:A very useful function and example of its use would be found in the TSMTPsend
+ object. Send "Maildata" (text of e-mail without any SMTP headers!) from
+ "MailFrom" e-mail address to "MailTo" e-mail address with "Subject". (If you
+ need more then one receiver, then separate their addresses by comma).
+
+ This function constructs all needed SMTP headers (with DATE header) and sends
+ the e-mail to the SMTP server defined in the "SMTPhost" parameter. If the
+ e-mail message is successfully sent, the result will be @TRUE.
+
+ If you need use different port number then standard, then add this port number
+ to SMTPhost after colon. (i.e. '127.0.0.1:1025')}
+function SendTo(const MailFrom, MailTo, Subject, SMTPHost: string;
+ const MailData: TStrings): Boolean;
+
+{:A very useful function and example of its use would be found in the TSMTPsend
+ object. Sends "MailData" (text of e-mail without any SMTP headers!) from
+ "MailFrom" e-mail address to "MailTo" e-mail address (If you need more then one
+ receiver, then separate their addresses by comma).
+
+ This function sends the e-mail to the SMTP server defined in the "SMTPhost"
+ parameter. Username and password are used for authorization to the "SMTPhost".
+ If you dont want authorization, set "Username" and "Password" to empty Strings.
+ If the e-mail message is successfully sent, the result will be @TRUE.
+
+ If you need use different port number then standard, then add this port number
+ to SMTPhost after colon. (i.e. '127.0.0.1:1025')}
+function SendToEx(const MailFrom, MailTo, Subject, SMTPHost: string;
+ const MailData: TStrings; const Username, Password: string): Boolean;
+
+implementation
+
+constructor TSMTPSend.Create;
+begin
+ inherited Create;
+ FFullResult := TStringList.Create;
+ FESMTPcap := TStringList.Create;
+ FSock := TTCPBlockSocket.Create;
+ FSock.Owner := self;
+ FSock.ConvertLineEnd := true;
+ FTimeout := 60000;
+ FTargetPort := cSmtpProtocol;
+ FSystemName := FSock.LocalName;
+ FAutoTLS := False;
+ FFullSSL := False;
+end;
+
+destructor TSMTPSend.Destroy;
+begin
+ FSock.Free;
+ FESMTPcap.Free;
+ FFullResult.Free;
+ inherited Destroy;
+end;
+
+procedure TSMTPSend.EnhancedCode(const Value: string);
+var
+ s, t: string;
+ e1, e2, e3: Integer;
+begin
+ FEnhCode1 := 0;
+ FEnhCode2 := 0;
+ FEnhCode3 := 0;
+ s := Copy(Value, 5, Length(Value) - 4);
+ t := Trim(SeparateLeft(s, '.'));
+ s := Trim(SeparateRight(s, '.'));
+ if t = '' then
+ Exit;
+ if Length(t) > 1 then
+ Exit;
+ e1 := StrToIntDef(t, 0);
+ if e1 = 0 then
+ Exit;
+ t := Trim(SeparateLeft(s, '.'));
+ s := Trim(SeparateRight(s, '.'));
+ if t = '' then
+ Exit;
+ if Length(t) > 3 then
+ Exit;
+ e2 := StrToIntDef(t, 0);
+ t := Trim(SeparateLeft(s, ' '));
+ if t = '' then
+ Exit;
+ if Length(t) > 3 then
+ Exit;
+ e3 := StrToIntDef(t, 0);
+ FEnhCode1 := e1;
+ FEnhCode2 := e2;
+ FEnhCode3 := e3;
+end;
+
+function TSMTPSend.ReadResult: Integer;
+var
+ s: String;
+begin
+ Result := 0;
+ FFullResult.Clear;
+ repeat
+ s := FSock.RecvString(FTimeout);
+ FResultString := s;
+ FFullResult.Add(s);
+ if FSock.LastError <> 0 then
+ Break;
+ until Pos('-', s) <> 4;
+ s := FFullResult[0];
+ if Length(s) >= 3 then
+ Result := StrToIntDef(Copy(s, 1, 3), 0);
+ FResultCode := Result;
+ EnhancedCode(s);
+end;
+
+function TSMTPSend.AuthLogin: Boolean;
+begin
+ Result := False;
+ FSock.SendString('AUTH LOGIN' + CRLF);
+ if ReadResult <> 334 then
+ Exit;
+ FSock.SendString(EncodeBase64(FUsername) + CRLF);
+ if ReadResult <> 334 then
+ Exit;
+ FSock.SendString(EncodeBase64(FPassword) + CRLF);
+ Result := ReadResult = 235;
+end;
+
+function TSMTPSend.AuthCram: Boolean;
+var
+ s: ansistring;
+begin
+ Result := False;
+ FSock.SendString('AUTH CRAM-MD5' + CRLF);
+ if ReadResult <> 334 then
+ Exit;
+ s := Copy(FResultString, 5, Length(FResultString) - 4);
+ s := DecodeBase64(s);
+ s := HMAC_MD5(s, FPassword);
+ s := FUsername + ' ' + StrToHex(s);
+ FSock.SendString(EncodeBase64(s) + CRLF);
+ Result := ReadResult = 235;
+end;
+
+function TSMTPSend.AuthPlain: Boolean;
+var
+ s: ansistring;
+begin
+ s := ansichar(0) + FUsername + ansichar(0) + FPassword;
+ FSock.SendString('AUTH PLAIN ' + EncodeBase64(s) + CRLF);
+ Result := ReadResult = 235;
+end;
+
+function TSMTPSend.Connect: Boolean;
+begin
+ FSock.CloseSocket;
+ FSock.Bind(FIPInterface, cAnyPort);
+ if FSock.LastError = 0 then
+ FSock.Connect(FTargetHost, FTargetPort);
+ if FSock.LastError = 0 then
+ if FFullSSL then
+ FSock.SSLDoConnect;
+ Result := FSock.LastError = 0;
+end;
+
+function TSMTPSend.Helo: Boolean;
+var
+ x: Integer;
+begin
+ FSock.SendString('HELO ' + FSystemName + CRLF);
+ x := ReadResult;
+ Result := (x >= 250) and (x <= 259);
+end;
+
+function TSMTPSend.Ehlo: Boolean;
+var
+ x: Integer;
+begin
+ FSock.SendString('EHLO ' + FSystemName + CRLF);
+ x := ReadResult;
+ Result := (x >= 250) and (x <= 259);
+end;
+
+function TSMTPSend.Login: Boolean;
+var
+ n: Integer;
+ auths: string;
+ s: string;
+begin
+ Result := False;
+ FESMTP := True;
+ FAuthDone := False;
+ FESMTPcap.clear;
+ FESMTPSize := False;
+ FMaxSize := 0;
+ if not Connect then
+ Exit;
+ if ReadResult <> 220 then
+ Exit;
+ if not Ehlo then
+ begin
+ FESMTP := False;
+ if not Helo then
+ Exit;
+ end;
+ Result := True;
+ if FESMTP then
+ begin
+ for n := 1 to FFullResult.Count - 1 do
+ FESMTPcap.Add(Copy(FFullResult[n], 5, Length(FFullResult[n]) - 4));
+ if (not FullSSL) and FAutoTLS and (FindCap('STARTTLS') <> '') then
+ if StartTLS then
+ begin
+ Ehlo;
+ FESMTPcap.Clear;
+ for n := 1 to FFullResult.Count - 1 do
+ FESMTPcap.Add(Copy(FFullResult[n], 5, Length(FFullResult[n]) - 4));
+ end
+ else
+ begin
+ Result := False;
+ Exit;
+ end;
+ if not ((FUsername = '') and (FPassword = '')) then
+ begin
+ s := FindCap('AUTH ');
+ if s = '' then
+ s := FindCap('AUTH=');
+ auths := UpperCase(s);
+ if s <> '' then
+ begin
+ if Pos('CRAM-MD5', auths) > 0 then
+ FAuthDone := AuthCram;
+ if (not FauthDone) and (Pos('PLAIN', auths) > 0) then
+ FAuthDone := AuthPlain;
+ if (not FauthDone) and (Pos('LOGIN', auths) > 0) then
+ FAuthDone := AuthLogin;
+ end;
+ end;
+ s := FindCap('SIZE');
+ if s <> '' then
+ begin
+ FESMTPsize := True;
+ FMaxSize := StrToIntDef(Copy(s, 6, Length(s) - 5), 0);
+ end;
+ end;
+end;
+
+function TSMTPSend.Logout: Boolean;
+begin
+ FSock.SendString('QUIT' + CRLF);
+ Result := ReadResult = 221;
+ FSock.CloseSocket;
+end;
+
+function TSMTPSend.Reset: Boolean;
+begin
+ FSock.SendString('RSET' + CRLF);
+ Result := ReadResult div 100 = 2;
+end;
+
+function TSMTPSend.NoOp: Boolean;
+begin
+ FSock.SendString('NOOP' + CRLF);
+ Result := ReadResult div 100 = 2;
+end;
+
+function TSMTPSend.MailFrom(const Value: string; Size: Integer): Boolean;
+var
+ s: string;
+begin
+ s := 'MAIL FROM:<' + Value + '>';
+ if FESMTPsize and (Size > 0) then
+ s := s + ' SIZE=' + IntToStr(Size);
+ FSock.SendString(s + CRLF);
+ Result := ReadResult div 100 = 2;
+end;
+
+function TSMTPSend.MailTo(const Value: string): Boolean;
+begin
+ FSock.SendString('RCPT TO:<' + Value + '>' + CRLF);
+ Result := ReadResult div 100 = 2;
+end;
+
+function TSMTPSend.MailData(const Value: TStrings): Boolean;
+var
+ n: Integer;
+ s: string;
+ t: string;
+ x: integer;
+begin
+ Result := False;
+ FSock.SendString('DATA' + CRLF);
+ if ReadResult <> 354 then
+ Exit;
+ t := '';
+ x := 1500;
+ for n := 0 to Value.Count - 1 do
+ begin
+ s := Value[n];
+ if Length(s) >= 1 then
+ if s[1] = '.' then
+ s := '.' + s;
+ if Length(t) + Length(s) >= x then
+ begin
+ FSock.SendString(t);
+ t := '';
+ end;
+ t := t + s + CRLF;
+ end;
+ if t <> '' then
+ FSock.SendString(t);
+ FSock.SendString('.' + CRLF);
+ Result := ReadResult div 100 = 2;
+end;
+
+function TSMTPSend.Etrn(const Value: string): Boolean;
+var
+ x: Integer;
+begin
+ FSock.SendString('ETRN ' + Value + CRLF);
+ x := ReadResult;
+ Result := (x >= 250) and (x <= 259);
+end;
+
+function TSMTPSend.Verify(const Value: string): Boolean;
+var
+ x: Integer;
+begin
+ FSock.SendString('VRFY ' + Value + CRLF);
+ x := ReadResult;
+ Result := (x >= 250) and (x <= 259);
+end;
+
+function TSMTPSend.StartTLS: Boolean;
+begin
+ Result := False;
+ if FindCap('STARTTLS') <> '' then
+ begin
+ FSock.SendString('STARTTLS' + CRLF);
+ if (ReadResult = 220) and (FSock.LastError = 0) then
+ begin
+ Fsock.SSLDoConnect;
+ Result := FSock.LastError = 0;
+ end;
+ end;
+end;
+
+function TSMTPSend.EnhCodeString: string;
+var
+ s, t: string;
+begin
+ s := IntToStr(FEnhCode2) + '.' + IntToStr(FEnhCode3);
+ t := '';
+ if s = '0.0' then t := 'Other undefined Status';
+ if s = '1.0' then t := 'Other address status';
+ if s = '1.1' then t := 'Bad destination mailbox address';
+ if s = '1.2' then t := 'Bad destination system address';
+ if s = '1.3' then t := 'Bad destination mailbox address syntax';
+ if s = '1.4' then t := 'Destination mailbox address ambiguous';
+ if s = '1.5' then t := 'Destination mailbox address valid';
+ if s = '1.6' then t := 'Mailbox has moved';
+ if s = '1.7' then t := 'Bad sender''s mailbox address syntax';
+ if s = '1.8' then t := 'Bad sender''s system address';
+ if s = '2.0' then t := 'Other or undefined mailbox status';
+ if s = '2.1' then t := 'Mailbox disabled, not accepting messages';
+ if s = '2.2' then t := 'Mailbox full';
+ if s = '2.3' then t := 'Message Length exceeds administrative limit';
+ if s = '2.4' then t := 'Mailing list expansion problem';
+ if s = '3.0' then t := 'Other or undefined mail system status';
+ if s = '3.1' then t := 'Mail system full';
+ if s = '3.2' then t := 'System not accepting network messages';
+ if s = '3.3' then t := 'System not capable of selected features';
+ if s = '3.4' then t := 'Message too big for system';
+ if s = '3.5' then t := 'System incorrectly configured';
+ if s = '4.0' then t := 'Other or undefined network or routing status';
+ if s = '4.1' then t := 'No answer from host';
+ if s = '4.2' then t := 'Bad connection';
+ if s = '4.3' then t := 'Routing server failure';
+ if s = '4.4' then t := 'Unable to route';
+ if s = '4.5' then t := 'Network congestion';
+ if s = '4.6' then t := 'Routing loop detected';
+ if s = '4.7' then t := 'Delivery time expired';
+ if s = '5.0' then t := 'Other or undefined protocol status';
+ if s = '5.1' then t := 'Invalid command';
+ if s = '5.2' then t := 'Syntax error';
+ if s = '5.3' then t := 'Too many recipients';
+ if s = '5.4' then t := 'Invalid command arguments';
+ if s = '5.5' then t := 'Wrong protocol version';
+ if s = '6.0' then t := 'Other or undefined media error';
+ if s = '6.1' then t := 'Media not supported';
+ if s = '6.2' then t := 'Conversion required and prohibited';
+ if s = '6.3' then t := 'Conversion required but not supported';
+ if s = '6.4' then t := 'Conversion with loss performed';
+ if s = '6.5' then t := 'Conversion failed';
+ if s = '7.0' then t := 'Other or undefined security status';
+ if s = '7.1' then t := 'Delivery not authorized, message refused';
+ if s = '7.2' then t := 'Mailing list expansion prohibited';
+ if s = '7.3' then t := 'Security conversion required but not possible';
+ if s = '7.4' then t := 'Security features not supported';
+ if s = '7.5' then t := 'Cryptographic failure';
+ if s = '7.6' then t := 'Cryptographic algorithm not supported';
+ if s = '7.7' then t := 'Message integrity failure';
+ s := '???-';
+ if FEnhCode1 = 2 then s := 'Success-';
+ if FEnhCode1 = 4 then s := 'Persistent Transient Failure-';
+ if FEnhCode1 = 5 then s := 'Permanent Failure-';
+ Result := s + t;
+end;
+
+function TSMTPSend.FindCap(const Value: string): string;
+var
+ n: Integer;
+ s: string;
+begin
+ s := UpperCase(Value);
+ Result := '';
+ for n := 0 to FESMTPcap.Count - 1 do
+ if Pos(s, UpperCase(FESMTPcap[n])) = 1 then
+ begin
+ Result := FESMTPcap[n];
+ Break;
+ end;
+end;
+
+{==============================================================================}
+
+function SendToRaw(const MailFrom, MailTo, SMTPHost: string;
+ const MailData: TStrings; const Username, Password: string): Boolean;
+var
+ SMTP: TSMTPSend;
+ s, t: string;
+begin
+ Result := False;
+ SMTP := TSMTPSend.Create;
+ try
+// if you need SOCKS5 support, uncomment next lines:
+ // SMTP.Sock.SocksIP := '127.0.0.1';
+ // SMTP.Sock.SocksPort := '1080';
+// if you need support for upgrade session to TSL/SSL, uncomment next lines:
+ // SMTP.AutoTLS := True;
+// if you need support for TSL/SSL tunnel, uncomment next lines:
+ // SMTP.FullSSL := True;
+ SMTP.TargetHost := Trim(SeparateLeft(SMTPHost, ':'));
+ s := Trim(SeparateRight(SMTPHost, ':'));
+ if (s <> '') and (s <> SMTPHost) then
+ SMTP.TargetPort := s;
+ SMTP.Username := Username;
+ SMTP.Password := Password;
+ if SMTP.Login then
+ begin
+ if SMTP.MailFrom(GetEmailAddr(MailFrom), Length(MailData.Text)) then
+ begin
+ s := MailTo;
+ repeat
+ t := GetEmailAddr(Trim(FetchEx(s, ',', '"')));
+ if t <> '' then
+ Result := SMTP.MailTo(t);
+ if not Result then
+ Break;
+ until s = '';
+ if Result then
+ Result := SMTP.MailData(MailData);
+ end;
+ SMTP.Logout;
+ end;
+ finally
+ SMTP.Free;
+ end;
+end;
+
+function SendToEx(const MailFrom, MailTo, Subject, SMTPHost: string;
+ const MailData: TStrings; const Username, Password: string): Boolean;
+var
+ t: TStrings;
+begin
+ t := TStringList.Create;
+ try
+ t.Assign(MailData);
+ t.Insert(0, '');
+ t.Insert(0, 'X-mailer: Synapse - Delphi & Kylix TCP/IP library by Lukas Gebauer');
+ t.Insert(0, 'Subject: ' + Subject);
+ t.Insert(0, 'Date: ' + Rfc822DateTime(now));
+ t.Insert(0, 'To: ' + MailTo);
+ t.Insert(0, 'From: ' + MailFrom);
+ Result := SendToRaw(MailFrom, MailTo, SMTPHost, t, Username, Password);
+ finally
+ t.Free;
+ end;
+end;
+
+function SendTo(const MailFrom, MailTo, Subject, SMTPHost: string;
+ const MailData: TStrings): Boolean;
+begin
+ Result := SendToEx(MailFrom, MailTo, Subject, SMTPHost, MailData, '', '');
+end;
+
+end.
ADDED lib/synapse/source/lib/snmpsend.pas
Index: lib/synapse/source/lib/snmpsend.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/lib/snmpsend.pas
@@ -0,0 +1,1266 @@
+{==============================================================================|
+| Project : Ararat Synapse | 004.000.000 |
+|==============================================================================|
+| Content: SNMP client |
+|==============================================================================|
+| Copyright (c)1999-2011, Lukas Gebauer |
+| All rights reserved. |
+| |
+| Redistribution and use in source and binary forms, with or without |
+| modification, are permitted provided that the following conditions are met: |
+| |
+| Redistributions of source code must retain the above copyright notice, this |
+| list of conditions and the following disclaimer. |
+| |
+| Redistributions in binary form must reproduce the above copyright notice, |
+| this list of conditions and the following disclaimer in the documentation |
+| and/or other materials provided with the distribution. |
+| |
+| Neither the name of Lukas Gebauer nor the names of its contributors may |
+| be used to endorse or promote products derived from this software without |
+| specific prior written permission. |
+| |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
+| DAMAGE. |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2000-2011. |
+| All Rights Reserved. |
+|==============================================================================|
+| Contributor(s): |
+| Jean-Fabien Connault (cycocrew@worldnet.fr) |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package |
+| (Found at URL: http://www.ararat.cz/synapse/) |
+|==============================================================================}
+
+{:@abstract(SNMP client)
+Supports SNMPv1 include traps, SNMPv2c and SNMPv3 include authorization
+and privacy encryption.
+
+Used RFC: RFC-1157, RFC-1901, RFC-3412, RFC-3414, RFC-3416, RFC-3826
+
+Supported Authorization hashes: MD5, SHA1
+Supported Privacy encryptions: DES, 3DES, AES
+}
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+{$Q-}
+{$H+}
+
+{$IFDEF UNICODE}
+ {$WARN IMPLICIT_STRING_CAST OFF}
+ {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+unit snmpsend;
+
+interface
+
+uses
+ Classes, SysUtils,
+ blcksock, synautil, asn1util, synaip, synacode, synacrypt;
+
+const
+ cSnmpProtocol = '161';
+ cSnmpTrapProtocol = '162';
+
+ SNMP_V1 = 0;
+ SNMP_V2C = 1;
+ SNMP_V3 = 3;
+
+ //PDU type
+ PDUGetRequest = $A0;
+ PDUGetNextRequest = $A1;
+ PDUGetResponse = $A2;
+ PDUSetRequest = $A3;
+ PDUTrap = $A4; //Obsolete
+ //for SNMPv2
+ PDUGetBulkRequest = $A5;
+ PDUInformRequest = $A6;
+ PDUTrapV2 = $A7;
+ PDUReport = $A8;
+
+ //errors
+ ENoError = 0;
+ ETooBig = 1;
+ ENoSuchName = 2;
+ EBadValue = 3;
+ EReadOnly = 4;
+ EGenErr = 5;
+ //errors SNMPv2
+ ENoAccess = 6;
+ EWrongType = 7;
+ EWrongLength = 8;
+ EWrongEncoding = 9;
+ EWrongValue = 10;
+ ENoCreation = 11;
+ EInconsistentValue = 12;
+ EResourceUnavailable = 13;
+ ECommitFailed = 14;
+ EUndoFailed = 15;
+ EAuthorizationError = 16;
+ ENotWritable = 17;
+ EInconsistentName = 18;
+
+type
+
+ {:@abstract(Possible values for SNMPv3 flags.)
+ This flags specify level of authorization and encryption.}
+ TV3Flags = (
+ NoAuthNoPriv,
+ AuthNoPriv,
+ AuthPriv);
+
+ {:@abstract(Type of SNMPv3 authorization)}
+ TV3Auth = (
+ AuthMD5,
+ AuthSHA1);
+
+ {:@abstract(Type of SNMPv3 privacy)}
+ TV3Priv = (
+ PrivDES,
+ Priv3DES,
+ PrivAES);
+
+ {:@abstract(Data object with one record of MIB OID and corresponding values.)}
+ TSNMPMib = class(TObject)
+ protected
+ FOID: AnsiString;
+ FValue: AnsiString;
+ FValueType: Integer;
+ published
+ {:OID number in string format.}
+ property OID: AnsiString read FOID write FOID;
+
+ {:Value of OID object in string format.}
+ property Value: AnsiString read FValue write FValue;
+
+ {:Define type of Value. Supported values are defined in @link(asn1util).
+ For queries use ASN1_NULL, becouse you don't know type in response!}
+ property ValueType: Integer read FValueType write FValueType;
+ end;
+
+ {:@abstract(It holding all information for SNMPv3 agent synchronization)
+ Used internally.}
+ TV3Sync = record
+ EngineID: AnsiString;
+ EngineBoots: integer;
+ EngineTime: integer;
+ EngineStamp: Cardinal;
+ end;
+
+ {:@abstract(Data object abstracts SNMP data packet)}
+ TSNMPRec = class(TObject)
+ protected
+ FVersion: Integer;
+ FPDUType: Integer;
+ FID: Integer;
+ FErrorStatus: Integer;
+ FErrorIndex: Integer;
+ FCommunity: AnsiString;
+ FSNMPMibList: TList;
+ FMaxSize: Integer;
+ FFlags: TV3Flags;
+ FFlagReportable: Boolean;
+ FContextEngineID: AnsiString;
+ FContextName: AnsiString;
+ FAuthMode: TV3Auth;
+ FAuthEngineID: AnsiString;
+ FAuthEngineBoots: integer;
+ FAuthEngineTime: integer;
+ FAuthEngineTimeStamp: cardinal;
+ FUserName: AnsiString;
+ FPassword: AnsiString;
+ FAuthKey: AnsiString;
+ FPrivMode: TV3Priv;
+ FPrivPassword: AnsiString;
+ FPrivKey: AnsiString;
+ FPrivSalt: AnsiString;
+ FPrivSaltCounter: integer;
+ FOldTrapEnterprise: AnsiString;
+ FOldTrapHost: AnsiString;
+ FOldTrapGen: Integer;
+ FOldTrapSpec: Integer;
+ FOldTrapTimeTicks: Integer;
+ function Pass2Key(const Value: AnsiString): AnsiString;
+ function EncryptPDU(const value: AnsiString): AnsiString;
+ function DecryptPDU(const value: AnsiString): AnsiString;
+ public
+ constructor Create;
+ destructor Destroy; override;
+
+ {:Decode SNMP packet in buffer to object properties.}
+ function DecodeBuf(Buffer: AnsiString): Boolean;
+
+ {:Encode obeject properties to SNMP packet.}
+ function EncodeBuf: AnsiString;
+
+ {:Clears all object properties to default values.}
+ procedure Clear;
+
+ {:Add entry to @link(SNMPMibList). For queries use value as empty string,
+ and ValueType as ASN1_NULL.}
+ procedure MIBAdd(const MIB, Value: AnsiString; ValueType: Integer);
+
+ {:Delete entry from @link(SNMPMibList).}
+ procedure MIBDelete(Index: Integer);
+
+ {:Search @link(SNMPMibList) list for MIB and return correspond value.}
+ function MIBGet(const MIB: AnsiString): AnsiString;
+
+ {:return number of entries in MIB array.}
+ function MIBCount: integer;
+
+ {:Return MIB information from given row of MIB array.}
+ function MIBByIndex(Index: Integer): TSNMPMib;
+
+ {:List of @link(TSNMPMib) objects.}
+ property SNMPMibList: TList read FSNMPMibList;
+ published
+ {:Version of SNMP packet. Default value is 0 (SNMP ver. 1). You can use
+ value 1 for SNMPv2c or value 3 for SNMPv3.}
+ property Version: Integer read FVersion write FVersion;
+
+ {:Community string for autorize access to SNMP server. (Case sensitive!)
+ Community string is not used in SNMPv3! Use @link(Username) and
+ @link(password) instead!}
+ property Community: AnsiString read FCommunity write FCommunity;
+
+ {:Define type of SNMP operation.}
+ property PDUType: Integer read FPDUType write FPDUType;
+
+ {:Contains ID number. Not need to use.}
+ property ID: Integer read FID write FID;
+
+ {:When packet is reply, contains error code. Supported values are defined by
+ E* constants.}
+ property ErrorStatus: Integer read FErrorStatus write FErrorStatus;
+
+ {:Point to error position in reply packet. Not usefull for users. It only
+ good for debugging!}
+ property ErrorIndex: Integer read FErrorIndex write FErrorIndex;
+
+ {:special value for GetBulkRequest of SNMPv2 and v3.}
+ property NonRepeaters: Integer read FErrorStatus write FErrorStatus;
+
+ {:special value for GetBulkRequest of SNMPv2 and v3.}
+ property MaxRepetitions: Integer read FErrorIndex write FErrorIndex;
+
+ {:Maximum message size in bytes for SNMPv3. For sending is default 1472 bytes.}
+ property MaxSize: Integer read FMaxSize write FMaxSize;
+
+ {:Specify if message is authorised or encrypted. Used only in SNMPv3.}
+ property Flags: TV3Flags read FFlags write FFlags;
+
+ {:For SNMPv3.... If is @true, SNMP agent must send reply (at least with some
+ error).}
+ property FlagReportable: Boolean read FFlagReportable write FFlagReportable;
+
+ {:For SNMPv3. If not specified, is used value from @link(AuthEngineID)}
+ property ContextEngineID: AnsiString read FContextEngineID write FContextEngineID;
+
+ {:For SNMPv3.}
+ property ContextName: AnsiString read FContextName write FContextName;
+
+ {:For SNMPv3. Specify Authorization mode. (specify used hash for
+ authorization)}
+ property AuthMode: TV3Auth read FAuthMode write FAuthMode;
+
+ {:For SNMPv3. Specify Privacy mode.}
+ property PrivMode: TV3Priv read FPrivMode write FPrivMode;
+
+ {:value used by SNMPv3 authorisation for synchronization with SNMP agent.}
+ property AuthEngineID: AnsiString read FAuthEngineID write FAuthEngineID;
+
+ {:value used by SNMPv3 authorisation for synchronization with SNMP agent.}
+ property AuthEngineBoots: Integer read FAuthEngineBoots write FAuthEngineBoots;
+
+ {:value used by SNMPv3 authorisation for synchronization with SNMP agent.}
+ property AuthEngineTime: Integer read FAuthEngineTime write FAuthEngineTime;
+
+ {:value used by SNMPv3 authorisation for synchronization with SNMP agent.}
+ property AuthEngineTimeStamp: Cardinal read FAuthEngineTimeStamp Write FAuthEngineTimeStamp;
+
+ {:SNMPv3 authorization username}
+ property UserName: AnsiString read FUserName write FUserName;
+
+ {:SNMPv3 authorization password}
+ property Password: AnsiString read FPassword write FPassword;
+
+ {:For SNMPv3. Computed Athorization key from @link(password).}
+ property AuthKey: AnsiString read FAuthKey write FAuthKey;
+
+ {:SNMPv3 privacy password}
+ property PrivPassword: AnsiString read FPrivPassword write FPrivPassword;
+
+ {:For SNMPv3. Computed Privacy key from @link(PrivPassword).}
+ property PrivKey: AnsiString read FPrivKey write FPrivKey;
+
+ {:MIB value to identify the object that sent the TRAPv1.}
+ property OldTrapEnterprise: AnsiString read FOldTrapEnterprise write FOldTrapEnterprise;
+
+ {:Address of TRAPv1 sender (IP address).}
+ property OldTrapHost: AnsiString read FOldTrapHost write FOldTrapHost;
+
+ {:Generic TRAPv1 identification.}
+ property OldTrapGen: Integer read FOldTrapGen write FOldTrapGen;
+
+ {:Specific TRAPv1 identification.}
+ property OldTrapSpec: Integer read FOldTrapSpec write FOldTrapSpec;
+
+ {:Number of 1/100th of seconds since last reboot or power up. (for TRAPv1)}
+ property OldTrapTimeTicks: Integer read FOldTrapTimeTicks write FOldTrapTimeTicks;
+ end;
+
+ {:@abstract(Implementation of SNMP protocol.)
+
+ Note: Are you missing properties for specify server address and port? Look to
+ parent @link(TSynaClient) too!}
+ TSNMPSend = class(TSynaClient)
+ protected
+ FSock: TUDPBlockSocket;
+ FBuffer: AnsiString;
+ FHostIP: AnsiString;
+ FQuery: TSNMPRec;
+ FReply: TSNMPRec;
+ function InternalSendSnmp(const Value: TSNMPRec): Boolean;
+ function InternalRecvSnmp(const Value: TSNMPRec): Boolean;
+ function InternalSendRequest(const QValue, RValue: TSNMPRec): Boolean;
+ function GetV3EngineID: AnsiString;
+ function GetV3Sync: TV3Sync;
+ public
+ constructor Create;
+ destructor Destroy; override;
+
+ {:Connects to a Host and send there query. If in timeout SNMP server send
+ back query, result is @true. If is used SNMPv3, then it synchronize self
+ with SNMPv3 agent first. (It is needed for SNMPv3 auhorization!)}
+ function SendRequest: Boolean;
+
+ {:Send SNMP packet only, but not waits for reply. Good for sending traps.}
+ function SendTrap: Boolean;
+
+ {:Receive SNMP packet only. Good for receiving traps.}
+ function RecvTrap: Boolean;
+
+ {:Mapped to @link(SendRequest) internally. This function is only for
+ backward compatibility.}
+ function DoIt: Boolean;
+ published
+ {:contains raw binary form of SNMP packet. Good for debugging.}
+ property Buffer: AnsiString read FBuffer write FBuffer;
+
+ {:After SNMP operation hold IP address of remote side.}
+ property HostIP: AnsiString read FHostIP;
+
+ {:Data object contains SNMP query.}
+ property Query: TSNMPRec read FQuery;
+
+ {:Data object contains SNMP reply.}
+ property Reply: TSNMPRec read FReply;
+
+ {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.}
+ property Sock: TUDPBlockSocket read FSock;
+ end;
+
+{:A very useful function and example of its use would be found in the TSNMPSend
+ object. It implements basic GET method of the SNMP protocol. The MIB value is
+ located in the "OID" variable, and is sent to the requested "SNMPHost" with
+ the proper "Community" access identifier. Upon a successful retrieval, "Value"
+ will contain the information requested. If the SNMP operation is successful,
+ the result returns @true.}
+function SNMPGet(const OID, Community, SNMPHost: AnsiString; var Value: AnsiString): Boolean;
+
+{:This is useful function and example of use TSNMPSend object. It implements
+ the basic SET method of the SNMP protocol. If the SNMP operation is successful,
+ the result is @true. "Value" is value of MIB Oid for "SNMPHost" with "Community"
+ access identifier. You must specify "ValueType" too.}
+function SNMPSet(const OID, Community, SNMPHost, Value: AnsiString; ValueType: Integer): Boolean;
+
+{:A very useful function and example of its use would be found in the TSNMPSend
+ object. It implements basic GETNEXT method of the SNMP protocol. The MIB value
+ is located in the "OID" variable, and is sent to the requested "SNMPHost" with
+ the proper "Community" access identifier. Upon a successful retrieval, "Value"
+ will contain the information requested. If the SNMP operation is successful,
+ the result returns @true.}
+function SNMPGetNext(var OID: AnsiString; const Community, SNMPHost: AnsiString; var Value: AnsiString): Boolean;
+
+{:A very useful function and example of its use would be found in the TSNMPSend
+ object. It implements basic read of SNMP MIB tables. As BaseOID you must
+ specify basic MIB OID of requested table (base IOD is OID without row and
+ column specificator!)
+ Table is readed into stringlist, where each string is comma delimited string.
+
+ Warning: this function is not have best performance. For better performance
+ you must write your own function. best performace you can get by knowledge
+ of structuture of table and by more then one MIB on one query. }
+function SNMPGetTable(const BaseOID, Community, SNMPHost: AnsiString; const Value: TStrings): Boolean;
+
+{:A very useful function and example of its use would be found in the TSNMPSend
+ object. It implements basic read of SNMP MIB table element. As BaseOID you must
+ specify basic MIB OID of requested table (base IOD is OID without row and
+ column specificator!)
+ As next you must specify identificator of row and column for specify of needed
+ field of table.}
+function SNMPGetTableElement(const BaseOID, RowID, ColID, Community, SNMPHost: AnsiString; var Value: AnsiString): Boolean;
+
+{:A very useful function and example of its use would be found in the TSNMPSend
+ object. It implements a TRAPv1 to send with all data in the parameters.}
+function SendTrap(const Dest, Source, Enterprise, Community: AnsiString;
+ Generic, Specific, Seconds: Integer; const MIBName, MIBValue: AnsiString;
+ MIBtype: Integer): Integer;
+
+{:A very useful function and example of its use would be found in the TSNMPSend
+ object. It receives a TRAPv1 and returns all the data that comes with it.}
+function RecvTrap(var Dest, Source, Enterprise, Community: AnsiString;
+ var Generic, Specific, Seconds: Integer; const MIBName,
+ MIBValue: TStringList): Integer;
+
+implementation
+
+{==============================================================================}
+
+constructor TSNMPRec.Create;
+begin
+ inherited Create;
+ FSNMPMibList := TList.Create;
+ Clear;
+ FAuthMode := AuthMD5;
+ FPassword := '';
+ FPrivMode := PrivDES;
+ FPrivPassword := '';
+ FID := 1;
+ FMaxSize := 1472;
+end;
+
+destructor TSNMPRec.Destroy;
+var
+ i: Integer;
+begin
+ for i := 0 to FSNMPMibList.Count - 1 do
+ TSNMPMib(FSNMPMibList[i]).Free;
+ FSNMPMibList.Clear;
+ FSNMPMibList.Free;
+ inherited Destroy;
+end;
+
+function TSNMPRec.Pass2Key(const Value: AnsiString): AnsiString;
+var
+ key: AnsiString;
+begin
+ case FAuthMode of
+ AuthMD5:
+ begin
+ key := MD5LongHash(Value, 1048576);
+ Result := MD5(key + FAuthEngineID + key);
+ end;
+ AuthSHA1:
+ begin
+ key := SHA1LongHash(Value, 1048576);
+ Result := SHA1(key + FAuthEngineID + key);
+ end;
+ else
+ Result := '';
+ end;
+end;
+
+function TSNMPRec.DecryptPDU(const value: AnsiString): AnsiString;
+var
+ des: TSynaDes;
+ des3: TSyna3Des;
+ aes: TSynaAes;
+ s: string;
+begin
+ FPrivKey := '';
+ if FFlags <> AuthPriv then
+ Result := value
+ else
+ begin
+ case FPrivMode of
+ Priv3DES:
+ begin
+ FPrivKey := Pass2Key(FPrivPassword);
+ FPrivKey := FPrivKey + Pass2Key(FPrivKey);
+ des3 := TSyna3Des.Create(PadString(FPrivKey, 24, #0));
+ try
+ s := PadString(FPrivKey, 32, #0);
+ delete(s, 1, 24);
+ des3.SetIV(xorstring(s, FPrivSalt));
+ s := des3.DecryptCBC(value);
+ Result := s;
+ finally
+ des3.free;
+ end;
+ end;
+ PrivAES:
+ begin
+ FPrivKey := Pass2Key(FPrivPassword);
+ aes := TSynaAes.Create(PadString(FPrivKey, 16, #0));
+ try
+ s := CodeLongInt(FAuthEngineBoots) + CodeLongInt(FAuthEngineTime) + FPrivSalt;
+ aes.SetIV(s);
+ s := aes.DecryptCFBblock(value);
+ Result := s;
+ finally
+ aes.free;
+ end;
+ end;
+ else //PrivDES as default
+ begin
+ FPrivKey := Pass2Key(FPrivPassword);
+ des := TSynaDes.Create(PadString(FPrivKey, 8, #0));
+ try
+ s := PadString(FPrivKey, 16, #0);
+ delete(s, 1, 8);
+ des.SetIV(xorstring(s, FPrivSalt));
+ s := des.DecryptCBC(value);
+ Result := s;
+ finally
+ des.free;
+ end;
+ end;
+ end;
+ end;
+end;
+
+function TSNMPRec.DecodeBuf(Buffer: AnsiString): Boolean;
+var
+ Pos: Integer;
+ EndPos: Integer;
+ sm, sv: AnsiString;
+ Svt: Integer;
+ s: AnsiString;
+ Spos: integer;
+ x: Byte;
+begin
+ Clear;
+ Result := False;
+ if Length(Buffer) < 2 then
+ Exit;
+ if (Ord(Buffer[1]) and $20) = 0 then
+ Exit;
+ Pos := 2;
+ EndPos := ASNDecLen(Pos, Buffer);
+ if Length(Buffer) < (EndPos + 2) then
+ Exit;
+ Self.FVersion := StrToIntDef(ASNItem(Pos, Buffer, Svt), 0);
+
+ if FVersion = 3 then
+ begin
+ ASNItem(Pos, Buffer, Svt); //header data seq
+ ASNItem(Pos, Buffer, Svt); //ID
+ FMaxSize := StrToIntDef(ASNItem(Pos, Buffer, Svt), 0);
+ s := ASNItem(Pos, Buffer, Svt);
+ x := 0;
+ if s <> '' then
+ x := Ord(s[1]);
+ FFlagReportable := (x and 4) > 0;
+ x := x and 3;
+ case x of
+ 1:
+ FFlags := AuthNoPriv;
+ 3:
+ FFlags := AuthPriv;
+ else
+ FFlags := NoAuthNoPriv;
+ end;
+
+ x := StrToIntDef(ASNItem(Pos, Buffer, Svt), 0);
+ s := ASNItem(Pos, Buffer, Svt); //SecurityParameters
+ //if SecurityModel is USM, then try to decode SecurityParameters
+ if (x = 3) and (s <> '') then
+ begin
+ spos := 1;
+ ASNItem(SPos, s, Svt);
+ FAuthEngineID := ASNItem(SPos, s, Svt);
+ FAuthEngineBoots := StrToIntDef(ASNItem(SPos, s, Svt), 0);
+ FAuthEngineTime := StrToIntDef(ASNItem(SPos, s, Svt), 0);
+ FAuthEngineTimeStamp := GetTick;
+ FUserName := ASNItem(SPos, s, Svt);
+ FAuthKey := ASNItem(SPos, s, Svt);
+ FPrivSalt := ASNItem(SPos, s, Svt);
+ end;
+ //scopedPDU
+ if FFlags = AuthPriv then
+ begin
+ x := Pos;
+ s := ASNItem(Pos, Buffer, Svt);
+ if Svt <> ASN1_OCTSTR then
+ exit;
+ s := DecryptPDU(s);
+ //replace encoded content by decoded version and continue
+ Buffer := copy(Buffer, 1, x - 1);
+ Buffer := Buffer + s;
+ Pos := x;
+ if length(Buffer) < EndPos then
+ EndPos := length(buffer);
+ end;
+ ASNItem(Pos, Buffer, Svt); //skip sequence mark
+ FContextEngineID := ASNItem(Pos, Buffer, Svt);
+ FContextName := ASNItem(Pos, Buffer, Svt);
+ end
+ else
+ begin
+ //old packet
+ Self.FCommunity := ASNItem(Pos, Buffer, Svt);
+ end;
+
+ ASNItem(Pos, Buffer, Svt);
+ Self.FPDUType := Svt;
+ if Self.FPDUType = PDUTrap then
+ begin
+ FOldTrapEnterprise := ASNItem(Pos, Buffer, Svt);
+ FOldTrapHost := ASNItem(Pos, Buffer, Svt);
+ FOldTrapGen := StrToIntDef(ASNItem(Pos, Buffer, Svt), 0);
+ FOldTrapSpec := StrToIntDef(ASNItem(Pos, Buffer, Svt), 0);
+ FOldTrapTimeTicks := StrToIntDef(ASNItem(Pos, Buffer, Svt), 0);
+ end
+ else
+ begin
+ Self.FID := StrToIntDef(ASNItem(Pos, Buffer, Svt), 0);
+ Self.FErrorStatus := StrToIntDef(ASNItem(Pos, Buffer, Svt), 0);
+ Self.FErrorIndex := StrToIntDef(ASNItem(Pos, Buffer, Svt), 0);
+ end;
+ ASNItem(Pos, Buffer, Svt);
+ while Pos < EndPos do
+ begin
+ ASNItem(Pos, Buffer, Svt);
+ Sm := ASNItem(Pos, Buffer, Svt);
+ Sv := ASNItem(Pos, Buffer, Svt);
+ if sm <> '' then
+ Self.MIBAdd(sm, sv, Svt);
+ end;
+ Result := True;
+end;
+
+function TSNMPRec.EncryptPDU(const value: AnsiString): AnsiString;
+var
+ des: TSynaDes;
+ des3: TSyna3Des;
+ aes: TSynaAes;
+ s: string;
+ x: integer;
+begin
+ FPrivKey := '';
+ if FFlags <> AuthPriv then
+ Result := Value
+ else
+ begin
+ case FPrivMode of
+ Priv3DES:
+ begin
+ FPrivKey := Pass2Key(FPrivPassword);
+ FPrivKey := FPrivKey + Pass2Key(FPrivKey);
+ des3 := TSyna3Des.Create(PadString(FPrivKey, 24, #0));
+ try
+ s := PadString(FPrivKey, 32, #0);
+ delete(s, 1, 24);
+ FPrivSalt := CodeLongInt(FAuthEngineBoots) + CodeLongInt(FPrivSaltCounter);
+ inc(FPrivSaltCounter);
+ s := xorstring(s, FPrivSalt);
+ des3.SetIV(s);
+ x := length(value) mod 8;
+ x := 8 - x;
+ if x = 8 then
+ x := 0;
+ s := des3.EncryptCBC(value + Stringofchar(#0, x));
+ Result := ASNObject(s, ASN1_OCTSTR);
+ finally
+ des3.free;
+ end;
+ end;
+ PrivAES:
+ begin
+ FPrivKey := Pass2Key(FPrivPassword);
+ aes := TSynaAes.Create(PadString(FPrivKey, 16, #0));
+ try
+ FPrivSalt := CodeLongInt(0) + CodeLongInt(FPrivSaltCounter);
+ inc(FPrivSaltCounter);
+ s := CodeLongInt(FAuthEngineBoots) + CodeLongInt(FAuthEngineTime) + FPrivSalt;
+ aes.SetIV(s);
+ s := aes.EncryptCFBblock(value);
+ Result := ASNObject(s, ASN1_OCTSTR);
+ finally
+ aes.free;
+ end;
+ end;
+ else //PrivDES as default
+ begin
+ FPrivKey := Pass2Key(FPrivPassword);
+ des := TSynaDes.Create(PadString(FPrivKey, 8, #0));
+ try
+ s := PadString(FPrivKey, 16, #0);
+ delete(s, 1, 8);
+ FPrivSalt := CodeLongInt(FAuthEngineBoots) + CodeLongInt(FPrivSaltCounter);
+ inc(FPrivSaltCounter);
+ s := xorstring(s, FPrivSalt);
+ des.SetIV(s);
+ x := length(value) mod 8;
+ x := 8 - x;
+ if x = 8 then
+ x := 0;
+ s := des.EncryptCBC(value + Stringofchar(#0, x));
+ Result := ASNObject(s, ASN1_OCTSTR);
+ finally
+ des.free;
+ end;
+ end;
+ end;
+ end;
+end;
+
+function TSNMPRec.EncodeBuf: AnsiString;
+var
+ s: AnsiString;
+ SNMPMib: TSNMPMib;
+ n: Integer;
+ pdu, head, auth, authbeg: AnsiString;
+ x: Byte;
+begin
+ pdu := '';
+ for n := 0 to FSNMPMibList.Count - 1 do
+ begin
+ SNMPMib := TSNMPMib(FSNMPMibList[n]);
+ case SNMPMib.ValueType of
+ ASN1_INT:
+ s := ASNObject(MibToID(SNMPMib.OID), ASN1_OBJID) +
+ ASNObject(ASNEncInt(StrToIntDef(SNMPMib.Value, 0)), SNMPMib.ValueType);
+ ASN1_COUNTER, ASN1_GAUGE, ASN1_TIMETICKS:
+ s := ASNObject(MibToID(SNMPMib.OID), ASN1_OBJID) +
+ ASNObject(ASNEncUInt(StrToIntDef(SNMPMib.Value, 0)), SNMPMib.ValueType);
+ ASN1_OBJID:
+ s := ASNObject(MibToID(SNMPMib.OID), ASN1_OBJID) +
+ ASNObject(MibToID(SNMPMib.Value), SNMPMib.ValueType);
+ ASN1_IPADDR:
+ s := ASNObject(MibToID(SNMPMib.OID), ASN1_OBJID) +
+ ASNObject(IPToID(SNMPMib.Value), SNMPMib.ValueType);
+ ASN1_NULL:
+ s := ASNObject(MibToID(SNMPMib.OID), ASN1_OBJID) +
+ ASNObject('', ASN1_NULL);
+ else
+ s := ASNObject(MibToID(SNMPMib.OID), ASN1_OBJID) +
+ ASNObject(SNMPMib.Value, SNMPMib.ValueType);
+ end;
+ pdu := pdu + ASNObject(s, ASN1_SEQ);
+ end;
+ pdu := ASNObject(pdu, ASN1_SEQ);
+
+ if Self.FPDUType = PDUTrap then
+ pdu := ASNObject(MibToID(FOldTrapEnterprise), ASN1_OBJID) +
+ ASNObject(IPToID(FOldTrapHost), ASN1_IPADDR) +
+ ASNObject(ASNEncInt(FOldTrapGen), ASN1_INT) +
+ ASNObject(ASNEncInt(FOldTrapSpec), ASN1_INT) +
+ ASNObject(ASNEncUInt(FOldTrapTimeTicks), ASN1_TIMETICKS) +
+ pdu
+ else
+ pdu := ASNObject(ASNEncInt(Self.FID), ASN1_INT) +
+ ASNObject(ASNEncInt(Self.FErrorStatus), ASN1_INT) +
+ ASNObject(ASNEncInt(Self.FErrorIndex), ASN1_INT) +
+ pdu;
+ pdu := ASNObject(pdu, Self.FPDUType);
+
+ if FVersion = 3 then
+ begin
+ if FContextEngineID = '' then
+ FContextEngineID := FAuthEngineID;
+ //complete PDUv3...
+ pdu := ASNObject(FContextEngineID, ASN1_OCTSTR)
+ + ASNObject(FContextName, ASN1_OCTSTR)
+ + pdu;
+ pdu := ASNObject(pdu, ASN1_SEQ);
+ //encrypt PDU if Priv mode is enabled
+ pdu := EncryptPDU(pdu);
+
+ //prepare flags
+ case FFlags of
+ AuthNoPriv:
+ x := 1;
+ AuthPriv:
+ x := 3;
+ else
+ x := 0;
+ end;
+ if FFlagReportable then
+ x := x or 4;
+ head := ASNObject(ASNEncInt(Self.FVersion), ASN1_INT);
+ s := ASNObject(ASNEncInt(FID), ASN1_INT)
+ + ASNObject(ASNEncInt(FMaxSize), ASN1_INT)
+ + ASNObject(AnsiChar(x), ASN1_OCTSTR)
+ //encode security model USM
+ + ASNObject(ASNEncInt(3), ASN1_INT);
+ head := head + ASNObject(s, ASN1_SEQ);
+
+ //compute engine time difference
+ if FAuthEngineTimeStamp = 0 then //out of sync
+ x := 0
+ else
+ x := TickDelta(FAuthEngineTimeStamp, GetTick) div 1000;
+
+ authbeg := ASNObject(FAuthEngineID, ASN1_OCTSTR)
+ + ASNObject(ASNEncInt(FAuthEngineBoots), ASN1_INT)
+ + ASNObject(ASNEncInt(FAuthEngineTime + x), ASN1_INT)
+ + ASNObject(FUserName, ASN1_OCTSTR);
+
+
+ case FFlags of
+ AuthNoPriv,
+ AuthPriv:
+ begin
+ s := authbeg + ASNObject(StringOfChar(#0, 12), ASN1_OCTSTR)
+ + ASNObject(FPrivSalt, ASN1_OCTSTR);
+ s := ASNObject(s, ASN1_SEQ);
+ s := head + ASNObject(s, ASN1_OCTSTR);
+ s := ASNObject(s + pdu, ASN1_SEQ);
+ //in s is entire packet without auth info...
+ case FAuthMode of
+ AuthMD5:
+ begin
+ s := HMAC_MD5(s, Pass2Key(FPassword) + StringOfChar(#0, 48));
+ //strip to HMAC-MD5-96
+ delete(s, 13, 4);
+ end;
+ AuthSHA1:
+ begin
+ s := HMAC_SHA1(s, Pass2Key(FPassword) + StringOfChar(#0, 44));
+ //strip to HMAC-SHA-96
+ delete(s, 13, 8);
+ end;
+ else
+ s := '';
+ end;
+ FAuthKey := s;
+ end;
+ end;
+
+ auth := authbeg + ASNObject(FAuthKey, ASN1_OCTSTR)
+ + ASNObject(FPrivSalt, ASN1_OCTSTR);
+ auth := ASNObject(auth, ASN1_SEQ);
+
+ head := head + ASNObject(auth, ASN1_OCTSTR);
+ Result := ASNObject(head + pdu, ASN1_SEQ);
+ end
+ else
+ begin
+ head := ASNObject(ASNEncInt(Self.FVersion), ASN1_INT) +
+ ASNObject(Self.FCommunity, ASN1_OCTSTR);
+ Result := ASNObject(head + pdu, ASN1_SEQ);
+ end;
+ inc(self.FID);
+end;
+
+procedure TSNMPRec.Clear;
+var
+ i: Integer;
+begin
+ FVersion := SNMP_V1;
+ FCommunity := 'public';
+ FUserName := '';
+ FPDUType := 0;
+ FErrorStatus := 0;
+ FErrorIndex := 0;
+ for i := 0 to FSNMPMibList.Count - 1 do
+ TSNMPMib(FSNMPMibList[i]).Free;
+ FSNMPMibList.Clear;
+ FOldTrapEnterprise := '';
+ FOldTrapHost := '';
+ FOldTrapGen := 0;
+ FOldTrapSpec := 0;
+ FOldTrapTimeTicks := 0;
+ FFlags := NoAuthNoPriv;
+ FFlagReportable := false;
+ FContextEngineID := '';
+ FContextName := '';
+ FAuthEngineID := '';
+ FAuthEngineBoots := 0;
+ FAuthEngineTime := 0;
+ FAuthEngineTimeStamp := 0;
+ FAuthKey := '';
+ FPrivKey := '';
+ FPrivSalt := '';
+ FPrivSaltCounter := random(maxint);
+end;
+
+procedure TSNMPRec.MIBAdd(const MIB, Value: AnsiString; ValueType: Integer);
+var
+ SNMPMib: TSNMPMib;
+begin
+ SNMPMib := TSNMPMib.Create;
+ SNMPMib.OID := MIB;
+ SNMPMib.Value := Value;
+ SNMPMib.ValueType := ValueType;
+ FSNMPMibList.Add(SNMPMib);
+end;
+
+procedure TSNMPRec.MIBDelete(Index: Integer);
+begin
+ if (Index >= 0) and (Index < MIBCount) then
+ begin
+ TSNMPMib(FSNMPMibList[Index]).Free;
+ FSNMPMibList.Delete(Index);
+ end;
+end;
+
+function TSNMPRec.MIBCount: integer;
+begin
+ Result := FSNMPMibList.Count;
+end;
+
+function TSNMPRec.MIBByIndex(Index: Integer): TSNMPMib;
+begin
+ Result := nil;
+ if (Index >= 0) and (Index < MIBCount) then
+ Result := TSNMPMib(FSNMPMibList[Index]);
+end;
+
+function TSNMPRec.MIBGet(const MIB: AnsiString): AnsiString;
+var
+ i: Integer;
+begin
+ Result := '';
+ for i := 0 to MIBCount - 1 do
+ begin
+ if ((TSNMPMib(FSNMPMibList[i])).OID = MIB) then
+ begin
+ Result := (TSNMPMib(FSNMPMibList[i])).Value;
+ Break;
+ end;
+ end;
+end;
+
+{==============================================================================}
+
+constructor TSNMPSend.Create;
+begin
+ inherited Create;
+ FQuery := TSNMPRec.Create;
+ FReply := TSNMPRec.Create;
+ FQuery.Clear;
+ FReply.Clear;
+ FSock := TUDPBlockSocket.Create;
+ FSock.Owner := self;
+ FTimeout := 5000;
+ FTargetPort := cSnmpProtocol;
+ FHostIP := '';
+end;
+
+destructor TSNMPSend.Destroy;
+begin
+ FSock.Free;
+ FReply.Free;
+ FQuery.Free;
+ inherited Destroy;
+end;
+
+function TSNMPSend.InternalSendSnmp(const Value: TSNMPRec): Boolean;
+begin
+ FBuffer := Value.EncodeBuf;
+ FSock.SendString(FBuffer);
+ Result := FSock.LastError = 0;
+end;
+
+function TSNMPSend.InternalRecvSnmp(const Value: TSNMPRec): Boolean;
+begin
+ Result := False;
+ FReply.Clear;
+ FHostIP := cAnyHost;
+ FBuffer := FSock.RecvPacket(FTimeout);
+ if FSock.LastError = 0 then
+ begin
+ FHostIP := FSock.GetRemoteSinIP;
+ Result := Value.DecodeBuf(FBuffer);
+ end;
+end;
+
+function TSNMPSend.InternalSendRequest(const QValue, RValue: TSNMPRec): Boolean;
+begin
+ Result := False;
+ RValue.AuthMode := QValue.AuthMode;
+ RValue.Password := QValue.Password;
+ RValue.PrivMode := QValue.PrivMode;
+ RValue.PrivPassword := QValue.PrivPassword;
+ FSock.Bind(FIPInterface, cAnyPort);
+ FSock.Connect(FTargetHost, FTargetPort);
+ if InternalSendSnmp(QValue) then
+ Result := InternalRecvSnmp(RValue);
+end;
+
+function TSNMPSend.SendRequest: Boolean;
+var
+ sync: TV3Sync;
+begin
+ Result := False;
+ if FQuery.FVersion = 3 then
+ begin
+ sync := GetV3Sync;
+ FQuery.AuthEngineBoots := Sync.EngineBoots;
+ FQuery.AuthEngineTime := Sync.EngineTime;
+ FQuery.AuthEngineTimeStamp := Sync.EngineStamp;
+ FQuery.AuthEngineID := Sync.EngineID;
+ end;
+ Result := InternalSendRequest(FQuery, FReply);
+end;
+
+function TSNMPSend.SendTrap: Boolean;
+begin
+ FSock.Bind(FIPInterface, cAnyPort);
+ FSock.Connect(FTargetHost, FTargetPort);
+ Result := InternalSendSnmp(FQuery);
+end;
+
+function TSNMPSend.RecvTrap: Boolean;
+begin
+ FSock.Bind(FIPInterface, FTargetPort);
+ Result := InternalRecvSnmp(FReply);
+end;
+
+function TSNMPSend.DoIt: Boolean;
+begin
+ Result := SendRequest;
+end;
+
+function TSNMPSend.GetV3EngineID: AnsiString;
+var
+ DisQuery: TSNMPRec;
+begin
+ Result := '';
+ DisQuery := TSNMPRec.Create;
+ try
+ DisQuery.Version := 3;
+ DisQuery.UserName := '';
+ DisQuery.FlagReportable := True;
+ DisQuery.PDUType := PDUGetRequest;
+ if InternalSendRequest(DisQuery, FReply) then
+ Result := FReply.FAuthEngineID;
+ finally
+ DisQuery.Free;
+ end;
+end;
+
+function TSNMPSend.GetV3Sync: TV3Sync;
+var
+ SyncQuery: TSNMPRec;
+begin
+ Result.EngineID := GetV3EngineID;
+ Result.EngineBoots := FReply.AuthEngineBoots;
+ Result.EngineTime := FReply.AuthEngineTime;
+ Result.EngineStamp := FReply.AuthEngineTimeStamp;
+ if Result.EngineTime = 0 then
+ begin
+ //still not have sync...
+ SyncQuery := TSNMPRec.Create;
+ try
+ SyncQuery.Version := 3;
+ SyncQuery.UserName := FQuery.UserName;
+ SyncQuery.Password := FQuery.Password;
+ SyncQuery.FlagReportable := True;
+ SyncQuery.Flags := FQuery.Flags;
+ SyncQuery.AuthMode := FQuery.AuthMode;
+ SyncQuery.PrivMode := FQuery.PrivMode;
+ SyncQuery.PrivPassword := FQuery.PrivPassword;
+ SyncQuery.PDUType := PDUGetRequest;
+ SyncQuery.AuthEngineID := FReply.FAuthEngineID;
+ if InternalSendRequest(SyncQuery, FReply) then
+ begin
+ Result.EngineBoots := FReply.AuthEngineBoots;
+ Result.EngineTime := FReply.AuthEngineTime;
+ Result.EngineStamp := FReply.AuthEngineTimeStamp;
+ end;
+ finally
+ SyncQuery.Free;
+ end;
+ end;
+end;
+
+{==============================================================================}
+
+function SNMPGet(const OID, Community, SNMPHost: AnsiString; var Value: AnsiString): Boolean;
+var
+ SNMPSend: TSNMPSend;
+begin
+ SNMPSend := TSNMPSend.Create;
+ try
+ SNMPSend.Query.Clear;
+ SNMPSend.Query.Community := Community;
+ SNMPSend.Query.PDUType := PDUGetRequest;
+ SNMPSend.Query.MIBAdd(OID, '', ASN1_NULL);
+ SNMPSend.TargetHost := SNMPHost;
+ Result := SNMPSend.SendRequest;
+ Value := '';
+ if Result then
+ Value := SNMPSend.Reply.MIBGet(OID);
+ finally
+ SNMPSend.Free;
+ end;
+end;
+
+function SNMPSet(const OID, Community, SNMPHost, Value: AnsiString; ValueType: Integer): Boolean;
+var
+ SNMPSend: TSNMPSend;
+begin
+ SNMPSend := TSNMPSend.Create;
+ try
+ SNMPSend.Query.Clear;
+ SNMPSend.Query.Community := Community;
+ SNMPSend.Query.PDUType := PDUSetRequest;
+ SNMPSend.Query.MIBAdd(OID, Value, ValueType);
+ SNMPSend.TargetHost := SNMPHost;
+ Result := SNMPSend.Sendrequest = True;
+ finally
+ SNMPSend.Free;
+ end;
+end;
+
+function InternalGetNext(const SNMPSend: TSNMPSend; var OID: AnsiString;
+ const Community: AnsiString; var Value: AnsiString): Boolean;
+begin
+ SNMPSend.Query.Clear;
+ SNMPSend.Query.ID := SNMPSend.Query.ID + 1;
+ SNMPSend.Query.Community := Community;
+ SNMPSend.Query.PDUType := PDUGetNextRequest;
+ SNMPSend.Query.MIBAdd(OID, '', ASN1_NULL);
+ Result := SNMPSend.Sendrequest;
+ Value := '';
+ if Result then
+ if SNMPSend.Reply.SNMPMibList.Count > 0 then
+ begin
+ OID := TSNMPMib(SNMPSend.Reply.SNMPMibList[0]).OID;
+ Value := TSNMPMib(SNMPSend.Reply.SNMPMibList[0]).Value;
+ end;
+end;
+
+function SNMPGetNext(var OID: AnsiString; const Community, SNMPHost: AnsiString; var Value: AnsiString): Boolean;
+var
+ SNMPSend: TSNMPSend;
+begin
+ SNMPSend := TSNMPSend.Create;
+ try
+ SNMPSend.TargetHost := SNMPHost;
+ Result := InternalGetNext(SNMPSend, OID, Community, Value);
+ finally
+ SNMPSend.Free;
+ end;
+end;
+
+function SNMPGetTable(const BaseOID, Community, SNMPHost: AnsiString; const Value: TStrings): Boolean;
+var
+ OID: AnsiString;
+ s: AnsiString;
+ col,row: String;
+ x: integer;
+ SNMPSend: TSNMPSend;
+ RowList: TStringList;
+begin
+ Value.Clear;
+ SNMPSend := TSNMPSend.Create;
+ RowList := TStringList.Create;
+ try
+ SNMPSend.TargetHost := SNMPHost;
+ OID := BaseOID;
+ repeat
+ Result := InternalGetNext(SNMPSend, OID, Community, s);
+ if Pos(BaseOID, OID) <> 1 then
+ break;
+ row := separateright(oid, baseoid + '.');
+ col := fetch(row, '.');
+
+ if IsBinaryString(s) then
+ s := StrToHex(s);
+ x := RowList.indexOf(Row);
+ if x < 0 then
+ begin
+ x := RowList.add(Row);
+ Value.Add('');
+ end;
+ if (Value[x] <> '') then
+ Value[x] := Value[x] + ',';
+ Value[x] := Value[x] + AnsiQuotedStr(s, '"');
+ until not result;
+ finally
+ SNMPSend.Free;
+ RowList.Free;
+ end;
+end;
+
+function SNMPGetTableElement(const BaseOID, RowID, ColID, Community, SNMPHost: AnsiString; var Value: AnsiString): Boolean;
+var
+ s: AnsiString;
+begin
+ s := BaseOID + '.' + ColID + '.' + RowID;
+ Result := SnmpGet(s, Community, SNMPHost, Value);
+end;
+
+function SendTrap(const Dest, Source, Enterprise, Community: AnsiString;
+ Generic, Specific, Seconds: Integer; const MIBName, MIBValue: AnsiString;
+ MIBtype: Integer): Integer;
+var
+ SNMPSend: TSNMPSend;
+begin
+ SNMPSend := TSNMPSend.Create;
+ try
+ SNMPSend.TargetHost := Dest;
+ SNMPSend.TargetPort := cSnmpTrapProtocol;
+ SNMPSend.Query.Community := Community;
+ SNMPSend.Query.Version := SNMP_V1;
+ SNMPSend.Query.PDUType := PDUTrap;
+ SNMPSend.Query.OldTrapHost := Source;
+ SNMPSend.Query.OldTrapEnterprise := Enterprise;
+ SNMPSend.Query.OldTrapGen := Generic;
+ SNMPSend.Query.OldTrapSpec := Specific;
+ SNMPSend.Query.OldTrapTimeTicks := Seconds;
+ SNMPSend.Query.MIBAdd(MIBName, MIBValue, MIBType);
+ Result := Ord(SNMPSend.SendTrap);
+ finally
+ SNMPSend.Free;
+ end;
+end;
+
+function RecvTrap(var Dest, Source, Enterprise, Community: AnsiString;
+ var Generic, Specific, Seconds: Integer;
+ const MIBName, MIBValue: TStringList): Integer;
+var
+ SNMPSend: TSNMPSend;
+ i: Integer;
+begin
+ SNMPSend := TSNMPSend.Create;
+ try
+ Result := 0;
+ SNMPSend.TargetPort := cSnmpTrapProtocol;
+ if SNMPSend.RecvTrap then
+ begin
+ Result := 1;
+ Dest := SNMPSend.HostIP;
+ Community := SNMPSend.Reply.Community;
+ Source := SNMPSend.Reply.OldTrapHost;
+ Enterprise := SNMPSend.Reply.OldTrapEnterprise;
+ Generic := SNMPSend.Reply.OldTrapGen;
+ Specific := SNMPSend.Reply.OldTrapSpec;
+ Seconds := SNMPSend.Reply.OldTrapTimeTicks;
+ MIBName.Clear;
+ MIBValue.Clear;
+ for i := 0 to SNMPSend.Reply.SNMPMibList.Count - 1 do
+ begin
+ MIBName.Add(TSNMPMib(SNMPSend.Reply.SNMPMibList[i]).OID);
+ MIBValue.Add(TSNMPMib(SNMPSend.Reply.SNMPMibList[i]).Value);
+ end;
+ end;
+ finally
+ SNMPSend.Free;
+ end;
+end;
+
+
+end.
+
+
ADDED lib/synapse/source/lib/sntpsend.pas
Index: lib/synapse/source/lib/sntpsend.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/lib/sntpsend.pas
@@ -0,0 +1,374 @@
+{==============================================================================|
+| Project : Ararat Synapse | 003.000.003 |
+|==============================================================================|
+| Content: SNTP client |
+|==============================================================================|
+| Copyright (c)1999-2010, Lukas Gebauer |
+| All rights reserved. |
+| |
+| Redistribution and use in source and binary forms, with or without |
+| modification, are permitted provided that the following conditions are met: |
+| |
+| Redistributions of source code must retain the above copyright notice, this |
+| list of conditions and the following disclaimer. |
+| |
+| Redistributions in binary form must reproduce the above copyright notice, |
+| this list of conditions and the following disclaimer in the documentation |
+| and/or other materials provided with the distribution. |
+| |
+| Neither the name of Lukas Gebauer nor the names of its contributors may |
+| be used to endorse or promote products derived from this software without |
+| specific prior written permission. |
+| |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
+| DAMAGE. |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2000-2010. |
+| All Rights Reserved. |
+|==============================================================================|
+| Contributor(s): |
+| Patrick Chevalley |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package |
+| (Found at URL: http://www.ararat.cz/synapse/) |
+|==============================================================================}
+
+{:@abstract( NTP and SNTP client)
+
+Used RFC: RFC-1305, RFC-2030
+}
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+{$Q-}
+{$H+}
+
+unit sntpsend;
+
+interface
+
+uses
+ SysUtils,
+ synsock, blcksock, synautil;
+
+const
+ cNtpProtocol = '123';
+
+type
+
+ {:@abstract(Record containing the NTP packet.)}
+ TNtp = packed record
+ mode: Byte;
+ stratum: Byte;
+ poll: Byte;
+ Precision: Byte;
+ RootDelay: Longint;
+ RootDisperson: Longint;
+ RefID: Longint;
+ Ref1: Longint;
+ Ref2: Longint;
+ Org1: Longint;
+ Org2: Longint;
+ Rcv1: Longint;
+ Rcv2: Longint;
+ Xmit1: Longint;
+ Xmit2: Longint;
+ end;
+
+ {:@abstract(Implementation of NTP and SNTP client protocol),
+ include time synchronisation. It can send NTP or SNTP time queries, or it
+ can receive NTP broadcasts too.
+
+ Note: Are you missing properties for specify server address and port? Look to
+ parent @link(TSynaClient) too!}
+ TSNTPSend = class(TSynaClient)
+ private
+ FNTPReply: TNtp;
+ FNTPTime: TDateTime;
+ FNTPOffset: double;
+ FNTPDelay: double;
+ FMaxSyncDiff: double;
+ FSyncTime: Boolean;
+ FSock: TUDPBlockSocket;
+ FBuffer: AnsiString;
+ FLi, FVn, Fmode : byte;
+ function StrToNTP(const Value: AnsiString): TNtp;
+ function NTPtoStr(const Value: Tntp): AnsiString;
+ procedure ClearNTP(var Value: Tntp);
+ public
+ constructor Create;
+ destructor Destroy; override;
+
+ {:Decode 128 bit timestamp used in NTP packet to TDateTime type.}
+ function DecodeTs(Nsec, Nfrac: Longint): TDateTime;
+
+ {:Decode TDateTime type to 128 bit timestamp used in NTP packet.}
+ procedure EncodeTs(dt: TDateTime; var Nsec, Nfrac: Longint);
+
+ {:Send request to @link(TSynaClient.TargetHost) and wait for reply. If all
+ is OK, then result is @true and @link(NTPReply) and @link(NTPTime) are
+ valid.}
+ function GetSNTP: Boolean;
+
+ {:Send request to @link(TSynaClient.TargetHost) and wait for reply. If all
+ is OK, then result is @true and @link(NTPReply) and @link(NTPTime) are
+ valid. Result time is after all needed corrections.}
+ function GetNTP: Boolean;
+
+ {:Wait for broadcast NTP packet. If all OK, result is @true and
+ @link(NTPReply) and @link(NTPTime) are valid.}
+ function GetBroadcastNTP: Boolean;
+
+ {:Holds last received NTP packet.}
+ property NTPReply: TNtp read FNTPReply;
+ published
+ {:Date and time of remote NTP or SNTP server. (UTC time!!!)}
+ property NTPTime: TDateTime read FNTPTime;
+
+ {:Offset between your computer and remote NTP or SNTP server.}
+ property NTPOffset: Double read FNTPOffset;
+
+ {:Delay between your computer and remote NTP or SNTP server.}
+ property NTPDelay: Double read FNTPDelay;
+
+ {:Define allowed maximum difference between your time and remote time for
+ synchronising time. If difference is bigger, your system time is not
+ changed!}
+ property MaxSyncDiff: double read FMaxSyncDiff write FMaxSyncDiff;
+
+ {:If @true, after successfull getting time is local computer clock
+ synchronised to given time.
+ For synchronising time you must have proper rights! (Usually Administrator)}
+ property SyncTime: Boolean read FSyncTime write FSyncTime;
+
+ {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.}
+ property Sock: TUDPBlockSocket read FSock;
+ end;
+
+implementation
+
+constructor TSNTPSend.Create;
+begin
+ inherited Create;
+ FSock := TUDPBlockSocket.Create;
+ FSock.Owner := self;
+ FTimeout := 5000;
+ FTargetPort := cNtpProtocol;
+ FMaxSyncDiff := 3600;
+ FSyncTime := False;
+end;
+
+destructor TSNTPSend.Destroy;
+begin
+ FSock.Free;
+ inherited Destroy;
+end;
+
+function TSNTPSend.StrToNTP(const Value: AnsiString): TNtp;
+begin
+ if length(FBuffer) >= SizeOf(Result) then
+ begin
+ Result.mode := ord(Value[1]);
+ Result.stratum := ord(Value[2]);
+ Result.poll := ord(Value[3]);
+ Result.Precision := ord(Value[4]);
+ Result.RootDelay := DecodeLongInt(value, 5);
+ Result.RootDisperson := DecodeLongInt(value, 9);
+ Result.RefID := DecodeLongInt(value, 13);
+ Result.Ref1 := DecodeLongInt(value, 17);
+ Result.Ref2 := DecodeLongInt(value, 21);
+ Result.Org1 := DecodeLongInt(value, 25);
+ Result.Org2 := DecodeLongInt(value, 29);
+ Result.Rcv1 := DecodeLongInt(value, 33);
+ Result.Rcv2 := DecodeLongInt(value, 37);
+ Result.Xmit1 := DecodeLongInt(value, 41);
+ Result.Xmit2 := DecodeLongInt(value, 45);
+ end;
+
+end;
+
+function TSNTPSend.NTPtoStr(const Value: Tntp): AnsiString;
+begin
+ SetLength(Result, 4);
+ Result[1] := AnsiChar(Value.mode);
+ Result[2] := AnsiChar(Value.stratum);
+ Result[3] := AnsiChar(Value.poll);
+ Result[4] := AnsiChar(Value.precision);
+ Result := Result + CodeLongInt(Value.RootDelay);
+ Result := Result + CodeLongInt(Value.RootDisperson);
+ Result := Result + CodeLongInt(Value.RefID);
+ Result := Result + CodeLongInt(Value.Ref1);
+ Result := Result + CodeLongInt(Value.Ref2);
+ Result := Result + CodeLongInt(Value.Org1);
+ Result := Result + CodeLongInt(Value.Org2);
+ Result := Result + CodeLongInt(Value.Rcv1);
+ Result := Result + CodeLongInt(Value.Rcv2);
+ Result := Result + CodeLongInt(Value.Xmit1);
+ Result := Result + CodeLongInt(Value.Xmit2);
+end;
+
+procedure TSNTPSend.ClearNTP(var Value: Tntp);
+begin
+ Value.mode := 0;
+ Value.stratum := 0;
+ Value.poll := 0;
+ Value.Precision := 0;
+ Value.RootDelay := 0;
+ Value.RootDisperson := 0;
+ Value.RefID := 0;
+ Value.Ref1 := 0;
+ Value.Ref2 := 0;
+ Value.Org1 := 0;
+ Value.Org2 := 0;
+ Value.Rcv1 := 0;
+ Value.Rcv2 := 0;
+ Value.Xmit1 := 0;
+ Value.Xmit2 := 0;
+end;
+
+function TSNTPSend.DecodeTs(Nsec, Nfrac: Longint): TDateTime;
+const
+ maxi = 4294967295.0;
+var
+ d, d1: Double;
+begin
+ d := Nsec;
+ if d < 0 then
+ d := maxi + d + 1;
+ d1 := Nfrac;
+ if d1 < 0 then
+ d1 := maxi + d1 + 1;
+ d1 := d1 / maxi;
+ d1 := Trunc(d1 * 10000) / 10000;
+ Result := (d + d1) / 86400;
+ Result := Result + 2;
+end;
+
+procedure TSNTPSend.EncodeTs(dt: TDateTime; var Nsec, Nfrac: Longint);
+const
+ maxi = 4294967295.0;
+ maxilongint = 2147483647;
+var
+ d, d1: Double;
+begin
+ d := (dt - 2) * 86400;
+ d1 := frac(d);
+ if d > maxilongint then
+ d := d - maxi - 1;
+ d := trunc(d);
+ d1 := Trunc(d1 * 10000) / 10000;
+ d1 := d1 * maxi;
+ if d1 > maxilongint then
+ d1 := d1 - maxi - 1;
+ Nsec:=trunc(d);
+ Nfrac:=trunc(d1);
+end;
+
+function TSNTPSend.GetBroadcastNTP: Boolean;
+var
+ x: Integer;
+begin
+ Result := False;
+ FSock.Bind(FIPInterface, FTargetPort);
+ FBuffer := FSock.RecvPacket(FTimeout);
+ if FSock.LastError = 0 then
+ begin
+ x := Length(FBuffer);
+ if (FTargetHost = '0.0.0.0') or (FSock.GetRemoteSinIP = FSock.ResolveName(FTargetHost)) then
+ if x >= SizeOf(NTPReply) then
+ begin
+ FNTPReply := StrToNTP(FBuffer);
+ FNTPTime := DecodeTs(NTPReply.Xmit1, NTPReply.Xmit2);
+ if FSyncTime and ((abs(FNTPTime - GetUTTime) * 86400) <= FMaxSyncDiff) then
+ SetUTTime(FNTPTime);
+ Result := True;
+ end;
+ end;
+end;
+
+function TSNTPSend.GetSNTP: Boolean;
+var
+ q: TNtp;
+ x: Integer;
+begin
+ Result := False;
+ FSock.CloseSocket;
+ FSock.Bind(FIPInterface, cAnyPort);
+ FSock.Connect(FTargetHost, FTargetPort);
+ ClearNtp(q);
+ q.mode := $1B;
+ FBuffer := NTPtoStr(q);
+ FSock.SendString(FBuffer);
+ FBuffer := FSock.RecvPacket(FTimeout);
+ if FSock.LastError = 0 then
+ begin
+ x := Length(FBuffer);
+ if x >= SizeOf(NTPReply) then
+ begin
+ FNTPReply := StrToNTP(FBuffer);
+ FNTPTime := DecodeTs(NTPReply.Xmit1, NTPReply.Xmit2);
+ if FSyncTime and ((abs(FNTPTime - GetUTTime) * 86400) <= FMaxSyncDiff) then
+ SetUTTime(FNTPTime);
+ Result := True;
+ end;
+ end;
+end;
+
+function TSNTPSend.GetNTP: Boolean;
+var
+ q: TNtp;
+ x: Integer;
+ t1, t2, t3, t4 : TDateTime;
+begin
+ Result := False;
+ FSock.CloseSocket;
+ FSock.Bind(FIPInterface, cAnyPort);
+ FSock.Connect(FTargetHost, FTargetPort);
+ ClearNtp(q);
+ q.mode := $1B;
+ t1 := GetUTTime;
+ EncodeTs(t1, q.org1, q.org2);
+ FBuffer := NTPtoStr(q);
+ FSock.SendString(FBuffer);
+ FBuffer := FSock.RecvPacket(FTimeout);
+ if FSock.LastError = 0 then
+ begin
+ x := Length(FBuffer);
+ t4 := GetUTTime;
+ if x >= SizeOf(NTPReply) then
+ begin
+ FNTPReply := StrToNTP(FBuffer);
+ FLi := (NTPReply.mode and $C0) shr 6;
+ FVn := (NTPReply.mode and $38) shr 3;
+ Fmode := NTPReply.mode and $07;
+ if (Fli < 3) and (Fmode = 4) and
+ (NTPReply.stratum >= 1) and (NTPReply.stratum <= 15) and
+ (NTPReply.Rcv1 <> 0) and (NTPReply.Xmit1 <> 0)
+ then begin
+ t2 := DecodeTs(NTPReply.Rcv1, NTPReply.Rcv2);
+ t3 := DecodeTs(NTPReply.Xmit1, NTPReply.Xmit2);
+ FNTPDelay := (T4 - T1) - (T2 - T3);
+ FNTPTime := t3 + FNTPDelay / 2;
+ FNTPOffset := (((T2 - T1) + (T3 - T4)) / 2) * 86400;
+ FNTPDelay := FNTPDelay * 86400;
+ if FSyncTime and ((abs(FNTPTime - t1) * 86400) <= FMaxSyncDiff) then
+ SetUTTime(FNTPTime);
+ Result := True;
+ end
+ else result:=false;
+ end;
+ end;
+end;
+
+end.
ADDED lib/synapse/source/lib/ssdotnet.inc
Index: lib/synapse/source/lib/ssdotnet.inc
==================================================================
--- /dev/null
+++ lib/synapse/source/lib/ssdotnet.inc
@@ -0,0 +1,1099 @@
+{==============================================================================|
+| Project : Ararat Synapse | 001.000.002 |
+|==============================================================================|
+| Content: Socket Independent Platform Layer - .NET definition include |
+|==============================================================================|
+| Copyright (c)2004, Lukas Gebauer |
+| All rights reserved. |
+| |
+| Redistribution and use in source and binary forms, with or without |
+| modification, are permitted provided that the following conditions are met: |
+| |
+| Redistributions of source code must retain the above copyright notice, this |
+| list of conditions and the following disclaimer. |
+| |
+| Redistributions in binary form must reproduce the above copyright notice, |
+| this list of conditions and the following disclaimer in the documentation |
+| and/or other materials provided with the distribution. |
+| |
+| Neither the name of Lukas Gebauer nor the names of its contributors may |
+| be used to endorse or promote products derived from this software without |
+| specific prior written permission. |
+| |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
+| DAMAGE. |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2004. |
+| All Rights Reserved. |
+|==============================================================================|
+| Contributor(s): |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package |
+| (Found at URL: http://www.ararat.cz/synapse/) |
+|==============================================================================}
+
+{:@exclude}
+
+{$IFDEF CIL}
+
+interface
+
+uses
+ SyncObjs, SysUtils, Classes,
+ System.Net,
+ System.Net.Sockets;
+
+const
+ DLLStackName = '';
+ WinsockLevel = $0202;
+
+function InitSocketInterface(stack: string): Boolean;
+function DestroySocketInterface: Boolean;
+
+type
+ u_char = Char;
+ u_short = Word;
+ u_int = Integer;
+ u_long = Longint;
+ pu_long = ^u_long;
+ pu_short = ^u_short;
+ PSockAddr = IPEndPoint;
+ DWORD = integer;
+ ULong = cardinal;
+ TMemory = Array of byte;
+ TLinger = LingerOption;
+ TSocket = socket;
+ TAddrFamily = AddressFamily;
+
+const
+ WSADESCRIPTION_LEN = 256;
+ WSASYS_STATUS_LEN = 128;
+type
+ PWSAData = ^TWSAData;
+ TWSAData = packed record
+ wVersion: Word;
+ wHighVersion: Word;
+ szDescription: array[0..WSADESCRIPTION_LEN] of Char;
+ szSystemStatus: array[0..WSASYS_STATUS_LEN] of Char;
+ iMaxSockets: Word;
+ iMaxUdpDg: Word;
+// lpVendorInfo: PChar;
+ end;
+
+const
+ MSG_NOSIGNAL = 0;
+ INVALID_SOCKET = nil;
+ AF_UNSPEC = AddressFamily.Unspecified;
+ AF_INET = AddressFamily.InterNetwork;
+ AF_INET6 = AddressFamily.InterNetworkV6;
+ SOCKET_ERROR = integer(-1);
+
+ FIONREAD = integer($4004667f);
+ FIONBIO = integer($8004667e);
+ FIOASYNC = integer($8004667d);
+
+ SOMAXCONN = integer($7fffffff);
+
+ IPPROTO_IP = ProtocolType.IP;
+ IPPROTO_ICMP = ProtocolType.Icmp;
+ IPPROTO_IGMP = ProtocolType.Igmp;
+ IPPROTO_TCP = ProtocolType.Tcp;
+ IPPROTO_UDP = ProtocolType.Udp;
+ IPPROTO_RAW = ProtocolType.Raw;
+ IPPROTO_IPV6 = ProtocolType.IPV6;
+//
+ IPPROTO_ICMPV6 = ProtocolType.Icmp; //??
+
+ SOCK_STREAM = SocketType.Stream;
+ SOCK_DGRAM = SocketType.Dgram;
+ SOCK_RAW = SocketType.Raw;
+ SOCK_RDM = SocketType.Rdm;
+ SOCK_SEQPACKET = SocketType.Seqpacket;
+
+ SOL_SOCKET = SocketOptionLevel.Socket;
+ SOL_IP = SocketOptionLevel.Ip;
+
+
+ IP_OPTIONS = SocketOptionName.IPOptions;
+ IP_HDRINCL = SocketOptionName.HeaderIncluded;
+ IP_TOS = SocketOptionName.TypeOfService; { set/get IP Type Of Service }
+ IP_TTL = SocketOptionName.IpTimeToLive; { set/get IP Time To Live }
+ IP_MULTICAST_IF = SocketOptionName.MulticastInterface; { set/get IP multicast interface }
+ IP_MULTICAST_TTL = SocketOptionName.MulticastTimeToLive; { set/get IP multicast timetolive }
+ IP_MULTICAST_LOOP = SocketOptionName.MulticastLoopback; { set/get IP multicast loopback }
+ IP_ADD_MEMBERSHIP = SocketOptionName.AddMembership; { add an IP group membership }
+ IP_DROP_MEMBERSHIP = SocketOptionName.DropMembership; { drop an IP group membership }
+ IP_DONTFRAGMENT = SocketOptionName.DontFragment; { set/get IP Don't Fragment flag }
+
+ IPV6_UNICAST_HOPS = 8; // TTL
+ IPV6_MULTICAST_IF = 9; // set/get IP multicast i/f
+ IPV6_MULTICAST_HOPS = 10; // set/get IP multicast ttl
+ IPV6_MULTICAST_LOOP = 11; // set/get IP multicast loopback
+ IPV6_JOIN_GROUP = 12; // add an IP group membership
+ IPV6_LEAVE_GROUP = 13; // drop an IP group membership
+
+ SO_DEBUG = SocketOptionName.Debug; { turn on debugging info recording }
+ SO_ACCEPTCONN = SocketOptionName.AcceptConnection; { socket has had listen() }
+ SO_REUSEADDR = SocketOptionName.ReuseAddress; { allow local address reuse }
+ SO_KEEPALIVE = SocketOptionName.KeepAlive; { keep connections alive }
+ SO_DONTROUTE = SocketOptionName.DontRoute; { just use interface addresses }
+ SO_BROADCAST = SocketOptionName.Broadcast; { permit sending of broadcast msgs }
+ SO_USELOOPBACK = SocketOptionName.UseLoopback; { bypass hardware when possible }
+ SO_LINGER = SocketOptionName.Linger; { linger on close if data present }
+ SO_OOBINLINE = SocketOptionName.OutOfBandInline; { leave received OOB data in line }
+ SO_DONTLINGER = SocketOptionName.DontLinger;
+{ Additional options. }
+ SO_SNDBUF = SocketOptionName.SendBuffer; { send buffer size }
+ SO_RCVBUF = SocketOptionName.ReceiveBuffer; { receive buffer size }
+ SO_SNDLOWAT = SocketOptionName.SendLowWater; { send low-water mark }
+ SO_RCVLOWAT = SocketOptionName.ReceiveLowWater; { receive low-water mark }
+ SO_SNDTIMEO = SocketOptionName.SendTimeout; { send timeout }
+ SO_RCVTIMEO = SocketOptionName.ReceiveTimeout; { receive timeout }
+ SO_ERROR = SocketOptionName.Error; { get error status and clear }
+ SO_TYPE = SocketOptionName.Type; { get socket type }
+
+{ WinSock 2 extension -- new options }
+// SO_GROUP_ID = $2001; { ID of a socket group}
+// SO_GROUP_PRIORITY = $2002; { the relative priority within a group}
+// SO_MAX_MSG_SIZE = $2003; { maximum message size }
+// SO_PROTOCOL_INFOA = $2004; { WSAPROTOCOL_INFOA structure }
+// SO_PROTOCOL_INFOW = $2005; { WSAPROTOCOL_INFOW structure }
+// SO_PROTOCOL_INFO = SO_PROTOCOL_INFOA;
+// PVD_CONFIG = $3001; {configuration info for service provider }
+{ Option for opening sockets for synchronous access. }
+// SO_OPENTYPE = $7008;
+// SO_SYNCHRONOUS_ALERT = $10;
+// SO_SYNCHRONOUS_NONALERT = $20;
+{ Other NT-specific options. }
+// SO_MAXDG = $7009;
+// SO_MAXPATHDG = $700A;
+// SO_UPDATE_ACCEPT_CONTEXT = $700B;
+// SO_CONNECT_TIME = $700C;
+
+
+ { All Windows Sockets error constants are biased by WSABASEERR from the "normal" }
+ WSABASEERR = 10000;
+
+{ Windows Sockets definitions of regular Microsoft C error constants }
+
+ WSAEINTR = (WSABASEERR+4);
+ WSAEBADF = (WSABASEERR+9);
+ WSAEACCES = (WSABASEERR+13);
+ WSAEFAULT = (WSABASEERR+14);
+ WSAEINVAL = (WSABASEERR+22);
+ WSAEMFILE = (WSABASEERR+24);
+
+{ Windows Sockets definitions of regular Berkeley error constants }
+
+ WSAEWOULDBLOCK = (WSABASEERR+35);
+ WSAEINPROGRESS = (WSABASEERR+36);
+ WSAEALREADY = (WSABASEERR+37);
+ WSAENOTSOCK = (WSABASEERR+38);
+ WSAEDESTADDRREQ = (WSABASEERR+39);
+ WSAEMSGSIZE = (WSABASEERR+40);
+ WSAEPROTOTYPE = (WSABASEERR+41);
+ WSAENOPROTOOPT = (WSABASEERR+42);
+ WSAEPROTONOSUPPORT = (WSABASEERR+43);
+ WSAESOCKTNOSUPPORT = (WSABASEERR+44);
+ WSAEOPNOTSUPP = (WSABASEERR+45);
+ WSAEPFNOSUPPORT = (WSABASEERR+46);
+ WSAEAFNOSUPPORT = (WSABASEERR+47);
+ WSAEADDRINUSE = (WSABASEERR+48);
+ WSAEADDRNOTAVAIL = (WSABASEERR+49);
+ WSAENETDOWN = (WSABASEERR+50);
+ WSAENETUNREACH = (WSABASEERR+51);
+ WSAENETRESET = (WSABASEERR+52);
+ WSAECONNABORTED = (WSABASEERR+53);
+ WSAECONNRESET = (WSABASEERR+54);
+ WSAENOBUFS = (WSABASEERR+55);
+ WSAEISCONN = (WSABASEERR+56);
+ WSAENOTCONN = (WSABASEERR+57);
+ WSAESHUTDOWN = (WSABASEERR+58);
+ WSAETOOMANYREFS = (WSABASEERR+59);
+ WSAETIMEDOUT = (WSABASEERR+60);
+ WSAECONNREFUSED = (WSABASEERR+61);
+ WSAELOOP = (WSABASEERR+62);
+ WSAENAMETOOLONG = (WSABASEERR+63);
+ WSAEHOSTDOWN = (WSABASEERR+64);
+ WSAEHOSTUNREACH = (WSABASEERR+65);
+ WSAENOTEMPTY = (WSABASEERR+66);
+ WSAEPROCLIM = (WSABASEERR+67);
+ WSAEUSERS = (WSABASEERR+68);
+ WSAEDQUOT = (WSABASEERR+69);
+ WSAESTALE = (WSABASEERR+70);
+ WSAEREMOTE = (WSABASEERR+71);
+
+{ Extended Windows Sockets error constant definitions }
+
+ WSASYSNOTREADY = (WSABASEERR+91);
+ WSAVERNOTSUPPORTED = (WSABASEERR+92);
+ WSANOTINITIALISED = (WSABASEERR+93);
+ WSAEDISCON = (WSABASEERR+101);
+ WSAENOMORE = (WSABASEERR+102);
+ WSAECANCELLED = (WSABASEERR+103);
+ WSAEEINVALIDPROCTABLE = (WSABASEERR+104);
+ WSAEINVALIDPROVIDER = (WSABASEERR+105);
+ WSAEPROVIDERFAILEDINIT = (WSABASEERR+106);
+ WSASYSCALLFAILURE = (WSABASEERR+107);
+ WSASERVICE_NOT_FOUND = (WSABASEERR+108);
+ WSATYPE_NOT_FOUND = (WSABASEERR+109);
+ WSA_E_NO_MORE = (WSABASEERR+110);
+ WSA_E_CANCELLED = (WSABASEERR+111);
+ WSAEREFUSED = (WSABASEERR+112);
+
+{ Error return codes from gethostbyname() and gethostbyaddr()
+ (when using the resolver). Note that these errors are
+ retrieved via WSAGetLastError() and must therefore follow
+ the rules for avoiding clashes with error numbers from
+ specific implementations or language run-time systems.
+ For this reason the codes are based at WSABASEERR+1001.
+ Note also that [WSA]NO_ADDRESS is defined only for
+ compatibility purposes. }
+
+{ Authoritative Answer: Host not found }
+ WSAHOST_NOT_FOUND = (WSABASEERR+1001);
+ HOST_NOT_FOUND = WSAHOST_NOT_FOUND;
+{ Non-Authoritative: Host not found, or SERVERFAIL }
+ WSATRY_AGAIN = (WSABASEERR+1002);
+ TRY_AGAIN = WSATRY_AGAIN;
+{ Non recoverable errors, FORMERR, REFUSED, NOTIMP }
+ WSANO_RECOVERY = (WSABASEERR+1003);
+ NO_RECOVERY = WSANO_RECOVERY;
+{ Valid name, no data record of requested type }
+ WSANO_DATA = (WSABASEERR+1004);
+ NO_DATA = WSANO_DATA;
+{ no address, look for MX record }
+ WSANO_ADDRESS = WSANO_DATA;
+ NO_ADDRESS = WSANO_ADDRESS;
+
+ EWOULDBLOCK = WSAEWOULDBLOCK;
+ EINPROGRESS = WSAEINPROGRESS;
+ EALREADY = WSAEALREADY;
+ ENOTSOCK = WSAENOTSOCK;
+ EDESTADDRREQ = WSAEDESTADDRREQ;
+ EMSGSIZE = WSAEMSGSIZE;
+ EPROTOTYPE = WSAEPROTOTYPE;
+ ENOPROTOOPT = WSAENOPROTOOPT;
+ EPROTONOSUPPORT = WSAEPROTONOSUPPORT;
+ ESOCKTNOSUPPORT = WSAESOCKTNOSUPPORT;
+ EOPNOTSUPP = WSAEOPNOTSUPP;
+ EPFNOSUPPORT = WSAEPFNOSUPPORT;
+ EAFNOSUPPORT = WSAEAFNOSUPPORT;
+ EADDRINUSE = WSAEADDRINUSE;
+ EADDRNOTAVAIL = WSAEADDRNOTAVAIL;
+ ENETDOWN = WSAENETDOWN;
+ ENETUNREACH = WSAENETUNREACH;
+ ENETRESET = WSAENETRESET;
+ ECONNABORTED = WSAECONNABORTED;
+ ECONNRESET = WSAECONNRESET;
+ ENOBUFS = WSAENOBUFS;
+ EISCONN = WSAEISCONN;
+ ENOTCONN = WSAENOTCONN;
+ ESHUTDOWN = WSAESHUTDOWN;
+ ETOOMANYREFS = WSAETOOMANYREFS;
+ ETIMEDOUT = WSAETIMEDOUT;
+ ECONNREFUSED = WSAECONNREFUSED;
+ ELOOP = WSAELOOP;
+ ENAMETOOLONG = WSAENAMETOOLONG;
+ EHOSTDOWN = WSAEHOSTDOWN;
+ EHOSTUNREACH = WSAEHOSTUNREACH;
+ ENOTEMPTY = WSAENOTEMPTY;
+ EPROCLIM = WSAEPROCLIM;
+ EUSERS = WSAEUSERS;
+ EDQUOT = WSAEDQUOT;
+ ESTALE = WSAESTALE;
+ EREMOTE = WSAEREMOTE;
+
+
+type
+ TVarSin = IPEndpoint;
+
+{ function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean;
+ function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean;
+ function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean;
+ function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean;
+ function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean;
+ function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6):boolean;
+ procedure SET_IN6_IF_ADDR_ANY (const a: PInAddr6);
+ procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6);
+var
+ in6addr_any, in6addr_loopback : TInAddr6;
+}
+
+{procedure FD_CLR(Socket: TSocket; var FDSet: TFDSet);
+function FD_ISSET(Socket: TSocket; var FDSet: TFDSet): Boolean;
+procedure FD_SET(Socket: TSocket; var FDSet: TFDSet);
+procedure FD_ZERO(var FDSet: TFDSet);
+}
+{=============================================================================}
+
+ function WSAStartup(wVersionRequired: Word; var WSData: TWSAData): Integer;
+ function WSACleanup: Integer;
+ function WSAGetLastError: Integer;
+ function WSAGetLastErrorDesc: String;
+ function GetHostName: string;
+ function Shutdown(s: TSocket; how: Integer): Integer;
+// function SetSockOpt(s: TSocket; level, optname: Integer; optval: PChar;
+// optlen: Integer): Integer;
+ function SetSockOpt(s: TSocket; level, optname: Integer; optval: TMemory;
+ optlen: Integer): Integer;
+ function SetSockOptObj(s: TSocket; level, optname: Integer; optval: TObject): Integer;
+ function GetSockOpt(s: TSocket; level, optname: Integer; optval: TMemory;
+ var optlen: Integer): Integer;
+// function SendTo(s: TSocket; const Buf; len, flags: Integer; addrto: PSockAddr;
+// tolen: Integer): Integer;
+/// function SendTo(s: TSocket; const Buf; len, flags: Integer; addrto: TVarSin): Integer;
+/// function Send(s: TSocket; const Buf; len, flags: Integer): Integer;
+/// function Recv(s: TSocket; var Buf; len, flags: Integer): Integer;
+// function RecvFrom(s: TSocket; var Buf; len, flags: Integer; from: PSockAddr;
+// var fromlen: Integer): Integer;
+/// function RecvFrom(s: TSocket; var Buf; len, flags: Integer; from: TVarSin): Integer;
+function Send(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
+function Recv(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
+function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin): Integer;
+function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer;
+ function ntohs(netshort: u_short): u_short;
+ function ntohl(netlong: u_long): u_long;
+ function Listen(s: TSocket; backlog: Integer): Integer;
+ function IoctlSocket(s: TSocket; cmd: DWORD; var arg: integer): Integer;
+ function htons(hostshort: u_short): u_short;
+ function htonl(hostlong: u_long): u_long;
+// function GetSockName(s: TSocket; name: PSockAddr; var namelen: Integer): Integer;
+ function GetSockName(s: TSocket; var name: TVarSin): Integer;
+// function GetPeerName(s: TSocket; name: PSockAddr; var namelen: Integer): Integer;
+ function GetPeerName(s: TSocket; var name: TVarSin): Integer;
+// function Connect(s: TSocket; name: PSockAddr; namelen: Integer): Integer;
+ function Connect(s: TSocket; const name: TVarSin): Integer;
+ function CloseSocket(s: TSocket): Integer;
+// function Bind(s: TSocket; addr: PSockAddr; namelen: Integer): Integer;
+ function Bind(s: TSocket; const addr: TVarSin): Integer;
+// function Accept(s: TSocket; addr: PSockAddr; var addrlen: Integer): TSocket;
+ function Accept(s: TSocket; var addr: TVarSin): TSocket;
+ function Socket(af, Struc, Protocol: Integer): TSocket;
+// Select = function(nfds: Integer; readfds, writefds, exceptfds: PFDSet;
+// timeout: PTimeVal): Longint;
+// {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF};
+
+// TWSAIoctl = function (s: TSocket; dwIoControlCode: DWORD; lpvInBuffer: Pointer;
+// cbInBuffer: DWORD; lpvOutBuffer: Pointer; cbOutBuffer: DWORD;
+// lpcbBytesReturned: PDWORD; lpOverlapped: Pointer;
+// lpCompletionRoutine: pointer): u_int;
+// stdcall;
+
+ function GetPortService(value: string): integer;
+
+function IsNewApi(Family: TAddrFamily): Boolean;
+function SetVarSin(var Sin: TVarSin; IP, Port: string; Family: TAddrFamily; SockProtocol, SockType: integer; PreferIP4: Boolean): integer;
+function GetSinIP(Sin: TVarSin): string;
+function GetSinPort(Sin: TVarSin): Integer;
+procedure ResolveNameToIP(Name: string; Family: TAddrFamily; SockProtocol, SockType: integer; const IPList: TStrings);
+function ResolveIPToName(IP: string; Family: TAddrFamily; SockProtocol, SockType: integer): string;
+function ResolvePort(Port: string; Family: TAddrFamily; SockProtocol, SockType: integer): Word;
+
+var
+ SynSockCS: SyncObjs.TCriticalSection;
+ SockEnhancedApi: Boolean;
+ SockWship6Api: Boolean;
+
+{==============================================================================}
+implementation
+
+threadvar
+ WSALastError: integer;
+ WSALastErrorDesc: string;
+
+var
+ services: Array [0..139, 0..1] of string =
+ (
+ ('echo', '7'),
+ ('discard', '9'),
+ ('sink', '9'),
+ ('null', '9'),
+ ('systat', '11'),
+ ('users', '11'),
+ ('daytime', '13'),
+ ('qotd', '17'),
+ ('quote', '17'),
+ ('chargen', '19'),
+ ('ttytst', '19'),
+ ('source', '19'),
+ ('ftp-data', '20'),
+ ('ftp', '21'),
+ ('telnet', '23'),
+ ('smtp', '25'),
+ ('mail', '25'),
+ ('time', '37'),
+ ('timeserver', '37'),
+ ('rlp', '39'),
+ ('nameserver', '42'),
+ ('name', '42'),
+ ('nickname', '43'),
+ ('whois', '43'),
+ ('domain', '53'),
+ ('bootps', '67'),
+ ('dhcps', '67'),
+ ('bootpc', '68'),
+ ('dhcpc', '68'),
+ ('tftp', '69'),
+ ('gopher', '70'),
+ ('finger', '79'),
+ ('http', '80'),
+ ('www', '80'),
+ ('www-http', '80'),
+ ('kerberos', '88'),
+ ('hostname', '101'),
+ ('hostnames', '101'),
+ ('iso-tsap', '102'),
+ ('rtelnet', '107'),
+ ('pop2', '109'),
+ ('postoffice', '109'),
+ ('pop3', '110'),
+ ('sunrpc', '111'),
+ ('rpcbind', '111'),
+ ('portmap', '111'),
+ ('auth', '113'),
+ ('ident', '113'),
+ ('tap', '113'),
+ ('uucp-path', '117'),
+ ('nntp', '119'),
+ ('usenet', '119'),
+ ('ntp', '123'),
+ ('epmap', '135'),
+ ('loc-srv', '135'),
+ ('netbios-ns', '137'),
+ ('nbname', '137'),
+ ('netbios-dgm', '138'),
+ ('nbdatagram', '138'),
+ ('netbios-ssn', '139'),
+ ('nbsession', '139'),
+ ('imap', '143'),
+ ('imap4', '143'),
+ ('pcmail-srv', '158'),
+ ('snmp', '161'),
+ ('snmptrap', '162'),
+ ('snmp-trap', '162'),
+ ('print-srv', '170'),
+ ('bgp', '179'),
+ ('irc', '194'),
+ ('ipx', '213'),
+ ('ldap', '389'),
+ ('https', '443'),
+ ('mcom', '443'),
+ ('microsoft-ds', '445'),
+ ('kpasswd', '464'),
+ ('isakmp', '500'),
+ ('ike', '500'),
+ ('exec', '512'),
+ ('biff', '512'),
+ ('comsat', '512'),
+ ('login', '513'),
+ ('who', '513'),
+ ('whod', '513'),
+ ('cmd', '514'),
+ ('shell', '514'),
+ ('syslog', '514'),
+ ('printer', '515'),
+ ('spooler', '515'),
+ ('talk', '517'),
+ ('ntalk', '517'),
+ ('efs', '520'),
+ ('router', '520'),
+ ('route', '520'),
+ ('routed', '520'),
+ ('timed', '525'),
+ ('timeserver', '525'),
+ ('tempo', '526'),
+ ('newdate', '526'),
+ ('courier', '530'),
+ ('rpc', '530'),
+ ('conference', '531'),
+ ('chat', '531'),
+ ('netnews', '532'),
+ ('readnews', '532'),
+ ('netwall', '533'),
+ ('uucp', '540'),
+ ('uucpd', '540'),
+ ('klogin', '543'),
+ ('kshell', '544'),
+ ('krcmd', '544'),
+ ('new-rwho', '550'),
+ ('new-who', '550'),
+ ('remotefs', '556'),
+ ('rfs', '556'),
+ ('rfs_server', '556'),
+ ('rmonitor', '560'),
+ ('rmonitord', '560'),
+ ('monitor', '561'),
+ ('ldaps', '636'),
+ ('sldap', '636'),
+ ('doom', '666'),
+ ('kerberos-adm', '749'),
+ ('kerberos-iv', '750'),
+ ('kpop', '1109'),
+ ('phone', '1167'),
+ ('ms-sql-s', '1433'),
+ ('ms-sql-m', '1434'),
+ ('wins', '1512'),
+ ('ingreslock', '1524'),
+ ('ingres', '1524'),
+ ('l2tp', '1701'),
+ ('pptp', '1723'),
+ ('radius', '1812'),
+ ('radacct', '1813'),
+ ('nfsd', '2049'),
+ ('nfs', '2049'),
+ ('knetd', '2053'),
+ ('gds_db', '3050'),
+ ('man', '9535')
+ );
+
+{function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean;
+begin
+ Result := ((a^.s_un_dw.s_dw1 = 0) and (a^.s_un_dw.s_dw2 = 0) and
+ (a^.s_un_dw.s_dw3 = 0) and (a^.s_un_dw.s_dw4 = 0));
+end;
+
+function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean;
+begin
+ Result := ((a^.s_un_dw.s_dw1 = 0) and (a^.s_un_dw.s_dw2 = 0) and
+ (a^.s_un_dw.s_dw3 = 0) and
+ (a^.s_un_b.s_b13 = char(0)) and (a^.s_un_b.s_b14 = char(0)) and
+ (a^.s_un_b.s_b15 = char(0)) and (a^.s_un_b.s_b16 = char(1)));
+end;
+
+function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean;
+begin
+ Result := ((a^.s_un_b.s_b1 = u_char($FE)) and (a^.s_un_b.s_b2 = u_char($80)));
+end;
+
+function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean;
+begin
+ Result := ((a^.s_un_b.s_b1 = u_char($FE)) and (a^.s_un_b.s_b2 = u_char($C0)));
+end;
+
+function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean;
+begin
+ Result := (a^.s_un_b.s_b1 = char($FF));
+end;
+
+function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6): boolean;
+begin
+ Result := (CompareMem( a, b, sizeof(TInAddr6)));
+end;
+
+procedure SET_IN6_IF_ADDR_ANY (const a: PInAddr6);
+begin
+ FillChar(a^, sizeof(TInAddr6), 0);
+end;
+
+procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6);
+begin
+ FillChar(a^, sizeof(TInAddr6), 0);
+ a^.s_un_b.s_b16 := char(1);
+end;
+}
+
+{=============================================================================}
+
+procedure NullErr;
+begin
+ WSALastError := 0;
+ WSALastErrorDesc := '';
+end;
+
+procedure GetErrCode(E: System.Exception);
+var
+ SE: System.Net.Sockets.SocketException;
+begin
+ if E is System.Net.Sockets.SocketException then
+ begin
+ SE := E as System.Net.Sockets.SocketException;
+ WSALastError := SE.ErrorCode;
+ WSALastErrorDesc := SE.Message;
+ end
+end;
+
+function WSAStartup(wVersionRequired: Word; var WSData: TWSAData): Integer;
+begin
+ NullErr;
+ with WSData do
+ begin
+ wVersion := wVersionRequired;
+ wHighVersion := $202;
+ szDescription := 'Synsock - Synapse Platform Independent Socket Layer';
+ szSystemStatus := 'Running on .NET';
+ iMaxSockets := 32768;
+ iMaxUdpDg := 8192;
+ end;
+ Result := 0;
+end;
+
+function WSACleanup: Integer;
+begin
+ NullErr;
+ Result := 0;
+end;
+
+function WSAGetLastError: Integer;
+begin
+ Result := WSALastError;
+end;
+
+function WSAGetLastErrorDesc: String;
+begin
+ Result := WSALastErrorDesc;
+end;
+
+function GetHostName: string;
+begin
+ Result := System.Net.DNS.GetHostName;
+end;
+
+function Shutdown(s: TSocket; how: Integer): Integer;
+begin
+ Result := 0;
+ NullErr;
+ try
+ s.ShutDown(SocketShutdown(how));
+ except
+ on e: System.Net.Sockets.SocketException do
+ begin
+ GetErrCode(e);
+ Result := integer(SOCKET_ERROR);
+ end;
+ end;
+end;
+
+function SetSockOpt(s: TSocket; level, optname: Integer; optval: Tmemory;
+ optlen: Integer): Integer;
+begin
+ Result := 0;
+ NullErr;
+ try
+ s.SetSocketOption(SocketOptionLevel(level), SocketOptionName(optname), optval);
+ except
+ on e: System.Net.Sockets.SocketException do
+ begin
+ GetErrCode(e);
+ Result := integer(SOCKET_ERROR);
+ end;
+ end;
+end;
+
+function SetSockOptObj(s: TSocket; level, optname: Integer; optval: TObject): Integer;
+begin
+ Result := 0;
+ NullErr;
+ try
+ s.SetSocketOption(SocketOptionLevel(level), SocketOptionName(optname), optval);
+ except
+ on e: System.Net.Sockets.SocketException do
+ begin
+ GetErrCode(e);
+ Result := integer(SOCKET_ERROR);
+ end;
+ end;
+end;
+
+function GetSockOpt(s: TSocket; level, optname: Integer; optval: Tmemory;
+ var optlen: Integer): Integer;
+begin
+ Result := 0;
+ NullErr;
+ try
+ s.GetSocketOption(SocketOptionLevel(level), SocketOptionName(optname), optval);
+ except
+ on e: System.Net.Sockets.SocketException do
+ begin
+ GetErrCode(e);
+ Result := integer(SOCKET_ERROR);
+ end;
+ end;
+end;
+
+function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin): Integer;
+//function SendTo(s: TSocket; const Buf; len, flags: Integer; addrto: TVarSin): Integer;
+begin
+ NullErr;
+ try
+ result := s.SendTo(Buf, len, SocketFlags(flags), addrto);
+ except
+ on e: System.Net.Sockets.SocketException do
+ begin
+ GetErrCode(e);
+ Result := integer(SOCKET_ERROR);
+ end;
+ end;
+end;
+
+function Send(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
+//function Send(s: TSocket; const Buf; len, flags: Integer): Integer;
+begin
+ NullErr;
+ try
+ result := s.Send(Buf, len, SocketFlags(flags));
+ except
+ on e: System.Net.Sockets.SocketException do
+ begin
+ GetErrCode(e);
+ Result := integer(SOCKET_ERROR);
+ end;
+ end;
+end;
+
+function Recv(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
+//function Recv(s: TSocket; var Buf; len, flags: Integer): Integer;
+begin
+ NullErr;
+ try
+ result := s.Receive(Buf, len, SocketFlags(flags));
+ except
+ on e: System.Net.Sockets.SocketException do
+ begin
+ GetErrCode(e);
+ Result := integer(SOCKET_ERROR);
+ end;
+ end;
+end;
+
+//function RecvFrom(s: TSocket; var Buf; len, flags: Integer; from: PSockAddr;
+// var fromlen: Integer): Integer;
+function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer;
+//function RecvFrom(s: TSocket; var Buf; len, flags: Integer; from: TVarSin): Integer;
+var
+ EP: EndPoint;
+begin
+ NullErr;
+ try
+ EP := from;
+ result := s.ReceiveFrom(Buf, len, SocketFlags(flags), EndPoint(EP));
+ from := EP as IPEndPoint;
+ except
+ on e: System.Net.Sockets.SocketException do
+ begin
+ GetErrCode(e);
+ Result := integer(SOCKET_ERROR);
+ end;
+ end;
+end;
+
+function ntohs(netshort: u_short): u_short;
+begin
+ Result := IPAddress.NetworkToHostOrder(NetShort);
+end;
+
+function ntohl(netlong: u_long): u_long;
+begin
+ Result := IPAddress.NetworkToHostOrder(NetLong);
+end;
+
+function Listen(s: TSocket; backlog: Integer): Integer;
+begin
+ Result := 0;
+ NullErr;
+ try
+ s.Listen(backlog);
+ except
+ on e: System.Net.Sockets.SocketException do
+ begin
+ GetErrCode(e);
+ Result := integer(SOCKET_ERROR);
+ end;
+ end;
+end;
+
+function IoctlSocket(s: TSocket; cmd: DWORD; var arg: integer): Integer;
+var
+ inv, outv: TMemory;
+begin
+ Result := 0;
+ NullErr;
+ try
+ if cmd = DWORD(FIONBIO) then
+ s.Blocking := arg = 0
+ else
+ begin
+ inv := BitConverter.GetBytes(arg);
+ outv := BitConverter.GetBytes(integer(0));
+ s.IOControl(cmd, inv, outv);
+ arg := BitConverter.ToInt32(outv, 0);
+ end;
+ except
+ on e: System.Net.Sockets.SocketException do
+ begin
+ GetErrCode(e);
+ Result := integer(SOCKET_ERROR);
+ end;
+ end;
+end;
+
+function htons(hostshort: u_short): u_short;
+begin
+ Result := IPAddress.HostToNetworkOrder(Hostshort);
+end;
+
+function htonl(hostlong: u_long): u_long;
+begin
+ Result := IPAddress.HostToNetworkOrder(HostLong);
+end;
+
+//function GetSockName(s: TSocket; name: PSockAddr; var namelen: Integer): Integer;
+function GetSockName(s: TSocket; var name: TVarSin): Integer;
+begin
+ Result := 0;
+ NullErr;
+ try
+ Name := s.localEndPoint as IPEndpoint;
+ except
+ on e: System.Net.Sockets.SocketException do
+ begin
+ GetErrCode(e);
+ Result := integer(SOCKET_ERROR);
+ end;
+ end;
+end;
+
+//function GetPeerName(s: TSocket; name: PSockAddr; var namelen: Integer): Integer;
+function GetPeerName(s: TSocket; var name: TVarSin): Integer;
+begin
+ Result := 0;
+ NullErr;
+ try
+ Name := s.RemoteEndPoint as IPEndpoint;
+ except
+ on e: System.Net.Sockets.SocketException do
+ begin
+ GetErrCode(e);
+ Result := integer(SOCKET_ERROR);
+ end;
+ end;
+end;
+
+//function Connect(s: TSocket; name: PSockAddr; namelen: Integer): Integer;
+function Connect(s: TSocket; const name: TVarSin): Integer;
+begin
+ Result := 0;
+ NullErr;
+ try
+ s.Connect(name);
+ except
+ on e: System.Net.Sockets.SocketException do
+ begin
+ GetErrCode(e);
+ Result := integer(SOCKET_ERROR);
+ end;
+ end;
+end;
+
+function CloseSocket(s: TSocket): Integer;
+begin
+ Result := 0;
+ NullErr;
+ try
+ s.Close;
+ except
+ on e: System.Net.Sockets.SocketException do
+ begin
+ Result := integer(SOCKET_ERROR);
+ end;
+ end;
+end;
+
+//function Bind(s: TSocket; addr: PSockAddr; namelen: Integer): Integer;
+function Bind(s: TSocket; const addr: TVarSin): Integer;
+begin
+ Result := 0;
+ NullErr;
+ try
+ s.Bind(addr);
+ except
+ on e: System.Net.Sockets.SocketException do
+ begin
+ GetErrCode(e);
+ Result := integer(SOCKET_ERROR);
+ end;
+ end;
+end;
+
+//function Accept(s: TSocket; addr: PSockAddr; var addrlen: Integer): TSocket;
+function Accept(s: TSocket; var addr: TVarSin): TSocket;
+begin
+ NullErr;
+ try
+ result := s.Accept();
+ except
+ on e: System.Net.Sockets.SocketException do
+ begin
+ GetErrCode(e);
+ Result := nil;
+ end;
+ end;
+end;
+
+function Socket(af, Struc, Protocol: Integer): TSocket;
+begin
+ NullErr;
+ try
+ result := TSocket.Create(AddressFamily(af), SocketType(Struc), ProtocolType(Protocol));
+ except
+ on e: System.Net.Sockets.SocketException do
+ begin
+ GetErrCode(e);
+ Result := nil;
+ end;
+ end;
+end;
+
+{=============================================================================}
+function GetPortService(value: string): integer;
+var
+ n: integer;
+begin
+ Result := 0;
+ value := Lowercase(value);
+ for n := 0 to High(Services) do
+ if services[n, 0] = value then
+ begin
+ Result := strtointdef(services[n, 1], 0);
+ break;
+ end;
+ if Result = 0 then
+ Result := StrToIntDef(value, 0);
+end;
+
+{=============================================================================}
+function IsNewApi(Family: TAddrFamily): Boolean;
+begin
+ Result := true;
+end;
+
+function SetVarSin(var Sin: TVarSin; IP, Port: string; Family: TAddrFamily; SockProtocol, SockType: integer; PreferIP4: Boolean): integer;
+var
+ IPs: array of IPAddress;
+ n: integer;
+ ip4, ip6: string;
+ sip: string;
+begin
+ sip := '';
+ ip4 := '';
+ ip6 := '';
+ IPs := Dns.Resolve(IP).AddressList;
+ for n :=low(IPs) to high(IPs) do begin
+ if (ip4 = '') and (IPs[n].AddressFamily = AF_INET) then
+ ip4 := IPs[n].toString;
+ if (ip6 = '') and (IPs[n].AddressFamily = AF_INET6) then
+ ip6 := IPs[n].toString;
+ if (ip4 <> '') and (ip6 <> '') then
+ break;
+ end;
+ case Family of
+ AF_UNSPEC:
+ begin
+ if (ip4 <> '') and (ip6 <> '') then
+ begin
+ if PreferIP4 then
+ sip := ip4
+ else
+ Sip := ip6;
+ end
+ else
+ begin
+ sip := ip4;
+ if (ip6 <> '') then
+ sip := ip6;
+ end;
+ end;
+ AF_INET:
+ sip := ip4;
+ AF_INET6:
+ sip := ip6;
+ end;
+ sin := TVarSin.Create(IPAddress.Parse(sip), GetPortService(Port));
+end;
+
+function GetSinIP(Sin: TVarSin): string;
+begin
+ Result := Sin.Address.ToString;
+end;
+
+function GetSinPort(Sin: TVarSin): Integer;
+begin
+ Result := Sin.Port;
+end;
+
+procedure ResolveNameToIP(Name: string; Family: TAddrFamily; SockProtocol, SockType: integer; const IPList: TStrings);
+var
+ IPs :array of IPAddress;
+ n: integer;
+begin
+ IPList.Clear;
+ IPs := Dns.Resolve(Name).AddressList;
+ for n := low(IPs) to high(IPs) do
+ begin
+ if not(((Family = AF_INET6) and (IPs[n].AddressFamily = AF_INET))
+ or ((Family = AF_INET) and (IPs[n].AddressFamily = AF_INET6))) then
+ begin
+ IPList.Add(IPs[n].toString);
+ end;
+ end;
+end;
+
+function ResolvePort(Port: string; Family: TAddrFamily; SockProtocol, SockType: integer): Word;
+var
+ n: integer;
+begin
+ Result := StrToIntDef(port, 0);
+ if Result = 0 then
+ begin
+ port := Lowercase(port);
+ for n := 0 to High(Services) do
+ if services[n, 0] = port then
+ begin
+ Result := strtointdef(services[n, 1], 0);
+ break;
+ end;
+ end;
+end;
+
+function ResolveIPToName(IP: string; Family: TAddrFamily; SockProtocol, SockType: integer): string;
+begin
+ Result := Dns.GetHostByAddress(IP).HostName;
+end;
+
+
+{=============================================================================}
+function InitSocketInterface(stack: string): Boolean;
+begin
+ Result := True;
+end;
+
+function DestroySocketInterface: Boolean;
+begin
+ NullErr;
+ Result := True;
+end;
+
+initialization
+begin
+ SynSockCS := SyncObjs.TCriticalSection.Create;
+// SET_IN6_IF_ADDR_ANY (@in6addr_any);
+// SET_LOOPBACK_ADDR6 (@in6addr_loopback);
+end;
+
+finalization
+begin
+ NullErr;
+ SynSockCS.Free;
+end;
+
+{$ENDIF}
ADDED lib/synapse/source/lib/ssfpc.inc
Index: lib/synapse/source/lib/ssfpc.inc
==================================================================
--- /dev/null
+++ lib/synapse/source/lib/ssfpc.inc
@@ -0,0 +1,909 @@
+{==============================================================================|
+| Project : Ararat Synapse | 001.001.004 |
+|==============================================================================|
+| Content: Socket Independent Platform Layer - FreePascal definition include |
+|==============================================================================|
+| Copyright (c)2006-2011, Lukas Gebauer |
+| All rights reserved. |
+| |
+| Redistribution and use in source and binary forms, with or without |
+| modification, are permitted provided that the following conditions are met: |
+| |
+| Redistributions of source code must retain the above copyright notice, this |
+| list of conditions and the following disclaimer. |
+| |
+| Redistributions in binary form must reproduce the above copyright notice, |
+| this list of conditions and the following disclaimer in the documentation |
+| and/or other materials provided with the distribution. |
+| |
+| Neither the name of Lukas Gebauer nor the names of its contributors may |
+| be used to endorse or promote products derived from this software without |
+| specific prior written permission. |
+| |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
+| DAMAGE. |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2006-2011. |
+| All Rights Reserved. |
+|==============================================================================|
+| Contributor(s): |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package |
+| (Found at URL: http://www.ararat.cz/synapse/) |
+|==============================================================================}
+
+{:@exclude}
+
+{$IFDEF FPC}
+{For FreePascal 2.x.x}
+
+//{$DEFINE FORCEOLDAPI}
+{Note about define FORCEOLDAPI:
+If you activate this compiler directive, then is allways used old socket API
+for name resolution. If you leave this directive inactive, then the new API
+is used, when running system allows it.
+
+For IPv6 support you must have new API!
+}
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+
+{$ifdef FreeBSD}
+{$DEFINE SOCK_HAS_SINLEN} // BSD definition of scoketaddr
+{$endif}
+{$ifdef darwin}
+{$DEFINE SOCK_HAS_SINLEN} // BSD definition of scoketaddr
+{$endif}
+
+interface
+
+uses
+ SyncObjs, SysUtils, Classes,
+ synafpc, BaseUnix, Unix, termio, sockets, netdb;
+
+function InitSocketInterface(stack: string): Boolean;
+function DestroySocketInterface: Boolean;
+
+const
+ DLLStackName = '';
+ WinsockLevel = $0202;
+
+ cLocalHost = '127.0.0.1';
+ cAnyHost = '0.0.0.0';
+ c6AnyHost = '::0';
+ c6Localhost = '::1';
+ cLocalHostStr = 'localhost';
+
+type
+ TSocket = longint;
+ TAddrFamily = integer;
+
+ TMemory = pointer;
+
+
+type
+ TFDSet = Baseunix.TFDSet;
+ PFDSet = ^TFDSet;
+ Ptimeval = Baseunix.ptimeval;
+ Ttimeval = Baseunix.ttimeval;
+
+const
+ FIONREAD = termio.FIONREAD;
+ FIONBIO = termio.FIONBIO;
+ FIOASYNC = termio.FIOASYNC;
+
+const
+ IPPROTO_IP = 0; { Dummy }
+ IPPROTO_ICMP = 1; { Internet Control Message Protocol }
+ IPPROTO_IGMP = 2; { Internet Group Management Protocol}
+ IPPROTO_TCP = 6; { TCP }
+ IPPROTO_UDP = 17; { User Datagram Protocol }
+ IPPROTO_IPV6 = 41;
+ IPPROTO_ICMPV6 = 58;
+ IPPROTO_RM = 113;
+
+ IPPROTO_RAW = 255;
+ IPPROTO_MAX = 256;
+
+type
+ PInAddr = ^TInAddr;
+ TInAddr = sockets.in_addr;
+
+ PSockAddrIn = ^TSockAddrIn;
+ TSockAddrIn = sockets.TInetSockAddr;
+
+
+ TIP_mreq = record
+ imr_multiaddr: TInAddr; // IP multicast address of group
+ imr_interface: TInAddr; // local IP address of interface
+ end;
+
+
+ PInAddr6 = ^TInAddr6;
+ TInAddr6 = sockets.Tin6_addr;
+
+ PSockAddrIn6 = ^TSockAddrIn6;
+ TSockAddrIn6 = sockets.TInetSockAddr6;
+
+
+ TIPv6_mreq = record
+ ipv6mr_multiaddr: TInAddr6; // IPv6 multicast address.
+ ipv6mr_interface: integer; // Interface index.
+ end;
+
+const
+ INADDR_ANY = $00000000;
+ INADDR_LOOPBACK = $7F000001;
+ INADDR_BROADCAST = $FFFFFFFF;
+ INADDR_NONE = $FFFFFFFF;
+ ADDR_ANY = INADDR_ANY;
+ INVALID_SOCKET = TSocket(NOT(0));
+ SOCKET_ERROR = -1;
+
+Const
+ IP_TOS = sockets.IP_TOS; { int; IP type of service and precedence. }
+ IP_TTL = sockets.IP_TTL; { int; IP time to live. }
+ IP_HDRINCL = sockets.IP_HDRINCL; { int; Header is included with data. }
+ IP_OPTIONS = sockets.IP_OPTIONS; { ip_opts; IP per-packet options. }
+// IP_ROUTER_ALERT = sockets.IP_ROUTER_ALERT; { bool }
+ IP_RECVOPTS = sockets.IP_RECVOPTS; { bool }
+ IP_RETOPTS = sockets.IP_RETOPTS; { bool }
+// IP_PKTINFO = sockets.IP_PKTINFO; { bool }
+// IP_PKTOPTIONS = sockets.IP_PKTOPTIONS;
+// IP_PMTUDISC = sockets.IP_PMTUDISC; { obsolete name? }
+// IP_MTU_DISCOVER = sockets.IP_MTU_DISCOVER; { int; see below }
+// IP_RECVERR = sockets.IP_RECVERR; { bool }
+// IP_RECVTTL = sockets.IP_RECVTTL; { bool }
+// IP_RECVTOS = sockets.IP_RECVTOS; { bool }
+ IP_MULTICAST_IF = sockets.IP_MULTICAST_IF; { in_addr; set/get IP multicast i/f }
+ IP_MULTICAST_TTL = sockets.IP_MULTICAST_TTL; { u_char; set/get IP multicast ttl }
+ IP_MULTICAST_LOOP = sockets.IP_MULTICAST_LOOP; { i_char; set/get IP multicast loopback }
+ IP_ADD_MEMBERSHIP = sockets.IP_ADD_MEMBERSHIP; { ip_mreq; add an IP group membership }
+ IP_DROP_MEMBERSHIP = sockets.IP_DROP_MEMBERSHIP; { ip_mreq; drop an IP group membership }
+
+ SOL_SOCKET = sockets.SOL_SOCKET;
+
+ SO_DEBUG = sockets.SO_DEBUG;
+ SO_REUSEADDR = sockets.SO_REUSEADDR;
+ SO_TYPE = sockets.SO_TYPE;
+ SO_ERROR = sockets.SO_ERROR;
+ SO_DONTROUTE = sockets.SO_DONTROUTE;
+ SO_BROADCAST = sockets.SO_BROADCAST;
+ SO_SNDBUF = sockets.SO_SNDBUF;
+ SO_RCVBUF = sockets.SO_RCVBUF;
+ SO_KEEPALIVE = sockets.SO_KEEPALIVE;
+ SO_OOBINLINE = sockets.SO_OOBINLINE;
+// SO_NO_CHECK = sockets.SO_NO_CHECK;
+// SO_PRIORITY = sockets.SO_PRIORITY;
+ SO_LINGER = sockets.SO_LINGER;
+// SO_BSDCOMPAT = sockets.SO_BSDCOMPAT;
+// SO_REUSEPORT = sockets.SO_REUSEPORT;
+// SO_PASSCRED = sockets.SO_PASSCRED;
+// SO_PEERCRED = sockets.SO_PEERCRED;
+ SO_RCVLOWAT = sockets.SO_RCVLOWAT;
+ SO_SNDLOWAT = sockets.SO_SNDLOWAT;
+ SO_RCVTIMEO = sockets.SO_RCVTIMEO;
+ SO_SNDTIMEO = sockets.SO_SNDTIMEO;
+{ Security levels - as per NRL IPv6 - don't actually do anything }
+// SO_SECURITY_AUTHENTICATION = sockets.SO_SECURITY_AUTHENTICATION;
+// SO_SECURITY_ENCRYPTION_TRANSPORT = sockets.SO_SECURITY_ENCRYPTION_TRANSPORT;
+// SO_SECURITY_ENCRYPTION_NETWORK = sockets.SO_SECURITY_ENCRYPTION_NETWORK;
+// SO_BINDTODEVICE = sockets.SO_BINDTODEVICE;
+{ Socket filtering }
+// SO_ATTACH_FILTER = sockets.SO_ATTACH_FILTER;
+// SO_DETACH_FILTER = sockets.SO_DETACH_FILTER;
+
+ SOMAXCONN = 1024;
+
+ IPV6_UNICAST_HOPS = sockets.IPV6_UNICAST_HOPS;
+ IPV6_MULTICAST_IF = sockets.IPV6_MULTICAST_IF;
+ IPV6_MULTICAST_HOPS = sockets.IPV6_MULTICAST_HOPS;
+ IPV6_MULTICAST_LOOP = sockets.IPV6_MULTICAST_LOOP;
+ IPV6_JOIN_GROUP = sockets.IPV6_JOIN_GROUP;
+ IPV6_LEAVE_GROUP = sockets.IPV6_LEAVE_GROUP;
+
+const
+ SOCK_STREAM = 1; { stream socket }
+ SOCK_DGRAM = 2; { datagram socket }
+ SOCK_RAW = 3; { raw-protocol interface }
+ SOCK_RDM = 4; { reliably-delivered message }
+ SOCK_SEQPACKET = 5; { sequenced packet stream }
+
+{ TCP options. }
+ TCP_NODELAY = $0001;
+
+{ Address families. }
+
+ AF_UNSPEC = 0; { unspecified }
+ AF_INET = 2; { internetwork: UDP, TCP, etc. }
+ AF_INET6 = 10; { Internetwork Version 6 }
+ AF_MAX = 24;
+
+{ Protocol families, same as address families for now. }
+ PF_UNSPEC = AF_UNSPEC;
+ PF_INET = AF_INET;
+ PF_INET6 = AF_INET6;
+ PF_MAX = AF_MAX;
+
+type
+{ Structure used for manipulating linger option. }
+ PLinger = ^TLinger;
+ TLinger = packed record
+ l_onoff: integer;
+ l_linger: integer;
+ end;
+
+const
+
+ MSG_OOB = sockets.MSG_OOB; // Process out-of-band data.
+ MSG_PEEK = sockets.MSG_PEEK; // Peek at incoming messages.
+ {$ifdef DARWIN}
+ MSG_NOSIGNAL = $20000; // Do not generate SIGPIPE.
+ // Works under MAC OS X, but is undocumented,
+ // So FPC doesn't include it
+ {$else}
+ MSG_NOSIGNAL = sockets.MSG_NOSIGNAL; // Do not generate SIGPIPE.
+ {$endif}
+
+const
+ WSAEINTR = ESysEINTR;
+ WSAEBADF = ESysEBADF;
+ WSAEACCES = ESysEACCES;
+ WSAEFAULT = ESysEFAULT;
+ WSAEINVAL = ESysEINVAL;
+ WSAEMFILE = ESysEMFILE;
+ WSAEWOULDBLOCK = ESysEWOULDBLOCK;
+ WSAEINPROGRESS = ESysEINPROGRESS;
+ WSAEALREADY = ESysEALREADY;
+ WSAENOTSOCK = ESysENOTSOCK;
+ WSAEDESTADDRREQ = ESysEDESTADDRREQ;
+ WSAEMSGSIZE = ESysEMSGSIZE;
+ WSAEPROTOTYPE = ESysEPROTOTYPE;
+ WSAENOPROTOOPT = ESysENOPROTOOPT;
+ WSAEPROTONOSUPPORT = ESysEPROTONOSUPPORT;
+ WSAESOCKTNOSUPPORT = ESysESOCKTNOSUPPORT;
+ WSAEOPNOTSUPP = ESysEOPNOTSUPP;
+ WSAEPFNOSUPPORT = ESysEPFNOSUPPORT;
+ WSAEAFNOSUPPORT = ESysEAFNOSUPPORT;
+ WSAEADDRINUSE = ESysEADDRINUSE;
+ WSAEADDRNOTAVAIL = ESysEADDRNOTAVAIL;
+ WSAENETDOWN = ESysENETDOWN;
+ WSAENETUNREACH = ESysENETUNREACH;
+ WSAENETRESET = ESysENETRESET;
+ WSAECONNABORTED = ESysECONNABORTED;
+ WSAECONNRESET = ESysECONNRESET;
+ WSAENOBUFS = ESysENOBUFS;
+ WSAEISCONN = ESysEISCONN;
+ WSAENOTCONN = ESysENOTCONN;
+ WSAESHUTDOWN = ESysESHUTDOWN;
+ WSAETOOMANYREFS = ESysETOOMANYREFS;
+ WSAETIMEDOUT = ESysETIMEDOUT;
+ WSAECONNREFUSED = ESysECONNREFUSED;
+ WSAELOOP = ESysELOOP;
+ WSAENAMETOOLONG = ESysENAMETOOLONG;
+ WSAEHOSTDOWN = ESysEHOSTDOWN;
+ WSAEHOSTUNREACH = ESysEHOSTUNREACH;
+ WSAENOTEMPTY = ESysENOTEMPTY;
+ WSAEPROCLIM = -1;
+ WSAEUSERS = ESysEUSERS;
+ WSAEDQUOT = ESysEDQUOT;
+ WSAESTALE = ESysESTALE;
+ WSAEREMOTE = ESysEREMOTE;
+ WSASYSNOTREADY = -2;
+ WSAVERNOTSUPPORTED = -3;
+ WSANOTINITIALISED = -4;
+ WSAEDISCON = -5;
+ WSAHOST_NOT_FOUND = 1;
+ WSATRY_AGAIN = 2;
+ WSANO_RECOVERY = 3;
+ WSANO_DATA = -6;
+
+const
+ WSADESCRIPTION_LEN = 256;
+ WSASYS_STATUS_LEN = 128;
+type
+ PWSAData = ^TWSAData;
+ TWSAData = packed record
+ wVersion: Word;
+ wHighVersion: Word;
+ szDescription: array[0..WSADESCRIPTION_LEN] of Char;
+ szSystemStatus: array[0..WSASYS_STATUS_LEN] of Char;
+ iMaxSockets: Word;
+ iMaxUdpDg: Word;
+ lpVendorInfo: PChar;
+ end;
+
+ function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean;
+ function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean;
+ function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean;
+ function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean;
+ function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean;
+ function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6):boolean;
+ procedure SET_IN6_IF_ADDR_ANY (const a: PInAddr6);
+ procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6);
+
+var
+ in6addr_any, in6addr_loopback : TInAddr6;
+
+procedure FD_CLR(Socket: TSocket; var FDSet: TFDSet);
+function FD_ISSET(Socket: TSocket; var FDSet: TFDSet): Boolean;
+procedure FD_SET(Socket: TSocket; var FDSet: TFDSet);
+procedure FD_ZERO(var FDSet: TFDSet);
+
+{=============================================================================}
+
+var
+ SynSockCS: SyncObjs.TCriticalSection;
+ SockEnhancedApi: Boolean;
+ SockWship6Api: Boolean;
+
+type
+ TVarSin = packed record
+ {$ifdef SOCK_HAS_SINLEN}
+ sin_len : cuchar;
+ {$endif}
+ case integer of
+ 0: (AddressFamily: sa_family_t);
+ 1: (
+ case sin_family: sa_family_t of
+ AF_INET: (sin_port: word;
+ sin_addr: TInAddr;
+ sin_zero: array[0..7] of Char);
+ AF_INET6: (sin6_port: word;
+ sin6_flowinfo: longword;
+ sin6_addr: TInAddr6;
+ sin6_scope_id: longword);
+ );
+ end;
+
+function SizeOfVarSin(sin: TVarSin): integer;
+
+ function WSAStartup(wVersionRequired: Word; var WSData: TWSAData): Integer;
+ function WSACleanup: Integer;
+ function WSAGetLastError: Integer;
+ function GetHostName: string;
+ function Shutdown(s: TSocket; how: Integer): Integer;
+ function SetSockOpt(s: TSocket; level, optname: Integer; optval: TMemory;
+ optlen: Integer): Integer;
+ function GetSockOpt(s: TSocket; level, optname: Integer; optval: TMemory;
+ var optlen: Integer): Integer;
+ function Send(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
+ function Recv(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
+ function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin): Integer;
+ function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer;
+ function ntohs(netshort: word): word;
+ function ntohl(netlong: longword): longword;
+ function Listen(s: TSocket; backlog: Integer): Integer;
+ function IoctlSocket(s: TSocket; cmd: DWORD; var arg: integer): Integer;
+ function htons(hostshort: word): word;
+ function htonl(hostlong: longword): longword;
+ function GetSockName(s: TSocket; var name: TVarSin): Integer;
+ function GetPeerName(s: TSocket; var name: TVarSin): Integer;
+ function Connect(s: TSocket; const name: TVarSin): Integer;
+ function CloseSocket(s: TSocket): Integer;
+ function Bind(s: TSocket; const addr: TVarSin): Integer;
+ function Accept(s: TSocket; var addr: TVarSin): TSocket;
+ function Socket(af, Struc, Protocol: Integer): TSocket;
+ function Select(nfds: Integer; readfds, writefds, exceptfds: PFDSet;
+ timeout: PTimeVal): Longint;
+
+function IsNewApi(Family: integer): Boolean;
+function SetVarSin(var Sin: TVarSin; IP, Port: string; Family, SockProtocol, SockType: integer; PreferIP4: Boolean): integer;
+function GetSinIP(Sin: TVarSin): string;
+function GetSinPort(Sin: TVarSin): Integer;
+procedure ResolveNameToIP(Name: string; Family, SockProtocol, SockType: integer; const IPList: TStrings);
+function ResolveIPToName(IP: string; Family, SockProtocol, SockType: integer): string;
+function ResolvePort(Port: string; Family, SockProtocol, SockType: integer): Word;
+
+
+{==============================================================================}
+implementation
+
+
+function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean;
+begin
+ Result := ((a^.u6_addr32[0] = 0) and (a^.u6_addr32[1] = 0) and
+ (a^.u6_addr32[2] = 0) and (a^.u6_addr32[3] = 0));
+end;
+
+function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean;
+begin
+ Result := ((a^.u6_addr32[0] = 0) and (a^.u6_addr32[1] = 0) and
+ (a^.u6_addr32[2] = 0) and
+ (a^.u6_addr8[12] = 0) and (a^.u6_addr8[13] = 0) and
+ (a^.u6_addr8[14] = 0) and (a^.u6_addr8[15] = 1));
+end;
+
+function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean;
+begin
+ Result := ((a^.u6_addr8[0] = $FE) and (a^.u6_addr8[1] = $80));
+end;
+
+function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean;
+begin
+ Result := ((a^.u6_addr8[0] = $FE) and (a^.u6_addr8[1] = $C0));
+end;
+
+function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean;
+begin
+ Result := (a^.u6_addr8[0] = $FF);
+end;
+
+function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6): boolean;
+begin
+ Result := (CompareMem( a, b, sizeof(TInAddr6)));
+end;
+
+procedure SET_IN6_IF_ADDR_ANY (const a: PInAddr6);
+begin
+ FillChar(a^, sizeof(TInAddr6), 0);
+end;
+
+procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6);
+begin
+ FillChar(a^, sizeof(TInAddr6), 0);
+ a^.u6_addr8[15] := 1;
+end;
+
+{=============================================================================}
+
+function WSAStartup(wVersionRequired: Word; var WSData: TWSAData): Integer;
+begin
+ with WSData do
+ begin
+ wVersion := wVersionRequired;
+ wHighVersion := $202;
+ szDescription := 'Synsock - Synapse Platform Independent Socket Layer';
+ szSystemStatus := 'Running on Unix/Linux by FreePascal';
+ iMaxSockets := 32768;
+ iMaxUdpDg := 8192;
+ end;
+ Result := 0;
+end;
+
+function WSACleanup: Integer;
+begin
+ Result := 0;
+end;
+
+function WSAGetLastError: Integer;
+begin
+ Result := fpGetErrno;
+end;
+
+function FD_ISSET(Socket: TSocket; var fdset: TFDSet): Boolean;
+begin
+ Result := fpFD_ISSET(socket, fdset) <> 0;
+end;
+
+procedure FD_SET(Socket: TSocket; var fdset: TFDSet);
+begin
+ fpFD_SET(Socket, fdset);
+end;
+
+procedure FD_CLR(Socket: TSocket; var fdset: TFDSet);
+begin
+ fpFD_CLR(Socket, fdset);
+end;
+
+procedure FD_ZERO(var fdset: TFDSet);
+begin
+ fpFD_ZERO(fdset);
+end;
+
+{=============================================================================}
+
+function SizeOfVarSin(sin: TVarSin): integer;
+begin
+ case sin.sin_family of
+ AF_INET:
+ Result := SizeOf(TSockAddrIn);
+ AF_INET6:
+ Result := SizeOf(TSockAddrIn6);
+ else
+ Result := 0;
+ end;
+end;
+
+{=============================================================================}
+
+function Bind(s: TSocket; const addr: TVarSin): Integer;
+begin
+ if fpBind(s, @addr, SizeOfVarSin(addr)) = 0 then
+ Result := 0
+ else
+ Result := SOCKET_ERROR;
+end;
+
+function Connect(s: TSocket; const name: TVarSin): Integer;
+begin
+ if fpConnect(s, @name, SizeOfVarSin(name)) = 0 then
+ Result := 0
+ else
+ Result := SOCKET_ERROR;
+end;
+
+function GetSockName(s: TSocket; var name: TVarSin): Integer;
+var
+ len: integer;
+begin
+ len := SizeOf(name);
+ FillChar(name, len, 0);
+ Result := fpGetSockName(s, @name, @Len);
+end;
+
+function GetPeerName(s: TSocket; var name: TVarSin): Integer;
+var
+ len: integer;
+begin
+ len := SizeOf(name);
+ FillChar(name, len, 0);
+ Result := fpGetPeerName(s, @name, @Len);
+end;
+
+function GetHostName: string;
+begin
+ Result := unix.GetHostName;
+end;
+
+function Send(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
+begin
+ Result := fpSend(s, pointer(Buf), len, flags);
+end;
+
+function Recv(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
+begin
+ Result := fpRecv(s, pointer(Buf), len, flags);
+end;
+
+function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin): Integer;
+begin
+ Result := fpSendTo(s, pointer(Buf), len, flags, @addrto, SizeOfVarSin(addrto));
+end;
+
+function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer;
+var
+ x: integer;
+begin
+ x := SizeOf(from);
+ Result := fpRecvFrom(s, pointer(Buf), len, flags, @from, @x);
+end;
+
+function Accept(s: TSocket; var addr: TVarSin): TSocket;
+var
+ x: integer;
+begin
+ x := SizeOf(addr);
+ Result := fpAccept(s, @addr, @x);
+end;
+
+function Shutdown(s: TSocket; how: Integer): Integer;
+begin
+ Result := fpShutdown(s, how);
+end;
+
+function SetSockOpt(s: TSocket; level, optname: Integer; optval: Tmemory;
+ optlen: Integer): Integer;
+begin
+ Result := fpsetsockopt(s, level, optname, pointer(optval), optlen);
+end;
+
+function GetSockOpt(s: TSocket; level, optname: Integer; optval: Tmemory;
+ var optlen: Integer): Integer;
+begin
+ Result := fpgetsockopt(s, level, optname, pointer(optval), @optlen);
+end;
+
+function ntohs(netshort: word): word;
+begin
+ Result := sockets.ntohs(NetShort);
+end;
+
+function ntohl(netlong: longword): longword;
+begin
+ Result := sockets.ntohl(NetLong);
+end;
+
+function Listen(s: TSocket; backlog: Integer): Integer;
+begin
+ if fpListen(s, backlog) = 0 then
+ Result := 0
+ else
+ Result := SOCKET_ERROR;
+end;
+
+function IoctlSocket(s: TSocket; cmd: DWORD; var arg: integer): Integer;
+begin
+ Result := fpIoctl(s, cmd, @arg);
+end;
+
+function htons(hostshort: word): word;
+begin
+ Result := sockets.htons(Hostshort);
+end;
+
+function htonl(hostlong: longword): longword;
+begin
+ Result := sockets.htonl(HostLong);
+end;
+
+function CloseSocket(s: TSocket): Integer;
+begin
+ Result := sockets.CloseSocket(s);
+end;
+
+function Socket(af, Struc, Protocol: Integer): TSocket;
+begin
+ Result := fpSocket(af, struc, protocol);
+end;
+
+function Select(nfds: Integer; readfds, writefds, exceptfds: PFDSet;
+ timeout: PTimeVal): Longint;
+begin
+ Result := fpSelect(nfds, readfds, writefds, exceptfds, timeout);
+end;
+
+{=============================================================================}
+function IsNewApi(Family: integer): Boolean;
+begin
+ Result := SockEnhancedApi;
+ if not Result then
+ Result := (Family = AF_INET6) and SockWship6Api;
+end;
+
+function SetVarSin(var Sin: TVarSin; IP, Port: string; Family, SockProtocol, SockType: integer; PreferIP4: Boolean): integer;
+var
+ TwoPass: boolean;
+ f1, f2: integer;
+
+ function GetAddr(f:integer): integer;
+ var
+ a4: array [1..1] of in_addr;
+ a6: array [1..1] of Tin6_addr;
+ he: THostEntry;
+ begin
+ Result := WSAEPROTONOSUPPORT;
+ case f of
+ AF_INET:
+ begin
+ if IP = cAnyHost then
+ begin
+ Sin.sin_family := AF_INET;
+ Result := 0;
+ end
+ else
+ begin
+ if lowercase(IP) = cLocalHostStr then
+ a4[1].s_addr := htonl(INADDR_LOOPBACK)
+ else
+ begin
+ a4[1].s_addr := 0;
+ Result := WSAHOST_NOT_FOUND;
+ a4[1] := StrTonetAddr(IP);
+ if a4[1].s_addr = INADDR_ANY then
+ if GetHostByName(ip, he) then
+ a4[1]:=HostToNet(he.Addr)
+ else
+ Resolvename(ip, a4);
+ end;
+ if a4[1].s_addr <> INADDR_ANY then
+ begin
+ Sin.sin_family := AF_INET;
+ sin.sin_addr := a4[1];
+ Result := 0;
+ end;
+ end;
+ end;
+ AF_INET6:
+ begin
+ if IP = c6AnyHost then
+ begin
+ Sin.sin_family := AF_INET6;
+ Result := 0;
+ end
+ else
+ begin
+ if lowercase(IP) = cLocalHostStr then
+ SET_LOOPBACK_ADDR6(@a6[1])
+ else
+ begin
+ Result := WSAHOST_NOT_FOUND;
+ SET_IN6_IF_ADDR_ANY(@a6[1]);
+ a6[1] := StrTonetAddr6(IP);
+ if IN6_IS_ADDR_UNSPECIFIED(@a6[1]) then
+ Resolvename6(ip, a6);
+ end;
+ if not IN6_IS_ADDR_UNSPECIFIED(@a6[1]) then
+ begin
+ Sin.sin_family := AF_INET6;
+ sin.sin6_addr := a6[1];
+ Result := 0;
+ end;
+ end;
+ end;
+ end;
+ end;
+begin
+ Result := 0;
+ FillChar(Sin, Sizeof(Sin), 0);
+ Sin.sin_port := Resolveport(port, family, SockProtocol, SockType);
+ TwoPass := False;
+ if Family = AF_UNSPEC then
+ begin
+ if PreferIP4 then
+ begin
+ f1 := AF_INET;
+ f2 := AF_INET6;
+ TwoPass := True;
+ end
+ else
+ begin
+ f2 := AF_INET;
+ f1 := AF_INET6;
+ TwoPass := True;
+ end;
+ end
+ else
+ f1 := Family;
+ Result := GetAddr(f1);
+ if Result <> 0 then
+ if TwoPass then
+ Result := GetAddr(f2);
+end;
+
+function GetSinIP(Sin: TVarSin): string;
+begin
+ Result := '';
+ case sin.AddressFamily of
+ AF_INET:
+ begin
+ result := NetAddrToStr(sin.sin_addr);
+ end;
+ AF_INET6:
+ begin
+ result := NetAddrToStr6(sin.sin6_addr);
+ end;
+ end;
+end;
+
+function GetSinPort(Sin: TVarSin): Integer;
+begin
+ if (Sin.sin_family = AF_INET6) then
+ Result := synsock.ntohs(Sin.sin6_port)
+ else
+ Result := synsock.ntohs(Sin.sin_port);
+end;
+
+procedure ResolveNameToIP(Name: string; Family, SockProtocol, SockType: integer; const IPList: TStrings);
+var
+ x, n: integer;
+ a4: array [1..255] of in_addr;
+ a6: array [1..255] of Tin6_addr;
+ he: THostEntry;
+begin
+ IPList.Clear;
+ if (family = AF_INET) or (family = AF_UNSPEC) then
+ begin
+ if lowercase(name) = cLocalHostStr then
+ IpList.Add(cLocalHost)
+ else
+ begin
+ a4[1] := StrTonetAddr(name);
+ if a4[1].s_addr = INADDR_ANY then
+ if GetHostByName(name, he) then
+ begin
+ a4[1]:=HostToNet(he.Addr);
+ x := 1;
+ end
+ else
+ x := Resolvename(name, a4)
+ else
+ x := 1;
+ for n := 1 to x do
+ IpList.Add(netaddrToStr(a4[n]));
+ end;
+ end;
+
+ if (family = AF_INET6) or (family = AF_UNSPEC) then
+ begin
+ if lowercase(name) = cLocalHostStr then
+ IpList.Add(c6LocalHost)
+ else
+ begin
+ a6[1] := StrTonetAddr6(name);
+ if IN6_IS_ADDR_UNSPECIFIED(@a6[1]) then
+ x := Resolvename6(name, a6)
+ else
+ x := 1;
+ for n := 1 to x do
+ IpList.Add(netaddrToStr6(a6[n]));
+ end;
+ end;
+
+ if IPList.Count = 0 then
+ IPList.Add(cLocalHost);
+end;
+
+function ResolvePort(Port: string; Family, SockProtocol, SockType: integer): Word;
+var
+ ProtoEnt: TProtocolEntry;
+ ServEnt: TServiceEntry;
+begin
+ Result := synsock.htons(StrToIntDef(Port, 0));
+ if Result = 0 then
+ begin
+ ProtoEnt.Name := '';
+ GetProtocolByNumber(SockProtocol, ProtoEnt);
+ ServEnt.port := 0;
+ GetServiceByName(Port, ProtoEnt.Name, ServEnt);
+ Result := ServEnt.port;
+ end;
+end;
+
+function ResolveIPToName(IP: string; Family, SockProtocol, SockType: integer): string;
+var
+ n: integer;
+ a4: array [1..1] of in_addr;
+ a6: array [1..1] of Tin6_addr;
+ a: array [1..1] of string;
+begin
+ Result := IP;
+ a4[1] := StrToNetAddr(IP);
+ if a4[1].s_addr <> INADDR_ANY then
+ begin
+//why ResolveAddress need address in HOST order? :-O
+ n := ResolveAddress(nettohost(a4[1]), a);
+ if n > 0 then
+ Result := a[1];
+ end
+ else
+ begin
+ a6[1] := StrToNetAddr6(IP);
+ n := ResolveAddress6(a6[1], a);
+ if n > 0 then
+ Result := a[1];
+ end;
+end;
+
+{=============================================================================}
+
+function InitSocketInterface(stack: string): Boolean;
+begin
+ SockEnhancedApi := False;
+ SockWship6Api := False;
+// Libc.Signal(Libc.SIGPIPE, TSignalHandler(Libc.SIG_IGN));
+ Result := True;
+end;
+
+function DestroySocketInterface: Boolean;
+begin
+ Result := True;
+end;
+
+initialization
+begin
+ SynSockCS := SyncObjs.TCriticalSection.Create;
+ SET_IN6_IF_ADDR_ANY (@in6addr_any);
+ SET_LOOPBACK_ADDR6 (@in6addr_loopback);
+end;
+
+finalization
+begin
+ SynSockCS.Free;
+end;
+
+{$ENDIF}
+
ADDED lib/synapse/source/lib/ssl_cryptlib.pas
Index: lib/synapse/source/lib/ssl_cryptlib.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/lib/ssl_cryptlib.pas
@@ -0,0 +1,677 @@
+{==============================================================================|
+| Project : Ararat Synapse | 001.001.000 |
+|==============================================================================|
+| Content: SSL/SSH support by Peter Gutmann's CryptLib |
+|==============================================================================|
+| Copyright (c)1999-2012, Lukas Gebauer |
+| All rights reserved. |
+| |
+| Redistribution and use in source and binary forms, with or without |
+| modification, are permitted provided that the following conditions are met: |
+| |
+| Redistributions of source code must retain the above copyright notice, this |
+| list of conditions and the following disclaimer. |
+| |
+| Redistributions in binary form must reproduce the above copyright notice, |
+| this list of conditions and the following disclaimer in the documentation |
+| and/or other materials provided with the distribution. |
+| |
+| Neither the name of Lukas Gebauer nor the names of its contributors may |
+| be used to endorse or promote products derived from this software without |
+| specific prior written permission. |
+| |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
+| DAMAGE. |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2005-2012. |
+| All Rights Reserved. |
+|==============================================================================|
+| Contributor(s): |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package |
+| (Found at URL: http://www.ararat.cz/synapse/) |
+|==============================================================================}
+
+{:@abstract(SSL/SSH plugin for CryptLib)
+
+This plugin requires cl32.dll at least version 3.2.0! It can be used on Win32
+and Linux. This library is staticly linked - when you compile your application
+with this plugin, you MUST distribute it with Cryptib library, otherwise you
+cannot run your application!
+
+It can work with keys and certificates stored as PKCS#15 only! It must be stored
+as disk file only, you cannot load them from memory! Each file can hold multiple
+keys and certificates. You must identify it by 'label' stored in
+@link(TSSLCryptLib.PrivateKeyLabel).
+
+If you need to use secure connection and authorize self by certificate
+(each SSL/TLS server or client with client authorization), then use
+@link(TCustomSSL.PrivateKeyFile), @link(TSSLCryptLib.PrivateKeyLabel) and
+@link(TCustomSSL.KeyPassword) properties.
+
+If you need to use server what verifying client certificates, then use
+@link(TCustomSSL.CertCAFile) as PKCS#15 file with public keyas of allowed clients. Clients
+with non-matching certificates will be rejected by cryptLib.
+
+This plugin is capable to create Ad-Hoc certificates. When you start SSL/TLS
+server without explicitly assigned key and certificate, then this plugin create
+Ad-Hoc key and certificate for each incomming connection by self. It slowdown
+accepting of new connections!
+
+You can use this plugin for SSHv2 connections too! You must explicitly set
+@link(TCustomSSL.SSLType) to value LT_SSHv2 and set @link(TCustomSSL.username)
+and @link(TCustomSSL.password). You can use special SSH channels too, see
+@link(TCustomSSL).
+}
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+
+unit ssl_cryptlib;
+
+interface
+
+uses
+ Windows,
+ SysUtils,
+ blcksock, synsock, synautil, synacode,
+ cryptlib;
+
+type
+ {:@abstract(class implementing CryptLib SSL/SSH plugin.)
+ Instance of this class will be created for each @link(TTCPBlockSocket).
+ You not need to create instance of this class, all is done by Synapse itself!}
+ TSSLCryptLib = class(TCustomSSL)
+ protected
+ FCryptSession: CRYPT_SESSION;
+ FPrivateKeyLabel: string;
+ FDelCert: Boolean;
+ FReadBuffer: string;
+ FTrustedCAs: array of integer;
+ function SSLCheck(Value: integer): Boolean;
+ function Init(server:Boolean): Boolean;
+ function DeInit: Boolean;
+ function Prepare(server:Boolean): Boolean;
+ function GetString(const cryptHandle: CRYPT_HANDLE; const attributeType: CRYPT_ATTRIBUTE_TYPE): string;
+ function CreateSelfSignedCert(Host: string): Boolean; override;
+ function PopAll: string;
+ public
+ {:See @inherited}
+ constructor Create(const Value: TTCPBlockSocket); override;
+ destructor Destroy; override;
+ {:Load trusted CA's in PEM format}
+ procedure SetCertCAFile(const Value: string); override;
+ {:See @inherited}
+ function LibVersion: String; override;
+ {:See @inherited}
+ function LibName: String; override;
+ {:See @inherited}
+ procedure Assign(const Value: TCustomSSL); override;
+ {:See @inherited and @link(ssl_cryptlib) for more details.}
+ function Connect: boolean; override;
+ {:See @inherited and @link(ssl_cryptlib) for more details.}
+ function Accept: boolean; override;
+ {:See @inherited}
+ function Shutdown: boolean; override;
+ {:See @inherited}
+ function BiShutdown: boolean; override;
+ {:See @inherited}
+ function SendBuffer(Buffer: TMemory; Len: Integer): Integer; override;
+ {:See @inherited}
+ function RecvBuffer(Buffer: TMemory; Len: Integer): Integer; override;
+ {:See @inherited}
+ function WaitingData: Integer; override;
+ {:See @inherited}
+ function GetSSLVersion: string; override;
+ {:See @inherited}
+ function GetPeerSubject: string; override;
+ {:See @inherited}
+ function GetPeerIssuer: string; override;
+ {:See @inherited}
+ function GetPeerName: string; override;
+ {:See @inherited}
+ function GetPeerFingerprint: string; override;
+ {:See @inherited}
+ function GetVerifyCert: integer; override;
+ published
+ {:name of certificate/key within PKCS#15 file. It can hold more then one
+ certificate/key and each certificate/key must have unique label within one file.}
+ property PrivateKeyLabel: string read FPrivateKeyLabel Write FPrivateKeyLabel;
+ end;
+
+implementation
+
+{==============================================================================}
+
+constructor TSSLCryptLib.Create(const Value: TTCPBlockSocket);
+begin
+ inherited Create(Value);
+ FcryptSession := CRYPT_SESSION(CRYPT_SESSION_NONE);
+ FPrivateKeyLabel := 'synapse';
+ FDelCert := false;
+ FTrustedCAs := nil;
+end;
+
+destructor TSSLCryptLib.Destroy;
+begin
+ SetCertCAFile(''); // destroy certificates
+ DeInit;
+ inherited Destroy;
+end;
+
+procedure TSSLCryptLib.Assign(const Value: TCustomSSL);
+begin
+ inherited Assign(Value);
+ if Value is TSSLCryptLib then
+ begin
+ FPrivateKeyLabel := TSSLCryptLib(Value).privatekeyLabel;
+ end;
+end;
+
+function TSSLCryptLib.GetString(const cryptHandle: CRYPT_HANDLE; const attributeType: CRYPT_ATTRIBUTE_TYPE): string;
+var
+ l: integer;
+begin
+ l := 0;
+ cryptGetAttributeString(cryptHandle, attributeType, nil, l);
+ setlength(Result, l);
+ cryptGetAttributeString(cryptHandle, attributeType, pointer(Result), l);
+ setlength(Result, l);
+end;
+
+function TSSLCryptLib.LibVersion: String;
+var
+ x: integer;
+begin
+ Result := GetString(CRYPT_UNUSED, CRYPT_OPTION_INFO_DESCRIPTION);
+ cryptGetAttribute(CRYPT_UNUSED, CRYPT_OPTION_INFO_MAJORVERSION, x);
+ Result := Result + ' v' + IntToStr(x);
+ cryptGetAttribute(CRYPT_UNUSED, CRYPT_OPTION_INFO_MINORVERSION, x);
+ Result := Result + '.' + IntToStr(x);
+ cryptGetAttribute(CRYPT_UNUSED, CRYPT_OPTION_INFO_STEPPING, x);
+ Result := Result + '.' + IntToStr(x);
+end;
+
+function TSSLCryptLib.LibName: String;
+begin
+ Result := 'ssl_cryptlib';
+end;
+
+function TSSLCryptLib.SSLCheck(Value: integer): Boolean;
+begin
+ Result := true;
+ FLastErrorDesc := '';
+ if Value = CRYPT_ERROR_COMPLETE then
+ Value := 0;
+ FLastError := Value;
+ if FLastError <> 0 then
+ begin
+ Result := False;
+{$IF CRYPTLIB_VERSION >= 3400}
+ FLastErrorDesc := GetString(FCryptSession, CRYPT_ATTRIBUTE_ERRORMESSAGE);
+{$ELSE}
+ FLastErrorDesc := GetString(FCryptSession, CRYPT_ATTRIBUTE_INT_ERRORMESSAGE);
+{$IFEND}
+ end;
+end;
+
+function TSSLCryptLib.CreateSelfSignedCert(Host: string): Boolean;
+var
+ privateKey: CRYPT_CONTEXT;
+ keyset: CRYPT_KEYSET;
+ cert: CRYPT_CERTIFICATE;
+ publicKey: CRYPT_CONTEXT;
+begin
+ if FPrivatekeyFile = '' then
+ FPrivatekeyFile := GetTempFile('', 'key');
+ cryptCreateContext(privateKey, CRYPT_UNUSED, CRYPT_ALGO_RSA);
+ cryptSetAttributeString(privateKey, CRYPT_CTXINFO_LABEL, Pointer(FPrivatekeyLabel),
+ Length(FPrivatekeyLabel));
+ cryptSetAttribute(privateKey, CRYPT_CTXINFO_KEYSIZE, 1024);
+ cryptGenerateKey(privateKey);
+ cryptKeysetOpen(keyset, CRYPT_UNUSED, CRYPT_KEYSET_FILE, PChar(FPrivatekeyFile), CRYPT_KEYOPT_CREATE);
+ FDelCert := True;
+ cryptAddPrivateKey(keyset, privateKey, PChar(FKeyPassword));
+ cryptCreateCert(cert, CRYPT_UNUSED, CRYPT_CERTTYPE_CERTIFICATE);
+ cryptSetAttribute(cert, CRYPT_CERTINFO_XYZZY, 1);
+ cryptGetPublicKey(keyset, publicKey, CRYPT_KEYID_NAME, PChar(FPrivatekeyLabel));
+ cryptSetAttribute(cert, CRYPT_CERTINFO_SUBJECTPUBLICKEYINFO, publicKey);
+ cryptSetAttributeString(cert, CRYPT_CERTINFO_COMMONNAME, Pointer(host), Length(host));
+ cryptSignCert(cert, privateKey);
+ cryptAddPublicKey(keyset, cert);
+ cryptKeysetClose(keyset);
+ cryptDestroyCert(cert);
+ cryptDestroyContext(privateKey);
+ cryptDestroyContext(publicKey);
+ Result := True;
+end;
+
+function TSSLCryptLib.PopAll: string;
+const
+ BufferMaxSize = 32768;
+var
+ Outbuffer: string;
+ WriteLen: integer;
+begin
+ Result := '';
+ repeat
+ setlength(outbuffer, BufferMaxSize);
+ Writelen := 0;
+ SSLCheck(CryptPopData(FCryptSession, @OutBuffer[1], BufferMaxSize, Writelen));
+ if FLastError <> 0 then
+ Break;
+ if WriteLen > 0 then
+ begin
+ setlength(outbuffer, WriteLen);
+ Result := Result + outbuffer;
+ end;
+ until WriteLen = 0;
+end;
+
+function TSSLCryptLib.Init(server:Boolean): Boolean;
+var
+ st: CRYPT_SESSION_TYPE;
+ keysetobj: CRYPT_KEYSET;
+ cryptContext: CRYPT_CONTEXT;
+ x: integer;
+begin
+ Result := False;
+ FLastErrorDesc := '';
+ FLastError := 0;
+ FDelCert := false;
+ FcryptSession := CRYPT_SESSION(CRYPT_SESSION_NONE);
+ if server then
+ case FSSLType of
+ LT_all, LT_SSLv3, LT_TLSv1, LT_TLSv1_1:
+ st := CRYPT_SESSION_SSL_SERVER;
+ LT_SSHv2:
+ st := CRYPT_SESSION_SSH_SERVER;
+ else
+ Exit;
+ end
+ else
+ case FSSLType of
+ LT_all, LT_SSLv3, LT_TLSv1, LT_TLSv1_1:
+ st := CRYPT_SESSION_SSL;
+ LT_SSHv2:
+ st := CRYPT_SESSION_SSH;
+ else
+ Exit;
+ end;
+ if not SSLCheck(cryptCreateSession(FcryptSession, CRYPT_UNUSED, st)) then
+ Exit;
+ x := -1;
+ case FSSLType of
+ LT_SSLv3:
+ x := 0;
+ LT_TLSv1:
+ x := 1;
+ LT_TLSv1_1:
+ x := 2;
+ end;
+ if x >= 0 then
+ if not SSLCheck(cryptSetAttribute(FCryptSession, CRYPT_SESSINFO_VERSION, x)) then
+ Exit;
+
+ if (FCertComplianceLevel <> -1) then
+ if not SSLCheck(cryptSetAttribute (CRYPT_UNUSED, CRYPT_OPTION_CERT_COMPLIANCELEVEL,
+ FCertComplianceLevel)) then
+ Exit;
+
+ if FUsername <> '' then
+ begin
+ cryptSetAttributeString(FcryptSession, CRYPT_SESSINFO_USERNAME,
+ Pointer(FUsername), Length(FUsername));
+ cryptSetAttributeString(FcryptSession, CRYPT_SESSINFO_PASSWORD,
+ Pointer(FPassword), Length(FPassword));
+ end;
+ if FSSLType = LT_SSHv2 then
+ if FSSHChannelType <> '' then
+ begin
+ cryptSetAttribute(FCryptSession, CRYPT_SESSINFO_SSH_CHANNEL, CRYPT_UNUSED);
+ cryptSetAttributeString(FCryptSession, CRYPT_SESSINFO_SSH_CHANNEL_TYPE,
+ Pointer(FSSHChannelType), Length(FSSHChannelType));
+ if FSSHChannelArg1 <> '' then
+ cryptSetAttributeString(FCryptSession, CRYPT_SESSINFO_SSH_CHANNEL_ARG1,
+ Pointer(FSSHChannelArg1), Length(FSSHChannelArg1));
+ if FSSHChannelArg2 <> '' then
+ cryptSetAttributeString(FCryptSession, CRYPT_SESSINFO_SSH_CHANNEL_ARG2,
+ Pointer(FSSHChannelArg2), Length(FSSHChannelArg2));
+ end;
+
+
+ if server and (FPrivatekeyFile = '') then
+ begin
+ if FPrivatekeyLabel = '' then
+ FPrivatekeyLabel := 'synapse';
+ if FkeyPassword = '' then
+ FkeyPassword := 'synapse';
+ CreateSelfSignedcert(FSocket.ResolveIPToName(FSocket.GetRemoteSinIP));
+ end;
+
+ if (FPrivatekeyLabel <> '') and (FPrivatekeyFile <> '') then
+ begin
+ if not SSLCheck(cryptKeysetOpen(KeySetObj, CRYPT_UNUSED, CRYPT_KEYSET_FILE,
+ PChar(FPrivatekeyFile), CRYPT_KEYOPT_READONLY)) then
+ Exit;
+ try
+ if not SSLCheck(cryptGetPrivateKey(KeySetObj, cryptcontext, CRYPT_KEYID_NAME,
+ PChar(FPrivatekeyLabel), PChar(FKeyPassword))) then
+ Exit;
+ if not SSLCheck(cryptSetAttribute(FcryptSession, CRYPT_SESSINFO_PRIVATEKEY,
+ cryptcontext)) then
+ Exit;
+ finally
+ cryptKeysetClose(keySetObj);
+ cryptDestroyContext(cryptcontext);
+ end;
+ end;
+ if server and FVerifyCert then
+ begin
+ if not SSLCheck(cryptKeysetOpen(KeySetObj, CRYPT_UNUSED, CRYPT_KEYSET_FILE,
+ PChar(FCertCAFile), CRYPT_KEYOPT_READONLY)) then
+ Exit;
+ try
+ if not SSLCheck(cryptSetAttribute(FcryptSession, CRYPT_SESSINFO_KEYSET,
+ keySetObj)) then
+ Exit;
+ finally
+ cryptKeysetClose(keySetObj);
+ end;
+ end;
+ Result := true;
+end;
+
+function TSSLCryptLib.DeInit: Boolean;
+begin
+ Result := True;
+ if FcryptSession <> CRYPT_SESSION(CRYPT_SESSION_NONE) then
+ CryptDestroySession(FcryptSession);
+ FcryptSession := CRYPT_SESSION(CRYPT_SESSION_NONE);
+ FSSLEnabled := False;
+ if FDelCert then
+ SysUtils.DeleteFile(FPrivatekeyFile);
+end;
+
+function TSSLCryptLib.Prepare(server:Boolean): Boolean;
+begin
+ Result := false;
+ DeInit;
+ if Init(server) then
+ Result := true
+ else
+ DeInit;
+end;
+
+function TSSLCryptLib.Connect: boolean;
+begin
+ Result := False;
+ if FSocket.Socket = INVALID_SOCKET then
+ Exit;
+ if Prepare(false) then
+ begin
+ if not SSLCheck(cryptSetAttribute(FCryptSession, CRYPT_SESSINFO_NETWORKSOCKET, FSocket.Socket)) then
+ Exit;
+ if not SSLCheck(cryptSetAttribute(FCryptSession, CRYPT_SESSINFO_ACTIVE, 1)) then
+ Exit;
+ if FverifyCert then
+ if (GetVerifyCert <> 0) or (not DoVerifyCert) then
+ Exit;
+ FSSLEnabled := True;
+ Result := True;
+ FReadBuffer := '';
+ end;
+end;
+
+function TSSLCryptLib.Accept: boolean;
+begin
+ Result := False;
+ if FSocket.Socket = INVALID_SOCKET then
+ Exit;
+ if Prepare(true) then
+ begin
+ if not SSLCheck(cryptSetAttribute(FCryptSession, CRYPT_SESSINFO_NETWORKSOCKET, FSocket.Socket)) then
+ Exit;
+ if not SSLCheck(cryptSetAttribute(FCryptSession, CRYPT_SESSINFO_ACTIVE, 1)) then
+ Exit;
+ FSSLEnabled := True;
+ Result := True;
+ FReadBuffer := '';
+ end;
+end;
+
+function TSSLCryptLib.Shutdown: boolean;
+begin
+ Result := BiShutdown;
+end;
+
+function TSSLCryptLib.BiShutdown: boolean;
+begin
+ if FcryptSession <> CRYPT_SESSION(CRYPT_SESSION_NONE) then
+ cryptSetAttribute(FCryptSession, CRYPT_SESSINFO_ACTIVE, 0);
+ DeInit;
+ FReadBuffer := '';
+ Result := True;
+end;
+
+function TSSLCryptLib.SendBuffer(Buffer: TMemory; Len: Integer): Integer;
+var
+ l: integer;
+begin
+ FLastError := 0;
+ FLastErrorDesc := '';
+ SSLCheck(cryptPushData(FCryptSession, Buffer, Len, L));
+ cryptFlushData(FcryptSession);
+ Result := l;
+end;
+
+function TSSLCryptLib.RecvBuffer(Buffer: TMemory; Len: Integer): Integer;
+begin
+ FLastError := 0;
+ FLastErrorDesc := '';
+ if Length(FReadBuffer) = 0 then
+ FReadBuffer := PopAll;
+ if Len > Length(FReadBuffer) then
+ Len := Length(FReadBuffer);
+ Move(Pointer(FReadBuffer)^, buffer^, Len);
+ Delete(FReadBuffer, 1, Len);
+ Result := Len;
+end;
+
+function TSSLCryptLib.WaitingData: Integer;
+begin
+ Result := Length(FReadBuffer);
+end;
+
+function TSSLCryptLib.GetSSLVersion: string;
+var
+ x: integer;
+begin
+ Result := '';
+ if FcryptSession = CRYPT_SESSION(CRYPT_SESSION_NONE) then
+ Exit;
+ cryptGetAttribute(FCryptSession, CRYPT_SESSINFO_VERSION, x);
+ if FSSLType in [LT_SSLv3, LT_TLSv1, LT_TLSv1_1, LT_all] then
+ case x of
+ 0:
+ Result := 'SSLv3';
+ 1:
+ Result := 'TLSv1';
+ 2:
+ Result := 'TLSv1.1';
+ end;
+ if FSSLType in [LT_SSHv2] then
+ case x of
+ 0:
+ Result := 'SSHv1';
+ 1:
+ Result := 'SSHv2';
+ end;
+end;
+
+function TSSLCryptLib.GetPeerSubject: string;
+var
+ cert: CRYPT_CERTIFICATE;
+begin
+ Result := '';
+ if FcryptSession = CRYPT_SESSION(CRYPT_SESSION_NONE) then
+ Exit;
+ cryptGetAttribute(FCryptSession, CRYPT_SESSINFO_RESPONSE, cert);
+ cryptSetAttribute(cert, CRYPT_ATTRIBUTE_CURRENT, CRYPT_CERTINFO_SUBJECTNAME);
+ Result := GetString(cert, CRYPT_CERTINFO_DN);
+ cryptDestroyCert(cert);
+end;
+
+function TSSLCryptLib.GetPeerName: string;
+var
+ cert: CRYPT_CERTIFICATE;
+begin
+ Result := '';
+ if FcryptSession = CRYPT_SESSION(CRYPT_SESSION_NONE) then
+ Exit;
+ cryptGetAttribute(FCryptSession, CRYPT_SESSINFO_RESPONSE, cert);
+ cryptSetAttribute(cert, CRYPT_ATTRIBUTE_CURRENT, CRYPT_CERTINFO_SUBJECTNAME);
+ Result := GetString(cert, CRYPT_CERTINFO_COMMONNAME);
+ cryptDestroyCert(cert);
+end;
+
+function TSSLCryptLib.GetPeerIssuer: string;
+var
+ cert: CRYPT_CERTIFICATE;
+begin
+ Result := '';
+ if FcryptSession = CRYPT_SESSION(CRYPT_SESSION_NONE) then
+ Exit;
+ cryptGetAttribute(FCryptSession, CRYPT_SESSINFO_RESPONSE, cert);
+ cryptSetAttribute(cert, CRYPT_ATTRIBUTE_CURRENT, CRYPT_CERTINFO_ISSUERNAME);
+ Result := GetString(cert, CRYPT_CERTINFO_COMMONNAME);
+ cryptDestroyCert(cert);
+end;
+
+function TSSLCryptLib.GetPeerFingerprint: string;
+var
+ cert: CRYPT_CERTIFICATE;
+begin
+ Result := '';
+ if FcryptSession = CRYPT_SESSION(CRYPT_SESSION_NONE) then
+ Exit;
+ cryptGetAttribute(FCryptSession, CRYPT_SESSINFO_RESPONSE, cert);
+ Result := GetString(cert, CRYPT_CERTINFO_FINGERPRINT);
+ cryptDestroyCert(cert);
+end;
+
+
+procedure TSSLCryptLib.SetCertCAFile(const Value: string);
+
+var F:textfile;
+ bInCert:boolean;
+ s,sCert:string;
+ cert: CRYPT_CERTIFICATE;
+ idx:integer;
+
+begin
+if assigned(FTrustedCAs) then
+ begin
+ for idx := 0 to High(FTrustedCAs) do
+ cryptDestroyCert(FTrustedCAs[idx]);
+ FTrustedCAs:=nil;
+ end;
+if Value<>'' then
+ begin
+ AssignFile(F,Value);
+ reset(F);
+ bInCert:=false;
+ idx:=0;
+ while not eof(F) do
+ begin
+ readln(F,s);
+ if pos('-----END CERTIFICATE-----',s)>0 then
+ begin
+ bInCert:=false;
+ cert:=0;
+ if (cryptImportCert(PAnsiChar(sCert),length(sCert)-2,CRYPT_UNUSED,cert)=CRYPT_OK) then
+ begin
+ cryptSetAttribute( cert, CRYPT_CERTINFO_TRUSTED_IMPLICIT, 1 );
+ SetLength(FTrustedCAs,idx+1);
+ FTrustedCAs[idx]:=cert;
+ idx:=idx+1;
+ end;
+ end;
+ if bInCert then
+ sCert:=sCert+s+#13#10;
+ if pos('-----BEGIN CERTIFICATE-----',s)>0 then
+ begin
+ bInCert:=true;
+ sCert:='';
+ end;
+ end;
+ CloseFile(F);
+ end;
+end;
+
+function TSSLCryptLib.GetVerifyCert: integer;
+var
+ cert: CRYPT_CERTIFICATE;
+ itype,ilocus:integer;
+begin
+ Result := -1;
+ if FcryptSession = CRYPT_SESSION(CRYPT_SESSION_NONE) then
+ Exit;
+ cryptGetAttribute(FCryptSession, CRYPT_SESSINFO_RESPONSE, cert);
+ result:=cryptCheckCert(cert,CRYPT_UNUSED);
+ if result<>CRYPT_OK then
+ begin
+ //get extended error info if available
+ cryptGetAttribute(cert,CRYPT_ATTRIBUTE_ERRORtype,itype);
+ cryptGetAttribute(cert,CRYPT_ATTRIBUTE_ERRORLOCUS,ilocus);
+ cryptSetAttribute(cert, CRYPT_ATTRIBUTE_CURRENT, CRYPT_CERTINFO_SUBJECTNAME);
+ FLastError := Result;
+ FLastErrorDesc := format('SSL/TLS certificate verification failed for "%s"'#13#10'Status: %d. ERRORTYPE: %d. ERRORLOCUS: %d.',
+ [GetString(cert, CRYPT_CERTINFO_COMMONNAME),result,itype,ilocus]);
+ end;
+ cryptDestroyCert(cert);
+end;
+
+{==============================================================================}
+
+var imajor,iminor,iver:integer;
+// e: ESynapseError;
+
+initialization
+ if cryptInit = CRYPT_OK then
+ SSLImplementation := TSSLCryptLib;
+ cryptAddRandom(nil, CRYPT_RANDOM_SLOWPOLL);
+ cryptGetAttribute (CRYPT_UNUSED, CRYPT_OPTION_INFO_MAJORVERSION,imajor);
+ cryptGetAttribute (CRYPT_UNUSED, CRYPT_OPTION_INFO_MINORVERSION,iminor);
+// according to the documentation CRYPTLIB version has 3 digits. recent versions use 4 digits
+ if CRYPTLIB_VERSION >1000 then
+ iver:=CRYPTLIB_VERSION div 100
+ else
+ iver:=CRYPTLIB_VERSION div 10;
+ if (iver <> imajor*10+iminor) then
+ begin
+ SSLImplementation :=TSSLNone;
+// e := ESynapseError.Create(format('Error wrong cryptlib version (is %d.%d expected %d.%d). ',
+// [imajor,iminor,iver div 10, iver mod 10]));
+// e.ErrorCode := 0;
+// e.ErrorMessage := format('Error wrong cryptlib version (%d.%d expected %d.%d)',
+// [imajor,iminor,iver div 10, iver mod 10]);
+// raise e;
+ end;
+finalization
+ cryptEnd;
+end.
+
+
ADDED lib/synapse/source/lib/ssl_openssl.pas
Index: lib/synapse/source/lib/ssl_openssl.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/lib/ssl_openssl.pas
@@ -0,0 +1,896 @@
+{==============================================================================|
+| Project : Ararat Synapse | 001.002.000 |
+|==============================================================================|
+| Content: SSL support by OpenSSL |
+|==============================================================================|
+| Copyright (c)1999-2008, Lukas Gebauer |
+| All rights reserved. |
+| |
+| Redistribution and use in source and binary forms, with or without |
+| modification, are permitted provided that the following conditions are met: |
+| |
+| Redistributions of source code must retain the above copyright notice, this |
+| list of conditions and the following disclaimer. |
+| |
+| Redistributions in binary form must reproduce the above copyright notice, |
+| this list of conditions and the following disclaimer in the documentation |
+| and/or other materials provided with the distribution. |
+| |
+| Neither the name of Lukas Gebauer nor the names of its contributors may |
+| be used to endorse or promote products derived from this software without |
+| specific prior written permission. |
+| |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
+| DAMAGE. |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2005-2012. |
+| Portions created by Petr Fejfar are Copyright (c)2011-2012. |
+| All Rights Reserved. |
+|==============================================================================|
+| Contributor(s): |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package |
+| (Found at URL: http://www.ararat.cz/synapse/) |
+|==============================================================================}
+
+//requires OpenSSL libraries!
+
+{:@abstract(SSL plugin for OpenSSL)
+
+You need OpenSSL libraries version 0.9.7. It can work with 0.9.6 too, but
+application mysteriously crashing when you are using freePascal on Linux.
+Use Kylix on Linux is OK! If you have version 0.9.7 on Linux, then I not see
+any problems with FreePascal.
+
+OpenSSL libraries are loaded dynamicly - you not need OpenSSl librares even you
+compile your application with this unit. SSL just not working when you not have
+OpenSSL libraries.
+
+This plugin have limited support for .NET too! Because is not possible to use
+callbacks with CDECL calling convention under .NET, is not supported
+key/certificate passwords and multithread locking. :-(
+
+For handling keys and certificates you can use this properties:
+
+@link(TCustomSSL.CertificateFile) for PEM or ASN1 DER (cer) format. @br
+@link(TCustomSSL.Certificate) for ASN1 DER format only. @br
+@link(TCustomSSL.PrivateKeyFile) for PEM or ASN1 DER (key) format. @br
+@link(TCustomSSL.PrivateKey) for ASN1 DER format only. @br
+@link(TCustomSSL.CertCAFile) for PEM CA certificate bundle. @br
+@link(TCustomSSL.PFXFile) for PFX format. @br
+@link(TCustomSSL.PFX) for PFX format from binary string. @br
+
+This plugin is capable to create Ad-Hoc certificates. When you start SSL/TLS
+server without explicitly assigned key and certificate, then this plugin create
+Ad-Hoc key and certificate for each incomming connection by self. It slowdown
+accepting of new connections!
+}
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+
+{$IFDEF UNICODE}
+ {$WARN IMPLICIT_STRING_CAST OFF}
+ {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+unit ssl_openssl;
+
+interface
+
+uses
+ SysUtils, Classes,
+ blcksock, synsock, synautil,
+{$IFDEF CIL}
+ System.Text,
+{$ENDIF}
+ ssl_openssl_lib;
+
+type
+ {:@abstract(class implementing OpenSSL SSL plugin.)
+ Instance of this class will be created for each @link(TTCPBlockSocket).
+ You not need to create instance of this class, all is done by Synapse itself!}
+ TSSLOpenSSL = class(TCustomSSL)
+ protected
+ FSsl: PSSL;
+ Fctx: PSSL_CTX;
+ function SSLCheck: Boolean;
+ function SetSslKeys: boolean;
+ function Init(server:Boolean): Boolean;
+ function DeInit: Boolean;
+ function Prepare(server:Boolean): Boolean;
+ function LoadPFX(pfxdata: ansistring): Boolean;
+ function CreateSelfSignedCert(Host: string): Boolean; override;
+ public
+ {:See @inherited}
+ constructor Create(const Value: TTCPBlockSocket); override;
+ destructor Destroy; override;
+ {:See @inherited}
+ function LibVersion: String; override;
+ {:See @inherited}
+ function LibName: String; override;
+ {:See @inherited and @link(ssl_cryptlib) for more details.}
+ function Connect: boolean; override;
+ {:See @inherited and @link(ssl_cryptlib) for more details.}
+ function Accept: boolean; override;
+ {:See @inherited}
+ function Shutdown: boolean; override;
+ {:See @inherited}
+ function BiShutdown: boolean; override;
+ {:See @inherited}
+ function SendBuffer(Buffer: TMemory; Len: Integer): Integer; override;
+ {:See @inherited}
+ function RecvBuffer(Buffer: TMemory; Len: Integer): Integer; override;
+ {:See @inherited}
+ function WaitingData: Integer; override;
+ {:See @inherited}
+ function GetSSLVersion: string; override;
+ {:See @inherited}
+ function GetPeerSubject: string; override;
+ {:See @inherited}
+ function GetPeerSerialNo: integer; override; {pf}
+ {:See @inherited}
+ function GetPeerIssuer: string; override;
+ {:See @inherited}
+ function GetPeerName: string; override;
+ {:See @inherited}
+ function GetPeerNameHash: cardinal; override; {pf}
+ {:See @inherited}
+ function GetPeerFingerprint: string; override;
+ {:See @inherited}
+ function GetCertInfo: string; override;
+ {:See @inherited}
+ function GetCipherName: string; override;
+ {:See @inherited}
+ function GetCipherBits: integer; override;
+ {:See @inherited}
+ function GetCipherAlgBits: integer; override;
+ {:See @inherited}
+ function GetVerifyCert: integer; override;
+ end;
+
+implementation
+
+{==============================================================================}
+
+{$IFNDEF CIL}
+function PasswordCallback(buf:PAnsiChar; size:Integer; rwflag:Integer; userdata: Pointer):Integer; cdecl;
+var
+ Password: AnsiString;
+begin
+ Password := '';
+ if TCustomSSL(userdata) is TCustomSSL then
+ Password := TCustomSSL(userdata).KeyPassword;
+ if Length(Password) > (Size - 1) then
+ SetLength(Password, Size - 1);
+ Result := Length(Password);
+ StrLCopy(buf, PAnsiChar(Password + #0), Result + 1);
+end;
+{$ENDIF}
+
+{==============================================================================}
+
+constructor TSSLOpenSSL.Create(const Value: TTCPBlockSocket);
+begin
+ inherited Create(Value);
+ FCiphers := 'DEFAULT';
+ FSsl := nil;
+ Fctx := nil;
+end;
+
+destructor TSSLOpenSSL.Destroy;
+begin
+ DeInit;
+ inherited Destroy;
+end;
+
+function TSSLOpenSSL.LibVersion: String;
+begin
+ Result := SSLeayversion(0);
+end;
+
+function TSSLOpenSSL.LibName: String;
+begin
+ Result := 'ssl_openssl';
+end;
+
+function TSSLOpenSSL.SSLCheck: Boolean;
+var
+{$IFDEF CIL}
+ sb: StringBuilder;
+{$ENDIF}
+ s : AnsiString;
+begin
+ Result := true;
+ FLastErrorDesc := '';
+ FLastError := ErrGetError;
+ ErrClearError;
+ if FLastError <> 0 then
+ begin
+ Result := False;
+{$IFDEF CIL}
+ sb := StringBuilder.Create(256);
+ ErrErrorString(FLastError, sb, 256);
+ FLastErrorDesc := Trim(sb.ToString);
+{$ELSE}
+ s := StringOfChar(#0, 256);
+ ErrErrorString(FLastError, s, Length(s));
+ FLastErrorDesc := s;
+{$ENDIF}
+ end;
+end;
+
+function TSSLOpenSSL.CreateSelfSignedCert(Host: string): Boolean;
+var
+ pk: EVP_PKEY;
+ x: PX509;
+ rsa: PRSA;
+ t: PASN1_UTCTIME;
+ name: PX509_NAME;
+ b: PBIO;
+ xn, y: integer;
+ s: AnsiString;
+{$IFDEF CIL}
+ sb: StringBuilder;
+{$ENDIF}
+begin
+ Result := True;
+ pk := EvpPkeynew;
+ x := X509New;
+ try
+ rsa := RsaGenerateKey(1024, $10001, nil, nil);
+ EvpPkeyAssign(pk, EVP_PKEY_RSA, rsa);
+ X509SetVersion(x, 2);
+ Asn1IntegerSet(X509getSerialNumber(x), 0);
+ t := Asn1UtctimeNew;
+ try
+ X509GmtimeAdj(t, -60 * 60 *24);
+ X509SetNotBefore(x, t);
+ X509GmtimeAdj(t, 60 * 60 * 60 *24);
+ X509SetNotAfter(x, t);
+ finally
+ Asn1UtctimeFree(t);
+ end;
+ X509SetPubkey(x, pk);
+ Name := X509GetSubjectName(x);
+ X509NameAddEntryByTxt(Name, 'C', $1001, 'CZ', -1, -1, 0);
+ X509NameAddEntryByTxt(Name, 'CN', $1001, host, -1, -1, 0);
+ x509SetIssuerName(x, Name);
+ x509Sign(x, pk, EvpGetDigestByName('SHA1'));
+ b := BioNew(BioSMem);
+ try
+ i2dX509Bio(b, x);
+ xn := bioctrlpending(b);
+{$IFDEF CIL}
+ sb := StringBuilder.Create(xn);
+ y := bioread(b, sb, xn);
+ if y > 0 then
+ begin
+ sb.Length := y;
+ s := sb.ToString;
+ end;
+{$ELSE}
+ setlength(s, xn);
+ y := bioread(b, s, xn);
+ if y > 0 then
+ setlength(s, y);
+{$ENDIF}
+ finally
+ BioFreeAll(b);
+ end;
+ FCertificate := s;
+ b := BioNew(BioSMem);
+ try
+ i2dPrivatekeyBio(b, pk);
+ xn := bioctrlpending(b);
+{$IFDEF CIL}
+ sb := StringBuilder.Create(xn);
+ y := bioread(b, sb, xn);
+ if y > 0 then
+ begin
+ sb.Length := y;
+ s := sb.ToString;
+ end;
+{$ELSE}
+ setlength(s, xn);
+ y := bioread(b, s, xn);
+ if y > 0 then
+ setlength(s, y);
+{$ENDIF}
+ finally
+ BioFreeAll(b);
+ end;
+ FPrivatekey := s;
+ finally
+ X509free(x);
+ EvpPkeyFree(pk);
+ end;
+end;
+
+function TSSLOpenSSL.LoadPFX(pfxdata: Ansistring): Boolean;
+var
+ cert, pkey, ca: SslPtr;
+ b: PBIO;
+ p12: SslPtr;
+begin
+ Result := False;
+ b := BioNew(BioSMem);
+ try
+ BioWrite(b, pfxdata, Length(PfxData));
+ p12 := d2iPKCS12bio(b, nil);
+ if not Assigned(p12) then
+ Exit;
+ try
+ cert := nil;
+ pkey := nil;
+ ca := nil;
+ try {pf}
+ if PKCS12parse(p12, FKeyPassword, pkey, cert, ca) > 0 then
+ if SSLCTXusecertificate(Fctx, cert) > 0 then
+ if SSLCTXusePrivateKey(Fctx, pkey) > 0 then
+ Result := True;
+ {pf}
+ finally
+ EvpPkeyFree(pkey);
+ X509free(cert);
+ SkX509PopFree(ca,_X509Free); // for ca=nil a new STACK was allocated...
+ end;
+ {/pf}
+ finally
+ PKCS12free(p12);
+ end;
+ finally
+ BioFreeAll(b);
+ end;
+end;
+
+function TSSLOpenSSL.SetSslKeys: boolean;
+var
+ st: TFileStream;
+ s: string;
+begin
+ Result := False;
+ if not assigned(FCtx) then
+ Exit;
+ try
+ if FCertificateFile <> '' then
+ if SslCtxUseCertificateChainFile(FCtx, FCertificateFile) <> 1 then
+ if SslCtxUseCertificateFile(FCtx, FCertificateFile, SSL_FILETYPE_PEM) <> 1 then
+ if SslCtxUseCertificateFile(FCtx, FCertificateFile, SSL_FILETYPE_ASN1) <> 1 then
+ Exit;
+ if FCertificate <> '' then
+ if SslCtxUseCertificateASN1(FCtx, length(FCertificate), FCertificate) <> 1 then
+ Exit;
+ SSLCheck;
+ if FPrivateKeyFile <> '' then
+ if SslCtxUsePrivateKeyFile(FCtx, FPrivateKeyFile, SSL_FILETYPE_PEM) <> 1 then
+ if SslCtxUsePrivateKeyFile(FCtx, FPrivateKeyFile, SSL_FILETYPE_ASN1) <> 1 then
+ Exit;
+ if FPrivateKey <> '' then
+ if SslCtxUsePrivateKeyASN1(EVP_PKEY_RSA, FCtx, FPrivateKey, length(FPrivateKey)) <> 1 then
+ Exit;
+ SSLCheck;
+ if FCertCAFile <> '' then
+ if SslCtxLoadVerifyLocations(FCtx, FCertCAFile, '') <> 1 then
+ Exit;
+ if FPFXfile <> '' then
+ begin
+ try
+ st := TFileStream.Create(FPFXfile, fmOpenRead or fmShareDenyNone);
+ try
+ s := ReadStrFromStream(st, st.Size);
+ finally
+ st.Free;
+ end;
+ if not LoadPFX(s) then
+ Exit;
+ except
+ on Exception do
+ Exit;
+ end;
+ end;
+ if FPFX <> '' then
+ if not LoadPFX(FPfx) then
+ Exit;
+ SSLCheck;
+ Result := True;
+ finally
+ SSLCheck;
+ end;
+end;
+
+function TSSLOpenSSL.Init(server:Boolean): Boolean;
+var
+ s: AnsiString;
+begin
+ Result := False;
+ FLastErrorDesc := '';
+ FLastError := 0;
+ Fctx := nil;
+ case FSSLType of
+ LT_SSLv2:
+ Fctx := SslCtxNew(SslMethodV2);
+ LT_SSLv3:
+ Fctx := SslCtxNew(SslMethodV3);
+ LT_TLSv1:
+ Fctx := SslCtxNew(SslMethodTLSV1);
+ LT_all:
+ Fctx := SslCtxNew(SslMethodV23);
+ else
+ Exit;
+ end;
+ if Fctx = nil then
+ begin
+ SSLCheck;
+ Exit;
+ end
+ else
+ begin
+ s := FCiphers;
+ SslCtxSetCipherList(Fctx, s);
+ if FVerifyCert then
+ SslCtxSetVerify(FCtx, SSL_VERIFY_PEER, nil)
+ else
+ SslCtxSetVerify(FCtx, SSL_VERIFY_NONE, nil);
+{$IFNDEF CIL}
+ SslCtxSetDefaultPasswdCb(FCtx, @PasswordCallback);
+ SslCtxSetDefaultPasswdCbUserdata(FCtx, self);
+{$ENDIF}
+
+ if server and (FCertificateFile = '') and (FCertificate = '')
+ and (FPFXfile = '') and (FPFX = '') then
+ begin
+ CreateSelfSignedcert(FSocket.ResolveIPToName(FSocket.GetRemoteSinIP));
+ end;
+
+ if not SetSSLKeys then
+ Exit
+ else
+ begin
+ Fssl := nil;
+ Fssl := SslNew(Fctx);
+ if Fssl = nil then
+ begin
+ SSLCheck;
+ exit;
+ end;
+ end;
+ end;
+ Result := true;
+end;
+
+function TSSLOpenSSL.DeInit: Boolean;
+begin
+ Result := True;
+ if assigned (Fssl) then
+ sslfree(Fssl);
+ Fssl := nil;
+ if assigned (Fctx) then
+ begin
+ SslCtxFree(Fctx);
+ Fctx := nil;
+ ErrRemoveState(0);
+ end;
+ FSSLEnabled := False;
+end;
+
+function TSSLOpenSSL.Prepare(server:Boolean): Boolean;
+begin
+ Result := false;
+ DeInit;
+ if Init(server) then
+ Result := true
+ else
+ DeInit;
+end;
+
+function TSSLOpenSSL.Connect: boolean;
+var
+ x: integer;
+begin
+ Result := False;
+ if FSocket.Socket = INVALID_SOCKET then
+ Exit;
+ if Prepare(False) then
+ begin
+{$IFDEF CIL}
+ if sslsetfd(FSsl, FSocket.Socket.Handle.ToInt32) < 1 then
+{$ELSE}
+ if sslsetfd(FSsl, FSocket.Socket) < 1 then
+{$ENDIF}
+ begin
+ SSLCheck;
+ Exit;
+ end;
+ if SNIHost<>'' then
+ SSLCtrl(Fssl, SSL_CTRL_SET_TLSEXT_HOSTNAME, TLSEXT_NAMETYPE_host_name, PAnsiChar(SNIHost));
+ x := sslconnect(FSsl);
+ if x < 1 then
+ begin
+ SSLcheck;
+ Exit;
+ end;
+ if FverifyCert then
+ if (GetVerifyCert <> 0) or (not DoVerifyCert) then
+ Exit;
+ FSSLEnabled := True;
+ Result := True;
+ end;
+end;
+
+function TSSLOpenSSL.Accept: boolean;
+var
+ x: integer;
+begin
+ Result := False;
+ if FSocket.Socket = INVALID_SOCKET then
+ Exit;
+ if Prepare(True) then
+ begin
+{$IFDEF CIL}
+ if sslsetfd(FSsl, FSocket.Socket.Handle.ToInt32) < 1 then
+{$ELSE}
+ if sslsetfd(FSsl, FSocket.Socket) < 1 then
+{$ENDIF}
+ begin
+ SSLCheck;
+ Exit;
+ end;
+ x := sslAccept(FSsl);
+ if x < 1 then
+ begin
+ SSLcheck;
+ Exit;
+ end;
+ FSSLEnabled := True;
+ Result := True;
+ end;
+end;
+
+function TSSLOpenSSL.Shutdown: boolean;
+begin
+ if assigned(FSsl) then
+ sslshutdown(FSsl);
+ DeInit;
+ Result := True;
+end;
+
+function TSSLOpenSSL.BiShutdown: boolean;
+var
+ x: integer;
+begin
+ if assigned(FSsl) then
+ begin
+ x := sslshutdown(FSsl);
+ if x = 0 then
+ begin
+ Synsock.Shutdown(FSocket.Socket, 1);
+ sslshutdown(FSsl);
+ end;
+ end;
+ DeInit;
+ Result := True;
+end;
+
+function TSSLOpenSSL.SendBuffer(Buffer: TMemory; Len: Integer): Integer;
+var
+ err: integer;
+{$IFDEF CIL}
+ s: ansistring;
+{$ENDIF}
+begin
+ FLastError := 0;
+ FLastErrorDesc := '';
+ repeat
+{$IFDEF CIL}
+ s := StringOf(Buffer);
+ Result := SslWrite(FSsl, s, Len);
+{$ELSE}
+ Result := SslWrite(FSsl, Buffer , Len);
+{$ENDIF}
+ err := SslGetError(FSsl, Result);
+ until (err <> SSL_ERROR_WANT_READ) and (err <> SSL_ERROR_WANT_WRITE);
+ if err = SSL_ERROR_ZERO_RETURN then
+ Result := 0
+ else
+ if (err <> 0) then
+ FLastError := err;
+end;
+
+function TSSLOpenSSL.RecvBuffer(Buffer: TMemory; Len: Integer): Integer;
+var
+ err: integer;
+{$IFDEF CIL}
+ sb: stringbuilder;
+ s: ansistring;
+{$ENDIF}
+begin
+ FLastError := 0;
+ FLastErrorDesc := '';
+ repeat
+{$IFDEF CIL}
+ sb := StringBuilder.Create(Len);
+ Result := SslRead(FSsl, sb, Len);
+ if Result > 0 then
+ begin
+ sb.Length := Result;
+ s := sb.ToString;
+ System.Array.Copy(BytesOf(s), Buffer, length(s));
+ end;
+{$ELSE}
+ Result := SslRead(FSsl, Buffer , Len);
+{$ENDIF}
+ err := SslGetError(FSsl, Result);
+ until (err <> SSL_ERROR_WANT_READ) and (err <> SSL_ERROR_WANT_WRITE);
+ if err = SSL_ERROR_ZERO_RETURN then
+ Result := 0
+ {pf}// Verze 1.1.0 byla s else tak jak to ted mam,
+ // ve verzi 1.1.1 bylo ELSE zruseno, ale pak je SSL_ERROR_ZERO_RETURN
+ // propagovano jako Chyba.
+ {pf} else {/pf} if (err <> 0) then
+ FLastError := err;
+end;
+
+function TSSLOpenSSL.WaitingData: Integer;
+begin
+ Result := sslpending(Fssl);
+end;
+
+function TSSLOpenSSL.GetSSLVersion: string;
+begin
+ if not assigned(FSsl) then
+ Result := ''
+ else
+ Result := SSlGetVersion(FSsl);
+end;
+
+function TSSLOpenSSL.GetPeerSubject: string;
+var
+ cert: PX509;
+ s: ansistring;
+{$IFDEF CIL}
+ sb: StringBuilder;
+{$ENDIF}
+begin
+ if not assigned(FSsl) then
+ begin
+ Result := '';
+ Exit;
+ end;
+ cert := SSLGetPeerCertificate(Fssl);
+ if not assigned(cert) then
+ begin
+ Result := '';
+ Exit;
+ end;
+{$IFDEF CIL}
+ sb := StringBuilder.Create(4096);
+ Result := X509NameOneline(X509GetSubjectName(cert), sb, 4096);
+{$ELSE}
+ setlength(s, 4096);
+ Result := X509NameOneline(X509GetSubjectName(cert), s, Length(s));
+{$ENDIF}
+ X509Free(cert);
+end;
+
+
+function TSSLOpenSSL.GetPeerSerialNo: integer; {pf}
+var
+ cert: PX509;
+ SN: PASN1_INTEGER;
+begin
+ if not assigned(FSsl) then
+ begin
+ Result := -1;
+ Exit;
+ end;
+ cert := SSLGetPeerCertificate(Fssl);
+ try
+ if not assigned(cert) then
+ begin
+ Result := -1;
+ Exit;
+ end;
+ SN := X509GetSerialNumber(cert);
+ Result := Asn1IntegerGet(SN);
+ finally
+ X509Free(cert);
+ end;
+end;
+
+function TSSLOpenSSL.GetPeerName: string;
+var
+ s: ansistring;
+begin
+ s := GetPeerSubject;
+ s := SeparateRight(s, '/CN=');
+ Result := Trim(SeparateLeft(s, '/'));
+end;
+
+function TSSLOpenSSL.GetPeerNameHash: cardinal; {pf}
+var
+ cert: PX509;
+begin
+ if not assigned(FSsl) then
+ begin
+ Result := 0;
+ Exit;
+ end;
+ cert := SSLGetPeerCertificate(Fssl);
+ try
+ if not assigned(cert) then
+ begin
+ Result := 0;
+ Exit;
+ end;
+ Result := X509NameHash(X509GetSubjectName(cert));
+ finally
+ X509Free(cert);
+ end;
+end;
+
+function TSSLOpenSSL.GetPeerIssuer: string;
+var
+ cert: PX509;
+ s: ansistring;
+{$IFDEF CIL}
+ sb: StringBuilder;
+{$ENDIF}
+begin
+ if not assigned(FSsl) then
+ begin
+ Result := '';
+ Exit;
+ end;
+ cert := SSLGetPeerCertificate(Fssl);
+ if not assigned(cert) then
+ begin
+ Result := '';
+ Exit;
+ end;
+{$IFDEF CIL}
+ sb := StringBuilder.Create(4096);
+ Result := X509NameOneline(X509GetIssuerName(cert), sb, 4096);
+{$ELSE}
+ setlength(s, 4096);
+ Result := X509NameOneline(X509GetIssuerName(cert), s, Length(s));
+{$ENDIF}
+ X509Free(cert);
+end;
+
+function TSSLOpenSSL.GetPeerFingerprint: string;
+var
+ cert: PX509;
+ x: integer;
+{$IFDEF CIL}
+ sb: StringBuilder;
+{$ENDIF}
+begin
+ if not assigned(FSsl) then
+ begin
+ Result := '';
+ Exit;
+ end;
+ cert := SSLGetPeerCertificate(Fssl);
+ if not assigned(cert) then
+ begin
+ Result := '';
+ Exit;
+ end;
+{$IFDEF CIL}
+ sb := StringBuilder.Create(EVP_MAX_MD_SIZE);
+ X509Digest(cert, EvpGetDigestByName('MD5'), sb, x);
+ sb.Length := x;
+ Result := sb.ToString;
+{$ELSE}
+ setlength(Result, EVP_MAX_MD_SIZE);
+ X509Digest(cert, EvpGetDigestByName('MD5'), Result, x);
+ SetLength(Result, x);
+{$ENDIF}
+ X509Free(cert);
+end;
+
+function TSSLOpenSSL.GetCertInfo: string;
+var
+ cert: PX509;
+ x, y: integer;
+ b: PBIO;
+ s: AnsiString;
+{$IFDEF CIL}
+ sb: stringbuilder;
+{$ENDIF}
+begin
+ if not assigned(FSsl) then
+ begin
+ Result := '';
+ Exit;
+ end;
+ cert := SSLGetPeerCertificate(Fssl);
+ if not assigned(cert) then
+ begin
+ Result := '';
+ Exit;
+ end;
+ try {pf}
+ b := BioNew(BioSMem);
+ try
+ X509Print(b, cert);
+ x := bioctrlpending(b);
+ {$IFDEF CIL}
+ sb := StringBuilder.Create(x);
+ y := bioread(b, sb, x);
+ if y > 0 then
+ begin
+ sb.Length := y;
+ s := sb.ToString;
+ end;
+ {$ELSE}
+ setlength(s,x);
+ y := bioread(b,s,x);
+ if y > 0 then
+ setlength(s, y);
+ {$ENDIF}
+ Result := ReplaceString(s, LF, CRLF);
+ finally
+ BioFreeAll(b);
+ end;
+ {pf}
+ finally
+ X509Free(cert);
+ end;
+ {/pf}
+end;
+
+function TSSLOpenSSL.GetCipherName: string;
+begin
+ if not assigned(FSsl) then
+ Result := ''
+ else
+ Result := SslCipherGetName(SslGetCurrentCipher(FSsl));
+end;
+
+function TSSLOpenSSL.GetCipherBits: integer;
+var
+ x: integer;
+begin
+ if not assigned(FSsl) then
+ Result := 0
+ else
+ Result := SSLCipherGetBits(SslGetCurrentCipher(FSsl), x);
+end;
+
+function TSSLOpenSSL.GetCipherAlgBits: integer;
+begin
+ if not assigned(FSsl) then
+ Result := 0
+ else
+ SSLCipherGetBits(SslGetCurrentCipher(FSsl), Result);
+end;
+
+function TSSLOpenSSL.GetVerifyCert: integer;
+begin
+ if not assigned(FSsl) then
+ Result := 1
+ else
+ Result := SslGetVerifyResult(FSsl);
+end;
+
+{==============================================================================}
+
+initialization
+ if InitSSLInterface then
+ SSLImplementation := TSSLOpenSSL;
+
+end.
ADDED lib/synapse/source/lib/ssl_openssl_lib.pas
Index: lib/synapse/source/lib/ssl_openssl_lib.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/lib/ssl_openssl_lib.pas
@@ -0,0 +1,2138 @@
+{==============================================================================|
+| Project : Ararat Synapse | 003.007.000 |
+|==============================================================================|
+| Content: SSL support by OpenSSL |
+|==============================================================================|
+| Copyright (c)1999-2012, Lukas Gebauer |
+| All rights reserved. |
+| |
+| Redistribution and use in source and binary forms, with or without |
+| modification, are permitted provided that the following conditions are met: |
+| |
+| Redistributions of source code must retain the above copyright notice, this |
+| list of conditions and the following disclaimer. |
+| |
+| Redistributions in binary form must reproduce the above copyright notice, |
+| this list of conditions and the following disclaimer in the documentation |
+| and/or other materials provided with the distribution. |
+| |
+| Neither the name of Lukas Gebauer nor the names of its contributors may |
+| be used to endorse or promote products derived from this software without |
+| specific prior written permission. |
+| |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
+| DAMAGE. |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2002-2012. |
+| Portions created by Petr Fejfar are Copyright (c)2011-2012. |
+| All Rights Reserved. |
+|==============================================================================|
+| Contributor(s): |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package |
+| (Found at URL: http://www.ararat.cz/synapse/) |
+|==============================================================================}
+
+{
+Special thanks to Gregor Ibic
+ (Intelicom d.o.o., http://www.intelicom.si)
+ for good inspiration about begin with SSL programming.
+}
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+{$IFDEF VER125}
+ {$DEFINE BCB}
+{$ENDIF}
+{$IFDEF BCB}
+ {$ObjExportAll On}
+ (*$HPPEMIT 'namespace ssl_openssl_lib { using System::Shortint; }' *)
+{$ENDIF}
+
+//old Delphi does not have MSWINDOWS define.
+{$IFDEF WIN32}
+ {$IFNDEF MSWINDOWS}
+ {$DEFINE MSWINDOWS}
+ {$ENDIF}
+{$ENDIF}
+
+{:@abstract(OpenSSL support)
+
+This unit is Pascal interface to OpenSSL library (used by @link(ssl_openssl) unit).
+OpenSSL is loaded dynamicly on-demand. If this library is not found in system,
+requested OpenSSL function just return errorcode.
+}
+unit ssl_openssl_lib;
+
+interface
+
+uses
+{$IFDEF CIL}
+ System.Runtime.InteropServices,
+ System.Text,
+{$ENDIF}
+ Classes,
+ synafpc,
+{$IFNDEF MSWINDOWS}
+ {$IFDEF FPC}
+ BaseUnix, SysUtils;
+ {$ELSE}
+ Libc, SysUtils;
+ {$ENDIF}
+{$ELSE}
+ Windows;
+{$ENDIF}
+
+
+{$IFDEF CIL}
+const
+ {$IFDEF LINUX}
+ DLLSSLName = 'libssl.so';
+ DLLUtilName = 'libcrypto.so';
+ {$ELSE}
+ DLLSSLName = 'ssleay32.dll';
+ DLLUtilName = 'libeay32.dll';
+ {$ENDIF}
+{$ELSE}
+var
+ {$IFNDEF MSWINDOWS}
+ {$IFDEF DARWIN}
+ DLLSSLName: string = 'libssl.dylib';
+ DLLUtilName: string = 'libcrypto.dylib';
+ {$ELSE}
+ DLLSSLName: string = 'libssl.so';
+ DLLUtilName: string = 'libcrypto.so';
+ {$ENDIF}
+ {$ELSE}
+ DLLSSLName: string = 'ssleay32.dll';
+ DLLSSLName2: string = 'libssl32.dll';
+ DLLUtilName: string = 'libeay32.dll';
+ {$ENDIF}
+{$ENDIF}
+
+type
+{$IFDEF CIL}
+ SslPtr = IntPtr;
+{$ELSE}
+ SslPtr = Pointer;
+{$ENDIF}
+ PSslPtr = ^SslPtr;
+ PSSL_CTX = SslPtr;
+ PSSL = SslPtr;
+ PSSL_METHOD = SslPtr;
+ PX509 = SslPtr;
+ PX509_NAME = SslPtr;
+ PEVP_MD = SslPtr;
+ PInteger = ^Integer;
+ PBIO_METHOD = SslPtr;
+ PBIO = SslPtr;
+ EVP_PKEY = SslPtr;
+ PRSA = SslPtr;
+ PASN1_UTCTIME = SslPtr;
+ PASN1_INTEGER = SslPtr;
+ PPasswdCb = SslPtr;
+ PFunction = procedure;
+ PSTACK = SslPtr; {pf}
+ TSkPopFreeFunc = procedure(p:SslPtr); cdecl; {pf}
+ TX509Free = procedure(x: PX509); cdecl; {pf}
+
+ DES_cblock = array[0..7] of Byte;
+ PDES_cblock = ^DES_cblock;
+ des_ks_struct = packed record
+ ks: DES_cblock;
+ weak_key: Integer;
+ end;
+ des_key_schedule = array[1..16] of des_ks_struct;
+
+const
+ EVP_MAX_MD_SIZE = 16 + 20;
+
+ SSL_ERROR_NONE = 0;
+ SSL_ERROR_SSL = 1;
+ SSL_ERROR_WANT_READ = 2;
+ SSL_ERROR_WANT_WRITE = 3;
+ SSL_ERROR_WANT_X509_LOOKUP = 4;
+ SSL_ERROR_SYSCALL = 5; //look at error stack/return value/errno
+ SSL_ERROR_ZERO_RETURN = 6;
+ SSL_ERROR_WANT_CONNECT = 7;
+ SSL_ERROR_WANT_ACCEPT = 8;
+
+ SSL_OP_NO_SSLv2 = $01000000;
+ SSL_OP_NO_SSLv3 = $02000000;
+ SSL_OP_NO_TLSv1 = $04000000;
+ SSL_OP_ALL = $000FFFFF;
+ SSL_VERIFY_NONE = $00;
+ SSL_VERIFY_PEER = $01;
+
+ OPENSSL_DES_DECRYPT = 0;
+ OPENSSL_DES_ENCRYPT = 1;
+
+ X509_V_OK = 0;
+ X509_V_ILLEGAL = 1;
+ X509_V_ERR_UNABLE_TO_GET_ISSUER_CERT = 2;
+ X509_V_ERR_UNABLE_TO_GET_CRL = 3;
+ X509_V_ERR_UNABLE_TO_DECRYPT_CERT_SIGNATURE = 4;
+ X509_V_ERR_UNABLE_TO_DECRYPT_CRL_SIGNATURE = 5;
+ X509_V_ERR_UNABLE_TO_DECODE_ISSUER_PUBLIC_KEY = 6;
+ X509_V_ERR_CERT_SIGNATURE_FAILURE = 7;
+ X509_V_ERR_CRL_SIGNATURE_FAILURE = 8;
+ X509_V_ERR_CERT_NOT_YET_VALID = 9;
+ X509_V_ERR_CERT_HAS_EXPIRED = 10;
+ X509_V_ERR_CRL_NOT_YET_VALID = 11;
+ X509_V_ERR_CRL_HAS_EXPIRED = 12;
+ X509_V_ERR_ERROR_IN_CERT_NOT_BEFORE_FIELD = 13;
+ X509_V_ERR_ERROR_IN_CERT_NOT_AFTER_FIELD = 14;
+ X509_V_ERR_ERROR_IN_CRL_LAST_UPDATE_FIELD = 15;
+ X509_V_ERR_ERROR_IN_CRL_NEXT_UPDATE_FIELD = 16;
+ X509_V_ERR_OUT_OF_MEM = 17;
+ X509_V_ERR_DEPTH_ZERO_SELF_SIGNED_CERT = 18;
+ X509_V_ERR_SELF_SIGNED_CERT_IN_CHAIN = 19;
+ X509_V_ERR_UNABLE_TO_GET_ISSUER_CERT_LOCALLY = 20;
+ X509_V_ERR_UNABLE_TO_VERIFY_LEAF_SIGNATURE = 21;
+ X509_V_ERR_CERT_CHAIN_TOO_LONG = 22;
+ X509_V_ERR_CERT_REVOKED = 23;
+ X509_V_ERR_INVALID_CA = 24;
+ X509_V_ERR_PATH_LENGTH_EXCEEDED = 25;
+ X509_V_ERR_INVALID_PURPOSE = 26;
+ X509_V_ERR_CERT_UNTRUSTED = 27;
+ X509_V_ERR_CERT_REJECTED = 28;
+ //These are 'informational' when looking for issuer cert
+ X509_V_ERR_SUBJECT_ISSUER_MISMATCH = 29;
+ X509_V_ERR_AKID_SKID_MISMATCH = 30;
+ X509_V_ERR_AKID_ISSUER_SERIAL_MISMATCH = 31;
+ X509_V_ERR_KEYUSAGE_NO_CERTSIGN = 32;
+ X509_V_ERR_UNABLE_TO_GET_CRL_ISSUER = 33;
+ X509_V_ERR_UNHANDLED_CRITICAL_EXTENSION = 34;
+ //The application is not happy
+ X509_V_ERR_APPLICATION_VERIFICATION = 50;
+
+ SSL_FILETYPE_ASN1 = 2;
+ SSL_FILETYPE_PEM = 1;
+ EVP_PKEY_RSA = 6;
+
+ SSL_CTRL_SET_TLSEXT_HOSTNAME = 55;
+ TLSEXT_NAMETYPE_host_name = 0;
+
+var
+ SSLLibHandle: TLibHandle = 0;
+ SSLUtilHandle: TLibHandle = 0;
+ SSLLibFile: string = '';
+ SSLUtilFile: string = '';
+
+{$IFDEF CIL}
+ [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'SSL_get_error')]
+ function SslGetError(s: PSSL; ret_code: Integer): Integer; external;
+
+ [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'SSL_library_init')]
+ function SslLibraryInit: Integer; external;
+
+ [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'SSL_load_error_strings')]
+ procedure SslLoadErrorStrings; external;
+
+ [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'SSL_CTX_set_cipher_list')]
+ function SslCtxSetCipherList(arg0: PSSL_CTX; var str: String): Integer; external;
+
+ [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'SSL_CTX_new')]
+ function SslCtxNew(meth: PSSL_METHOD):PSSL_CTX; external;
+
+ [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'SSL_CTX_free')]
+ procedure SslCtxFree (arg0: PSSL_CTX); external;
+
+ [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'SSL_set_fd')]
+ function SslSetFd(s: PSSL; fd: Integer):Integer; external;
+
+ [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'SSLv2_method')]
+ function SslMethodV2 : PSSL_METHOD; external;
+
+ [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'SSLv3_method')]
+ function SslMethodV3 : PSSL_METHOD; external;
+
+ [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'TLSv1_method')]
+ function SslMethodTLSV1:PSSL_METHOD; external;
+
+ [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'SSLv23_method')]
+ function SslMethodV23 : PSSL_METHOD; external;
+
+ [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'SSL_CTX_use_PrivateKey')]
+ function SslCtxUsePrivateKey(ctx: PSSL_CTX; pkey: SslPtr):Integer; external;
+
+ [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'SSL_CTX_use_PrivateKey_ASN1')]
+ function SslCtxUsePrivateKeyASN1(pk: integer; ctx: PSSL_CTX; d: String; len: integer):Integer; external;
+
+ [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'SSL_CTX_use_RSAPrivateKey_file')]
+ function SslCtxUsePrivateKeyFile(ctx: PSSL_CTX; const _file: String; _type: Integer):Integer; external;
+
+ [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'SSL_CTX_use_certificate')]
+ function SslCtxUseCertificate(ctx: PSSL_CTX; x: SslPtr):Integer; external;
+
+ [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'SSL_CTX_use_certificate_ASN1')]
+ function SslCtxUseCertificateASN1(ctx: PSSL_CTX; len: integer; d: String):Integer; external;
+
+ [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'SSL_CTX_use_certificate_file')]
+ function SslCtxUseCertificateFile(ctx: PSSL_CTX; const _file: String; _type: Integer):Integer;external;
+
+ [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'SSL_CTX_use_certificate_chain_file')]
+ function SslCtxUseCertificateChainFile(ctx: PSSL_CTX; const _file: String):Integer;external;
+
+ [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'SSL_CTX_check_private_key')]
+ function SslCtxCheckPrivateKeyFile(ctx: PSSL_CTX):Integer; external;
+
+ [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'SSL_CTX_set_default_passwd_cb')]
+ procedure SslCtxSetDefaultPasswdCb(ctx: PSSL_CTX; cb: PPasswdCb); external;
+
+ [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'SSL_CTX_set_default_passwd_cb_userdata')]
+ procedure SslCtxSetDefaultPasswdCbUserdata(ctx: PSSL_CTX; u: IntPtr); external;
+
+ [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'SSL_CTX_load_verify_locations')]
+ function SslCtxLoadVerifyLocations(ctx: PSSL_CTX; CAfile: string; CApath: String):Integer; external;
+
+ [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'SSL_CTX_ctrl')]
+ function SslCtxCtrl(ctx: PSSL_CTX; cmd: integer; larg: integer; parg: IntPtr): integer; external;
+
+ [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'SSL_new')]
+ function SslNew(ctx: PSSL_CTX):PSSL; external;
+
+ [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'SSL_free')]
+ procedure SslFree(ssl: PSSL); external;
+
+ [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'SSL_accept')]
+ function SslAccept(ssl: PSSL):Integer; external;
+
+ [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'SSL_connect')]
+ function SslConnect(ssl: PSSL):Integer; external;
+
+ [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'SSL_shutdown')]
+ function SslShutdown(s: PSSL):Integer; external;
+
+ [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'SSL_read')]
+ function SslRead(ssl: PSSL; buf: StringBuilder; num: Integer):Integer; external;
+
+ [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'SSL_peek')]
+ function SslPeek(ssl: PSSL; buf: StringBuilder; num: Integer):Integer; external;
+
+ [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'SSL_write')]
+ function SslWrite(ssl: PSSL; buf: String; num: Integer):Integer; external;
+
+ [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'SSL_pending')]
+ function SslPending(ssl: PSSL):Integer; external;
+
+ [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'SSL_get_version')]
+ function SslGetVersion(ssl: PSSL):String; external;
+
+ [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'SSL_get_peer_certificate')]
+ function SslGetPeerCertificate(s: PSSL):PX509; external;
+
+ [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'SSL_CTX_set_verify')]
+ procedure SslCtxSetVerify(ctx: PSSL_CTX; mode: Integer; arg2: PFunction); external;
+
+ [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'SSL_get_current_cipher')]
+ function SSLGetCurrentCipher(s: PSSL): SslPtr; external;
+
+ [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'SSL_CIPHER_get_name')]
+ function SSLCipherGetName(c: SslPtr):String; external;
+
+ [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'SSL_CIPHER_get_bits')]
+ function SSLCipherGetBits(c: SslPtr; var alg_bits: Integer):Integer; external;
+
+ [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'SSL_get_verify_result')]
+ function SSLGetVerifyResult(ssl: PSSL):Integer;external;
+
+ [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'SSL_ctrl')]
+ function SslCtrl(ssl: PSSL; cmd: integer; larg: integer; parg: IntPtr): integer; external;
+
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'X509_new')]
+ function X509New: PX509; external;
+
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'X509_free')]
+ procedure X509Free(x: PX509); external;
+
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'X509_NAME_oneline')]
+ function X509NameOneline(a: PX509_NAME; buf: StringBuilder; size: Integer): String; external;
+
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'X509_get_subject_name')]
+ function X509GetSubjectName(a: PX509):PX509_NAME; external;
+
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'X509_get_issuer_name')]
+ function X509GetIssuerName(a: PX509):PX509_NAME; external;
+
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'X509_NAME_hash')]
+ function X509NameHash(x: PX509_NAME):Cardinal; external;
+
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'X509_digest')]
+ function X509Digest (data: PX509; _type: PEVP_MD; md: StringBuilder; var len: Integer):Integer; external;
+
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'X509_set_version')]
+ function X509SetVersion(x: PX509; version: integer): integer; external;
+
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'X509_set_pubkey')]
+ function X509SetPubkey(x: PX509; pkey: EVP_PKEY): integer; external;
+
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'X509_set_issuer_name')]
+ function X509SetIssuerName(x: PX509; name: PX509_NAME): integer; external;
+
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'X509_NAME_add_entry_by_txt')]
+ function X509NameAddEntryByTxt(name: PX509_NAME; field: string; _type: integer;
+ bytes: string; len, loc, _set: integer): integer; external;
+
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'X509_sign')]
+ function X509Sign(x: PX509; pkey: EVP_PKEY; const md: PEVP_MD): integer; external;
+
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'X509_print')]
+ function X509print(b: PBIO; a: PX509): integer; external;
+
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'X509_gmtime_adj')]
+ function X509GmtimeAdj(s: PASN1_UTCTIME; adj: integer): PASN1_UTCTIME; external;
+
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'X509_set_notBefore')]
+ function X509SetNotBefore(x: PX509; tm: PASN1_UTCTIME): integer; external;
+
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'X509_set_notAfter')]
+ function X509SetNotAfter(x: PX509; tm: PASN1_UTCTIME): integer; external;
+
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'X509_get_serialNumber')]
+ function X509GetSerialNumber(x: PX509): PASN1_INTEGER; external;
+
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'EVP_PKEY_new')]
+ function EvpPkeyNew: EVP_PKEY; external;
+
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'EVP_PKEY_free')]
+ procedure EvpPkeyFree(pk: EVP_PKEY); external;
+
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'EVP_PKEY_assign')]
+ function EvpPkeyAssign(pkey: EVP_PKEY; _type: integer; key: Prsa): integer; external;
+
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'EVP_get_digestbyname')]
+ function EvpGetDigestByName(Name: String): PEVP_MD; external;
+
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'EVP_cleanup')]
+ procedure EVPcleanup; external;
+
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'SSLeay_version')]
+ function SSLeayversion(t: integer): String; external;
+
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'ERR_error_string_n')]
+ procedure ErrErrorString(e: integer; buf: StringBuilder; len: integer); external;
+
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'ERR_get_error')]
+ function ErrGetError: integer; external;
+
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'ERR_clear_error')]
+ procedure ErrClearError; external;
+
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'ERR_free_strings')]
+ procedure ErrFreeStrings; external;
+
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'ERR_remove_state')]
+ procedure ErrRemoveState(pid: integer); external;
+
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'OPENSSL_add_all_algorithms_noconf')]
+ procedure OPENSSLaddallalgorithms; external;
+
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'CRYPTO_cleanup_all_ex_data')]
+ procedure CRYPTOcleanupAllExData; external;
+
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'RAND_screen')]
+ procedure RandScreen; external;
+
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'BIO_new')]
+ function BioNew(b: PBIO_METHOD): PBIO; external;
+
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'BIO_free_all')]
+ procedure BioFreeAll(b: PBIO); external;
+
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'BIO_s_mem')]
+ function BioSMem: PBIO_METHOD; external;
+
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'BIO_ctrl_pending')]
+ function BioCtrlPending(b: PBIO): integer; external;
+
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'BIO_read')]
+ function BioRead(b: PBIO; Buf: StringBuilder; Len: integer): integer; external;
+
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'BIO_write')]
+ function BioWrite(b: PBIO; var Buf: String; Len: integer): integer; external;
+
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'd2i_PKCS12_bio')]
+ function d2iPKCS12bio(b:PBIO; Pkcs12: SslPtr): SslPtr; external;
+
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'PKCS12_parse')]
+ function PKCS12parse(p12: SslPtr; pass: string; var pkey, cert, ca: SslPtr): integer; external;
+
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'PKCS12_free')]
+ procedure PKCS12free(p12: SslPtr); external;
+
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'RSA_generate_key')]
+ function RsaGenerateKey(bits, e: integer; callback: PFunction; cb_arg: SslPtr): PRSA; external;
+
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'ASN1_UTCTIME_new')]
+ function Asn1UtctimeNew: PASN1_UTCTIME; external;
+
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'ASN1_UTCTIME_free')]
+ procedure Asn1UtctimeFree(a: PASN1_UTCTIME); external;
+
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'ASN1_INTEGER_set')]
+ function Asn1IntegerSet(a: PASN1_INTEGER; v: integer): integer; external;
+
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'i2d_X509_bio')]
+ function i2dX509bio(b: PBIO; x: PX509): integer; external;
+
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'i2d_PrivateKey_bio')]
+ function i2dPrivateKeyBio(b: PBIO; pkey: EVP_PKEY): integer; external;
+
+ // 3DES functions
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'DES_set_odd_parity')]
+ procedure DESsetoddparity(Key: des_cblock); external;
+
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'DES_set_key_checked')]
+ function DESsetkeychecked(key: des_cblock; schedule: des_key_schedule): Integer; external;
+
+ [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'DES_ecb_encrypt')]
+ procedure DESecbencrypt(Input: des_cblock; output: des_cblock; ks: des_key_schedule; enc: Integer); external;
+
+{$ELSE}
+// libssl.dll
+ function SslGetError(s: PSSL; ret_code: Integer):Integer;
+ function SslLibraryInit:Integer;
+ procedure SslLoadErrorStrings;
+// function SslCtxSetCipherList(arg0: PSSL_CTX; str: PChar):Integer;
+ function SslCtxSetCipherList(arg0: PSSL_CTX; var str: AnsiString):Integer;
+ function SslCtxNew(meth: PSSL_METHOD):PSSL_CTX;
+ procedure SslCtxFree(arg0: PSSL_CTX);
+ function SslSetFd(s: PSSL; fd: Integer):Integer;
+ function SslMethodV2:PSSL_METHOD;
+ function SslMethodV3:PSSL_METHOD;
+ function SslMethodTLSV1:PSSL_METHOD;
+ function SslMethodV23:PSSL_METHOD;
+ function SslCtxUsePrivateKey(ctx: PSSL_CTX; pkey: SslPtr):Integer;
+ function SslCtxUsePrivateKeyASN1(pk: integer; ctx: PSSL_CTX; d: AnsiString; len: integer):Integer;
+// function SslCtxUsePrivateKeyFile(ctx: PSSL_CTX; const _file: PChar; _type: Integer):Integer;
+ function SslCtxUsePrivateKeyFile(ctx: PSSL_CTX; const _file: AnsiString; _type: Integer):Integer;
+ function SslCtxUseCertificate(ctx: PSSL_CTX; x: SslPtr):Integer;
+ function SslCtxUseCertificateASN1(ctx: PSSL_CTX; len: integer; d: AnsiString):Integer;
+ function SslCtxUseCertificateFile(ctx: PSSL_CTX; const _file: AnsiString; _type: Integer):Integer;
+// function SslCtxUseCertificateChainFile(ctx: PSSL_CTX; const _file: PChar):Integer;
+ function SslCtxUseCertificateChainFile(ctx: PSSL_CTX; const _file: AnsiString):Integer;
+ function SslCtxCheckPrivateKeyFile(ctx: PSSL_CTX):Integer;
+ procedure SslCtxSetDefaultPasswdCb(ctx: PSSL_CTX; cb: PPasswdCb);
+ procedure SslCtxSetDefaultPasswdCbUserdata(ctx: PSSL_CTX; u: SslPtr);
+// function SslCtxLoadVerifyLocations(ctx: PSSL_CTX; const CAfile: PChar; const CApath: PChar):Integer;
+ function SslCtxLoadVerifyLocations(ctx: PSSL_CTX; const CAfile: AnsiString; const CApath: AnsiString):Integer;
+ function SslCtxCtrl(ctx: PSSL_CTX; cmd: integer; larg: integer; parg: SslPtr): integer;
+ function SslNew(ctx: PSSL_CTX):PSSL;
+ procedure SslFree(ssl: PSSL);
+ function SslAccept(ssl: PSSL):Integer;
+ function SslConnect(ssl: PSSL):Integer;
+ function SslShutdown(ssl: PSSL):Integer;
+ function SslRead(ssl: PSSL; buf: SslPtr; num: Integer):Integer;
+ function SslPeek(ssl: PSSL; buf: SslPtr; num: Integer):Integer;
+ function SslWrite(ssl: PSSL; buf: SslPtr; num: Integer):Integer;
+ function SslPending(ssl: PSSL):Integer;
+ function SslGetVersion(ssl: PSSL):AnsiString;
+ function SslGetPeerCertificate(ssl: PSSL):PX509;
+ procedure SslCtxSetVerify(ctx: PSSL_CTX; mode: Integer; arg2: PFunction);
+ function SSLGetCurrentCipher(s: PSSL):SslPtr;
+ function SSLCipherGetName(c: SslPtr): AnsiString;
+ function SSLCipherGetBits(c: SslPtr; var alg_bits: Integer):Integer;
+ function SSLGetVerifyResult(ssl: PSSL):Integer;
+ function SSLCtrl(ssl: PSSL; cmd: integer; larg: integer; parg: SslPtr):Integer;
+
+// libeay.dll
+ function X509New: PX509;
+ procedure X509Free(x: PX509);
+ function X509NameOneline(a: PX509_NAME; var buf: AnsiString; size: Integer):AnsiString;
+ function X509GetSubjectName(a: PX509):PX509_NAME;
+ function X509GetIssuerName(a: PX509):PX509_NAME;
+ function X509NameHash(x: PX509_NAME):Cardinal;
+// function SslX509Digest(data: PX509; _type: PEVP_MD; md: PChar; len: PInteger):Integer;
+ function X509Digest(data: PX509; _type: PEVP_MD; md: AnsiString; var len: Integer):Integer;
+ function X509print(b: PBIO; a: PX509): integer;
+ function X509SetVersion(x: PX509; version: integer): integer;
+ function X509SetPubkey(x: PX509; pkey: EVP_PKEY): integer;
+ function X509SetIssuerName(x: PX509; name: PX509_NAME): integer;
+ function X509NameAddEntryByTxt(name: PX509_NAME; field: Ansistring; _type: integer;
+ bytes: Ansistring; len, loc, _set: integer): integer;
+ function X509Sign(x: PX509; pkey: EVP_PKEY; const md: PEVP_MD): integer;
+ function X509GmtimeAdj(s: PASN1_UTCTIME; adj: integer): PASN1_UTCTIME;
+ function X509SetNotBefore(x: PX509; tm: PASN1_UTCTIME): integer;
+ function X509SetNotAfter(x: PX509; tm: PASN1_UTCTIME): integer;
+ function X509GetSerialNumber(x: PX509): PASN1_INTEGER;
+ function EvpPkeyNew: EVP_PKEY;
+ procedure EvpPkeyFree(pk: EVP_PKEY);
+ function EvpPkeyAssign(pkey: EVP_PKEY; _type: integer; key: Prsa): integer;
+ function EvpGetDigestByName(Name: AnsiString): PEVP_MD;
+ procedure EVPcleanup;
+// function ErrErrorString(e: integer; buf: PChar): PChar;
+ function SSLeayversion(t: integer): Ansistring;
+ procedure ErrErrorString(e: integer; var buf: Ansistring; len: integer);
+ function ErrGetError: integer;
+ procedure ErrClearError;
+ procedure ErrFreeStrings;
+ procedure ErrRemoveState(pid: integer);
+ procedure OPENSSLaddallalgorithms;
+ procedure CRYPTOcleanupAllExData;
+ procedure RandScreen;
+ function BioNew(b: PBIO_METHOD): PBIO;
+ procedure BioFreeAll(b: PBIO);
+ function BioSMem: PBIO_METHOD;
+ function BioCtrlPending(b: PBIO): integer;
+ function BioRead(b: PBIO; var Buf: AnsiString; Len: integer): integer;
+ function BioWrite(b: PBIO; Buf: AnsiString; Len: integer): integer;
+ function d2iPKCS12bio(b:PBIO; Pkcs12: SslPtr): SslPtr;
+ function PKCS12parse(p12: SslPtr; pass: Ansistring; var pkey, cert, ca: SslPtr): integer;
+ procedure PKCS12free(p12: SslPtr);
+ function RsaGenerateKey(bits, e: integer; callback: PFunction; cb_arg: SslPtr): PRSA;
+ function Asn1UtctimeNew: PASN1_UTCTIME;
+ procedure Asn1UtctimeFree(a: PASN1_UTCTIME);
+ function Asn1IntegerSet(a: PASN1_INTEGER; v: integer): integer;
+ function Asn1IntegerGet(a: PASN1_INTEGER): integer; {pf}
+ function i2dX509bio(b: PBIO; x: PX509): integer;
+ function d2iX509bio(b:PBIO; x:PX509): PX509; {pf}
+ function PEMReadBioX509(b:PBIO; {var x:PX509;}x:PSslPtr; callback:PFunction; cb_arg: SslPtr): PX509; {pf}
+ procedure SkX509PopFree(st: PSTACK; func: TSkPopFreeFunc); {pf}
+
+
+ function i2dPrivateKeyBio(b: PBIO; pkey: EVP_PKEY): integer;
+
+ // 3DES functions
+ procedure DESsetoddparity(Key: des_cblock);
+ function DESsetkeychecked(key: des_cblock; schedule: des_key_schedule): Integer;
+ procedure DESecbencrypt(Input: des_cblock; output: des_cblock; ks: des_key_schedule; enc: Integer);
+
+{$ENDIF}
+
+function IsSSLloaded: Boolean;
+function InitSSLInterface: Boolean;
+function DestroySSLInterface: Boolean;
+
+var
+ _X509Free: TX509Free = nil; {pf}
+
+implementation
+
+uses SyncObjs;
+
+{$IFNDEF CIL}
+type
+// libssl.dll
+ TSslGetError = function(s: PSSL; ret_code: Integer):Integer; cdecl;
+ TSslLibraryInit = function:Integer; cdecl;
+ TSslLoadErrorStrings = procedure; cdecl;
+ TSslCtxSetCipherList = function(arg0: PSSL_CTX; str: PAnsiChar):Integer; cdecl;
+ TSslCtxNew = function(meth: PSSL_METHOD):PSSL_CTX; cdecl;
+ TSslCtxFree = procedure(arg0: PSSL_CTX); cdecl;
+ TSslSetFd = function(s: PSSL; fd: Integer):Integer; cdecl;
+ TSslMethodV2 = function:PSSL_METHOD; cdecl;
+ TSslMethodV3 = function:PSSL_METHOD; cdecl;
+ TSslMethodTLSV1 = function:PSSL_METHOD; cdecl;
+ TSslMethodV23 = function:PSSL_METHOD; cdecl;
+ TSslCtxUsePrivateKey = function(ctx: PSSL_CTX; pkey: sslptr):Integer; cdecl;
+ TSslCtxUsePrivateKeyASN1 = function(pk: integer; ctx: PSSL_CTX; d: sslptr; len: integer):Integer; cdecl;
+ TSslCtxUsePrivateKeyFile = function(ctx: PSSL_CTX; const _file: PAnsiChar; _type: Integer):Integer; cdecl;
+ TSslCtxUseCertificate = function(ctx: PSSL_CTX; x: SslPtr):Integer; cdecl;
+ TSslCtxUseCertificateASN1 = function(ctx: PSSL_CTX; len: Integer; d: SslPtr):Integer; cdecl;
+ TSslCtxUseCertificateFile = function(ctx: PSSL_CTX; const _file: PAnsiChar; _type: Integer):Integer; cdecl;
+ TSslCtxUseCertificateChainFile = function(ctx: PSSL_CTX; const _file: PAnsiChar):Integer; cdecl;
+ TSslCtxCheckPrivateKeyFile = function(ctx: PSSL_CTX):Integer; cdecl;
+ TSslCtxSetDefaultPasswdCb = procedure(ctx: PSSL_CTX; cb: SslPtr); cdecl;
+ TSslCtxSetDefaultPasswdCbUserdata = procedure(ctx: PSSL_CTX; u: SslPtr); cdecl;
+ TSslCtxLoadVerifyLocations = function(ctx: PSSL_CTX; const CAfile: PAnsiChar; const CApath: PAnsiChar):Integer; cdecl;
+ TSslCtxCtrl = function(ctx: PSSL_CTX; cmd: integer; larg: integer; parg: SslPtr): integer; cdecl;
+ TSslNew = function(ctx: PSSL_CTX):PSSL; cdecl;
+ TSslFree = procedure(ssl: PSSL); cdecl;
+ TSslAccept = function(ssl: PSSL):Integer; cdecl;
+ TSslConnect = function(ssl: PSSL):Integer; cdecl;
+ TSslShutdown = function(ssl: PSSL):Integer; cdecl;
+ TSslRead = function(ssl: PSSL; buf: PAnsiChar; num: Integer):Integer; cdecl;
+ TSslPeek = function(ssl: PSSL; buf: PAnsiChar; num: Integer):Integer; cdecl;
+ TSslWrite = function(ssl: PSSL; const buf: PAnsiChar; num: Integer):Integer; cdecl;
+ TSslPending = function(ssl: PSSL):Integer; cdecl;
+ TSslGetVersion = function(ssl: PSSL):PAnsiChar; cdecl;
+ TSslGetPeerCertificate = function(ssl: PSSL):PX509; cdecl;
+ TSslCtxSetVerify = procedure(ctx: PSSL_CTX; mode: Integer; arg2: SslPtr); cdecl;
+ TSSLGetCurrentCipher = function(s: PSSL):SslPtr; cdecl;
+ TSSLCipherGetName = function(c: Sslptr):PAnsiChar; cdecl;
+ TSSLCipherGetBits = function(c: SslPtr; alg_bits: PInteger):Integer; cdecl;
+ TSSLGetVerifyResult = function(ssl: PSSL):Integer; cdecl;
+ TSSLCtrl = function(ssl: PSSL; cmd: integer; larg: integer; parg: SslPtr):Integer; cdecl;
+
+ TSSLSetTlsextHostName = function(ssl: PSSL; buf: PAnsiChar):Integer; cdecl;
+
+// libeay.dll
+ TX509New = function: PX509; cdecl;
+ TX509NameOneline = function(a: PX509_NAME; buf: PAnsiChar; size: Integer):PAnsiChar; cdecl;
+ TX509GetSubjectName = function(a: PX509):PX509_NAME; cdecl;
+ TX509GetIssuerName = function(a: PX509):PX509_NAME; cdecl;
+ TX509NameHash = function(x: PX509_NAME):Cardinal; cdecl;
+ TX509Digest = function(data: PX509; _type: PEVP_MD; md: PAnsiChar; len: PInteger):Integer; cdecl;
+ TX509print = function(b: PBIO; a: PX509): integer; cdecl;
+ TX509SetVersion = function(x: PX509; version: integer): integer; cdecl;
+ TX509SetPubkey = function(x: PX509; pkey: EVP_PKEY): integer; cdecl;
+ TX509SetIssuerName = function(x: PX509; name: PX509_NAME): integer; cdecl;
+ TX509NameAddEntryByTxt = function(name: PX509_NAME; field: PAnsiChar; _type: integer;
+ bytes: PAnsiChar; len, loc, _set: integer): integer; cdecl;
+ TX509Sign = function(x: PX509; pkey: EVP_PKEY; const md: PEVP_MD): integer; cdecl;
+ TX509GmtimeAdj = function(s: PASN1_UTCTIME; adj: integer): PASN1_UTCTIME; cdecl;
+ TX509SetNotBefore = function(x: PX509; tm: PASN1_UTCTIME): integer; cdecl;
+ TX509SetNotAfter = function(x: PX509; tm: PASN1_UTCTIME): integer; cdecl;
+ TX509GetSerialNumber = function(x: PX509): PASN1_INTEGER; cdecl;
+ TEvpPkeyNew = function: EVP_PKEY; cdecl;
+ TEvpPkeyFree = procedure(pk: EVP_PKEY); cdecl;
+ TEvpPkeyAssign = function(pkey: EVP_PKEY; _type: integer; key: Prsa): integer; cdecl;
+ TEvpGetDigestByName = function(Name: PAnsiChar): PEVP_MD; cdecl;
+ TEVPcleanup = procedure; cdecl;
+ TSSLeayversion = function(t: integer): PAnsiChar; cdecl;
+ TErrErrorString = procedure(e: integer; buf: PAnsiChar; len: integer); cdecl;
+ TErrGetError = function: integer; cdecl;
+ TErrClearError = procedure; cdecl;
+ TErrFreeStrings = procedure; cdecl;
+ TErrRemoveState = procedure(pid: integer); cdecl;
+ TOPENSSLaddallalgorithms = procedure; cdecl;
+ TCRYPTOcleanupAllExData = procedure; cdecl;
+ TRandScreen = procedure; cdecl;
+ TBioNew = function(b: PBIO_METHOD): PBIO; cdecl;
+ TBioFreeAll = procedure(b: PBIO); cdecl;
+ TBioSMem = function: PBIO_METHOD; cdecl;
+ TBioCtrlPending = function(b: PBIO): integer; cdecl;
+ TBioRead = function(b: PBIO; Buf: PAnsiChar; Len: integer): integer; cdecl;
+ TBioWrite = function(b: PBIO; Buf: PAnsiChar; Len: integer): integer; cdecl;
+ Td2iPKCS12bio = function(b:PBIO; Pkcs12: SslPtr): SslPtr; cdecl;
+ TPKCS12parse = function(p12: SslPtr; pass: PAnsiChar; var pkey, cert, ca: SslPtr): integer; cdecl;
+ TPKCS12free = procedure(p12: SslPtr); cdecl;
+ TRsaGenerateKey = function(bits, e: integer; callback: PFunction; cb_arg: SslPtr): PRSA; cdecl;
+ TAsn1UtctimeNew = function: PASN1_UTCTIME; cdecl;
+ TAsn1UtctimeFree = procedure(a: PASN1_UTCTIME); cdecl;
+ TAsn1IntegerSet = function(a: PASN1_INTEGER; v: integer): integer; cdecl;
+ TAsn1IntegerGet = function(a: PASN1_INTEGER): integer; cdecl; {pf}
+ Ti2dX509bio = function(b: PBIO; x: PX509): integer; cdecl;
+ Td2iX509bio = function(b:PBIO; x:PX509): PX509; cdecl; {pf}
+ TPEMReadBioX509 = function(b:PBIO; {var x:PX509;}x:PSslPtr; callback:PFunction; cb_arg:SslPtr): PX509; cdecl; {pf}
+ TSkX509PopFree = procedure(st: PSTACK; func: TSkPopFreeFunc); cdecl; {pf}
+ Ti2dPrivateKeyBio= function(b: PBIO; pkey: EVP_PKEY): integer; cdecl;
+
+ // 3DES functions
+ TDESsetoddparity = procedure(Key: des_cblock); cdecl;
+ TDESsetkeychecked = function(key: des_cblock; schedule: des_key_schedule): Integer; cdecl;
+ TDESecbencrypt = procedure(Input: des_cblock; output: des_cblock; ks: des_key_schedule; enc: Integer); cdecl;
+ //thread lock functions
+ TCRYPTOnumlocks = function: integer; cdecl;
+ TCRYPTOSetLockingCallback = procedure(cb: Sslptr); cdecl;
+
+var
+// libssl.dll
+ _SslGetError: TSslGetError = nil;
+ _SslLibraryInit: TSslLibraryInit = nil;
+ _SslLoadErrorStrings: TSslLoadErrorStrings = nil;
+ _SslCtxSetCipherList: TSslCtxSetCipherList = nil;
+ _SslCtxNew: TSslCtxNew = nil;
+ _SslCtxFree: TSslCtxFree = nil;
+ _SslSetFd: TSslSetFd = nil;
+ _SslMethodV2: TSslMethodV2 = nil;
+ _SslMethodV3: TSslMethodV3 = nil;
+ _SslMethodTLSV1: TSslMethodTLSV1 = nil;
+ _SslMethodV23: TSslMethodV23 = nil;
+ _SslCtxUsePrivateKey: TSslCtxUsePrivateKey = nil;
+ _SslCtxUsePrivateKeyASN1: TSslCtxUsePrivateKeyASN1 = nil;
+ _SslCtxUsePrivateKeyFile: TSslCtxUsePrivateKeyFile = nil;
+ _SslCtxUseCertificate: TSslCtxUseCertificate = nil;
+ _SslCtxUseCertificateASN1: TSslCtxUseCertificateASN1 = nil;
+ _SslCtxUseCertificateFile: TSslCtxUseCertificateFile = nil;
+ _SslCtxUseCertificateChainFile: TSslCtxUseCertificateChainFile = nil;
+ _SslCtxCheckPrivateKeyFile: TSslCtxCheckPrivateKeyFile = nil;
+ _SslCtxSetDefaultPasswdCb: TSslCtxSetDefaultPasswdCb = nil;
+ _SslCtxSetDefaultPasswdCbUserdata: TSslCtxSetDefaultPasswdCbUserdata = nil;
+ _SslCtxLoadVerifyLocations: TSslCtxLoadVerifyLocations = nil;
+ _SslCtxCtrl: TSslCtxCtrl = nil;
+ _SslNew: TSslNew = nil;
+ _SslFree: TSslFree = nil;
+ _SslAccept: TSslAccept = nil;
+ _SslConnect: TSslConnect = nil;
+ _SslShutdown: TSslShutdown = nil;
+ _SslRead: TSslRead = nil;
+ _SslPeek: TSslPeek = nil;
+ _SslWrite: TSslWrite = nil;
+ _SslPending: TSslPending = nil;
+ _SslGetVersion: TSslGetVersion = nil;
+ _SslGetPeerCertificate: TSslGetPeerCertificate = nil;
+ _SslCtxSetVerify: TSslCtxSetVerify = nil;
+ _SSLGetCurrentCipher: TSSLGetCurrentCipher = nil;
+ _SSLCipherGetName: TSSLCipherGetName = nil;
+ _SSLCipherGetBits: TSSLCipherGetBits = nil;
+ _SSLGetVerifyResult: TSSLGetVerifyResult = nil;
+ _SSLCtrl: TSSLCtrl = nil;
+
+// libeay.dll
+ _X509New: TX509New = nil;
+ _X509NameOneline: TX509NameOneline = nil;
+ _X509GetSubjectName: TX509GetSubjectName = nil;
+ _X509GetIssuerName: TX509GetIssuerName = nil;
+ _X509NameHash: TX509NameHash = nil;
+ _X509Digest: TX509Digest = nil;
+ _X509print: TX509print = nil;
+ _X509SetVersion: TX509SetVersion = nil;
+ _X509SetPubkey: TX509SetPubkey = nil;
+ _X509SetIssuerName: TX509SetIssuerName = nil;
+ _X509NameAddEntryByTxt: TX509NameAddEntryByTxt = nil;
+ _X509Sign: TX509Sign = nil;
+ _X509GmtimeAdj: TX509GmtimeAdj = nil;
+ _X509SetNotBefore: TX509SetNotBefore = nil;
+ _X509SetNotAfter: TX509SetNotAfter = nil;
+ _X509GetSerialNumber: TX509GetSerialNumber = nil;
+ _EvpPkeyNew: TEvpPkeyNew = nil;
+ _EvpPkeyFree: TEvpPkeyFree = nil;
+ _EvpPkeyAssign: TEvpPkeyAssign = nil;
+ _EvpGetDigestByName: TEvpGetDigestByName = nil;
+ _EVPcleanup: TEVPcleanup = nil;
+ _SSLeayversion: TSSLeayversion = nil;
+ _ErrErrorString: TErrErrorString = nil;
+ _ErrGetError: TErrGetError = nil;
+ _ErrClearError: TErrClearError = nil;
+ _ErrFreeStrings: TErrFreeStrings = nil;
+ _ErrRemoveState: TErrRemoveState = nil;
+ _OPENSSLaddallalgorithms: TOPENSSLaddallalgorithms = nil;
+ _CRYPTOcleanupAllExData: TCRYPTOcleanupAllExData = nil;
+ _RandScreen: TRandScreen = nil;
+ _BioNew: TBioNew = nil;
+ _BioFreeAll: TBioFreeAll = nil;
+ _BioSMem: TBioSMem = nil;
+ _BioCtrlPending: TBioCtrlPending = nil;
+ _BioRead: TBioRead = nil;
+ _BioWrite: TBioWrite = nil;
+ _d2iPKCS12bio: Td2iPKCS12bio = nil;
+ _PKCS12parse: TPKCS12parse = nil;
+ _PKCS12free: TPKCS12free = nil;
+ _RsaGenerateKey: TRsaGenerateKey = nil;
+ _Asn1UtctimeNew: TAsn1UtctimeNew = nil;
+ _Asn1UtctimeFree: TAsn1UtctimeFree = nil;
+ _Asn1IntegerSet: TAsn1IntegerSet = nil;
+ _Asn1IntegerGet: TAsn1IntegerGet = nil; {pf}
+ _i2dX509bio: Ti2dX509bio = nil;
+ _d2iX509bio: Td2iX509bio = nil; {pf}
+ _PEMReadBioX509: TPEMReadBioX509 = nil; {pf}
+ _SkX509PopFree: TSkX509PopFree = nil; {pf}
+ _i2dPrivateKeyBio: Ti2dPrivateKeyBio = nil;
+
+ // 3DES functions
+ _DESsetoddparity: TDESsetoddparity = nil;
+ _DESsetkeychecked: TDESsetkeychecked = nil;
+ _DESecbencrypt: TDESecbencrypt = nil;
+ //thread lock functions
+ _CRYPTOnumlocks: TCRYPTOnumlocks = nil;
+ _CRYPTOSetLockingCallback: TCRYPTOSetLockingCallback = nil;
+{$ENDIF}
+
+var
+ SSLCS: TCriticalSection;
+ SSLloaded: boolean = false;
+{$IFNDEF CIL}
+ Locks: TList;
+{$ENDIF}
+
+{$IFNDEF CIL}
+// libssl.dll
+function SslGetError(s: PSSL; ret_code: Integer):Integer;
+begin
+ if InitSSLInterface and Assigned(_SslGetError) then
+ Result := _SslGetError(s, ret_code)
+ else
+ Result := SSL_ERROR_SSL;
+end;
+
+function SslLibraryInit:Integer;
+begin
+ if InitSSLInterface and Assigned(_SslLibraryInit) then
+ Result := _SslLibraryInit
+ else
+ Result := 1;
+end;
+
+procedure SslLoadErrorStrings;
+begin
+ if InitSSLInterface and Assigned(_SslLoadErrorStrings) then
+ _SslLoadErrorStrings;
+end;
+
+//function SslCtxSetCipherList(arg0: PSSL_CTX; str: PChar):Integer;
+function SslCtxSetCipherList(arg0: PSSL_CTX; var str: AnsiString):Integer;
+begin
+ if InitSSLInterface and Assigned(_SslCtxSetCipherList) then
+ Result := _SslCtxSetCipherList(arg0, PAnsiChar(str))
+ else
+ Result := 0;
+end;
+
+function SslCtxNew(meth: PSSL_METHOD):PSSL_CTX;
+begin
+ if InitSSLInterface and Assigned(_SslCtxNew) then
+ Result := _SslCtxNew(meth)
+ else
+ Result := nil;
+end;
+
+procedure SslCtxFree(arg0: PSSL_CTX);
+begin
+ if InitSSLInterface and Assigned(_SslCtxFree) then
+ _SslCtxFree(arg0);
+end;
+
+function SslSetFd(s: PSSL; fd: Integer):Integer;
+begin
+ if InitSSLInterface and Assigned(_SslSetFd) then
+ Result := _SslSetFd(s, fd)
+ else
+ Result := 0;
+end;
+
+function SslMethodV2:PSSL_METHOD;
+begin
+ if InitSSLInterface and Assigned(_SslMethodV2) then
+ Result := _SslMethodV2
+ else
+ Result := nil;
+end;
+
+function SslMethodV3:PSSL_METHOD;
+begin
+ if InitSSLInterface and Assigned(_SslMethodV3) then
+ Result := _SslMethodV3
+ else
+ Result := nil;
+end;
+
+function SslMethodTLSV1:PSSL_METHOD;
+begin
+ if InitSSLInterface and Assigned(_SslMethodTLSV1) then
+ Result := _SslMethodTLSV1
+ else
+ Result := nil;
+end;
+
+function SslMethodV23:PSSL_METHOD;
+begin
+ if InitSSLInterface and Assigned(_SslMethodV23) then
+ Result := _SslMethodV23
+ else
+ Result := nil;
+end;
+
+function SslCtxUsePrivateKey(ctx: PSSL_CTX; pkey: SslPtr):Integer;
+begin
+ if InitSSLInterface and Assigned(_SslCtxUsePrivateKey) then
+ Result := _SslCtxUsePrivateKey(ctx, pkey)
+ else
+ Result := 0;
+end;
+
+function SslCtxUsePrivateKeyASN1(pk: integer; ctx: PSSL_CTX; d: AnsiString; len: integer):Integer;
+begin
+ if InitSSLInterface and Assigned(_SslCtxUsePrivateKeyASN1) then
+ Result := _SslCtxUsePrivateKeyASN1(pk, ctx, Sslptr(d), len)
+ else
+ Result := 0;
+end;
+
+//function SslCtxUsePrivateKeyFile(ctx: PSSL_CTX; const _file: PChar; _type: Integer):Integer;
+function SslCtxUsePrivateKeyFile(ctx: PSSL_CTX; const _file: AnsiString; _type: Integer):Integer;
+begin
+ if InitSSLInterface and Assigned(_SslCtxUsePrivateKeyFile) then
+ Result := _SslCtxUsePrivateKeyFile(ctx, PAnsiChar(_file), _type)
+ else
+ Result := 0;
+end;
+
+function SslCtxUseCertificate(ctx: PSSL_CTX; x: SslPtr):Integer;
+begin
+ if InitSSLInterface and Assigned(_SslCtxUseCertificate) then
+ Result := _SslCtxUseCertificate(ctx, x)
+ else
+ Result := 0;
+end;
+
+function SslCtxUseCertificateASN1(ctx: PSSL_CTX; len: integer; d: AnsiString):Integer;
+begin
+ if InitSSLInterface and Assigned(_SslCtxUseCertificateASN1) then
+ Result := _SslCtxUseCertificateASN1(ctx, len, SslPtr(d))
+ else
+ Result := 0;
+end;
+
+function SslCtxUseCertificateFile(ctx: PSSL_CTX; const _file: AnsiString; _type: Integer):Integer;
+begin
+ if InitSSLInterface and Assigned(_SslCtxUseCertificateFile) then
+ Result := _SslCtxUseCertificateFile(ctx, PAnsiChar(_file), _type)
+ else
+ Result := 0;
+end;
+
+//function SslCtxUseCertificateChainFile(ctx: PSSL_CTX; const _file: PChar):Integer;
+function SslCtxUseCertificateChainFile(ctx: PSSL_CTX; const _file: AnsiString):Integer;
+begin
+ if InitSSLInterface and Assigned(_SslCtxUseCertificateChainFile) then
+ Result := _SslCtxUseCertificateChainFile(ctx, PAnsiChar(_file))
+ else
+ Result := 0;
+end;
+
+function SslCtxCheckPrivateKeyFile(ctx: PSSL_CTX):Integer;
+begin
+ if InitSSLInterface and Assigned(_SslCtxCheckPrivateKeyFile) then
+ Result := _SslCtxCheckPrivateKeyFile(ctx)
+ else
+ Result := 0;
+end;
+
+procedure SslCtxSetDefaultPasswdCb(ctx: PSSL_CTX; cb: PPasswdCb);
+begin
+ if InitSSLInterface and Assigned(_SslCtxSetDefaultPasswdCb) then
+ _SslCtxSetDefaultPasswdCb(ctx, cb);
+end;
+
+procedure SslCtxSetDefaultPasswdCbUserdata(ctx: PSSL_CTX; u: SslPtr);
+begin
+ if InitSSLInterface and Assigned(_SslCtxSetDefaultPasswdCbUserdata) then
+ _SslCtxSetDefaultPasswdCbUserdata(ctx, u);
+end;
+
+//function SslCtxLoadVerifyLocations(ctx: PSSL_CTX; const CAfile: PChar; const CApath: PChar):Integer;
+function SslCtxLoadVerifyLocations(ctx: PSSL_CTX; const CAfile: AnsiString; const CApath: AnsiString):Integer;
+begin
+ if InitSSLInterface and Assigned(_SslCtxLoadVerifyLocations) then
+ Result := _SslCtxLoadVerifyLocations(ctx, SslPtr(CAfile), SslPtr(CApath))
+ else
+ Result := 0;
+end;
+
+function SslCtxCtrl(ctx: PSSL_CTX; cmd: integer; larg: integer; parg: SslPtr): integer;
+begin
+ if InitSSLInterface and Assigned(_SslCtxCtrl) then
+ Result := _SslCtxCtrl(ctx, cmd, larg, parg)
+ else
+ Result := 0;
+end;
+
+function SslNew(ctx: PSSL_CTX):PSSL;
+begin
+ if InitSSLInterface and Assigned(_SslNew) then
+ Result := _SslNew(ctx)
+ else
+ Result := nil;
+end;
+
+procedure SslFree(ssl: PSSL);
+begin
+ if InitSSLInterface and Assigned(_SslFree) then
+ _SslFree(ssl);
+end;
+
+function SslAccept(ssl: PSSL):Integer;
+begin
+ if InitSSLInterface and Assigned(_SslAccept) then
+ Result := _SslAccept(ssl)
+ else
+ Result := -1;
+end;
+
+function SslConnect(ssl: PSSL):Integer;
+begin
+ if InitSSLInterface and Assigned(_SslConnect) then
+ Result := _SslConnect(ssl)
+ else
+ Result := -1;
+end;
+
+function SslShutdown(ssl: PSSL):Integer;
+begin
+ if InitSSLInterface and Assigned(_SslShutdown) then
+ Result := _SslShutdown(ssl)
+ else
+ Result := -1;
+end;
+
+//function SslRead(ssl: PSSL; buf: PChar; num: Integer):Integer;
+function SslRead(ssl: PSSL; buf: SslPtr; num: Integer):Integer;
+begin
+ if InitSSLInterface and Assigned(_SslRead) then
+ Result := _SslRead(ssl, PAnsiChar(buf), num)
+ else
+ Result := -1;
+end;
+
+//function SslPeek(ssl: PSSL; buf: PChar; num: Integer):Integer;
+function SslPeek(ssl: PSSL; buf: SslPtr; num: Integer):Integer;
+begin
+ if InitSSLInterface and Assigned(_SslPeek) then
+ Result := _SslPeek(ssl, PAnsiChar(buf), num)
+ else
+ Result := -1;
+end;
+
+//function SslWrite(ssl: PSSL; const buf: PChar; num: Integer):Integer;
+function SslWrite(ssl: PSSL; buf: SslPtr; num: Integer):Integer;
+begin
+ if InitSSLInterface and Assigned(_SslWrite) then
+ Result := _SslWrite(ssl, PAnsiChar(buf), num)
+ else
+ Result := -1;
+end;
+
+function SslPending(ssl: PSSL):Integer;
+begin
+ if InitSSLInterface and Assigned(_SslPending) then
+ Result := _SslPending(ssl)
+ else
+ Result := 0;
+end;
+
+//function SslGetVersion(ssl: PSSL):PChar;
+function SslGetVersion(ssl: PSSL):AnsiString;
+begin
+ if InitSSLInterface and Assigned(_SslGetVersion) then
+ Result := _SslGetVersion(ssl)
+ else
+ Result := '';
+end;
+
+function SslGetPeerCertificate(ssl: PSSL):PX509;
+begin
+ if InitSSLInterface and Assigned(_SslGetPeerCertificate) then
+ Result := _SslGetPeerCertificate(ssl)
+ else
+ Result := nil;
+end;
+
+//procedure SslCtxSetVerify(ctx: PSSL_CTX; mode: Integer; arg2: SslPtr);
+procedure SslCtxSetVerify(ctx: PSSL_CTX; mode: Integer; arg2: PFunction);
+begin
+ if InitSSLInterface and Assigned(_SslCtxSetVerify) then
+ _SslCtxSetVerify(ctx, mode, @arg2);
+end;
+
+function SSLGetCurrentCipher(s: PSSL):SslPtr;
+begin
+ if InitSSLInterface and Assigned(_SSLGetCurrentCipher) then
+{$IFDEF CIL}
+{$ELSE}
+ Result := _SSLGetCurrentCipher(s)
+{$ENDIF}
+ else
+ Result := nil;
+end;
+
+//function SSLCipherGetName(c: SslPtr):PChar;
+function SSLCipherGetName(c: SslPtr):AnsiString;
+begin
+ if InitSSLInterface and Assigned(_SSLCipherGetName) then
+ Result := _SSLCipherGetName(c)
+ else
+ Result := '';
+end;
+
+//function SSLCipherGetBits(c: SslPtr; alg_bits: PInteger):Integer;
+function SSLCipherGetBits(c: SslPtr; var alg_bits: Integer):Integer;
+begin
+ if InitSSLInterface and Assigned(_SSLCipherGetBits) then
+ Result := _SSLCipherGetBits(c, @alg_bits)
+ else
+ Result := 0;
+end;
+
+function SSLGetVerifyResult(ssl: PSSL):Integer;
+begin
+ if InitSSLInterface and Assigned(_SSLGetVerifyResult) then
+ Result := _SSLGetVerifyResult(ssl)
+ else
+ Result := X509_V_ERR_APPLICATION_VERIFICATION;
+end;
+
+
+function SSLCtrl(ssl: PSSL; cmd: integer; larg: integer; parg: SslPtr):Integer;
+begin
+ if InitSSLInterface and Assigned(_SSLCtrl) then
+ Result := _SSLCtrl(ssl, cmd, larg, parg)
+ else
+ Result := X509_V_ERR_APPLICATION_VERIFICATION;
+end;
+
+// libeay.dll
+function X509New: PX509;
+begin
+ if InitSSLInterface and Assigned(_X509New) then
+ Result := _X509New
+ else
+ Result := nil;
+end;
+
+procedure X509Free(x: PX509);
+begin
+ if InitSSLInterface and Assigned(_X509Free) then
+ _X509Free(x);
+end;
+
+//function SslX509NameOneline(a: PX509_NAME; buf: PChar; size: Integer):PChar;
+function X509NameOneline(a: PX509_NAME; var buf: AnsiString; size: Integer):AnsiString;
+begin
+ if InitSSLInterface and Assigned(_X509NameOneline) then
+ Result := _X509NameOneline(a, PAnsiChar(buf),size)
+ else
+ Result := '';
+end;
+
+function X509GetSubjectName(a: PX509):PX509_NAME;
+begin
+ if InitSSLInterface and Assigned(_X509GetSubjectName) then
+ Result := _X509GetSubjectName(a)
+ else
+ Result := nil;
+end;
+
+function X509GetIssuerName(a: PX509):PX509_NAME;
+begin
+ if InitSSLInterface and Assigned(_X509GetIssuerName) then
+ Result := _X509GetIssuerName(a)
+ else
+ Result := nil;
+end;
+
+function X509NameHash(x: PX509_NAME):Cardinal;
+begin
+ if InitSSLInterface and Assigned(_X509NameHash) then
+ Result := _X509NameHash(x)
+ else
+ Result := 0;
+end;
+
+//function SslX509Digest(data: PX509; _type: PEVP_MD; md: PChar; len: PInteger):Integer;
+function X509Digest(data: PX509; _type: PEVP_MD; md: AnsiString; var len: Integer):Integer;
+begin
+ if InitSSLInterface and Assigned(_X509Digest) then
+ Result := _X509Digest(data, _type, PAnsiChar(md), @len)
+ else
+ Result := 0;
+end;
+
+function EvpPkeyNew: EVP_PKEY;
+begin
+ if InitSSLInterface and Assigned(_EvpPkeyNew) then
+ Result := _EvpPkeyNew
+ else
+ Result := nil;
+end;
+
+procedure EvpPkeyFree(pk: EVP_PKEY);
+begin
+ if InitSSLInterface and Assigned(_EvpPkeyFree) then
+ _EvpPkeyFree(pk);
+end;
+
+function SSLeayversion(t: integer): Ansistring;
+begin
+ if InitSSLInterface and Assigned(_SSLeayversion) then
+ Result := PAnsiChar(_SSLeayversion(t))
+ else
+ Result := '';
+end;
+
+procedure ErrErrorString(e: integer; var buf: Ansistring; len: integer);
+begin
+ if InitSSLInterface and Assigned(_ErrErrorString) then
+ _ErrErrorString(e, Pointer(buf), len);
+ buf := PAnsiChar(Buf);
+end;
+
+function ErrGetError: integer;
+begin
+ if InitSSLInterface and Assigned(_ErrGetError) then
+ Result := _ErrGetError
+ else
+ Result := SSL_ERROR_SSL;
+end;
+
+procedure ErrClearError;
+begin
+ if InitSSLInterface and Assigned(_ErrClearError) then
+ _ErrClearError;
+end;
+
+procedure ErrFreeStrings;
+begin
+ if InitSSLInterface and Assigned(_ErrFreeStrings) then
+ _ErrFreeStrings;
+end;
+
+procedure ErrRemoveState(pid: integer);
+begin
+ if InitSSLInterface and Assigned(_ErrRemoveState) then
+ _ErrRemoveState(pid);
+end;
+
+procedure OPENSSLaddallalgorithms;
+begin
+ if InitSSLInterface and Assigned(_OPENSSLaddallalgorithms) then
+ _OPENSSLaddallalgorithms;
+end;
+
+procedure EVPcleanup;
+begin
+ if InitSSLInterface and Assigned(_EVPcleanup) then
+ _EVPcleanup;
+end;
+
+procedure CRYPTOcleanupAllExData;
+begin
+ if InitSSLInterface and Assigned(_CRYPTOcleanupAllExData) then
+ _CRYPTOcleanupAllExData;
+end;
+
+procedure RandScreen;
+begin
+ if InitSSLInterface and Assigned(_RandScreen) then
+ _RandScreen;
+end;
+
+function BioNew(b: PBIO_METHOD): PBIO;
+begin
+ if InitSSLInterface and Assigned(_BioNew) then
+ Result := _BioNew(b)
+ else
+ Result := nil;
+end;
+
+procedure BioFreeAll(b: PBIO);
+begin
+ if InitSSLInterface and Assigned(_BioFreeAll) then
+ _BioFreeAll(b);
+end;
+
+function BioSMem: PBIO_METHOD;
+begin
+ if InitSSLInterface and Assigned(_BioSMem) then
+ Result := _BioSMem
+ else
+ Result := nil;
+end;
+
+function BioCtrlPending(b: PBIO): integer;
+begin
+ if InitSSLInterface and Assigned(_BioCtrlPending) then
+ Result := _BioCtrlPending(b)
+ else
+ Result := 0;
+end;
+
+//function BioRead(b: PBIO; Buf: PChar; Len: integer): integer;
+function BioRead(b: PBIO; var Buf: AnsiString; Len: integer): integer;
+begin
+ if InitSSLInterface and Assigned(_BioRead) then
+ Result := _BioRead(b, PAnsiChar(Buf), Len)
+ else
+ Result := -2;
+end;
+
+//function BioWrite(b: PBIO; Buf: PChar; Len: integer): integer;
+function BioWrite(b: PBIO; Buf: AnsiString; Len: integer): integer;
+begin
+ if InitSSLInterface and Assigned(_BioWrite) then
+ Result := _BioWrite(b, PAnsiChar(Buf), Len)
+ else
+ Result := -2;
+end;
+
+function X509print(b: PBIO; a: PX509): integer;
+begin
+ if InitSSLInterface and Assigned(_X509print) then
+ Result := _X509print(b, a)
+ else
+ Result := 0;
+end;
+
+function d2iPKCS12bio(b:PBIO; Pkcs12: SslPtr): SslPtr;
+begin
+ if InitSSLInterface and Assigned(_d2iPKCS12bio) then
+ Result := _d2iPKCS12bio(b, Pkcs12)
+ else
+ Result := nil;
+end;
+
+function PKCS12parse(p12: SslPtr; pass: Ansistring; var pkey, cert, ca: SslPtr): integer;
+begin
+ if InitSSLInterface and Assigned(_PKCS12parse) then
+ Result := _PKCS12parse(p12, SslPtr(pass), pkey, cert, ca)
+ else
+ Result := 0;
+end;
+
+procedure PKCS12free(p12: SslPtr);
+begin
+ if InitSSLInterface and Assigned(_PKCS12free) then
+ _PKCS12free(p12);
+end;
+
+function RsaGenerateKey(bits, e: integer; callback: PFunction; cb_arg: SslPtr): PRSA;
+begin
+ if InitSSLInterface and Assigned(_RsaGenerateKey) then
+ Result := _RsaGenerateKey(bits, e, callback, cb_arg)
+ else
+ Result := nil;
+end;
+
+function EvpPkeyAssign(pkey: EVP_PKEY; _type: integer; key: Prsa): integer;
+begin
+ if InitSSLInterface and Assigned(_EvpPkeyAssign) then
+ Result := _EvpPkeyAssign(pkey, _type, key)
+ else
+ Result := 0;
+end;
+
+function X509SetVersion(x: PX509; version: integer): integer;
+begin
+ if InitSSLInterface and Assigned(_X509SetVersion) then
+ Result := _X509SetVersion(x, version)
+ else
+ Result := 0;
+end;
+
+function X509SetPubkey(x: PX509; pkey: EVP_PKEY): integer;
+begin
+ if InitSSLInterface and Assigned(_X509SetPubkey) then
+ Result := _X509SetPubkey(x, pkey)
+ else
+ Result := 0;
+end;
+
+function X509SetIssuerName(x: PX509; name: PX509_NAME): integer;
+begin
+ if InitSSLInterface and Assigned(_X509SetIssuerName) then
+ Result := _X509SetIssuerName(x, name)
+ else
+ Result := 0;
+end;
+
+function X509NameAddEntryByTxt(name: PX509_NAME; field: Ansistring; _type: integer;
+ bytes: Ansistring; len, loc, _set: integer): integer;
+begin
+ if InitSSLInterface and Assigned(_X509NameAddEntryByTxt) then
+ Result := _X509NameAddEntryByTxt(name, PAnsiChar(field), _type, PAnsiChar(Bytes), len, loc, _set)
+ else
+ Result := 0;
+end;
+
+function X509Sign(x: PX509; pkey: EVP_PKEY; const md: PEVP_MD): integer;
+begin
+ if InitSSLInterface and Assigned(_X509Sign) then
+ Result := _X509Sign(x, pkey, md)
+ else
+ Result := 0;
+end;
+
+function Asn1UtctimeNew: PASN1_UTCTIME;
+begin
+ if InitSSLInterface and Assigned(_Asn1UtctimeNew) then
+ Result := _Asn1UtctimeNew
+ else
+ Result := nil;
+end;
+
+procedure Asn1UtctimeFree(a: PASN1_UTCTIME);
+begin
+ if InitSSLInterface and Assigned(_Asn1UtctimeFree) then
+ _Asn1UtctimeFree(a);
+end;
+
+function X509GmtimeAdj(s: PASN1_UTCTIME; adj: integer): PASN1_UTCTIME;
+begin
+ if InitSSLInterface and Assigned(_X509GmtimeAdj) then
+ Result := _X509GmtimeAdj(s, adj)
+ else
+ Result := nil;
+end;
+
+function X509SetNotBefore(x: PX509; tm: PASN1_UTCTIME): integer;
+begin
+ if InitSSLInterface and Assigned(_X509SetNotBefore) then
+ Result := _X509SetNotBefore(x, tm)
+ else
+ Result := 0;
+end;
+
+function X509SetNotAfter(x: PX509; tm: PASN1_UTCTIME): integer;
+begin
+ if InitSSLInterface and Assigned(_X509SetNotAfter) then
+ Result := _X509SetNotAfter(x, tm)
+ else
+ Result := 0;
+end;
+
+function i2dX509bio(b: PBIO; x: PX509): integer;
+begin
+ if InitSSLInterface and Assigned(_i2dX509bio) then
+ Result := _i2dX509bio(b, x)
+ else
+ Result := 0;
+end;
+
+function d2iX509bio(b: PBIO; x: PX509): PX509; {pf}
+begin
+ if InitSSLInterface and Assigned(_d2iX509bio) then
+ Result := _d2iX509bio(x,b)
+ else
+ Result := nil;
+end;
+
+function PEMReadBioX509(b:PBIO; {var x:PX509;}x:PSslPtr; callback:PFunction; cb_arg: SslPtr): PX509; {pf}
+begin
+ if InitSSLInterface and Assigned(_PEMReadBioX509) then
+ Result := _PEMReadBioX509(b,x,callback,cb_arg)
+ else
+ Result := nil;
+end;
+
+procedure SkX509PopFree(st: PSTACK; func:TSkPopFreeFunc); {pf}
+begin
+ if InitSSLInterface and Assigned(_SkX509PopFree) then
+ _SkX509PopFree(st,func);
+end;
+
+function i2dPrivateKeyBio(b: PBIO; pkey: EVP_PKEY): integer;
+begin
+ if InitSSLInterface and Assigned(_i2dPrivateKeyBio) then
+ Result := _i2dPrivateKeyBio(b, pkey)
+ else
+ Result := 0;
+end;
+
+function EvpGetDigestByName(Name: AnsiString): PEVP_MD;
+begin
+ if InitSSLInterface and Assigned(_EvpGetDigestByName) then
+ Result := _EvpGetDigestByName(PAnsiChar(Name))
+ else
+ Result := nil;
+end;
+
+function Asn1IntegerSet(a: PASN1_INTEGER; v: integer): integer;
+begin
+ if InitSSLInterface and Assigned(_Asn1IntegerSet) then
+ Result := _Asn1IntegerSet(a, v)
+ else
+ Result := 0;
+end;
+
+function Asn1IntegerGet(a: PASN1_INTEGER): integer; {pf}
+begin
+ if InitSSLInterface and Assigned(_Asn1IntegerGet) then
+ Result := _Asn1IntegerGet(a)
+ else
+ Result := 0;
+end;
+
+function X509GetSerialNumber(x: PX509): PASN1_INTEGER;
+begin
+ if InitSSLInterface and Assigned(_X509GetSerialNumber) then
+ Result := _X509GetSerialNumber(x)
+ else
+ Result := nil;
+end;
+
+// 3DES functions
+procedure DESsetoddparity(Key: des_cblock);
+begin
+ if InitSSLInterface and Assigned(_DESsetoddparity) then
+ _DESsetoddparity(Key);
+end;
+
+function DESsetkeychecked(key: des_cblock; schedule: des_key_schedule): Integer;
+begin
+ if InitSSLInterface and Assigned(_DESsetkeychecked) then
+ Result := _DESsetkeychecked(key, schedule)
+ else
+ Result := -1;
+end;
+
+procedure DESecbencrypt(Input: des_cblock; output: des_cblock; ks: des_key_schedule; enc: Integer);
+begin
+ if InitSSLInterface and Assigned(_DESecbencrypt) then
+ _DESecbencrypt(Input, output, ks, enc);
+end;
+
+procedure locking_callback(mode, ltype: integer; lfile: PChar; line: integer); cdecl;
+begin
+ if (mode and 1) > 0 then
+ TCriticalSection(Locks[ltype]).Enter
+ else
+ TCriticalSection(Locks[ltype]).Leave;
+end;
+
+procedure InitLocks;
+var
+ n: integer;
+ max: integer;
+begin
+ Locks := TList.Create;
+ max := _CRYPTOnumlocks;
+ for n := 1 to max do
+ Locks.Add(TCriticalSection.Create);
+ _CRYPTOsetlockingcallback(@locking_callback);
+end;
+
+procedure FreeLocks;
+var
+ n: integer;
+begin
+ _CRYPTOsetlockingcallback(nil);
+ for n := 0 to Locks.Count - 1 do
+ TCriticalSection(Locks[n]).Free;
+ Locks.Free;
+end;
+
+{$ENDIF}
+
+function LoadLib(const Value: String): HModule;
+begin
+{$IFDEF CIL}
+ Result := LoadLibrary(Value);
+{$ELSE}
+ Result := LoadLibrary(PChar(Value));
+{$ENDIF}
+end;
+
+function GetProcAddr(module: HModule; const ProcName: string): SslPtr;
+begin
+{$IFDEF CIL}
+ Result := GetProcAddress(module, ProcName);
+{$ELSE}
+ Result := GetProcAddress(module, PChar(ProcName));
+{$ENDIF}
+end;
+
+function InitSSLInterface: Boolean;
+var
+ s: string;
+ x: integer;
+begin
+ {pf}
+ if SSLLoaded then
+ begin
+ Result := TRUE;
+ exit;
+ end;
+ {/pf}
+ SSLCS.Enter;
+ try
+ if not IsSSLloaded then
+ begin
+{$IFDEF CIL}
+ SSLLibHandle := 1;
+ SSLUtilHandle := 1;
+{$ELSE}
+ SSLLibHandle := LoadLib(DLLSSLName);
+ SSLUtilHandle := LoadLib(DLLUtilName);
+ {$IFDEF MSWINDOWS}
+ if (SSLLibHandle = 0) then
+ SSLLibHandle := LoadLib(DLLSSLName2);
+ {$ENDIF}
+{$ENDIF}
+ if (SSLLibHandle <> 0) and (SSLUtilHandle <> 0) then
+ begin
+{$IFNDEF CIL}
+ _SslGetError := GetProcAddr(SSLLibHandle, 'SSL_get_error');
+ _SslLibraryInit := GetProcAddr(SSLLibHandle, 'SSL_library_init');
+ _SslLoadErrorStrings := GetProcAddr(SSLLibHandle, 'SSL_load_error_strings');
+ _SslCtxSetCipherList := GetProcAddr(SSLLibHandle, 'SSL_CTX_set_cipher_list');
+ _SslCtxNew := GetProcAddr(SSLLibHandle, 'SSL_CTX_new');
+ _SslCtxFree := GetProcAddr(SSLLibHandle, 'SSL_CTX_free');
+ _SslSetFd := GetProcAddr(SSLLibHandle, 'SSL_set_fd');
+ _SslMethodV2 := GetProcAddr(SSLLibHandle, 'SSLv2_method');
+ _SslMethodV3 := GetProcAddr(SSLLibHandle, 'SSLv3_method');
+ _SslMethodTLSV1 := GetProcAddr(SSLLibHandle, 'TLSv1_method');
+ _SslMethodV23 := GetProcAddr(SSLLibHandle, 'SSLv23_method');
+ _SslCtxUsePrivateKey := GetProcAddr(SSLLibHandle, 'SSL_CTX_use_PrivateKey');
+ _SslCtxUsePrivateKeyASN1 := GetProcAddr(SSLLibHandle, 'SSL_CTX_use_PrivateKey_ASN1');
+ //use SSL_CTX_use_RSAPrivateKey_file instead SSL_CTX_use_PrivateKey_file,
+ //because SSL_CTX_use_PrivateKey_file not support DER format. :-O
+ _SslCtxUsePrivateKeyFile := GetProcAddr(SSLLibHandle, 'SSL_CTX_use_RSAPrivateKey_file');
+ _SslCtxUseCertificate := GetProcAddr(SSLLibHandle, 'SSL_CTX_use_certificate');
+ _SslCtxUseCertificateASN1 := GetProcAddr(SSLLibHandle, 'SSL_CTX_use_certificate_ASN1');
+ _SslCtxUseCertificateFile := GetProcAddr(SSLLibHandle, 'SSL_CTX_use_certificate_file');
+ _SslCtxUseCertificateChainFile := GetProcAddr(SSLLibHandle, 'SSL_CTX_use_certificate_chain_file');
+ _SslCtxCheckPrivateKeyFile := GetProcAddr(SSLLibHandle, 'SSL_CTX_check_private_key');
+ _SslCtxSetDefaultPasswdCb := GetProcAddr(SSLLibHandle, 'SSL_CTX_set_default_passwd_cb');
+ _SslCtxSetDefaultPasswdCbUserdata := GetProcAddr(SSLLibHandle, 'SSL_CTX_set_default_passwd_cb_userdata');
+ _SslCtxLoadVerifyLocations := GetProcAddr(SSLLibHandle, 'SSL_CTX_load_verify_locations');
+ _SslCtxCtrl := GetProcAddr(SSLLibHandle, 'SSL_CTX_ctrl');
+ _SslNew := GetProcAddr(SSLLibHandle, 'SSL_new');
+ _SslFree := GetProcAddr(SSLLibHandle, 'SSL_free');
+ _SslAccept := GetProcAddr(SSLLibHandle, 'SSL_accept');
+ _SslConnect := GetProcAddr(SSLLibHandle, 'SSL_connect');
+ _SslShutdown := GetProcAddr(SSLLibHandle, 'SSL_shutdown');
+ _SslRead := GetProcAddr(SSLLibHandle, 'SSL_read');
+ _SslPeek := GetProcAddr(SSLLibHandle, 'SSL_peek');
+ _SslWrite := GetProcAddr(SSLLibHandle, 'SSL_write');
+ _SslPending := GetProcAddr(SSLLibHandle, 'SSL_pending');
+ _SslGetPeerCertificate := GetProcAddr(SSLLibHandle, 'SSL_get_peer_certificate');
+ _SslGetVersion := GetProcAddr(SSLLibHandle, 'SSL_get_version');
+ _SslCtxSetVerify := GetProcAddr(SSLLibHandle, 'SSL_CTX_set_verify');
+ _SslGetCurrentCipher := GetProcAddr(SSLLibHandle, 'SSL_get_current_cipher');
+ _SslCipherGetName := GetProcAddr(SSLLibHandle, 'SSL_CIPHER_get_name');
+ _SslCipherGetBits := GetProcAddr(SSLLibHandle, 'SSL_CIPHER_get_bits');
+ _SslGetVerifyResult := GetProcAddr(SSLLibHandle, 'SSL_get_verify_result');
+ _SslCtrl := GetProcAddr(SSLLibHandle, 'SSL_ctrl');
+
+ _X509New := GetProcAddr(SSLUtilHandle, 'X509_new');
+ _X509Free := GetProcAddr(SSLUtilHandle, 'X509_free');
+ _X509NameOneline := GetProcAddr(SSLUtilHandle, 'X509_NAME_oneline');
+ _X509GetSubjectName := GetProcAddr(SSLUtilHandle, 'X509_get_subject_name');
+ _X509GetIssuerName := GetProcAddr(SSLUtilHandle, 'X509_get_issuer_name');
+ _X509NameHash := GetProcAddr(SSLUtilHandle, 'X509_NAME_hash');
+ _X509Digest := GetProcAddr(SSLUtilHandle, 'X509_digest');
+ _X509print := GetProcAddr(SSLUtilHandle, 'X509_print');
+ _X509SetVersion := GetProcAddr(SSLUtilHandle, 'X509_set_version');
+ _X509SetPubkey := GetProcAddr(SSLUtilHandle, 'X509_set_pubkey');
+ _X509SetIssuerName := GetProcAddr(SSLUtilHandle, 'X509_set_issuer_name');
+ _X509NameAddEntryByTxt := GetProcAddr(SSLUtilHandle, 'X509_NAME_add_entry_by_txt');
+ _X509Sign := GetProcAddr(SSLUtilHandle, 'X509_sign');
+ _X509GmtimeAdj := GetProcAddr(SSLUtilHandle, 'X509_gmtime_adj');
+ _X509SetNotBefore := GetProcAddr(SSLUtilHandle, 'X509_set_notBefore');
+ _X509SetNotAfter := GetProcAddr(SSLUtilHandle, 'X509_set_notAfter');
+ _X509GetSerialNumber := GetProcAddr(SSLUtilHandle, 'X509_get_serialNumber');
+ _EvpPkeyNew := GetProcAddr(SSLUtilHandle, 'EVP_PKEY_new');
+ _EvpPkeyFree := GetProcAddr(SSLUtilHandle, 'EVP_PKEY_free');
+ _EvpPkeyAssign := GetProcAddr(SSLUtilHandle, 'EVP_PKEY_assign');
+ _EVPCleanup := GetProcAddr(SSLUtilHandle, 'EVP_cleanup');
+ _EvpGetDigestByName := GetProcAddr(SSLUtilHandle, 'EVP_get_digestbyname');
+ _SSLeayversion := GetProcAddr(SSLUtilHandle, 'SSLeay_version');
+ _ErrErrorString := GetProcAddr(SSLUtilHandle, 'ERR_error_string_n');
+ _ErrGetError := GetProcAddr(SSLUtilHandle, 'ERR_get_error');
+ _ErrClearError := GetProcAddr(SSLUtilHandle, 'ERR_clear_error');
+ _ErrFreeStrings := GetProcAddr(SSLUtilHandle, 'ERR_free_strings');
+ _ErrRemoveState := GetProcAddr(SSLUtilHandle, 'ERR_remove_state');
+ _OPENSSLaddallalgorithms := GetProcAddr(SSLUtilHandle, 'OPENSSL_add_all_algorithms_noconf');
+ _CRYPTOcleanupAllExData := GetProcAddr(SSLUtilHandle, 'CRYPTO_cleanup_all_ex_data');
+ _RandScreen := GetProcAddr(SSLUtilHandle, 'RAND_screen');
+ _BioNew := GetProcAddr(SSLUtilHandle, 'BIO_new');
+ _BioFreeAll := GetProcAddr(SSLUtilHandle, 'BIO_free_all');
+ _BioSMem := GetProcAddr(SSLUtilHandle, 'BIO_s_mem');
+ _BioCtrlPending := GetProcAddr(SSLUtilHandle, 'BIO_ctrl_pending');
+ _BioRead := GetProcAddr(SSLUtilHandle, 'BIO_read');
+ _BioWrite := GetProcAddr(SSLUtilHandle, 'BIO_write');
+ _d2iPKCS12bio := GetProcAddr(SSLUtilHandle, 'd2i_PKCS12_bio');
+ _PKCS12parse := GetProcAddr(SSLUtilHandle, 'PKCS12_parse');
+ _PKCS12free := GetProcAddr(SSLUtilHandle, 'PKCS12_free');
+ _RsaGenerateKey := GetProcAddr(SSLUtilHandle, 'RSA_generate_key');
+ _Asn1UtctimeNew := GetProcAddr(SSLUtilHandle, 'ASN1_UTCTIME_new');
+ _Asn1UtctimeFree := GetProcAddr(SSLUtilHandle, 'ASN1_UTCTIME_free');
+ _Asn1IntegerSet := GetProcAddr(SSLUtilHandle, 'ASN1_INTEGER_set');
+ _Asn1IntegerGet := GetProcAddr(SSLUtilHandle, 'ASN1_INTEGER_get'); {pf}
+ _i2dX509bio := GetProcAddr(SSLUtilHandle, 'i2d_X509_bio');
+ _d2iX509bio := GetProcAddr(SSLUtilHandle, 'd2i_X509_bio'); {pf}
+ _PEMReadBioX509 := GetProcAddr(SSLUtilHandle, 'PEM_read_bio_X509'); {pf}
+ _SkX509PopFree := GetProcAddr(SSLUtilHandle, 'SK_X509_POP_FREE'); {pf}
+ _i2dPrivateKeyBio := GetProcAddr(SSLUtilHandle, 'i2d_PrivateKey_bio');
+
+ // 3DES functions
+ _DESsetoddparity := GetProcAddr(SSLUtilHandle, 'DES_set_odd_parity');
+ _DESsetkeychecked := GetProcAddr(SSLUtilHandle, 'DES_set_key_checked');
+ _DESecbencrypt := GetProcAddr(SSLUtilHandle, 'DES_ecb_encrypt');
+ //
+ _CRYPTOnumlocks := GetProcAddr(SSLUtilHandle, 'CRYPTO_num_locks');
+ _CRYPTOsetlockingcallback := GetProcAddr(SSLUtilHandle, 'CRYPTO_set_locking_callback');
+{$ENDIF}
+{$IFDEF CIL}
+ SslLibraryInit;
+ SslLoadErrorStrings;
+ OPENSSLaddallalgorithms;
+ RandScreen;
+{$ELSE}
+ SetLength(s, 1024);
+ x := GetModuleFilename(SSLLibHandle,PChar(s),Length(s));
+ SetLength(s, x);
+ SSLLibFile := s;
+ SetLength(s, 1024);
+ x := GetModuleFilename(SSLUtilHandle,PChar(s),Length(s));
+ SetLength(s, x);
+ SSLUtilFile := s;
+ //init library
+ if assigned(_SslLibraryInit) then
+ _SslLibraryInit;
+ if assigned(_SslLoadErrorStrings) then
+ _SslLoadErrorStrings;
+ if assigned(_OPENSSLaddallalgorithms) then
+ _OPENSSLaddallalgorithms;
+ if assigned(_RandScreen) then
+ _RandScreen;
+ if assigned(_CRYPTOnumlocks) and assigned(_CRYPTOsetlockingcallback) then
+ InitLocks;
+{$ENDIF}
+ Result := True;
+ SSLloaded := True;
+ end
+ else
+ begin
+ //load failed!
+ if SSLLibHandle <> 0 then
+ begin
+{$IFNDEF CIL}
+ FreeLibrary(SSLLibHandle);
+{$ENDIF}
+ SSLLibHandle := 0;
+ end;
+ if SSLUtilHandle <> 0 then
+ begin
+{$IFNDEF CIL}
+ FreeLibrary(SSLUtilHandle);
+{$ENDIF}
+ SSLLibHandle := 0;
+ end;
+ Result := False;
+ end;
+ end
+ else
+ //loaded before...
+ Result := true;
+ finally
+ SSLCS.Leave;
+ end;
+end;
+
+function DestroySSLInterface: Boolean;
+begin
+ SSLCS.Enter;
+ try
+ if IsSSLLoaded then
+ begin
+ //deinit library
+{$IFNDEF CIL}
+ if assigned(_CRYPTOnumlocks) and assigned(_CRYPTOsetlockingcallback) then
+ FreeLocks;
+{$ENDIF}
+ EVPCleanup;
+ CRYPTOcleanupAllExData;
+ ErrRemoveState(0);
+ end;
+ SSLloaded := false;
+ if SSLLibHandle <> 0 then
+ begin
+{$IFNDEF CIL}
+ FreeLibrary(SSLLibHandle);
+{$ENDIF}
+ SSLLibHandle := 0;
+ end;
+ if SSLUtilHandle <> 0 then
+ begin
+{$IFNDEF CIL}
+ FreeLibrary(SSLUtilHandle);
+{$ENDIF}
+ SSLLibHandle := 0;
+ end;
+
+{$IFNDEF CIL}
+ _SslGetError := nil;
+ _SslLibraryInit := nil;
+ _SslLoadErrorStrings := nil;
+ _SslCtxSetCipherList := nil;
+ _SslCtxNew := nil;
+ _SslCtxFree := nil;
+ _SslSetFd := nil;
+ _SslMethodV2 := nil;
+ _SslMethodV3 := nil;
+ _SslMethodTLSV1 := nil;
+ _SslMethodV23 := nil;
+ _SslCtxUsePrivateKey := nil;
+ _SslCtxUsePrivateKeyASN1 := nil;
+ _SslCtxUsePrivateKeyFile := nil;
+ _SslCtxUseCertificate := nil;
+ _SslCtxUseCertificateASN1 := nil;
+ _SslCtxUseCertificateFile := nil;
+ _SslCtxUseCertificateChainFile := nil;
+ _SslCtxCheckPrivateKeyFile := nil;
+ _SslCtxSetDefaultPasswdCb := nil;
+ _SslCtxSetDefaultPasswdCbUserdata := nil;
+ _SslCtxLoadVerifyLocations := nil;
+ _SslCtxCtrl := nil;
+ _SslNew := nil;
+ _SslFree := nil;
+ _SslAccept := nil;
+ _SslConnect := nil;
+ _SslShutdown := nil;
+ _SslRead := nil;
+ _SslPeek := nil;
+ _SslWrite := nil;
+ _SslPending := nil;
+ _SslGetPeerCertificate := nil;
+ _SslGetVersion := nil;
+ _SslCtxSetVerify := nil;
+ _SslGetCurrentCipher := nil;
+ _SslCipherGetName := nil;
+ _SslCipherGetBits := nil;
+ _SslGetVerifyResult := nil;
+ _SslCtrl := nil;
+
+ _X509New := nil;
+ _X509Free := nil;
+ _X509NameOneline := nil;
+ _X509GetSubjectName := nil;
+ _X509GetIssuerName := nil;
+ _X509NameHash := nil;
+ _X509Digest := nil;
+ _X509print := nil;
+ _X509SetVersion := nil;
+ _X509SetPubkey := nil;
+ _X509SetIssuerName := nil;
+ _X509NameAddEntryByTxt := nil;
+ _X509Sign := nil;
+ _X509GmtimeAdj := nil;
+ _X509SetNotBefore := nil;
+ _X509SetNotAfter := nil;
+ _X509GetSerialNumber := nil;
+ _EvpPkeyNew := nil;
+ _EvpPkeyFree := nil;
+ _EvpPkeyAssign := nil;
+ _EVPCleanup := nil;
+ _EvpGetDigestByName := nil;
+ _SSLeayversion := nil;
+ _ErrErrorString := nil;
+ _ErrGetError := nil;
+ _ErrClearError := nil;
+ _ErrFreeStrings := nil;
+ _ErrRemoveState := nil;
+ _OPENSSLaddallalgorithms := nil;
+ _CRYPTOcleanupAllExData := nil;
+ _RandScreen := nil;
+ _BioNew := nil;
+ _BioFreeAll := nil;
+ _BioSMem := nil;
+ _BioCtrlPending := nil;
+ _BioRead := nil;
+ _BioWrite := nil;
+ _d2iPKCS12bio := nil;
+ _PKCS12parse := nil;
+ _PKCS12free := nil;
+ _RsaGenerateKey := nil;
+ _Asn1UtctimeNew := nil;
+ _Asn1UtctimeFree := nil;
+ _Asn1IntegerSet := nil;
+ _Asn1IntegerGet := nil; {pf}
+ _SkX509PopFree := nil; {pf}
+ _i2dX509bio := nil;
+ _i2dPrivateKeyBio := nil;
+
+ // 3DES functions
+ _DESsetoddparity := nil;
+ _DESsetkeychecked := nil;
+ _DESecbencrypt := nil;
+ //
+ _CRYPTOnumlocks := nil;
+ _CRYPTOsetlockingcallback := nil;
+{$ENDIF}
+ finally
+ SSLCS.Leave;
+ end;
+ Result := True;
+end;
+
+function IsSSLloaded: Boolean;
+begin
+ Result := SSLLoaded;
+end;
+
+initialization
+begin
+ SSLCS:= TCriticalSection.Create;
+end;
+
+finalization
+begin
+{$IFNDEF CIL}
+ DestroySSLInterface;
+{$ENDIF}
+ SSLCS.Free;
+end;
+
+end.
ADDED lib/synapse/source/lib/ssl_sbb.pas
Index: lib/synapse/source/lib/ssl_sbb.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/lib/ssl_sbb.pas
@@ -0,0 +1,697 @@
+{==============================================================================|
+| Project : Ararat Synapse | 001.000.003 |
+|==============================================================================|
+| Content: SSL support for SecureBlackBox |
+|==============================================================================|
+| Copyright (c)1999-2005, Lukas Gebauer |
+| All rights reserved. |
+| |
+| Redistribution and use in source and binary forms, with or without |
+| modification, are permitted provided that the following conditions are met: |
+| |
+| Redistributions of source code must retain the above copyright notice, this |
+| list of conditions and the following disclaimer. |
+| |
+| Redistributions in binary form must reproduce the above copyright notice, |
+| this list of conditions and the following disclaimer in the documentation |
+| and/or other materials provided with the distribution. |
+| |
+| Neither the name of Lukas Gebauer nor the names of its contributors may |
+| be used to endorse or promote products derived from this software without |
+| specific prior written permission. |
+| |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
+| DAMAGE. |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2005. |
+| All Rights Reserved. |
+|==============================================================================|
+| Contributor(s): |
+| Allen Drennan (adrennan@wiredred.com) |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package |
+| (Found at URL: http://www.ararat.cz/synapse/) |
+|==============================================================================}
+
+{:@abstract(SSL plugin for Eldos SecureBlackBox)
+
+For handling keys and certificates you can use this properties:
+@link(TCustomSSL.CertCAFile), @link(TCustomSSL.CertCA),
+@link(TCustomSSL.TrustCertificateFile), @link(TCustomSSL.TrustCertificate),
+@link(TCustomSSL.PrivateKeyFile), @link(TCustomSSL.PrivateKey),
+@link(TCustomSSL.CertificateFile), @link(TCustomSSL.Certificate),
+@link(TCustomSSL.PFXFile). For usage of this properties and for possible formats
+of keys and certificates refer to SecureBlackBox documentation.
+}
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+
+unit ssl_sbb;
+
+interface
+
+uses
+ SysUtils, Classes, Windows, blcksock, synsock, synautil, synacode,
+ SBClient, SBServer, SBX509, SBWinCertStorage, SBCustomCertStorage,
+ SBUtils, SBConstants, SBSessionPool;
+
+const
+ DEFAULT_RECV_BUFFER=32768;
+
+type
+ {:@abstract(class implementing SecureBlackbox SSL plugin.)
+ Instance of this class will be created for each @link(TTCPBlockSocket).
+ You not need to create instance of this class, all is done by Synapse itself!}
+ TSSLSBB=class(TCustomSSL)
+ protected
+ FServer: Boolean;
+ FElSecureClient:TElSecureClient;
+ FElSecureServer:TElSecureServer;
+ FElCertStorage:TElMemoryCertStorage;
+ FElX509Certificate:TElX509Certificate;
+ FElX509CACertificate:TElX509Certificate;
+ FCipherSuites:TBits;
+ private
+ FRecvBuffer:String;
+ FRecvBuffers:String;
+ FRecvBuffersLock:TRTLCriticalSection;
+ FRecvDecodedBuffers:String;
+ function GetCipherSuite:Integer;
+ procedure Reset;
+ function Prepare(Server:Boolean):Boolean;
+ procedure OnError(Sender:TObject; ErrorCode:Integer; Fatal:Boolean; Remote:Boolean);
+ procedure OnSend(Sender:TObject;Buffer:Pointer;Size:LongInt);
+ procedure OnReceive(Sender:TObject;Buffer:Pointer;MaxSize:LongInt;var Written:LongInt);
+ procedure OnData(Sender:TObject;Buffer:Pointer;Size:LongInt);
+ public
+ constructor Create(const Value: TTCPBlockSocket); override;
+ destructor Destroy; override;
+ {:See @inherited}
+ function LibVersion: String; override;
+ {:See @inherited}
+ function LibName: String; override;
+ {:See @inherited and @link(ssl_sbb) for more details.}
+ function Connect: boolean; override;
+ {:See @inherited and @link(ssl_sbb) for more details.}
+ function Accept: boolean; override;
+ {:See @inherited}
+ function Shutdown: boolean; override;
+ {:See @inherited}
+ function BiShutdown: boolean; override;
+ {:See @inherited}
+ function SendBuffer(Buffer: TMemory; Len: Integer): Integer; override;
+ {:See @inherited}
+ function RecvBuffer(Buffer: TMemory; Len: Integer): Integer; override;
+ {:See @inherited}
+ function WaitingData: Integer; override;
+ {:See @inherited}
+ function GetSSLVersion: string; override;
+ {:See @inherited}
+ function GetPeerSubject: string; override;
+ {:See @inherited}
+ function GetPeerIssuer: string; override;
+ {:See @inherited}
+ function GetPeerName: string; override;
+ {:See @inherited}
+ function GetPeerFingerprint: string; override;
+ {:See @inherited}
+ function GetCertInfo: string; override;
+ published
+ property ElSecureClient:TElSecureClient read FElSecureClient write FElSecureClient;
+ property ElSecureServer:TElSecureServer read FElSecureServer write FElSecureServer;
+ property CipherSuites:TBits read FCipherSuites write FCipherSuites;
+ property CipherSuite:Integer read GetCipherSuite;
+ end;
+
+implementation
+
+var
+ FAcceptThread:THandle=0;
+
+// on error
+procedure TSSLSBB.OnError(Sender:TObject; ErrorCode:Integer; Fatal:Boolean; Remote:Boolean);
+
+begin
+ FLastErrorDesc:='';
+ FLastError:=ErrorCode;
+end;
+
+// on send
+procedure TSSLSBB.OnSend(Sender:TObject;Buffer:Pointer;Size:LongInt);
+
+var
+ lResult:Integer;
+
+begin
+ if FSocket.Socket=INVALID_SOCKET then
+ Exit;
+ lResult:=Send(FSocket.Socket,Buffer,Size,0);
+ if lResult=SOCKET_ERROR then
+ begin
+ FLastErrorDesc:='';
+ FLastError:=WSAGetLastError;
+ end;
+end;
+
+// on receive
+procedure TSSLSBB.OnReceive(Sender:TObject;Buffer:Pointer;MaxSize:LongInt;var Written:LongInt);
+
+begin
+ if GetCurrentThreadId<>FAcceptThread then EnterCriticalSection(FRecvBuffersLock);
+ try
+ if Length(FRecvBuffers)<=MaxSize then
+ begin
+ Written:=Length(FRecvBuffers);
+ Move(FRecvBuffers[1],Buffer^,Written);
+ FRecvBuffers:='';
+ end
+ else
+ begin
+ Written:=MaxSize;
+ Move(FRecvBuffers[1],Buffer^,Written);
+ Delete(FRecvBuffers,1,Written);
+ end;
+ finally
+ if GetCurrentThreadId<>FAcceptThread then LeaveCriticalSection(FRecvBuffersLock);
+ end;
+end;
+
+// on data
+procedure TSSLSBB.OnData(Sender:TObject;Buffer:Pointer;Size:LongInt);
+
+var
+ lString:String;
+
+begin
+ SetLength(lString,Size);
+ Move(Buffer^,lString[1],Size);
+ FRecvDecodedBuffers:=FRecvDecodedBuffers+lString;
+end;
+
+{ inherited }
+
+constructor TSSLSBB.Create(const Value: TTCPBlockSocket);
+
+var
+ loop1:Integer;
+
+begin
+ inherited Create(Value);
+ FServer:=FALSE;
+ FElSecureClient:=NIL;
+ FElSecureServer:=NIL;
+ FElCertStorage:=NIL;
+ FElX509Certificate:=NIL;
+ FElX509CACertificate:=NIL;
+ SetLength(FRecvBuffer,DEFAULT_RECV_BUFFER);
+ FRecvBuffers:='';
+ InitializeCriticalSection(FRecvBuffersLock);
+ FRecvDecodedBuffers:='';
+ FCipherSuites:=TBits.Create;
+ if FCipherSuites<>NIL then
+ begin
+ FCipherSuites.Size:=SB_SUITE_LAST+1;
+ for loop1:=SB_SUITE_FIRST to SB_SUITE_LAST do
+ FCipherSuites[loop1]:=TRUE;
+ end;
+end;
+
+destructor TSSLSBB.Destroy;
+
+begin
+ Reset;
+ inherited Destroy;
+ if FCipherSuites<>NIL then
+ FreeAndNIL(FCipherSuites);
+ DeleteCriticalSection(FRecvBuffersLock);
+end;
+
+function TSSLSBB.LibVersion: String;
+
+begin
+ Result:='SecureBlackBox';
+end;
+
+function TSSLSBB.LibName: String;
+
+begin
+ Result:='ssl_sbb';
+end;
+
+function FileToString(lFile:String):String;
+
+var
+ lStream:TMemoryStream;
+
+begin
+ Result:='';
+ lStream:=TMemoryStream.Create;
+ if lStream<>NIL then
+ begin
+ lStream.LoadFromFile(lFile);
+ if lStream.Size>0 then
+ begin
+ lStream.Position:=0;
+ SetLength(Result,lStream.Size);
+ Move(lStream.Memory^,Result[1],lStream.Size);
+ end;
+ lStream.Free;
+ end;
+end;
+
+function TSSLSBB.GetCipherSuite:Integer;
+
+begin
+ if FServer then
+ Result:=FElSecureServer.CipherSuite
+ else
+ Result:=FElSecureClient.CipherSuite;
+end;
+
+procedure TSSLSBB.Reset;
+
+begin
+ if FElSecureServer<>NIL then
+ FreeAndNIL(FElSecureServer);
+ if FElSecureClient<>NIL then
+ FreeAndNIL(FElSecureClient);
+ if FElX509Certificate<>NIL then
+ FreeAndNIL(FElX509Certificate);
+ if FElX509CACertificate<>NIL then
+ FreeAndNIL(FElX509CACertificate);
+ if FElCertStorage<>NIL then
+ FreeAndNIL(FElCertStorage);
+ FSSLEnabled:=FALSE;
+end;
+
+function TSSLSBB.Prepare(Server:Boolean): Boolean;
+
+var
+ loop1:Integer;
+ lStream:TMemoryStream;
+ lCertificate,lPrivateKey,lCertCA:String;
+
+begin
+ Result:=FALSE;
+ FServer:=Server;
+
+ // reset, if necessary
+ Reset;
+
+ // init, certificate
+ if FCertificateFile<>'' then
+ lCertificate:=FileToString(FCertificateFile)
+ else
+ lCertificate:=FCertificate;
+ if FPrivateKeyFile<>'' then
+ lPrivateKey:=FileToString(FPrivateKeyFile)
+ else
+ lPrivateKey:=FPrivateKey;
+ if FCertCAFile<>'' then
+ lCertCA:=FileToString(FCertCAFile)
+ else
+ lCertCA:=FCertCA;
+ if (lCertificate<>'') and (lPrivateKey<>'') then
+ begin
+ FElCertStorage:=TElMemoryCertStorage.Create(NIL);
+ if FElCertStorage<>NIL then
+ FElCertStorage.Clear;
+
+ // apply ca certificate
+ if lCertCA<>'' then
+ begin
+ FElX509CACertificate:=TElX509Certificate.Create(NIL);
+ if FElX509CACertificate<>NIL then
+ begin
+ with FElX509CACertificate do
+ begin
+ lStream:=TMemoryStream.Create;
+ try
+ WriteStrToStream(lStream,lCertCA);
+ lStream.Seek(0,soFromBeginning);
+ LoadFromStream(lStream);
+ finally
+ lStream.Free;
+ end;
+ end;
+ if FElCertStorage<>NIL then
+ FElCertStorage.Add(FElX509CACertificate);
+ end;
+ end;
+
+ // apply certificate
+ FElX509Certificate:=TElX509Certificate.Create(NIL);
+ if FElX509Certificate<>NIL then
+ begin
+ with FElX509Certificate do
+ begin
+ lStream:=TMemoryStream.Create;
+ try
+ WriteStrToStream(lStream,lCertificate);
+ lStream.Seek(0,soFromBeginning);
+ LoadFromStream(lStream);
+ finally
+ lStream.Free;
+ end;
+ lStream:=TMemoryStream.Create;
+ try
+ WriteStrToStream(lStream,lPrivateKey);
+ lStream.Seek(0,soFromBeginning);
+ LoadKeyFromStream(lStream);
+ finally
+ lStream.Free;
+ end;
+ if FElCertStorage<>NIL then
+ FElCertStorage.Add(FElX509Certificate);
+ end;
+ end;
+ end;
+
+ // init, as server
+ if FServer then
+ begin
+ FElSecureServer:=TElSecureServer.Create(NIL);
+ if FElSecureServer<>NIL then
+ begin
+ // init, ciphers
+ for loop1:=SB_SUITE_FIRST to SB_SUITE_LAST do
+ FElSecureServer.CipherSuites[loop1]:=FCipherSuites[loop1];
+ FElSecureServer.Versions:=[sbSSL2,sbSSL3,sbTLS1];
+ FElSecureServer.ClientAuthentication:=FALSE;
+ FElSecureServer.OnError:=OnError;
+ FElSecureServer.OnSend:=OnSend;
+ FElSecureServer.OnReceive:=OnReceive;
+ FElSecureServer.OnData:=OnData;
+ FElSecureServer.CertStorage:=FElCertStorage;
+ Result:=TRUE;
+ end;
+ end
+ else
+ // init, as client
+ begin
+ FElSecureClient:=TElSecureClient.Create(NIL);
+ if FElSecureClient<>NIL then
+ begin
+ // init, ciphers
+ for loop1:=SB_SUITE_FIRST to SB_SUITE_LAST do
+ FElSecureClient.CipherSuites[loop1]:=FCipherSuites[loop1];
+ FElSecureClient.Versions:=[sbSSL3,sbTLS1];
+ FElSecureClient.OnError:=OnError;
+ FElSecureClient.OnSend:=OnSend;
+ FElSecureClient.OnReceive:=OnReceive;
+ FElSecureClient.OnData:=OnData;
+ FElSecureClient.CertStorage:=FElCertStorage;
+ Result:=TRUE;
+ end;
+ end;
+end;
+
+function TSSLSBB.Connect:Boolean;
+
+var
+ lResult:Integer;
+
+begin
+ Result:=FALSE;
+ if FSocket.Socket=INVALID_SOCKET then
+ Exit;
+ if Prepare(FALSE) then
+ begin
+ FElSecureClient.Open;
+
+ // reset
+ FRecvBuffers:='';
+ FRecvDecodedBuffers:='';
+
+ // wait for open or error
+ while (not FElSecureClient.Active) and
+ (FLastError=0) do
+ begin
+ // data available?
+ if FRecvBuffers<>'' then
+ FElSecureClient.DataAvailable
+ else
+ begin
+ // socket recv
+ lResult:=Recv(FSocket.Socket,@FRecvBuffer[1],Length(FRecvBuffer),0);
+ if lResult=SOCKET_ERROR then
+ begin
+ FLastErrorDesc:='';
+ FLastError:=WSAGetLastError;
+ end
+ else
+ begin
+ if lResult>0 then
+ FRecvBuffers:=FRecvBuffers+Copy(FRecvBuffer,1,lResult)
+ else
+ Break;
+ end;
+ end;
+ end;
+ if FLastError<>0 then
+ Exit;
+ FSSLEnabled:=FElSecureClient.Active;
+ Result:=FSSLEnabled;
+ end;
+end;
+
+function TSSLSBB.Accept:Boolean;
+
+var
+ lResult:Integer;
+
+begin
+ Result:=FALSE;
+ if FSocket.Socket=INVALID_SOCKET then
+ Exit;
+ if Prepare(TRUE) then
+ begin
+ FAcceptThread:=GetCurrentThreadId;
+ FElSecureServer.Open;
+
+ // reset
+ FRecvBuffers:='';
+ FRecvDecodedBuffers:='';
+
+ // wait for open or error
+ while (not FElSecureServer.Active) and
+ (FLastError=0) do
+ begin
+ // data available?
+ if FRecvBuffers<>'' then
+ FElSecureServer.DataAvailable
+ else
+ begin
+ // socket recv
+ lResult:=Recv(FSocket.Socket,@FRecvBuffer[1],Length(FRecvBuffer),0);
+ if lResult=SOCKET_ERROR then
+ begin
+ FLastErrorDesc:='';
+ FLastError:=WSAGetLastError;
+ end
+ else
+ begin
+ if lResult>0 then
+ FRecvBuffers:=FRecvBuffers+Copy(FRecvBuffer,1,lResult)
+ else
+ Break;
+ end;
+ end;
+ end;
+ if FLastError<>0 then
+ Exit;
+ FSSLEnabled:=FElSecureServer.Active;
+ Result:=FSSLEnabled;
+ end;
+end;
+
+function TSSLSBB.Shutdown:Boolean;
+
+begin
+ Result:=BiShutdown;
+end;
+
+function TSSLSBB.BiShutdown: boolean;
+
+begin
+ Reset;
+ Result:=TRUE;
+end;
+
+function TSSLSBB.SendBuffer(Buffer: TMemory; Len: Integer): Integer;
+
+begin
+ if FServer then
+ FElSecureServer.SendData(Buffer,Len)
+ else
+ FElSecureClient.SendData(Buffer,Len);
+ Result:=Len;
+end;
+
+function TSSLSBB.RecvBuffer(Buffer: TMemory; Len: Integer): Integer;
+
+begin
+ Result:=0;
+ try
+ // recv waiting, if necessary
+ if FRecvDecodedBuffers='' then
+ WaitingData;
+
+ // received
+ if Length(FRecvDecodedBuffers)FAcceptThread then EnterCriticalSection(FRecvBuffersLock);
+ try
+ lRecvBuffers:=FRecvBuffers<>'';
+ finally
+ if GetCurrentThreadId<>FAcceptThread then LeaveCriticalSection(FRecvBuffersLock);
+ end;
+ if lRecvBuffers then
+ begin
+ if FServer then
+ FElSecureServer.DataAvailable
+ else
+ FElSecureClient.DataAvailable;
+ end
+ else
+ begin
+ // socket recv
+ lResult:=Recv(FSocket.Socket,@FRecvBuffer[1],Length(FRecvBuffer),0);
+ if lResult=SOCKET_ERROR then
+ begin
+ FLastErrorDesc:='';
+ FLastError:=WSAGetLastError;
+ end
+ else
+ begin
+ if GetCurrentThreadId<>FAcceptThread then EnterCriticalSection(FRecvBuffersLock);
+ try
+ FRecvBuffers:=FRecvBuffers+Copy(FRecvBuffer,1,lResult);
+ finally
+ if GetCurrentThreadId<>FAcceptThread then LeaveCriticalSection(FRecvBuffersLock);
+ end;
+
+ // data available?
+ if GetCurrentThreadId<>FAcceptThread then EnterCriticalSection(FRecvBuffersLock);
+ try
+ lRecvBuffers:=FRecvBuffers<>'';
+ finally
+ if GetCurrentThreadId<>FAcceptThread then LeaveCriticalSection(FRecvBuffersLock);
+ end;
+ if lRecvBuffers then
+ begin
+ if FServer then
+ FElSecureServer.DataAvailable
+ else
+ FElSecureClient.DataAvailable;
+ end;
+ end;
+ end;
+
+ // decoded buffers result
+ Result:=Length(FRecvDecodedBuffers);
+end;
+
+function TSSLSBB.GetSSLVersion: string;
+
+begin
+ Result:='SSLv3 or TLSv1';
+end;
+
+function TSSLSBB.GetPeerSubject: string;
+
+begin
+ Result := '';
+// if FServer then
+ // must return subject of the client certificate
+// else
+ // must return subject of the server certificate
+end;
+
+function TSSLSBB.GetPeerName: string;
+
+begin
+ Result := '';
+// if FServer then
+ // must return commonname of the client certificate
+// else
+ // must return commonname of the server certificate
+end;
+
+function TSSLSBB.GetPeerIssuer: string;
+
+begin
+ Result := '';
+// if FServer then
+ // must return issuer of the client certificate
+// else
+ // must return issuer of the server certificate
+end;
+
+function TSSLSBB.GetPeerFingerprint: string;
+
+begin
+ Result := '';
+// if FServer then
+ // must return a unique hash string of the client certificate
+// else
+ // must return a unique hash string of the server certificate
+end;
+
+function TSSLSBB.GetCertInfo: string;
+
+begin
+ Result := '';
+// if FServer then
+ // must return a text representation of the ASN of the client certificate
+// else
+ // must return a text representation of the ASN of the server certificate
+end;
+
+{==============================================================================}
+
+initialization
+ SSLImplementation := TSSLSBB;
+
+finalization
+
+end.
ADDED lib/synapse/source/lib/ssl_streamsec.pas
Index: lib/synapse/source/lib/ssl_streamsec.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/lib/ssl_streamsec.pas
@@ -0,0 +1,539 @@
+{==============================================================================|
+| Project : Ararat Synapse | 001.000.006 |
+|==============================================================================|
+| Content: SSL support by StreamSecII |
+|==============================================================================|
+| Copyright (c)1999-2005, Lukas Gebauer |
+| All rights reserved. |
+| |
+| Redistribution and use in source and binary forms, with or without |
+| modification, are permitted provided that the following conditions are met: |
+| |
+| Redistributions of source code must retain the above copyright notice, this |
+| list of conditions and the following disclaimer. |
+| |
+| Redistributions in binary form must reproduce the above copyright notice, |
+| this list of conditions and the following disclaimer in the documentation |
+| and/or other materials provided with the distribution. |
+| |
+| Neither the name of Lukas Gebauer nor the names of its contributors may |
+| be used to endorse or promote products derived from this software without |
+| specific prior written permission. |
+| |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
+| DAMAGE. |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2005. |
+| All Rights Reserved. |
+|==============================================================================|
+| Contributor(s): |
+| Henrick Hellström |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package |
+| (Found at URL: http://www.ararat.cz/synapse/) |
+|==============================================================================}
+
+{:@abstract(SSL plugin for StreamSecII or OpenStreamSecII)
+
+StreamSecII is native pascal library, you not need any external libraries!
+
+You can tune lot of StreamSecII properties by using your GlobalServer. If you not
+using your GlobalServer, then this plugin create own TSimpleTLSInternalServer
+instance for each TCP connection. Formore information about GlobalServer usage
+refer StreamSecII documentation.
+
+If you are not using key and certificate by GlobalServer, then you can use
+properties of this plugin instead, but this have limited features and
+@link(TCustomSSL.KeyPassword) not working properly yet!
+
+For handling keys and certificates you can use this properties:
+@link(TCustomSSL.CertCAFile), @link(TCustomSSL.CertCA),
+@link(TCustomSSL.TrustCertificateFile), @link(TCustomSSL.TrustCertificate),
+@link(TCustomSSL.PrivateKeyFile), @link(TCustomSSL.PrivateKey),
+@link(TCustomSSL.CertificateFile), @link(TCustomSSL.Certificate),
+@link(TCustomSSL.PFXFile). For usage of this properties and for possible formats
+of keys and certificates refer to StreamSecII documentation.
+}
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+
+unit ssl_streamsec;
+
+interface
+
+uses
+ SysUtils, Classes,
+ blcksock, synsock, synautil, synacode,
+ TlsInternalServer, TlsSynaSock, TlsConst, StreamSecII, Asn1, X509Base,
+ SecUtils;
+
+type
+ {:@exclude}
+ TMyTLSSynSockSlave = class(TTLSSynSockSlave)
+ protected
+ procedure SetMyTLSServer(const Value: TCustomTLSInternalServer);
+ function GetMyTLSServer: TCustomTLSInternalServer;
+ published
+ property MyTLSServer: TCustomTLSInternalServer read GetMyTLSServer write SetMyTLSServer;
+ end;
+
+ {:@abstract(class implementing StreamSecII SSL plugin.)
+ Instance of this class will be created for each @link(TTCPBlockSocket).
+ You not need to create instance of this class, all is done by Synapse itself!}
+ TSSLStreamSec = class(TCustomSSL)
+ protected
+ FSlave: TMyTLSSynSockSlave;
+ FIsServer: Boolean;
+ FTLSServer: TCustomTLSInternalServer;
+ FServerCreated: Boolean;
+ function SSLCheck: Boolean;
+ function Init(server:Boolean): Boolean;
+ function DeInit: Boolean;
+ function Prepare(server:Boolean): Boolean;
+ procedure NotTrustEvent(Sender: TObject; Cert: TASN1Struct; var ExplicitTrust: Boolean);
+ function X500StrToStr(const Prefix: string; const Value: TX500String): string;
+ function X501NameToStr(const Value: TX501Name): string;
+ function GetCert: PASN1Struct;
+ public
+ constructor Create(const Value: TTCPBlockSocket); override;
+ destructor Destroy; override;
+ {:See @inherited}
+ function LibVersion: String; override;
+ {:See @inherited}
+ function LibName: String; override;
+ {:See @inherited and @link(ssl_streamsec) for more details.}
+ function Connect: boolean; override;
+ {:See @inherited and @link(ssl_streamsec) for more details.}
+ function Accept: boolean; override;
+ {:See @inherited}
+ function Shutdown: boolean; override;
+ {:See @inherited}
+ function BiShutdown: boolean; override;
+ {:See @inherited}
+ function SendBuffer(Buffer: TMemory; Len: Integer): Integer; override;
+ {:See @inherited}
+ function RecvBuffer(Buffer: TMemory; Len: Integer): Integer; override;
+ {:See @inherited}
+ function WaitingData: Integer; override;
+ {:See @inherited}
+ function GetSSLVersion: string; override;
+ {:See @inherited}
+ function GetPeerSubject: string; override;
+ {:See @inherited}
+ function GetPeerIssuer: string; override;
+ {:See @inherited}
+ function GetPeerName: string; override;
+ {:See @inherited}
+ function GetPeerFingerprint: string; override;
+ {:See @inherited}
+ function GetCertInfo: string; override;
+ published
+ {:TLS server for tuning of StreamSecII.}
+ property TLSServer: TCustomTLSInternalServer read FTLSServer write FTLSServer;
+ end;
+
+implementation
+
+{==============================================================================}
+procedure TMyTLSSynSockSlave.SetMyTLSServer(const Value: TCustomTLSInternalServer);
+begin
+ TLSServer := Value;
+end;
+
+function TMyTLSSynSockSlave.GetMyTLSServer: TCustomTLSInternalServer;
+begin
+ Result := TLSServer;
+end;
+
+{==============================================================================}
+
+constructor TSSLStreamSec.Create(const Value: TTCPBlockSocket);
+begin
+ inherited Create(Value);
+ FSlave := nil;
+ FIsServer := False;
+ FTLSServer := nil;
+end;
+
+destructor TSSLStreamSec.Destroy;
+begin
+ DeInit;
+ inherited Destroy;
+end;
+
+function TSSLStreamSec.LibVersion: String;
+begin
+ Result := 'StreamSecII';
+end;
+
+function TSSLStreamSec.LibName: String;
+begin
+ Result := 'ssl_streamsec';
+end;
+
+function TSSLStreamSec.SSLCheck: Boolean;
+begin
+ Result := true;
+ FLastErrorDesc := '';
+ if not Assigned(FSlave) then
+ Exit;
+ FLastError := FSlave.ErrorCode;
+ if FLastError <> 0 then
+ begin
+ FLastErrorDesc := TlsConst.AlertMsg(FLastError);
+ end;
+end;
+
+procedure TSSLStreamSec.NotTrustEvent(Sender: TObject; Cert: TASN1Struct; var ExplicitTrust: Boolean);
+begin
+ ExplicitTrust := true;
+end;
+
+function TSSLStreamSec.Init(server:Boolean): Boolean;
+var
+ st: TMemoryStream;
+ pass: ISecretKey;
+ ws: WideString;
+begin
+ Result := False;
+ ws := FKeyPassword;
+ pass := TSecretKey.CreateBmpStr(PWideChar(ws), length(ws));
+ try
+ FIsServer := Server;
+ FSlave := TMyTLSSynSockSlave.CreateSocket(FSocket.Socket);
+ if Assigned(FTLSServer) then
+ FSlave.MyTLSServer := FTLSServer
+ else
+ if Assigned(TLSInternalServer.GlobalServer) then
+ FSlave.MyTLSServer := TLSInternalServer.GlobalServer
+ else begin
+ FSlave.MyTLSServer := TSimpleTLSInternalServer.Create(nil);
+ FServerCreated := True;
+ end;
+ if server then
+ FSlave.MyTLSServer.ClientOrServer := cosServerSide
+ else
+ FSlave.MyTLSServer.ClientOrServer := cosClientSide;
+ if not FVerifyCert then
+ begin
+ FSlave.MyTLSServer.OnCertNotTrusted := NotTrustEvent;
+ end;
+ FSlave.MyTLSServer.Options.VerifyServerName := [];
+ FSlave.MyTLSServer.Options.Export40Bit := prAllowed;
+ FSlave.MyTLSServer.Options.Export56Bit := prAllowed;
+ FSlave.MyTLSServer.Options.RequestClientCertificate := False;
+ FSlave.MyTLSServer.Options.RequireClientCertificate := False;
+ if server and FVerifyCert then
+ begin
+ FSlave.MyTLSServer.Options.RequestClientCertificate := True;
+ FSlave.MyTLSServer.Options.RequireClientCertificate := True;
+ end;
+ if FCertCAFile <> '' then
+ FSlave.MyTLSServer.LoadRootCertsFromFile(CertCAFile);
+ if FCertCA <> '' then
+ begin
+ st := TMemoryStream.Create;
+ try
+ WriteStrToStream(st, FCertCA);
+ st.Seek(0, soFromBeginning);
+ FSlave.MyTLSServer.LoadRootCertsFromStream(st);
+ finally
+ st.free;
+ end;
+ end;
+ if FTrustCertificateFile <> '' then
+ FSlave.MyTLSServer.LoadTrustedCertsFromFile(FTrustCertificateFile);
+ if FTrustCertificate <> '' then
+ begin
+ st := TMemoryStream.Create;
+ try
+ WriteStrToStream(st, FTrustCertificate);
+ st.Seek(0, soFromBeginning);
+ FSlave.MyTLSServer.LoadTrustedCertsFromStream(st);
+ finally
+ st.free;
+ end;
+ end;
+ if FPrivateKeyFile <> '' then
+ FSlave.MyTLSServer.LoadPrivateKeyRingFromFile(FPrivateKeyFile, pass);
+// FSlave.MyTLSServer.PrivateKeyRing.LoadPrivateKeyFromFile(FPrivateKeyFile, pass);
+ if FPrivateKey <> '' then
+ begin
+ st := TMemoryStream.Create;
+ try
+ WriteStrToStream(st, FPrivateKey);
+ st.Seek(0, soFromBeginning);
+ FSlave.MyTLSServer.LoadPrivateKeyRingFromStream(st, pass);
+ finally
+ st.free;
+ end;
+ end;
+ if FCertificateFile <> '' then
+ FSlave.MyTLSServer.LoadMyCertsFromFile(FCertificateFile);
+ if FCertificate <> '' then
+ begin
+ st := TMemoryStream.Create;
+ try
+ WriteStrToStream(st, FCertificate);
+ st.Seek(0, soFromBeginning);
+ FSlave.MyTLSServer.LoadMyCertsFromStream(st);
+ finally
+ st.free;
+ end;
+ end;
+ if FPFXfile <> '' then
+ FSlave.MyTLSServer.ImportFromPFX(FPFXfile, pass);
+ if server and FServerCreated then
+ begin
+ FSlave.MyTLSServer.Options.BulkCipherAES128 := prPrefer;
+ FSlave.MyTLSServer.Options.BulkCipherAES256 := prAllowed;
+ FSlave.MyTLSServer.Options.EphemeralECDHKeySize := ecs256;
+ FSlave.MyTLSServer.Options.SignatureRSA := prPrefer;
+ FSlave.MyTLSServer.Options.KeyAgreementRSA := prAllowed;
+ FSlave.MyTLSServer.Options.KeyAgreementECDHE := prAllowed;
+ FSlave.MyTLSServer.Options.KeyAgreementDHE := prPrefer;
+ FSlave.MyTLSServer.TLSSetupServer;
+ end;
+ Result := true;
+ finally
+ pass := nil;
+ end;
+end;
+
+function TSSLStreamSec.DeInit: Boolean;
+var
+ obj: TObject;
+begin
+ Result := True;
+ if assigned(FSlave) then
+ begin
+ FSlave.Close;
+ if FServerCreated then
+ obj := FSlave.TLSServer
+ else
+ obj := nil;
+ FSlave.Free;
+ obj.Free;
+ FSlave := nil;
+ end;
+ FSSLEnabled := false;
+end;
+
+function TSSLStreamSec.Prepare(server:Boolean): Boolean;
+begin
+ Result := false;
+ DeInit;
+ if Init(server) then
+ Result := true
+ else
+ DeInit;
+end;
+
+function TSSLStreamSec.Connect: boolean;
+begin
+ Result := False;
+ if FSocket.Socket = INVALID_SOCKET then
+ Exit;
+ if Prepare(false) then
+ begin
+ FSlave.Open;
+ SSLCheck;
+ if FLastError <> 0 then
+ Exit;
+ FSSLEnabled := True;
+ Result := True;
+ end;
+end;
+
+function TSSLStreamSec.Accept: boolean;
+begin
+ Result := False;
+ if FSocket.Socket = INVALID_SOCKET then
+ Exit;
+ if Prepare(true) then
+ begin
+ FSlave.DoConnect;
+ SSLCheck;
+ if FLastError <> 0 then
+ Exit;
+ FSSLEnabled := True;
+ Result := True;
+ end;
+end;
+
+function TSSLStreamSec.Shutdown: boolean;
+begin
+ Result := BiShutdown;
+end;
+
+function TSSLStreamSec.BiShutdown: boolean;
+begin
+ DeInit;
+ Result := True;
+end;
+
+function TSSLStreamSec.SendBuffer(Buffer: TMemory; Len: Integer): Integer;
+var
+ l: integer;
+begin
+ l := len;
+ FSlave.SendBuf(Buffer^, l, true);
+ Result := l;
+ SSLCheck;
+end;
+
+function TSSLStreamSec.RecvBuffer(Buffer: TMemory; Len: Integer): Integer;
+var
+ l: integer;
+begin
+ l := Len;
+ Result := FSlave.ReceiveBuf(Buffer^, l);
+ SSLCheck;
+end;
+
+function TSSLStreamSec.WaitingData: Integer;
+begin
+ Result := 0;
+ while FSlave.Connected do begin
+ Result := FSlave.ReceiveLength;
+ if Result > 0 then
+ Break;
+ Sleep(1);
+ end;
+end;
+
+function TSSLStreamSec.GetSSLVersion: string;
+begin
+ Result := 'SSLv3 or TLSv1';
+end;
+
+function TSSLStreamSec.GetCert: PASN1Struct;
+begin
+ if FIsServer then
+ Result := FSlave.GetClientCert
+ else
+ Result := FSlave.GetServerCert;
+end;
+
+function TSSLStreamSec.GetPeerSubject: string;
+var
+ XName: TX501Name;
+ Cert: PASN1Struct;
+begin
+ Result := '';
+ Cert := GetCert;
+ if Assigned(cert) then
+ begin
+ ExtractSubject(Cert^,XName, false);
+ Result := X501NameToStr(XName);
+ end;
+end;
+
+function TSSLStreamSec.GetPeerName: string;
+var
+ XName: TX501Name;
+ Cert: PASN1Struct;
+begin
+ Result := '';
+ Cert := GetCert;
+ if Assigned(cert) then
+ begin
+ ExtractSubject(Cert^,XName, false);
+ Result := XName.commonName.Str;
+ end;
+end;
+
+function TSSLStreamSec.GetPeerIssuer: string;
+var
+ XName: TX501Name;
+ Cert: PASN1Struct;
+begin
+ Result := '';
+ Cert := GetCert;
+ if Assigned(cert) then
+ begin
+ ExtractIssuer(Cert^, XName, false);
+ Result := X501NameToStr(XName);
+ end;
+end;
+
+function TSSLStreamSec.GetPeerFingerprint: string;
+var
+ Cert: PASN1Struct;
+begin
+ Result := '';
+ Cert := GetCert;
+ if Assigned(cert) then
+ Result := MD5(Cert.ContentAsOctetString);
+end;
+
+function TSSLStreamSec.GetCertInfo: string;
+var
+ Cert: PASN1Struct;
+ l: Tstringlist;
+begin
+ Result := '';
+ Cert := GetCert;
+ if Assigned(cert) then
+ begin
+ l := TStringList.Create;
+ try
+ Asn1.RenderAsText(cert^, l, true, true, true, 2);
+ Result := l.Text;
+ finally
+ l.free;
+ end;
+ end;
+end;
+
+function TSSLStreamSec.X500StrToStr(const Prefix: string;
+ const Value: TX500String): string;
+begin
+ if Value.Str = '' then
+ Result := ''
+ else
+ Result := '/' + Prefix + '=' + Value.Str;
+end;
+
+function TSSLStreamSec.X501NameToStr(const Value: TX501Name): string;
+begin
+ Result := X500StrToStr('CN',Value.commonName) +
+ X500StrToStr('C',Value.countryName) +
+ X500StrToStr('L',Value.localityName) +
+ X500StrToStr('ST',Value.stateOrProvinceName) +
+ X500StrToStr('O',Value.organizationName) +
+ X500StrToStr('OU',Value.organizationalUnitName) +
+ X500StrToStr('T',Value.title) +
+ X500StrToStr('N',Value.name) +
+ X500StrToStr('G',Value.givenName) +
+ X500StrToStr('I',Value.initials) +
+ X500StrToStr('SN',Value.surname) +
+ X500StrToStr('GQ',Value.generationQualifier) +
+ X500StrToStr('DNQ',Value.dnQualifier) +
+ X500StrToStr('E',Value.emailAddress);
+end;
+
+
+{==============================================================================}
+
+initialization
+ SSLImplementation := TSSLStreamSec;
+
+finalization
+
+end.
+
+
ADDED lib/synapse/source/lib/sslinux.inc
Index: lib/synapse/source/lib/sslinux.inc
==================================================================
--- /dev/null
+++ lib/synapse/source/lib/sslinux.inc
@@ -0,0 +1,1314 @@
+{==============================================================================|
+| Project : Ararat Synapse | 002.000.009 |
+|==============================================================================|
+| Content: Socket Independent Platform Layer - Linux definition include |
+|==============================================================================|
+| Copyright (c)1999-2010, Lukas Gebauer |
+| All rights reserved. |
+| |
+| Redistribution and use in source and binary forms, with or without |
+| modification, are permitted provided that the following conditions are met: |
+| |
+| Redistributions of source code must retain the above copyright notice, this |
+| list of conditions and the following disclaimer. |
+| |
+| Redistributions in binary form must reproduce the above copyright notice, |
+| this list of conditions and the following disclaimer in the documentation |
+| and/or other materials provided with the distribution. |
+| |
+| Neither the name of Lukas Gebauer nor the names of its contributors may |
+| be used to endorse or promote products derived from this software without |
+| specific prior written permission. |
+| |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
+| DAMAGE. |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2003-2010. |
+| All Rights Reserved. |
+|==============================================================================|
+| Contributor(s): |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package |
+| (Found at URL: http://www.ararat.cz/synapse/) |
+|==============================================================================}
+
+{:@exclude}
+
+{$IFDEF LINUX}
+
+//{$DEFINE FORCEOLDAPI}
+{Note about define FORCEOLDAPI:
+If you activate this compiler directive, then is allways used old socket API
+for name resolution. If you leave this directive inactive, then the new API
+is used, when running system allows it.
+
+For IPv6 support you must have new API!
+}
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+interface
+
+uses
+ SyncObjs, SysUtils, Classes,
+ synafpc,
+ Libc;
+
+function InitSocketInterface(stack: string): Boolean;
+function DestroySocketInterface: Boolean;
+
+const
+ WinsockLevel = $0202;
+
+type
+ u_char = Char;
+ u_short = Word;
+ u_int = Integer;
+ u_long = Longint;
+ pu_long = ^u_long;
+ pu_short = ^u_short;
+ TSocket = u_int;
+ TAddrFamily = integer;
+
+ TMemory = pointer;
+
+
+const
+ DLLStackName = 'libc.so.6';
+
+ cLocalhost = '127.0.0.1';
+ cAnyHost = '0.0.0.0';
+ cBroadcast = '255.255.255.255';
+ c6Localhost = '::1';
+ c6AnyHost = '::0';
+ c6Broadcast = 'ffff::1';
+ cAnyPort = '0';
+
+type
+ DWORD = Integer;
+ __fd_mask = LongWord;
+const
+ __FD_SETSIZE = 1024;
+ __NFDBITS = 8 * sizeof(__fd_mask);
+type
+ __fd_set = {packed} record
+ fds_bits: packed array[0..(__FD_SETSIZE div __NFDBITS)-1] of __fd_mask;
+ end;
+ TFDSet = __fd_set;
+ PFDSet = ^TFDSet;
+
+const
+ FIONREAD = $541B;
+ FIONBIO = $5421;
+ FIOASYNC = $5452;
+
+type
+ PTimeVal = ^TTimeVal;
+ TTimeVal = packed record
+ tv_sec: Longint;
+ tv_usec: Longint;
+ end;
+
+const
+ IPPROTO_IP = 0; { Dummy }
+ IPPROTO_ICMP = 1; { Internet Control Message Protocol }
+ IPPROTO_IGMP = 2; { Internet Group Management Protocol}
+ IPPROTO_TCP = 6; { TCP }
+ IPPROTO_UDP = 17; { User Datagram Protocol }
+ IPPROTO_IPV6 = 41;
+ IPPROTO_ICMPV6 = 58;
+ IPPROTO_RM = 113;
+
+ IPPROTO_RAW = 255;
+ IPPROTO_MAX = 256;
+
+type
+ PInAddr = ^TInAddr;
+ TInAddr = packed record
+ case integer of
+ 0: (S_bytes: packed array [0..3] of byte);
+ 1: (S_addr: u_long);
+ end;
+
+ PSockAddrIn = ^TSockAddrIn;
+ TSockAddrIn = packed record
+ case Integer of
+ 0: (sin_family: u_short;
+ sin_port: u_short;
+ sin_addr: TInAddr;
+ sin_zero: array[0..7] of Char);
+ 1: (sa_family: u_short;
+ sa_data: array[0..13] of Char)
+ end;
+
+ TIP_mreq = record
+ imr_multiaddr: TInAddr; { IP multicast address of group }
+ imr_interface: TInAddr; { local IP address of interface }
+ end;
+
+ PInAddr6 = ^TInAddr6;
+ TInAddr6 = packed record
+ case integer of
+ 0: (S6_addr: packed array [0..15] of byte);
+ 1: (u6_addr8: packed array [0..15] of byte);
+ 2: (u6_addr16: packed array [0..7] of word);
+ 3: (u6_addr32: packed array [0..3] of integer);
+ end;
+
+ PSockAddrIn6 = ^TSockAddrIn6;
+ TSockAddrIn6 = packed record
+ sin6_family: u_short; // AF_INET6
+ sin6_port: u_short; // Transport level port number
+ sin6_flowinfo: u_long; // IPv6 flow information
+ sin6_addr: TInAddr6; // IPv6 address
+ sin6_scope_id: u_long; // Scope Id: IF number for link-local
+ // SITE id for site-local
+ end;
+
+ TIPv6_mreq = record
+ ipv6mr_multiaddr: TInAddr6; // IPv6 multicast address.
+ ipv6mr_interface: integer; // Interface index.
+ padding: u_long;
+ end;
+
+ PHostEnt = ^THostEnt;
+ THostent = record
+ h_name: PChar;
+ h_aliases: PPChar;
+ h_addrtype: Integer;
+ h_length: Cardinal;
+ case Byte of
+ 0: (h_addr_list: PPChar);
+ 1: (h_addr: PPChar);
+ end;
+
+ PNetEnt = ^TNetEnt;
+ TNetEnt = record
+ n_name: PChar;
+ n_aliases: PPChar;
+ n_addrtype: Integer;
+ n_net: uint32_t;
+ end;
+
+ PServEnt = ^TServEnt;
+ TServEnt = record
+ s_name: PChar;
+ s_aliases: PPChar;
+ s_port: Integer;
+ s_proto: PChar;
+ end;
+
+ PProtoEnt = ^TProtoEnt;
+ TProtoEnt = record
+ p_name: PChar;
+ p_aliases: ^PChar;
+ p_proto: u_short;
+ end;
+
+const
+ INADDR_ANY = $00000000;
+ INADDR_LOOPBACK = $7F000001;
+ INADDR_BROADCAST = $FFFFFFFF;
+ INADDR_NONE = $FFFFFFFF;
+ ADDR_ANY = INADDR_ANY;
+ INVALID_SOCKET = TSocket(NOT(0));
+ SOCKET_ERROR = -1;
+
+Const
+ IP_TOS = 1; { int; IP type of service and precedence. }
+ IP_TTL = 2; { int; IP time to live. }
+ IP_HDRINCL = 3; { int; Header is included with data. }
+ IP_OPTIONS = 4; { ip_opts; IP per-packet options. }
+ IP_ROUTER_ALERT = 5; { bool }
+ IP_RECVOPTS = 6; { bool }
+ IP_RETOPTS = 7; { bool }
+ IP_PKTINFO = 8; { bool }
+ IP_PKTOPTIONS = 9;
+ IP_PMTUDISC = 10; { obsolete name? }
+ IP_MTU_DISCOVER = 10; { int; see below }
+ IP_RECVERR = 11; { bool }
+ IP_RECVTTL = 12; { bool }
+ IP_RECVTOS = 13; { bool }
+ IP_MULTICAST_IF = 32; { in_addr; set/get IP multicast i/f }
+ IP_MULTICAST_TTL = 33; { u_char; set/get IP multicast ttl }
+ IP_MULTICAST_LOOP = 34; { i_char; set/get IP multicast loopback }
+ IP_ADD_MEMBERSHIP = 35; { ip_mreq; add an IP group membership }
+ IP_DROP_MEMBERSHIP = 36; { ip_mreq; drop an IP group membership }
+
+ SOL_SOCKET = 1;
+
+ SO_DEBUG = 1;
+ SO_REUSEADDR = 2;
+ SO_TYPE = 3;
+ SO_ERROR = 4;
+ SO_DONTROUTE = 5;
+ SO_BROADCAST = 6;
+ SO_SNDBUF = 7;
+ SO_RCVBUF = 8;
+ SO_KEEPALIVE = 9;
+ SO_OOBINLINE = 10;
+ SO_NO_CHECK = 11;
+ SO_PRIORITY = 12;
+ SO_LINGER = 13;
+ SO_BSDCOMPAT = 14;
+ SO_REUSEPORT = 15;
+ SO_PASSCRED = 16;
+ SO_PEERCRED = 17;
+ SO_RCVLOWAT = 18;
+ SO_SNDLOWAT = 19;
+ SO_RCVTIMEO = 20;
+ SO_SNDTIMEO = 21;
+{ Security levels - as per NRL IPv6 - don't actually do anything }
+ SO_SECURITY_AUTHENTICATION = 22;
+ SO_SECURITY_ENCRYPTION_TRANSPORT = 23;
+ SO_SECURITY_ENCRYPTION_NETWORK = 24;
+ SO_BINDTODEVICE = 25;
+{ Socket filtering }
+ SO_ATTACH_FILTER = 26;
+ SO_DETACH_FILTER = 27;
+
+ SOMAXCONN = 128;
+
+ IPV6_UNICAST_HOPS = 16;
+ IPV6_MULTICAST_IF = 17;
+ IPV6_MULTICAST_HOPS = 18;
+ IPV6_MULTICAST_LOOP = 19;
+ IPV6_JOIN_GROUP = 20;
+ IPV6_LEAVE_GROUP = 21;
+
+ MSG_NOSIGNAL = $4000; // Do not generate SIGPIPE.
+
+ // getnameinfo constants
+ NI_MAXHOST = 1025;
+ NI_MAXSERV = 32;
+ NI_NOFQDN = $4;
+ NI_NUMERICHOST = $1;
+ NI_NAMEREQD = $8;
+ NI_NUMERICSERV = $2;
+ NI_DGRAM = $10;
+
+const
+ SOCK_STREAM = 1; { stream socket }
+ SOCK_DGRAM = 2; { datagram socket }
+ SOCK_RAW = 3; { raw-protocol interface }
+ SOCK_RDM = 4; { reliably-delivered message }
+ SOCK_SEQPACKET = 5; { sequenced packet stream }
+
+{ TCP options. }
+ TCP_NODELAY = $0001;
+
+{ Address families. }
+
+ AF_UNSPEC = 0; { unspecified }
+ AF_INET = 2; { internetwork: UDP, TCP, etc. }
+ AF_INET6 = 10; { Internetwork Version 6 }
+ AF_MAX = 24;
+
+{ Protocol families, same as address families for now. }
+ PF_UNSPEC = AF_UNSPEC;
+ PF_INET = AF_INET;
+ PF_INET6 = AF_INET6;
+ PF_MAX = AF_MAX;
+
+type
+ { Structure used by kernel to store most addresses. }
+ PSockAddr = ^TSockAddr;
+ TSockAddr = TSockAddrIn;
+
+ { Structure used by kernel to pass protocol information in raw sockets. }
+ PSockProto = ^TSockProto;
+ TSockProto = packed record
+ sp_family: u_short;
+ sp_protocol: u_short;
+ end;
+
+type
+ PAddrInfo = ^TAddrInfo;
+ TAddrInfo = record
+ ai_flags: integer; // AI_PASSIVE, AI_CANONNAME, AI_NUMERICHOST.
+ ai_family: integer; // PF_xxx.
+ ai_socktype: integer; // SOCK_xxx.
+ ai_protocol: integer; // 0 or IPPROTO_xxx for IPv4 and IPv6.
+ ai_addrlen: u_int; // Length of ai_addr.
+ ai_addr: PSockAddr; // Binary address.
+ ai_canonname: PChar; // Canonical name for nodename.
+ ai_next: PAddrInfo; // Next structure in linked list.
+ end;
+
+const
+ // Flags used in "hints" argument to getaddrinfo().
+ AI_PASSIVE = $1; // Socket address will be used in bind() call.
+ AI_CANONNAME = $2; // Return canonical name in first ai_canonname.
+ AI_NUMERICHOST = $4; // Nodename must be a numeric address string.
+
+type
+{ Structure used for manipulating linger option. }
+ PLinger = ^TLinger;
+ TLinger = packed record
+ l_onoff: integer;
+ l_linger: integer;
+ end;
+
+const
+
+ MSG_OOB = $01; // Process out-of-band data.
+ MSG_PEEK = $02; // Peek at incoming messages.
+
+const
+ WSAEINTR = EINTR;
+ WSAEBADF = EBADF;
+ WSAEACCES = EACCES;
+ WSAEFAULT = EFAULT;
+ WSAEINVAL = EINVAL;
+ WSAEMFILE = EMFILE;
+ WSAEWOULDBLOCK = EWOULDBLOCK;
+ WSAEINPROGRESS = EINPROGRESS;
+ WSAEALREADY = EALREADY;
+ WSAENOTSOCK = ENOTSOCK;
+ WSAEDESTADDRREQ = EDESTADDRREQ;
+ WSAEMSGSIZE = EMSGSIZE;
+ WSAEPROTOTYPE = EPROTOTYPE;
+ WSAENOPROTOOPT = ENOPROTOOPT;
+ WSAEPROTONOSUPPORT = EPROTONOSUPPORT;
+ WSAESOCKTNOSUPPORT = ESOCKTNOSUPPORT;
+ WSAEOPNOTSUPP = EOPNOTSUPP;
+ WSAEPFNOSUPPORT = EPFNOSUPPORT;
+ WSAEAFNOSUPPORT = EAFNOSUPPORT;
+ WSAEADDRINUSE = EADDRINUSE;
+ WSAEADDRNOTAVAIL = EADDRNOTAVAIL;
+ WSAENETDOWN = ENETDOWN;
+ WSAENETUNREACH = ENETUNREACH;
+ WSAENETRESET = ENETRESET;
+ WSAECONNABORTED = ECONNABORTED;
+ WSAECONNRESET = ECONNRESET;
+ WSAENOBUFS = ENOBUFS;
+ WSAEISCONN = EISCONN;
+ WSAENOTCONN = ENOTCONN;
+ WSAESHUTDOWN = ESHUTDOWN;
+ WSAETOOMANYREFS = ETOOMANYREFS;
+ WSAETIMEDOUT = ETIMEDOUT;
+ WSAECONNREFUSED = ECONNREFUSED;
+ WSAELOOP = ELOOP;
+ WSAENAMETOOLONG = ENAMETOOLONG;
+ WSAEHOSTDOWN = EHOSTDOWN;
+ WSAEHOSTUNREACH = EHOSTUNREACH;
+ WSAENOTEMPTY = ENOTEMPTY;
+ WSAEPROCLIM = -1;
+ WSAEUSERS = EUSERS;
+ WSAEDQUOT = EDQUOT;
+ WSAESTALE = ESTALE;
+ WSAEREMOTE = EREMOTE;
+ WSASYSNOTREADY = -2;
+ WSAVERNOTSUPPORTED = -3;
+ WSANOTINITIALISED = -4;
+ WSAEDISCON = -5;
+ WSAHOST_NOT_FOUND = HOST_NOT_FOUND;
+ WSATRY_AGAIN = TRY_AGAIN;
+ WSANO_RECOVERY = NO_RECOVERY;
+ WSANO_DATA = -6;
+
+ EAI_BADFLAGS = -1; { Invalid value for `ai_flags' field. }
+ EAI_NONAME = -2; { NAME or SERVICE is unknown. }
+ EAI_AGAIN = -3; { Temporary failure in name resolution. }
+ EAI_FAIL = -4; { Non-recoverable failure in name res. }
+ EAI_NODATA = -5; { No address associated with NAME. }
+ EAI_FAMILY = -6; { `ai_family' not supported. }
+ EAI_SOCKTYPE = -7; { `ai_socktype' not supported. }
+ EAI_SERVICE = -8; { SERVICE not supported for `ai_socktype'. }
+ EAI_ADDRFAMILY = -9; { Address family for NAME not supported. }
+ EAI_MEMORY = -10; { Memory allocation failure. }
+ EAI_SYSTEM = -11; { System error returned in `errno'. }
+
+const
+ WSADESCRIPTION_LEN = 256;
+ WSASYS_STATUS_LEN = 128;
+type
+ PWSAData = ^TWSAData;
+ TWSAData = packed record
+ wVersion: Word;
+ wHighVersion: Word;
+ szDescription: array[0..WSADESCRIPTION_LEN] of Char;
+ szSystemStatus: array[0..WSASYS_STATUS_LEN] of Char;
+ iMaxSockets: Word;
+ iMaxUdpDg: Word;
+ lpVendorInfo: PChar;
+ end;
+
+ function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean;
+ function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean;
+ function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean;
+ function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean;
+ function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean;
+ function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6):boolean;
+ procedure SET_IN6_IF_ADDR_ANY (const a: PInAddr6);
+ procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6);
+var
+ in6addr_any, in6addr_loopback : TInAddr6;
+
+procedure FD_CLR(Socket: TSocket; var FDSet: TFDSet);
+function FD_ISSET(Socket: TSocket; var FDSet: TFDSet): Boolean;
+procedure FD_SET(Socket: TSocket; var FDSet: TFDSet);
+procedure FD_ZERO(var FDSet: TFDSet);
+
+{=============================================================================}
+
+type
+ TWSAStartup = function(wVersionRequired: Word; var WSData: TWSAData): Integer;
+ cdecl;
+ TWSACleanup = function: Integer;
+ cdecl;
+ TWSAGetLastError = function: Integer;
+ cdecl;
+ TGetServByName = function(name, proto: PChar): PServEnt;
+ cdecl;
+ TGetServByPort = function(port: Integer; proto: PChar): PServEnt;
+ cdecl;
+ TGetProtoByName = function(name: PChar): PProtoEnt;
+ cdecl;
+ TGetProtoByNumber = function(proto: Integer): PProtoEnt;
+ cdecl;
+ TGetHostByName = function(name: PChar): PHostEnt;
+ cdecl;
+ TGetHostByAddr = function(addr: Pointer; len, Struc: Integer): PHostEnt;
+ cdecl;
+ TGetHostName = function(name: PChar; len: Integer): Integer;
+ cdecl;
+ TShutdown = function(s: TSocket; how: Integer): Integer;
+ cdecl;
+ TSetSockOpt = function(s: TSocket; level, optname: Integer; optval: PChar;
+ optlen: Integer): Integer;
+ cdecl;
+ TGetSockOpt = function(s: TSocket; level, optname: Integer; optval: PChar;
+ var optlen: Integer): Integer;
+ cdecl;
+ TSendTo = function(s: TSocket; const Buf; len, flags: Integer; addrto: PSockAddr;
+ tolen: Integer): Integer;
+ cdecl;
+ TSend = function(s: TSocket; const Buf; len, flags: Integer): Integer;
+ cdecl;
+ TRecv = function(s: TSocket; var Buf; len, flags: Integer): Integer;
+ cdecl;
+ TRecvFrom = function(s: TSocket; var Buf; len, flags: Integer; from: PSockAddr;
+ var fromlen: Integer): Integer;
+ cdecl;
+ Tntohs = function(netshort: u_short): u_short;
+ cdecl;
+ Tntohl = function(netlong: u_long): u_long;
+ cdecl;
+ TListen = function(s: TSocket; backlog: Integer): Integer;
+ cdecl;
+ TIoctlSocket = function(s: TSocket; cmd: DWORD; var arg: integer): Integer;
+ cdecl;
+ TInet_ntoa = function(inaddr: TInAddr): PChar;
+ cdecl;
+ TInet_addr = function(cp: PChar): u_long;
+ cdecl;
+ Thtons = function(hostshort: u_short): u_short;
+ cdecl;
+ Thtonl = function(hostlong: u_long): u_long;
+ cdecl;
+ TGetSockName = function(s: TSocket; name: PSockAddr; var namelen: Integer): Integer;
+ cdecl;
+ TGetPeerName = function(s: TSocket; name: PSockAddr; var namelen: Integer): Integer;
+ cdecl;
+ TConnect = function(s: TSocket; name: PSockAddr; namelen: Integer): Integer;
+ cdecl;
+ TCloseSocket = function(s: TSocket): Integer;
+ cdecl;
+ TBind = function(s: TSocket; addr: PSockAddr; namelen: Integer): Integer;
+ cdecl;
+ TAccept = function(s: TSocket; addr: PSockAddr; var addrlen: Integer): TSocket;
+ cdecl;
+ TTSocket = function(af, Struc, Protocol: Integer): TSocket;
+ cdecl;
+ TSelect = function(nfds: Integer; readfds, writefds, exceptfds: PFDSet;
+ timeout: PTimeVal): Longint;
+ cdecl;
+
+ TGetAddrInfo = function(NodeName: PChar; ServName: PChar; Hints: PAddrInfo;
+ var Addrinfo: PAddrInfo): integer;
+ cdecl;
+ TFreeAddrInfo = procedure(ai: PAddrInfo);
+ cdecl;
+ TGetNameInfo = function( addr: PSockAddr; namelen: Integer; host: PChar;
+ hostlen: DWORD; serv: PChar; servlen: DWORD; flags: integer): integer;
+ cdecl;
+
+var
+ WSAStartup: TWSAStartup = nil;
+ WSACleanup: TWSACleanup = nil;
+ WSAGetLastError: TWSAGetLastError = nil;
+ GetServByName: TGetServByName = nil;
+ GetServByPort: TGetServByPort = nil;
+ GetProtoByName: TGetProtoByName = nil;
+ GetProtoByNumber: TGetProtoByNumber = nil;
+ GetHostByName: TGetHostByName = nil;
+ GetHostByAddr: TGetHostByAddr = nil;
+ ssGetHostName: TGetHostName = nil;
+ Shutdown: TShutdown = nil;
+ SetSockOpt: TSetSockOpt = nil;
+ GetSockOpt: TGetSockOpt = nil;
+ ssSendTo: TSendTo = nil;
+ ssSend: TSend = nil;
+ ssRecv: TRecv = nil;
+ ssRecvFrom: TRecvFrom = nil;
+ ntohs: Tntohs = nil;
+ ntohl: Tntohl = nil;
+ Listen: TListen = nil;
+ IoctlSocket: TIoctlSocket = nil;
+ Inet_ntoa: TInet_ntoa = nil;
+ Inet_addr: TInet_addr = nil;
+ htons: Thtons = nil;
+ htonl: Thtonl = nil;
+ ssGetSockName: TGetSockName = nil;
+ ssGetPeerName: TGetPeerName = nil;
+ ssConnect: TConnect = nil;
+ CloseSocket: TCloseSocket = nil;
+ ssBind: TBind = nil;
+ ssAccept: TAccept = nil;
+ Socket: TTSocket = nil;
+ Select: TSelect = nil;
+
+ GetAddrInfo: TGetAddrInfo = nil;
+ FreeAddrInfo: TFreeAddrInfo = nil;
+ GetNameInfo: TGetNameInfo = nil;
+
+function LSWSAStartup(wVersionRequired: Word; var WSData: TWSAData): Integer; cdecl;
+function LSWSACleanup: Integer; cdecl;
+function LSWSAGetLastError: Integer; cdecl;
+
+var
+ SynSockCS: SyncObjs.TCriticalSection;
+ SockEnhancedApi: Boolean;
+ SockWship6Api: Boolean;
+
+type
+ TVarSin = packed record
+ case integer of
+ 0: (AddressFamily: u_short);
+ 1: (
+ case sin_family: u_short of
+ AF_INET: (sin_port: u_short;
+ sin_addr: TInAddr;
+ sin_zero: array[0..7] of Char);
+ AF_INET6: (sin6_port: u_short;
+ sin6_flowinfo: u_long;
+ sin6_addr: TInAddr6;
+ sin6_scope_id: u_long);
+ );
+ end;
+
+function SizeOfVarSin(sin: TVarSin): integer;
+
+function Bind(s: TSocket; const addr: TVarSin): Integer;
+function Connect(s: TSocket; const name: TVarSin): Integer;
+function GetSockName(s: TSocket; var name: TVarSin): Integer;
+function GetPeerName(s: TSocket; var name: TVarSin): Integer;
+function GetHostName: string;
+function Send(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
+function Recv(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
+function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin): Integer;
+function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer;
+function Accept(s: TSocket; var addr: TVarSin): TSocket;
+
+function IsNewApi(Family: integer): Boolean;
+function SetVarSin(var Sin: TVarSin; IP, Port: string; Family, SockProtocol, SockType: integer; PreferIP4: Boolean): integer;
+function GetSinIP(Sin: TVarSin): string;
+function GetSinPort(Sin: TVarSin): Integer;
+procedure ResolveNameToIP(Name: string; Family, SockProtocol, SockType: integer; const IPList: TStrings);
+function ResolveIPToName(IP: string; Family, SockProtocol, SockType: integer): string;
+function ResolvePort(Port: string; Family, SockProtocol, SockType: integer): Word;
+
+{==============================================================================}
+implementation
+
+var
+ SynSockCount: Integer = 0;
+ LibHandle: TLibHandle = 0;
+ Libwship6Handle: TLibHandle = 0;
+
+function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean;
+begin
+ Result := ((a^.u6_addr32[0] = 0) and (a^.u6_addr32[1] = 0) and
+ (a^.u6_addr32[2] = 0) and (a^.u6_addr32[3] = 0));
+end;
+
+function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean;
+begin
+ Result := ((a^.u6_addr32[0] = 0) and (a^.u6_addr32[1] = 0) and
+ (a^.u6_addr32[2] = 0) and
+ (a^.u6_addr8[12] = 0) and (a^.u6_addr8[13] = 0) and
+ (a^.u6_addr8[14] = 0) and (a^.u6_addr8[15] = 1));
+end;
+
+function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean;
+begin
+ Result := ((a^.u6_addr8[0] = $FE) and (a^.u6_addr8[1] = $80));
+end;
+
+function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean;
+begin
+ Result := ((a^.u6_addr8[0] = $FE) and (a^.u6_addr8[1] = $C0));
+end;
+
+function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean;
+begin
+ Result := (a^.u6_addr8[0] = $FF);
+end;
+
+function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6): boolean;
+begin
+ Result := (CompareMem( a, b, sizeof(TInAddr6)));
+end;
+
+procedure SET_IN6_IF_ADDR_ANY (const a: PInAddr6);
+begin
+ FillChar(a^, sizeof(TInAddr6), 0);
+end;
+
+procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6);
+begin
+ FillChar(a^, sizeof(TInAddr6), 0);
+ a^.u6_addr8[15] := 1;
+end;
+
+{=============================================================================}
+var
+{$IFNDEF VER1_0} //FTP version 1.0.x
+ errno_loc: function: PInteger cdecl = nil;
+{$ELSE}
+ errno_loc: function: PInteger = nil; cdecl;
+{$ENDIF}
+
+function LSWSAStartup(wVersionRequired: Word; var WSData: TWSAData): Integer;
+begin
+ with WSData do
+ begin
+ wVersion := wVersionRequired;
+ wHighVersion := $202;
+ szDescription := 'Synsock - Synapse Platform Independent Socket Layer';
+ szSystemStatus := 'Running on Linux';
+ iMaxSockets := 32768;
+ iMaxUdpDg := 8192;
+ end;
+ Result := 0;
+end;
+
+function LSWSACleanup: Integer;
+begin
+ Result := 0;
+end;
+
+function LSWSAGetLastError: Integer;
+var
+ p: PInteger;
+begin
+ p := errno_loc;
+ Result := p^;
+end;
+
+function __FDELT(Socket: TSocket): Integer;
+begin
+ Result := Socket div __NFDBITS;
+end;
+
+function __FDMASK(Socket: TSocket): __fd_mask;
+begin
+ Result := LongWord(1) shl (Socket mod __NFDBITS);
+end;
+
+function FD_ISSET(Socket: TSocket; var fdset: TFDSet): Boolean;
+begin
+ Result := (fdset.fds_bits[__FDELT(Socket)] and __FDMASK(Socket)) <> 0;
+end;
+
+procedure FD_SET(Socket: TSocket; var fdset: TFDSet);
+begin
+ fdset.fds_bits[__FDELT(Socket)] := fdset.fds_bits[__FDELT(Socket)] or __FDMASK(Socket);
+end;
+
+procedure FD_CLR(Socket: TSocket; var fdset: TFDSet);
+begin
+ fdset.fds_bits[__FDELT(Socket)] := fdset.fds_bits[__FDELT(Socket)] and (not __FDMASK(Socket));
+end;
+
+procedure FD_ZERO(var fdset: TFDSet);
+var
+ I: Integer;
+begin
+ with fdset do
+ for I := Low(fds_bits) to High(fds_bits) do
+ fds_bits[I] := 0;
+end;
+
+{=============================================================================}
+
+function SizeOfVarSin(sin: TVarSin): integer;
+begin
+ case sin.sin_family of
+ AF_INET:
+ Result := SizeOf(TSockAddrIn);
+ AF_INET6:
+ Result := SizeOf(TSockAddrIn6);
+ else
+ Result := 0;
+ end;
+end;
+
+{=============================================================================}
+
+function Bind(s: TSocket; const addr: TVarSin): Integer;
+begin
+ Result := ssBind(s, @addr, SizeOfVarSin(addr));
+end;
+
+function Connect(s: TSocket; const name: TVarSin): Integer;
+begin
+ Result := ssConnect(s, @name, SizeOfVarSin(name));
+end;
+
+function GetSockName(s: TSocket; var name: TVarSin): Integer;
+var
+ len: integer;
+begin
+ len := SizeOf(name);
+ FillChar(name, len, 0);
+ Result := ssGetSockName(s, @name, Len);
+end;
+
+function GetPeerName(s: TSocket; var name: TVarSin): Integer;
+var
+ len: integer;
+begin
+ len := SizeOf(name);
+ FillChar(name, len, 0);
+ Result := ssGetPeerName(s, @name, Len);
+end;
+
+function GetHostName: string;
+var
+ s: string;
+begin
+ Result := '';
+ setlength(s, 255);
+ ssGetHostName(pchar(s), Length(s) - 1);
+ Result := Pchar(s);
+end;
+
+function Send(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
+begin
+ Result := ssSend(s, Buf^, len, flags);
+end;
+
+function Recv(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
+begin
+ Result := ssRecv(s, Buf^, len, flags);
+end;
+
+function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin): Integer;
+begin
+ Result := ssSendTo(s, Buf^, len, flags, @addrto, SizeOfVarSin(addrto));
+end;
+
+function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer;
+var
+ x: integer;
+begin
+ x := SizeOf(from);
+ Result := ssRecvFrom(s, Buf^, len, flags, @from, x);
+end;
+
+function Accept(s: TSocket; var addr: TVarSin): TSocket;
+var
+ x: integer;
+begin
+ x := SizeOf(addr);
+ Result := ssAccept(s, @addr, x);
+end;
+
+{=============================================================================}
+function IsNewApi(Family: integer): Boolean;
+begin
+ Result := SockEnhancedApi;
+ if not Result then
+ Result := (Family = AF_INET6) and SockWship6Api;
+end;
+
+function SetVarSin(var Sin: TVarSin; IP, Port: string; Family, SockProtocol, SockType: integer; PreferIP4: Boolean): integer;
+type
+ pu_long = ^u_long;
+var
+ ProtoEnt: PProtoEnt;
+ ServEnt: PServEnt;
+ HostEnt: PHostEnt;
+ r: integer;
+ Hints1, Hints2: TAddrInfo;
+ Sin1, Sin2: TVarSin;
+ TwoPass: boolean;
+
+ function GetAddr(const IP, port: string; Hints: TAddrInfo; var Sin: TVarSin): integer;
+ var
+ Addr: PAddrInfo;
+ begin
+ Addr := nil;
+ try
+ FillChar(Sin, Sizeof(Sin), 0);
+ if Hints.ai_socktype = SOCK_RAW then
+ begin
+ Hints.ai_socktype := 0;
+ Hints.ai_protocol := 0;
+ Result := synsock.GetAddrInfo(PChar(IP), nil, @Hints, Addr);
+ end
+ else
+ begin
+ if (IP = cAnyHost) or (IP = c6AnyHost) then
+ begin
+ Hints.ai_flags := AI_PASSIVE;
+ Result := synsock.GetAddrInfo(nil, PChar(Port), @Hints, Addr);
+ end
+ else
+ if (IP = cLocalhost) or (IP = c6Localhost) then
+ begin
+ Result := synsock.GetAddrInfo(nil, PChar(Port), @Hints, Addr);
+ end
+ else
+ begin
+ Result := synsock.GetAddrInfo(PChar(IP), PChar(Port), @Hints, Addr);
+ end;
+ end;
+ if Result = 0 then
+ if (Addr <> nil) then
+ Move(Addr^.ai_addr^, Sin, Addr^.ai_addrlen);
+ finally
+ if Assigned(Addr) then
+ synsock.FreeAddrInfo(Addr);
+ end;
+ end;
+
+begin
+ Result := 0;
+ FillChar(Sin, Sizeof(Sin), 0);
+ if not IsNewApi(family) then
+ begin
+ SynSockCS.Enter;
+ try
+ Sin.sin_family := AF_INET;
+ ProtoEnt := synsock.GetProtoByNumber(SockProtocol);
+ ServEnt := nil;
+ if ProtoEnt <> nil then
+ ServEnt := synsock.GetServByName(PChar(Port), ProtoEnt^.p_name);
+ if ServEnt = nil then
+ Sin.sin_port := synsock.htons(StrToIntDef(Port, 0))
+ else
+ Sin.sin_port := ServEnt^.s_port;
+ if IP = cBroadcast then
+ Sin.sin_addr.s_addr := u_long(INADDR_BROADCAST)
+ else
+ begin
+ Sin.sin_addr.s_addr := synsock.inet_addr(PChar(IP));
+ if Sin.sin_addr.s_addr = u_long(INADDR_NONE) then
+ begin
+ HostEnt := synsock.GetHostByName(PChar(IP));
+ Result := synsock.WSAGetLastError;
+ if HostEnt <> nil then
+ Sin.sin_addr.S_addr := u_long(Pu_long(HostEnt^.h_addr_list^)^);
+ end;
+ end;
+ finally
+ SynSockCS.Leave;
+ end;
+ end
+ else
+ begin
+ FillChar(Hints1, Sizeof(Hints1), 0);
+ FillChar(Hints2, Sizeof(Hints2), 0);
+ TwoPass := False;
+ if Family = AF_UNSPEC then
+ begin
+ if PreferIP4 then
+ begin
+ Hints1.ai_family := AF_INET;
+ Hints2.ai_family := AF_INET6;
+ TwoPass := True;
+ end
+ else
+ begin
+ Hints2.ai_family := AF_INET;
+ Hints1.ai_family := AF_INET6;
+ TwoPass := True;
+ end;
+ end
+ else
+ Hints1.ai_family := Family;
+
+ Hints1.ai_socktype := SockType;
+ Hints1.ai_protocol := SockProtocol;
+ Hints2.ai_socktype := Hints1.ai_socktype;
+ Hints2.ai_protocol := Hints1.ai_protocol;
+
+ r := GetAddr(IP, Port, Hints1, Sin1);
+ Result := r;
+ sin := sin1;
+ if r <> 0 then
+ if TwoPass then
+ begin
+ r := GetAddr(IP, Port, Hints2, Sin2);
+ Result := r;
+ if r = 0 then
+ sin := sin2;
+ end;
+ end;
+end;
+
+function GetSinIP(Sin: TVarSin): string;
+var
+ p: PChar;
+ host, serv: string;
+ hostlen, servlen: integer;
+ r: integer;
+begin
+ Result := '';
+ if not IsNewApi(Sin.AddressFamily) then
+ begin
+ p := synsock.inet_ntoa(Sin.sin_addr);
+ if p <> nil then
+ Result := p;
+ end
+ else
+ begin
+ hostlen := NI_MAXHOST;
+ servlen := NI_MAXSERV;
+ setlength(host, hostlen);
+ setlength(serv, servlen);
+ r := getnameinfo(@sin, SizeOfVarSin(sin), PChar(host), hostlen,
+ PChar(serv), servlen, NI_NUMERICHOST + NI_NUMERICSERV);
+ if r = 0 then
+ Result := PChar(host);
+ end;
+end;
+
+function GetSinPort(Sin: TVarSin): Integer;
+begin
+ if (Sin.sin_family = AF_INET6) then
+ Result := synsock.ntohs(Sin.sin6_port)
+ else
+ Result := synsock.ntohs(Sin.sin_port);
+end;
+
+procedure ResolveNameToIP(Name: string; Family, SockProtocol, SockType: integer; const IPList: TStrings);
+type
+ TaPInAddr = array[0..250] of PInAddr;
+ PaPInAddr = ^TaPInAddr;
+var
+ Hints: TAddrInfo;
+ Addr: PAddrInfo;
+ AddrNext: PAddrInfo;
+ r: integer;
+ host, serv: string;
+ hostlen, servlen: integer;
+ RemoteHost: PHostEnt;
+ IP: u_long;
+ PAdrPtr: PaPInAddr;
+ i: Integer;
+ s: string;
+ InAddr: TInAddr;
+begin
+ IPList.Clear;
+ if not IsNewApi(Family) then
+ begin
+ IP := synsock.inet_addr(PChar(Name));
+ if IP = u_long(INADDR_NONE) then
+ begin
+ SynSockCS.Enter;
+ try
+ RemoteHost := synsock.GetHostByName(PChar(Name));
+ if RemoteHost <> nil then
+ begin
+ PAdrPtr := PAPInAddr(RemoteHost^.h_addr_list);
+ i := 0;
+ while PAdrPtr^[i] <> nil do
+ begin
+ InAddr := PAdrPtr^[i]^;
+ s := Format('%d.%d.%d.%d', [InAddr.S_bytes[0], InAddr.S_bytes[1],
+ InAddr.S_bytes[2], InAddr.S_bytes[3]]);
+ IPList.Add(s);
+ Inc(i);
+ end;
+ end;
+ finally
+ SynSockCS.Leave;
+ end;
+ end
+ else
+ IPList.Add(Name);
+ end
+ else
+ begin
+ Addr := nil;
+ try
+ FillChar(Hints, Sizeof(Hints), 0);
+ Hints.ai_family := AF_UNSPEC;
+ Hints.ai_socktype := SockType;
+ Hints.ai_protocol := SockProtocol;
+ Hints.ai_flags := 0;
+ r := synsock.GetAddrInfo(PChar(Name), nil, @Hints, Addr);
+ if r = 0 then
+ begin
+ AddrNext := Addr;
+ while not(AddrNext = nil) do
+ begin
+ if not(((Family = AF_INET6) and (AddrNext^.ai_family = AF_INET))
+ or ((Family = AF_INET) and (AddrNext^.ai_family = AF_INET6))) then
+ begin
+ hostlen := NI_MAXHOST;
+ servlen := NI_MAXSERV;
+ setlength(host, hostlen);
+ setlength(serv, servlen);
+ r := getnameinfo(AddrNext^.ai_addr, AddrNext^.ai_addrlen,
+ PChar(host), hostlen, PChar(serv), servlen,
+ NI_NUMERICHOST + NI_NUMERICSERV);
+ if r = 0 then
+ begin
+ host := PChar(host);
+ IPList.Add(host);
+ end;
+ end;
+ AddrNext := AddrNext^.ai_next;
+ end;
+ end;
+ finally
+ if Assigned(Addr) then
+ synsock.FreeAddrInfo(Addr);
+ end;
+ end;
+ if IPList.Count = 0 then
+ IPList.Add(cAnyHost);
+end;
+
+function ResolvePort(Port: string; Family, SockProtocol, SockType: integer): Word;
+var
+ ProtoEnt: PProtoEnt;
+ ServEnt: PServEnt;
+ Hints: TAddrInfo;
+ Addr: PAddrInfo;
+ r: integer;
+begin
+ Result := 0;
+ if not IsNewApi(Family) then
+ begin
+ SynSockCS.Enter;
+ try
+ ProtoEnt := synsock.GetProtoByNumber(SockProtocol);
+ ServEnt := nil;
+ if ProtoEnt <> nil then
+ ServEnt := synsock.GetServByName(PChar(Port), ProtoEnt^.p_name);
+ if ServEnt = nil then
+ Result := StrToIntDef(Port, 0)
+ else
+ Result := synsock.htons(ServEnt^.s_port);
+ finally
+ SynSockCS.Leave;
+ end;
+ end
+ else
+ begin
+ Addr := nil;
+ try
+ FillChar(Hints, Sizeof(Hints), 0);
+ Hints.ai_family := AF_UNSPEC;
+ Hints.ai_socktype := SockType;
+ Hints.ai_protocol := Sockprotocol;
+ Hints.ai_flags := AI_PASSIVE;
+ r := synsock.GetAddrInfo(nil, PChar(Port), @Hints, Addr);
+ if (r = 0) and Assigned(Addr) then
+ begin
+ if Addr^.ai_family = AF_INET then
+ Result := synsock.htons(Addr^.ai_addr^.sin_port);
+ if Addr^.ai_family = AF_INET6 then
+ Result := synsock.htons(PSockAddrIn6(Addr^.ai_addr)^.sin6_port);
+ end;
+ finally
+ if Assigned(Addr) then
+ synsock.FreeAddrInfo(Addr);
+ end;
+ end;
+end;
+
+function ResolveIPToName(IP: string; Family, SockProtocol, SockType: integer): string;
+var
+ Hints: TAddrInfo;
+ Addr: PAddrInfo;
+ r: integer;
+ host, serv: string;
+ hostlen, servlen: integer;
+ RemoteHost: PHostEnt;
+ IPn: u_long;
+begin
+ Result := IP;
+ if not IsNewApi(Family) then
+ begin
+ IPn := synsock.inet_addr(PChar(IP));
+ if IPn <> u_long(INADDR_NONE) then
+ begin
+ SynSockCS.Enter;
+ try
+ RemoteHost := GetHostByAddr(@IPn, SizeOf(IPn), AF_INET);
+ if RemoteHost <> nil then
+ Result := RemoteHost^.h_name;
+ finally
+ SynSockCS.Leave;
+ end;
+ end;
+ end
+ else
+ begin
+ Addr := nil;
+ try
+ FillChar(Hints, Sizeof(Hints), 0);
+ Hints.ai_family := AF_UNSPEC;
+ Hints.ai_socktype := SockType;
+ Hints.ai_protocol := SockProtocol;
+ Hints.ai_flags := 0;
+ r := synsock.GetAddrInfo(PChar(IP), nil, @Hints, Addr);
+ if (r = 0) and Assigned(Addr)then
+ begin
+ hostlen := NI_MAXHOST;
+ servlen := NI_MAXSERV;
+ setlength(host, hostlen);
+ setlength(serv, servlen);
+ r := getnameinfo(Addr^.ai_addr, Addr^.ai_addrlen,
+ PChar(host), hostlen, PChar(serv), servlen,
+ NI_NUMERICSERV);
+ if r = 0 then
+ Result := PChar(host);
+ end;
+ finally
+ if Assigned(Addr) then
+ synsock.FreeAddrInfo(Addr);
+ end;
+ end;
+end;
+
+{=============================================================================}
+
+function InitSocketInterface(stack: string): Boolean;
+begin
+ Result := False;
+ SockEnhancedApi := False;
+ if stack = '' then
+ stack := DLLStackName;
+ SynSockCS.Enter;
+ try
+ if SynSockCount = 0 then
+ begin
+ SockEnhancedApi := False;
+ SockWship6Api := False;
+ Libc.Signal(Libc.SIGPIPE, TSignalHandler(Libc.SIG_IGN));
+ LibHandle := LoadLibrary(PChar(Stack));
+ if LibHandle <> 0 then
+ begin
+ errno_loc := GetProcAddress(LibHandle, PChar('__errno_location'));
+ CloseSocket := GetProcAddress(LibHandle, PChar('close'));
+ IoctlSocket := GetProcAddress(LibHandle, PChar('ioctl'));
+ WSAGetLastError := LSWSAGetLastError;
+ WSAStartup := LSWSAStartup;
+ WSACleanup := LSWSACleanup;
+ ssAccept := GetProcAddress(LibHandle, PChar('accept'));
+ ssBind := GetProcAddress(LibHandle, PChar('bind'));
+ ssConnect := GetProcAddress(LibHandle, PChar('connect'));
+ ssGetPeerName := GetProcAddress(LibHandle, PChar('getpeername'));
+ ssGetSockName := GetProcAddress(LibHandle, PChar('getsockname'));
+ GetSockOpt := GetProcAddress(LibHandle, PChar('getsockopt'));
+ Htonl := GetProcAddress(LibHandle, PChar('htonl'));
+ Htons := GetProcAddress(LibHandle, PChar('htons'));
+ Inet_Addr := GetProcAddress(LibHandle, PChar('inet_addr'));
+ Inet_Ntoa := GetProcAddress(LibHandle, PChar('inet_ntoa'));
+ Listen := GetProcAddress(LibHandle, PChar('listen'));
+ Ntohl := GetProcAddress(LibHandle, PChar('ntohl'));
+ Ntohs := GetProcAddress(LibHandle, PChar('ntohs'));
+ ssRecv := GetProcAddress(LibHandle, PChar('recv'));
+ ssRecvFrom := GetProcAddress(LibHandle, PChar('recvfrom'));
+ Select := GetProcAddress(LibHandle, PChar('select'));
+ ssSend := GetProcAddress(LibHandle, PChar('send'));
+ ssSendTo := GetProcAddress(LibHandle, PChar('sendto'));
+ SetSockOpt := GetProcAddress(LibHandle, PChar('setsockopt'));
+ ShutDown := GetProcAddress(LibHandle, PChar('shutdown'));
+ Socket := GetProcAddress(LibHandle, PChar('socket'));
+ GetHostByAddr := GetProcAddress(LibHandle, PChar('gethostbyaddr'));
+ GetHostByName := GetProcAddress(LibHandle, PChar('gethostbyname'));
+ GetProtoByName := GetProcAddress(LibHandle, PChar('getprotobyname'));
+ GetProtoByNumber := GetProcAddress(LibHandle, PChar('getprotobynumber'));
+ GetServByName := GetProcAddress(LibHandle, PChar('getservbyname'));
+ GetServByPort := GetProcAddress(LibHandle, PChar('getservbyport'));
+ ssGetHostName := GetProcAddress(LibHandle, PChar('gethostname'));
+
+{$IFNDEF FORCEOLDAPI}
+ GetAddrInfo := GetProcAddress(LibHandle, PChar('getaddrinfo'));
+ FreeAddrInfo := GetProcAddress(LibHandle, PChar('freeaddrinfo'));
+ GetNameInfo := GetProcAddress(LibHandle, PChar('getnameinfo'));
+ SockEnhancedApi := Assigned(GetAddrInfo) and Assigned(FreeAddrInfo)
+ and Assigned(GetNameInfo);
+{$ENDIF}
+ Result := True;
+ end;
+ end
+ else Result := True;
+ if Result then
+ Inc(SynSockCount);
+ finally
+ SynSockCS.Leave;
+ end;
+end;
+
+function DestroySocketInterface: Boolean;
+begin
+ SynSockCS.Enter;
+ try
+ Dec(SynSockCount);
+ if SynSockCount < 0 then
+ SynSockCount := 0;
+ if SynSockCount = 0 then
+ begin
+ if LibHandle <> 0 then
+ begin
+ FreeLibrary(libHandle);
+ LibHandle := 0;
+ end;
+ if LibWship6Handle <> 0 then
+ begin
+ FreeLibrary(LibWship6Handle);
+ LibWship6Handle := 0;
+ end;
+ end;
+ finally
+ SynSockCS.Leave;
+ end;
+ Result := True;
+end;
+
+initialization
+begin
+ SynSockCS := SyncObjs.TCriticalSection.Create;
+ SET_IN6_IF_ADDR_ANY (@in6addr_any);
+ SET_LOOPBACK_ADDR6 (@in6addr_loopback);
+end;
+
+finalization
+begin
+ SynSockCS.Free;
+end;
+
+{$ENDIF}
+
ADDED lib/synapse/source/lib/sswin32.inc
Index: lib/synapse/source/lib/sswin32.inc
==================================================================
--- /dev/null
+++ lib/synapse/source/lib/sswin32.inc
@@ -0,0 +1,1615 @@
+{==============================================================================|
+| Project : Ararat Synapse | 002.003.000 |
+|==============================================================================|
+| Content: Socket Independent Platform Layer - Win32/64 definition include |
+|==============================================================================|
+| Copyright (c)1999-2011, Lukas Gebauer |
+| All rights reserved. |
+| |
+| Redistribution and use in source and binary forms, with or without |
+| modification, are permitted provided that the following conditions are met: |
+| |
+| Redistributions of source code must retain the above copyright notice, this |
+| list of conditions and the following disclaimer. |
+| |
+| Redistributions in binary form must reproduce the above copyright notice, |
+| this list of conditions and the following disclaimer in the documentation |
+| and/or other materials provided with the distribution. |
+| |
+| Neither the name of Lukas Gebauer nor the names of its contributors may |
+| be used to endorse or promote products derived from this software without |
+| specific prior written permission. |
+| |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
+| DAMAGE. |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2003-2011. |
+| All Rights Reserved. |
+|==============================================================================|
+| Contributor(s): |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package |
+| (Found at URL: http://www.ararat.cz/synapse/) |
+|==============================================================================}
+
+{:@exclude}
+
+//{$DEFINE WINSOCK1}
+{Note about define WINSOCK1:
+If you activate this compiler directive, then socket interface level 1.1 is
+used instead default level 2.2. Level 2.2 is not available on old W95, however
+you can install update.
+}
+
+//{$DEFINE FORCEOLDAPI}
+{Note about define FORCEOLDAPI:
+If you activate this compiler directive, then is allways used old socket API
+for name resolution. If you leave this directive inactive, then the new API
+is used, when running system allows it.
+
+For IPv6 support you must have new API!
+}
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+{$IFDEF VER125}
+ {$DEFINE BCB}
+{$ENDIF}
+{$IFDEF BCB}
+ {$ObjExportAll On}
+ (*$HPPEMIT '/* EDE 2003-02-19 */' *)
+ (*$HPPEMIT 'namespace Synsock { using System::Shortint; }' *)
+ (*$HPPEMIT '#undef h_addr' *)
+ (*$HPPEMIT '#undef IOCPARM_MASK' *)
+ (*$HPPEMIT '#undef FD_SETSIZE' *)
+ (*$HPPEMIT '#undef IOC_VOID' *)
+ (*$HPPEMIT '#undef IOC_OUT' *)
+ (*$HPPEMIT '#undef IOC_IN' *)
+ (*$HPPEMIT '#undef IOC_INOUT' *)
+ (*$HPPEMIT '#undef FIONREAD' *)
+ (*$HPPEMIT '#undef FIONBIO' *)
+ (*$HPPEMIT '#undef FIOASYNC' *)
+ (*$HPPEMIT '#undef IPPROTO_IP' *)
+ (*$HPPEMIT '#undef IPPROTO_ICMP' *)
+ (*$HPPEMIT '#undef IPPROTO_IGMP' *)
+ (*$HPPEMIT '#undef IPPROTO_TCP' *)
+ (*$HPPEMIT '#undef IPPROTO_UDP' *)
+ (*$HPPEMIT '#undef IPPROTO_RAW' *)
+ (*$HPPEMIT '#undef IPPROTO_MAX' *)
+ (*$HPPEMIT '#undef INADDR_ANY' *)
+ (*$HPPEMIT '#undef INADDR_LOOPBACK' *)
+ (*$HPPEMIT '#undef INADDR_BROADCAST' *)
+ (*$HPPEMIT '#undef INADDR_NONE' *)
+ (*$HPPEMIT '#undef INVALID_SOCKET' *)
+ (*$HPPEMIT '#undef SOCKET_ERROR' *)
+ (*$HPPEMIT '#undef WSADESCRIPTION_LEN' *)
+ (*$HPPEMIT '#undef WSASYS_STATUS_LEN' *)
+ (*$HPPEMIT '#undef IP_OPTIONS' *)
+ (*$HPPEMIT '#undef IP_TOS' *)
+ (*$HPPEMIT '#undef IP_TTL' *)
+ (*$HPPEMIT '#undef IP_MULTICAST_IF' *)
+ (*$HPPEMIT '#undef IP_MULTICAST_TTL' *)
+ (*$HPPEMIT '#undef IP_MULTICAST_LOOP' *)
+ (*$HPPEMIT '#undef IP_ADD_MEMBERSHIP' *)
+ (*$HPPEMIT '#undef IP_DROP_MEMBERSHIP' *)
+ (*$HPPEMIT '#undef IP_DONTFRAGMENT' *)
+ (*$HPPEMIT '#undef IP_DEFAULT_MULTICAST_TTL' *)
+ (*$HPPEMIT '#undef IP_DEFAULT_MULTICAST_LOOP' *)
+ (*$HPPEMIT '#undef IP_MAX_MEMBERSHIPS' *)
+ (*$HPPEMIT '#undef SOL_SOCKET' *)
+ (*$HPPEMIT '#undef SO_DEBUG' *)
+ (*$HPPEMIT '#undef SO_ACCEPTCONN' *)
+ (*$HPPEMIT '#undef SO_REUSEADDR' *)
+ (*$HPPEMIT '#undef SO_KEEPALIVE' *)
+ (*$HPPEMIT '#undef SO_DONTROUTE' *)
+ (*$HPPEMIT '#undef SO_BROADCAST' *)
+ (*$HPPEMIT '#undef SO_USELOOPBACK' *)
+ (*$HPPEMIT '#undef SO_LINGER' *)
+ (*$HPPEMIT '#undef SO_OOBINLINE' *)
+ (*$HPPEMIT '#undef SO_DONTLINGER' *)
+ (*$HPPEMIT '#undef SO_SNDBUF' *)
+ (*$HPPEMIT '#undef SO_RCVBUF' *)
+ (*$HPPEMIT '#undef SO_SNDLOWAT' *)
+ (*$HPPEMIT '#undef SO_RCVLOWAT' *)
+ (*$HPPEMIT '#undef SO_SNDTIMEO' *)
+ (*$HPPEMIT '#undef SO_RCVTIMEO' *)
+ (*$HPPEMIT '#undef SO_ERROR' *)
+ (*$HPPEMIT '#undef SO_OPENTYPE' *)
+ (*$HPPEMIT '#undef SO_SYNCHRONOUS_ALERT' *)
+ (*$HPPEMIT '#undef SO_SYNCHRONOUS_NONALERT' *)
+ (*$HPPEMIT '#undef SO_MAXDG' *)
+ (*$HPPEMIT '#undef SO_MAXPATHDG' *)
+ (*$HPPEMIT '#undef SO_UPDATE_ACCEPT_CONTEXT' *)
+ (*$HPPEMIT '#undef SO_CONNECT_TIME' *)
+ (*$HPPEMIT '#undef SO_TYPE' *)
+ (*$HPPEMIT '#undef SOCK_STREAM' *)
+ (*$HPPEMIT '#undef SOCK_DGRAM' *)
+ (*$HPPEMIT '#undef SOCK_RAW' *)
+ (*$HPPEMIT '#undef SOCK_RDM' *)
+ (*$HPPEMIT '#undef SOCK_SEQPACKET' *)
+ (*$HPPEMIT '#undef TCP_NODELAY' *)
+ (*$HPPEMIT '#undef AF_UNSPEC' *)
+ (*$HPPEMIT '#undef SOMAXCONN' *)
+ (*$HPPEMIT '#undef AF_INET' *)
+ (*$HPPEMIT '#undef AF_MAX' *)
+ (*$HPPEMIT '#undef PF_UNSPEC' *)
+ (*$HPPEMIT '#undef PF_INET' *)
+ (*$HPPEMIT '#undef PF_MAX' *)
+ (*$HPPEMIT '#undef MSG_OOB' *)
+ (*$HPPEMIT '#undef MSG_PEEK' *)
+ (*$HPPEMIT '#undef WSABASEERR' *)
+ (*$HPPEMIT '#undef WSAEINTR' *)
+ (*$HPPEMIT '#undef WSAEBADF' *)
+ (*$HPPEMIT '#undef WSAEACCES' *)
+ (*$HPPEMIT '#undef WSAEFAULT' *)
+ (*$HPPEMIT '#undef WSAEINVAL' *)
+ (*$HPPEMIT '#undef WSAEMFILE' *)
+ (*$HPPEMIT '#undef WSAEWOULDBLOCK' *)
+ (*$HPPEMIT '#undef WSAEINPROGRESS' *)
+ (*$HPPEMIT '#undef WSAEALREADY' *)
+ (*$HPPEMIT '#undef WSAENOTSOCK' *)
+ (*$HPPEMIT '#undef WSAEDESTADDRREQ' *)
+ (*$HPPEMIT '#undef WSAEMSGSIZE' *)
+ (*$HPPEMIT '#undef WSAEPROTOTYPE' *)
+ (*$HPPEMIT '#undef WSAENOPROTOOPT' *)
+ (*$HPPEMIT '#undef WSAEPROTONOSUPPORT' *)
+ (*$HPPEMIT '#undef WSAESOCKTNOSUPPORT' *)
+ (*$HPPEMIT '#undef WSAEOPNOTSUPP' *)
+ (*$HPPEMIT '#undef WSAEPFNOSUPPORT' *)
+ (*$HPPEMIT '#undef WSAEAFNOSUPPORT' *)
+ (*$HPPEMIT '#undef WSAEADDRINUSE' *)
+ (*$HPPEMIT '#undef WSAEADDRNOTAVAIL' *)
+ (*$HPPEMIT '#undef WSAENETDOWN' *)
+ (*$HPPEMIT '#undef WSAENETUNREACH' *)
+ (*$HPPEMIT '#undef WSAENETRESET' *)
+ (*$HPPEMIT '#undef WSAECONNABORTED' *)
+ (*$HPPEMIT '#undef WSAECONNRESET' *)
+ (*$HPPEMIT '#undef WSAENOBUFS' *)
+ (*$HPPEMIT '#undef WSAEISCONN' *)
+ (*$HPPEMIT '#undef WSAENOTCONN' *)
+ (*$HPPEMIT '#undef WSAESHUTDOWN' *)
+ (*$HPPEMIT '#undef WSAETOOMANYREFS' *)
+ (*$HPPEMIT '#undef WSAETIMEDOUT' *)
+ (*$HPPEMIT '#undef WSAECONNREFUSED' *)
+ (*$HPPEMIT '#undef WSAELOOP' *)
+ (*$HPPEMIT '#undef WSAENAMETOOLONG' *)
+ (*$HPPEMIT '#undef WSAEHOSTDOWN' *)
+ (*$HPPEMIT '#undef WSAEHOSTUNREACH' *)
+ (*$HPPEMIT '#undef WSAENOTEMPTY' *)
+ (*$HPPEMIT '#undef WSAEPROCLIM' *)
+ (*$HPPEMIT '#undef WSAEUSERS' *)
+ (*$HPPEMIT '#undef WSAEDQUOT' *)
+ (*$HPPEMIT '#undef WSAESTALE' *)
+ (*$HPPEMIT '#undef WSAEREMOTE' *)
+ (*$HPPEMIT '#undef WSASYSNOTREADY' *)
+ (*$HPPEMIT '#undef WSAVERNOTSUPPORTED' *)
+ (*$HPPEMIT '#undef WSANOTINITIALISED' *)
+ (*$HPPEMIT '#undef WSAEDISCON' *)
+ (*$HPPEMIT '#undef WSAENOMORE' *)
+ (*$HPPEMIT '#undef WSAECANCELLED' *)
+ (*$HPPEMIT '#undef WSAEEINVALIDPROCTABLE' *)
+ (*$HPPEMIT '#undef WSAEINVALIDPROVIDER' *)
+ (*$HPPEMIT '#undef WSAEPROVIDERFAILEDINIT' *)
+ (*$HPPEMIT '#undef WSASYSCALLFAILURE' *)
+ (*$HPPEMIT '#undef WSASERVICE_NOT_FOUND' *)
+ (*$HPPEMIT '#undef WSATYPE_NOT_FOUND' *)
+ (*$HPPEMIT '#undef WSA_E_NO_MORE' *)
+ (*$HPPEMIT '#undef WSA_E_CANCELLED' *)
+ (*$HPPEMIT '#undef WSAEREFUSED' *)
+ (*$HPPEMIT '#undef WSAHOST_NOT_FOUND' *)
+ (*$HPPEMIT '#undef HOST_NOT_FOUND' *)
+ (*$HPPEMIT '#undef WSATRY_AGAIN' *)
+ (*$HPPEMIT '#undef TRY_AGAIN' *)
+ (*$HPPEMIT '#undef WSANO_RECOVERY' *)
+ (*$HPPEMIT '#undef NO_RECOVERY' *)
+ (*$HPPEMIT '#undef WSANO_DATA' *)
+ (*$HPPEMIT '#undef NO_DATA' *)
+ (*$HPPEMIT '#undef WSANO_ADDRESS' *)
+ (*$HPPEMIT '#undef ENAMETOOLONG' *)
+ (*$HPPEMIT '#undef ENOTEMPTY' *)
+ (*$HPPEMIT '#undef FD_CLR' *)
+ (*$HPPEMIT '#undef FD_ISSET' *)
+ (*$HPPEMIT '#undef FD_SET' *)
+ (*$HPPEMIT '#undef FD_ZERO' *)
+ (*$HPPEMIT '#undef NO_ADDRESS' *)
+ (*$HPPEMIT '#undef ADDR_ANY' *)
+ (*$HPPEMIT '#undef SO_GROUP_ID' *)
+ (*$HPPEMIT '#undef SO_GROUP_PRIORITY' *)
+ (*$HPPEMIT '#undef SO_MAX_MSG_SIZE' *)
+ (*$HPPEMIT '#undef SO_PROTOCOL_INFOA' *)
+ (*$HPPEMIT '#undef SO_PROTOCOL_INFOW' *)
+ (*$HPPEMIT '#undef SO_PROTOCOL_INFO' *)
+ (*$HPPEMIT '#undef PVD_CONFIG' *)
+ (*$HPPEMIT '#undef AF_INET6' *)
+ (*$HPPEMIT '#undef PF_INET6' *)
+{$ENDIF}
+
+{$IFDEF FPC}
+ {$IFDEF WIN32}
+ {$ALIGN OFF}
+ {$ELSE}
+ {$PACKRECORDS C}
+ {$ENDIF}
+{$ENDIF}
+
+interface
+
+uses
+ SyncObjs, SysUtils, Classes,
+ Windows;
+
+function InitSocketInterface(stack: String): Boolean;
+function DestroySocketInterface: Boolean;
+
+const
+{$IFDEF WINSOCK1}
+ WinsockLevel = $0101;
+{$ELSE}
+ WinsockLevel = $0202;
+{$ENDIF}
+
+type
+ u_short = Word;
+ u_int = Integer;
+ u_long = Longint;
+ pu_long = ^u_long;
+ pu_short = ^u_short;
+{$IFDEF FPC}
+ TSocket = ptruint;
+{$ELSE}
+ {$IFDEF WIN64}
+ TSocket = UINT_PTR;
+ {$ELSE}
+ TSocket = u_int;
+ {$ENDIF}
+{$ENDIF}
+ TAddrFamily = integer;
+
+ TMemory = pointer;
+
+const
+ {$IFDEF WINCE}
+ DLLStackName = 'ws2.dll';
+ {$ELSE}
+ {$IFDEF WINSOCK1}
+ DLLStackName = 'wsock32.dll';
+ {$ELSE}
+ DLLStackName = 'ws2_32.dll';
+ {$ENDIF}
+ {$ENDIF}
+ DLLwship6 = 'wship6.dll';
+
+ cLocalhost = '127.0.0.1';
+ cAnyHost = '0.0.0.0';
+ cBroadcast = '255.255.255.255';
+ c6Localhost = '::1';
+ c6AnyHost = '::0';
+ c6Broadcast = 'ffff::1';
+ cAnyPort = '0';
+
+
+const
+ FD_SETSIZE = 64;
+type
+ PFDSet = ^TFDSet;
+ TFDSet = record
+ fd_count: u_int;
+ fd_array: array[0..FD_SETSIZE-1] of TSocket;
+ end;
+
+const
+ FIONREAD = $4004667f;
+ FIONBIO = $8004667e;
+ FIOASYNC = $8004667d;
+
+type
+ PTimeVal = ^TTimeVal;
+ TTimeVal = record
+ tv_sec: Longint;
+ tv_usec: Longint;
+ end;
+
+const
+ IPPROTO_IP = 0; { Dummy }
+ IPPROTO_ICMP = 1; { Internet Control Message Protocol }
+ IPPROTO_IGMP = 2; { Internet Group Management Protocol}
+ IPPROTO_TCP = 6; { TCP }
+ IPPROTO_UDP = 17; { User Datagram Protocol }
+ IPPROTO_IPV6 = 41;
+ IPPROTO_ICMPV6 = 58;
+ IPPROTO_RM = 113;
+
+ IPPROTO_RAW = 255;
+ IPPROTO_MAX = 256;
+
+type
+
+ PInAddr = ^TInAddr;
+ TInAddr = record
+ case integer of
+ 0: (S_bytes: packed array [0..3] of byte);
+ 1: (S_addr: u_long);
+ end;
+
+ PSockAddrIn = ^TSockAddrIn;
+ TSockAddrIn = record
+ case Integer of
+ 0: (sin_family: u_short;
+ sin_port: u_short;
+ sin_addr: TInAddr;
+ sin_zero: array[0..7] of byte);
+ 1: (sa_family: u_short;
+ sa_data: array[0..13] of byte)
+ end;
+
+ TIP_mreq = record
+ imr_multiaddr: TInAddr; { IP multicast address of group }
+ imr_interface: TInAddr; { local IP address of interface }
+ end;
+
+ PInAddr6 = ^TInAddr6;
+ TInAddr6 = record
+ case integer of
+ 0: (S6_addr: packed array [0..15] of byte);
+ 1: (u6_addr8: packed array [0..15] of byte);
+ 2: (u6_addr16: packed array [0..7] of word);
+ 3: (u6_addr32: packed array [0..3] of integer);
+ end;
+
+ PSockAddrIn6 = ^TSockAddrIn6;
+ TSockAddrIn6 = record
+ sin6_family: u_short; // AF_INET6
+ sin6_port: u_short; // Transport level port number
+ sin6_flowinfo: u_long; // IPv6 flow information
+ sin6_addr: TInAddr6; // IPv6 address
+ sin6_scope_id: u_long; // Scope Id: IF number for link-local
+ // SITE id for site-local
+ end;
+
+ TIPv6_mreq = record
+ ipv6mr_multiaddr: TInAddr6; // IPv6 multicast address.
+ ipv6mr_interface: integer; // Interface index.
+ padding: integer;
+ end;
+
+ PHostEnt = ^THostEnt;
+ THostEnt = record
+ h_name: PAnsiChar;
+ h_aliases: ^PAnsiChar;
+ h_addrtype: Smallint;
+ h_length: Smallint;
+ case integer of
+ 0: (h_addr_list: ^PAnsiChar);
+ 1: (h_addr: ^PInAddr);
+ end;
+
+ PNetEnt = ^TNetEnt;
+ TNetEnt = record
+ n_name: PAnsiChar;
+ n_aliases: ^PAnsiChar;
+ n_addrtype: Smallint;
+ n_net: u_long;
+ end;
+
+ PServEnt = ^TServEnt;
+ TServEnt = record
+ s_name: PAnsiChar;
+ s_aliases: ^PAnsiChar;
+{$ifdef WIN64}
+ s_proto: PAnsiChar;
+ s_port: Smallint;
+{$else}
+ s_port: Smallint;
+ s_proto: PAnsiChar;
+{$endif}
+ end;
+
+ PProtoEnt = ^TProtoEnt;
+ TProtoEnt = record
+ p_name: PAnsiChar;
+ p_aliases: ^PAnsichar;
+ p_proto: Smallint;
+ end;
+
+const
+ INADDR_ANY = $00000000;
+ INADDR_LOOPBACK = $7F000001;
+ INADDR_BROADCAST = $FFFFFFFF;
+ INADDR_NONE = $FFFFFFFF;
+ ADDR_ANY = INADDR_ANY;
+ INVALID_SOCKET = TSocket(NOT(0));
+ SOCKET_ERROR = -1;
+
+Const
+ {$IFDEF WINSOCK1}
+ IP_OPTIONS = 1;
+ IP_MULTICAST_IF = 2; { set/get IP multicast interface }
+ IP_MULTICAST_TTL = 3; { set/get IP multicast timetolive }
+ IP_MULTICAST_LOOP = 4; { set/get IP multicast loopback }
+ IP_ADD_MEMBERSHIP = 5; { add an IP group membership }
+ IP_DROP_MEMBERSHIP = 6; { drop an IP group membership }
+ IP_TTL = 7; { set/get IP Time To Live }
+ IP_TOS = 8; { set/get IP Type Of Service }
+ IP_DONTFRAGMENT = 9; { set/get IP Don't Fragment flag }
+ {$ELSE}
+ IP_OPTIONS = 1;
+ IP_HDRINCL = 2;
+ IP_TOS = 3; { set/get IP Type Of Service }
+ IP_TTL = 4; { set/get IP Time To Live }
+ IP_MULTICAST_IF = 9; { set/get IP multicast interface }
+ IP_MULTICAST_TTL = 10; { set/get IP multicast timetolive }
+ IP_MULTICAST_LOOP = 11; { set/get IP multicast loopback }
+ IP_ADD_MEMBERSHIP = 12; { add an IP group membership }
+ IP_DROP_MEMBERSHIP = 13; { drop an IP group membership }
+ IP_DONTFRAGMENT = 14; { set/get IP Don't Fragment flag }
+ {$ENDIF}
+
+ IP_DEFAULT_MULTICAST_TTL = 1; { normally limit m'casts to 1 hop }
+ IP_DEFAULT_MULTICAST_LOOP = 1; { normally hear sends if a member }
+ IP_MAX_MEMBERSHIPS = 20; { per socket; must fit in one mbuf }
+
+ SOL_SOCKET = $ffff; {options for socket level }
+{ Option flags per-socket. }
+ SO_DEBUG = $0001; { turn on debugging info recording }
+ SO_ACCEPTCONN = $0002; { socket has had listen() }
+ SO_REUSEADDR = $0004; { allow local address reuse }
+ SO_KEEPALIVE = $0008; { keep connections alive }
+ SO_DONTROUTE = $0010; { just use interface addresses }
+ SO_BROADCAST = $0020; { permit sending of broadcast msgs }
+ SO_USELOOPBACK = $0040; { bypass hardware when possible }
+ SO_LINGER = $0080; { linger on close if data present }
+ SO_OOBINLINE = $0100; { leave received OOB data in line }
+ SO_DONTLINGER = $ff7f;
+{ Additional options. }
+ SO_SNDBUF = $1001; { send buffer size }
+ SO_RCVBUF = $1002; { receive buffer size }
+ SO_SNDLOWAT = $1003; { send low-water mark }
+ SO_RCVLOWAT = $1004; { receive low-water mark }
+ SO_SNDTIMEO = $1005; { send timeout }
+ SO_RCVTIMEO = $1006; { receive timeout }
+ SO_ERROR = $1007; { get error status and clear }
+ SO_TYPE = $1008; { get socket type }
+{ WinSock 2 extension -- new options }
+ SO_GROUP_ID = $2001; { ID of a socket group}
+ SO_GROUP_PRIORITY = $2002; { the relative priority within a group}
+ SO_MAX_MSG_SIZE = $2003; { maximum message size }
+ SO_PROTOCOL_INFOA = $2004; { WSAPROTOCOL_INFOA structure }
+ SO_PROTOCOL_INFOW = $2005; { WSAPROTOCOL_INFOW structure }
+ SO_PROTOCOL_INFO = SO_PROTOCOL_INFOA;
+ PVD_CONFIG = $3001; {configuration info for service provider }
+{ Option for opening sockets for synchronous access. }
+ SO_OPENTYPE = $7008;
+ SO_SYNCHRONOUS_ALERT = $10;
+ SO_SYNCHRONOUS_NONALERT = $20;
+{ Other NT-specific options. }
+ SO_MAXDG = $7009;
+ SO_MAXPATHDG = $700A;
+ SO_UPDATE_ACCEPT_CONTEXT = $700B;
+ SO_CONNECT_TIME = $700C;
+
+ SOMAXCONN = $7fffffff;
+
+ IPV6_UNICAST_HOPS = 8; // ???
+ IPV6_MULTICAST_IF = 9; // set/get IP multicast i/f
+ IPV6_MULTICAST_HOPS = 10; // set/get IP multicast ttl
+ IPV6_MULTICAST_LOOP = 11; // set/get IP multicast loopback
+ IPV6_JOIN_GROUP = 12; // add an IP group membership
+ IPV6_LEAVE_GROUP = 13; // drop an IP group membership
+
+ MSG_NOSIGNAL = 0;
+
+ // getnameinfo constants
+ NI_MAXHOST = 1025;
+ NI_MAXSERV = 32;
+ NI_NOFQDN = $1;
+ NI_NUMERICHOST = $2;
+ NI_NAMEREQD = $4;
+ NI_NUMERICSERV = $8;
+ NI_DGRAM = $10;
+
+
+const
+ SOCK_STREAM = 1; { stream socket }
+ SOCK_DGRAM = 2; { datagram socket }
+ SOCK_RAW = 3; { raw-protocol interface }
+ SOCK_RDM = 4; { reliably-delivered message }
+ SOCK_SEQPACKET = 5; { sequenced packet stream }
+
+{ TCP options. }
+ TCP_NODELAY = $0001;
+
+{ Address families. }
+
+ AF_UNSPEC = 0; { unspecified }
+ AF_INET = 2; { internetwork: UDP, TCP, etc. }
+ AF_INET6 = 23; { Internetwork Version 6 }
+ AF_MAX = 24;
+
+{ Protocol families, same as address families for now. }
+ PF_UNSPEC = AF_UNSPEC;
+ PF_INET = AF_INET;
+ PF_INET6 = AF_INET6;
+ PF_MAX = AF_MAX;
+
+type
+ { Structure used by kernel to store most addresses. }
+ PSockAddr = ^TSockAddr;
+ TSockAddr = TSockAddrIn;
+
+ { Structure used by kernel to pass protocol information in raw sockets. }
+ PSockProto = ^TSockProto;
+ TSockProto = record
+ sp_family: u_short;
+ sp_protocol: u_short;
+ end;
+
+type
+ PAddrInfo = ^TAddrInfo;
+ TAddrInfo = record
+ ai_flags: integer; // AI_PASSIVE, AI_CANONNAME, AI_NUMERICHOST.
+ ai_family: integer; // PF_xxx.
+ ai_socktype: integer; // SOCK_xxx.
+ ai_protocol: integer; // 0 or IPPROTO_xxx for IPv4 and IPv6.
+ ai_addrlen: u_int; // Length of ai_addr.
+ ai_canonname: PAnsiChar; // Canonical name for nodename.
+ ai_addr: PSockAddr; // Binary address.
+ ai_next: PAddrInfo; // Next structure in linked list.
+ end;
+
+const
+ // Flags used in "hints" argument to getaddrinfo().
+ AI_PASSIVE = $1; // Socket address will be used in bind() call.
+ AI_CANONNAME = $2; // Return canonical name in first ai_canonname.
+ AI_NUMERICHOST = $4; // Nodename must be a numeric address string.
+
+type
+{ Structure used for manipulating linger option. }
+ PLinger = ^TLinger;
+ TLinger = record
+ l_onoff: u_short;
+ l_linger: u_short;
+ end;
+
+const
+
+ MSG_OOB = $01; // Process out-of-band data.
+ MSG_PEEK = $02; // Peek at incoming messages.
+
+const
+
+{ All Windows Sockets error constants are biased by WSABASEERR from the "normal" }
+ WSABASEERR = 10000;
+
+{ Windows Sockets definitions of regular Microsoft C error constants }
+
+ WSAEINTR = (WSABASEERR+4);
+ WSAEBADF = (WSABASEERR+9);
+ WSAEACCES = (WSABASEERR+13);
+ WSAEFAULT = (WSABASEERR+14);
+ WSAEINVAL = (WSABASEERR+22);
+ WSAEMFILE = (WSABASEERR+24);
+
+{ Windows Sockets definitions of regular Berkeley error constants }
+
+ WSAEWOULDBLOCK = (WSABASEERR+35);
+ WSAEINPROGRESS = (WSABASEERR+36);
+ WSAEALREADY = (WSABASEERR+37);
+ WSAENOTSOCK = (WSABASEERR+38);
+ WSAEDESTADDRREQ = (WSABASEERR+39);
+ WSAEMSGSIZE = (WSABASEERR+40);
+ WSAEPROTOTYPE = (WSABASEERR+41);
+ WSAENOPROTOOPT = (WSABASEERR+42);
+ WSAEPROTONOSUPPORT = (WSABASEERR+43);
+ WSAESOCKTNOSUPPORT = (WSABASEERR+44);
+ WSAEOPNOTSUPP = (WSABASEERR+45);
+ WSAEPFNOSUPPORT = (WSABASEERR+46);
+ WSAEAFNOSUPPORT = (WSABASEERR+47);
+ WSAEADDRINUSE = (WSABASEERR+48);
+ WSAEADDRNOTAVAIL = (WSABASEERR+49);
+ WSAENETDOWN = (WSABASEERR+50);
+ WSAENETUNREACH = (WSABASEERR+51);
+ WSAENETRESET = (WSABASEERR+52);
+ WSAECONNABORTED = (WSABASEERR+53);
+ WSAECONNRESET = (WSABASEERR+54);
+ WSAENOBUFS = (WSABASEERR+55);
+ WSAEISCONN = (WSABASEERR+56);
+ WSAENOTCONN = (WSABASEERR+57);
+ WSAESHUTDOWN = (WSABASEERR+58);
+ WSAETOOMANYREFS = (WSABASEERR+59);
+ WSAETIMEDOUT = (WSABASEERR+60);
+ WSAECONNREFUSED = (WSABASEERR+61);
+ WSAELOOP = (WSABASEERR+62);
+ WSAENAMETOOLONG = (WSABASEERR+63);
+ WSAEHOSTDOWN = (WSABASEERR+64);
+ WSAEHOSTUNREACH = (WSABASEERR+65);
+ WSAENOTEMPTY = (WSABASEERR+66);
+ WSAEPROCLIM = (WSABASEERR+67);
+ WSAEUSERS = (WSABASEERR+68);
+ WSAEDQUOT = (WSABASEERR+69);
+ WSAESTALE = (WSABASEERR+70);
+ WSAEREMOTE = (WSABASEERR+71);
+
+{ Extended Windows Sockets error constant definitions }
+
+ WSASYSNOTREADY = (WSABASEERR+91);
+ WSAVERNOTSUPPORTED = (WSABASEERR+92);
+ WSANOTINITIALISED = (WSABASEERR+93);
+ WSAEDISCON = (WSABASEERR+101);
+ WSAENOMORE = (WSABASEERR+102);
+ WSAECANCELLED = (WSABASEERR+103);
+ WSAEEINVALIDPROCTABLE = (WSABASEERR+104);
+ WSAEINVALIDPROVIDER = (WSABASEERR+105);
+ WSAEPROVIDERFAILEDINIT = (WSABASEERR+106);
+ WSASYSCALLFAILURE = (WSABASEERR+107);
+ WSASERVICE_NOT_FOUND = (WSABASEERR+108);
+ WSATYPE_NOT_FOUND = (WSABASEERR+109);
+ WSA_E_NO_MORE = (WSABASEERR+110);
+ WSA_E_CANCELLED = (WSABASEERR+111);
+ WSAEREFUSED = (WSABASEERR+112);
+
+{ Error return codes from gethostbyname() and gethostbyaddr()
+ (when using the resolver). Note that these errors are
+ retrieved via WSAGetLastError() and must therefore follow
+ the rules for avoiding clashes with error numbers from
+ specific implementations or language run-time systems.
+ For this reason the codes are based at WSABASEERR+1001.
+ Note also that [WSA]NO_ADDRESS is defined only for
+ compatibility purposes. }
+
+{ Authoritative Answer: Host not found }
+ WSAHOST_NOT_FOUND = (WSABASEERR+1001);
+ HOST_NOT_FOUND = WSAHOST_NOT_FOUND;
+{ Non-Authoritative: Host not found, or SERVERFAIL }
+ WSATRY_AGAIN = (WSABASEERR+1002);
+ TRY_AGAIN = WSATRY_AGAIN;
+{ Non recoverable errors, FORMERR, REFUSED, NOTIMP }
+ WSANO_RECOVERY = (WSABASEERR+1003);
+ NO_RECOVERY = WSANO_RECOVERY;
+{ Valid name, no data record of requested type }
+ WSANO_DATA = (WSABASEERR+1004);
+ NO_DATA = WSANO_DATA;
+{ no address, look for MX record }
+ WSANO_ADDRESS = WSANO_DATA;
+ NO_ADDRESS = WSANO_ADDRESS;
+
+ EWOULDBLOCK = WSAEWOULDBLOCK;
+ EINPROGRESS = WSAEINPROGRESS;
+ EALREADY = WSAEALREADY;
+ ENOTSOCK = WSAENOTSOCK;
+ EDESTADDRREQ = WSAEDESTADDRREQ;
+ EMSGSIZE = WSAEMSGSIZE;
+ EPROTOTYPE = WSAEPROTOTYPE;
+ ENOPROTOOPT = WSAENOPROTOOPT;
+ EPROTONOSUPPORT = WSAEPROTONOSUPPORT;
+ ESOCKTNOSUPPORT = WSAESOCKTNOSUPPORT;
+ EOPNOTSUPP = WSAEOPNOTSUPP;
+ EPFNOSUPPORT = WSAEPFNOSUPPORT;
+ EAFNOSUPPORT = WSAEAFNOSUPPORT;
+ EADDRINUSE = WSAEADDRINUSE;
+ EADDRNOTAVAIL = WSAEADDRNOTAVAIL;
+ ENETDOWN = WSAENETDOWN;
+ ENETUNREACH = WSAENETUNREACH;
+ ENETRESET = WSAENETRESET;
+ ECONNABORTED = WSAECONNABORTED;
+ ECONNRESET = WSAECONNRESET;
+ ENOBUFS = WSAENOBUFS;
+ EISCONN = WSAEISCONN;
+ ENOTCONN = WSAENOTCONN;
+ ESHUTDOWN = WSAESHUTDOWN;
+ ETOOMANYREFS = WSAETOOMANYREFS;
+ ETIMEDOUT = WSAETIMEDOUT;
+ ECONNREFUSED = WSAECONNREFUSED;
+ ELOOP = WSAELOOP;
+ ENAMETOOLONG = WSAENAMETOOLONG;
+ EHOSTDOWN = WSAEHOSTDOWN;
+ EHOSTUNREACH = WSAEHOSTUNREACH;
+ ENOTEMPTY = WSAENOTEMPTY;
+ EPROCLIM = WSAEPROCLIM;
+ EUSERS = WSAEUSERS;
+ EDQUOT = WSAEDQUOT;
+ ESTALE = WSAESTALE;
+ EREMOTE = WSAEREMOTE;
+
+ EAI_ADDRFAMILY = 1; // Address family for nodename not supported.
+ EAI_AGAIN = 2; // Temporary failure in name resolution.
+ EAI_BADFLAGS = 3; // Invalid value for ai_flags.
+ EAI_FAIL = 4; // Non-recoverable failure in name resolution.
+ EAI_FAMILY = 5; // Address family ai_family not supported.
+ EAI_MEMORY = 6; // Memory allocation failure.
+ EAI_NODATA = 7; // No address associated with nodename.
+ EAI_NONAME = 8; // Nodename nor servname provided, or not known.
+ EAI_SERVICE = 9; // Servname not supported for ai_socktype.
+ EAI_SOCKTYPE = 10; // Socket type ai_socktype not supported.
+ EAI_SYSTEM = 11; // System error returned in errno.
+
+const
+ WSADESCRIPTION_LEN = 256;
+ WSASYS_STATUS_LEN = 128;
+type
+ PWSAData = ^TWSAData;
+ TWSAData = record
+ wVersion: Word;
+ wHighVersion: Word;
+{$ifdef win64}
+ iMaxSockets : Word;
+ iMaxUdpDg : Word;
+ lpVendorInfo : PAnsiChar;
+ szDescription : array[0..WSADESCRIPTION_LEN] of AnsiChar;
+ szSystemStatus : array[0..WSASYS_STATUS_LEN] of AnsiChar;
+{$else}
+ szDescription: array[0..WSADESCRIPTION_LEN] of AnsiChar;
+ szSystemStatus: array[0..WSASYS_STATUS_LEN] of AnsiChar;
+ iMaxSockets: Word;
+ iMaxUdpDg: Word;
+ lpVendorInfo: PAnsiChar;
+{$endif}
+ end;
+
+ function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean;
+ function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean;
+ function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean;
+ function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean;
+ function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean;
+ function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6):boolean;
+ procedure SET_IN6_IF_ADDR_ANY (const a: PInAddr6);
+ procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6);
+var
+ in6addr_any, in6addr_loopback : TInAddr6;
+
+procedure FD_CLR(Socket: TSocket; var FDSet: TFDSet);
+function FD_ISSET(Socket: TSocket; var FDSet: TFDSet): Boolean;
+procedure FD_SET(Socket: TSocket; var FDSet: TFDSet);
+procedure FD_ZERO(var FDSet: TFDSet);
+
+{=============================================================================}
+
+type
+ TWSAStartup = function(wVersionRequired: Word; var WSData: TWSAData): Integer;
+ stdcall;
+ TWSACleanup = function: Integer;
+ stdcall;
+ TWSAGetLastError = function: Integer;
+ stdcall;
+ TGetServByName = function(name, proto: PAnsiChar): PServEnt;
+ stdcall;
+ TGetServByPort = function(port: Integer; proto: PAnsiChar): PServEnt;
+ stdcall;
+ TGetProtoByName = function(name: PAnsiChar): PProtoEnt;
+ stdcall;
+ TGetProtoByNumber = function(proto: Integer): PProtoEnt;
+ stdcall;
+ TGetHostByName = function(name: PAnsiChar): PHostEnt;
+ stdcall;
+ TGetHostByAddr = function(addr: Pointer; len, Struc: Integer): PHostEnt;
+ stdcall;
+ TGetHostName = function(name: PAnsiChar; len: Integer): Integer;
+ stdcall;
+ TShutdown = function(s: TSocket; how: Integer): Integer;
+ stdcall;
+ TSetSockOpt = function(s: TSocket; level, optname: Integer; optval: PAnsiChar;
+ optlen: Integer): Integer;
+ stdcall;
+ TGetSockOpt = function(s: TSocket; level, optname: Integer; optval: PAnsiChar;
+ var optlen: Integer): Integer;
+ stdcall;
+ TSendTo = function(s: TSocket; const Buf; len, flags: Integer; addrto: PSockAddr;
+ tolen: Integer): Integer;
+ stdcall;
+ TSend = function(s: TSocket; const Buf; len, flags: Integer): Integer;
+ stdcall;
+ TRecv = function(s: TSocket; var Buf; len, flags: Integer): Integer;
+ stdcall;
+ TRecvFrom = function(s: TSocket; var Buf; len, flags: Integer; from: PSockAddr;
+ var fromlen: Integer): Integer;
+ stdcall;
+ Tntohs = function(netshort: u_short): u_short;
+ stdcall;
+ Tntohl = function(netlong: u_long): u_long;
+ stdcall;
+ TListen = function(s: TSocket; backlog: Integer): Integer;
+ stdcall;
+ TIoctlSocket = function(s: TSocket; cmd: DWORD; var arg: Integer): Integer;
+ stdcall;
+ TInet_ntoa = function(inaddr: TInAddr): PAnsiChar;
+ stdcall;
+ TInet_addr = function(cp: PAnsiChar): u_long;
+ stdcall;
+ Thtons = function(hostshort: u_short): u_short;
+ stdcall;
+ Thtonl = function(hostlong: u_long): u_long;
+ stdcall;
+ TGetSockName = function(s: TSocket; name: PSockAddr; var namelen: Integer): Integer;
+ stdcall;
+ TGetPeerName = function(s: TSocket; name: PSockAddr; var namelen: Integer): Integer;
+ stdcall;
+ TConnect = function(s: TSocket; name: PSockAddr; namelen: Integer): Integer;
+ stdcall;
+ TCloseSocket = function(s: TSocket): Integer;
+ stdcall;
+ TBind = function(s: TSocket; addr: PSockAddr; namelen: Integer): Integer;
+ stdcall;
+ TAccept = function(s: TSocket; addr: PSockAddr; var addrlen: Integer): TSocket;
+ stdcall;
+ TTSocket = function(af, Struc, Protocol: Integer): TSocket;
+ stdcall;
+ TSelect = function(nfds: Integer; readfds, writefds, exceptfds: PFDSet;
+ timeout: PTimeVal): Longint;
+ stdcall;
+
+ TGetAddrInfo = function(NodeName: PAnsiChar; ServName: PAnsiChar; Hints: PAddrInfo;
+ var Addrinfo: PAddrInfo): integer;
+ stdcall;
+ TFreeAddrInfo = procedure(ai: PAddrInfo);
+ stdcall;
+ TGetNameInfo = function( addr: PSockAddr; namelen: Integer; host: PAnsiChar;
+ hostlen: DWORD; serv: PAnsiChar; servlen: DWORD; flags: integer): integer;
+ stdcall;
+
+ T__WSAFDIsSet = function (s: TSocket; var FDSet: TFDSet): Bool;
+ stdcall;
+
+ TWSAIoctl = function (s: TSocket; dwIoControlCode: DWORD; lpvInBuffer: Pointer;
+ cbInBuffer: DWORD; lpvOutBuffer: Pointer; cbOutBuffer: DWORD;
+ lpcbBytesReturned: PDWORD; lpOverlapped: Pointer;
+ lpCompletionRoutine: pointer): u_int;
+ stdcall;
+
+var
+ WSAStartup: TWSAStartup = nil;
+ WSACleanup: TWSACleanup = nil;
+ WSAGetLastError: TWSAGetLastError = nil;
+ GetServByName: TGetServByName = nil;
+ GetServByPort: TGetServByPort = nil;
+ GetProtoByName: TGetProtoByName = nil;
+ GetProtoByNumber: TGetProtoByNumber = nil;
+ GetHostByName: TGetHostByName = nil;
+ GetHostByAddr: TGetHostByAddr = nil;
+ ssGetHostName: TGetHostName = nil;
+ Shutdown: TShutdown = nil;
+ SetSockOpt: TSetSockOpt = nil;
+ GetSockOpt: TGetSockOpt = nil;
+ ssSendTo: TSendTo = nil;
+ ssSend: TSend = nil;
+ ssRecv: TRecv = nil;
+ ssRecvFrom: TRecvFrom = nil;
+ ntohs: Tntohs = nil;
+ ntohl: Tntohl = nil;
+ Listen: TListen = nil;
+ IoctlSocket: TIoctlSocket = nil;
+ Inet_ntoa: TInet_ntoa = nil;
+ Inet_addr: TInet_addr = nil;
+ htons: Thtons = nil;
+ htonl: Thtonl = nil;
+ ssGetSockName: TGetSockName = nil;
+ ssGetPeerName: TGetPeerName = nil;
+ ssConnect: TConnect = nil;
+ CloseSocket: TCloseSocket = nil;
+ ssBind: TBind = nil;
+ ssAccept: TAccept = nil;
+ Socket: TTSocket = nil;
+ Select: TSelect = nil;
+
+ GetAddrInfo: TGetAddrInfo = nil;
+ FreeAddrInfo: TFreeAddrInfo = nil;
+ GetNameInfo: TGetNameInfo = nil;
+
+ __WSAFDIsSet: T__WSAFDIsSet = nil;
+
+ WSAIoctl: TWSAIoctl = nil;
+
+var
+ SynSockCS: SyncObjs.TCriticalSection;
+ SockEnhancedApi: Boolean;
+ SockWship6Api: Boolean;
+
+type
+ TVarSin = packed record
+ case integer of
+ 0: (AddressFamily: u_short);
+ 1: (
+ case sin_family: u_short of
+ AF_INET: (sin_port: u_short;
+ sin_addr: TInAddr;
+ sin_zero: array[0..7] of byte);
+ AF_INET6: (sin6_port: u_short;
+ sin6_flowinfo: u_long;
+ sin6_addr: TInAddr6;
+ sin6_scope_id: u_long);
+ );
+ end;
+
+function SizeOfVarSin(sin: TVarSin): integer;
+
+function Bind(s: TSocket; const addr: TVarSin): Integer;
+function Connect(s: TSocket; const name: TVarSin): Integer;
+function GetSockName(s: TSocket; var name: TVarSin): Integer;
+function GetPeerName(s: TSocket; var name: TVarSin): Integer;
+function GetHostName: AnsiString;
+function Send(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
+function Recv(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
+function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin): Integer;
+function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer;
+function Accept(s: TSocket; var addr: TVarSin): TSocket;
+
+function IsNewApi(Family: integer): Boolean;
+function SetVarSin(var Sin: TVarSin; IP, Port: AnsiString; Family, SockProtocol, SockType: integer; PreferIP4: Boolean): integer;
+function GetSinIP(Sin: TVarSin): AnsiString;
+function GetSinPort(Sin: TVarSin): Integer;
+procedure ResolveNameToIP(Name: AnsiString; Family, SockProtocol, SockType: integer; const IPList: TStrings);
+function ResolveIPToName(IP: AnsiString; Family, SockProtocol, SockType: integer): AnsiString;
+function ResolvePort(Port: AnsiString; Family, SockProtocol, SockType: integer): Word;
+
+{==============================================================================}
+implementation
+
+var
+ SynSockCount: Integer = 0;
+ LibHandle: THandle = 0;
+ Libwship6Handle: THandle = 0;
+
+function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean;
+begin
+ Result := ((a^.u6_addr32[0] = 0) and (a^.u6_addr32[1] = 0) and
+ (a^.u6_addr32[2] = 0) and (a^.u6_addr32[3] = 0));
+end;
+
+function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean;
+begin
+ Result := ((a^.u6_addr32[0] = 0) and (a^.u6_addr32[1] = 0) and
+ (a^.u6_addr32[2] = 0) and
+ (a^.u6_addr8[12] = 0) and (a^.u6_addr8[13] = 0) and
+ (a^.u6_addr8[14] = 0) and (a^.u6_addr8[15] = 1));
+end;
+
+function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean;
+begin
+ Result := ((a^.u6_addr8[0] = $FE) and (a^.u6_addr8[1] = $80));
+end;
+
+function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean;
+begin
+ Result := ((a^.u6_addr8[0] = $FE) and (a^.u6_addr8[1] = $C0));
+end;
+
+function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean;
+begin
+ Result := (a^.u6_addr8[0] = $FF);
+end;
+
+function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6): boolean;
+begin
+ Result := (CompareMem( a, b, sizeof(TInAddr6)));
+end;
+
+procedure SET_IN6_IF_ADDR_ANY (const a: PInAddr6);
+begin
+ FillChar(a^, sizeof(TInAddr6), 0);
+end;
+
+procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6);
+begin
+ FillChar(a^, sizeof(TInAddr6), 0);
+ a^.u6_addr8[15] := 1;
+end;
+
+{=============================================================================}
+procedure FD_CLR(Socket: TSocket; var FDSet: TFDSet);
+var
+ I: Integer;
+begin
+ I := 0;
+ while I < FDSet.fd_count do
+ begin
+ if FDSet.fd_array[I] = Socket then
+ begin
+ while I < FDSet.fd_count - 1 do
+ begin
+ FDSet.fd_array[I] := FDSet.fd_array[I + 1];
+ Inc(I);
+ end;
+ Dec(FDSet.fd_count);
+ Break;
+ end;
+ Inc(I);
+ end;
+end;
+
+function FD_ISSET(Socket: TSocket; var FDSet: TFDSet): Boolean;
+begin
+ Result := __WSAFDIsSet(Socket, FDSet);
+end;
+
+procedure FD_SET(Socket: TSocket; var FDSet: TFDSet);
+begin
+ if FDSet.fd_count < FD_SETSIZE then
+ begin
+ FDSet.fd_array[FDSet.fd_count] := Socket;
+ Inc(FDSet.fd_count);
+ end;
+end;
+
+procedure FD_ZERO(var FDSet: TFDSet);
+begin
+ FDSet.fd_count := 0;
+end;
+
+{=============================================================================}
+
+function SizeOfVarSin(sin: TVarSin): integer;
+begin
+ case sin.sin_family of
+ AF_INET:
+ Result := SizeOf(TSockAddrIn);
+ AF_INET6:
+ Result := SizeOf(TSockAddrIn6);
+ else
+ Result := 0;
+ end;
+end;
+
+{=============================================================================}
+
+function Bind(s: TSocket; const addr: TVarSin): Integer;
+begin
+ Result := ssBind(s, @addr, SizeOfVarSin(addr));
+end;
+
+function Connect(s: TSocket; const name: TVarSin): Integer;
+begin
+ Result := ssConnect(s, @name, SizeOfVarSin(name));
+end;
+
+function GetSockName(s: TSocket; var name: TVarSin): Integer;
+var
+ len: integer;
+begin
+ len := SizeOf(name);
+ FillChar(name, len, 0);
+ Result := ssGetSockName(s, @name, Len);
+end;
+
+function GetPeerName(s: TSocket; var name: TVarSin): Integer;
+var
+ len: integer;
+begin
+ len := SizeOf(name);
+ FillChar(name, len, 0);
+ Result := ssGetPeerName(s, @name, Len);
+end;
+
+function GetHostName: AnsiString;
+var
+ s: AnsiString;
+begin
+ Result := '';
+ setlength(s, 255);
+ ssGetHostName(pAnsichar(s), Length(s) - 1);
+ Result := PAnsichar(s);
+end;
+
+function Send(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
+begin
+ Result := ssSend(s, Buf^, len, flags);
+end;
+
+function Recv(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
+begin
+ Result := ssRecv(s, Buf^, len, flags);
+end;
+
+function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin): Integer;
+begin
+ Result := ssSendTo(s, Buf^, len, flags, @addrto, SizeOfVarSin(addrto));
+end;
+
+function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer;
+var
+ x: integer;
+begin
+ x := SizeOf(from);
+ Result := ssRecvFrom(s, Buf^, len, flags, @from, x);
+end;
+
+function Accept(s: TSocket; var addr: TVarSin): TSocket;
+var
+ x: integer;
+begin
+ x := SizeOf(addr);
+ Result := ssAccept(s, @addr, x);
+end;
+
+{=============================================================================}
+function IsNewApi(Family: integer): Boolean;
+begin
+ Result := SockEnhancedApi;
+ if not Result then
+ Result := (Family = AF_INET6) and SockWship6Api;
+end;
+
+function SetVarSin(var Sin: TVarSin; IP, Port: AnsiString; Family, SockProtocol, SockType: integer; PreferIP4: Boolean): integer;
+type
+ pu_long = ^u_long;
+var
+ ProtoEnt: PProtoEnt;
+ ServEnt: PServEnt;
+ HostEnt: PHostEnt;
+ r: integer;
+ Hints1, Hints2: TAddrInfo;
+ Sin1, Sin2: TVarSin;
+ TwoPass: boolean;
+
+ function GetAddr(const IP, port: AnsiString; Hints: TAddrInfo; var Sin: TVarSin): integer;
+ var
+ Addr: PAddrInfo;
+ begin
+ Addr := nil;
+ try
+ FillChar(Sin, Sizeof(Sin), 0);
+ if Hints.ai_socktype = SOCK_RAW then
+ begin
+ Hints.ai_socktype := 0;
+ Hints.ai_protocol := 0;
+ Result := synsock.GetAddrInfo(PAnsiChar(IP), nil, @Hints, Addr);
+ end
+ else
+ begin
+ if (IP = cAnyHost) or (IP = c6AnyHost) then
+ begin
+ Hints.ai_flags := AI_PASSIVE;
+ Result := synsock.GetAddrInfo(nil, PAnsiChar(Port), @Hints, Addr);
+ end
+ else
+ if (IP = cLocalhost) or (IP = c6Localhost) then
+ begin
+ Result := synsock.GetAddrInfo(nil, PAnsiChar(Port), @Hints, Addr);
+ end
+ else
+ begin
+ Result := synsock.GetAddrInfo(PAnsiChar(IP), PAnsiChar(Port), @Hints, Addr);
+ end;
+ end;
+ if Result = 0 then
+ if (Addr <> nil) then
+ Move(Addr^.ai_addr^, Sin, Addr^.ai_addrlen);
+ finally
+ if Assigned(Addr) then
+ synsock.FreeAddrInfo(Addr);
+ end;
+ end;
+
+begin
+ Result := 0;
+ FillChar(Sin, Sizeof(Sin), 0);
+ if not IsNewApi(family) then
+ begin
+ SynSockCS.Enter;
+ try
+ Sin.sin_family := AF_INET;
+ ProtoEnt := synsock.GetProtoByNumber(SockProtocol);
+ ServEnt := nil;
+ if (ProtoEnt <> nil) and (StrToIntDef(string(Port),-1) =-1) then
+ ServEnt := synsock.GetServByName(PAnsiChar(Port), ProtoEnt^.p_name);
+ if ServEnt = nil then
+ Sin.sin_port := synsock.htons(StrToIntDef(string(Port), 0))
+ else
+ Sin.sin_port := ServEnt^.s_port;
+ if IP = cBroadcast then
+ Sin.sin_addr.s_addr := u_long(INADDR_BROADCAST)
+ else
+ begin
+ Sin.sin_addr.s_addr := synsock.inet_addr(PAnsiChar(IP));
+ if Sin.sin_addr.s_addr = u_long(INADDR_NONE) then
+ begin
+ HostEnt := synsock.GetHostByName(PAnsiChar(IP));
+ Result := synsock.WSAGetLastError;
+ if HostEnt <> nil then
+ Sin.sin_addr.S_addr := u_long(Pu_long(HostEnt^.h_addr_list^)^);
+ end;
+ end;
+ finally
+ SynSockCS.Leave;
+ end;
+ end
+ else
+ begin
+ FillChar(Hints1, Sizeof(Hints1), 0);
+ FillChar(Hints2, Sizeof(Hints2), 0);
+ TwoPass := False;
+ if Family = AF_UNSPEC then
+ begin
+ if PreferIP4 then
+ begin
+ Hints1.ai_family := AF_INET;
+ Hints2.ai_family := AF_INET6;
+ TwoPass := True;
+ end
+ else
+ begin
+ Hints2.ai_family := AF_INET;
+ Hints1.ai_family := AF_INET6;
+ TwoPass := True;
+ end;
+ end
+ else
+ Hints1.ai_family := Family;
+
+ Hints1.ai_socktype := SockType;
+ Hints1.ai_protocol := SockProtocol;
+ Hints2.ai_socktype := Hints1.ai_socktype;
+ Hints2.ai_protocol := Hints1.ai_protocol;
+
+ r := GetAddr(IP, Port, Hints1, Sin1);
+ Result := r;
+ sin := sin1;
+ if r <> 0 then
+ if TwoPass then
+ begin
+ r := GetAddr(IP, Port, Hints2, Sin2);
+ Result := r;
+ if r = 0 then
+ sin := sin2;
+ end;
+ end;
+end;
+
+function GetSinIP(Sin: TVarSin): AnsiString;
+var
+ p: PAnsiChar;
+ host, serv: AnsiString;
+ hostlen, servlen: integer;
+ r: integer;
+begin
+ Result := '';
+ if not IsNewApi(Sin.AddressFamily) then
+ begin
+ p := synsock.inet_ntoa(Sin.sin_addr);
+ if p <> nil then
+ Result := p;
+ end
+ else
+ begin
+ hostlen := NI_MAXHOST;
+ servlen := NI_MAXSERV;
+ setlength(host, hostlen);
+ setlength(serv, servlen);
+ r := getnameinfo(@sin, SizeOfVarSin(sin), PAnsiChar(host), hostlen,
+ PAnsiChar(serv), servlen, NI_NUMERICHOST + NI_NUMERICSERV);
+ if r = 0 then
+ Result := PAnsiChar(host);
+ end;
+end;
+
+function GetSinPort(Sin: TVarSin): Integer;
+begin
+ if (Sin.sin_family = AF_INET6) then
+ Result := synsock.ntohs(Sin.sin6_port)
+ else
+ Result := synsock.ntohs(Sin.sin_port);
+end;
+
+procedure ResolveNameToIP(Name: AnsiString; Family, SockProtocol, SockType: integer; const IPList: TStrings);
+type
+ TaPInAddr = array[0..250] of PInAddr;
+ PaPInAddr = ^TaPInAddr;
+var
+ Hints: TAddrInfo;
+ Addr: PAddrInfo;
+ AddrNext: PAddrInfo;
+ r: integer;
+ host, serv: AnsiString;
+ hostlen, servlen: integer;
+ RemoteHost: PHostEnt;
+ IP: u_long;
+ PAdrPtr: PaPInAddr;
+ i: Integer;
+ s: String;
+ InAddr: TInAddr;
+begin
+ IPList.Clear;
+ if not IsNewApi(Family) then
+ begin
+ IP := synsock.inet_addr(PAnsiChar(Name));
+ if IP = u_long(INADDR_NONE) then
+ begin
+ SynSockCS.Enter;
+ try
+ RemoteHost := synsock.GetHostByName(PAnsiChar(Name));
+ if RemoteHost <> nil then
+ begin
+ PAdrPtr := PAPInAddr(RemoteHost^.h_addr_list);
+ i := 0;
+ while PAdrPtr^[i] <> nil do
+ begin
+ InAddr := PAdrPtr^[i]^;
+ s := Format('%d.%d.%d.%d', [InAddr.S_bytes[0], InAddr.S_bytes[1],
+ InAddr.S_bytes[2], InAddr.S_bytes[3]]);
+ IPList.Add(s);
+ Inc(i);
+ end;
+ end;
+ finally
+ SynSockCS.Leave;
+ end;
+ end
+ else
+ IPList.Add(string(Name));
+ end
+ else
+ begin
+ Addr := nil;
+ try
+ FillChar(Hints, Sizeof(Hints), 0);
+ Hints.ai_family := AF_UNSPEC;
+ Hints.ai_socktype := SockType;
+ Hints.ai_protocol := SockProtocol;
+ Hints.ai_flags := 0;
+ r := synsock.GetAddrInfo(PAnsiChar(Name), nil, @Hints, Addr);
+ if r = 0 then
+ begin
+ AddrNext := Addr;
+ while not(AddrNext = nil) do
+ begin
+ if not(((Family = AF_INET6) and (AddrNext^.ai_family = AF_INET))
+ or ((Family = AF_INET) and (AddrNext^.ai_family = AF_INET6))) then
+ begin
+ hostlen := NI_MAXHOST;
+ servlen := NI_MAXSERV;
+ setlength(host, hostlen);
+ setlength(serv, servlen);
+ r := getnameinfo(AddrNext^.ai_addr, AddrNext^.ai_addrlen,
+ PAnsiChar(host), hostlen, PAnsiChar(serv), servlen,
+ NI_NUMERICHOST + NI_NUMERICSERV);
+ if r = 0 then
+ begin
+ host := PAnsiChar(host);
+ IPList.Add(string(host));
+ end;
+ end;
+ AddrNext := AddrNext^.ai_next;
+ end;
+ end;
+ finally
+ if Assigned(Addr) then
+ synsock.FreeAddrInfo(Addr);
+ end;
+ end;
+ if IPList.Count = 0 then
+ IPList.Add(cAnyHost);
+end;
+
+function ResolvePort(Port: AnsiString; Family, SockProtocol, SockType: integer): Word;
+var
+ ProtoEnt: PProtoEnt;
+ ServEnt: PServEnt;
+ Hints: TAddrInfo;
+ Addr: PAddrInfo;
+ r: integer;
+begin
+ Result := 0;
+ if not IsNewApi(Family) then
+ begin
+ SynSockCS.Enter;
+ try
+ ProtoEnt := synsock.GetProtoByNumber(SockProtocol);
+ ServEnt := nil;
+ if ProtoEnt <> nil then
+ ServEnt := synsock.GetServByName(PAnsiChar(Port), ProtoEnt^.p_name);
+ if ServEnt = nil then
+ Result := StrToIntDef(string(Port), 0)
+ else
+ Result := synsock.htons(ServEnt^.s_port);
+ finally
+ SynSockCS.Leave;
+ end;
+ end
+ else
+ begin
+ Addr := nil;
+ try
+ FillChar(Hints, Sizeof(Hints), 0);
+ Hints.ai_family := AF_UNSPEC;
+ Hints.ai_socktype := SockType;
+ Hints.ai_protocol := Sockprotocol;
+ Hints.ai_flags := AI_PASSIVE;
+ r := synsock.GetAddrInfo(nil, PAnsiChar(Port), @Hints, Addr);
+ if (r = 0) and Assigned(Addr) then
+ begin
+ if Addr^.ai_family = AF_INET then
+ Result := synsock.htons(Addr^.ai_addr^.sin_port);
+ if Addr^.ai_family = AF_INET6 then
+ Result := synsock.htons(PSockAddrIn6(Addr^.ai_addr)^.sin6_port);
+ end;
+ finally
+ if Assigned(Addr) then
+ synsock.FreeAddrInfo(Addr);
+ end;
+ end;
+end;
+
+function ResolveIPToName(IP: AnsiString; Family, SockProtocol, SockType: integer): AnsiString;
+var
+ Hints: TAddrInfo;
+ Addr: PAddrInfo;
+ r: integer;
+ host, serv: AnsiString;
+ hostlen, servlen: integer;
+ RemoteHost: PHostEnt;
+ IPn: u_long;
+begin
+ Result := IP;
+ if not IsNewApi(Family) then
+ begin
+ IPn := synsock.inet_addr(PAnsiChar(IP));
+ if IPn <> u_long(INADDR_NONE) then
+ begin
+ SynSockCS.Enter;
+ try
+ RemoteHost := GetHostByAddr(@IPn, SizeOf(IPn), AF_INET);
+ if RemoteHost <> nil then
+ Result := RemoteHost^.h_name;
+ finally
+ SynSockCS.Leave;
+ end;
+ end;
+ end
+ else
+ begin
+ Addr := nil;
+ try
+ FillChar(Hints, Sizeof(Hints), 0);
+ Hints.ai_family := AF_UNSPEC;
+ Hints.ai_socktype := SockType;
+ Hints.ai_protocol := SockProtocol;
+ Hints.ai_flags := 0;
+ r := synsock.GetAddrInfo(PAnsiChar(IP), nil, @Hints, Addr);
+ if (r = 0) and Assigned(Addr)then
+ begin
+ hostlen := NI_MAXHOST;
+ servlen := NI_MAXSERV;
+ setlength(host, hostlen);
+ setlength(serv, servlen);
+ r := getnameinfo(Addr^.ai_addr, Addr^.ai_addrlen,
+ PAnsiChar(host), hostlen, PAnsiChar(serv), servlen,
+ NI_NUMERICSERV);
+ if r = 0 then
+ Result := PAnsiChar(host);
+ end;
+ finally
+ if Assigned(Addr) then
+ synsock.FreeAddrInfo(Addr);
+ end;
+ end;
+end;
+
+{=============================================================================}
+
+function InitSocketInterface(stack: String): Boolean;
+begin
+ Result := False;
+ SockEnhancedApi := False;
+ if stack = '' then
+ stack := DLLStackName;
+ SynSockCS.Enter;
+ try
+ if SynSockCount = 0 then
+ begin
+ SockEnhancedApi := False;
+ SockWship6Api := False;
+ LibHandle := LoadLibrary(PChar(Stack));
+ if LibHandle <> 0 then
+ begin
+ WSAIoctl := GetProcAddress(LibHandle, PAnsiChar(AnsiString('WSAIoctl')));
+ __WSAFDIsSet := GetProcAddress(LibHandle, PAnsiChar(AnsiString('__WSAFDIsSet')));
+ CloseSocket := GetProcAddress(LibHandle, PAnsiChar(AnsiString('closesocket')));
+ IoctlSocket := GetProcAddress(LibHandle, PAnsiChar(AnsiString('ioctlsocket')));
+ WSAGetLastError := GetProcAddress(LibHandle, PAnsiChar(AnsiString('WSAGetLastError')));
+ WSAStartup := GetProcAddress(LibHandle, PAnsiChar(AnsiString('WSAStartup')));
+ WSACleanup := GetProcAddress(LibHandle, PAnsiChar(AnsiString('WSACleanup')));
+ ssAccept := GetProcAddress(LibHandle, PAnsiChar(AnsiString('accept')));
+ ssBind := GetProcAddress(LibHandle, PAnsiChar(AnsiString('bind')));
+ ssConnect := GetProcAddress(LibHandle, PAnsiChar(AnsiString('connect')));
+ ssGetPeerName := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getpeername')));
+ ssGetSockName := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getsockname')));
+ GetSockOpt := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getsockopt')));
+ Htonl := GetProcAddress(LibHandle, PAnsiChar(AnsiString('htonl')));
+ Htons := GetProcAddress(LibHandle, PAnsiChar(AnsiString('htons')));
+ Inet_Addr := GetProcAddress(LibHandle, PAnsiChar(AnsiString('inet_addr')));
+ Inet_Ntoa := GetProcAddress(LibHandle, PAnsiChar(AnsiString('inet_ntoa')));
+ Listen := GetProcAddress(LibHandle, PAnsiChar(AnsiString('listen')));
+ Ntohl := GetProcAddress(LibHandle, PAnsiChar(AnsiString('ntohl')));
+ Ntohs := GetProcAddress(LibHandle, PAnsiChar(AnsiString('ntohs')));
+ ssRecv := GetProcAddress(LibHandle, PAnsiChar(AnsiString('recv')));
+ ssRecvFrom := GetProcAddress(LibHandle, PAnsiChar(AnsiString('recvfrom')));
+ Select := GetProcAddress(LibHandle, PAnsiChar(AnsiString('select')));
+ ssSend := GetProcAddress(LibHandle, PAnsiChar(AnsiString('send')));
+ ssSendTo := GetProcAddress(LibHandle, PAnsiChar(AnsiString('sendto')));
+ SetSockOpt := GetProcAddress(LibHandle, PAnsiChar(AnsiString('setsockopt')));
+ ShutDown := GetProcAddress(LibHandle, PAnsiChar(AnsiString('shutdown')));
+ Socket := GetProcAddress(LibHandle, PAnsiChar(AnsiString('socket')));
+ GetHostByAddr := GetProcAddress(LibHandle, PAnsiChar(AnsiString('gethostbyaddr')));
+ GetHostByName := GetProcAddress(LibHandle, PAnsiChar(AnsiString('gethostbyname')));
+ GetProtoByName := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getprotobyname')));
+ GetProtoByNumber := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getprotobynumber')));
+ GetServByName := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getservbyname')));
+ GetServByPort := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getservbyport')));
+ ssGetHostName := GetProcAddress(LibHandle, PAnsiChar(AnsiString('gethostname')));
+
+{$IFNDEF FORCEOLDAPI}
+ GetAddrInfo := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getaddrinfo')));
+ FreeAddrInfo := GetProcAddress(LibHandle, PAnsiChar(AnsiString('freeaddrinfo')));
+ GetNameInfo := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getnameinfo')));
+ SockEnhancedApi := Assigned(GetAddrInfo) and Assigned(FreeAddrInfo)
+ and Assigned(GetNameInfo);
+ if not SockEnhancedApi then
+ begin
+ LibWship6Handle := LoadLibrary(PChar(DLLWship6));
+ if LibWship6Handle <> 0 then
+ begin
+ GetAddrInfo := GetProcAddress(LibWship6Handle, PAnsiChar(AnsiString('getaddrinfo')));
+ FreeAddrInfo := GetProcAddress(LibWship6Handle, PAnsiChar(AnsiString('freeaddrinfo')));
+ GetNameInfo := GetProcAddress(LibWship6Handle, PAnsiChar(AnsiString('getnameinfo')));
+ SockWship6Api := Assigned(GetAddrInfo) and Assigned(FreeAddrInfo)
+ and Assigned(GetNameInfo);
+ end;
+ end;
+{$ENDIF}
+ Result := True;
+ end;
+ end
+ else Result := True;
+ if Result then
+ Inc(SynSockCount);
+ finally
+ SynSockCS.Leave;
+ end;
+end;
+
+function DestroySocketInterface: Boolean;
+begin
+ SynSockCS.Enter;
+ try
+ Dec(SynSockCount);
+ if SynSockCount < 0 then
+ SynSockCount := 0;
+ if SynSockCount = 0 then
+ begin
+ if LibHandle <> 0 then
+ begin
+ FreeLibrary(libHandle);
+ LibHandle := 0;
+ end;
+ if LibWship6Handle <> 0 then
+ begin
+ FreeLibrary(LibWship6Handle);
+ LibWship6Handle := 0;
+ end;
+ end;
+ finally
+ SynSockCS.Leave;
+ end;
+ Result := True;
+end;
+
+initialization
+begin
+ SynSockCS := SyncObjs.TCriticalSection.Create;
+ SET_IN6_IF_ADDR_ANY (@in6addr_any);
+ SET_LOOPBACK_ADDR6 (@in6addr_loopback);
+end;
+
+finalization
+begin
+ SynSockCS.Free;
+end;
ADDED lib/synapse/source/lib/synachar.pas
Index: lib/synapse/source/lib/synachar.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/lib/synachar.pas
@@ -0,0 +1,2035 @@
+{==============================================================================|
+| Project : Ararat Synapse | 005.002.002 |
+|==============================================================================|
+| Content: Charset conversion support |
+|==============================================================================|
+| Copyright (c)1999-2004, Lukas Gebauer |
+| All rights reserved. |
+| |
+| Redistribution and use in source and binary forms, with or without |
+| modification, are permitted provided that the following conditions are met: |
+| |
+| Redistributions of source code must retain the above copyright notice, this |
+| list of conditions and the following disclaimer. |
+| |
+| Redistributions in binary form must reproduce the above copyright notice, |
+| this list of conditions and the following disclaimer in the documentation |
+| and/or other materials provided with the distribution. |
+| |
+| Neither the name of Lukas Gebauer nor the names of its contributors may |
+| be used to endorse or promote products derived from this software without |
+| specific prior written permission. |
+| |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
+| DAMAGE. |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2000-2004. |
+| All Rights Reserved. |
+|==============================================================================|
+| Contributor(s): |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package |
+| (Found at URL: http://www.ararat.cz/synapse/) |
+|==============================================================================}
+
+{: @abstract(Charset conversion support)
+This unit contains a routines for lot of charset conversions.
+
+It using built-in conversion tables or external Iconv library. Iconv is used
+ when needed conversion is known by Iconv library. When Iconv library is not
+ found or Iconv not know requested conversion, then are internal routines used
+ for conversion. (You can disable Iconv support from your program too!)
+
+Internal routines knows all major charsets for Europe or America. For East-Asian
+ charsets you must use Iconv library!
+}
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+{$Q-}
+{$H+}
+
+{$IFDEF UNICODE}
+ {$WARN IMPLICIT_STRING_CAST OFF}
+ {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+unit synachar;
+
+interface
+
+uses
+{$IFNDEF WIN32}
+ {$IFNDEF FPC}
+ Libc,
+ {$ELSE}
+ {$IFDEF FPC_USE_LIBC}
+ Libc,
+ {$ENDIF}
+ {$ENDIF}
+{$ELSE}
+ Windows,
+{$ENDIF}
+ SysUtils,
+ synautil, synacode, synaicnv;
+
+type
+ {:Type with all supported charsets.}
+ TMimeChar = (ISO_8859_1, ISO_8859_2, ISO_8859_3, ISO_8859_4, ISO_8859_5,
+ ISO_8859_6, ISO_8859_7, ISO_8859_8, ISO_8859_9, ISO_8859_10, ISO_8859_13,
+ ISO_8859_14, ISO_8859_15, CP1250, CP1251, CP1252, CP1253, CP1254, CP1255,
+ CP1256, CP1257, CP1258, KOI8_R, CP895, CP852, UCS_2, UCS_4, UTF_8, UTF_7,
+ UTF_7mod, UCS_2LE, UCS_4LE,
+ //next is supported by Iconv only...
+ UTF_16, UTF_16LE, UTF_32, UTF_32LE, C99, JAVA, ISO_8859_16, KOI8_U, KOI8_RU,
+ CP862, CP866, MAC, MACCE, MACICE, MACCRO, MACRO, MACCYR, MACUK, MACGR, MACTU,
+ MACHEB, MACAR, MACTH, ROMAN8, NEXTSTEP, ARMASCII, GEORGIAN_AC, GEORGIAN_PS,
+ KOI8_T, MULELAO, CP1133, TIS620, CP874, VISCII, TCVN, ISO_IR_14, JIS_X0201,
+ JIS_X0208, JIS_X0212, GB1988_80, GB2312_80, ISO_IR_165, ISO_IR_149, EUC_JP,
+ SHIFT_JIS, CP932, ISO_2022_JP, ISO_2022_JP1, ISO_2022_JP2, GB2312, CP936,
+ GB18030, ISO_2022_CN, ISO_2022_CNE, HZ, EUC_TW, BIG5, CP950, BIG5_HKSCS,
+ EUC_KR, CP949, CP1361, ISO_2022_KR, CP737, CP775, CP853, CP855, CP857,
+ CP858, CP860, CP861, CP863, CP864, CP865, CP869, CP1125);
+
+ {:Set of any charsets.}
+ TMimeSetChar = set of TMimeChar;
+
+const
+ {:Set of charsets supported by Iconv library only.}
+ IconvOnlyChars: set of TMimeChar = [UTF_16, UTF_16LE, UTF_32, UTF_32LE,
+ C99, JAVA, ISO_8859_16, KOI8_U, KOI8_RU, CP862, CP866, MAC, MACCE, MACICE,
+ MACCRO, MACRO, MACCYR, MACUK, MACGR, MACTU, MACHEB, MACAR, MACTH, ROMAN8,
+ NEXTSTEP, ARMASCII, GEORGIAN_AC, GEORGIAN_PS, KOI8_T, MULELAO, CP1133,
+ TIS620, CP874, VISCII, TCVN, ISO_IR_14, JIS_X0201, JIS_X0208, JIS_X0212,
+ GB1988_80, GB2312_80, ISO_IR_165, ISO_IR_149, EUC_JP, SHIFT_JIS, CP932,
+ ISO_2022_JP, ISO_2022_JP1, ISO_2022_JP2, GB2312, CP936, GB18030,
+ ISO_2022_CN, ISO_2022_CNE, HZ, EUC_TW, BIG5, CP950, BIG5_HKSCS, EUC_KR,
+ CP949, CP1361, ISO_2022_KR, CP737, CP775, CP853, CP855, CP857, CP858,
+ CP860, CP861, CP863, CP864, CP865, CP869, CP1125];
+
+ {:Set of charsets supported by internal routines only.}
+ NoIconvChars: set of TMimeChar = [CP895, UTF_7mod];
+
+ {:null character replace table. (Usable for disable charater replacing.)}
+ Replace_None: array[0..0] of Word =
+ (0);
+
+ {:Character replace table for remove Czech diakritics.}
+ Replace_Czech: array[0..59] of Word =
+ (
+ $00E1, $0061,
+ $010D, $0063,
+ $010F, $0064,
+ $010E, $0044,
+ $00E9, $0065,
+ $011B, $0065,
+ $00ED, $0069,
+ $0148, $006E,
+ $00F3, $006F,
+ $0159, $0072,
+ $0161, $0073,
+ $0165, $0074,
+ $00FA, $0075,
+ $016F, $0075,
+ $00FD, $0079,
+ $017E, $007A,
+ $00C1, $0041,
+ $010C, $0043,
+ $00C9, $0045,
+ $011A, $0045,
+ $00CD, $0049,
+ $0147, $004E,
+ $00D3, $004F,
+ $0158, $0052,
+ $0160, $0053,
+ $0164, $0054,
+ $00DA, $0055,
+ $016E, $0055,
+ $00DD, $0059,
+ $017D, $005A
+ );
+
+var
+ {:By this you can generally disable/enable Iconv support.}
+ DisableIconv: Boolean = False;
+
+ {:Default set of charsets for @link(IdealCharsetCoding) function.}
+ IdealCharsets: TMimeSetChar =
+ [ISO_8859_1, ISO_8859_2, ISO_8859_3, ISO_8859_4, ISO_8859_5,
+ ISO_8859_6, ISO_8859_7, ISO_8859_8, ISO_8859_9, ISO_8859_10,
+ KOI8_R, KOI8_U
+ {$IFNDEF CIL} //error URW778 ??? :-O
+ , GB2312, EUC_KR, ISO_2022_JP, EUC_TW
+ {$ENDIF}
+ ];
+
+{==============================================================================}
+{:Convert Value from one charset to another. See: @link(CharsetConversionEx)}
+function CharsetConversion(const Value: AnsiString; CharFrom: TMimeChar;
+ CharTo: TMimeChar): AnsiString;
+
+{:Convert Value from one charset to another with additional character conversion.
+see: @link(Replace_None) and @link(Replace_Czech)}
+function CharsetConversionEx(const Value: AnsiString; CharFrom: TMimeChar;
+ CharTo: TMimeChar; const TransformTable: array of Word): AnsiString;
+
+{:Convert Value from one charset to another with additional character conversion.
+ This funtion is similar to @link(CharsetConversionEx), but you can disable
+ transliteration of unconvertible characters.}
+function CharsetConversionTrans(Value: AnsiString; CharFrom: TMimeChar;
+ CharTo: TMimeChar; const TransformTable: array of Word; Translit: Boolean): AnsiString;
+
+{:Returns charset used by operating system.}
+function GetCurCP: TMimeChar;
+
+{:Returns charset used by operating system as OEM charset. (in Windows DOS box,
+ for example)}
+function GetCurOEMCP: TMimeChar;
+
+{:Converting string with charset name to TMimeChar.}
+function GetCPFromID(Value: AnsiString): TMimeChar;
+
+{:Converting TMimeChar to string with name of charset.}
+function GetIDFromCP(Value: TMimeChar): AnsiString;
+
+{:return @true when value need to be converted. (It is not 7-bit ASCII)}
+function NeedCharsetConversion(const Value: AnsiString): Boolean;
+
+{:Finding best target charset from set of TMimeChars with minimal count of
+ unconvertible characters.}
+function IdealCharsetCoding(const Value: AnsiString; CharFrom: TMimeChar;
+ CharTo: TMimeSetChar): TMimeChar;
+
+{:Return BOM (Byte Order Mark) for given unicode charset.}
+function GetBOM(Value: TMimeChar): AnsiString;
+
+{:Convert binary string with unicode content to WideString.}
+function StringToWide(const Value: AnsiString): WideString;
+
+{:Convert WideString to binary string with unicode content.}
+function WideToString(const Value: WideString): AnsiString;
+
+{==============================================================================}
+implementation
+
+//character transcoding tables X to UCS-2
+{
+//dummy table
+$0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
+$0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
+$0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
+$0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
+$00A0, $00A1, $00A2, $00A3, $00A4, $00A5, $00A6, $00A7,
+$00A8, $00A9, $00AA, $00AB, $00AC, $00AD, $00AE, $00AF,
+$00B0, $00B1, $00B2, $00B3, $00B4, $00B5, $00B6, $00B7,
+$00B8, $00B9, $00BA, $00BB, $00BC, $00BD, $00BE, $00BF,
+$00C0, $00C1, $00C2, $00C3, $00C4, $00C5, $00C6, $00C7,
+$00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF,
+$00D0, $00D1, $00D2, $00D3, $00D4, $00D5, $00D6, $00D7,
+$00D8, $00D9, $00DA, $00DB, $00DC, $00DD, $00DE, $00DF,
+$00E0, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $00E7,
+$00E8, $00E9, $00EA, $00EB, $00EC, $00ED, $00EE, $00EF,
+$00F0, $00F1, $00F2, $00F3, $00F4, $00F5, $00F6, $00F7,
+$00F8, $00F9, $00FA, $00FB, $00FC, $00FD, $00FE, $00FF
+}
+
+const
+
+{Latin-1
+ Danish, Dutch, English, Faeroese, Finnish, French, German, Icelandic,
+ Irish, Italian, Norwegian, Portuguese, Spanish and Swedish.
+}
+ CharISO_8859_1: array[128..255] of Word =
+ (
+ $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
+ $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
+ $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
+ $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
+ $00A0, $00A1, $00A2, $00A3, $00A4, $00A5, $00A6, $00A7,
+ $00A8, $00A9, $00AA, $00AB, $00AC, $00AD, $00AE, $00AF,
+ $00B0, $00B1, $00B2, $00B3, $00B4, $00B5, $00B6, $00B7,
+ $00B8, $00B9, $00BA, $00BB, $00BC, $00BD, $00BE, $00BF,
+ $00C0, $00C1, $00C2, $00C3, $00C4, $00C5, $00C6, $00C7,
+ $00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF,
+ $00D0, $00D1, $00D2, $00D3, $00D4, $00D5, $00D6, $00D7,
+ $00D8, $00D9, $00DA, $00DB, $00DC, $00DD, $00DE, $00DF,
+ $00E0, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $00E7,
+ $00E8, $00E9, $00EA, $00EB, $00EC, $00ED, $00EE, $00EF,
+ $00F0, $00F1, $00F2, $00F3, $00F4, $00F5, $00F6, $00F7,
+ $00F8, $00F9, $00FA, $00FB, $00FC, $00FD, $00FE, $00FF
+ );
+
+{Latin-2
+ Albanian, Czech, English, German, Hungarian, Polish, Rumanian,
+ Serbo-Croatian, Slovak, Slovene and Swedish.
+}
+ CharISO_8859_2: array[128..255] of Word =
+ (
+ $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
+ $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
+ $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
+ $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
+ $00A0, $0104, $02D8, $0141, $00A4, $013D, $015A, $00A7,
+ $00A8, $0160, $015E, $0164, $0179, $00AD, $017D, $017B,
+ $00B0, $0105, $02DB, $0142, $00B4, $013E, $015B, $02C7,
+ $00B8, $0161, $015F, $0165, $017A, $02DD, $017E, $017C,
+ $0154, $00C1, $00C2, $0102, $00C4, $0139, $0106, $00C7,
+ $010C, $00C9, $0118, $00CB, $011A, $00CD, $00CE, $010E,
+ $0110, $0143, $0147, $00D3, $00D4, $0150, $00D6, $00D7,
+ $0158, $016E, $00DA, $0170, $00DC, $00DD, $0162, $00DF,
+ $0155, $00E1, $00E2, $0103, $00E4, $013A, $0107, $00E7,
+ $010D, $00E9, $0119, $00EB, $011B, $00ED, $00EE, $010F,
+ $0111, $0144, $0148, $00F3, $00F4, $0151, $00F6, $00F7,
+ $0159, $016F, $00FA, $0171, $00FC, $00FD, $0163, $02D9
+ );
+
+{Latin-3
+ Afrikaans, Catalan, English, Esperanto, French, Galician,
+ German, Italian, Maltese and Turkish.
+}
+ CharISO_8859_3: array[128..255] of Word =
+ (
+ $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
+ $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
+ $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
+ $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
+ $00A0, $0126, $02D8, $00A3, $00A4, $FFFD, $0124, $00A7,
+ $00A8, $0130, $015E, $011E, $0134, $00AD, $FFFD, $017B,
+ $00B0, $0127, $00B2, $00B3, $00B4, $00B5, $0125, $00B7,
+ $00B8, $0131, $015F, $011F, $0135, $00BD, $FFFD, $017C,
+ $00C0, $00C1, $00C2, $FFFD, $00C4, $010A, $0108, $00C7,
+ $00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF,
+ $FFFD, $00D1, $00D2, $00D3, $00D4, $0120, $00D6, $00D7,
+ $011C, $00D9, $00DA, $00DB, $00DC, $016C, $015C, $00DF,
+ $00E0, $00E1, $00E2, $FFFD, $00E4, $010B, $0109, $00E7,
+ $00E8, $00E9, $00EA, $00EB, $00EC, $00ED, $00EE, $00EF,
+ $FFFD, $00F1, $00F2, $00F3, $00F4, $0121, $00F6, $00F7,
+ $011D, $00F9, $00FA, $00FB, $00FC, $016D, $015D, $02D9
+ );
+
+{Latin-4
+ Danish, English, Estonian, Finnish, German, Greenlandic,
+ Lappish, Latvian, Lithuanian, Norwegian and Swedish.
+}
+ CharISO_8859_4: array[128..255] of Word =
+ (
+ $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
+ $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
+ $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
+ $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
+ $00A0, $0104, $0138, $0156, $00A4, $0128, $013B, $00A7,
+ $00A8, $0160, $0112, $0122, $0166, $00AD, $017D, $00AF,
+ $00B0, $0105, $02DB, $0157, $00B4, $0129, $013C, $02C7,
+ $00B8, $0161, $0113, $0123, $0167, $014A, $017E, $014B,
+ $0100, $00C1, $00C2, $00C3, $00C4, $00C5, $00C6, $012E,
+ $010C, $00C9, $0118, $00CB, $0116, $00CD, $00CE, $012A,
+ $0110, $0145, $014C, $0136, $00D4, $00D5, $00D6, $00D7,
+ $00D8, $0172, $00DA, $00DB, $00DC, $0168, $016A, $00DF,
+ $0101, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $012F,
+ $010D, $00E9, $0119, $00EB, $0117, $00ED, $00EE, $012B,
+ $0111, $0146, $014D, $0137, $00F4, $00F5, $00F6, $00F7,
+ $00F8, $0173, $00FA, $00FB, $00FC, $0169, $016B, $02D9
+ );
+
+{CYRILLIC
+ Bulgarian, Bielorussian, English, Macedonian, Russian,
+ Serbo-Croatian and Ukrainian.
+}
+ CharISO_8859_5: array[128..255] of Word =
+ (
+ $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
+ $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
+ $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
+ $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
+ $00A0, $0401, $0402, $0403, $0404, $0405, $0406, $0407,
+ $0408, $0409, $040A, $040B, $040C, $00AD, $040E, $040F,
+ $0410, $0411, $0412, $0413, $0414, $0415, $0416, $0417,
+ $0418, $0419, $041A, $041B, $041C, $041D, $041E, $041F,
+ $0420, $0421, $0422, $0423, $0424, $0425, $0426, $0427,
+ $0428, $0429, $042A, $042B, $042C, $042D, $042E, $042F,
+ $0430, $0431, $0432, $0433, $0434, $0435, $0436, $0437,
+ $0438, $0439, $043A, $043B, $043C, $043D, $043E, $043F,
+ $0440, $0441, $0442, $0443, $0444, $0445, $0446, $0447,
+ $0448, $0449, $044A, $044B, $044C, $044D, $044E, $044F,
+ $2116, $0451, $0452, $0453, $0454, $0455, $0456, $0457,
+ $0458, $0459, $045A, $045B, $045C, $00A7, $045E, $045F
+ );
+
+{ARABIC
+}
+ CharISO_8859_6: array[128..255] of Word =
+ (
+ $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
+ $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
+ $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
+ $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
+ $00A0, $FFFD, $FFFD, $FFFD, $00A4, $FFFD, $FFFD, $FFFD,
+ $FFFD, $FFFD, $FFFD, $FFFD, $060C, $00AD, $FFFD, $FFFD,
+ $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD,
+ $FFFD, $FFFD, $FFFD, $061B, $FFFD, $FFFD, $FFFD, $061F,
+ $FFFD, $0621, $0622, $0623, $0624, $0625, $0626, $0627,
+ $0628, $0629, $062A, $062B, $062C, $062D, $062E, $062F,
+ $0630, $0631, $0632, $0633, $0634, $0635, $0636, $0637,
+ $0638, $0639, $063A, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD,
+ $0640, $0641, $0642, $0643, $0644, $0645, $0646, $0647,
+ $0648, $0649, $064A, $064B, $064C, $064D, $064E, $064F,
+ $0650, $0651, $0652, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD,
+ $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD
+ );
+
+{GREEK
+}
+ CharISO_8859_7: array[128..255] of Word =
+ (
+ $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
+ $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
+ $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
+ $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
+ $00A0, $2018, $2019, $00A3, $FFFD, $FFFD, $00A6, $00A7,
+ $00A8, $00A9, $FFFD, $00AB, $00AC, $00AD, $FFFD, $2015,
+ $00B0, $00B1, $00B2, $00B3, $0384, $0385, $0386, $00B7,
+ $0388, $0389, $038A, $00BB, $038C, $00BD, $038E, $038F,
+ $0390, $0391, $0392, $0393, $0394, $0395, $0396, $0397,
+ $0398, $0399, $039A, $039B, $039C, $039D, $039E, $039F,
+ $03A0, $03A1, $FFFD, $03A3, $03A4, $03A5, $03A6, $03A7,
+ $03A8, $03A9, $03AA, $03AB, $03AC, $03AD, $03AE, $03AF,
+ $03B0, $03B1, $03B2, $03B3, $03B4, $03B5, $03B6, $03B7,
+ $03B8, $03B9, $03BA, $03BB, $03BC, $03BD, $03BE, $03BF,
+ $03C0, $03C1, $03C2, $03C3, $03C4, $03C5, $03C6, $03C7,
+ $03C8, $03C9, $03CA, $03CB, $03CC, $03CD, $03CE, $FFFD
+ );
+
+{HEBREW
+}
+ CharISO_8859_8: array[128..255] of Word =
+ (
+ $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
+ $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
+ $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
+ $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
+ $00A0, $FFFD, $00A2, $00A3, $00A4, $00A5, $00A6, $00A7,
+ $00A8, $00A9, $00D7, $00AB, $00AC, $00AD, $00AE, $00AF,
+ $00B0, $00B1, $00B2, $00B3, $00B4, $00B5, $00B6, $00B7,
+ $00B8, $00B9, $00F7, $00BB, $00BC, $00BD, $00BE, $FFFD,
+ $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD,
+ $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD,
+ $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD,
+ $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $2017,
+ $05D0, $05D1, $05D2, $05D3, $05D4, $05D5, $05D6, $05D7,
+ $05D8, $05D9, $05DA, $05DB, $05DC, $05DD, $05DE, $05DF,
+ $05E0, $05E1, $05E2, $05E3, $05E4, $05E5, $05E6, $05E7,
+ $05E8, $05E9, $05EA, $FFFD, $FFFD, $200E, $200F, $FFFD
+ );
+
+{Latin-5
+ English, Finnish, French, German, Irish, Italian, Norwegian,
+ Portuguese, Spanish, Swedish and Turkish.
+}
+ CharISO_8859_9: array[128..255] of Word =
+ (
+ $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
+ $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
+ $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
+ $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
+ $00A0, $0104, $02D8, $0141, $00A4, $013D, $015A, $00A7,
+ $00A8, $0160, $015E, $0164, $0179, $00AD, $017D, $017B,
+ $00B0, $0105, $02DB, $0142, $00B4, $013E, $015B, $02C7,
+ $00B8, $0161, $015F, $0165, $017A, $02DD, $017E, $017C,
+ $0154, $00C1, $00C2, $0102, $00C4, $0139, $0106, $00C7,
+ $010C, $00C9, $0118, $00CB, $011A, $00CD, $00CE, $010E,
+ $011E, $00D1, $00D2, $00D3, $00D4, $00D5, $00D6, $00D7,
+ $00D8, $00D9, $00DA, $00DB, $00DC, $0130, $015E, $00DF,
+ $00E0, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $00E7,
+ $00E8, $00E9, $00EA, $00EB, $00EC, $00ED, $00EE, $00EF,
+ $011F, $00F1, $00F2, $00F3, $00F4, $00F5, $00F6, $00F7,
+ $00F8, $00F9, $00FA, $00FB, $00FC, $0131, $015F, $00FF
+ );
+
+{Latin-6
+ Danish, English, Estonian, Faeroese, Finnish, German, Greenlandic,
+ Icelandic, Lappish, Latvian, Lithuanian, Norwegian and Swedish.
+}
+ CharISO_8859_10: array[128..255] of Word =
+ (
+ $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
+ $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
+ $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
+ $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
+ $00A0, $0104, $0112, $0122, $012A, $0128, $0136, $00A7,
+ $013B, $0110, $0160, $0166, $017D, $00AD, $016A, $014A,
+ $00B0, $0105, $0113, $0123, $012B, $0129, $0137, $00B7,
+ $013C, $0111, $0161, $0167, $017E, $2015, $016B, $014B,
+ $0100, $00C1, $00C2, $00C3, $00C4, $00C5, $00C6, $012E,
+ $010C, $00C9, $0118, $00CB, $0116, $00CD, $00CE, $00CF,
+ $00D0, $0145, $014C, $00D3, $00D4, $00D5, $00D6, $0168,
+ $00D8, $0172, $00DA, $00DB, $00DC, $00DD, $00DE, $00DF,
+ $0101, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $012F,
+ $010D, $00E9, $0119, $00EB, $0117, $00ED, $00EE, $00EF,
+ $00F0, $0146, $014D, $00F3, $00F4, $00F5, $00F6, $0169,
+ $00F8, $0173, $00FA, $00FB, $00FC, $00FD, $00FE, $0138
+ );
+
+ CharISO_8859_13: array[128..255] of Word =
+ (
+ $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
+ $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
+ $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
+ $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
+ $00A0, $201D, $00A2, $00A3, $00A4, $201E, $00A6, $00A7,
+ $00D8, $00A9, $0156, $00AB, $00AC, $00AD, $00AE, $00C6,
+ $00B0, $00B1, $00B2, $00B3, $201C, $00B5, $00B6, $00B7,
+ $00F8, $00B9, $0157, $00BB, $00BC, $00BD, $00BE, $00E6,
+ $0104, $012E, $0100, $0106, $00C4, $00C5, $0118, $0112,
+ $010C, $00C9, $0179, $0116, $0122, $0136, $012A, $013B,
+ $0160, $0143, $0145, $00D3, $014C, $00D5, $00D6, $00D7,
+ $0172, $0141, $015A, $016A, $00DC, $017B, $017D, $00DF,
+ $0105, $012F, $0101, $0107, $00E4, $00E5, $0119, $0113,
+ $010D, $00E9, $017A, $0117, $0123, $0137, $012B, $013C,
+ $0161, $0144, $0146, $00F3, $014D, $00F5, $00F6, $00F7,
+ $0173, $0142, $015B, $016B, $00FC, $017C, $017E, $2019
+ );
+
+ CharISO_8859_14: array[128..255] of Word =
+ (
+ $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
+ $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
+ $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
+ $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
+ $00A0, $1E02, $1E03, $00A3, $010A, $010B, $1E0A, $00A7,
+ $1E80, $00A9, $1E82, $1E0B, $1EF2, $00AD, $00AE, $0178,
+ $1E1E, $1E1F, $0120, $0121, $1E40, $1E41, $00B6, $1E56,
+ $1E81, $1E57, $1E83, $1E60, $1EF3, $1E84, $1E85, $1E61,
+ $00C0, $00C1, $00C2, $00C3, $00C4, $00C5, $00C6, $00C7,
+ $00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF,
+ $0174, $00D1, $00D2, $00D3, $00D4, $00D5, $00D6, $1E6A,
+ $00D8, $00D9, $00DA, $00DB, $00DC, $00DD, $0176, $00DF,
+ $00E0, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $00E7,
+ $00E8, $00E9, $00EA, $00EB, $00EC, $00ED, $00EE, $00EF,
+ $0175, $00F1, $00F2, $00F3, $00F4, $00F5, $00F6, $1E6B,
+ $00F8, $00F9, $00FA, $00FB, $00FC, $00FD, $0177, $00FF
+ );
+
+ CharISO_8859_15: array[128..255] of Word =
+ (
+ $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
+ $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
+ $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
+ $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
+ $00A0, $00A1, $00A2, $00A3, $20AC, $00A5, $0160, $00A7,
+ $0161, $00A9, $00AA, $00AB, $00AC, $00AD, $00AE, $00AF,
+ $00B0, $00B1, $00B2, $00B3, $017D, $00B5, $00B6, $00B7,
+ $017E, $00B9, $00BA, $00BB, $0152, $0153, $0178, $00BF,
+ $00C0, $00C1, $00C2, $00C3, $00C4, $00C5, $00C6, $00C7,
+ $00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF,
+ $00D0, $00D1, $00D2, $00D3, $00D4, $00D5, $00D6, $00D7,
+ $00D8, $00D9, $00DA, $00DB, $00DC, $00DD, $00DE, $00DF,
+ $00E0, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $00E7,
+ $00E8, $00E9, $00EA, $00EB, $00EC, $00ED, $00EE, $00EF,
+ $00F0, $00F1, $00F2, $00F3, $00F4, $00F5, $00F6, $00F7,
+ $00F8, $00F9, $00FA, $00FB, $00FC, $00FD, $00FE, $00FF
+ );
+
+{Eastern European
+}
+ CharCP_1250: array[128..255] of Word =
+ (
+ $20AC, $FFFD, $201A, $FFFD, $201E, $2026, $2020, $2021,
+ $FFFD, $2030, $0160, $2039, $015A, $0164, $017D, $0179,
+ $FFFD, $2018, $2019, $201C, $201D, $2022, $2013, $2014,
+ $FFFD, $2122, $0161, $203A, $015B, $0165, $017E, $017A,
+ $00A0, $02C7, $02D8, $0141, $00A4, $0104, $00A6, $00A7,
+ $00A8, $00A9, $015E, $00AB, $00AC, $00AD, $00AE, $017B,
+ $00B0, $00B1, $02DB, $0142, $00B4, $00B5, $00B6, $00B7,
+ $00B8, $0105, $015F, $00BB, $013D, $02DD, $013E, $017C,
+ $0154, $00C1, $00C2, $0102, $00C4, $0139, $0106, $00C7,
+ $010C, $00C9, $0118, $00CB, $011A, $00CD, $00CE, $010E,
+ $0110, $0143, $0147, $00D3, $00D4, $0150, $00D6, $00D7,
+ $0158, $016E, $00DA, $0170, $00DC, $00DD, $0162, $00DF,
+ $0155, $00E1, $00E2, $0103, $00E4, $013A, $0107, $00E7,
+ $010D, $00E9, $0119, $00EB, $011B, $00ED, $00EE, $010F,
+ $0111, $0144, $0148, $00F3, $00F4, $0151, $00F6, $00F7,
+ $0159, $016F, $00FA, $0171, $00FC, $00FD, $0163, $02D9
+ );
+
+{Cyrillic
+}
+ CharCP_1251: array[128..255] of Word =
+ (
+ $0402, $0403, $201A, $0453, $201E, $2026, $2020, $2021,
+ $20AC, $2030, $0409, $2039, $040A, $040C, $040B, $040F,
+ $0452, $2018, $2019, $201C, $201D, $2022, $2013, $2014,
+ $FFFD, $2122, $0459, $203A, $045A, $045C, $045B, $045F,
+ $00A0, $040E, $045E, $0408, $00A4, $0490, $00A6, $00A7,
+ $0401, $00A9, $0404, $00AB, $00AC, $00AD, $00AE, $0407,
+ $00B0, $00B1, $0406, $0456, $0491, $00B5, $00B6, $00B7,
+ $0451, $2116, $0454, $00BB, $0458, $0405, $0455, $0457,
+ $0410, $0411, $0412, $0413, $0414, $0415, $0416, $0417,
+ $0418, $0419, $041A, $041B, $041C, $041D, $041E, $041F,
+ $0420, $0421, $0422, $0423, $0424, $0425, $0426, $0427,
+ $0428, $0429, $042A, $042B, $042C, $042D, $042E, $042F,
+ $0430, $0431, $0432, $0433, $0434, $0435, $0436, $0437,
+ $0438, $0439, $043A, $043B, $043C, $043D, $043E, $043F,
+ $0440, $0441, $0442, $0443, $0444, $0445, $0446, $0447,
+ $0448, $0449, $044A, $044B, $044C, $044D, $044E, $044F
+ );
+
+{Latin-1 (US, Western Europe)
+}
+ CharCP_1252: array[128..255] of Word =
+ (
+ $20AC, $FFFD, $201A, $0192, $201E, $2026, $2020, $2021,
+ $02C6, $2030, $0160, $2039, $0152, $FFFD, $017D, $FFFD,
+ $FFFD, $2018, $2019, $201C, $201D, $2022, $2013, $2014,
+ $02DC, $2122, $0161, $203A, $0153, $FFFD, $017E, $0178,
+ $00A0, $00A1, $00A2, $00A3, $00A4, $00A5, $00A6, $00A7,
+ $00A8, $00A9, $00AA, $00AB, $00AC, $00AD, $00AE, $00AF,
+ $00B0, $00B1, $00B2, $00B3, $00B4, $00B5, $00B6, $00B7,
+ $00B8, $00B9, $00BA, $00BB, $00BC, $00BD, $00BE, $00BF,
+ $00C0, $00C1, $00C2, $00C3, $00C4, $00C5, $00C6, $00C7,
+ $00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF,
+ $00D0, $00D1, $00D2, $00D3, $00D4, $00D5, $00D6, $00D7,
+ $00D8, $00D9, $00DA, $00DB, $00DC, $00DD, $00DE, $00DF,
+ $00E0, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $00E7,
+ $00E8, $00E9, $00EA, $00EB, $00EC, $00ED, $00EE, $00EF,
+ $00F0, $00F1, $00F2, $00F3, $00F4, $00F5, $00F6, $00F7,
+ $00F8, $00F9, $00FA, $00FB, $00FC, $00FD, $00FE, $00FF
+ );
+
+{Greek
+}
+ CharCP_1253: array[128..255] of Word =
+ (
+ $20AC, $FFFD, $201A, $0192, $201E, $2026, $2020, $2021,
+ $FFFD, $2030, $FFFD, $2039, $FFFD, $FFFD, $FFFD, $FFFD,
+ $FFFD, $2018, $2019, $201C, $201D, $2022, $2013, $2014,
+ $FFFD, $2122, $FFFD, $203A, $FFFD, $FFFD, $FFFD, $FFFD,
+ $00A0, $0385, $0386, $00A3, $00A4, $00A5, $00A6, $00A7,
+ $00A8, $00A9, $FFFD, $00AB, $00AC, $00AD, $00AE, $2015,
+ $00B0, $00B1, $00B2, $00B3, $0384, $00B5, $00B6, $00B7,
+ $0388, $0389, $038A, $00BB, $038C, $00BD, $038E, $038F,
+ $0390, $0391, $0392, $0393, $0394, $0395, $0396, $0397,
+ $0398, $0399, $039A, $039B, $039C, $039D, $039E, $039F,
+ $03A0, $03A1, $FFFD, $03A3, $03A4, $03A5, $03A6, $03A7,
+ $03A8, $03A9, $03AA, $03AB, $03AC, $03AD, $03AE, $03AF,
+ $03B0, $03B1, $03B2, $03B3, $03B4, $03B5, $03B6, $03B7,
+ $03B8, $03B9, $03BA, $03BB, $03BC, $03BD, $03BE, $03BF,
+ $03C0, $03C1, $03C2, $03C3, $03C4, $03C5, $03C6, $03C7,
+ $03C8, $03C9, $03CA, $03CB, $03CC, $03CD, $03CE, $FFFD
+ );
+
+{Turkish
+}
+ CharCP_1254: array[128..255] of Word =
+ (
+ $20AC, $FFFD, $201A, $0192, $201E, $2026, $2020, $2021,
+ $02C6, $2030, $0160, $2039, $0152, $FFFD, $FFFD, $FFFD,
+ $FFFD, $2018, $2019, $201C, $201D, $2022, $2013, $2014,
+ $02DC, $2122, $0161, $203A, $0153, $FFFD, $FFFD, $0178,
+ $00A0, $00A1, $00A2, $00A3, $00A4, $00A5, $00A6, $00A7,
+ $00A8, $00A9, $00AA, $00AB, $00AC, $00AD, $00AE, $00AF,
+ $00B0, $00B1, $00B2, $00B3, $00B4, $00B5, $00B6, $00B7,
+ $00B8, $00B9, $00BA, $00BB, $00BC, $00BD, $00BE, $00BF,
+ $00C0, $00C1, $00C2, $00C3, $00C4, $00C5, $00C6, $00C7,
+ $00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF,
+ $011E, $00D1, $00D2, $00D3, $00D4, $00D5, $00D6, $00D7,
+ $00D8, $00D9, $00DA, $00DB, $00DC, $0130, $015E, $00DF,
+ $00E0, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $00E7,
+ $00E8, $00E9, $00EA, $00EB, $00EC, $00ED, $00EE, $00EF,
+ $011F, $00F1, $00F2, $00F3, $00F4, $00F5, $00F6, $00F7,
+ $00F8, $00F9, $00FA, $00FB, $00FC, $0131, $015F, $00FF
+ );
+
+{Hebrew
+}
+ CharCP_1255: array[128..255] of Word =
+ (
+ $20AC, $FFFD, $201A, $0192, $201E, $2026, $2020, $2021,
+ $02C6, $2030, $FFFD, $2039, $FFFD, $FFFD, $FFFD, $FFFD,
+ $FFFD, $2018, $2019, $201C, $201D, $2022, $2013, $2014,
+ $02DC, $2122, $FFFD, $203A, $FFFD, $FFFD, $FFFD, $FFFD,
+ $00A0, $00A1, $00A2, $00A3, $20AA, $00A5, $00A6, $00A7,
+ $00A8, $00A9, $00D7, $00AB, $00AC, $00AD, $00AE, $00AF,
+ $00B0, $00B1, $00B2, $00B3, $00B4, $00B5, $00B6, $00B7,
+ $00B8, $00B9, $00F7, $00BB, $00BC, $00BD, $00BE, $00BF,
+ $05B0, $05B1, $05B2, $05B3, $05B4, $05B5, $05B6, $05B7,
+ $05B8, $05B9, $FFFD, $05BB, $05BC, $05BD, $05BE, $05BF,
+ $05C0, $05C1, $05C2, $05C3, $05F0, $05F1, $05F2, $05F3,
+ $05F4, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD,
+ $05D0, $05D1, $05D2, $05D3, $05D4, $05D5, $05D6, $05D7,
+ $05D8, $05D9, $05DA, $05DB, $05DC, $05DD, $05DE, $05DF,
+ $05E0, $05E1, $05E2, $05E3, $05E4, $05E5, $05E6, $05E7,
+ $05E8, $05E9, $05EA, $FFFD, $FFFD, $200E, $200F, $FFFD
+ );
+
+{Arabic
+}
+ CharCP_1256: array[128..255] of Word =
+ (
+ $20AC, $067E, $201A, $0192, $201E, $2026, $2020, $2021,
+ $02C6, $2030, $0679, $2039, $0152, $0686, $0698, $0688,
+ $06AF, $2018, $2019, $201C, $201D, $2022, $2013, $2014,
+ $06A9, $2122, $0691, $203A, $0153, $200C, $200D, $06BA,
+ $00A0, $060C, $00A2, $00A3, $00A4, $00A5, $00A6, $00A7,
+ $00A8, $00A9, $06BE, $00AB, $00AC, $00AD, $00AE, $00AF,
+ $00B0, $00B1, $00B2, $00B3, $00B4, $00B5, $00B6, $00B7,
+ $00B8, $00B9, $061B, $00BB, $00BC, $00BD, $00BE, $061F,
+ $06C1, $0621, $0622, $0623, $0624, $0625, $0626, $0627,
+ $0628, $0629, $062A, $062B, $062C, $062D, $062E, $062F,
+ $0630, $0631, $0632, $0633, $0634, $0635, $0636, $00D7,
+ $0637, $0638, $0639, $063A, $0640, $0641, $0642, $0643,
+ $00E0, $0644, $00E2, $0645, $0646, $0647, $0648, $00E7,
+ $00E8, $00E9, $00EA, $00EB, $0649, $064A, $00EE, $00EF,
+ $064B, $064C, $064D, $064E, $00F4, $064F, $0650, $00F7,
+ $0651, $00F9, $0652, $00FB, $00FC, $200E, $200F, $06D2
+ );
+
+{Baltic
+}
+ CharCP_1257: array[128..255] of Word =
+ (
+ $20AC, $FFFD, $201A, $FFFD, $201E, $2026, $2020, $2021,
+ $FFFD, $2030, $FFFD, $2039, $FFFD, $00A8, $02C7, $00B8,
+ $FFFD, $2018, $2019, $201C, $201D, $2022, $2013, $2014,
+ $FFFD, $2122, $FFFD, $203A, $FFFD, $00AF, $02DB, $FFFD,
+ $00A0, $FFFD, $00A2, $00A3, $00A4, $FFFD, $00A6, $00A7,
+ $00D8, $00A9, $0156, $00AB, $00AC, $00AD, $00AE, $00C6,
+ $00B0, $00B1, $00B2, $00B3, $00B4, $00B5, $00B6, $00B7,
+ $00F8, $00B9, $0157, $00BB, $00BC, $00BD, $00BE, $00E6,
+ $0104, $012E, $0100, $0106, $00C4, $00C5, $0118, $0112,
+ $010C, $00C9, $0179, $0116, $0122, $0136, $012A, $013B,
+ $0160, $0143, $0145, $00D3, $014C, $00D5, $00D6, $00D7,
+ $0172, $0141, $015A, $016A, $00DC, $017B, $017D, $00DF,
+ $0105, $012F, $0101, $0107, $00E4, $00E5, $0119, $0113,
+ $010D, $00E9, $017A, $0117, $0123, $0137, $012B, $013C,
+ $0161, $0144, $0146, $00F3, $014D, $00F5, $00F6, $00F7,
+ $0173, $0142, $015B, $016B, $00FC, $017C, $017E, $02D9
+ );
+
+{Vietnamese
+}
+ CharCP_1258: array[128..255] of Word =
+ (
+ $20AC, $FFFD, $201A, $0192, $201E, $2026, $2020, $2021,
+ $02C6, $2030, $FFFD, $2039, $0152, $FFFD, $FFFD, $FFFD,
+ $FFFD, $2018, $2019, $201C, $201D, $2022, $2013, $2014,
+ $02DC, $2122, $FFFD, $203A, $0153, $FFFD, $FFFD, $0178,
+ $00A0, $00A1, $00A2, $00A3, $00A4, $00A5, $00A6, $00A7,
+ $00A8, $00A9, $00AA, $00AB, $00AC, $00AD, $00AE, $00AF,
+ $00B0, $00B1, $00B2, $00B3, $00B4, $00B5, $00B6, $00B7,
+ $00B8, $00B9, $00BA, $00BB, $00BC, $00BD, $00BE, $00BF,
+ $00C0, $00C1, $00C2, $0102, $00C4, $00C5, $00C6, $00C7,
+ $00C8, $00C9, $00CA, $00CB, $0300, $00CD, $00CE, $00CF,
+ $0110, $00D1, $0309, $00D3, $00D4, $01A0, $00D6, $00D7,
+ $00D8, $00D9, $00DA, $00DB, $00DC, $01AF, $0303, $00DF,
+ $00E0, $00E1, $00E2, $0103, $00E4, $00E5, $00E6, $00E7,
+ $00E8, $00E9, $00EA, $00EB, $0301, $00ED, $00EE, $00EF,
+ $0111, $00F1, $0323, $00F3, $00F4, $01A1, $00F6, $00F7,
+ $00F8, $00F9, $00FA, $00FB, $00FC, $01B0, $20AB, $00FF
+ );
+
+{Cyrillic
+}
+ CharKOI8_R: array[128..255] of Word =
+ (
+ $2500, $2502, $250C, $2510, $2514, $2518, $251C, $2524,
+ $252C, $2534, $253C, $2580, $2584, $2588, $258C, $2590,
+ $2591, $2592, $2593, $2320, $25A0, $2219, $221A, $2248,
+ $2264, $2265, $00A0, $2321, $00B0, $00B2, $00B7, $00F7,
+ $2550, $2551, $2552, $0451, $2553, $2554, $2555, $2556,
+ $2557, $2558, $2559, $255A, $255B, $255C, $255D, $255E,
+ $255F, $2560, $2561, $0401, $2562, $2563, $2564, $2565,
+ $2566, $2567, $2568, $2569, $256A, $256B, $256C, $00A9,
+ $044E, $0430, $0431, $0446, $0434, $0435, $0444, $0433,
+ $0445, $0438, $0439, $043A, $043B, $043C, $043D, $043E,
+ $043F, $044F, $0440, $0441, $0442, $0443, $0436, $0432,
+ $044C, $044B, $0437, $0448, $044D, $0449, $0447, $044A,
+ $042E, $0410, $0411, $0426, $0414, $0415, $0424, $0413,
+ $0425, $0418, $0419, $041A, $041B, $041C, $041D, $041E,
+ $041F, $042F, $0420, $0421, $0422, $0423, $0416, $0412,
+ $042C, $042B, $0417, $0428, $042D, $0429, $0427, $042A
+ );
+
+{Czech (Kamenicky)
+}
+ CharCP_895: array[128..255] of Word =
+ (
+ $010C, $00FC, $00E9, $010F, $00E4, $010E, $0164, $010D,
+ $011B, $011A, $0139, $00CD, $013E, $013A, $00C4, $00C1,
+ $00C9, $017E, $017D, $00F4, $00F6, $00D3, $016F, $00DA,
+ $00FD, $00D6, $00DC, $0160, $013D, $00DD, $0158, $0165,
+ $00E1, $00ED, $00F3, $00FA, $0148, $0147, $016E, $00D4,
+ $0161, $0159, $0155, $0154, $00BC, $00A7, $00AB, $00BB,
+ $2591, $2592, $2593, $2502, $2524, $2561, $2562, $2556,
+ $2555, $2563, $2551, $2557, $255D, $255C, $255B, $2510,
+ $2514, $2534, $252C, $251C, $2500, $253C, $255E, $255F,
+ $255A, $2554, $2569, $2566, $2560, $2550, $256C, $2567,
+ $2568, $2564, $2565, $2559, $2558, $2552, $2553, $256B,
+ $256A, $2518, $250C, $2588, $2584, $258C, $2590, $2580,
+ $03B1, $03B2, $0393, $03C0, $03A3, $03C3, $03BC, $03C4,
+ $03A6, $0398, $03A9, $03B4, $221E, $2205, $03B5, $2229,
+ $2261, $00B1, $2265, $2264, $2320, $2321, $00F7, $2248,
+ $2218, $00B7, $2219, $221A, $207F, $00B2, $25A0, $00A0
+ );
+
+{Eastern European
+}
+ CharCP_852: array[128..255] of Word =
+ (
+ $00C7, $00FC, $00E9, $00E2, $00E4, $016F, $0107, $00E7,
+ $0142, $00EB, $0150, $0151, $00EE, $0179, $00C4, $0106,
+ $00C9, $0139, $013A, $00F4, $00F6, $013D, $013E, $015A,
+ $015B, $00D6, $00DC, $0164, $0165, $0141, $00D7, $010D,
+ $00E1, $00ED, $00F3, $00FA, $0104, $0105, $017D, $017E,
+ $0118, $0119, $00AC, $017A, $010C, $015F, $00AB, $00BB,
+ $2591, $2592, $2593, $2502, $2524, $00C1, $00C2, $011A,
+ $015E, $2563, $2551, $2557, $255D, $017B, $017C, $2510,
+ $2514, $2534, $252C, $251C, $2500, $253C, $0102, $0103,
+ $255A, $2554, $2569, $2566, $2560, $2550, $256C, $00A4,
+ $0111, $0110, $010E, $00CB, $010F, $0147, $00CD, $00CE,
+ $011B, $2518, $250C, $2588, $2584, $0162, $016E, $2580,
+ $00D3, $00DF, $00D4, $0143, $0144, $0148, $0160, $0161,
+ $0154, $00DA, $0155, $0170, $00FD, $00DD, $0163, $00B4,
+ $00AD, $02DD, $02DB, $02C7, $02D8, $00A7, $00F7, $00B8,
+ $00B0, $00A8, $02D9, $0171, $0158, $0159, $25A0, $00A0
+ );
+
+{==============================================================================}
+type
+ TIconvChar = record
+ Charset: TMimeChar;
+ CharName: string;
+ end;
+ TIconvArr = array [0..112] of TIconvChar;
+
+const
+ NotFoundChar = '_';
+
+var
+ SetTwo: set of TMimeChar = [UCS_2, UCS_2LE, UTF_7, UTF_7mod];
+ SetFour: set of TMimeChar = [UCS_4, UCS_4LE, UTF_8];
+ SetLE: set of TMimeChar = [UCS_2LE, UCS_4LE];
+
+ IconvArr: TIconvArr;
+
+{==============================================================================}
+function FindIconvID(const Value, Charname: string): Boolean;
+var
+ s: string;
+begin
+ Result := True;
+ //exact match
+ if Value = Charname then
+ Exit;
+ //Value is on begin of charname
+ s := Value + ' ';
+ if s = Copy(Charname, 1, Length(s)) then
+ Exit;
+ //Value is on end of charname
+ s := ' ' + Value;
+ if s = Copy(Charname, Length(Charname) - Length(s) + 1, Length(s)) then
+ Exit;
+ //value is somewhere inside charname
+ if Pos( s + ' ', Charname) > 0 then
+ Exit;
+ Result := False;
+end;
+
+function GetCPFromIconvID(Value: AnsiString): TMimeChar;
+var
+ n: integer;
+begin
+ Result := ISO_8859_1;
+ Value := UpperCase(Value);
+ for n := 0 to High(IconvArr) do
+ if FindIconvID(Value, IconvArr[n].Charname) then
+ begin
+ Result := IconvArr[n].Charset;
+ Break;
+ end;
+end;
+
+{==============================================================================}
+function GetIconvIDFromCP(Value: TMimeChar): AnsiString;
+var
+ n: integer;
+begin
+ Result := 'ISO-8859-1';
+ for n := 0 to High(IconvArr) do
+ if IconvArr[n].Charset = Value then
+ begin
+ Result := Separateleft(IconvArr[n].Charname, ' ');
+ Break;
+ end;
+end;
+
+{==============================================================================}
+function ReplaceUnicode(Value: Word; const TransformTable: array of Word): Word;
+var
+ n: integer;
+begin
+ if High(TransformTable) <> 0 then
+ for n := 0 to High(TransformTable) do
+ if not odd(n) then
+ if TransformTable[n] = Value then
+ begin
+ Value := TransformTable[n+1];
+ break;
+ end;
+ Result := Value;
+end;
+
+{==============================================================================}
+procedure CopyArray(const SourceTable: array of Word;
+ var TargetTable: array of Word);
+var
+ n: Integer;
+begin
+ for n := 0 to 127 do
+ TargetTable[n] := SourceTable[n];
+end;
+
+{==============================================================================}
+procedure GetArray(CharSet: TMimeChar; var Result: array of Word);
+begin
+ case CharSet of
+ ISO_8859_2:
+ CopyArray(CharISO_8859_2, Result);
+ ISO_8859_3:
+ CopyArray(CharISO_8859_3, Result);
+ ISO_8859_4:
+ CopyArray(CharISO_8859_4, Result);
+ ISO_8859_5:
+ CopyArray(CharISO_8859_5, Result);
+ ISO_8859_6:
+ CopyArray(CharISO_8859_6, Result);
+ ISO_8859_7:
+ CopyArray(CharISO_8859_7, Result);
+ ISO_8859_8:
+ CopyArray(CharISO_8859_8, Result);
+ ISO_8859_9:
+ CopyArray(CharISO_8859_9, Result);
+ ISO_8859_10:
+ CopyArray(CharISO_8859_10, Result);
+ ISO_8859_13:
+ CopyArray(CharISO_8859_13, Result);
+ ISO_8859_14:
+ CopyArray(CharISO_8859_14, Result);
+ ISO_8859_15:
+ CopyArray(CharISO_8859_15, Result);
+ CP1250:
+ CopyArray(CharCP_1250, Result);
+ CP1251:
+ CopyArray(CharCP_1251, Result);
+ CP1252:
+ CopyArray(CharCP_1252, Result);
+ CP1253:
+ CopyArray(CharCP_1253, Result);
+ CP1254:
+ CopyArray(CharCP_1254, Result);
+ CP1255:
+ CopyArray(CharCP_1255, Result);
+ CP1256:
+ CopyArray(CharCP_1256, Result);
+ CP1257:
+ CopyArray(CharCP_1257, Result);
+ CP1258:
+ CopyArray(CharCP_1258, Result);
+ KOI8_R:
+ CopyArray(CharKOI8_R, Result);
+ CP895:
+ CopyArray(CharCP_895, Result);
+ CP852:
+ CopyArray(CharCP_852, Result);
+ else
+ CopyArray(CharISO_8859_1, Result);
+ end;
+end;
+
+{==============================================================================}
+procedure ReadMulti(const Value: AnsiString; var Index: Integer; mb: Byte;
+ var b1, b2, b3, b4: Byte; le: boolean);
+Begin
+ b1 := 0;
+ b2 := 0;
+ b3 := 0;
+ b4 := 0;
+ if Index < 0 then
+ Index := 1;
+ if mb > 4 then
+ mb := 1;
+ if (Index + mb - 1) <= Length(Value) then
+ begin
+ if le then
+ Case mb Of
+ 1:
+ b1 := Ord(Value[Index]);
+ 2:
+ Begin
+ b1 := Ord(Value[Index]);
+ b2 := Ord(Value[Index + 1]);
+ End;
+ 3:
+ Begin
+ b1 := Ord(Value[Index]);
+ b2 := Ord(Value[Index + 1]);
+ b3 := Ord(Value[Index + 2]);
+ End;
+ 4:
+ Begin
+ b1 := Ord(Value[Index]);
+ b2 := Ord(Value[Index + 1]);
+ b3 := Ord(Value[Index + 2]);
+ b4 := Ord(Value[Index + 3]);
+ End;
+ end
+ else
+ Case mb Of
+ 1:
+ b1 := Ord(Value[Index]);
+ 2:
+ Begin
+ b2 := Ord(Value[Index]);
+ b1 := Ord(Value[Index + 1]);
+ End;
+ 3:
+ Begin
+ b3 := Ord(Value[Index]);
+ b2 := Ord(Value[Index + 1]);
+ b1 := Ord(Value[Index + 2]);
+ End;
+ 4:
+ Begin
+ b4 := Ord(Value[Index]);
+ b3 := Ord(Value[Index + 1]);
+ b2 := Ord(Value[Index + 2]);
+ b1 := Ord(Value[Index + 3]);
+ End;
+ end;
+ end;
+ Inc(Index, mb);
+end;
+
+{==============================================================================}
+function WriteMulti(b1, b2, b3, b4: Byte; mb: Byte; le: boolean): AnsiString;
+begin
+ if mb > 4 then
+ mb := 1;
+ SetLength(Result, mb);
+ if le then
+ case mb Of
+ 1:
+ Result[1] := AnsiChar(b1);
+ 2:
+ begin
+ Result[1] := AnsiChar(b1);
+ Result[2] := AnsiChar(b2);
+ end;
+ 3:
+ begin
+ Result[1] := AnsiChar(b1);
+ Result[2] := AnsiChar(b2);
+ Result[3] := AnsiChar(b3);
+ end;
+ 4:
+ begin
+ Result[1] := AnsiChar(b1);
+ Result[2] := AnsiChar(b2);
+ Result[3] := AnsiChar(b3);
+ Result[4] := AnsiChar(b4);
+ end;
+ end
+ else
+ case mb Of
+ 1:
+ Result[1] := AnsiChar(b1);
+ 2:
+ begin
+ Result[2] := AnsiChar(b1);
+ Result[1] := AnsiChar(b2);
+ end;
+ 3:
+ begin
+ Result[3] := AnsiChar(b1);
+ Result[2] := AnsiChar(b2);
+ Result[1] := AnsiChar(b3);
+ end;
+ 4:
+ begin
+ Result[4] := AnsiChar(b1);
+ Result[3] := AnsiChar(b2);
+ Result[2] := AnsiChar(b3);
+ Result[1] := AnsiChar(b4);
+ end;
+ end;
+end;
+
+{==============================================================================}
+function UTF8toUCS4(const Value: AnsiString): AnsiString;
+var
+ n, x, ul, m: Integer;
+ s: AnsiString;
+ w1, w2: Word;
+begin
+ Result := '';
+ n := 1;
+ while Length(Value) >= n do
+ begin
+ x := Ord(Value[n]);
+ Inc(n);
+ if x < 128 then
+ Result := Result + WriteMulti(x, 0, 0, 0, 4, false)
+ else
+ begin
+ m := 0;
+ if (x and $E0) = $C0 then
+ m := $1F;
+ if (x and $F0) = $E0 then
+ m := $0F;
+ if (x and $F8) = $F0 then
+ m := $07;
+ if (x and $FC) = $F8 then
+ m := $03;
+ if (x and $FE) = $FC then
+ m := $01;
+ ul := x and m;
+ s := IntToBin(ul, 0);
+ while Length(Value) >= n do
+ begin
+ x := Ord(Value[n]);
+ Inc(n);
+ if (x and $C0) = $80 then
+ s := s + IntToBin(x and $3F, 6)
+ else
+ begin
+ Dec(n);
+ Break;
+ end;
+ end;
+ ul := BinToInt(s);
+ w1 := ul div 65536;
+ w2 := ul mod 65536;
+ Result := Result + WriteMulti(Lo(w2), Hi(w2), Lo(w1), Hi(w1), 4, false);
+ end;
+ end;
+end;
+
+{==============================================================================}
+function UCS4toUTF8(const Value: AnsiString): AnsiString;
+var
+ s, l, k: AnsiString;
+ b1, b2, b3, b4: Byte;
+ n, m, x, y: Integer;
+ b: Byte;
+begin
+ Result := '';
+ n := 1;
+ while Length(Value) >= n do
+ begin
+ ReadMulti(Value, n, 4, b1, b2, b3, b4, false);
+ if (b2 = 0) and (b3 = 0) and (b4 = 0) and (b1 < 128) then
+ Result := Result + AnsiChar(b1)
+ else
+ begin
+ x := (b1 + 256 * b2) + (b3 + 256 * b4) * 65536;
+ l := IntToBin(x, 0);
+ y := Length(l) div 6;
+ s := '';
+ for m := 1 to y do
+ begin
+ k := Copy(l, Length(l) - 5, 6);
+ l := Copy(l, 1, Length(l) - 6);
+ b := BinToInt(k) or $80;
+ s := AnsiChar(b) + s;
+ end;
+ b := BinToInt(l);
+ case y of
+ 5:
+ b := b or $FC;
+ 4:
+ b := b or $F8;
+ 3:
+ b := b or $F0;
+ 2:
+ b := b or $E0;
+ 1:
+ b := b or $C0;
+ end;
+ s := AnsiChar(b) + s;
+ Result := Result + s;
+ end;
+ end;
+end;
+
+{==============================================================================}
+function UTF7toUCS2(const Value: AnsiString; Modified: Boolean): AnsiString;
+var
+ n, i: Integer;
+ c: AnsiChar;
+ s, t: AnsiString;
+ shift: AnsiChar;
+ table: String;
+begin
+ Result := '';
+ n := 1;
+ if modified then
+ begin
+ shift := '&';
+ table := TableBase64mod;
+ end
+ else
+ begin
+ shift := '+';
+ table := TableBase64;
+ end;
+ while Length(Value) >= n do
+ begin
+ c := Value[n];
+ Inc(n);
+ if c <> shift then
+ Result := Result + WriteMulti(Ord(c), 0, 0, 0, 2, false)
+ else
+ begin
+ s := '';
+ while Length(Value) >= n do
+ begin
+ c := Value[n];
+ Inc(n);
+ if c = '-' then
+ Break;
+ if (c = '=') or (Pos(c, table) < 1) then
+ begin
+ Dec(n);
+ Break;
+ end;
+ s := s + c;
+ end;
+ if s = '' then
+ s := WriteMulti(Ord(shift), 0, 0, 0, 2, false)
+ else
+ begin
+ if modified then
+ t := DecodeBase64mod(s)
+ else
+ t := DecodeBase64(s);
+ if not odd(length(t)) then
+ s := t
+ else
+ begin //ill-formed sequence
+ t := s;
+ s := WriteMulti(Ord(shift), 0, 0, 0, 2, false);
+ for i := 1 to length(t) do
+ s := s + WriteMulti(Ord(t[i]), 0, 0, 0, 2, false);
+ end;
+ end;
+ Result := Result + s;
+ end;
+ end;
+end;
+
+{==============================================================================}
+function UCS2toUTF7(const Value: AnsiString; Modified: Boolean): AnsiString;
+var
+ s: AnsiString;
+ b1, b2, b3, b4: Byte;
+ n, m: Integer;
+ shift: AnsiChar;
+begin
+ Result := '';
+ n := 1;
+ if modified then
+ shift := '&'
+ else
+ shift := '+';
+ while Length(Value) >= n do
+ begin
+ ReadMulti(Value, n, 2, b1, b2, b3, b4, false);
+ if (b2 = 0) and (b1 < 128) then
+ if AnsiChar(b1) = shift then
+ Result := Result + shift + '-'
+ else
+ Result := Result + AnsiChar(b1)
+ else
+ begin
+ s := AnsiChar(b2) + AnsiChar(b1);
+ while Length(Value) >= n do
+ begin
+ ReadMulti(Value, n, 2, b1, b2, b3, b4, false);
+ if (b2 = 0) and (b1 < 128) then
+ begin
+ Dec(n, 2);
+ Break;
+ end;
+ s := s + AnsiChar(b2) + AnsiChar(b1);
+ end;
+ if modified then
+ s := EncodeBase64mod(s)
+ else
+ s := EncodeBase64(s);
+ m := Pos('=', s);
+ if m > 0 then
+ s := Copy(s, 1, m - 1);
+ Result := Result + shift + s + '-';
+ end;
+ end;
+end;
+
+{==============================================================================}
+function CharsetConversion(const Value: AnsiString; CharFrom: TMimeChar;
+ CharTo: TMimeChar): AnsiString;
+begin
+ Result := CharsetConversionEx(Value, CharFrom, CharTo, Replace_None);
+end;
+
+{==============================================================================}
+function CharsetConversionEx(const Value: AnsiString; CharFrom: TMimeChar;
+ CharTo: TMimeChar; const TransformTable: array of Word): AnsiString;
+begin
+ Result := CharsetConversionTrans(Value, CharFrom, CharTo, TransformTable, True);
+end;
+
+{==============================================================================}
+
+function InternalToUcs(const Value: AnsiString; Charfrom: TMimeChar): AnsiString;
+var
+ uni: Word;
+ n: Integer;
+ b1, b2, b3, b4: Byte;
+ SourceTable: array[128..255] of Word;
+ mbf: Byte;
+ lef: Boolean;
+ s: AnsiString;
+begin
+ if CharFrom = UTF_8 then
+ s := UTF8toUCS4(Value)
+ else
+ if CharFrom = UTF_7 then
+ s := UTF7toUCS2(Value, False)
+ else
+ if CharFrom = UTF_7mod then
+ s := UTF7toUCS2(Value, True)
+ else
+ s := Value;
+ GetArray(CharFrom, SourceTable);
+ mbf := 1;
+ if CharFrom in SetTwo then
+ mbf := 2;
+ if CharFrom in SetFour then
+ mbf := 4;
+ lef := CharFrom in SetLe;
+ Result := '';
+ n := 1;
+ while Length(s) >= n do
+ begin
+ ReadMulti(s, n, mbf, b1, b2, b3, b4, lef);
+ //handle BOM
+ if (b3 = 0) and (b4 = 0) then
+ begin
+ if (b1 = $FE) and (b2 = $FF) then
+ begin
+ lef := not lef;
+ continue;
+ end;
+ if (b1 = $FF) and (b2 = $FE) then
+ continue;
+ end;
+ if mbf = 1 then
+ if b1 > 127 then
+ begin
+ uni := SourceTable[b1];
+ b1 := Lo(uni);
+ b2 := Hi(uni);
+ end;
+ Result := Result + WriteMulti(b1, b2, b3, b4, 2, False);
+ end;
+end;
+
+function CharsetConversionTrans(Value: AnsiString; CharFrom: TMimeChar;
+ CharTo: TMimeChar; const TransformTable: array of Word; Translit: Boolean): AnsiString;
+var
+ uni: Word;
+ n, m: Integer;
+ b: Byte;
+ b1, b2, b3, b4: Byte;
+ TargetTable: array[128..255] of Word;
+ mbt: Byte;
+ let: Boolean;
+ ucsstring, s, t: AnsiString;
+ cd: iconv_t;
+ f: Boolean;
+ NotNeedTransform: Boolean;
+ FromID, ToID: string;
+begin
+ NotNeedTransform := (High(TransformTable) = 0);
+ if (CharFrom = CharTo) and NotNeedTransform then
+ begin
+ Result := Value;
+ Exit;
+ end;
+ FromID := GetIDFromCP(CharFrom);
+ ToID := GetIDFromCP(CharTo);
+ cd := Iconv_t(-1);
+ //do two-pass conversion. Transform to UCS-2 first.
+ if not DisableIconv then
+ cd := SynaIconvOpenIgnore('UCS-2BE', FromID);
+ try
+ if cd <> iconv_t(-1) then
+ SynaIconv(cd, Value, ucsstring)
+ else
+ ucsstring := InternalToUcs(Value, CharFrom);
+ finally
+ SynaIconvClose(cd);
+ end;
+ //here we allways have ucstring with UCS-2 encoding
+ //second pass... from UCS-2 to target encoding.
+ if not DisableIconv then
+ if translit then
+ cd := SynaIconvOpenTranslit(ToID, 'UCS-2BE')
+ else
+ cd := SynaIconvOpenIgnore(ToID, 'UCS-2BE');
+ try
+ if (cd <> iconv_t(-1)) and NotNeedTransform then
+ begin
+ if CharTo = UTF_7 then
+ ucsstring := ucsstring + #0 + '-';
+ //when transformtable is not needed and Iconv know target charset,
+ //do it fast by one call.
+ SynaIconv(cd, ucsstring, Result);
+ if CharTo = UTF_7 then
+ Delete(Result, Length(Result), 1);
+ end
+ else
+ begin
+ GetArray(CharTo, TargetTable);
+ mbt := 1;
+ if CharTo in SetTwo then
+ mbt := 2;
+ if CharTo in SetFour then
+ mbt := 4;
+ let := CharTo in SetLe;
+ b3 := 0;
+ b4 := 0;
+ Result := '';
+ for n:= 0 to (Length(ucsstring) div 2) - 1 do
+ begin
+ s := Copy(ucsstring, n * 2 + 1, 2);
+ b2 := Ord(s[1]);
+ b1 := Ord(s[2]);
+ uni := b2 * 256 + b1;
+ if not NotNeedTransform then
+ begin
+ uni := ReplaceUnicode(uni, TransformTable);
+ b1 := Lo(uni);
+ b2 := Hi(uni);
+ s[1] := AnsiChar(b2);
+ s[2] := AnsiChar(b1);
+ end;
+ if cd <> iconv_t(-1) then
+ begin
+ if CharTo = UTF_7 then
+ s := s + #0 + '-';
+ SynaIconv(cd, s, t);
+ if CharTo = UTF_7 then
+ Delete(t, Length(t), 1);
+ Result := Result + t;
+ end
+ else
+ begin
+ f := True;
+ if mbt = 1 then
+ if uni > 127 then
+ begin
+ f := False;
+ b := 0;
+ for m := 128 to 255 do
+ if TargetTable[m] = uni then
+ begin
+ b := m;
+ f := True;
+ Break;
+ end;
+ b1 := b;
+ b2 := 0;
+ end
+ else
+ b1 := Lo(uni);
+ if not f then
+ if translit then
+ begin
+ b1 := Ord(NotFoundChar);
+ b2 := 0;
+ f := True;
+ end;
+ if f then
+ Result := Result + WriteMulti(b1, b2, b3, b4, mbt, let)
+ end;
+ end;
+ if cd = iconv_t(-1) then
+ begin
+ if CharTo = UTF_7 then
+ Result := UCS2toUTF7(Result, false);
+ if CharTo = UTF_7mod then
+ Result := UCS2toUTF7(Result, true);
+ if CharTo = UTF_8 then
+ Result := UCS4toUTF8(Result);
+ end;
+ end;
+ finally
+ SynaIconvClose(cd);
+ end;
+end;
+
+{==============================================================================}
+{$IFNDEF WIN32}
+
+function GetCurCP: TMimeChar;
+begin
+ {$IFNDEF FPC}
+ Result := GetCPFromID(nl_langinfo(_NL_CTYPE_CODESET_NAME));
+ {$ELSE}
+ {$IFDEF FPC_USE_LIBC}
+ Result := GetCPFromID(nl_langinfo(_NL_CTYPE_CODESET_NAME));
+ {$ELSE}
+ //How to get system codepage without LIBC?
+ Result := UTF_8;
+ {$ENDIF}
+ {$ENDIF}
+end;
+
+function GetCurOEMCP: TMimeChar;
+begin
+ Result := GetCurCP;
+end;
+
+{$ELSE}
+
+function CPToMimeChar(Value: Integer): TMimeChar;
+begin
+ case Value of
+ 437, 850, 20127:
+ Result := ISO_8859_1; //I know, it is not ideal!
+ 737:
+ Result := CP737;
+ 775:
+ Result := CP775;
+ 852:
+ Result := CP852;
+ 855:
+ Result := CP855;
+ 857:
+ Result := CP857;
+ 858:
+ Result := CP858;
+ 860:
+ Result := CP860;
+ 861:
+ Result := CP861;
+ 862:
+ Result := CP862;
+ 863:
+ Result := CP863;
+ 864:
+ Result := CP864;
+ 865:
+ Result := CP865;
+ 866:
+ Result := CP866;
+ 869:
+ Result := CP869;
+ 874:
+ Result := ISO_8859_15;
+ 895:
+ Result := CP895;
+ 932:
+ Result := CP932;
+ 936:
+ Result := CP936;
+ 949:
+ Result := CP949;
+ 950:
+ Result := CP950;
+ 1200:
+ Result := UCS_2LE;
+ 1201:
+ Result := UCS_2;
+ 1250:
+ Result := CP1250;
+ 1251:
+ Result := CP1251;
+ 1253:
+ Result := CP1253;
+ 1254:
+ Result := CP1254;
+ 1255:
+ Result := CP1255;
+ 1256:
+ Result := CP1256;
+ 1257:
+ Result := CP1257;
+ 1258:
+ Result := CP1258;
+ 1361:
+ Result := CP1361;
+ 10000:
+ Result := MAC;
+ 10004:
+ Result := MACAR;
+ 10005:
+ Result := MACHEB;
+ 10006:
+ Result := MACGR;
+ 10007:
+ Result := MACCYR;
+ 10010:
+ Result := MACRO;
+ 10017:
+ Result := MACUK;
+ 10021:
+ Result := MACTH;
+ 10029:
+ Result := MACCE;
+ 10079:
+ Result := MACICE;
+ 10081:
+ Result := MACTU;
+ 10082:
+ Result := MACCRO;
+ 12000:
+ Result := UCS_4LE;
+ 12001:
+ Result := UCS_4;
+ 20866:
+ Result := KOI8_R;
+ 20932:
+ Result := JIS_X0208;
+ 20936:
+ Result := GB2312;
+ 21866:
+ Result := KOI8_U;
+ 28591:
+ Result := ISO_8859_1;
+ 28592:
+ Result := ISO_8859_2;
+ 28593:
+ Result := ISO_8859_3;
+ 28594:
+ Result := ISO_8859_4;
+ 28595:
+ Result := ISO_8859_5;
+ 28596, 708:
+ Result := ISO_8859_6;
+ 28597:
+ Result := ISO_8859_7;
+ 28598, 38598:
+ Result := ISO_8859_8;
+ 28599:
+ Result := ISO_8859_9;
+ 28605:
+ Result := ISO_8859_15;
+ 50220:
+ Result := ISO_2022_JP; //? ISO 2022 Japanese with no halfwidth Katakana
+ 50221:
+ Result := ISO_2022_JP1;//? Japanese with halfwidth Katakana
+ 50222:
+ Result := ISO_2022_JP2;//? Japanese JIS X 0201-1989
+ 50225:
+ Result := ISO_2022_KR;
+ 50227:
+ Result := ISO_2022_CN;//? ISO 2022 Simplified Chinese
+ 50229:
+ Result := ISO_2022_CNE;//? ISO 2022 Traditional Chinese
+ 51932:
+ Result := EUC_JP;
+ 51936:
+ Result := GB2312;
+ 51949:
+ Result := EUC_KR;
+ 52936:
+ Result := HZ;
+ 54936:
+ Result := GB18030;
+ 65000:
+ Result := UTF_7;
+ 65001:
+ Result := UTF_8;
+ 0:
+ Result := UCS_2LE;
+ else
+ Result := CP1252;
+ end;
+end;
+
+function GetCurCP: TMimeChar;
+begin
+ Result := CPToMimeChar(GetACP);
+end;
+
+function GetCurOEMCP: TMimeChar;
+begin
+ Result := CPToMimeChar(GetOEMCP);
+end;
+{$ENDIF}
+
+{==============================================================================}
+function NeedCharsetConversion(const Value: AnsiString): Boolean;
+var
+ n: Integer;
+begin
+ Result := False;
+ for n := 1 to Length(Value) do
+ if (Ord(Value[n]) > 127) or (Ord(Value[n]) = 0) then
+ begin
+ Result := True;
+ Break;
+ end;
+end;
+
+{==============================================================================}
+function IdealCharsetCoding(const Value: AnsiString; CharFrom: TMimeChar;
+ CharTo: TMimeSetChar): TMimeChar;
+var
+ n: Integer;
+ max: Integer;
+ s, t, u: AnsiString;
+ CharSet: TMimeChar;
+begin
+ Result := ISO_8859_1;
+ s := Copy(Value, 1, 1024); //max first 1KB for next procedure
+ max := 0;
+ for n := Ord(Low(TMimeChar)) to Ord(High(TMimeChar)) do
+ begin
+ CharSet := TMimeChar(n);
+ if CharSet in CharTo then
+ begin
+ t := CharsetConversionTrans(s, CharFrom, CharSet, Replace_None, False);
+ u := CharsetConversionTrans(t, CharSet, CharFrom, Replace_None, False);
+ if s = u then
+ begin
+ Result := CharSet;
+ Exit;
+ end;
+ if Length(u) > max then
+ begin
+ Result := CharSet;
+ max := Length(u);
+ end;
+ end;
+ end;
+end;
+
+{==============================================================================}
+function GetBOM(Value: TMimeChar): AnsiString;
+begin
+ Result := '';
+ case Value of
+ UCS_2:
+ Result := #$fe + #$ff;
+ UCS_4:
+ Result := #$00 + #$00 + #$fe + #$ff;
+ UCS_2LE:
+ Result := #$ff + #$fe;
+ UCS_4LE:
+ Result := #$ff + #$fe + #$00 + #$00;
+ UTF_8:
+ Result := #$ef + #$bb + #$bf;
+ end;
+end;
+
+{==============================================================================}
+function GetCPFromID(Value: AnsiString): TMimeChar;
+begin
+ Value := UpperCase(Value);
+ if (Pos('KAMENICKY', Value) > 0) or (Pos('895', Value) > 0) then
+ Result := CP895
+ else
+ if Pos('MUTF-7', Value) > 0 then
+ Result := UTF_7mod
+ else
+ Result := GetCPFromIconvID(Value);
+end;
+
+{==============================================================================}
+function GetIDFromCP(Value: TMimeChar): AnsiString;
+begin
+ case Value of
+ CP895:
+ Result := 'CP-895';
+ UTF_7mod:
+ Result := 'mUTF-7';
+ else
+ Result := GetIconvIDFromCP(Value);
+ end;
+end;
+
+{==============================================================================}
+function StringToWide(const Value: AnsiString): WideString;
+var
+ n: integer;
+ x, y: integer;
+begin
+ SetLength(Result, Length(Value) div 2);
+ for n := 1 to Length(Value) div 2 do
+ begin
+ x := Ord(Value[((n-1) * 2) + 1]);
+ y := Ord(Value[((n-1) * 2) + 2]);
+ Result[n] := WideChar(x * 256 + y);
+ end;
+end;
+
+{==============================================================================}
+function WideToString(const Value: WideString): AnsiString;
+var
+ n: integer;
+ x: integer;
+begin
+ SetLength(Result, Length(Value) * 2);
+ for n := 1 to Length(Value) do
+ begin
+ x := Ord(Value[n]);
+ Result[((n-1) * 2) + 1] := AnsiChar(x div 256);
+ Result[((n-1) * 2) + 2] := AnsiChar(x mod 256);
+ end;
+end;
+
+{==============================================================================}
+initialization
+begin
+ IconvArr[0].Charset := ISO_8859_1;
+ IconvArr[0].Charname := 'ISO-8859-1 CP819 IBM819 ISO-IR-100 ISO8859-1 ISO_8859-1 ISO_8859-1:1987 L1 LATIN1 CSISOLATIN1';
+ IconvArr[1].Charset := UTF_8;
+ IconvArr[1].Charname := 'UTF-8';
+ IconvArr[2].Charset := UCS_2;
+ IconvArr[2].Charname := 'ISO-10646-UCS-2 UCS-2 CSUNICODE';
+ IconvArr[3].Charset := UCS_2;
+ IconvArr[3].Charname := 'UCS-2BE UNICODE-1-1 UNICODEBIG CSUNICODE11';
+ IconvArr[4].Charset := UCS_2LE;
+ IconvArr[4].Charname := 'UCS-2LE UNICODELITTLE';
+ IconvArr[5].Charset := UCS_4;
+ IconvArr[5].Charname := 'ISO-10646-UCS-4 UCS-4 CSUCS4';
+ IconvArr[6].Charset := UCS_4;
+ IconvArr[6].Charname := 'UCS-4BE';
+ IconvArr[7].Charset := UCS_2LE;
+ IconvArr[7].Charname := 'UCS-4LE';
+ IconvArr[8].Charset := UTF_16;
+ IconvArr[8].Charname := 'UTF-16';
+ IconvArr[9].Charset := UTF_16;
+ IconvArr[9].Charname := 'UTF-16BE';
+ IconvArr[10].Charset := UTF_16LE;
+ IconvArr[10].Charname := 'UTF-16LE';
+ IconvArr[11].Charset := UTF_32;
+ IconvArr[11].Charname := 'UTF-32';
+ IconvArr[12].Charset := UTF_32;
+ IconvArr[12].Charname := 'UTF-32BE';
+ IconvArr[13].Charset := UTF_32;
+ IconvArr[13].Charname := 'UTF-32LE';
+ IconvArr[14].Charset := UTF_7;
+ IconvArr[14].Charname := 'UNICODE-1-1-UTF-7 UTF-7 CSUNICODE11UTF7';
+ IconvArr[15].Charset := C99;
+ IconvArr[15].Charname := 'C99';
+ IconvArr[16].Charset := JAVA;
+ IconvArr[16].Charname := 'JAVA';
+ IconvArr[17].Charset := ISO_8859_1;
+ IconvArr[17].Charname := 'US-ASCII ANSI_X3.4-1968 ANSI_X3.4-1986 ASCII CP367 IBM367 ISO-IR-6 ISO646-US ISO_646.IRV:1991 US CSASCII';
+ IconvArr[18].Charset := ISO_8859_2;
+ IconvArr[18].Charname := 'ISO-8859-2 ISO-IR-101 ISO8859-2 ISO_8859-2 ISO_8859-2:1987 L2 LATIN2 CSISOLATIN2';
+ IconvArr[19].Charset := ISO_8859_3;
+ IconvArr[19].Charname := 'ISO-8859-3 ISO-IR-109 ISO8859-3 ISO_8859-3 ISO_8859-3:1988 L3 LATIN3 CSISOLATIN3';
+ IconvArr[20].Charset := ISO_8859_4;
+ IconvArr[20].Charname := 'ISO-8859-4 ISO-IR-110 ISO8859-4 ISO_8859-4 ISO_8859-4:1988 L4 LATIN4 CSISOLATIN4';
+ IconvArr[21].Charset := ISO_8859_5;
+ IconvArr[21].Charname := 'ISO-8859-5 CYRILLIC ISO-IR-144 ISO8859-5 ISO_8859-5 ISO_8859-5:1988 CSISOLATINCYRILLIC';
+ IconvArr[22].Charset := ISO_8859_6;
+ IconvArr[22].Charname := 'ISO-8859-6 ARABIC ASMO-708 ECMA-114 ISO-IR-127 ISO8859-6 ISO_8859-6 ISO_8859-6:1987 CSISOLATINARABIC';
+ IconvArr[23].Charset := ISO_8859_7;
+ IconvArr[23].Charname := 'ISO-8859-7 ECMA-118 ELOT_928 GREEK GREEK8 ISO-IR-126 ISO8859-7 ISO_8859-7 ISO_8859-7:1987 CSISOLATINGREEK';
+ IconvArr[24].Charset := ISO_8859_8;
+ IconvArr[24].Charname := 'ISO-8859-8 HEBREW ISO_8859-8 ISO-IR-138 ISO8859-8 ISO_8859-8:1988 CSISOLATINHEBREW ISO-8859-8-I';
+ IconvArr[25].Charset := ISO_8859_9;
+ IconvArr[25].Charname := 'ISO-8859-9 ISO-IR-148 ISO8859-9 ISO_8859-9 ISO_8859-9:1989 L5 LATIN5 CSISOLATIN5';
+ IconvArr[26].Charset := ISO_8859_10;
+ IconvArr[26].Charname := 'ISO-8859-10 ISO-IR-157 ISO8859-10 ISO_8859-10 ISO_8859-10:1992 L6 LATIN6 CSISOLATIN6';
+ IconvArr[27].Charset := ISO_8859_13;
+ IconvArr[27].Charname := 'ISO-8859-13 ISO-IR-179 ISO8859-13 ISO_8859-13 L7 LATIN7';
+ IconvArr[28].Charset := ISO_8859_14;
+ IconvArr[28].Charname := 'ISO-8859-14 ISO-CELTIC ISO-IR-199 ISO8859-14 ISO_8859-14 ISO_8859-14:1998 L8 LATIN8';
+ IconvArr[29].Charset := ISO_8859_15;
+ IconvArr[29].Charname := 'ISO-8859-15 ISO-IR-203 ISO8859-15 ISO_8859-15 ISO_8859-15:1998';
+ IconvArr[30].Charset := ISO_8859_16;
+ IconvArr[30].Charname := 'ISO-8859-16 ISO-IR-226 ISO8859-16 ISO_8859-16 ISO_8859-16:2000';
+ IconvArr[31].Charset := KOI8_R;
+ IconvArr[31].Charname := 'KOI8-R CSKOI8R';
+ IconvArr[32].Charset := KOI8_U;
+ IconvArr[32].Charname := 'KOI8-U';
+ IconvArr[33].Charset := KOI8_RU;
+ IconvArr[33].Charname := 'KOI8-RU';
+ IconvArr[34].Charset := CP1250;
+ IconvArr[34].Charname := 'WINDOWS-1250 CP1250 MS-EE';
+ IconvArr[35].Charset := CP1251;
+ IconvArr[35].Charname := 'WINDOWS-1251 CP1251 MS-CYRL';
+ IconvArr[36].Charset := CP1252;
+ IconvArr[36].Charname := 'WINDOWS-1252 CP1252 MS-ANSI';
+ IconvArr[37].Charset := CP1253;
+ IconvArr[37].Charname := 'WINDOWS-1253 CP1253 MS-GREEK';
+ IconvArr[38].Charset := CP1254;
+ IconvArr[38].Charname := 'WINDOWS-1254 CP1254 MS-TURK';
+ IconvArr[39].Charset := CP1255;
+ IconvArr[39].Charname := 'WINDOWS-1255 CP1255 MS-HEBR';
+ IconvArr[40].Charset := CP1256;
+ IconvArr[40].Charname := 'WINDOWS-1256 CP1256 MS-ARAB';
+ IconvArr[41].Charset := CP1257;
+ IconvArr[41].Charname := 'WINDOWS-1257 CP1257 WINBALTRIM';
+ IconvArr[42].Charset := CP1258;
+ IconvArr[42].Charname := 'WINDOWS-1258 CP1258';
+ IconvArr[43].Charset := ISO_8859_1;
+ IconvArr[43].Charname := '850 CP850 IBM850 CSPC850MULTILINGUAL';
+ IconvArr[44].Charset := CP862;
+ IconvArr[44].Charname := '862 CP862 IBM862 CSPC862LATINHEBREW';
+ IconvArr[45].Charset := CP866;
+ IconvArr[45].Charname := '866 CP866 IBM866 CSIBM866';
+ IconvArr[46].Charset := MAC;
+ IconvArr[46].Charname := 'MAC MACINTOSH MACROMAN CSMACINTOSH';
+ IconvArr[47].Charset := MACCE;
+ IconvArr[47].Charname := 'MACCENTRALEUROPE';
+ IconvArr[48].Charset := MACICE;
+ IconvArr[48].Charname := 'MACICELAND';
+ IconvArr[49].Charset := MACCRO;
+ IconvArr[49].Charname := 'MACCROATIAN';
+ IconvArr[50].Charset := MACRO;
+ IconvArr[50].Charname := 'MACROMANIA';
+ IconvArr[51].Charset := MACCYR;
+ IconvArr[51].Charname := 'MACCYRILLIC';
+ IconvArr[52].Charset := MACUK;
+ IconvArr[52].Charname := 'MACUKRAINE';
+ IconvArr[53].Charset := MACGR;
+ IconvArr[53].Charname := 'MACGREEK';
+ IconvArr[54].Charset := MACTU;
+ IconvArr[54].Charname := 'MACTURKISH';
+ IconvArr[55].Charset := MACHEB;
+ IconvArr[55].Charname := 'MACHEBREW';
+ IconvArr[56].Charset := MACAR;
+ IconvArr[56].Charname := 'MACARABIC';
+ IconvArr[57].Charset := MACTH;
+ IconvArr[57].Charname := 'MACTHAI';
+ IconvArr[58].Charset := ROMAN8;
+ IconvArr[58].Charname := 'HP-ROMAN8 R8 ROMAN8 CSHPROMAN8';
+ IconvArr[59].Charset := NEXTSTEP;
+ IconvArr[59].Charname := 'NEXTSTEP';
+ IconvArr[60].Charset := ARMASCII;
+ IconvArr[60].Charname := 'ARMSCII-8';
+ IconvArr[61].Charset := GEORGIAN_AC;
+ IconvArr[61].Charname := 'GEORGIAN-ACADEMY';
+ IconvArr[62].Charset := GEORGIAN_PS;
+ IconvArr[62].Charname := 'GEORGIAN-PS';
+ IconvArr[63].Charset := KOI8_T;
+ IconvArr[63].Charname := 'KOI8-T';
+ IconvArr[64].Charset := MULELAO;
+ IconvArr[64].Charname := 'MULELAO-1';
+ IconvArr[65].Charset := CP1133;
+ IconvArr[65].Charname := 'CP1133 IBM-CP1133';
+ IconvArr[66].Charset := TIS620;
+ IconvArr[66].Charname := 'TIS-620 ISO-IR-166 TIS620 TIS620-0 TIS620.2529-1 TIS620.2533-0 TIS620.2533-1';
+ IconvArr[67].Charset := CP874;
+ IconvArr[67].Charname := 'CP874 WINDOWS-874';
+ IconvArr[68].Charset := VISCII;
+ IconvArr[68].Charname := 'VISCII VISCII1.1-1 CSVISCII';
+ IconvArr[69].Charset := TCVN;
+ IconvArr[69].Charname := 'TCVN TCVN-5712 TCVN5712-1 TCVN5712-1:1993';
+ IconvArr[70].Charset := ISO_IR_14;
+ IconvArr[70].Charname := 'ISO-IR-14 ISO646-JP JIS_C6220-1969-RO JP CSISO14JISC6220RO';
+ IconvArr[71].Charset := JIS_X0201;
+ IconvArr[71].Charname := 'JISX0201-1976 JIS_X0201 X0201 CSHALFWIDTHKATAKANA';
+ IconvArr[72].Charset := JIS_X0208;
+ IconvArr[72].Charname := 'ISO-IR-87 JIS0208 JIS_C6226-1983 JIS_X0208 JIS_X0208-1983 JIS_X0208-1990 X0208 CSISO87JISX0208';
+ IconvArr[73].Charset := JIS_X0212;
+ IconvArr[73].Charname := 'ISO-IR-159 JIS_X0212 JIS_X0212-1990 JIS_X0212.1990-0 X0212 CSISO159JISX02121990';
+ IconvArr[74].Charset := GB1988_80;
+ IconvArr[74].Charname := 'CN GB_1988-80 ISO-IR-57 ISO646-CN CSISO57GB1988';
+ IconvArr[75].Charset := GB2312_80;
+ IconvArr[75].Charname := 'CHINESE GB_2312-80 ISO-IR-58 CSISO58GB231280';
+ IconvArr[76].Charset := ISO_IR_165;
+ IconvArr[76].Charname := 'CN-GB-ISOIR165 ISO-IR-165';
+ IconvArr[77].Charset := ISO_IR_149;
+ IconvArr[77].Charname := 'ISO-IR-149 KOREAN KSC_5601 KS_C_5601-1987 KS_C_5601-1989 CSKSC56011987';
+ IconvArr[78].Charset := EUC_JP;
+ IconvArr[78].Charname := 'EUC-JP EUCJP EXTENDED_UNIX_CODE_PACKED_FORMAT_FOR_JAPANESE CSEUCPKDFMTJAPANESE';
+ IconvArr[79].Charset := SHIFT_JIS;
+ IconvArr[79].Charname := 'SHIFT-JIS MS_KANJI SHIFT_JIS SJIS CSSHIFTJIS';
+ IconvArr[80].Charset := CP932;
+ IconvArr[80].Charname := 'CP932';
+ IconvArr[81].Charset := ISO_2022_JP;
+ IconvArr[81].Charname := 'ISO-2022-JP CSISO2022JP';
+ IconvArr[82].Charset := ISO_2022_JP1;
+ IconvArr[82].Charname := 'ISO-2022-JP-1';
+ IconvArr[83].Charset := ISO_2022_JP2;
+ IconvArr[83].Charname := 'ISO-2022-JP-2 CSISO2022JP2';
+ IconvArr[84].Charset := GB2312;
+ IconvArr[84].Charname := 'CN-GB EUC-CN EUCCN GB2312 CSGB2312';
+ IconvArr[85].Charset := CP936;
+ IconvArr[85].Charname := 'CP936 GBK';
+ IconvArr[86].Charset := GB18030;
+ IconvArr[86].Charname := 'GB18030';
+ IconvArr[87].Charset := ISO_2022_CN;
+ IconvArr[87].Charname := 'ISO-2022-CN CSISO2022CN';
+ IconvArr[88].Charset := ISO_2022_CNE;
+ IconvArr[88].Charname := 'ISO-2022-CN-EXT';
+ IconvArr[89].Charset := HZ;
+ IconvArr[89].Charname := 'HZ HZ-GB-2312';
+ IconvArr[90].Charset := EUC_TW;
+ IconvArr[90].Charname := 'EUC-TW EUCTW CSEUCTW';
+ IconvArr[91].Charset := BIG5;
+ IconvArr[91].Charname := 'BIG5 BIG-5 BIG-FIVE BIGFIVE CN-BIG5 CSBIG5';
+ IconvArr[92].Charset := CP950;
+ IconvArr[92].Charname := 'CP950';
+ IconvArr[93].Charset := BIG5_HKSCS;
+ IconvArr[93].Charname := 'BIG5-HKSCS BIG5HKSCS';
+ IconvArr[94].Charset := EUC_KR;
+ IconvArr[94].Charname := 'EUC-KR EUCKR CSEUCKR';
+ IconvArr[95].Charset := CP949;
+ IconvArr[95].Charname := 'CP949 UHC';
+ IconvArr[96].Charset := CP1361;
+ IconvArr[96].Charname := 'CP1361 JOHAB';
+ IconvArr[97].Charset := ISO_2022_KR;
+ IconvArr[97].Charname := 'ISO-2022-KR CSISO2022KR';
+ IconvArr[98].Charset := ISO_8859_1;
+ IconvArr[98].Charname := '437 CP437 IBM437 CSPC8CODEPAGE437';
+ IconvArr[99].Charset := CP737;
+ IconvArr[99].Charname := 'CP737';
+ IconvArr[100].Charset := CP775;
+ IconvArr[100].Charname := 'CP775 IBM775 CSPC775BALTIC';
+ IconvArr[101].Charset := CP852;
+ IconvArr[101].Charname := '852 CP852 IBM852 CSPCP852';
+ IconvArr[102].Charset := CP853;
+ IconvArr[102].Charname := 'CP853';
+ IconvArr[103].Charset := CP855;
+ IconvArr[103].Charname := '855 CP855 IBM855 CSIBM855';
+ IconvArr[104].Charset := CP857;
+ IconvArr[104].Charname := '857 CP857 IBM857 CSIBM857';
+ IconvArr[105].Charset := CP858;
+ IconvArr[105].Charname := 'CP858';
+ IconvArr[106].Charset := CP860;
+ IconvArr[106].Charname := '860 CP860 IBM860 CSIBM860';
+ IconvArr[107].Charset := CP861;
+ IconvArr[107].Charname := '861 CP-IS CP861 IBM861 CSIBM861';
+ IconvArr[108].Charset := CP863;
+ IconvArr[108].Charname := '863 CP863 IBM863 CSIBM863';
+ IconvArr[109].Charset := CP864;
+ IconvArr[109].Charname := 'CP864 IBM864 CSIBM864';
+ IconvArr[110].Charset := CP865;
+ IconvArr[110].Charname := '865 CP865 IBM865 CSIBM865';
+ IconvArr[111].Charset := CP869;
+ IconvArr[111].Charname := '869 CP-GR CP869 IBM869 CSIBM869';
+ IconvArr[112].Charset := CP1125;
+ IconvArr[112].Charname := 'CP1125';
+end;
+
+end.
ADDED lib/synapse/source/lib/synacode.pas
Index: lib/synapse/source/lib/synacode.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/lib/synacode.pas
@@ -0,0 +1,1461 @@
+{==============================================================================|
+| Project : Ararat Synapse | 002.002.001 |
+|==============================================================================|
+| Content: Coding and decoding support |
+|==============================================================================|
+| Copyright (c)1999-2012, Lukas Gebauer |
+| All rights reserved. |
+| |
+| Redistribution and use in source and binary forms, with or without |
+| modification, are permitted provided that the following conditions are met: |
+| |
+| Redistributions of source code must retain the above copyright notice, this |
+| list of conditions and the following disclaimer. |
+| |
+| Redistributions in binary form must reproduce the above copyright notice, |
+| this list of conditions and the following disclaimer in the documentation |
+| and/or other materials provided with the distribution. |
+| |
+| Neither the name of Lukas Gebauer nor the names of its contributors may |
+| be used to endorse or promote products derived from this software without |
+| specific prior written permission. |
+| |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
+| DAMAGE. |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2000-2012. |
+| All Rights Reserved. |
+|==============================================================================|
+| Contributor(s): |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package |
+| (Found at URL: http://www.ararat.cz/synapse/) |
+|==============================================================================}
+
+{:@abstract(Various encoding and decoding support)}
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+{$Q-}
+{$R-}
+{$H+}
+{$TYPEDADDRESS OFF}
+
+{$IFDEF UNICODE}
+ {$WARN IMPLICIT_STRING_CAST OFF}
+ {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+ {$WARN SUSPICIOUS_TYPECAST OFF}
+{$ENDIF}
+
+unit synacode;
+
+interface
+
+uses
+ SysUtils;
+
+type
+ TSpecials = set of AnsiChar;
+
+const
+
+ SpecialChar: TSpecials =
+ ['=', '(', ')', '[', ']', '<', '>', ':', ';', ',', '@', '/', '?', '\',
+ '"', '_'];
+ NonAsciiChar: TSpecials =
+ [#0..#31, #127..#255];
+ URLFullSpecialChar: TSpecials =
+ [';', '/', '?', ':', '@', '=', '&', '#', '+'];
+ URLSpecialChar: TSpecials =
+ [#$00..#$20, '_', '<', '>', '"', '%', '{', '}', '|', '\', '^', '~', '[', ']',
+ '`', #$7F..#$FF];
+ TableBase64 =
+ 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=';
+ TableBase64mod =
+ 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+,=';
+ TableUU =
+ '`!"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';
+ TableXX =
+ '+-0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
+ ReTablebase64 =
+ #$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$3E +#$40
+ +#$40 +#$40 +#$3F +#$34 +#$35 +#$36 +#$37 +#$38 +#$39 +#$3A +#$3B +#$3C
+ +#$3D +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$00 +#$01 +#$02 +#$03
+ +#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A +#$0B +#$0C +#$0D +#$0E +#$0F
+ +#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18 +#$19 +#$40 +#$40
+ +#$40 +#$40 +#$40 +#$40 +#$1A +#$1B +#$1C +#$1D +#$1E +#$1F +#$20 +#$21
+ +#$22 +#$23 +#$24 +#$25 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D
+ +#$2E +#$2F +#$30 +#$31 +#$32 +#$33 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40;
+ ReTableUU =
+ #$01 +#$02 +#$03 +#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A +#$0B +#$0C
+ +#$0D +#$0E +#$0F +#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18
+ +#$19 +#$1A +#$1B +#$1C +#$1D +#$1E +#$1F +#$20 +#$21 +#$22 +#$23 +#$24
+ +#$25 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D +#$2E +#$2F +#$30
+ +#$31 +#$32 +#$33 +#$34 +#$35 +#$36 +#$37 +#$38 +#$39 +#$3A +#$3B +#$3C
+ +#$3D +#$3E +#$3F +#$00 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40
+ +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40
+ +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40;
+ ReTableXX =
+ #$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$00 +#$40
+ +#$01 +#$40 +#$40 +#$02 +#$03 +#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A
+ +#$0B +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$0C +#$0D +#$0E +#$0F
+ +#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18 +#$19 +#$1A +#$1B
+ +#$1C +#$1D +#$1E +#$1F +#$20 +#$21 +#$22 +#$23 +#$24 +#$25 +#$40 +#$40
+ +#$40 +#$40 +#$40 +#$40 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D
+ +#$2E +#$2F +#$30 +#$31 +#$32 +#$33 +#$34 +#$35 +#$36 +#$37 +#$38 +#$39
+ +#$3A +#$3B +#$3C +#$3D +#$3E +#$3F +#$40 +#$40 +#$40 +#$40 +#$40 +#$40;
+
+{:Decodes triplet encoding with a given character delimiter. It is used for
+ decoding quoted-printable or URL encoding.}
+function DecodeTriplet(const Value: AnsiString; Delimiter: AnsiChar): AnsiString;
+
+{:Decodes a string from quoted printable form. (also decodes triplet sequences
+ like '=7F')}
+function DecodeQuotedPrintable(const Value: AnsiString): AnsiString;
+
+{:Decodes a string of URL encoding. (also decodes triplet sequences like '%7F')}
+function DecodeURL(const Value: AnsiString): AnsiString;
+
+{:Performs triplet encoding with a given character delimiter. Used for encoding
+ quoted-printable or URL encoding.}
+function EncodeTriplet(const Value: AnsiString; Delimiter: AnsiChar;
+ Specials: TSpecials): AnsiString;
+
+{:Encodes a string to triplet quoted printable form. All @link(NonAsciiChar)
+ are encoded.}
+function EncodeQuotedPrintable(const Value: AnsiString): AnsiString;
+
+{:Encodes a string to triplet quoted printable form. All @link(NonAsciiChar) and
+ @link(SpecialChar) are encoded.}
+function EncodeSafeQuotedPrintable(const Value: AnsiString): AnsiString;
+
+{:Encodes a string to URL format. Used for encoding data from a form field in
+ HTTP, etc. (Encodes all critical characters including characters used as URL
+ delimiters ('/',':', etc.)}
+function EncodeURLElement(const Value: AnsiString): AnsiString;
+
+{:Encodes a string to URL format. Used to encode critical characters in all
+ URLs.}
+function EncodeURL(const Value: AnsiString): AnsiString;
+
+{:Decode 4to3 encoding with given table. If some element is not found in table,
+ first item from table is used. This is good for buggy coded items by Microsoft
+ Outlook. This software sometimes using wrong table for UUcode, where is used
+ ' ' instead '`'.}
+function Decode4to3(const Value, Table: AnsiString): AnsiString;
+
+{:Decode 4to3 encoding with given REVERSE table. Using this function with
+reverse table is much faster then @link(Decode4to3). This function is used
+internally for Base64, UU or XX decoding.}
+function Decode4to3Ex(const Value, Table: AnsiString): AnsiString;
+
+{:Encode by system 3to4 (used by Base64, UU coding, etc) by given table.}
+function Encode3to4(const Value, Table: AnsiString): AnsiString;
+
+{:Decode string from base64 format.}
+function DecodeBase64(const Value: AnsiString): AnsiString;
+
+{:Encodes a string to base64 format.}
+function EncodeBase64(const Value: AnsiString): AnsiString;
+
+{:Decode string from modified base64 format. (used in IMAP, for example.)}
+function DecodeBase64mod(const Value: AnsiString): AnsiString;
+
+{:Encodes a string to modified base64 format. (used in IMAP, for example.)}
+function EncodeBase64mod(const Value: AnsiString): AnsiString;
+
+{:Decodes a string from UUcode format.}
+function DecodeUU(const Value: AnsiString): AnsiString;
+
+{:encode UUcode. it encode only datas, you must also add header and footer for
+ proper encode.}
+function EncodeUU(const Value: AnsiString): AnsiString;
+
+{:Decodes a string from XXcode format.}
+function DecodeXX(const Value: AnsiString): AnsiString;
+
+{:decode line with Yenc code. This code is sometimes used in newsgroups.}
+function DecodeYEnc(const Value: AnsiString): AnsiString;
+
+{:Returns a new CRC32 value after adding a new byte of data.}
+function UpdateCrc32(Value: Byte; Crc32: Integer): Integer;
+
+{:return CRC32 from a value string.}
+function Crc32(const Value: AnsiString): Integer;
+
+{:Returns a new CRC16 value after adding a new byte of data.}
+function UpdateCrc16(Value: Byte; Crc16: Word): Word;
+
+{:return CRC16 from a value string.}
+function Crc16(const Value: AnsiString): Word;
+
+{:Returns a binary string with a RSA-MD5 hashing of "Value" string.}
+function MD5(const Value: AnsiString): AnsiString;
+
+{:Returns a binary string with HMAC-MD5 hash.}
+function HMAC_MD5(Text, Key: AnsiString): AnsiString;
+
+{:Returns a binary string with a RSA-MD5 hashing of string what is constructed
+ by repeating "value" until length is "Len".}
+function MD5LongHash(const Value: AnsiString; Len: integer): AnsiString;
+
+{:Returns a binary string with a SHA-1 hashing of "Value" string.}
+function SHA1(const Value: AnsiString): AnsiString;
+
+{:Returns a binary string with HMAC-SHA1 hash.}
+function HMAC_SHA1(Text, Key: AnsiString): AnsiString;
+
+{:Returns a binary string with a SHA-1 hashing of string what is constructed
+ by repeating "value" until length is "Len".}
+function SHA1LongHash(const Value: AnsiString; Len: integer): AnsiString;
+
+{:Returns a binary string with a RSA-MD4 hashing of "Value" string.}
+function MD4(const Value: AnsiString): AnsiString;
+
+implementation
+
+const
+
+ Crc32Tab: array[0..255] of Integer = (
+ Integer($00000000), Integer($77073096), Integer($EE0E612C), Integer($990951BA),
+ Integer($076DC419), Integer($706AF48F), Integer($E963A535), Integer($9E6495A3),
+ Integer($0EDB8832), Integer($79DCB8A4), Integer($E0D5E91E), Integer($97D2D988),
+ Integer($09B64C2B), Integer($7EB17CBD), Integer($E7B82D07), Integer($90BF1D91),
+ Integer($1DB71064), Integer($6AB020F2), Integer($F3B97148), Integer($84BE41DE),
+ Integer($1ADAD47D), Integer($6DDDE4EB), Integer($F4D4B551), Integer($83D385C7),
+ Integer($136C9856), Integer($646BA8C0), Integer($FD62F97A), Integer($8A65C9EC),
+ Integer($14015C4F), Integer($63066CD9), Integer($FA0F3D63), Integer($8D080DF5),
+ Integer($3B6E20C8), Integer($4C69105E), Integer($D56041E4), Integer($A2677172),
+ Integer($3C03E4D1), Integer($4B04D447), Integer($D20D85FD), Integer($A50AB56B),
+ Integer($35B5A8FA), Integer($42B2986C), Integer($DBBBC9D6), Integer($ACBCF940),
+ Integer($32D86CE3), Integer($45DF5C75), Integer($DCD60DCF), Integer($ABD13D59),
+ Integer($26D930AC), Integer($51DE003A), Integer($C8D75180), Integer($BFD06116),
+ Integer($21B4F4B5), Integer($56B3C423), Integer($CFBA9599), Integer($B8BDA50F),
+ Integer($2802B89E), Integer($5F058808), Integer($C60CD9B2), Integer($B10BE924),
+ Integer($2F6F7C87), Integer($58684C11), Integer($C1611DAB), Integer($B6662D3D),
+ Integer($76DC4190), Integer($01DB7106), Integer($98D220BC), Integer($EFD5102A),
+ Integer($71B18589), Integer($06B6B51F), Integer($9FBFE4A5), Integer($E8B8D433),
+ Integer($7807C9A2), Integer($0F00F934), Integer($9609A88E), Integer($E10E9818),
+ Integer($7F6A0DBB), Integer($086D3D2D), Integer($91646C97), Integer($E6635C01),
+ Integer($6B6B51F4), Integer($1C6C6162), Integer($856530D8), Integer($F262004E),
+ Integer($6C0695ED), Integer($1B01A57B), Integer($8208F4C1), Integer($F50FC457),
+ Integer($65B0D9C6), Integer($12B7E950), Integer($8BBEB8EA), Integer($FCB9887C),
+ Integer($62DD1DDF), Integer($15DA2D49), Integer($8CD37CF3), Integer($FBD44C65),
+ Integer($4DB26158), Integer($3AB551CE), Integer($A3BC0074), Integer($D4BB30E2),
+ Integer($4ADFA541), Integer($3DD895D7), Integer($A4D1C46D), Integer($D3D6F4FB),
+ Integer($4369E96A), Integer($346ED9FC), Integer($AD678846), Integer($DA60B8D0),
+ Integer($44042D73), Integer($33031DE5), Integer($AA0A4C5F), Integer($DD0D7CC9),
+ Integer($5005713C), Integer($270241AA), Integer($BE0B1010), Integer($C90C2086),
+ Integer($5768B525), Integer($206F85B3), Integer($B966D409), Integer($CE61E49F),
+ Integer($5EDEF90E), Integer($29D9C998), Integer($B0D09822), Integer($C7D7A8B4),
+ Integer($59B33D17), Integer($2EB40D81), Integer($B7BD5C3B), Integer($C0BA6CAD),
+ Integer($EDB88320), Integer($9ABFB3B6), Integer($03B6E20C), Integer($74B1D29A),
+ Integer($EAD54739), Integer($9DD277AF), Integer($04DB2615), Integer($73DC1683),
+ Integer($E3630B12), Integer($94643B84), Integer($0D6D6A3E), Integer($7A6A5AA8),
+ Integer($E40ECF0B), Integer($9309FF9D), Integer($0A00AE27), Integer($7D079EB1),
+ Integer($F00F9344), Integer($8708A3D2), Integer($1E01F268), Integer($6906C2FE),
+ Integer($F762575D), Integer($806567CB), Integer($196C3671), Integer($6E6B06E7),
+ Integer($FED41B76), Integer($89D32BE0), Integer($10DA7A5A), Integer($67DD4ACC),
+ Integer($F9B9DF6F), Integer($8EBEEFF9), Integer($17B7BE43), Integer($60B08ED5),
+ Integer($D6D6A3E8), Integer($A1D1937E), Integer($38D8C2C4), Integer($4FDFF252),
+ Integer($D1BB67F1), Integer($A6BC5767), Integer($3FB506DD), Integer($48B2364B),
+ Integer($D80D2BDA), Integer($AF0A1B4C), Integer($36034AF6), Integer($41047A60),
+ Integer($DF60EFC3), Integer($A867DF55), Integer($316E8EEF), Integer($4669BE79),
+ Integer($CB61B38C), Integer($BC66831A), Integer($256FD2A0), Integer($5268E236),
+ Integer($CC0C7795), Integer($BB0B4703), Integer($220216B9), Integer($5505262F),
+ Integer($C5BA3BBE), Integer($B2BD0B28), Integer($2BB45A92), Integer($5CB36A04),
+ Integer($C2D7FFA7), Integer($B5D0CF31), Integer($2CD99E8B), Integer($5BDEAE1D),
+ Integer($9B64C2B0), Integer($EC63F226), Integer($756AA39C), Integer($026D930A),
+ Integer($9C0906A9), Integer($EB0E363F), Integer($72076785), Integer($05005713),
+ Integer($95BF4A82), Integer($E2B87A14), Integer($7BB12BAE), Integer($0CB61B38),
+ Integer($92D28E9B), Integer($E5D5BE0D), Integer($7CDCEFB7), Integer($0BDBDF21),
+ Integer($86D3D2D4), Integer($F1D4E242), Integer($68DDB3F8), Integer($1FDA836E),
+ Integer($81BE16CD), Integer($F6B9265B), Integer($6FB077E1), Integer($18B74777),
+ Integer($88085AE6), Integer($FF0F6A70), Integer($66063BCA), Integer($11010B5C),
+ Integer($8F659EFF), Integer($F862AE69), Integer($616BFFD3), Integer($166CCF45),
+ Integer($A00AE278), Integer($D70DD2EE), Integer($4E048354), Integer($3903B3C2),
+ Integer($A7672661), Integer($D06016F7), Integer($4969474D), Integer($3E6E77DB),
+ Integer($AED16A4A), Integer($D9D65ADC), Integer($40DF0B66), Integer($37D83BF0),
+ Integer($A9BCAE53), Integer($DEBB9EC5), Integer($47B2CF7F), Integer($30B5FFE9),
+ Integer($BDBDF21C), Integer($CABAC28A), Integer($53B39330), Integer($24B4A3A6),
+ Integer($BAD03605), Integer($CDD70693), Integer($54DE5729), Integer($23D967BF),
+ Integer($B3667A2E), Integer($C4614AB8), Integer($5D681B02), Integer($2A6F2B94),
+ Integer($B40BBE37), Integer($C30C8EA1), Integer($5A05DF1B), Integer($2D02EF8D)
+ );
+
+ Crc16Tab: array[0..255] of Word = (
+ $0000, $1189, $2312, $329B, $4624, $57AD, $6536, $74BF,
+ $8C48, $9DC1, $AF5A, $BED3, $CA6C, $DBE5, $E97E, $F8F7,
+ $1081, $0108, $3393, $221A, $56A5, $472C, $75B7, $643E,
+ $9CC9, $8D40, $BFDB, $AE52, $DAED, $CB64, $F9FF, $E876,
+ $2102, $308B, $0210, $1399, $6726, $76AF, $4434, $55BD,
+ $AD4A, $BCC3, $8E58, $9FD1, $EB6E, $FAE7, $C87C, $D9F5,
+ $3183, $200A, $1291, $0318, $77A7, $662E, $54B5, $453C,
+ $BDCB, $AC42, $9ED9, $8F50, $FBEF, $EA66, $D8FD, $C974,
+ $4204, $538D, $6116, $709F, $0420, $15A9, $2732, $36BB,
+ $CE4C, $DFC5, $ED5E, $FCD7, $8868, $99E1, $AB7A, $BAF3,
+ $5285, $430C, $7197, $601E, $14A1, $0528, $37B3, $263A,
+ $DECD, $CF44, $FDDF, $EC56, $98E9, $8960, $BBFB, $AA72,
+ $6306, $728F, $4014, $519D, $2522, $34AB, $0630, $17B9,
+ $EF4E, $FEC7, $CC5C, $DDD5, $A96A, $B8E3, $8A78, $9BF1,
+ $7387, $620E, $5095, $411C, $35A3, $242A, $16B1, $0738,
+ $FFCF, $EE46, $DCDD, $CD54, $B9EB, $A862, $9AF9, $8B70,
+ $8408, $9581, $A71A, $B693, $C22C, $D3A5, $E13E, $F0B7,
+ $0840, $19C9, $2B52, $3ADB, $4E64, $5FED, $6D76, $7CFF,
+ $9489, $8500, $B79B, $A612, $D2AD, $C324, $F1BF, $E036,
+ $18C1, $0948, $3BD3, $2A5A, $5EE5, $4F6C, $7DF7, $6C7E,
+ $A50A, $B483, $8618, $9791, $E32E, $F2A7, $C03C, $D1B5,
+ $2942, $38CB, $0A50, $1BD9, $6F66, $7EEF, $4C74, $5DFD,
+ $B58B, $A402, $9699, $8710, $F3AF, $E226, $D0BD, $C134,
+ $39C3, $284A, $1AD1, $0B58, $7FE7, $6E6E, $5CF5, $4D7C,
+ $C60C, $D785, $E51E, $F497, $8028, $91A1, $A33A, $B2B3,
+ $4A44, $5BCD, $6956, $78DF, $0C60, $1DE9, $2F72, $3EFB,
+ $D68D, $C704, $F59F, $E416, $90A9, $8120, $B3BB, $A232,
+ $5AC5, $4B4C, $79D7, $685E, $1CE1, $0D68, $3FF3, $2E7A,
+ $E70E, $F687, $C41C, $D595, $A12A, $B0A3, $8238, $93B1,
+ $6B46, $7ACF, $4854, $59DD, $2D62, $3CEB, $0E70, $1FF9,
+ $F78F, $E606, $D49D, $C514, $B1AB, $A022, $92B9, $8330,
+ $7BC7, $6A4E, $58D5, $495C, $3DE3, $2C6A, $1EF1, $0F78
+ );
+
+procedure ArrByteToLong(var ArByte: Array of byte; var ArLong: Array of Integer);
+{$IFDEF CIL}
+var
+ n: integer;
+{$ENDIF}
+begin
+ if (High(ArByte) + 1) > ((High(ArLong) + 1) * 4) then
+ Exit;
+ {$IFDEF CIL}
+ for n := 0 to ((high(ArByte) + 1) div 4) - 1 do
+ ArLong[n] := ArByte[n * 4 + 0]
+ + (ArByte[n * 4 + 1] shl 8)
+ + (ArByte[n * 4 + 2] shl 16)
+ + (ArByte[n * 4 + 3] shl 24);
+ {$ELSE}
+ Move(ArByte[0], ArLong[0], High(ArByte) + 1);
+ {$ENDIF}
+end;
+
+procedure ArrLongToByte(var ArLong: Array of Integer; var ArByte: Array of byte);
+{$IFDEF CIL}
+var
+ n: integer;
+{$ENDIF}
+begin
+ if (High(ArByte) + 1) < ((High(ArLong) + 1) * 4) then
+ Exit;
+ {$IFDEF CIL}
+ for n := 0 to high(ArLong) do
+ begin
+ ArByte[n * 4 + 0] := ArLong[n] and $000000FF;
+ ArByte[n * 4 + 1] := (ArLong[n] shr 8) and $000000FF;
+ ArByte[n * 4 + 2] := (ArLong[n] shr 16) and $000000FF;
+ ArByte[n * 4 + 3] := (ArLong[n] shr 24) and $000000FF;
+ end;
+ {$ELSE}
+ Move(ArLong[0], ArByte[0], High(ArByte) + 1);
+ {$ENDIF}
+end;
+
+type
+ TMDCtx = record
+ State: array[0..3] of Integer;
+ Count: array[0..1] of Integer;
+ BufAnsiChar: array[0..63] of Byte;
+ BufLong: array[0..15] of Integer;
+ end;
+ TSHA1Ctx= record
+ Hi, Lo: integer;
+ Buffer: array[0..63] of byte;
+ Index: integer;
+ Hash: array[0..4] of Integer;
+ HashByte: array[0..19] of byte;
+ end;
+
+ TMDTransform = procedure(var Buf: array of LongInt; const Data: array of LongInt);
+
+{==============================================================================}
+
+function DecodeTriplet(const Value: AnsiString; Delimiter: AnsiChar): AnsiString;
+var
+ x, l, lv: Integer;
+ c: AnsiChar;
+ b: Byte;
+ bad: Boolean;
+begin
+ lv := Length(Value);
+ SetLength(Result, lv);
+ x := 1;
+ l := 1;
+ while x <= lv do
+ begin
+ c := Value[x];
+ Inc(x);
+ if c <> Delimiter then
+ begin
+ Result[l] := c;
+ Inc(l);
+ end
+ else
+ if x < lv then
+ begin
+ Case Value[x] Of
+ #13:
+ if (Value[x + 1] = #10) then
+ Inc(x, 2)
+ else
+ Inc(x);
+ #10:
+ if (Value[x + 1] = #13) then
+ Inc(x, 2)
+ else
+ Inc(x);
+ else
+ begin
+ bad := False;
+ Case Value[x] Of
+ '0'..'9': b := (Byte(Value[x]) - 48) Shl 4;
+ 'a'..'f', 'A'..'F': b := ((Byte(Value[x]) And 7) + 9) shl 4;
+ else
+ begin
+ b := 0;
+ bad := True;
+ end;
+ end;
+ Case Value[x + 1] Of
+ '0'..'9': b := b Or (Byte(Value[x + 1]) - 48);
+ 'a'..'f', 'A'..'F': b := b Or ((Byte(Value[x + 1]) And 7) + 9);
+ else
+ bad := True;
+ end;
+ if bad then
+ begin
+ Result[l] := c;
+ Inc(l);
+ end
+ else
+ begin
+ Inc(x, 2);
+ Result[l] := AnsiChar(b);
+ Inc(l);
+ end;
+ end;
+ end;
+ end
+ else
+ break;
+ end;
+ Dec(l);
+ SetLength(Result, l);
+end;
+
+{==============================================================================}
+
+function DecodeQuotedPrintable(const Value: AnsiString): AnsiString;
+begin
+ Result := DecodeTriplet(Value, '=');
+end;
+
+{==============================================================================}
+
+function DecodeURL(const Value: AnsiString): AnsiString;
+begin
+ Result := DecodeTriplet(Value, '%');
+end;
+
+{==============================================================================}
+
+function EncodeTriplet(const Value: AnsiString; Delimiter: AnsiChar;
+ Specials: TSpecials): AnsiString;
+var
+ n, l: Integer;
+ s: AnsiString;
+ c: AnsiChar;
+begin
+ SetLength(Result, Length(Value) * 3);
+ l := 1;
+ for n := 1 to Length(Value) do
+ begin
+ c := Value[n];
+ if c in Specials then
+ begin
+ Result[l] := Delimiter;
+ Inc(l);
+ s := IntToHex(Ord(c), 2);
+ Result[l] := s[1];
+ Inc(l);
+ Result[l] := s[2];
+ Inc(l);
+ end
+ else
+ begin
+ Result[l] := c;
+ Inc(l);
+ end;
+ end;
+ Dec(l);
+ SetLength(Result, l);
+end;
+
+{==============================================================================}
+
+function EncodeQuotedPrintable(const Value: AnsiString): AnsiString;
+begin
+ Result := EncodeTriplet(Value, '=', ['='] + NonAsciiChar);
+end;
+
+{==============================================================================}
+
+function EncodeSafeQuotedPrintable(const Value: AnsiString): AnsiString;
+begin
+ Result := EncodeTriplet(Value, '=', SpecialChar + NonAsciiChar);
+end;
+
+{==============================================================================}
+
+function EncodeURLElement(const Value: AnsiString): AnsiString;
+begin
+ Result := EncodeTriplet(Value, '%', URLSpecialChar + URLFullSpecialChar);
+end;
+
+{==============================================================================}
+
+function EncodeURL(const Value: AnsiString): AnsiString;
+begin
+ Result := EncodeTriplet(Value, '%', URLSpecialChar);
+end;
+
+{==============================================================================}
+
+function Decode4to3(const Value, Table: AnsiString): AnsiString;
+var
+ x, y, n, l: Integer;
+ d: array[0..3] of Byte;
+begin
+ SetLength(Result, Length(Value));
+ x := 1;
+ l := 1;
+ while x <= Length(Value) do
+ begin
+ for n := 0 to 3 do
+ begin
+ if x > Length(Value) then
+ d[n] := 64
+ else
+ begin
+ y := Pos(Value[x], Table);
+ if y < 1 then
+ y := 1;
+ d[n] := y - 1;
+ end;
+ Inc(x);
+ end;
+ Result[l] := AnsiChar((D[0] and $3F) shl 2 + (D[1] and $30) shr 4);
+ Inc(l);
+ if d[2] <> 64 then
+ begin
+ Result[l] := AnsiChar((D[1] and $0F) shl 4 + (D[2] and $3C) shr 2);
+ Inc(l);
+ if d[3] <> 64 then
+ begin
+ Result[l] := AnsiChar((D[2] and $03) shl 6 + (D[3] and $3F));
+ Inc(l);
+ end;
+ end;
+ end;
+ Dec(l);
+ SetLength(Result, l);
+end;
+
+{==============================================================================}
+function Decode4to3Ex(const Value, Table: AnsiString): AnsiString;
+var
+ x, y, lv: Integer;
+ d: integer;
+ dl: integer;
+ c: byte;
+ p: integer;
+begin
+ lv := Length(Value);
+ SetLength(Result, lv);
+ x := 1;
+ dl := 4;
+ d := 0;
+ p := 1;
+ while x <= lv do
+ begin
+ y := Ord(Value[x]);
+ if y in [33..127] then
+ c := Ord(Table[y - 32])
+ else
+ c := 64;
+ Inc(x);
+ if c > 63 then
+ continue;
+ d := (d shl 6) or c;
+ dec(dl);
+ if dl <> 0 then
+ continue;
+ Result[p] := AnsiChar((d shr 16) and $ff);
+ inc(p);
+ Result[p] := AnsiChar((d shr 8) and $ff);
+ inc(p);
+ Result[p] := AnsiChar(d and $ff);
+ inc(p);
+ d := 0;
+ dl := 4;
+ end;
+ case dl of
+ 1:
+ begin
+ d := d shr 2;
+ Result[p] := AnsiChar((d shr 8) and $ff);
+ inc(p);
+ Result[p] := AnsiChar(d and $ff);
+ inc(p);
+ end;
+ 2:
+ begin
+ d := d shr 4;
+ Result[p] := AnsiChar(d and $ff);
+ inc(p);
+ end;
+ end;
+ SetLength(Result, p - 1);
+end;
+
+{==============================================================================}
+
+function Encode3to4(const Value, Table: AnsiString): AnsiString;
+var
+ c: Byte;
+ n, l: Integer;
+ Count: Integer;
+ DOut: array[0..3] of Byte;
+begin
+ setlength(Result, ((Length(Value) + 2) div 3) * 4);
+ l := 1;
+ Count := 1;
+ while Count <= Length(Value) do
+ begin
+ c := Ord(Value[Count]);
+ Inc(Count);
+ DOut[0] := (c and $FC) shr 2;
+ DOut[1] := (c and $03) shl 4;
+ if Count <= Length(Value) then
+ begin
+ c := Ord(Value[Count]);
+ Inc(Count);
+ DOut[1] := DOut[1] + (c and $F0) shr 4;
+ DOut[2] := (c and $0F) shl 2;
+ if Count <= Length(Value) then
+ begin
+ c := Ord(Value[Count]);
+ Inc(Count);
+ DOut[2] := DOut[2] + (c and $C0) shr 6;
+ DOut[3] := (c and $3F);
+ end
+ else
+ begin
+ DOut[3] := $40;
+ end;
+ end
+ else
+ begin
+ DOut[2] := $40;
+ DOut[3] := $40;
+ end;
+ for n := 0 to 3 do
+ begin
+ if (DOut[n] + 1) <= Length(Table) then
+ begin
+ Result[l] := Table[DOut[n] + 1];
+ Inc(l);
+ end;
+ end;
+ end;
+ SetLength(Result, l - 1);
+end;
+
+{==============================================================================}
+
+function DecodeBase64(const Value: AnsiString): AnsiString;
+begin
+ Result := Decode4to3Ex(Value, ReTableBase64);
+end;
+
+{==============================================================================}
+
+function EncodeBase64(const Value: AnsiString): AnsiString;
+begin
+ Result := Encode3to4(Value, TableBase64);
+end;
+
+{==============================================================================}
+
+function DecodeBase64mod(const Value: AnsiString): AnsiString;
+begin
+ Result := Decode4to3(Value, TableBase64mod);
+end;
+
+{==============================================================================}
+
+function EncodeBase64mod(const Value: AnsiString): AnsiString;
+begin
+ Result := Encode3to4(Value, TableBase64mod);
+end;
+
+{==============================================================================}
+
+function DecodeUU(const Value: AnsiString): AnsiString;
+var
+ s: AnsiString;
+ uut: AnsiString;
+ x: Integer;
+begin
+ Result := '';
+ uut := TableUU;
+ s := trim(UpperCase(Value));
+ if s = '' then Exit;
+ if Pos('BEGIN', s) = 1 then
+ Exit;
+ if Pos('END', s) = 1 then
+ Exit;
+ if Pos('TABLE', s) = 1 then
+ Exit; //ignore Table yet (set custom UUT)
+ //begin decoding
+ x := Pos(Value[1], uut) - 1;
+ case (x mod 3) of
+ 0: x :=(x div 3)* 4;
+ 1: x :=((x div 3) * 4) + 2;
+ 2: x :=((x div 3) * 4) + 3;
+ end;
+ //x - lenght UU line
+ s := Copy(Value, 2, x);
+ if s = '' then
+ Exit;
+ s := s + StringOfChar(' ', x - length(s));
+ Result := Decode4to3(s, uut);
+end;
+
+{==============================================================================}
+
+function EncodeUU(const Value: AnsiString): AnsiString;
+begin
+ Result := '';
+ if Length(Value) < Length(TableUU) then
+ Result := TableUU[Length(Value) + 1] + Encode3to4(Value, TableUU);
+end;
+
+{==============================================================================}
+
+function DecodeXX(const Value: AnsiString): AnsiString;
+var
+ s: AnsiString;
+ x: Integer;
+begin
+ Result := '';
+ s := trim(UpperCase(Value));
+ if s = '' then
+ Exit;
+ if Pos('BEGIN', s) = 1 then
+ Exit;
+ if Pos('END', s) = 1 then
+ Exit;
+ //begin decoding
+ x := Pos(Value[1], TableXX) - 1;
+ case (x mod 3) of
+ 0: x :=(x div 3)* 4;
+ 1: x :=((x div 3) * 4) + 2;
+ 2: x :=((x div 3) * 4) + 3;
+ end;
+ //x - lenght XX line
+ s := Copy(Value, 2, x);
+ if s = '' then
+ Exit;
+ s := s + StringOfChar(' ', x - length(s));
+ Result := Decode4to3(s, TableXX);
+end;
+
+{==============================================================================}
+
+function DecodeYEnc(const Value: AnsiString): AnsiString;
+var
+ C : Byte;
+ i: integer;
+begin
+ Result := '';
+ i := 1;
+ while i <= Length(Value) do
+ begin
+ c := Ord(Value[i]);
+ Inc(i);
+ if c = Ord('=') then
+ begin
+ c := Ord(Value[i]);
+ Inc(i);
+ Dec(c, 64);
+ end;
+ Dec(C, 42);
+ Result := Result + AnsiChar(C);
+ end;
+end;
+
+{==============================================================================}
+
+function UpdateCrc32(Value: Byte; Crc32: Integer): Integer;
+begin
+ Result := (Crc32 shr 8)
+ xor crc32tab[Byte(Value xor (Crc32 and Integer($000000FF)))];
+end;
+
+{==============================================================================}
+
+function Crc32(const Value: AnsiString): Integer;
+var
+ n: Integer;
+begin
+ Result := Integer($FFFFFFFF);
+ for n := 1 to Length(Value) do
+ Result := UpdateCrc32(Ord(Value[n]), Result);
+ Result := not Result;
+end;
+
+{==============================================================================}
+
+function UpdateCrc16(Value: Byte; Crc16: Word): Word;
+begin
+ Result := ((Crc16 shr 8) and $00FF) xor
+ crc16tab[Byte(Crc16 xor (Word(Value)) and $00FF)];
+end;
+
+{==============================================================================}
+
+function Crc16(const Value: AnsiString): Word;
+var
+ n: Integer;
+begin
+ Result := $FFFF;
+ for n := 1 to Length(Value) do
+ Result := UpdateCrc16(Ord(Value[n]), Result);
+end;
+
+{==============================================================================}
+
+procedure MDInit(var MDContext: TMDCtx);
+var
+ n: integer;
+begin
+ MDContext.Count[0] := 0;
+ MDContext.Count[1] := 0;
+ for n := 0 to high(MDContext.BufAnsiChar) do
+ MDContext.BufAnsiChar[n] := 0;
+ for n := 0 to high(MDContext.BufLong) do
+ MDContext.BufLong[n] := 0;
+ MDContext.State[0] := Integer($67452301);
+ MDContext.State[1] := Integer($EFCDAB89);
+ MDContext.State[2] := Integer($98BADCFE);
+ MDContext.State[3] := Integer($10325476);
+end;
+
+procedure MD5Transform(var Buf: array of LongInt; const Data: array of LongInt);
+var
+ A, B, C, D: LongInt;
+
+ procedure Round1(var W: LongInt; X, Y, Z, Data: LongInt; S: Byte);
+ begin
+ Inc(W, (Z xor (X and (Y xor Z))) + Data);
+ W := (W shl S) or (W shr (32 - S));
+ Inc(W, X);
+ end;
+
+ procedure Round2(var W: LongInt; X, Y, Z, Data: LongInt; S: Byte);
+ begin
+ Inc(W, (Y xor (Z and (X xor Y))) + Data);
+ W := (W shl S) or (W shr (32 - S));
+ Inc(W, X);
+ end;
+
+ procedure Round3(var W: LongInt; X, Y, Z, Data: LongInt; S: Byte);
+ begin
+ Inc(W, (X xor Y xor Z) + Data);
+ W := (W shl S) or (W shr (32 - S));
+ Inc(W, X);
+ end;
+
+ procedure Round4(var W: LongInt; X, Y, Z, Data: LongInt; S: Byte);
+ begin
+ Inc(W, (Y xor (X or not Z)) + Data);
+ W := (W shl S) or (W shr (32 - S));
+ Inc(W, X);
+ end;
+begin
+ A := Buf[0];
+ B := Buf[1];
+ C := Buf[2];
+ D := Buf[3];
+
+ Round1(A, B, C, D, Data[0] + Longint($D76AA478), 7);
+ Round1(D, A, B, C, Data[1] + Longint($E8C7B756), 12);
+ Round1(C, D, A, B, Data[2] + Longint($242070DB), 17);
+ Round1(B, C, D, A, Data[3] + Longint($C1BDCEEE), 22);
+ Round1(A, B, C, D, Data[4] + Longint($F57C0FAF), 7);
+ Round1(D, A, B, C, Data[5] + Longint($4787C62A), 12);
+ Round1(C, D, A, B, Data[6] + Longint($A8304613), 17);
+ Round1(B, C, D, A, Data[7] + Longint($FD469501), 22);
+ Round1(A, B, C, D, Data[8] + Longint($698098D8), 7);
+ Round1(D, A, B, C, Data[9] + Longint($8B44F7AF), 12);
+ Round1(C, D, A, B, Data[10] + Longint($FFFF5BB1), 17);
+ Round1(B, C, D, A, Data[11] + Longint($895CD7BE), 22);
+ Round1(A, B, C, D, Data[12] + Longint($6B901122), 7);
+ Round1(D, A, B, C, Data[13] + Longint($FD987193), 12);
+ Round1(C, D, A, B, Data[14] + Longint($A679438E), 17);
+ Round1(B, C, D, A, Data[15] + Longint($49B40821), 22);
+
+ Round2(A, B, C, D, Data[1] + Longint($F61E2562), 5);
+ Round2(D, A, B, C, Data[6] + Longint($C040B340), 9);
+ Round2(C, D, A, B, Data[11] + Longint($265E5A51), 14);
+ Round2(B, C, D, A, Data[0] + Longint($E9B6C7AA), 20);
+ Round2(A, B, C, D, Data[5] + Longint($D62F105D), 5);
+ Round2(D, A, B, C, Data[10] + Longint($02441453), 9);
+ Round2(C, D, A, B, Data[15] + Longint($D8A1E681), 14);
+ Round2(B, C, D, A, Data[4] + Longint($E7D3FBC8), 20);
+ Round2(A, B, C, D, Data[9] + Longint($21E1CDE6), 5);
+ Round2(D, A, B, C, Data[14] + Longint($C33707D6), 9);
+ Round2(C, D, A, B, Data[3] + Longint($F4D50D87), 14);
+ Round2(B, C, D, A, Data[8] + Longint($455A14ED), 20);
+ Round2(A, B, C, D, Data[13] + Longint($A9E3E905), 5);
+ Round2(D, A, B, C, Data[2] + Longint($FCEFA3F8), 9);
+ Round2(C, D, A, B, Data[7] + Longint($676F02D9), 14);
+ Round2(B, C, D, A, Data[12] + Longint($8D2A4C8A), 20);
+
+ Round3(A, B, C, D, Data[5] + Longint($FFFA3942), 4);
+ Round3(D, A, B, C, Data[8] + Longint($8771F681), 11);
+ Round3(C, D, A, B, Data[11] + Longint($6D9D6122), 16);
+ Round3(B, C, D, A, Data[14] + Longint($FDE5380C), 23);
+ Round3(A, B, C, D, Data[1] + Longint($A4BEEA44), 4);
+ Round3(D, A, B, C, Data[4] + Longint($4BDECFA9), 11);
+ Round3(C, D, A, B, Data[7] + Longint($F6BB4B60), 16);
+ Round3(B, C, D, A, Data[10] + Longint($BEBFBC70), 23);
+ Round3(A, B, C, D, Data[13] + Longint($289B7EC6), 4);
+ Round3(D, A, B, C, Data[0] + Longint($EAA127FA), 11);
+ Round3(C, D, A, B, Data[3] + Longint($D4EF3085), 16);
+ Round3(B, C, D, A, Data[6] + Longint($04881D05), 23);
+ Round3(A, B, C, D, Data[9] + Longint($D9D4D039), 4);
+ Round3(D, A, B, C, Data[12] + Longint($E6DB99E5), 11);
+ Round3(C, D, A, B, Data[15] + Longint($1FA27CF8), 16);
+ Round3(B, C, D, A, Data[2] + Longint($C4AC5665), 23);
+
+ Round4(A, B, C, D, Data[0] + Longint($F4292244), 6);
+ Round4(D, A, B, C, Data[7] + Longint($432AFF97), 10);
+ Round4(C, D, A, B, Data[14] + Longint($AB9423A7), 15);
+ Round4(B, C, D, A, Data[5] + Longint($FC93A039), 21);
+ Round4(A, B, C, D, Data[12] + Longint($655B59C3), 6);
+ Round4(D, A, B, C, Data[3] + Longint($8F0CCC92), 10);
+ Round4(C, D, A, B, Data[10] + Longint($FFEFF47D), 15);
+ Round4(B, C, D, A, Data[1] + Longint($85845DD1), 21);
+ Round4(A, B, C, D, Data[8] + Longint($6FA87E4F), 6);
+ Round4(D, A, B, C, Data[15] + Longint($FE2CE6E0), 10);
+ Round4(C, D, A, B, Data[6] + Longint($A3014314), 15);
+ Round4(B, C, D, A, Data[13] + Longint($4E0811A1), 21);
+ Round4(A, B, C, D, Data[4] + Longint($F7537E82), 6);
+ Round4(D, A, B, C, Data[11] + Longint($BD3AF235), 10);
+ Round4(C, D, A, B, Data[2] + Longint($2AD7D2BB), 15);
+ Round4(B, C, D, A, Data[9] + Longint($EB86D391), 21);
+
+ Inc(Buf[0], A);
+ Inc(Buf[1], B);
+ Inc(Buf[2], C);
+ Inc(Buf[3], D);
+end;
+
+//fixed by James McAdams
+procedure MDUpdate(var MDContext: TMDCtx; const Data: AnsiString; transform: TMDTransform);
+var
+ Index, partLen, InputLen, I: integer;
+{$IFDEF CIL}
+ n: integer;
+{$ENDIF}
+begin
+ InputLen := Length(Data);
+ with MDContext do
+ begin
+ Index := (Count[0] shr 3) and $3F;
+ Inc(Count[0], InputLen shl 3);
+ if Count[0] < (InputLen shl 3) then
+ Inc(Count[1]);
+ Inc(Count[1], InputLen shr 29);
+ partLen := 64 - Index;
+ if InputLen >= partLen then
+ begin
+ ArrLongToByte(BufLong, BufAnsiChar);
+ {$IFDEF CIL}
+ for n := 1 to partLen do
+ BufAnsiChar[index - 1 + n] := Ord(Data[n]);
+ {$ELSE}
+ Move(Data[1], BufAnsiChar[Index], partLen);
+ {$ENDIF}
+ ArrByteToLong(BufAnsiChar, BufLong);
+ Transform(State, Buflong);
+ I := partLen;
+ while I + 63 < InputLen do
+ begin
+ ArrLongToByte(BufLong, BufAnsiChar);
+ {$IFDEF CIL}
+ for n := 1 to 64 do
+ BufAnsiChar[n - 1] := Ord(Data[i + n]);
+ {$ELSE}
+ Move(Data[I+1], BufAnsiChar, 64);
+ {$ENDIF}
+ ArrByteToLong(BufAnsiChar, BufLong);
+ Transform(State, Buflong);
+ inc(I, 64);
+ end;
+ Index := 0;
+ end
+ else
+ I := 0;
+ ArrLongToByte(BufLong, BufAnsiChar);
+ {$IFDEF CIL}
+ for n := 1 to InputLen-I do
+ BufAnsiChar[Index + n - 1] := Ord(Data[i + n]);
+ {$ELSE}
+ Move(Data[I+1], BufAnsiChar[Index], InputLen-I);
+ {$ENDIF}
+ ArrByteToLong(BufAnsiChar, BufLong);
+ end
+end;
+
+function MDFinal(var MDContext: TMDCtx; transform: TMDTransform): AnsiString;
+var
+ Cnt: Word;
+ P: Byte;
+ digest: array[0..15] of Byte;
+ i: Integer;
+ n: integer;
+begin
+ for I := 0 to 15 do
+ Digest[I] := I + 1;
+ with MDContext do
+ begin
+ Cnt := (Count[0] shr 3) and $3F;
+ P := Cnt;
+ BufAnsiChar[P] := $80;
+ Inc(P);
+ Cnt := 64 - 1 - Cnt;
+ if Cnt < 8 then
+ begin
+ for n := 0 to cnt - 1 do
+ BufAnsiChar[P + n] := 0;
+ ArrByteToLong(BufAnsiChar, BufLong);
+// FillChar(BufAnsiChar[P], Cnt, #0);
+ Transform(State, BufLong);
+ ArrLongToByte(BufLong, BufAnsiChar);
+ for n := 0 to 55 do
+ BufAnsiChar[n] := 0;
+ ArrByteToLong(BufAnsiChar, BufLong);
+// FillChar(BufAnsiChar, 56, #0);
+ end
+ else
+ begin
+ for n := 0 to Cnt - 8 - 1 do
+ BufAnsiChar[p + n] := 0;
+ ArrByteToLong(BufAnsiChar, BufLong);
+// FillChar(BufAnsiChar[P], Cnt - 8, #0);
+ end;
+ BufLong[14] := Count[0];
+ BufLong[15] := Count[1];
+ Transform(State, BufLong);
+ ArrLongToByte(State, Digest);
+// Move(State, Digest, 16);
+ Result := '';
+ for i := 0 to 15 do
+ Result := Result + AnsiChar(digest[i]);
+ end;
+// FillChar(MD5Context, SizeOf(TMD5Ctx), #0)
+end;
+
+{==============================================================================}
+
+function MD5(const Value: AnsiString): AnsiString;
+var
+ MDContext: TMDCtx;
+begin
+ MDInit(MDContext);
+ MDUpdate(MDContext, Value, @MD5Transform);
+ Result := MDFinal(MDContext, @MD5Transform);
+end;
+
+{==============================================================================}
+
+function HMAC_MD5(Text, Key: AnsiString): AnsiString;
+var
+ ipad, opad, s: AnsiString;
+ n: Integer;
+ MDContext: TMDCtx;
+begin
+ if Length(Key) > 64 then
+ Key := md5(Key);
+ ipad := StringOfChar(#$36, 64);
+ opad := StringOfChar(#$5C, 64);
+ for n := 1 to Length(Key) do
+ begin
+ ipad[n] := AnsiChar(Byte(ipad[n]) xor Byte(Key[n]));
+ opad[n] := AnsiChar(Byte(opad[n]) xor Byte(Key[n]));
+ end;
+ MDInit(MDContext);
+ MDUpdate(MDContext, ipad, @MD5Transform);
+ MDUpdate(MDContext, Text, @MD5Transform);
+ s := MDFinal(MDContext, @MD5Transform);
+ MDInit(MDContext);
+ MDUpdate(MDContext, opad, @MD5Transform);
+ MDUpdate(MDContext, s, @MD5Transform);
+ Result := MDFinal(MDContext, @MD5Transform);
+end;
+
+{==============================================================================}
+
+function MD5LongHash(const Value: AnsiString; Len: integer): AnsiString;
+var
+ cnt, rest: integer;
+ l: integer;
+ n: integer;
+ MDContext: TMDCtx;
+begin
+ l := length(Value);
+ cnt := Len div l;
+ rest := Len mod l;
+ MDInit(MDContext);
+ for n := 1 to cnt do
+ MDUpdate(MDContext, Value, @MD5Transform);
+ if rest > 0 then
+ MDUpdate(MDContext, Copy(Value, 1, rest), @MD5Transform);
+ Result := MDFinal(MDContext, @MD5Transform);
+end;
+
+{==============================================================================}
+// SHA1 is based on sources by Dave Barton (davebarton@bigfoot.com)
+
+procedure SHA1init( var SHA1Context: TSHA1Ctx );
+var
+ n: integer;
+begin
+ SHA1Context.Hi := 0;
+ SHA1Context.Lo := 0;
+ SHA1Context.Index := 0;
+ for n := 0 to High(SHA1Context.Buffer) do
+ SHA1Context.Buffer[n] := 0;
+ for n := 0 to High(SHA1Context.HashByte) do
+ SHA1Context.HashByte[n] := 0;
+// FillChar(SHA1Context, SizeOf(TSHA1Ctx), #0);
+ SHA1Context.Hash[0] := integer($67452301);
+ SHA1Context.Hash[1] := integer($EFCDAB89);
+ SHA1Context.Hash[2] := integer($98BADCFE);
+ SHA1Context.Hash[3] := integer($10325476);
+ SHA1Context.Hash[4] := integer($C3D2E1F0);
+end;
+
+//******************************************************************************
+function RB(A: integer): integer;
+begin
+ Result := (A shr 24) or ((A shr 8) and $FF00) or ((A shl 8) and $FF0000) or (A shl 24);
+end;
+
+procedure SHA1Compress(var Data: TSHA1Ctx);
+var
+ A, B, C, D, E, T: integer;
+ W: array[0..79] of integer;
+ i: integer;
+ n: integer;
+
+ function F1(x, y, z: integer): integer;
+ begin
+ Result := z xor (x and (y xor z));
+ end;
+ function F2(x, y, z: integer): integer;
+ begin
+ Result := x xor y xor z;
+ end;
+ function F3(x, y, z: integer): integer;
+ begin
+ Result := (x and y) or (z and (x or y));
+ end;
+ function LRot32(X: integer; c: integer): integer;
+ begin
+ result := (x shl c) or (x shr (32 - c));
+ end;
+begin
+ ArrByteToLong(Data.Buffer, W);
+// Move(Data.Buffer, W, Sizeof(Data.Buffer));
+ for i := 0 to 15 do
+ W[i] := RB(W[i]);
+ for i := 16 to 79 do
+ W[i] := LRot32(W[i-3] xor W[i-8] xor W[i-14] xor W[i-16], 1);
+ A := Data.Hash[0];
+ B := Data.Hash[1];
+ C := Data.Hash[2];
+ D := Data.Hash[3];
+ E := Data.Hash[4];
+ for i := 0 to 19 do
+ begin
+ T := LRot32(A, 5) + F1(B, C, D) + E + W[i] + integer($5A827999);
+ E := D;
+ D := C;
+ C := LRot32(B, 30);
+ B := A;
+ A := T;
+ end;
+ for i := 20 to 39 do
+ begin
+ T := LRot32(A, 5) + F2(B, C, D) + E + W[i] + integer($6ED9EBA1);
+ E := D;
+ D := C;
+ C := LRot32(B, 30);
+ B := A;
+ A := T;
+ end;
+ for i := 40 to 59 do
+ begin
+ T := LRot32(A, 5) + F3(B, C, D) + E + W[i] + integer($8F1BBCDC);
+ E := D;
+ D := C;
+ C := LRot32(B, 30);
+ B := A;
+ A := T;
+ end;
+ for i := 60 to 79 do
+ begin
+ T := LRot32(A, 5) + F2(B, C, D) + E + W[i] + integer($CA62C1D6);
+ E := D;
+ D := C;
+ C := LRot32(B, 30);
+ B := A;
+ A := T;
+ end;
+ Data.Hash[0] := Data.Hash[0] + A;
+ Data.Hash[1] := Data.Hash[1] + B;
+ Data.Hash[2] := Data.Hash[2] + C;
+ Data.Hash[3] := Data.Hash[3] + D;
+ Data.Hash[4] := Data.Hash[4] + E;
+ for n := 0 to high(w) do
+ w[n] := 0;
+// FillChar(W, Sizeof(W), 0);
+ for n := 0 to high(Data.Buffer) do
+ Data.Buffer[n] := 0;
+// FillChar(Data.Buffer, Sizeof(Data.Buffer), 0);
+end;
+
+//******************************************************************************
+procedure SHA1Update(var Context: TSHA1Ctx; const Data: AnsiString);
+var
+ Len: integer;
+ n: integer;
+ i, k: integer;
+begin
+ Len := Length(data);
+ for k := 0 to 7 do
+ begin
+ i := Context.Lo;
+ Inc(Context.Lo, Len);
+ if Context.Lo < i then
+ Inc(Context.Hi);
+ end;
+ for n := 1 to len do
+ begin
+ Context.Buffer[Context.Index] := byte(Data[n]);
+ Inc(Context.Index);
+ if Context.Index = 64 then
+ begin
+ Context.Index := 0;
+ SHA1Compress(Context);
+ end;
+ end;
+end;
+
+//******************************************************************************
+function SHA1Final(var Context: TSHA1Ctx): AnsiString;
+type
+ Pinteger = ^integer;
+var
+ i: integer;
+ procedure ItoArr(var Ar: Array of byte; I, value: Integer);
+ begin
+ Ar[i + 0] := Value and $000000FF;
+ Ar[i + 1] := (Value shr 8) and $000000FF;
+ Ar[i + 2] := (Value shr 16) and $000000FF;
+ Ar[i + 3] := (Value shr 24) and $000000FF;
+ end;
+begin
+ Context.Buffer[Context.Index] := $80;
+ if Context.Index >= 56 then
+ SHA1Compress(Context);
+ ItoArr(Context.Buffer, 56, RB(Context.Hi));
+ ItoArr(Context.Buffer, 60, RB(Context.Lo));
+// Pinteger(@Context.Buffer[56])^ := RB(Context.Hi);
+// Pinteger(@Context.Buffer[60])^ := RB(Context.Lo);
+ SHA1Compress(Context);
+ Context.Hash[0] := RB(Context.Hash[0]);
+ Context.Hash[1] := RB(Context.Hash[1]);
+ Context.Hash[2] := RB(Context.Hash[2]);
+ Context.Hash[3] := RB(Context.Hash[3]);
+ Context.Hash[4] := RB(Context.Hash[4]);
+ ArrLongToByte(Context.Hash, Context.HashByte);
+ Result := '';
+ for i := 0 to 19 do
+ Result := Result + AnsiChar(Context.HashByte[i]);
+end;
+
+function SHA1(const Value: AnsiString): AnsiString;
+var
+ SHA1Context: TSHA1Ctx;
+begin
+ SHA1Init(SHA1Context);
+ SHA1Update(SHA1Context, Value);
+ Result := SHA1Final(SHA1Context);
+end;
+
+{==============================================================================}
+
+function HMAC_SHA1(Text, Key: AnsiString): AnsiString;
+var
+ ipad, opad, s: AnsiString;
+ n: Integer;
+ SHA1Context: TSHA1Ctx;
+begin
+ if Length(Key) > 64 then
+ Key := SHA1(Key);
+ ipad := StringOfChar(#$36, 64);
+ opad := StringOfChar(#$5C, 64);
+ for n := 1 to Length(Key) do
+ begin
+ ipad[n] := AnsiChar(Byte(ipad[n]) xor Byte(Key[n]));
+ opad[n] := AnsiChar(Byte(opad[n]) xor Byte(Key[n]));
+ end;
+ SHA1Init(SHA1Context);
+ SHA1Update(SHA1Context, ipad);
+ SHA1Update(SHA1Context, Text);
+ s := SHA1Final(SHA1Context);
+ SHA1Init(SHA1Context);
+ SHA1Update(SHA1Context, opad);
+ SHA1Update(SHA1Context, s);
+ Result := SHA1Final(SHA1Context);
+end;
+
+{==============================================================================}
+
+function SHA1LongHash(const Value: AnsiString; Len: integer): AnsiString;
+var
+ cnt, rest: integer;
+ l: integer;
+ n: integer;
+ SHA1Context: TSHA1Ctx;
+begin
+ l := length(Value);
+ cnt := Len div l;
+ rest := Len mod l;
+ SHA1Init(SHA1Context);
+ for n := 1 to cnt do
+ SHA1Update(SHA1Context, Value);
+ if rest > 0 then
+ SHA1Update(SHA1Context, Copy(Value, 1, rest));
+ Result := SHA1Final(SHA1Context);
+end;
+
+{==============================================================================}
+
+procedure MD4Transform(var Buf: array of LongInt; const Data: array of LongInt);
+var
+ A, B, C, D: LongInt;
+ function LRot32(a, b: longint): longint;
+ begin
+ Result:= (a shl b) or (a shr (32 - b));
+ end;
+begin
+ A := Buf[0];
+ B := Buf[1];
+ C := Buf[2];
+ D := Buf[3];
+
+ A:= LRot32(A + (D xor (B and (C xor D))) + Data[ 0], 3);
+ D:= LRot32(D + (C xor (A and (B xor C))) + Data[ 1], 7);
+ C:= LRot32(C + (B xor (D and (A xor B))) + Data[ 2], 11);
+ B:= LRot32(B + (A xor (C and (D xor A))) + Data[ 3], 19);
+ A:= LRot32(A + (D xor (B and (C xor D))) + Data[ 4], 3);
+ D:= LRot32(D + (C xor (A and (B xor C))) + Data[ 5], 7);
+ C:= LRot32(C + (B xor (D and (A xor B))) + Data[ 6], 11);
+ B:= LRot32(B + (A xor (C and (D xor A))) + Data[ 7], 19);
+ A:= LRot32(A + (D xor (B and (C xor D))) + Data[ 8], 3);
+ D:= LRot32(D + (C xor (A and (B xor C))) + Data[ 9], 7);
+ C:= LRot32(C + (B xor (D and (A xor B))) + Data[10], 11);
+ B:= LRot32(B + (A xor (C and (D xor A))) + Data[11], 19);
+ A:= LRot32(A + (D xor (B and (C xor D))) + Data[12], 3);
+ D:= LRot32(D + (C xor (A and (B xor C))) + Data[13], 7);
+ C:= LRot32(C + (B xor (D and (A xor B))) + Data[14], 11);
+ B:= LRot32(B + (A xor (C and (D xor A))) + Data[15], 19);
+
+ A:= LRot32(A + ((B and C) or (B and D) or (C and D)) + Data[ 0] + longint($5a827999), 3);
+ D:= LRot32(D + ((A and B) or (A and C) or (B and C)) + Data[ 4] + longint($5a827999), 5);
+ C:= LRot32(C + ((D and A) or (D and B) or (A and B)) + Data[ 8] + longint($5a827999), 9);
+ B:= LRot32(B + ((C and D) or (C and A) or (D and A)) + Data[12] + longint($5a827999), 13);
+ A:= LRot32(A + ((B and C) or (B and D) or (C and D)) + Data[ 1] + longint($5a827999), 3);
+ D:= LRot32(D + ((A and B) or (A and C) or (B and C)) + Data[ 5] + longint($5a827999), 5);
+ C:= LRot32(C + ((D and A) or (D and B) or (A and B)) + Data[ 9] + longint($5a827999), 9);
+ B:= LRot32(B + ((C and D) or (C and A) or (D and A)) + Data[13] + longint($5a827999), 13);
+ A:= LRot32(A + ((B and C) or (B and D) or (C and D)) + Data[ 2] + longint($5a827999), 3);
+ D:= LRot32(D + ((A and B) or (A and C) or (B and C)) + Data[ 6] + longint($5a827999), 5);
+ C:= LRot32(C + ((D and A) or (D and B) or (A and B)) + Data[10] + longint($5a827999), 9);
+ B:= LRot32(B + ((C and D) or (C and A) or (D and A)) + Data[14] + longint($5a827999), 13);
+ A:= LRot32(A + ((B and C) or (B and D) or (C and D)) + Data[ 3] + longint($5a827999), 3);
+ D:= LRot32(D + ((A and B) or (A and C) or (B and C)) + Data[ 7] + longint($5a827999), 5);
+ C:= LRot32(C + ((D and A) or (D and B) or (A and B)) + Data[11] + longint($5a827999), 9);
+ B:= LRot32(B + ((C and D) or (C and A) or (D and A)) + Data[15] + longint($5a827999), 13);
+
+ A:= LRot32(A + (B xor C xor D) + Data[ 0] + longint($6ed9eba1), 3);
+ D:= LRot32(D + (A xor B xor C) + Data[ 8] + longint($6ed9eba1), 9);
+ C:= LRot32(C + (D xor A xor B) + Data[ 4] + longint($6ed9eba1), 11);
+ B:= LRot32(B + (C xor D xor A) + Data[12] + longint($6ed9eba1), 15);
+ A:= LRot32(A + (B xor C xor D) + Data[ 2] + longint($6ed9eba1), 3);
+ D:= LRot32(D + (A xor B xor C) + Data[10] + longint($6ed9eba1), 9);
+ C:= LRot32(C + (D xor A xor B) + Data[ 6] + longint($6ed9eba1), 11);
+ B:= LRot32(B + (C xor D xor A) + Data[14] + longint($6ed9eba1), 15);
+ A:= LRot32(A + (B xor C xor D) + Data[ 1] + longint($6ed9eba1), 3);
+ D:= LRot32(D + (A xor B xor C) + Data[ 9] + longint($6ed9eba1), 9);
+ C:= LRot32(C + (D xor A xor B) + Data[ 5] + longint($6ed9eba1), 11);
+ B:= LRot32(B + (C xor D xor A) + Data[13] + longint($6ed9eba1), 15);
+ A:= LRot32(A + (B xor C xor D) + Data[ 3] + longint($6ed9eba1), 3);
+ D:= LRot32(D + (A xor B xor C) + Data[11] + longint($6ed9eba1), 9);
+ C:= LRot32(C + (D xor A xor B) + Data[ 7] + longint($6ed9eba1), 11);
+ B:= LRot32(B + (C xor D xor A) + Data[15] + longint($6ed9eba1), 15);
+
+ Inc(Buf[0], A);
+ Inc(Buf[1], B);
+ Inc(Buf[2], C);
+ Inc(Buf[3], D);
+end;
+
+{==============================================================================}
+
+function MD4(const Value: AnsiString): AnsiString;
+var
+ MDContext: TMDCtx;
+begin
+ MDInit(MDContext);
+ MDUpdate(MDContext, Value, @MD4Transform);
+ Result := MDFinal(MDContext, @MD4Transform);
+end;
+
+{==============================================================================}
+
+
+end.
ADDED lib/synapse/source/lib/synacrypt.pas
Index: lib/synapse/source/lib/synacrypt.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/lib/synacrypt.pas
@@ -0,0 +1,2412 @@
+{==============================================================================|
+| Project : Ararat Synapse | 001.001.000 |
+|==============================================================================|
+| Content: Encryption support |
+|==============================================================================|
+| Copyright (c)2007-2011, Lukas Gebauer |
+| All rights reserved. |
+| |
+| Redistribution and use in source and binary forms, with or without |
+| modification, are permitted provided that the following conditions are met: |
+| |
+| Redistributions of source code must retain the above copyright notice, this |
+| list of conditions and the following disclaimer. |
+| |
+| Redistributions in binary form must reproduce the above copyright notice, |
+| this list of conditions and the following disclaimer in the documentation |
+| and/or other materials provided with the distribution. |
+| |
+| Neither the name of Lukas Gebauer nor the names of its contributors may |
+| be used to endorse or promote products derived from this software without |
+| specific prior written permission. |
+| |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
+| DAMAGE. |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2007-2011. |
+| All Rights Reserved. |
+| Based on work of David Barton and Eric Young |
+|==============================================================================|
+| Contributor(s): |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package |
+| (Found at URL: http://www.ararat.cz/synapse/) |
+|==============================================================================}
+
+{:@abstract(Encryption support)
+
+Implemented are DES and 3DES encryption/decryption by ECB, CBC, CFB-8bit,
+ CFB-block, OFB and CTR methods.
+}
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+{$Q-}
+{$R-}
+{$H+}
+
+{$IFDEF UNICODE}
+ {$WARN IMPLICIT_STRING_CAST OFF}
+ {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+unit synacrypt;
+
+interface
+
+uses
+ SysUtils, Classes, synautil, synafpc;
+
+type
+ {:@abstract(Implementation of common routines block ciphers (dafault size is 64-bits))
+
+ Do not use this class directly, use descendants only!}
+ TSynaBlockCipher= class(TObject)
+ protected
+ procedure InitKey(Key: AnsiString); virtual;
+ function GetSize: byte; virtual;
+ private
+ IV, CV: AnsiString;
+ procedure IncCounter;
+ public
+ {:Sets the IV to Value and performs a reset}
+ procedure SetIV(const Value: AnsiString); virtual;
+ {:Returns the current chaining information, not the actual IV}
+ function GetIV: AnsiString; virtual;
+ {:Reset any stored chaining information}
+ procedure Reset; virtual;
+ {:Encrypt a 64-bit block of data using the ECB method of encryption}
+ function EncryptECB(const InData: AnsiString): AnsiString; virtual;
+ {:Decrypt a 64-bit block of data using the ECB method of decryption}
+ function DecryptECB(const InData: AnsiString): AnsiString; virtual;
+ {:Encrypt data using the CBC method of encryption}
+ function EncryptCBC(const Indata: AnsiString): AnsiString; virtual;
+ {:Decrypt data using the CBC method of decryption}
+ function DecryptCBC(const Indata: AnsiString): AnsiString; virtual;
+ {:Encrypt data using the CFB (8 bit) method of encryption}
+ function EncryptCFB8bit(const Indata: AnsiString): AnsiString; virtual;
+ {:Decrypt data using the CFB (8 bit) method of decryption}
+ function DecryptCFB8bit(const Indata: AnsiString): AnsiString; virtual;
+ {:Encrypt data using the CFB (block) method of encryption}
+ function EncryptCFBblock(const Indata: AnsiString): AnsiString; virtual;
+ {:Decrypt data using the CFB (block) method of decryption}
+ function DecryptCFBblock(const Indata: AnsiString): AnsiString; virtual;
+ {:Encrypt data using the OFB method of encryption}
+ function EncryptOFB(const Indata: AnsiString): AnsiString; virtual;
+ {:Decrypt data using the OFB method of decryption}
+ function DecryptOFB(const Indata: AnsiString): AnsiString; virtual;
+ {:Encrypt data using the CTR method of encryption}
+ function EncryptCTR(const Indata: AnsiString): AnsiString; virtual;
+ {:Decrypt data using the CTR method of decryption}
+ function DecryptCTR(const Indata: AnsiString): AnsiString; virtual;
+ {:Create a encryptor/decryptor instance and initialize it by the Key.}
+ constructor Create(Key: AnsiString);
+ end;
+
+ {:@abstract(Datatype for holding one DES key data)
+
+ This data type is used internally.}
+ TDesKeyData = array[0..31] of integer;
+
+ {:@abstract(Implementation of common routines for DES encryption)
+
+ Do not use this class directly, use descendants only!}
+ TSynaCustomDes = class(TSynaBlockcipher)
+ protected
+ procedure DoInit(KeyB: AnsiString; var KeyData: TDesKeyData);
+ function EncryptBlock(const InData: AnsiString; var KeyData: TDesKeyData): AnsiString;
+ function DecryptBlock(const InData: AnsiString; var KeyData: TDesKeyData): AnsiString;
+ end;
+
+ {:@abstract(Implementation of DES encryption)}
+ TSynaDes= class(TSynaCustomDes)
+ protected
+ KeyData: TDesKeyData;
+ procedure InitKey(Key: AnsiString); override;
+ public
+ {:Encrypt a 64-bit block of data using the ECB method of encryption}
+ function EncryptECB(const InData: AnsiString): AnsiString; override;
+ {:Decrypt a 64-bit block of data using the ECB method of decryption}
+ function DecryptECB(const InData: AnsiString): AnsiString; override;
+ end;
+
+ {:@abstract(Implementation of 3DES encryption)}
+ TSyna3Des= class(TSynaCustomDes)
+ protected
+ KeyData: array[0..2] of TDesKeyData;
+ procedure InitKey(Key: AnsiString); override;
+ public
+ {:Encrypt a 64-bit block of data using the ECB method of encryption}
+ function EncryptECB(const InData: AnsiString): AnsiString; override;
+ {:Decrypt a 64-bit block of data using the ECB method of decryption}
+ function DecryptECB(const InData: AnsiString): AnsiString; override;
+ end;
+
+const
+ BC = 4;
+ MAXROUNDS = 14;
+type
+ {:@abstract(Implementation of AES encryption)}
+ TSynaAes= class(TSynaBlockcipher)
+ protected
+ numrounds: longword;
+ rk, drk: array[0..MAXROUNDS,0..7] of longword;
+ procedure InitKey(Key: AnsiString); override;
+ function GetSize: byte; override;
+ public
+ {:Encrypt a 128-bit block of data using the ECB method of encryption}
+ function EncryptECB(const InData: AnsiString): AnsiString; override;
+ {:Decrypt a 128-bit block of data using the ECB method of decryption}
+ function DecryptECB(const InData: AnsiString): AnsiString; override;
+ end;
+
+{:Call internal test of all DES encryptions. Returns @true if all is OK.}
+function TestDes: boolean;
+{:Call internal test of all 3DES encryptions. Returns @true if all is OK.}
+function Test3Des: boolean;
+{:Call internal test of all AES encryptions. Returns @true if all is OK.}
+function TestAes: boolean;
+
+{==============================================================================}
+implementation
+
+//DES consts
+const
+ shifts2: array[0..15]of byte=
+ (0,0,1,1,1,1,1,1,0,1,1,1,1,1,1,0);
+
+ des_skb: array[0..7,0..63]of integer=(
+ (
+ (* for C bits (numbered as per FIPS 46) 1 2 3 4 5 6 *)
+ integer($00000000),integer($00000010),integer($20000000),integer($20000010),
+ integer($00010000),integer($00010010),integer($20010000),integer($20010010),
+ integer($00000800),integer($00000810),integer($20000800),integer($20000810),
+ integer($00010800),integer($00010810),integer($20010800),integer($20010810),
+ integer($00000020),integer($00000030),integer($20000020),integer($20000030),
+ integer($00010020),integer($00010030),integer($20010020),integer($20010030),
+ integer($00000820),integer($00000830),integer($20000820),integer($20000830),
+ integer($00010820),integer($00010830),integer($20010820),integer($20010830),
+ integer($00080000),integer($00080010),integer($20080000),integer($20080010),
+ integer($00090000),integer($00090010),integer($20090000),integer($20090010),
+ integer($00080800),integer($00080810),integer($20080800),integer($20080810),
+ integer($00090800),integer($00090810),integer($20090800),integer($20090810),
+ integer($00080020),integer($00080030),integer($20080020),integer($20080030),
+ integer($00090020),integer($00090030),integer($20090020),integer($20090030),
+ integer($00080820),integer($00080830),integer($20080820),integer($20080830),
+ integer($00090820),integer($00090830),integer($20090820),integer($20090830)
+ ),(
+ (* for C bits (numbered as per FIPS 46) 7 8 10 11 12 13 *)
+ integer($00000000),integer($02000000),integer($00002000),integer($02002000),
+ integer($00200000),integer($02200000),integer($00202000),integer($02202000),
+ integer($00000004),integer($02000004),integer($00002004),integer($02002004),
+ integer($00200004),integer($02200004),integer($00202004),integer($02202004),
+ integer($00000400),integer($02000400),integer($00002400),integer($02002400),
+ integer($00200400),integer($02200400),integer($00202400),integer($02202400),
+ integer($00000404),integer($02000404),integer($00002404),integer($02002404),
+ integer($00200404),integer($02200404),integer($00202404),integer($02202404),
+ integer($10000000),integer($12000000),integer($10002000),integer($12002000),
+ integer($10200000),integer($12200000),integer($10202000),integer($12202000),
+ integer($10000004),integer($12000004),integer($10002004),integer($12002004),
+ integer($10200004),integer($12200004),integer($10202004),integer($12202004),
+ integer($10000400),integer($12000400),integer($10002400),integer($12002400),
+ integer($10200400),integer($12200400),integer($10202400),integer($12202400),
+ integer($10000404),integer($12000404),integer($10002404),integer($12002404),
+ integer($10200404),integer($12200404),integer($10202404),integer($12202404)
+ ),(
+ (* for C bits (numbered as per FIPS 46) 14 15 16 17 19 20 *)
+ integer($00000000),integer($00000001),integer($00040000),integer($00040001),
+ integer($01000000),integer($01000001),integer($01040000),integer($01040001),
+ integer($00000002),integer($00000003),integer($00040002),integer($00040003),
+ integer($01000002),integer($01000003),integer($01040002),integer($01040003),
+ integer($00000200),integer($00000201),integer($00040200),integer($00040201),
+ integer($01000200),integer($01000201),integer($01040200),integer($01040201),
+ integer($00000202),integer($00000203),integer($00040202),integer($00040203),
+ integer($01000202),integer($01000203),integer($01040202),integer($01040203),
+ integer($08000000),integer($08000001),integer($08040000),integer($08040001),
+ integer($09000000),integer($09000001),integer($09040000),integer($09040001),
+ integer($08000002),integer($08000003),integer($08040002),integer($08040003),
+ integer($09000002),integer($09000003),integer($09040002),integer($09040003),
+ integer($08000200),integer($08000201),integer($08040200),integer($08040201),
+ integer($09000200),integer($09000201),integer($09040200),integer($09040201),
+ integer($08000202),integer($08000203),integer($08040202),integer($08040203),
+ integer($09000202),integer($09000203),integer($09040202),integer($09040203)
+ ),(
+ (* for C bits (numbered as per FIPS 46) 21 23 24 26 27 28 *)
+ integer($00000000),integer($00100000),integer($00000100),integer($00100100),
+ integer($00000008),integer($00100008),integer($00000108),integer($00100108),
+ integer($00001000),integer($00101000),integer($00001100),integer($00101100),
+ integer($00001008),integer($00101008),integer($00001108),integer($00101108),
+ integer($04000000),integer($04100000),integer($04000100),integer($04100100),
+ integer($04000008),integer($04100008),integer($04000108),integer($04100108),
+ integer($04001000),integer($04101000),integer($04001100),integer($04101100),
+ integer($04001008),integer($04101008),integer($04001108),integer($04101108),
+ integer($00020000),integer($00120000),integer($00020100),integer($00120100),
+ integer($00020008),integer($00120008),integer($00020108),integer($00120108),
+ integer($00021000),integer($00121000),integer($00021100),integer($00121100),
+ integer($00021008),integer($00121008),integer($00021108),integer($00121108),
+ integer($04020000),integer($04120000),integer($04020100),integer($04120100),
+ integer($04020008),integer($04120008),integer($04020108),integer($04120108),
+ integer($04021000),integer($04121000),integer($04021100),integer($04121100),
+ integer($04021008),integer($04121008),integer($04021108),integer($04121108)
+ ),(
+ (* for D bits (numbered as per FIPS 46) 1 2 3 4 5 6 *)
+ integer($00000000),integer($10000000),integer($00010000),integer($10010000),
+ integer($00000004),integer($10000004),integer($00010004),integer($10010004),
+ integer($20000000),integer($30000000),integer($20010000),integer($30010000),
+ integer($20000004),integer($30000004),integer($20010004),integer($30010004),
+ integer($00100000),integer($10100000),integer($00110000),integer($10110000),
+ integer($00100004),integer($10100004),integer($00110004),integer($10110004),
+ integer($20100000),integer($30100000),integer($20110000),integer($30110000),
+ integer($20100004),integer($30100004),integer($20110004),integer($30110004),
+ integer($00001000),integer($10001000),integer($00011000),integer($10011000),
+ integer($00001004),integer($10001004),integer($00011004),integer($10011004),
+ integer($20001000),integer($30001000),integer($20011000),integer($30011000),
+ integer($20001004),integer($30001004),integer($20011004),integer($30011004),
+ integer($00101000),integer($10101000),integer($00111000),integer($10111000),
+ integer($00101004),integer($10101004),integer($00111004),integer($10111004),
+ integer($20101000),integer($30101000),integer($20111000),integer($30111000),
+ integer($20101004),integer($30101004),integer($20111004),integer($30111004)
+ ),(
+ (* for D bits (numbered as per FIPS 46) 8 9 11 12 13 14 *)
+ integer($00000000),integer($08000000),integer($00000008),integer($08000008),
+ integer($00000400),integer($08000400),integer($00000408),integer($08000408),
+ integer($00020000),integer($08020000),integer($00020008),integer($08020008),
+ integer($00020400),integer($08020400),integer($00020408),integer($08020408),
+ integer($00000001),integer($08000001),integer($00000009),integer($08000009),
+ integer($00000401),integer($08000401),integer($00000409),integer($08000409),
+ integer($00020001),integer($08020001),integer($00020009),integer($08020009),
+ integer($00020401),integer($08020401),integer($00020409),integer($08020409),
+ integer($02000000),integer($0A000000),integer($02000008),integer($0A000008),
+ integer($02000400),integer($0A000400),integer($02000408),integer($0A000408),
+ integer($02020000),integer($0A020000),integer($02020008),integer($0A020008),
+ integer($02020400),integer($0A020400),integer($02020408),integer($0A020408),
+ integer($02000001),integer($0A000001),integer($02000009),integer($0A000009),
+ integer($02000401),integer($0A000401),integer($02000409),integer($0A000409),
+ integer($02020001),integer($0A020001),integer($02020009),integer($0A020009),
+ integer($02020401),integer($0A020401),integer($02020409),integer($0A020409)
+ ),(
+ (* for D bits (numbered as per FIPS 46) 16 17 18 19 20 21 *)
+ integer($00000000),integer($00000100),integer($00080000),integer($00080100),
+ integer($01000000),integer($01000100),integer($01080000),integer($01080100),
+ integer($00000010),integer($00000110),integer($00080010),integer($00080110),
+ integer($01000010),integer($01000110),integer($01080010),integer($01080110),
+ integer($00200000),integer($00200100),integer($00280000),integer($00280100),
+ integer($01200000),integer($01200100),integer($01280000),integer($01280100),
+ integer($00200010),integer($00200110),integer($00280010),integer($00280110),
+ integer($01200010),integer($01200110),integer($01280010),integer($01280110),
+ integer($00000200),integer($00000300),integer($00080200),integer($00080300),
+ integer($01000200),integer($01000300),integer($01080200),integer($01080300),
+ integer($00000210),integer($00000310),integer($00080210),integer($00080310),
+ integer($01000210),integer($01000310),integer($01080210),integer($01080310),
+ integer($00200200),integer($00200300),integer($00280200),integer($00280300),
+ integer($01200200),integer($01200300),integer($01280200),integer($01280300),
+ integer($00200210),integer($00200310),integer($00280210),integer($00280310),
+ integer($01200210),integer($01200310),integer($01280210),integer($01280310)
+ ),(
+ (* for D bits (numbered as per FIPS 46) 22 23 24 25 27 28 *)
+ integer($00000000),integer($04000000),integer($00040000),integer($04040000),
+ integer($00000002),integer($04000002),integer($00040002),integer($04040002),
+ integer($00002000),integer($04002000),integer($00042000),integer($04042000),
+ integer($00002002),integer($04002002),integer($00042002),integer($04042002),
+ integer($00000020),integer($04000020),integer($00040020),integer($04040020),
+ integer($00000022),integer($04000022),integer($00040022),integer($04040022),
+ integer($00002020),integer($04002020),integer($00042020),integer($04042020),
+ integer($00002022),integer($04002022),integer($00042022),integer($04042022),
+ integer($00000800),integer($04000800),integer($00040800),integer($04040800),
+ integer($00000802),integer($04000802),integer($00040802),integer($04040802),
+ integer($00002800),integer($04002800),integer($00042800),integer($04042800),
+ integer($00002802),integer($04002802),integer($00042802),integer($04042802),
+ integer($00000820),integer($04000820),integer($00040820),integer($04040820),
+ integer($00000822),integer($04000822),integer($00040822),integer($04040822),
+ integer($00002820),integer($04002820),integer($00042820),integer($04042820),
+ integer($00002822),integer($04002822),integer($00042822),integer($04042822)
+ ));
+
+ des_sptrans: array[0..7,0..63] of integer=(
+ (
+ (* nibble 0 *)
+ integer($02080800), integer($00080000), integer($02000002), integer($02080802),
+ integer($02000000), integer($00080802), integer($00080002), integer($02000002),
+ integer($00080802), integer($02080800), integer($02080000), integer($00000802),
+ integer($02000802), integer($02000000), integer($00000000), integer($00080002),
+ integer($00080000), integer($00000002), integer($02000800), integer($00080800),
+ integer($02080802), integer($02080000), integer($00000802), integer($02000800),
+ integer($00000002), integer($00000800), integer($00080800), integer($02080002),
+ integer($00000800), integer($02000802), integer($02080002), integer($00000000),
+ integer($00000000), integer($02080802), integer($02000800), integer($00080002),
+ integer($02080800), integer($00080000), integer($00000802), integer($02000800),
+ integer($02080002), integer($00000800), integer($00080800), integer($02000002),
+ integer($00080802), integer($00000002), integer($02000002), integer($02080000),
+ integer($02080802), integer($00080800), integer($02080000), integer($02000802),
+ integer($02000000), integer($00000802), integer($00080002), integer($00000000),
+ integer($00080000), integer($02000000), integer($02000802), integer($02080800),
+ integer($00000002), integer($02080002), integer($00000800), integer($00080802)
+ ),(
+ (* nibble 1 *)
+ integer($40108010), integer($00000000), integer($00108000), integer($40100000),
+ integer($40000010), integer($00008010), integer($40008000), integer($00108000),
+ integer($00008000), integer($40100010), integer($00000010), integer($40008000),
+ integer($00100010), integer($40108000), integer($40100000), integer($00000010),
+ integer($00100000), integer($40008010), integer($40100010), integer($00008000),
+ integer($00108010), integer($40000000), integer($00000000), integer($00100010),
+ integer($40008010), integer($00108010), integer($40108000), integer($40000010),
+ integer($40000000), integer($00100000), integer($00008010), integer($40108010),
+ integer($00100010), integer($40108000), integer($40008000), integer($00108010),
+ integer($40108010), integer($00100010), integer($40000010), integer($00000000),
+ integer($40000000), integer($00008010), integer($00100000), integer($40100010),
+ integer($00008000), integer($40000000), integer($00108010), integer($40008010),
+ integer($40108000), integer($00008000), integer($00000000), integer($40000010),
+ integer($00000010), integer($40108010), integer($00108000), integer($40100000),
+ integer($40100010), integer($00100000), integer($00008010), integer($40008000),
+ integer($40008010), integer($00000010), integer($40100000), integer($00108000)
+ ),(
+ (* nibble 2 *)
+ integer($04000001), integer($04040100), integer($00000100), integer($04000101),
+ integer($00040001), integer($04000000), integer($04000101), integer($00040100),
+ integer($04000100), integer($00040000), integer($04040000), integer($00000001),
+ integer($04040101), integer($00000101), integer($00000001), integer($04040001),
+ integer($00000000), integer($00040001), integer($04040100), integer($00000100),
+ integer($00000101), integer($04040101), integer($00040000), integer($04000001),
+ integer($04040001), integer($04000100), integer($00040101), integer($04040000),
+ integer($00040100), integer($00000000), integer($04000000), integer($00040101),
+ integer($04040100), integer($00000100), integer($00000001), integer($00040000),
+ integer($00000101), integer($00040001), integer($04040000), integer($04000101),
+ integer($00000000), integer($04040100), integer($00040100), integer($04040001),
+ integer($00040001), integer($04000000), integer($04040101), integer($00000001),
+ integer($00040101), integer($04000001), integer($04000000), integer($04040101),
+ integer($00040000), integer($04000100), integer($04000101), integer($00040100),
+ integer($04000100), integer($00000000), integer($04040001), integer($00000101),
+ integer($04000001), integer($00040101), integer($00000100), integer($04040000)
+ ),(
+ (* nibble 3 *)
+ integer($00401008), integer($10001000), integer($00000008), integer($10401008),
+ integer($00000000), integer($10400000), integer($10001008), integer($00400008),
+ integer($10401000), integer($10000008), integer($10000000), integer($00001008),
+ integer($10000008), integer($00401008), integer($00400000), integer($10000000),
+ integer($10400008), integer($00401000), integer($00001000), integer($00000008),
+ integer($00401000), integer($10001008), integer($10400000), integer($00001000),
+ integer($00001008), integer($00000000), integer($00400008), integer($10401000),
+ integer($10001000), integer($10400008), integer($10401008), integer($00400000),
+ integer($10400008), integer($00001008), integer($00400000), integer($10000008),
+ integer($00401000), integer($10001000), integer($00000008), integer($10400000),
+ integer($10001008), integer($00000000), integer($00001000), integer($00400008),
+ integer($00000000), integer($10400008), integer($10401000), integer($00001000),
+ integer($10000000), integer($10401008), integer($00401008), integer($00400000),
+ integer($10401008), integer($00000008), integer($10001000), integer($00401008),
+ integer($00400008), integer($00401000), integer($10400000), integer($10001008),
+ integer($00001008), integer($10000000), integer($10000008), integer($10401000)
+ ),(
+ (* nibble 4 *)
+ integer($08000000), integer($00010000), integer($00000400), integer($08010420),
+ integer($08010020), integer($08000400), integer($00010420), integer($08010000),
+ integer($00010000), integer($00000020), integer($08000020), integer($00010400),
+ integer($08000420), integer($08010020), integer($08010400), integer($00000000),
+ integer($00010400), integer($08000000), integer($00010020), integer($00000420),
+ integer($08000400), integer($00010420), integer($00000000), integer($08000020),
+ integer($00000020), integer($08000420), integer($08010420), integer($00010020),
+ integer($08010000), integer($00000400), integer($00000420), integer($08010400),
+ integer($08010400), integer($08000420), integer($00010020), integer($08010000),
+ integer($00010000), integer($00000020), integer($08000020), integer($08000400),
+ integer($08000000), integer($00010400), integer($08010420), integer($00000000),
+ integer($00010420), integer($08000000), integer($00000400), integer($00010020),
+ integer($08000420), integer($00000400), integer($00000000), integer($08010420),
+ integer($08010020), integer($08010400), integer($00000420), integer($00010000),
+ integer($00010400), integer($08010020), integer($08000400), integer($00000420),
+ integer($00000020), integer($00010420), integer($08010000), integer($08000020)
+ ),(
+ (* nibble 5 *)
+ integer($80000040), integer($00200040), integer($00000000), integer($80202000),
+ integer($00200040), integer($00002000), integer($80002040), integer($00200000),
+ integer($00002040), integer($80202040), integer($00202000), integer($80000000),
+ integer($80002000), integer($80000040), integer($80200000), integer($00202040),
+ integer($00200000), integer($80002040), integer($80200040), integer($00000000),
+ integer($00002000), integer($00000040), integer($80202000), integer($80200040),
+ integer($80202040), integer($80200000), integer($80000000), integer($00002040),
+ integer($00000040), integer($00202000), integer($00202040), integer($80002000),
+ integer($00002040), integer($80000000), integer($80002000), integer($00202040),
+ integer($80202000), integer($00200040), integer($00000000), integer($80002000),
+ integer($80000000), integer($00002000), integer($80200040), integer($00200000),
+ integer($00200040), integer($80202040), integer($00202000), integer($00000040),
+ integer($80202040), integer($00202000), integer($00200000), integer($80002040),
+ integer($80000040), integer($80200000), integer($00202040), integer($00000000),
+ integer($00002000), integer($80000040), integer($80002040), integer($80202000),
+ integer($80200000), integer($00002040), integer($00000040), integer($80200040)
+ ),(
+ (* nibble 6 *)
+ integer($00004000), integer($00000200), integer($01000200), integer($01000004),
+ integer($01004204), integer($00004004), integer($00004200), integer($00000000),
+ integer($01000000), integer($01000204), integer($00000204), integer($01004000),
+ integer($00000004), integer($01004200), integer($01004000), integer($00000204),
+ integer($01000204), integer($00004000), integer($00004004), integer($01004204),
+ integer($00000000), integer($01000200), integer($01000004), integer($00004200),
+ integer($01004004), integer($00004204), integer($01004200), integer($00000004),
+ integer($00004204), integer($01004004), integer($00000200), integer($01000000),
+ integer($00004204), integer($01004000), integer($01004004), integer($00000204),
+ integer($00004000), integer($00000200), integer($01000000), integer($01004004),
+ integer($01000204), integer($00004204), integer($00004200), integer($00000000),
+ integer($00000200), integer($01000004), integer($00000004), integer($01000200),
+ integer($00000000), integer($01000204), integer($01000200), integer($00004200),
+ integer($00000204), integer($00004000), integer($01004204), integer($01000000),
+ integer($01004200), integer($00000004), integer($00004004), integer($01004204),
+ integer($01000004), integer($01004200), integer($01004000), integer($00004004)
+ ),(
+ (* nibble 7 *)
+ integer($20800080), integer($20820000), integer($00020080), integer($00000000),
+ integer($20020000), integer($00800080), integer($20800000), integer($20820080),
+ integer($00000080), integer($20000000), integer($00820000), integer($00020080),
+ integer($00820080), integer($20020080), integer($20000080), integer($20800000),
+ integer($00020000), integer($00820080), integer($00800080), integer($20020000),
+ integer($20820080), integer($20000080), integer($00000000), integer($00820000),
+ integer($20000000), integer($00800000), integer($20020080), integer($20800080),
+ integer($00800000), integer($00020000), integer($20820000), integer($00000080),
+ integer($00800000), integer($00020000), integer($20000080), integer($20820080),
+ integer($00020080), integer($20000000), integer($00000000), integer($00820000),
+ integer($20800080), integer($20020080), integer($20020000), integer($00800080),
+ integer($20820000), integer($00000080), integer($00800080), integer($20020000),
+ integer($20820080), integer($00800000), integer($20800000), integer($20000080),
+ integer($00820000), integer($00020080), integer($20020080), integer($20800000),
+ integer($00000080), integer($20820000), integer($00820080), integer($00000000),
+ integer($20000000), integer($20800080), integer($00020000), integer($00820080)
+ ));
+
+//AES consts
+const
+ MAXBC= 8;
+ MAXKC= 8;
+
+ S: array[0..255] of byte= (
+ 99, 124, 119, 123, 242, 107, 111, 197, 48, 1, 103, 43, 254, 215, 171, 118,
+ 202, 130, 201, 125, 250, 89, 71, 240, 173, 212, 162, 175, 156, 164, 114, 192,
+ 183, 253, 147, 38, 54, 63, 247, 204, 52, 165, 229, 241, 113, 216, 49, 21,
+ 4, 199, 35, 195, 24, 150, 5, 154, 7, 18, 128, 226, 235, 39, 178, 117,
+ 9, 131, 44, 26, 27, 110, 90, 160, 82, 59, 214, 179, 41, 227, 47, 132,
+ 83, 209, 0, 237, 32, 252, 177, 91, 106, 203, 190, 57, 74, 76, 88, 207,
+ 208, 239, 170, 251, 67, 77, 51, 133, 69, 249, 2, 127, 80, 60, 159, 168,
+ 81, 163, 64, 143, 146, 157, 56, 245, 188, 182, 218, 33, 16, 255, 243, 210,
+ 205, 12, 19, 236, 95, 151, 68, 23, 196, 167, 126, 61, 100, 93, 25, 115,
+ 96, 129, 79, 220, 34, 42, 144, 136, 70, 238, 184, 20, 222, 94, 11, 219,
+ 224, 50, 58, 10, 73, 6, 36, 92, 194, 211, 172, 98, 145, 149, 228, 121,
+ 231, 200, 55, 109, 141, 213, 78, 169, 108, 86, 244, 234, 101, 122, 174, 8,
+ 186, 120, 37, 46, 28, 166, 180, 198, 232, 221, 116, 31, 75, 189, 139, 138,
+ 112, 62, 181, 102, 72, 3, 246, 14, 97, 53, 87, 185, 134, 193, 29, 158,
+ 225, 248, 152, 17, 105, 217, 142, 148, 155, 30, 135, 233, 206, 85, 40, 223,
+ 140, 161, 137, 13, 191, 230, 66, 104, 65, 153, 45, 15, 176, 84, 187, 22);
+ T1: array[0..255,0..3] of byte= (
+ ($c6,$63,$63,$a5), ($f8,$7c,$7c,$84), ($ee,$77,$77,$99), ($f6,$7b,$7b,$8d),
+ ($ff,$f2,$f2,$0d), ($d6,$6b,$6b,$bd), ($de,$6f,$6f,$b1), ($91,$c5,$c5,$54),
+ ($60,$30,$30,$50), ($02,$01,$01,$03), ($ce,$67,$67,$a9), ($56,$2b,$2b,$7d),
+ ($e7,$fe,$fe,$19), ($b5,$d7,$d7,$62), ($4d,$ab,$ab,$e6), ($ec,$76,$76,$9a),
+ ($8f,$ca,$ca,$45), ($1f,$82,$82,$9d), ($89,$c9,$c9,$40), ($fa,$7d,$7d,$87),
+ ($ef,$fa,$fa,$15), ($b2,$59,$59,$eb), ($8e,$47,$47,$c9), ($fb,$f0,$f0,$0b),
+ ($41,$ad,$ad,$ec), ($b3,$d4,$d4,$67), ($5f,$a2,$a2,$fd), ($45,$af,$af,$ea),
+ ($23,$9c,$9c,$bf), ($53,$a4,$a4,$f7), ($e4,$72,$72,$96), ($9b,$c0,$c0,$5b),
+ ($75,$b7,$b7,$c2), ($e1,$fd,$fd,$1c), ($3d,$93,$93,$ae), ($4c,$26,$26,$6a),
+ ($6c,$36,$36,$5a), ($7e,$3f,$3f,$41), ($f5,$f7,$f7,$02), ($83,$cc,$cc,$4f),
+ ($68,$34,$34,$5c), ($51,$a5,$a5,$f4), ($d1,$e5,$e5,$34), ($f9,$f1,$f1,$08),
+ ($e2,$71,$71,$93), ($ab,$d8,$d8,$73), ($62,$31,$31,$53), ($2a,$15,$15,$3f),
+ ($08,$04,$04,$0c), ($95,$c7,$c7,$52), ($46,$23,$23,$65), ($9d,$c3,$c3,$5e),
+ ($30,$18,$18,$28), ($37,$96,$96,$a1), ($0a,$05,$05,$0f), ($2f,$9a,$9a,$b5),
+ ($0e,$07,$07,$09), ($24,$12,$12,$36), ($1b,$80,$80,$9b), ($df,$e2,$e2,$3d),
+ ($cd,$eb,$eb,$26), ($4e,$27,$27,$69), ($7f,$b2,$b2,$cd), ($ea,$75,$75,$9f),
+ ($12,$09,$09,$1b), ($1d,$83,$83,$9e), ($58,$2c,$2c,$74), ($34,$1a,$1a,$2e),
+ ($36,$1b,$1b,$2d), ($dc,$6e,$6e,$b2), ($b4,$5a,$5a,$ee), ($5b,$a0,$a0,$fb),
+ ($a4,$52,$52,$f6), ($76,$3b,$3b,$4d), ($b7,$d6,$d6,$61), ($7d,$b3,$b3,$ce),
+ ($52,$29,$29,$7b), ($dd,$e3,$e3,$3e), ($5e,$2f,$2f,$71), ($13,$84,$84,$97),
+ ($a6,$53,$53,$f5), ($b9,$d1,$d1,$68), ($00,$00,$00,$00), ($c1,$ed,$ed,$2c),
+ ($40,$20,$20,$60), ($e3,$fc,$fc,$1f), ($79,$b1,$b1,$c8), ($b6,$5b,$5b,$ed),
+ ($d4,$6a,$6a,$be), ($8d,$cb,$cb,$46), ($67,$be,$be,$d9), ($72,$39,$39,$4b),
+ ($94,$4a,$4a,$de), ($98,$4c,$4c,$d4), ($b0,$58,$58,$e8), ($85,$cf,$cf,$4a),
+ ($bb,$d0,$d0,$6b), ($c5,$ef,$ef,$2a), ($4f,$aa,$aa,$e5), ($ed,$fb,$fb,$16),
+ ($86,$43,$43,$c5), ($9a,$4d,$4d,$d7), ($66,$33,$33,$55), ($11,$85,$85,$94),
+ ($8a,$45,$45,$cf), ($e9,$f9,$f9,$10), ($04,$02,$02,$06), ($fe,$7f,$7f,$81),
+ ($a0,$50,$50,$f0), ($78,$3c,$3c,$44), ($25,$9f,$9f,$ba), ($4b,$a8,$a8,$e3),
+ ($a2,$51,$51,$f3), ($5d,$a3,$a3,$fe), ($80,$40,$40,$c0), ($05,$8f,$8f,$8a),
+ ($3f,$92,$92,$ad), ($21,$9d,$9d,$bc), ($70,$38,$38,$48), ($f1,$f5,$f5,$04),
+ ($63,$bc,$bc,$df), ($77,$b6,$b6,$c1), ($af,$da,$da,$75), ($42,$21,$21,$63),
+ ($20,$10,$10,$30), ($e5,$ff,$ff,$1a), ($fd,$f3,$f3,$0e), ($bf,$d2,$d2,$6d),
+ ($81,$cd,$cd,$4c), ($18,$0c,$0c,$14), ($26,$13,$13,$35), ($c3,$ec,$ec,$2f),
+ ($be,$5f,$5f,$e1), ($35,$97,$97,$a2), ($88,$44,$44,$cc), ($2e,$17,$17,$39),
+ ($93,$c4,$c4,$57), ($55,$a7,$a7,$f2), ($fc,$7e,$7e,$82), ($7a,$3d,$3d,$47),
+ ($c8,$64,$64,$ac), ($ba,$5d,$5d,$e7), ($32,$19,$19,$2b), ($e6,$73,$73,$95),
+ ($c0,$60,$60,$a0), ($19,$81,$81,$98), ($9e,$4f,$4f,$d1), ($a3,$dc,$dc,$7f),
+ ($44,$22,$22,$66), ($54,$2a,$2a,$7e), ($3b,$90,$90,$ab), ($0b,$88,$88,$83),
+ ($8c,$46,$46,$ca), ($c7,$ee,$ee,$29), ($6b,$b8,$b8,$d3), ($28,$14,$14,$3c),
+ ($a7,$de,$de,$79), ($bc,$5e,$5e,$e2), ($16,$0b,$0b,$1d), ($ad,$db,$db,$76),
+ ($db,$e0,$e0,$3b), ($64,$32,$32,$56), ($74,$3a,$3a,$4e), ($14,$0a,$0a,$1e),
+ ($92,$49,$49,$db), ($0c,$06,$06,$0a), ($48,$24,$24,$6c), ($b8,$5c,$5c,$e4),
+ ($9f,$c2,$c2,$5d), ($bd,$d3,$d3,$6e), ($43,$ac,$ac,$ef), ($c4,$62,$62,$a6),
+ ($39,$91,$91,$a8), ($31,$95,$95,$a4), ($d3,$e4,$e4,$37), ($f2,$79,$79,$8b),
+ ($d5,$e7,$e7,$32), ($8b,$c8,$c8,$43), ($6e,$37,$37,$59), ($da,$6d,$6d,$b7),
+ ($01,$8d,$8d,$8c), ($b1,$d5,$d5,$64), ($9c,$4e,$4e,$d2), ($49,$a9,$a9,$e0),
+ ($d8,$6c,$6c,$b4), ($ac,$56,$56,$fa), ($f3,$f4,$f4,$07), ($cf,$ea,$ea,$25),
+ ($ca,$65,$65,$af), ($f4,$7a,$7a,$8e), ($47,$ae,$ae,$e9), ($10,$08,$08,$18),
+ ($6f,$ba,$ba,$d5), ($f0,$78,$78,$88), ($4a,$25,$25,$6f), ($5c,$2e,$2e,$72),
+ ($38,$1c,$1c,$24), ($57,$a6,$a6,$f1), ($73,$b4,$b4,$c7), ($97,$c6,$c6,$51),
+ ($cb,$e8,$e8,$23), ($a1,$dd,$dd,$7c), ($e8,$74,$74,$9c), ($3e,$1f,$1f,$21),
+ ($96,$4b,$4b,$dd), ($61,$bd,$bd,$dc), ($0d,$8b,$8b,$86), ($0f,$8a,$8a,$85),
+ ($e0,$70,$70,$90), ($7c,$3e,$3e,$42), ($71,$b5,$b5,$c4), ($cc,$66,$66,$aa),
+ ($90,$48,$48,$d8), ($06,$03,$03,$05), ($f7,$f6,$f6,$01), ($1c,$0e,$0e,$12),
+ ($c2,$61,$61,$a3), ($6a,$35,$35,$5f), ($ae,$57,$57,$f9), ($69,$b9,$b9,$d0),
+ ($17,$86,$86,$91), ($99,$c1,$c1,$58), ($3a,$1d,$1d,$27), ($27,$9e,$9e,$b9),
+ ($d9,$e1,$e1,$38), ($eb,$f8,$f8,$13), ($2b,$98,$98,$b3), ($22,$11,$11,$33),
+ ($d2,$69,$69,$bb), ($a9,$d9,$d9,$70), ($07,$8e,$8e,$89), ($33,$94,$94,$a7),
+ ($2d,$9b,$9b,$b6), ($3c,$1e,$1e,$22), ($15,$87,$87,$92), ($c9,$e9,$e9,$20),
+ ($87,$ce,$ce,$49), ($aa,$55,$55,$ff), ($50,$28,$28,$78), ($a5,$df,$df,$7a),
+ ($03,$8c,$8c,$8f), ($59,$a1,$a1,$f8), ($09,$89,$89,$80), ($1a,$0d,$0d,$17),
+ ($65,$bf,$bf,$da), ($d7,$e6,$e6,$31), ($84,$42,$42,$c6), ($d0,$68,$68,$b8),
+ ($82,$41,$41,$c3), ($29,$99,$99,$b0), ($5a,$2d,$2d,$77), ($1e,$0f,$0f,$11),
+ ($7b,$b0,$b0,$cb), ($a8,$54,$54,$fc), ($6d,$bb,$bb,$d6), ($2c,$16,$16,$3a));
+ T2: array[0..255,0..3] of byte= (
+ ($a5,$c6,$63,$63), ($84,$f8,$7c,$7c), ($99,$ee,$77,$77), ($8d,$f6,$7b,$7b),
+ ($0d,$ff,$f2,$f2), ($bd,$d6,$6b,$6b), ($b1,$de,$6f,$6f), ($54,$91,$c5,$c5),
+ ($50,$60,$30,$30), ($03,$02,$01,$01), ($a9,$ce,$67,$67), ($7d,$56,$2b,$2b),
+ ($19,$e7,$fe,$fe), ($62,$b5,$d7,$d7), ($e6,$4d,$ab,$ab), ($9a,$ec,$76,$76),
+ ($45,$8f,$ca,$ca), ($9d,$1f,$82,$82), ($40,$89,$c9,$c9), ($87,$fa,$7d,$7d),
+ ($15,$ef,$fa,$fa), ($eb,$b2,$59,$59), ($c9,$8e,$47,$47), ($0b,$fb,$f0,$f0),
+ ($ec,$41,$ad,$ad), ($67,$b3,$d4,$d4), ($fd,$5f,$a2,$a2), ($ea,$45,$af,$af),
+ ($bf,$23,$9c,$9c), ($f7,$53,$a4,$a4), ($96,$e4,$72,$72), ($5b,$9b,$c0,$c0),
+ ($c2,$75,$b7,$b7), ($1c,$e1,$fd,$fd), ($ae,$3d,$93,$93), ($6a,$4c,$26,$26),
+ ($5a,$6c,$36,$36), ($41,$7e,$3f,$3f), ($02,$f5,$f7,$f7), ($4f,$83,$cc,$cc),
+ ($5c,$68,$34,$34), ($f4,$51,$a5,$a5), ($34,$d1,$e5,$e5), ($08,$f9,$f1,$f1),
+ ($93,$e2,$71,$71), ($73,$ab,$d8,$d8), ($53,$62,$31,$31), ($3f,$2a,$15,$15),
+ ($0c,$08,$04,$04), ($52,$95,$c7,$c7), ($65,$46,$23,$23), ($5e,$9d,$c3,$c3),
+ ($28,$30,$18,$18), ($a1,$37,$96,$96), ($0f,$0a,$05,$05), ($b5,$2f,$9a,$9a),
+ ($09,$0e,$07,$07), ($36,$24,$12,$12), ($9b,$1b,$80,$80), ($3d,$df,$e2,$e2),
+ ($26,$cd,$eb,$eb), ($69,$4e,$27,$27), ($cd,$7f,$b2,$b2), ($9f,$ea,$75,$75),
+ ($1b,$12,$09,$09), ($9e,$1d,$83,$83), ($74,$58,$2c,$2c), ($2e,$34,$1a,$1a),
+ ($2d,$36,$1b,$1b), ($b2,$dc,$6e,$6e), ($ee,$b4,$5a,$5a), ($fb,$5b,$a0,$a0),
+ ($f6,$a4,$52,$52), ($4d,$76,$3b,$3b), ($61,$b7,$d6,$d6), ($ce,$7d,$b3,$b3),
+ ($7b,$52,$29,$29), ($3e,$dd,$e3,$e3), ($71,$5e,$2f,$2f), ($97,$13,$84,$84),
+ ($f5,$a6,$53,$53), ($68,$b9,$d1,$d1), ($00,$00,$00,$00), ($2c,$c1,$ed,$ed),
+ ($60,$40,$20,$20), ($1f,$e3,$fc,$fc), ($c8,$79,$b1,$b1), ($ed,$b6,$5b,$5b),
+ ($be,$d4,$6a,$6a), ($46,$8d,$cb,$cb), ($d9,$67,$be,$be), ($4b,$72,$39,$39),
+ ($de,$94,$4a,$4a), ($d4,$98,$4c,$4c), ($e8,$b0,$58,$58), ($4a,$85,$cf,$cf),
+ ($6b,$bb,$d0,$d0), ($2a,$c5,$ef,$ef), ($e5,$4f,$aa,$aa), ($16,$ed,$fb,$fb),
+ ($c5,$86,$43,$43), ($d7,$9a,$4d,$4d), ($55,$66,$33,$33), ($94,$11,$85,$85),
+ ($cf,$8a,$45,$45), ($10,$e9,$f9,$f9), ($06,$04,$02,$02), ($81,$fe,$7f,$7f),
+ ($f0,$a0,$50,$50), ($44,$78,$3c,$3c), ($ba,$25,$9f,$9f), ($e3,$4b,$a8,$a8),
+ ($f3,$a2,$51,$51), ($fe,$5d,$a3,$a3), ($c0,$80,$40,$40), ($8a,$05,$8f,$8f),
+ ($ad,$3f,$92,$92), ($bc,$21,$9d,$9d), ($48,$70,$38,$38), ($04,$f1,$f5,$f5),
+ ($df,$63,$bc,$bc), ($c1,$77,$b6,$b6), ($75,$af,$da,$da), ($63,$42,$21,$21),
+ ($30,$20,$10,$10), ($1a,$e5,$ff,$ff), ($0e,$fd,$f3,$f3), ($6d,$bf,$d2,$d2),
+ ($4c,$81,$cd,$cd), ($14,$18,$0c,$0c), ($35,$26,$13,$13), ($2f,$c3,$ec,$ec),
+ ($e1,$be,$5f,$5f), ($a2,$35,$97,$97), ($cc,$88,$44,$44), ($39,$2e,$17,$17),
+ ($57,$93,$c4,$c4), ($f2,$55,$a7,$a7), ($82,$fc,$7e,$7e), ($47,$7a,$3d,$3d),
+ ($ac,$c8,$64,$64), ($e7,$ba,$5d,$5d), ($2b,$32,$19,$19), ($95,$e6,$73,$73),
+ ($a0,$c0,$60,$60), ($98,$19,$81,$81), ($d1,$9e,$4f,$4f), ($7f,$a3,$dc,$dc),
+ ($66,$44,$22,$22), ($7e,$54,$2a,$2a), ($ab,$3b,$90,$90), ($83,$0b,$88,$88),
+ ($ca,$8c,$46,$46), ($29,$c7,$ee,$ee), ($d3,$6b,$b8,$b8), ($3c,$28,$14,$14),
+ ($79,$a7,$de,$de), ($e2,$bc,$5e,$5e), ($1d,$16,$0b,$0b), ($76,$ad,$db,$db),
+ ($3b,$db,$e0,$e0), ($56,$64,$32,$32), ($4e,$74,$3a,$3a), ($1e,$14,$0a,$0a),
+ ($db,$92,$49,$49), ($0a,$0c,$06,$06), ($6c,$48,$24,$24), ($e4,$b8,$5c,$5c),
+ ($5d,$9f,$c2,$c2), ($6e,$bd,$d3,$d3), ($ef,$43,$ac,$ac), ($a6,$c4,$62,$62),
+ ($a8,$39,$91,$91), ($a4,$31,$95,$95), ($37,$d3,$e4,$e4), ($8b,$f2,$79,$79),
+ ($32,$d5,$e7,$e7), ($43,$8b,$c8,$c8), ($59,$6e,$37,$37), ($b7,$da,$6d,$6d),
+ ($8c,$01,$8d,$8d), ($64,$b1,$d5,$d5), ($d2,$9c,$4e,$4e), ($e0,$49,$a9,$a9),
+ ($b4,$d8,$6c,$6c), ($fa,$ac,$56,$56), ($07,$f3,$f4,$f4), ($25,$cf,$ea,$ea),
+ ($af,$ca,$65,$65), ($8e,$f4,$7a,$7a), ($e9,$47,$ae,$ae), ($18,$10,$08,$08),
+ ($d5,$6f,$ba,$ba), ($88,$f0,$78,$78), ($6f,$4a,$25,$25), ($72,$5c,$2e,$2e),
+ ($24,$38,$1c,$1c), ($f1,$57,$a6,$a6), ($c7,$73,$b4,$b4), ($51,$97,$c6,$c6),
+ ($23,$cb,$e8,$e8), ($7c,$a1,$dd,$dd), ($9c,$e8,$74,$74), ($21,$3e,$1f,$1f),
+ ($dd,$96,$4b,$4b), ($dc,$61,$bd,$bd), ($86,$0d,$8b,$8b), ($85,$0f,$8a,$8a),
+ ($90,$e0,$70,$70), ($42,$7c,$3e,$3e), ($c4,$71,$b5,$b5), ($aa,$cc,$66,$66),
+ ($d8,$90,$48,$48), ($05,$06,$03,$03), ($01,$f7,$f6,$f6), ($12,$1c,$0e,$0e),
+ ($a3,$c2,$61,$61), ($5f,$6a,$35,$35), ($f9,$ae,$57,$57), ($d0,$69,$b9,$b9),
+ ($91,$17,$86,$86), ($58,$99,$c1,$c1), ($27,$3a,$1d,$1d), ($b9,$27,$9e,$9e),
+ ($38,$d9,$e1,$e1), ($13,$eb,$f8,$f8), ($b3,$2b,$98,$98), ($33,$22,$11,$11),
+ ($bb,$d2,$69,$69), ($70,$a9,$d9,$d9), ($89,$07,$8e,$8e), ($a7,$33,$94,$94),
+ ($b6,$2d,$9b,$9b), ($22,$3c,$1e,$1e), ($92,$15,$87,$87), ($20,$c9,$e9,$e9),
+ ($49,$87,$ce,$ce), ($ff,$aa,$55,$55), ($78,$50,$28,$28), ($7a,$a5,$df,$df),
+ ($8f,$03,$8c,$8c), ($f8,$59,$a1,$a1), ($80,$09,$89,$89), ($17,$1a,$0d,$0d),
+ ($da,$65,$bf,$bf), ($31,$d7,$e6,$e6), ($c6,$84,$42,$42), ($b8,$d0,$68,$68),
+ ($c3,$82,$41,$41), ($b0,$29,$99,$99), ($77,$5a,$2d,$2d), ($11,$1e,$0f,$0f),
+ ($cb,$7b,$b0,$b0), ($fc,$a8,$54,$54), ($d6,$6d,$bb,$bb), ($3a,$2c,$16,$16));
+ T3: array[0..255,0..3] of byte= (
+ ($63,$a5,$c6,$63), ($7c,$84,$f8,$7c), ($77,$99,$ee,$77), ($7b,$8d,$f6,$7b),
+ ($f2,$0d,$ff,$f2), ($6b,$bd,$d6,$6b), ($6f,$b1,$de,$6f), ($c5,$54,$91,$c5),
+ ($30,$50,$60,$30), ($01,$03,$02,$01), ($67,$a9,$ce,$67), ($2b,$7d,$56,$2b),
+ ($fe,$19,$e7,$fe), ($d7,$62,$b5,$d7), ($ab,$e6,$4d,$ab), ($76,$9a,$ec,$76),
+ ($ca,$45,$8f,$ca), ($82,$9d,$1f,$82), ($c9,$40,$89,$c9), ($7d,$87,$fa,$7d),
+ ($fa,$15,$ef,$fa), ($59,$eb,$b2,$59), ($47,$c9,$8e,$47), ($f0,$0b,$fb,$f0),
+ ($ad,$ec,$41,$ad), ($d4,$67,$b3,$d4), ($a2,$fd,$5f,$a2), ($af,$ea,$45,$af),
+ ($9c,$bf,$23,$9c), ($a4,$f7,$53,$a4), ($72,$96,$e4,$72), ($c0,$5b,$9b,$c0),
+ ($b7,$c2,$75,$b7), ($fd,$1c,$e1,$fd), ($93,$ae,$3d,$93), ($26,$6a,$4c,$26),
+ ($36,$5a,$6c,$36), ($3f,$41,$7e,$3f), ($f7,$02,$f5,$f7), ($cc,$4f,$83,$cc),
+ ($34,$5c,$68,$34), ($a5,$f4,$51,$a5), ($e5,$34,$d1,$e5), ($f1,$08,$f9,$f1),
+ ($71,$93,$e2,$71), ($d8,$73,$ab,$d8), ($31,$53,$62,$31), ($15,$3f,$2a,$15),
+ ($04,$0c,$08,$04), ($c7,$52,$95,$c7), ($23,$65,$46,$23), ($c3,$5e,$9d,$c3),
+ ($18,$28,$30,$18), ($96,$a1,$37,$96), ($05,$0f,$0a,$05), ($9a,$b5,$2f,$9a),
+ ($07,$09,$0e,$07), ($12,$36,$24,$12), ($80,$9b,$1b,$80), ($e2,$3d,$df,$e2),
+ ($eb,$26,$cd,$eb), ($27,$69,$4e,$27), ($b2,$cd,$7f,$b2), ($75,$9f,$ea,$75),
+ ($09,$1b,$12,$09), ($83,$9e,$1d,$83), ($2c,$74,$58,$2c), ($1a,$2e,$34,$1a),
+ ($1b,$2d,$36,$1b), ($6e,$b2,$dc,$6e), ($5a,$ee,$b4,$5a), ($a0,$fb,$5b,$a0),
+ ($52,$f6,$a4,$52), ($3b,$4d,$76,$3b), ($d6,$61,$b7,$d6), ($b3,$ce,$7d,$b3),
+ ($29,$7b,$52,$29), ($e3,$3e,$dd,$e3), ($2f,$71,$5e,$2f), ($84,$97,$13,$84),
+ ($53,$f5,$a6,$53), ($d1,$68,$b9,$d1), ($00,$00,$00,$00), ($ed,$2c,$c1,$ed),
+ ($20,$60,$40,$20), ($fc,$1f,$e3,$fc), ($b1,$c8,$79,$b1), ($5b,$ed,$b6,$5b),
+ ($6a,$be,$d4,$6a), ($cb,$46,$8d,$cb), ($be,$d9,$67,$be), ($39,$4b,$72,$39),
+ ($4a,$de,$94,$4a), ($4c,$d4,$98,$4c), ($58,$e8,$b0,$58), ($cf,$4a,$85,$cf),
+ ($d0,$6b,$bb,$d0), ($ef,$2a,$c5,$ef), ($aa,$e5,$4f,$aa), ($fb,$16,$ed,$fb),
+ ($43,$c5,$86,$43), ($4d,$d7,$9a,$4d), ($33,$55,$66,$33), ($85,$94,$11,$85),
+ ($45,$cf,$8a,$45), ($f9,$10,$e9,$f9), ($02,$06,$04,$02), ($7f,$81,$fe,$7f),
+ ($50,$f0,$a0,$50), ($3c,$44,$78,$3c), ($9f,$ba,$25,$9f), ($a8,$e3,$4b,$a8),
+ ($51,$f3,$a2,$51), ($a3,$fe,$5d,$a3), ($40,$c0,$80,$40), ($8f,$8a,$05,$8f),
+ ($92,$ad,$3f,$92), ($9d,$bc,$21,$9d), ($38,$48,$70,$38), ($f5,$04,$f1,$f5),
+ ($bc,$df,$63,$bc), ($b6,$c1,$77,$b6), ($da,$75,$af,$da), ($21,$63,$42,$21),
+ ($10,$30,$20,$10), ($ff,$1a,$e5,$ff), ($f3,$0e,$fd,$f3), ($d2,$6d,$bf,$d2),
+ ($cd,$4c,$81,$cd), ($0c,$14,$18,$0c), ($13,$35,$26,$13), ($ec,$2f,$c3,$ec),
+ ($5f,$e1,$be,$5f), ($97,$a2,$35,$97), ($44,$cc,$88,$44), ($17,$39,$2e,$17),
+ ($c4,$57,$93,$c4), ($a7,$f2,$55,$a7), ($7e,$82,$fc,$7e), ($3d,$47,$7a,$3d),
+ ($64,$ac,$c8,$64), ($5d,$e7,$ba,$5d), ($19,$2b,$32,$19), ($73,$95,$e6,$73),
+ ($60,$a0,$c0,$60), ($81,$98,$19,$81), ($4f,$d1,$9e,$4f), ($dc,$7f,$a3,$dc),
+ ($22,$66,$44,$22), ($2a,$7e,$54,$2a), ($90,$ab,$3b,$90), ($88,$83,$0b,$88),
+ ($46,$ca,$8c,$46), ($ee,$29,$c7,$ee), ($b8,$d3,$6b,$b8), ($14,$3c,$28,$14),
+ ($de,$79,$a7,$de), ($5e,$e2,$bc,$5e), ($0b,$1d,$16,$0b), ($db,$76,$ad,$db),
+ ($e0,$3b,$db,$e0), ($32,$56,$64,$32), ($3a,$4e,$74,$3a), ($0a,$1e,$14,$0a),
+ ($49,$db,$92,$49), ($06,$0a,$0c,$06), ($24,$6c,$48,$24), ($5c,$e4,$b8,$5c),
+ ($c2,$5d,$9f,$c2), ($d3,$6e,$bd,$d3), ($ac,$ef,$43,$ac), ($62,$a6,$c4,$62),
+ ($91,$a8,$39,$91), ($95,$a4,$31,$95), ($e4,$37,$d3,$e4), ($79,$8b,$f2,$79),
+ ($e7,$32,$d5,$e7), ($c8,$43,$8b,$c8), ($37,$59,$6e,$37), ($6d,$b7,$da,$6d),
+ ($8d,$8c,$01,$8d), ($d5,$64,$b1,$d5), ($4e,$d2,$9c,$4e), ($a9,$e0,$49,$a9),
+ ($6c,$b4,$d8,$6c), ($56,$fa,$ac,$56), ($f4,$07,$f3,$f4), ($ea,$25,$cf,$ea),
+ ($65,$af,$ca,$65), ($7a,$8e,$f4,$7a), ($ae,$e9,$47,$ae), ($08,$18,$10,$08),
+ ($ba,$d5,$6f,$ba), ($78,$88,$f0,$78), ($25,$6f,$4a,$25), ($2e,$72,$5c,$2e),
+ ($1c,$24,$38,$1c), ($a6,$f1,$57,$a6), ($b4,$c7,$73,$b4), ($c6,$51,$97,$c6),
+ ($e8,$23,$cb,$e8), ($dd,$7c,$a1,$dd), ($74,$9c,$e8,$74), ($1f,$21,$3e,$1f),
+ ($4b,$dd,$96,$4b), ($bd,$dc,$61,$bd), ($8b,$86,$0d,$8b), ($8a,$85,$0f,$8a),
+ ($70,$90,$e0,$70), ($3e,$42,$7c,$3e), ($b5,$c4,$71,$b5), ($66,$aa,$cc,$66),
+ ($48,$d8,$90,$48), ($03,$05,$06,$03), ($f6,$01,$f7,$f6), ($0e,$12,$1c,$0e),
+ ($61,$a3,$c2,$61), ($35,$5f,$6a,$35), ($57,$f9,$ae,$57), ($b9,$d0,$69,$b9),
+ ($86,$91,$17,$86), ($c1,$58,$99,$c1), ($1d,$27,$3a,$1d), ($9e,$b9,$27,$9e),
+ ($e1,$38,$d9,$e1), ($f8,$13,$eb,$f8), ($98,$b3,$2b,$98), ($11,$33,$22,$11),
+ ($69,$bb,$d2,$69), ($d9,$70,$a9,$d9), ($8e,$89,$07,$8e), ($94,$a7,$33,$94),
+ ($9b,$b6,$2d,$9b), ($1e,$22,$3c,$1e), ($87,$92,$15,$87), ($e9,$20,$c9,$e9),
+ ($ce,$49,$87,$ce), ($55,$ff,$aa,$55), ($28,$78,$50,$28), ($df,$7a,$a5,$df),
+ ($8c,$8f,$03,$8c), ($a1,$f8,$59,$a1), ($89,$80,$09,$89), ($0d,$17,$1a,$0d),
+ ($bf,$da,$65,$bf), ($e6,$31,$d7,$e6), ($42,$c6,$84,$42), ($68,$b8,$d0,$68),
+ ($41,$c3,$82,$41), ($99,$b0,$29,$99), ($2d,$77,$5a,$2d), ($0f,$11,$1e,$0f),
+ ($b0,$cb,$7b,$b0), ($54,$fc,$a8,$54), ($bb,$d6,$6d,$bb), ($16,$3a,$2c,$16));
+ T4: array[0..255,0..3] of byte= (
+ ($63,$63,$a5,$c6), ($7c,$7c,$84,$f8), ($77,$77,$99,$ee), ($7b,$7b,$8d,$f6),
+ ($f2,$f2,$0d,$ff), ($6b,$6b,$bd,$d6), ($6f,$6f,$b1,$de), ($c5,$c5,$54,$91),
+ ($30,$30,$50,$60), ($01,$01,$03,$02), ($67,$67,$a9,$ce), ($2b,$2b,$7d,$56),
+ ($fe,$fe,$19,$e7), ($d7,$d7,$62,$b5), ($ab,$ab,$e6,$4d), ($76,$76,$9a,$ec),
+ ($ca,$ca,$45,$8f), ($82,$82,$9d,$1f), ($c9,$c9,$40,$89), ($7d,$7d,$87,$fa),
+ ($fa,$fa,$15,$ef), ($59,$59,$eb,$b2), ($47,$47,$c9,$8e), ($f0,$f0,$0b,$fb),
+ ($ad,$ad,$ec,$41), ($d4,$d4,$67,$b3), ($a2,$a2,$fd,$5f), ($af,$af,$ea,$45),
+ ($9c,$9c,$bf,$23), ($a4,$a4,$f7,$53), ($72,$72,$96,$e4), ($c0,$c0,$5b,$9b),
+ ($b7,$b7,$c2,$75), ($fd,$fd,$1c,$e1), ($93,$93,$ae,$3d), ($26,$26,$6a,$4c),
+ ($36,$36,$5a,$6c), ($3f,$3f,$41,$7e), ($f7,$f7,$02,$f5), ($cc,$cc,$4f,$83),
+ ($34,$34,$5c,$68), ($a5,$a5,$f4,$51), ($e5,$e5,$34,$d1), ($f1,$f1,$08,$f9),
+ ($71,$71,$93,$e2), ($d8,$d8,$73,$ab), ($31,$31,$53,$62), ($15,$15,$3f,$2a),
+ ($04,$04,$0c,$08), ($c7,$c7,$52,$95), ($23,$23,$65,$46), ($c3,$c3,$5e,$9d),
+ ($18,$18,$28,$30), ($96,$96,$a1,$37), ($05,$05,$0f,$0a), ($9a,$9a,$b5,$2f),
+ ($07,$07,$09,$0e), ($12,$12,$36,$24), ($80,$80,$9b,$1b), ($e2,$e2,$3d,$df),
+ ($eb,$eb,$26,$cd), ($27,$27,$69,$4e), ($b2,$b2,$cd,$7f), ($75,$75,$9f,$ea),
+ ($09,$09,$1b,$12), ($83,$83,$9e,$1d), ($2c,$2c,$74,$58), ($1a,$1a,$2e,$34),
+ ($1b,$1b,$2d,$36), ($6e,$6e,$b2,$dc), ($5a,$5a,$ee,$b4), ($a0,$a0,$fb,$5b),
+ ($52,$52,$f6,$a4), ($3b,$3b,$4d,$76), ($d6,$d6,$61,$b7), ($b3,$b3,$ce,$7d),
+ ($29,$29,$7b,$52), ($e3,$e3,$3e,$dd), ($2f,$2f,$71,$5e), ($84,$84,$97,$13),
+ ($53,$53,$f5,$a6), ($d1,$d1,$68,$b9), ($00,$00,$00,$00), ($ed,$ed,$2c,$c1),
+ ($20,$20,$60,$40), ($fc,$fc,$1f,$e3), ($b1,$b1,$c8,$79), ($5b,$5b,$ed,$b6),
+ ($6a,$6a,$be,$d4), ($cb,$cb,$46,$8d), ($be,$be,$d9,$67), ($39,$39,$4b,$72),
+ ($4a,$4a,$de,$94), ($4c,$4c,$d4,$98), ($58,$58,$e8,$b0), ($cf,$cf,$4a,$85),
+ ($d0,$d0,$6b,$bb), ($ef,$ef,$2a,$c5), ($aa,$aa,$e5,$4f), ($fb,$fb,$16,$ed),
+ ($43,$43,$c5,$86), ($4d,$4d,$d7,$9a), ($33,$33,$55,$66), ($85,$85,$94,$11),
+ ($45,$45,$cf,$8a), ($f9,$f9,$10,$e9), ($02,$02,$06,$04), ($7f,$7f,$81,$fe),
+ ($50,$50,$f0,$a0), ($3c,$3c,$44,$78), ($9f,$9f,$ba,$25), ($a8,$a8,$e3,$4b),
+ ($51,$51,$f3,$a2), ($a3,$a3,$fe,$5d), ($40,$40,$c0,$80), ($8f,$8f,$8a,$05),
+ ($92,$92,$ad,$3f), ($9d,$9d,$bc,$21), ($38,$38,$48,$70), ($f5,$f5,$04,$f1),
+ ($bc,$bc,$df,$63), ($b6,$b6,$c1,$77), ($da,$da,$75,$af), ($21,$21,$63,$42),
+ ($10,$10,$30,$20), ($ff,$ff,$1a,$e5), ($f3,$f3,$0e,$fd), ($d2,$d2,$6d,$bf),
+ ($cd,$cd,$4c,$81), ($0c,$0c,$14,$18), ($13,$13,$35,$26), ($ec,$ec,$2f,$c3),
+ ($5f,$5f,$e1,$be), ($97,$97,$a2,$35), ($44,$44,$cc,$88), ($17,$17,$39,$2e),
+ ($c4,$c4,$57,$93), ($a7,$a7,$f2,$55), ($7e,$7e,$82,$fc), ($3d,$3d,$47,$7a),
+ ($64,$64,$ac,$c8), ($5d,$5d,$e7,$ba), ($19,$19,$2b,$32), ($73,$73,$95,$e6),
+ ($60,$60,$a0,$c0), ($81,$81,$98,$19), ($4f,$4f,$d1,$9e), ($dc,$dc,$7f,$a3),
+ ($22,$22,$66,$44), ($2a,$2a,$7e,$54), ($90,$90,$ab,$3b), ($88,$88,$83,$0b),
+ ($46,$46,$ca,$8c), ($ee,$ee,$29,$c7), ($b8,$b8,$d3,$6b), ($14,$14,$3c,$28),
+ ($de,$de,$79,$a7), ($5e,$5e,$e2,$bc), ($0b,$0b,$1d,$16), ($db,$db,$76,$ad),
+ ($e0,$e0,$3b,$db), ($32,$32,$56,$64), ($3a,$3a,$4e,$74), ($0a,$0a,$1e,$14),
+ ($49,$49,$db,$92), ($06,$06,$0a,$0c), ($24,$24,$6c,$48), ($5c,$5c,$e4,$b8),
+ ($c2,$c2,$5d,$9f), ($d3,$d3,$6e,$bd), ($ac,$ac,$ef,$43), ($62,$62,$a6,$c4),
+ ($91,$91,$a8,$39), ($95,$95,$a4,$31), ($e4,$e4,$37,$d3), ($79,$79,$8b,$f2),
+ ($e7,$e7,$32,$d5), ($c8,$c8,$43,$8b), ($37,$37,$59,$6e), ($6d,$6d,$b7,$da),
+ ($8d,$8d,$8c,$01), ($d5,$d5,$64,$b1), ($4e,$4e,$d2,$9c), ($a9,$a9,$e0,$49),
+ ($6c,$6c,$b4,$d8), ($56,$56,$fa,$ac), ($f4,$f4,$07,$f3), ($ea,$ea,$25,$cf),
+ ($65,$65,$af,$ca), ($7a,$7a,$8e,$f4), ($ae,$ae,$e9,$47), ($08,$08,$18,$10),
+ ($ba,$ba,$d5,$6f), ($78,$78,$88,$f0), ($25,$25,$6f,$4a), ($2e,$2e,$72,$5c),
+ ($1c,$1c,$24,$38), ($a6,$a6,$f1,$57), ($b4,$b4,$c7,$73), ($c6,$c6,$51,$97),
+ ($e8,$e8,$23,$cb), ($dd,$dd,$7c,$a1), ($74,$74,$9c,$e8), ($1f,$1f,$21,$3e),
+ ($4b,$4b,$dd,$96), ($bd,$bd,$dc,$61), ($8b,$8b,$86,$0d), ($8a,$8a,$85,$0f),
+ ($70,$70,$90,$e0), ($3e,$3e,$42,$7c), ($b5,$b5,$c4,$71), ($66,$66,$aa,$cc),
+ ($48,$48,$d8,$90), ($03,$03,$05,$06), ($f6,$f6,$01,$f7), ($0e,$0e,$12,$1c),
+ ($61,$61,$a3,$c2), ($35,$35,$5f,$6a), ($57,$57,$f9,$ae), ($b9,$b9,$d0,$69),
+ ($86,$86,$91,$17), ($c1,$c1,$58,$99), ($1d,$1d,$27,$3a), ($9e,$9e,$b9,$27),
+ ($e1,$e1,$38,$d9), ($f8,$f8,$13,$eb), ($98,$98,$b3,$2b), ($11,$11,$33,$22),
+ ($69,$69,$bb,$d2), ($d9,$d9,$70,$a9), ($8e,$8e,$89,$07), ($94,$94,$a7,$33),
+ ($9b,$9b,$b6,$2d), ($1e,$1e,$22,$3c), ($87,$87,$92,$15), ($e9,$e9,$20,$c9),
+ ($ce,$ce,$49,$87), ($55,$55,$ff,$aa), ($28,$28,$78,$50), ($df,$df,$7a,$a5),
+ ($8c,$8c,$8f,$03), ($a1,$a1,$f8,$59), ($89,$89,$80,$09), ($0d,$0d,$17,$1a),
+ ($bf,$bf,$da,$65), ($e6,$e6,$31,$d7), ($42,$42,$c6,$84), ($68,$68,$b8,$d0),
+ ($41,$41,$c3,$82), ($99,$99,$b0,$29), ($2d,$2d,$77,$5a), ($0f,$0f,$11,$1e),
+ ($b0,$b0,$cb,$7b), ($54,$54,$fc,$a8), ($bb,$bb,$d6,$6d), ($16,$16,$3a,$2c));
+ T5: array[0..255,0..3] of byte= (
+ ($51,$f4,$a7,$50), ($7e,$41,$65,$53), ($1a,$17,$a4,$c3), ($3a,$27,$5e,$96),
+ ($3b,$ab,$6b,$cb), ($1f,$9d,$45,$f1), ($ac,$fa,$58,$ab), ($4b,$e3,$03,$93),
+ ($20,$30,$fa,$55), ($ad,$76,$6d,$f6), ($88,$cc,$76,$91), ($f5,$02,$4c,$25),
+ ($4f,$e5,$d7,$fc), ($c5,$2a,$cb,$d7), ($26,$35,$44,$80), ($b5,$62,$a3,$8f),
+ ($de,$b1,$5a,$49), ($25,$ba,$1b,$67), ($45,$ea,$0e,$98), ($5d,$fe,$c0,$e1),
+ ($c3,$2f,$75,$02), ($81,$4c,$f0,$12), ($8d,$46,$97,$a3), ($6b,$d3,$f9,$c6),
+ ($03,$8f,$5f,$e7), ($15,$92,$9c,$95), ($bf,$6d,$7a,$eb), ($95,$52,$59,$da),
+ ($d4,$be,$83,$2d), ($58,$74,$21,$d3), ($49,$e0,$69,$29), ($8e,$c9,$c8,$44),
+ ($75,$c2,$89,$6a), ($f4,$8e,$79,$78), ($99,$58,$3e,$6b), ($27,$b9,$71,$dd),
+ ($be,$e1,$4f,$b6), ($f0,$88,$ad,$17), ($c9,$20,$ac,$66), ($7d,$ce,$3a,$b4),
+ ($63,$df,$4a,$18), ($e5,$1a,$31,$82), ($97,$51,$33,$60), ($62,$53,$7f,$45),
+ ($b1,$64,$77,$e0), ($bb,$6b,$ae,$84), ($fe,$81,$a0,$1c), ($f9,$08,$2b,$94),
+ ($70,$48,$68,$58), ($8f,$45,$fd,$19), ($94,$de,$6c,$87), ($52,$7b,$f8,$b7),
+ ($ab,$73,$d3,$23), ($72,$4b,$02,$e2), ($e3,$1f,$8f,$57), ($66,$55,$ab,$2a),
+ ($b2,$eb,$28,$07), ($2f,$b5,$c2,$03), ($86,$c5,$7b,$9a), ($d3,$37,$08,$a5),
+ ($30,$28,$87,$f2), ($23,$bf,$a5,$b2), ($02,$03,$6a,$ba), ($ed,$16,$82,$5c),
+ ($8a,$cf,$1c,$2b), ($a7,$79,$b4,$92), ($f3,$07,$f2,$f0), ($4e,$69,$e2,$a1),
+ ($65,$da,$f4,$cd), ($06,$05,$be,$d5), ($d1,$34,$62,$1f), ($c4,$a6,$fe,$8a),
+ ($34,$2e,$53,$9d), ($a2,$f3,$55,$a0), ($05,$8a,$e1,$32), ($a4,$f6,$eb,$75),
+ ($0b,$83,$ec,$39), ($40,$60,$ef,$aa), ($5e,$71,$9f,$06), ($bd,$6e,$10,$51),
+ ($3e,$21,$8a,$f9), ($96,$dd,$06,$3d), ($dd,$3e,$05,$ae), ($4d,$e6,$bd,$46),
+ ($91,$54,$8d,$b5), ($71,$c4,$5d,$05), ($04,$06,$d4,$6f), ($60,$50,$15,$ff),
+ ($19,$98,$fb,$24), ($d6,$bd,$e9,$97), ($89,$40,$43,$cc), ($67,$d9,$9e,$77),
+ ($b0,$e8,$42,$bd), ($07,$89,$8b,$88), ($e7,$19,$5b,$38), ($79,$c8,$ee,$db),
+ ($a1,$7c,$0a,$47), ($7c,$42,$0f,$e9), ($f8,$84,$1e,$c9), ($00,$00,$00,$00),
+ ($09,$80,$86,$83), ($32,$2b,$ed,$48), ($1e,$11,$70,$ac), ($6c,$5a,$72,$4e),
+ ($fd,$0e,$ff,$fb), ($0f,$85,$38,$56), ($3d,$ae,$d5,$1e), ($36,$2d,$39,$27),
+ ($0a,$0f,$d9,$64), ($68,$5c,$a6,$21), ($9b,$5b,$54,$d1), ($24,$36,$2e,$3a),
+ ($0c,$0a,$67,$b1), ($93,$57,$e7,$0f), ($b4,$ee,$96,$d2), ($1b,$9b,$91,$9e),
+ ($80,$c0,$c5,$4f), ($61,$dc,$20,$a2), ($5a,$77,$4b,$69), ($1c,$12,$1a,$16),
+ ($e2,$93,$ba,$0a), ($c0,$a0,$2a,$e5), ($3c,$22,$e0,$43), ($12,$1b,$17,$1d),
+ ($0e,$09,$0d,$0b), ($f2,$8b,$c7,$ad), ($2d,$b6,$a8,$b9), ($14,$1e,$a9,$c8),
+ ($57,$f1,$19,$85), ($af,$75,$07,$4c), ($ee,$99,$dd,$bb), ($a3,$7f,$60,$fd),
+ ($f7,$01,$26,$9f), ($5c,$72,$f5,$bc), ($44,$66,$3b,$c5), ($5b,$fb,$7e,$34),
+ ($8b,$43,$29,$76), ($cb,$23,$c6,$dc), ($b6,$ed,$fc,$68), ($b8,$e4,$f1,$63),
+ ($d7,$31,$dc,$ca), ($42,$63,$85,$10), ($13,$97,$22,$40), ($84,$c6,$11,$20),
+ ($85,$4a,$24,$7d), ($d2,$bb,$3d,$f8), ($ae,$f9,$32,$11), ($c7,$29,$a1,$6d),
+ ($1d,$9e,$2f,$4b), ($dc,$b2,$30,$f3), ($0d,$86,$52,$ec), ($77,$c1,$e3,$d0),
+ ($2b,$b3,$16,$6c), ($a9,$70,$b9,$99), ($11,$94,$48,$fa), ($47,$e9,$64,$22),
+ ($a8,$fc,$8c,$c4), ($a0,$f0,$3f,$1a), ($56,$7d,$2c,$d8), ($22,$33,$90,$ef),
+ ($87,$49,$4e,$c7), ($d9,$38,$d1,$c1), ($8c,$ca,$a2,$fe), ($98,$d4,$0b,$36),
+ ($a6,$f5,$81,$cf), ($a5,$7a,$de,$28), ($da,$b7,$8e,$26), ($3f,$ad,$bf,$a4),
+ ($2c,$3a,$9d,$e4), ($50,$78,$92,$0d), ($6a,$5f,$cc,$9b), ($54,$7e,$46,$62),
+ ($f6,$8d,$13,$c2), ($90,$d8,$b8,$e8), ($2e,$39,$f7,$5e), ($82,$c3,$af,$f5),
+ ($9f,$5d,$80,$be), ($69,$d0,$93,$7c), ($6f,$d5,$2d,$a9), ($cf,$25,$12,$b3),
+ ($c8,$ac,$99,$3b), ($10,$18,$7d,$a7), ($e8,$9c,$63,$6e), ($db,$3b,$bb,$7b),
+ ($cd,$26,$78,$09), ($6e,$59,$18,$f4), ($ec,$9a,$b7,$01), ($83,$4f,$9a,$a8),
+ ($e6,$95,$6e,$65), ($aa,$ff,$e6,$7e), ($21,$bc,$cf,$08), ($ef,$15,$e8,$e6),
+ ($ba,$e7,$9b,$d9), ($4a,$6f,$36,$ce), ($ea,$9f,$09,$d4), ($29,$b0,$7c,$d6),
+ ($31,$a4,$b2,$af), ($2a,$3f,$23,$31), ($c6,$a5,$94,$30), ($35,$a2,$66,$c0),
+ ($74,$4e,$bc,$37), ($fc,$82,$ca,$a6), ($e0,$90,$d0,$b0), ($33,$a7,$d8,$15),
+ ($f1,$04,$98,$4a), ($41,$ec,$da,$f7), ($7f,$cd,$50,$0e), ($17,$91,$f6,$2f),
+ ($76,$4d,$d6,$8d), ($43,$ef,$b0,$4d), ($cc,$aa,$4d,$54), ($e4,$96,$04,$df),
+ ($9e,$d1,$b5,$e3), ($4c,$6a,$88,$1b), ($c1,$2c,$1f,$b8), ($46,$65,$51,$7f),
+ ($9d,$5e,$ea,$04), ($01,$8c,$35,$5d), ($fa,$87,$74,$73), ($fb,$0b,$41,$2e),
+ ($b3,$67,$1d,$5a), ($92,$db,$d2,$52), ($e9,$10,$56,$33), ($6d,$d6,$47,$13),
+ ($9a,$d7,$61,$8c), ($37,$a1,$0c,$7a), ($59,$f8,$14,$8e), ($eb,$13,$3c,$89),
+ ($ce,$a9,$27,$ee), ($b7,$61,$c9,$35), ($e1,$1c,$e5,$ed), ($7a,$47,$b1,$3c),
+ ($9c,$d2,$df,$59), ($55,$f2,$73,$3f), ($18,$14,$ce,$79), ($73,$c7,$37,$bf),
+ ($53,$f7,$cd,$ea), ($5f,$fd,$aa,$5b), ($df,$3d,$6f,$14), ($78,$44,$db,$86),
+ ($ca,$af,$f3,$81), ($b9,$68,$c4,$3e), ($38,$24,$34,$2c), ($c2,$a3,$40,$5f),
+ ($16,$1d,$c3,$72), ($bc,$e2,$25,$0c), ($28,$3c,$49,$8b), ($ff,$0d,$95,$41),
+ ($39,$a8,$01,$71), ($08,$0c,$b3,$de), ($d8,$b4,$e4,$9c), ($64,$56,$c1,$90),
+ ($7b,$cb,$84,$61), ($d5,$32,$b6,$70), ($48,$6c,$5c,$74), ($d0,$b8,$57,$42));
+ T6: array[0..255,0..3] of byte= (
+ ($50,$51,$f4,$a7), ($53,$7e,$41,$65), ($c3,$1a,$17,$a4), ($96,$3a,$27,$5e),
+ ($cb,$3b,$ab,$6b), ($f1,$1f,$9d,$45), ($ab,$ac,$fa,$58), ($93,$4b,$e3,$03),
+ ($55,$20,$30,$fa), ($f6,$ad,$76,$6d), ($91,$88,$cc,$76), ($25,$f5,$02,$4c),
+ ($fc,$4f,$e5,$d7), ($d7,$c5,$2a,$cb), ($80,$26,$35,$44), ($8f,$b5,$62,$a3),
+ ($49,$de,$b1,$5a), ($67,$25,$ba,$1b), ($98,$45,$ea,$0e), ($e1,$5d,$fe,$c0),
+ ($02,$c3,$2f,$75), ($12,$81,$4c,$f0), ($a3,$8d,$46,$97), ($c6,$6b,$d3,$f9),
+ ($e7,$03,$8f,$5f), ($95,$15,$92,$9c), ($eb,$bf,$6d,$7a), ($da,$95,$52,$59),
+ ($2d,$d4,$be,$83), ($d3,$58,$74,$21), ($29,$49,$e0,$69), ($44,$8e,$c9,$c8),
+ ($6a,$75,$c2,$89), ($78,$f4,$8e,$79), ($6b,$99,$58,$3e), ($dd,$27,$b9,$71),
+ ($b6,$be,$e1,$4f), ($17,$f0,$88,$ad), ($66,$c9,$20,$ac), ($b4,$7d,$ce,$3a),
+ ($18,$63,$df,$4a), ($82,$e5,$1a,$31), ($60,$97,$51,$33), ($45,$62,$53,$7f),
+ ($e0,$b1,$64,$77), ($84,$bb,$6b,$ae), ($1c,$fe,$81,$a0), ($94,$f9,$08,$2b),
+ ($58,$70,$48,$68), ($19,$8f,$45,$fd), ($87,$94,$de,$6c), ($b7,$52,$7b,$f8),
+ ($23,$ab,$73,$d3), ($e2,$72,$4b,$02), ($57,$e3,$1f,$8f), ($2a,$66,$55,$ab),
+ ($07,$b2,$eb,$28), ($03,$2f,$b5,$c2), ($9a,$86,$c5,$7b), ($a5,$d3,$37,$08),
+ ($f2,$30,$28,$87), ($b2,$23,$bf,$a5), ($ba,$02,$03,$6a), ($5c,$ed,$16,$82),
+ ($2b,$8a,$cf,$1c), ($92,$a7,$79,$b4), ($f0,$f3,$07,$f2), ($a1,$4e,$69,$e2),
+ ($cd,$65,$da,$f4), ($d5,$06,$05,$be), ($1f,$d1,$34,$62), ($8a,$c4,$a6,$fe),
+ ($9d,$34,$2e,$53), ($a0,$a2,$f3,$55), ($32,$05,$8a,$e1), ($75,$a4,$f6,$eb),
+ ($39,$0b,$83,$ec), ($aa,$40,$60,$ef), ($06,$5e,$71,$9f), ($51,$bd,$6e,$10),
+ ($f9,$3e,$21,$8a), ($3d,$96,$dd,$06), ($ae,$dd,$3e,$05), ($46,$4d,$e6,$bd),
+ ($b5,$91,$54,$8d), ($05,$71,$c4,$5d), ($6f,$04,$06,$d4), ($ff,$60,$50,$15),
+ ($24,$19,$98,$fb), ($97,$d6,$bd,$e9), ($cc,$89,$40,$43), ($77,$67,$d9,$9e),
+ ($bd,$b0,$e8,$42), ($88,$07,$89,$8b), ($38,$e7,$19,$5b), ($db,$79,$c8,$ee),
+ ($47,$a1,$7c,$0a), ($e9,$7c,$42,$0f), ($c9,$f8,$84,$1e), ($00,$00,$00,$00),
+ ($83,$09,$80,$86), ($48,$32,$2b,$ed), ($ac,$1e,$11,$70), ($4e,$6c,$5a,$72),
+ ($fb,$fd,$0e,$ff), ($56,$0f,$85,$38), ($1e,$3d,$ae,$d5), ($27,$36,$2d,$39),
+ ($64,$0a,$0f,$d9), ($21,$68,$5c,$a6), ($d1,$9b,$5b,$54), ($3a,$24,$36,$2e),
+ ($b1,$0c,$0a,$67), ($0f,$93,$57,$e7), ($d2,$b4,$ee,$96), ($9e,$1b,$9b,$91),
+ ($4f,$80,$c0,$c5), ($a2,$61,$dc,$20), ($69,$5a,$77,$4b), ($16,$1c,$12,$1a),
+ ($0a,$e2,$93,$ba), ($e5,$c0,$a0,$2a), ($43,$3c,$22,$e0), ($1d,$12,$1b,$17),
+ ($0b,$0e,$09,$0d), ($ad,$f2,$8b,$c7), ($b9,$2d,$b6,$a8), ($c8,$14,$1e,$a9),
+ ($85,$57,$f1,$19), ($4c,$af,$75,$07), ($bb,$ee,$99,$dd), ($fd,$a3,$7f,$60),
+ ($9f,$f7,$01,$26), ($bc,$5c,$72,$f5), ($c5,$44,$66,$3b), ($34,$5b,$fb,$7e),
+ ($76,$8b,$43,$29), ($dc,$cb,$23,$c6), ($68,$b6,$ed,$fc), ($63,$b8,$e4,$f1),
+ ($ca,$d7,$31,$dc), ($10,$42,$63,$85), ($40,$13,$97,$22), ($20,$84,$c6,$11),
+ ($7d,$85,$4a,$24), ($f8,$d2,$bb,$3d), ($11,$ae,$f9,$32), ($6d,$c7,$29,$a1),
+ ($4b,$1d,$9e,$2f), ($f3,$dc,$b2,$30), ($ec,$0d,$86,$52), ($d0,$77,$c1,$e3),
+ ($6c,$2b,$b3,$16), ($99,$a9,$70,$b9), ($fa,$11,$94,$48), ($22,$47,$e9,$64),
+ ($c4,$a8,$fc,$8c), ($1a,$a0,$f0,$3f), ($d8,$56,$7d,$2c), ($ef,$22,$33,$90),
+ ($c7,$87,$49,$4e), ($c1,$d9,$38,$d1), ($fe,$8c,$ca,$a2), ($36,$98,$d4,$0b),
+ ($cf,$a6,$f5,$81), ($28,$a5,$7a,$de), ($26,$da,$b7,$8e), ($a4,$3f,$ad,$bf),
+ ($e4,$2c,$3a,$9d), ($0d,$50,$78,$92), ($9b,$6a,$5f,$cc), ($62,$54,$7e,$46),
+ ($c2,$f6,$8d,$13), ($e8,$90,$d8,$b8), ($5e,$2e,$39,$f7), ($f5,$82,$c3,$af),
+ ($be,$9f,$5d,$80), ($7c,$69,$d0,$93), ($a9,$6f,$d5,$2d), ($b3,$cf,$25,$12),
+ ($3b,$c8,$ac,$99), ($a7,$10,$18,$7d), ($6e,$e8,$9c,$63), ($7b,$db,$3b,$bb),
+ ($09,$cd,$26,$78), ($f4,$6e,$59,$18), ($01,$ec,$9a,$b7), ($a8,$83,$4f,$9a),
+ ($65,$e6,$95,$6e), ($7e,$aa,$ff,$e6), ($08,$21,$bc,$cf), ($e6,$ef,$15,$e8),
+ ($d9,$ba,$e7,$9b), ($ce,$4a,$6f,$36), ($d4,$ea,$9f,$09), ($d6,$29,$b0,$7c),
+ ($af,$31,$a4,$b2), ($31,$2a,$3f,$23), ($30,$c6,$a5,$94), ($c0,$35,$a2,$66),
+ ($37,$74,$4e,$bc), ($a6,$fc,$82,$ca), ($b0,$e0,$90,$d0), ($15,$33,$a7,$d8),
+ ($4a,$f1,$04,$98), ($f7,$41,$ec,$da), ($0e,$7f,$cd,$50), ($2f,$17,$91,$f6),
+ ($8d,$76,$4d,$d6), ($4d,$43,$ef,$b0), ($54,$cc,$aa,$4d), ($df,$e4,$96,$04),
+ ($e3,$9e,$d1,$b5), ($1b,$4c,$6a,$88), ($b8,$c1,$2c,$1f), ($7f,$46,$65,$51),
+ ($04,$9d,$5e,$ea), ($5d,$01,$8c,$35), ($73,$fa,$87,$74), ($2e,$fb,$0b,$41),
+ ($5a,$b3,$67,$1d), ($52,$92,$db,$d2), ($33,$e9,$10,$56), ($13,$6d,$d6,$47),
+ ($8c,$9a,$d7,$61), ($7a,$37,$a1,$0c), ($8e,$59,$f8,$14), ($89,$eb,$13,$3c),
+ ($ee,$ce,$a9,$27), ($35,$b7,$61,$c9), ($ed,$e1,$1c,$e5), ($3c,$7a,$47,$b1),
+ ($59,$9c,$d2,$df), ($3f,$55,$f2,$73), ($79,$18,$14,$ce), ($bf,$73,$c7,$37),
+ ($ea,$53,$f7,$cd), ($5b,$5f,$fd,$aa), ($14,$df,$3d,$6f), ($86,$78,$44,$db),
+ ($81,$ca,$af,$f3), ($3e,$b9,$68,$c4), ($2c,$38,$24,$34), ($5f,$c2,$a3,$40),
+ ($72,$16,$1d,$c3), ($0c,$bc,$e2,$25), ($8b,$28,$3c,$49), ($41,$ff,$0d,$95),
+ ($71,$39,$a8,$01), ($de,$08,$0c,$b3), ($9c,$d8,$b4,$e4), ($90,$64,$56,$c1),
+ ($61,$7b,$cb,$84), ($70,$d5,$32,$b6), ($74,$48,$6c,$5c), ($42,$d0,$b8,$57));
+ T7: array[0..255,0..3] of byte= (
+ ($a7,$50,$51,$f4), ($65,$53,$7e,$41), ($a4,$c3,$1a,$17), ($5e,$96,$3a,$27),
+ ($6b,$cb,$3b,$ab), ($45,$f1,$1f,$9d), ($58,$ab,$ac,$fa), ($03,$93,$4b,$e3),
+ ($fa,$55,$20,$30), ($6d,$f6,$ad,$76), ($76,$91,$88,$cc), ($4c,$25,$f5,$02),
+ ($d7,$fc,$4f,$e5), ($cb,$d7,$c5,$2a), ($44,$80,$26,$35), ($a3,$8f,$b5,$62),
+ ($5a,$49,$de,$b1), ($1b,$67,$25,$ba), ($0e,$98,$45,$ea), ($c0,$e1,$5d,$fe),
+ ($75,$02,$c3,$2f), ($f0,$12,$81,$4c), ($97,$a3,$8d,$46), ($f9,$c6,$6b,$d3),
+ ($5f,$e7,$03,$8f), ($9c,$95,$15,$92), ($7a,$eb,$bf,$6d), ($59,$da,$95,$52),
+ ($83,$2d,$d4,$be), ($21,$d3,$58,$74), ($69,$29,$49,$e0), ($c8,$44,$8e,$c9),
+ ($89,$6a,$75,$c2), ($79,$78,$f4,$8e), ($3e,$6b,$99,$58), ($71,$dd,$27,$b9),
+ ($4f,$b6,$be,$e1), ($ad,$17,$f0,$88), ($ac,$66,$c9,$20), ($3a,$b4,$7d,$ce),
+ ($4a,$18,$63,$df), ($31,$82,$e5,$1a), ($33,$60,$97,$51), ($7f,$45,$62,$53),
+ ($77,$e0,$b1,$64), ($ae,$84,$bb,$6b), ($a0,$1c,$fe,$81), ($2b,$94,$f9,$08),
+ ($68,$58,$70,$48), ($fd,$19,$8f,$45), ($6c,$87,$94,$de), ($f8,$b7,$52,$7b),
+ ($d3,$23,$ab,$73), ($02,$e2,$72,$4b), ($8f,$57,$e3,$1f), ($ab,$2a,$66,$55),
+ ($28,$07,$b2,$eb), ($c2,$03,$2f,$b5), ($7b,$9a,$86,$c5), ($08,$a5,$d3,$37),
+ ($87,$f2,$30,$28), ($a5,$b2,$23,$bf), ($6a,$ba,$02,$03), ($82,$5c,$ed,$16),
+ ($1c,$2b,$8a,$cf), ($b4,$92,$a7,$79), ($f2,$f0,$f3,$07), ($e2,$a1,$4e,$69),
+ ($f4,$cd,$65,$da), ($be,$d5,$06,$05), ($62,$1f,$d1,$34), ($fe,$8a,$c4,$a6),
+ ($53,$9d,$34,$2e), ($55,$a0,$a2,$f3), ($e1,$32,$05,$8a), ($eb,$75,$a4,$f6),
+ ($ec,$39,$0b,$83), ($ef,$aa,$40,$60), ($9f,$06,$5e,$71), ($10,$51,$bd,$6e),
+ ($8a,$f9,$3e,$21), ($06,$3d,$96,$dd), ($05,$ae,$dd,$3e), ($bd,$46,$4d,$e6),
+ ($8d,$b5,$91,$54), ($5d,$05,$71,$c4), ($d4,$6f,$04,$06), ($15,$ff,$60,$50),
+ ($fb,$24,$19,$98), ($e9,$97,$d6,$bd), ($43,$cc,$89,$40), ($9e,$77,$67,$d9),
+ ($42,$bd,$b0,$e8), ($8b,$88,$07,$89), ($5b,$38,$e7,$19), ($ee,$db,$79,$c8),
+ ($0a,$47,$a1,$7c), ($0f,$e9,$7c,$42), ($1e,$c9,$f8,$84), ($00,$00,$00,$00),
+ ($86,$83,$09,$80), ($ed,$48,$32,$2b), ($70,$ac,$1e,$11), ($72,$4e,$6c,$5a),
+ ($ff,$fb,$fd,$0e), ($38,$56,$0f,$85), ($d5,$1e,$3d,$ae), ($39,$27,$36,$2d),
+ ($d9,$64,$0a,$0f), ($a6,$21,$68,$5c), ($54,$d1,$9b,$5b), ($2e,$3a,$24,$36),
+ ($67,$b1,$0c,$0a), ($e7,$0f,$93,$57), ($96,$d2,$b4,$ee), ($91,$9e,$1b,$9b),
+ ($c5,$4f,$80,$c0), ($20,$a2,$61,$dc), ($4b,$69,$5a,$77), ($1a,$16,$1c,$12),
+ ($ba,$0a,$e2,$93), ($2a,$e5,$c0,$a0), ($e0,$43,$3c,$22), ($17,$1d,$12,$1b),
+ ($0d,$0b,$0e,$09), ($c7,$ad,$f2,$8b), ($a8,$b9,$2d,$b6), ($a9,$c8,$14,$1e),
+ ($19,$85,$57,$f1), ($07,$4c,$af,$75), ($dd,$bb,$ee,$99), ($60,$fd,$a3,$7f),
+ ($26,$9f,$f7,$01), ($f5,$bc,$5c,$72), ($3b,$c5,$44,$66), ($7e,$34,$5b,$fb),
+ ($29,$76,$8b,$43), ($c6,$dc,$cb,$23), ($fc,$68,$b6,$ed), ($f1,$63,$b8,$e4),
+ ($dc,$ca,$d7,$31), ($85,$10,$42,$63), ($22,$40,$13,$97), ($11,$20,$84,$c6),
+ ($24,$7d,$85,$4a), ($3d,$f8,$d2,$bb), ($32,$11,$ae,$f9), ($a1,$6d,$c7,$29),
+ ($2f,$4b,$1d,$9e), ($30,$f3,$dc,$b2), ($52,$ec,$0d,$86), ($e3,$d0,$77,$c1),
+ ($16,$6c,$2b,$b3), ($b9,$99,$a9,$70), ($48,$fa,$11,$94), ($64,$22,$47,$e9),
+ ($8c,$c4,$a8,$fc), ($3f,$1a,$a0,$f0), ($2c,$d8,$56,$7d), ($90,$ef,$22,$33),
+ ($4e,$c7,$87,$49), ($d1,$c1,$d9,$38), ($a2,$fe,$8c,$ca), ($0b,$36,$98,$d4),
+ ($81,$cf,$a6,$f5), ($de,$28,$a5,$7a), ($8e,$26,$da,$b7), ($bf,$a4,$3f,$ad),
+ ($9d,$e4,$2c,$3a), ($92,$0d,$50,$78), ($cc,$9b,$6a,$5f), ($46,$62,$54,$7e),
+ ($13,$c2,$f6,$8d), ($b8,$e8,$90,$d8), ($f7,$5e,$2e,$39), ($af,$f5,$82,$c3),
+ ($80,$be,$9f,$5d), ($93,$7c,$69,$d0), ($2d,$a9,$6f,$d5), ($12,$b3,$cf,$25),
+ ($99,$3b,$c8,$ac), ($7d,$a7,$10,$18), ($63,$6e,$e8,$9c), ($bb,$7b,$db,$3b),
+ ($78,$09,$cd,$26), ($18,$f4,$6e,$59), ($b7,$01,$ec,$9a), ($9a,$a8,$83,$4f),
+ ($6e,$65,$e6,$95), ($e6,$7e,$aa,$ff), ($cf,$08,$21,$bc), ($e8,$e6,$ef,$15),
+ ($9b,$d9,$ba,$e7), ($36,$ce,$4a,$6f), ($09,$d4,$ea,$9f), ($7c,$d6,$29,$b0),
+ ($b2,$af,$31,$a4), ($23,$31,$2a,$3f), ($94,$30,$c6,$a5), ($66,$c0,$35,$a2),
+ ($bc,$37,$74,$4e), ($ca,$a6,$fc,$82), ($d0,$b0,$e0,$90), ($d8,$15,$33,$a7),
+ ($98,$4a,$f1,$04), ($da,$f7,$41,$ec), ($50,$0e,$7f,$cd), ($f6,$2f,$17,$91),
+ ($d6,$8d,$76,$4d), ($b0,$4d,$43,$ef), ($4d,$54,$cc,$aa), ($04,$df,$e4,$96),
+ ($b5,$e3,$9e,$d1), ($88,$1b,$4c,$6a), ($1f,$b8,$c1,$2c), ($51,$7f,$46,$65),
+ ($ea,$04,$9d,$5e), ($35,$5d,$01,$8c), ($74,$73,$fa,$87), ($41,$2e,$fb,$0b),
+ ($1d,$5a,$b3,$67), ($d2,$52,$92,$db), ($56,$33,$e9,$10), ($47,$13,$6d,$d6),
+ ($61,$8c,$9a,$d7), ($0c,$7a,$37,$a1), ($14,$8e,$59,$f8), ($3c,$89,$eb,$13),
+ ($27,$ee,$ce,$a9), ($c9,$35,$b7,$61), ($e5,$ed,$e1,$1c), ($b1,$3c,$7a,$47),
+ ($df,$59,$9c,$d2), ($73,$3f,$55,$f2), ($ce,$79,$18,$14), ($37,$bf,$73,$c7),
+ ($cd,$ea,$53,$f7), ($aa,$5b,$5f,$fd), ($6f,$14,$df,$3d), ($db,$86,$78,$44),
+ ($f3,$81,$ca,$af), ($c4,$3e,$b9,$68), ($34,$2c,$38,$24), ($40,$5f,$c2,$a3),
+ ($c3,$72,$16,$1d), ($25,$0c,$bc,$e2), ($49,$8b,$28,$3c), ($95,$41,$ff,$0d),
+ ($01,$71,$39,$a8), ($b3,$de,$08,$0c), ($e4,$9c,$d8,$b4), ($c1,$90,$64,$56),
+ ($84,$61,$7b,$cb), ($b6,$70,$d5,$32), ($5c,$74,$48,$6c), ($57,$42,$d0,$b8));
+ T8: array[0..255,0..3] of byte= (
+ ($f4,$a7,$50,$51), ($41,$65,$53,$7e), ($17,$a4,$c3,$1a), ($27,$5e,$96,$3a),
+ ($ab,$6b,$cb,$3b), ($9d,$45,$f1,$1f), ($fa,$58,$ab,$ac), ($e3,$03,$93,$4b),
+ ($30,$fa,$55,$20), ($76,$6d,$f6,$ad), ($cc,$76,$91,$88), ($02,$4c,$25,$f5),
+ ($e5,$d7,$fc,$4f), ($2a,$cb,$d7,$c5), ($35,$44,$80,$26), ($62,$a3,$8f,$b5),
+ ($b1,$5a,$49,$de), ($ba,$1b,$67,$25), ($ea,$0e,$98,$45), ($fe,$c0,$e1,$5d),
+ ($2f,$75,$02,$c3), ($4c,$f0,$12,$81), ($46,$97,$a3,$8d), ($d3,$f9,$c6,$6b),
+ ($8f,$5f,$e7,$03), ($92,$9c,$95,$15), ($6d,$7a,$eb,$bf), ($52,$59,$da,$95),
+ ($be,$83,$2d,$d4), ($74,$21,$d3,$58), ($e0,$69,$29,$49), ($c9,$c8,$44,$8e),
+ ($c2,$89,$6a,$75), ($8e,$79,$78,$f4), ($58,$3e,$6b,$99), ($b9,$71,$dd,$27),
+ ($e1,$4f,$b6,$be), ($88,$ad,$17,$f0), ($20,$ac,$66,$c9), ($ce,$3a,$b4,$7d),
+ ($df,$4a,$18,$63), ($1a,$31,$82,$e5), ($51,$33,$60,$97), ($53,$7f,$45,$62),
+ ($64,$77,$e0,$b1), ($6b,$ae,$84,$bb), ($81,$a0,$1c,$fe), ($08,$2b,$94,$f9),
+ ($48,$68,$58,$70), ($45,$fd,$19,$8f), ($de,$6c,$87,$94), ($7b,$f8,$b7,$52),
+ ($73,$d3,$23,$ab), ($4b,$02,$e2,$72), ($1f,$8f,$57,$e3), ($55,$ab,$2a,$66),
+ ($eb,$28,$07,$b2), ($b5,$c2,$03,$2f), ($c5,$7b,$9a,$86), ($37,$08,$a5,$d3),
+ ($28,$87,$f2,$30), ($bf,$a5,$b2,$23), ($03,$6a,$ba,$02), ($16,$82,$5c,$ed),
+ ($cf,$1c,$2b,$8a), ($79,$b4,$92,$a7), ($07,$f2,$f0,$f3), ($69,$e2,$a1,$4e),
+ ($da,$f4,$cd,$65), ($05,$be,$d5,$06), ($34,$62,$1f,$d1), ($a6,$fe,$8a,$c4),
+ ($2e,$53,$9d,$34), ($f3,$55,$a0,$a2), ($8a,$e1,$32,$05), ($f6,$eb,$75,$a4),
+ ($83,$ec,$39,$0b), ($60,$ef,$aa,$40), ($71,$9f,$06,$5e), ($6e,$10,$51,$bd),
+ ($21,$8a,$f9,$3e), ($dd,$06,$3d,$96), ($3e,$05,$ae,$dd), ($e6,$bd,$46,$4d),
+ ($54,$8d,$b5,$91), ($c4,$5d,$05,$71), ($06,$d4,$6f,$04), ($50,$15,$ff,$60),
+ ($98,$fb,$24,$19), ($bd,$e9,$97,$d6), ($40,$43,$cc,$89), ($d9,$9e,$77,$67),
+ ($e8,$42,$bd,$b0), ($89,$8b,$88,$07), ($19,$5b,$38,$e7), ($c8,$ee,$db,$79),
+ ($7c,$0a,$47,$a1), ($42,$0f,$e9,$7c), ($84,$1e,$c9,$f8), ($00,$00,$00,$00),
+ ($80,$86,$83,$09), ($2b,$ed,$48,$32), ($11,$70,$ac,$1e), ($5a,$72,$4e,$6c),
+ ($0e,$ff,$fb,$fd), ($85,$38,$56,$0f), ($ae,$d5,$1e,$3d), ($2d,$39,$27,$36),
+ ($0f,$d9,$64,$0a), ($5c,$a6,$21,$68), ($5b,$54,$d1,$9b), ($36,$2e,$3a,$24),
+ ($0a,$67,$b1,$0c), ($57,$e7,$0f,$93), ($ee,$96,$d2,$b4), ($9b,$91,$9e,$1b),
+ ($c0,$c5,$4f,$80), ($dc,$20,$a2,$61), ($77,$4b,$69,$5a), ($12,$1a,$16,$1c),
+ ($93,$ba,$0a,$e2), ($a0,$2a,$e5,$c0), ($22,$e0,$43,$3c), ($1b,$17,$1d,$12),
+ ($09,$0d,$0b,$0e), ($8b,$c7,$ad,$f2), ($b6,$a8,$b9,$2d), ($1e,$a9,$c8,$14),
+ ($f1,$19,$85,$57), ($75,$07,$4c,$af), ($99,$dd,$bb,$ee), ($7f,$60,$fd,$a3),
+ ($01,$26,$9f,$f7), ($72,$f5,$bc,$5c), ($66,$3b,$c5,$44), ($fb,$7e,$34,$5b),
+ ($43,$29,$76,$8b), ($23,$c6,$dc,$cb), ($ed,$fc,$68,$b6), ($e4,$f1,$63,$b8),
+ ($31,$dc,$ca,$d7), ($63,$85,$10,$42), ($97,$22,$40,$13), ($c6,$11,$20,$84),
+ ($4a,$24,$7d,$85), ($bb,$3d,$f8,$d2), ($f9,$32,$11,$ae), ($29,$a1,$6d,$c7),
+ ($9e,$2f,$4b,$1d), ($b2,$30,$f3,$dc), ($86,$52,$ec,$0d), ($c1,$e3,$d0,$77),
+ ($b3,$16,$6c,$2b), ($70,$b9,$99,$a9), ($94,$48,$fa,$11), ($e9,$64,$22,$47),
+ ($fc,$8c,$c4,$a8), ($f0,$3f,$1a,$a0), ($7d,$2c,$d8,$56), ($33,$90,$ef,$22),
+ ($49,$4e,$c7,$87), ($38,$d1,$c1,$d9), ($ca,$a2,$fe,$8c), ($d4,$0b,$36,$98),
+ ($f5,$81,$cf,$a6), ($7a,$de,$28,$a5), ($b7,$8e,$26,$da), ($ad,$bf,$a4,$3f),
+ ($3a,$9d,$e4,$2c), ($78,$92,$0d,$50), ($5f,$cc,$9b,$6a), ($7e,$46,$62,$54),
+ ($8d,$13,$c2,$f6), ($d8,$b8,$e8,$90), ($39,$f7,$5e,$2e), ($c3,$af,$f5,$82),
+ ($5d,$80,$be,$9f), ($d0,$93,$7c,$69), ($d5,$2d,$a9,$6f), ($25,$12,$b3,$cf),
+ ($ac,$99,$3b,$c8), ($18,$7d,$a7,$10), ($9c,$63,$6e,$e8), ($3b,$bb,$7b,$db),
+ ($26,$78,$09,$cd), ($59,$18,$f4,$6e), ($9a,$b7,$01,$ec), ($4f,$9a,$a8,$83),
+ ($95,$6e,$65,$e6), ($ff,$e6,$7e,$aa), ($bc,$cf,$08,$21), ($15,$e8,$e6,$ef),
+ ($e7,$9b,$d9,$ba), ($6f,$36,$ce,$4a), ($9f,$09,$d4,$ea), ($b0,$7c,$d6,$29),
+ ($a4,$b2,$af,$31), ($3f,$23,$31,$2a), ($a5,$94,$30,$c6), ($a2,$66,$c0,$35),
+ ($4e,$bc,$37,$74), ($82,$ca,$a6,$fc), ($90,$d0,$b0,$e0), ($a7,$d8,$15,$33),
+ ($04,$98,$4a,$f1), ($ec,$da,$f7,$41), ($cd,$50,$0e,$7f), ($91,$f6,$2f,$17),
+ ($4d,$d6,$8d,$76), ($ef,$b0,$4d,$43), ($aa,$4d,$54,$cc), ($96,$04,$df,$e4),
+ ($d1,$b5,$e3,$9e), ($6a,$88,$1b,$4c), ($2c,$1f,$b8,$c1), ($65,$51,$7f,$46),
+ ($5e,$ea,$04,$9d), ($8c,$35,$5d,$01), ($87,$74,$73,$fa), ($0b,$41,$2e,$fb),
+ ($67,$1d,$5a,$b3), ($db,$d2,$52,$92), ($10,$56,$33,$e9), ($d6,$47,$13,$6d),
+ ($d7,$61,$8c,$9a), ($a1,$0c,$7a,$37), ($f8,$14,$8e,$59), ($13,$3c,$89,$eb),
+ ($a9,$27,$ee,$ce), ($61,$c9,$35,$b7), ($1c,$e5,$ed,$e1), ($47,$b1,$3c,$7a),
+ ($d2,$df,$59,$9c), ($f2,$73,$3f,$55), ($14,$ce,$79,$18), ($c7,$37,$bf,$73),
+ ($f7,$cd,$ea,$53), ($fd,$aa,$5b,$5f), ($3d,$6f,$14,$df), ($44,$db,$86,$78),
+ ($af,$f3,$81,$ca), ($68,$c4,$3e,$b9), ($24,$34,$2c,$38), ($a3,$40,$5f,$c2),
+ ($1d,$c3,$72,$16), ($e2,$25,$0c,$bc), ($3c,$49,$8b,$28), ($0d,$95,$41,$ff),
+ ($a8,$01,$71,$39), ($0c,$b3,$de,$08), ($b4,$e4,$9c,$d8), ($56,$c1,$90,$64),
+ ($cb,$84,$61,$7b), ($32,$b6,$70,$d5), ($6c,$5c,$74,$48), ($b8,$57,$42,$d0));
+ S5: array[0..255] of byte= (
+ $52,$09,$6a,$d5,
+ $30,$36,$a5,$38,
+ $bf,$40,$a3,$9e,
+ $81,$f3,$d7,$fb,
+ $7c,$e3,$39,$82,
+ $9b,$2f,$ff,$87,
+ $34,$8e,$43,$44,
+ $c4,$de,$e9,$cb,
+ $54,$7b,$94,$32,
+ $a6,$c2,$23,$3d,
+ $ee,$4c,$95,$0b,
+ $42,$fa,$c3,$4e,
+ $08,$2e,$a1,$66,
+ $28,$d9,$24,$b2,
+ $76,$5b,$a2,$49,
+ $6d,$8b,$d1,$25,
+ $72,$f8,$f6,$64,
+ $86,$68,$98,$16,
+ $d4,$a4,$5c,$cc,
+ $5d,$65,$b6,$92,
+ $6c,$70,$48,$50,
+ $fd,$ed,$b9,$da,
+ $5e,$15,$46,$57,
+ $a7,$8d,$9d,$84,
+ $90,$d8,$ab,$00,
+ $8c,$bc,$d3,$0a,
+ $f7,$e4,$58,$05,
+ $b8,$b3,$45,$06,
+ $d0,$2c,$1e,$8f,
+ $ca,$3f,$0f,$02,
+ $c1,$af,$bd,$03,
+ $01,$13,$8a,$6b,
+ $3a,$91,$11,$41,
+ $4f,$67,$dc,$ea,
+ $97,$f2,$cf,$ce,
+ $f0,$b4,$e6,$73,
+ $96,$ac,$74,$22,
+ $e7,$ad,$35,$85,
+ $e2,$f9,$37,$e8,
+ $1c,$75,$df,$6e,
+ $47,$f1,$1a,$71,
+ $1d,$29,$c5,$89,
+ $6f,$b7,$62,$0e,
+ $aa,$18,$be,$1b,
+ $fc,$56,$3e,$4b,
+ $c6,$d2,$79,$20,
+ $9a,$db,$c0,$fe,
+ $78,$cd,$5a,$f4,
+ $1f,$dd,$a8,$33,
+ $88,$07,$c7,$31,
+ $b1,$12,$10,$59,
+ $27,$80,$ec,$5f,
+ $60,$51,$7f,$a9,
+ $19,$b5,$4a,$0d,
+ $2d,$e5,$7a,$9f,
+ $93,$c9,$9c,$ef,
+ $a0,$e0,$3b,$4d,
+ $ae,$2a,$f5,$b0,
+ $c8,$eb,$bb,$3c,
+ $83,$53,$99,$61,
+ $17,$2b,$04,$7e,
+ $ba,$77,$d6,$26,
+ $e1,$69,$14,$63,
+ $55,$21,$0c,$7d);
+ U1: array[0..255,0..3] of byte= (
+ ($00,$00,$00,$00), ($0e,$09,$0d,$0b), ($1c,$12,$1a,$16), ($12,$1b,$17,$1d),
+ ($38,$24,$34,$2c), ($36,$2d,$39,$27), ($24,$36,$2e,$3a), ($2a,$3f,$23,$31),
+ ($70,$48,$68,$58), ($7e,$41,$65,$53), ($6c,$5a,$72,$4e), ($62,$53,$7f,$45),
+ ($48,$6c,$5c,$74), ($46,$65,$51,$7f), ($54,$7e,$46,$62), ($5a,$77,$4b,$69),
+ ($e0,$90,$d0,$b0), ($ee,$99,$dd,$bb), ($fc,$82,$ca,$a6), ($f2,$8b,$c7,$ad),
+ ($d8,$b4,$e4,$9c), ($d6,$bd,$e9,$97), ($c4,$a6,$fe,$8a), ($ca,$af,$f3,$81),
+ ($90,$d8,$b8,$e8), ($9e,$d1,$b5,$e3), ($8c,$ca,$a2,$fe), ($82,$c3,$af,$f5),
+ ($a8,$fc,$8c,$c4), ($a6,$f5,$81,$cf), ($b4,$ee,$96,$d2), ($ba,$e7,$9b,$d9),
+ ($db,$3b,$bb,$7b), ($d5,$32,$b6,$70), ($c7,$29,$a1,$6d), ($c9,$20,$ac,$66),
+ ($e3,$1f,$8f,$57), ($ed,$16,$82,$5c), ($ff,$0d,$95,$41), ($f1,$04,$98,$4a),
+ ($ab,$73,$d3,$23), ($a5,$7a,$de,$28), ($b7,$61,$c9,$35), ($b9,$68,$c4,$3e),
+ ($93,$57,$e7,$0f), ($9d,$5e,$ea,$04), ($8f,$45,$fd,$19), ($81,$4c,$f0,$12),
+ ($3b,$ab,$6b,$cb), ($35,$a2,$66,$c0), ($27,$b9,$71,$dd), ($29,$b0,$7c,$d6),
+ ($03,$8f,$5f,$e7), ($0d,$86,$52,$ec), ($1f,$9d,$45,$f1), ($11,$94,$48,$fa),
+ ($4b,$e3,$03,$93), ($45,$ea,$0e,$98), ($57,$f1,$19,$85), ($59,$f8,$14,$8e),
+ ($73,$c7,$37,$bf), ($7d,$ce,$3a,$b4), ($6f,$d5,$2d,$a9), ($61,$dc,$20,$a2),
+ ($ad,$76,$6d,$f6), ($a3,$7f,$60,$fd), ($b1,$64,$77,$e0), ($bf,$6d,$7a,$eb),
+ ($95,$52,$59,$da), ($9b,$5b,$54,$d1), ($89,$40,$43,$cc), ($87,$49,$4e,$c7),
+ ($dd,$3e,$05,$ae), ($d3,$37,$08,$a5), ($c1,$2c,$1f,$b8), ($cf,$25,$12,$b3),
+ ($e5,$1a,$31,$82), ($eb,$13,$3c,$89), ($f9,$08,$2b,$94), ($f7,$01,$26,$9f),
+ ($4d,$e6,$bd,$46), ($43,$ef,$b0,$4d), ($51,$f4,$a7,$50), ($5f,$fd,$aa,$5b),
+ ($75,$c2,$89,$6a), ($7b,$cb,$84,$61), ($69,$d0,$93,$7c), ($67,$d9,$9e,$77),
+ ($3d,$ae,$d5,$1e), ($33,$a7,$d8,$15), ($21,$bc,$cf,$08), ($2f,$b5,$c2,$03),
+ ($05,$8a,$e1,$32), ($0b,$83,$ec,$39), ($19,$98,$fb,$24), ($17,$91,$f6,$2f),
+ ($76,$4d,$d6,$8d), ($78,$44,$db,$86), ($6a,$5f,$cc,$9b), ($64,$56,$c1,$90),
+ ($4e,$69,$e2,$a1), ($40,$60,$ef,$aa), ($52,$7b,$f8,$b7), ($5c,$72,$f5,$bc),
+ ($06,$05,$be,$d5), ($08,$0c,$b3,$de), ($1a,$17,$a4,$c3), ($14,$1e,$a9,$c8),
+ ($3e,$21,$8a,$f9), ($30,$28,$87,$f2), ($22,$33,$90,$ef), ($2c,$3a,$9d,$e4),
+ ($96,$dd,$06,$3d), ($98,$d4,$0b,$36), ($8a,$cf,$1c,$2b), ($84,$c6,$11,$20),
+ ($ae,$f9,$32,$11), ($a0,$f0,$3f,$1a), ($b2,$eb,$28,$07), ($bc,$e2,$25,$0c),
+ ($e6,$95,$6e,$65), ($e8,$9c,$63,$6e), ($fa,$87,$74,$73), ($f4,$8e,$79,$78),
+ ($de,$b1,$5a,$49), ($d0,$b8,$57,$42), ($c2,$a3,$40,$5f), ($cc,$aa,$4d,$54),
+ ($41,$ec,$da,$f7), ($4f,$e5,$d7,$fc), ($5d,$fe,$c0,$e1), ($53,$f7,$cd,$ea),
+ ($79,$c8,$ee,$db), ($77,$c1,$e3,$d0), ($65,$da,$f4,$cd), ($6b,$d3,$f9,$c6),
+ ($31,$a4,$b2,$af), ($3f,$ad,$bf,$a4), ($2d,$b6,$a8,$b9), ($23,$bf,$a5,$b2),
+ ($09,$80,$86,$83), ($07,$89,$8b,$88), ($15,$92,$9c,$95), ($1b,$9b,$91,$9e),
+ ($a1,$7c,$0a,$47), ($af,$75,$07,$4c), ($bd,$6e,$10,$51), ($b3,$67,$1d,$5a),
+ ($99,$58,$3e,$6b), ($97,$51,$33,$60), ($85,$4a,$24,$7d), ($8b,$43,$29,$76),
+ ($d1,$34,$62,$1f), ($df,$3d,$6f,$14), ($cd,$26,$78,$09), ($c3,$2f,$75,$02),
+ ($e9,$10,$56,$33), ($e7,$19,$5b,$38), ($f5,$02,$4c,$25), ($fb,$0b,$41,$2e),
+ ($9a,$d7,$61,$8c), ($94,$de,$6c,$87), ($86,$c5,$7b,$9a), ($88,$cc,$76,$91),
+ ($a2,$f3,$55,$a0), ($ac,$fa,$58,$ab), ($be,$e1,$4f,$b6), ($b0,$e8,$42,$bd),
+ ($ea,$9f,$09,$d4), ($e4,$96,$04,$df), ($f6,$8d,$13,$c2), ($f8,$84,$1e,$c9),
+ ($d2,$bb,$3d,$f8), ($dc,$b2,$30,$f3), ($ce,$a9,$27,$ee), ($c0,$a0,$2a,$e5),
+ ($7a,$47,$b1,$3c), ($74,$4e,$bc,$37), ($66,$55,$ab,$2a), ($68,$5c,$a6,$21),
+ ($42,$63,$85,$10), ($4c,$6a,$88,$1b), ($5e,$71,$9f,$06), ($50,$78,$92,$0d),
+ ($0a,$0f,$d9,$64), ($04,$06,$d4,$6f), ($16,$1d,$c3,$72), ($18,$14,$ce,$79),
+ ($32,$2b,$ed,$48), ($3c,$22,$e0,$43), ($2e,$39,$f7,$5e), ($20,$30,$fa,$55),
+ ($ec,$9a,$b7,$01), ($e2,$93,$ba,$0a), ($f0,$88,$ad,$17), ($fe,$81,$a0,$1c),
+ ($d4,$be,$83,$2d), ($da,$b7,$8e,$26), ($c8,$ac,$99,$3b), ($c6,$a5,$94,$30),
+ ($9c,$d2,$df,$59), ($92,$db,$d2,$52), ($80,$c0,$c5,$4f), ($8e,$c9,$c8,$44),
+ ($a4,$f6,$eb,$75), ($aa,$ff,$e6,$7e), ($b8,$e4,$f1,$63), ($b6,$ed,$fc,$68),
+ ($0c,$0a,$67,$b1), ($02,$03,$6a,$ba), ($10,$18,$7d,$a7), ($1e,$11,$70,$ac),
+ ($34,$2e,$53,$9d), ($3a,$27,$5e,$96), ($28,$3c,$49,$8b), ($26,$35,$44,$80),
+ ($7c,$42,$0f,$e9), ($72,$4b,$02,$e2), ($60,$50,$15,$ff), ($6e,$59,$18,$f4),
+ ($44,$66,$3b,$c5), ($4a,$6f,$36,$ce), ($58,$74,$21,$d3), ($56,$7d,$2c,$d8),
+ ($37,$a1,$0c,$7a), ($39,$a8,$01,$71), ($2b,$b3,$16,$6c), ($25,$ba,$1b,$67),
+ ($0f,$85,$38,$56), ($01,$8c,$35,$5d), ($13,$97,$22,$40), ($1d,$9e,$2f,$4b),
+ ($47,$e9,$64,$22), ($49,$e0,$69,$29), ($5b,$fb,$7e,$34), ($55,$f2,$73,$3f),
+ ($7f,$cd,$50,$0e), ($71,$c4,$5d,$05), ($63,$df,$4a,$18), ($6d,$d6,$47,$13),
+ ($d7,$31,$dc,$ca), ($d9,$38,$d1,$c1), ($cb,$23,$c6,$dc), ($c5,$2a,$cb,$d7),
+ ($ef,$15,$e8,$e6), ($e1,$1c,$e5,$ed), ($f3,$07,$f2,$f0), ($fd,$0e,$ff,$fb),
+ ($a7,$79,$b4,$92), ($a9,$70,$b9,$99), ($bb,$6b,$ae,$84), ($b5,$62,$a3,$8f),
+ ($9f,$5d,$80,$be), ($91,$54,$8d,$b5), ($83,$4f,$9a,$a8), ($8d,$46,$97,$a3));
+ U2: array[0..255,0..3] of byte= (
+ ($00,$00,$00,$00), ($0b,$0e,$09,$0d), ($16,$1c,$12,$1a), ($1d,$12,$1b,$17),
+ ($2c,$38,$24,$34), ($27,$36,$2d,$39), ($3a,$24,$36,$2e), ($31,$2a,$3f,$23),
+ ($58,$70,$48,$68), ($53,$7e,$41,$65), ($4e,$6c,$5a,$72), ($45,$62,$53,$7f),
+ ($74,$48,$6c,$5c), ($7f,$46,$65,$51), ($62,$54,$7e,$46), ($69,$5a,$77,$4b),
+ ($b0,$e0,$90,$d0), ($bb,$ee,$99,$dd), ($a6,$fc,$82,$ca), ($ad,$f2,$8b,$c7),
+ ($9c,$d8,$b4,$e4), ($97,$d6,$bd,$e9), ($8a,$c4,$a6,$fe), ($81,$ca,$af,$f3),
+ ($e8,$90,$d8,$b8), ($e3,$9e,$d1,$b5), ($fe,$8c,$ca,$a2), ($f5,$82,$c3,$af),
+ ($c4,$a8,$fc,$8c), ($cf,$a6,$f5,$81), ($d2,$b4,$ee,$96), ($d9,$ba,$e7,$9b),
+ ($7b,$db,$3b,$bb), ($70,$d5,$32,$b6), ($6d,$c7,$29,$a1), ($66,$c9,$20,$ac),
+ ($57,$e3,$1f,$8f), ($5c,$ed,$16,$82), ($41,$ff,$0d,$95), ($4a,$f1,$04,$98),
+ ($23,$ab,$73,$d3), ($28,$a5,$7a,$de), ($35,$b7,$61,$c9), ($3e,$b9,$68,$c4),
+ ($0f,$93,$57,$e7), ($04,$9d,$5e,$ea), ($19,$8f,$45,$fd), ($12,$81,$4c,$f0),
+ ($cb,$3b,$ab,$6b), ($c0,$35,$a2,$66), ($dd,$27,$b9,$71), ($d6,$29,$b0,$7c),
+ ($e7,$03,$8f,$5f), ($ec,$0d,$86,$52), ($f1,$1f,$9d,$45), ($fa,$11,$94,$48),
+ ($93,$4b,$e3,$03), ($98,$45,$ea,$0e), ($85,$57,$f1,$19), ($8e,$59,$f8,$14),
+ ($bf,$73,$c7,$37), ($b4,$7d,$ce,$3a), ($a9,$6f,$d5,$2d), ($a2,$61,$dc,$20),
+ ($f6,$ad,$76,$6d), ($fd,$a3,$7f,$60), ($e0,$b1,$64,$77), ($eb,$bf,$6d,$7a),
+ ($da,$95,$52,$59), ($d1,$9b,$5b,$54), ($cc,$89,$40,$43), ($c7,$87,$49,$4e),
+ ($ae,$dd,$3e,$05), ($a5,$d3,$37,$08), ($b8,$c1,$2c,$1f), ($b3,$cf,$25,$12),
+ ($82,$e5,$1a,$31), ($89,$eb,$13,$3c), ($94,$f9,$08,$2b), ($9f,$f7,$01,$26),
+ ($46,$4d,$e6,$bd), ($4d,$43,$ef,$b0), ($50,$51,$f4,$a7), ($5b,$5f,$fd,$aa),
+ ($6a,$75,$c2,$89), ($61,$7b,$cb,$84), ($7c,$69,$d0,$93), ($77,$67,$d9,$9e),
+ ($1e,$3d,$ae,$d5), ($15,$33,$a7,$d8), ($08,$21,$bc,$cf), ($03,$2f,$b5,$c2),
+ ($32,$05,$8a,$e1), ($39,$0b,$83,$ec), ($24,$19,$98,$fb), ($2f,$17,$91,$f6),
+ ($8d,$76,$4d,$d6), ($86,$78,$44,$db), ($9b,$6a,$5f,$cc), ($90,$64,$56,$c1),
+ ($a1,$4e,$69,$e2), ($aa,$40,$60,$ef), ($b7,$52,$7b,$f8), ($bc,$5c,$72,$f5),
+ ($d5,$06,$05,$be), ($de,$08,$0c,$b3), ($c3,$1a,$17,$a4), ($c8,$14,$1e,$a9),
+ ($f9,$3e,$21,$8a), ($f2,$30,$28,$87), ($ef,$22,$33,$90), ($e4,$2c,$3a,$9d),
+ ($3d,$96,$dd,$06), ($36,$98,$d4,$0b), ($2b,$8a,$cf,$1c), ($20,$84,$c6,$11),
+ ($11,$ae,$f9,$32), ($1a,$a0,$f0,$3f), ($07,$b2,$eb,$28), ($0c,$bc,$e2,$25),
+ ($65,$e6,$95,$6e), ($6e,$e8,$9c,$63), ($73,$fa,$87,$74), ($78,$f4,$8e,$79),
+ ($49,$de,$b1,$5a), ($42,$d0,$b8,$57), ($5f,$c2,$a3,$40), ($54,$cc,$aa,$4d),
+ ($f7,$41,$ec,$da), ($fc,$4f,$e5,$d7), ($e1,$5d,$fe,$c0), ($ea,$53,$f7,$cd),
+ ($db,$79,$c8,$ee), ($d0,$77,$c1,$e3), ($cd,$65,$da,$f4), ($c6,$6b,$d3,$f9),
+ ($af,$31,$a4,$b2), ($a4,$3f,$ad,$bf), ($b9,$2d,$b6,$a8), ($b2,$23,$bf,$a5),
+ ($83,$09,$80,$86), ($88,$07,$89,$8b), ($95,$15,$92,$9c), ($9e,$1b,$9b,$91),
+ ($47,$a1,$7c,$0a), ($4c,$af,$75,$07), ($51,$bd,$6e,$10), ($5a,$b3,$67,$1d),
+ ($6b,$99,$58,$3e), ($60,$97,$51,$33), ($7d,$85,$4a,$24), ($76,$8b,$43,$29),
+ ($1f,$d1,$34,$62), ($14,$df,$3d,$6f), ($09,$cd,$26,$78), ($02,$c3,$2f,$75),
+ ($33,$e9,$10,$56), ($38,$e7,$19,$5b), ($25,$f5,$02,$4c), ($2e,$fb,$0b,$41),
+ ($8c,$9a,$d7,$61), ($87,$94,$de,$6c), ($9a,$86,$c5,$7b), ($91,$88,$cc,$76),
+ ($a0,$a2,$f3,$55), ($ab,$ac,$fa,$58), ($b6,$be,$e1,$4f), ($bd,$b0,$e8,$42),
+ ($d4,$ea,$9f,$09), ($df,$e4,$96,$04), ($c2,$f6,$8d,$13), ($c9,$f8,$84,$1e),
+ ($f8,$d2,$bb,$3d), ($f3,$dc,$b2,$30), ($ee,$ce,$a9,$27), ($e5,$c0,$a0,$2a),
+ ($3c,$7a,$47,$b1), ($37,$74,$4e,$bc), ($2a,$66,$55,$ab), ($21,$68,$5c,$a6),
+ ($10,$42,$63,$85), ($1b,$4c,$6a,$88), ($06,$5e,$71,$9f), ($0d,$50,$78,$92),
+ ($64,$0a,$0f,$d9), ($6f,$04,$06,$d4), ($72,$16,$1d,$c3), ($79,$18,$14,$ce),
+ ($48,$32,$2b,$ed), ($43,$3c,$22,$e0), ($5e,$2e,$39,$f7), ($55,$20,$30,$fa),
+ ($01,$ec,$9a,$b7), ($0a,$e2,$93,$ba), ($17,$f0,$88,$ad), ($1c,$fe,$81,$a0),
+ ($2d,$d4,$be,$83), ($26,$da,$b7,$8e), ($3b,$c8,$ac,$99), ($30,$c6,$a5,$94),
+ ($59,$9c,$d2,$df), ($52,$92,$db,$d2), ($4f,$80,$c0,$c5), ($44,$8e,$c9,$c8),
+ ($75,$a4,$f6,$eb), ($7e,$aa,$ff,$e6), ($63,$b8,$e4,$f1), ($68,$b6,$ed,$fc),
+ ($b1,$0c,$0a,$67), ($ba,$02,$03,$6a), ($a7,$10,$18,$7d), ($ac,$1e,$11,$70),
+ ($9d,$34,$2e,$53), ($96,$3a,$27,$5e), ($8b,$28,$3c,$49), ($80,$26,$35,$44),
+ ($e9,$7c,$42,$0f), ($e2,$72,$4b,$02), ($ff,$60,$50,$15), ($f4,$6e,$59,$18),
+ ($c5,$44,$66,$3b), ($ce,$4a,$6f,$36), ($d3,$58,$74,$21), ($d8,$56,$7d,$2c),
+ ($7a,$37,$a1,$0c), ($71,$39,$a8,$01), ($6c,$2b,$b3,$16), ($67,$25,$ba,$1b),
+ ($56,$0f,$85,$38), ($5d,$01,$8c,$35), ($40,$13,$97,$22), ($4b,$1d,$9e,$2f),
+ ($22,$47,$e9,$64), ($29,$49,$e0,$69), ($34,$5b,$fb,$7e), ($3f,$55,$f2,$73),
+ ($0e,$7f,$cd,$50), ($05,$71,$c4,$5d), ($18,$63,$df,$4a), ($13,$6d,$d6,$47),
+ ($ca,$d7,$31,$dc), ($c1,$d9,$38,$d1), ($dc,$cb,$23,$c6), ($d7,$c5,$2a,$cb),
+ ($e6,$ef,$15,$e8), ($ed,$e1,$1c,$e5), ($f0,$f3,$07,$f2), ($fb,$fd,$0e,$ff),
+ ($92,$a7,$79,$b4), ($99,$a9,$70,$b9), ($84,$bb,$6b,$ae), ($8f,$b5,$62,$a3),
+ ($be,$9f,$5d,$80), ($b5,$91,$54,$8d), ($a8,$83,$4f,$9a), ($a3,$8d,$46,$97));
+ U3: array[0..255,0..3] of byte= (
+ ($00,$00,$00,$00), ($0d,$0b,$0e,$09), ($1a,$16,$1c,$12), ($17,$1d,$12,$1b),
+ ($34,$2c,$38,$24), ($39,$27,$36,$2d), ($2e,$3a,$24,$36), ($23,$31,$2a,$3f),
+ ($68,$58,$70,$48), ($65,$53,$7e,$41), ($72,$4e,$6c,$5a), ($7f,$45,$62,$53),
+ ($5c,$74,$48,$6c), ($51,$7f,$46,$65), ($46,$62,$54,$7e), ($4b,$69,$5a,$77),
+ ($d0,$b0,$e0,$90), ($dd,$bb,$ee,$99), ($ca,$a6,$fc,$82), ($c7,$ad,$f2,$8b),
+ ($e4,$9c,$d8,$b4), ($e9,$97,$d6,$bd), ($fe,$8a,$c4,$a6), ($f3,$81,$ca,$af),
+ ($b8,$e8,$90,$d8), ($b5,$e3,$9e,$d1), ($a2,$fe,$8c,$ca), ($af,$f5,$82,$c3),
+ ($8c,$c4,$a8,$fc), ($81,$cf,$a6,$f5), ($96,$d2,$b4,$ee), ($9b,$d9,$ba,$e7),
+ ($bb,$7b,$db,$3b), ($b6,$70,$d5,$32), ($a1,$6d,$c7,$29), ($ac,$66,$c9,$20),
+ ($8f,$57,$e3,$1f), ($82,$5c,$ed,$16), ($95,$41,$ff,$0d), ($98,$4a,$f1,$04),
+ ($d3,$23,$ab,$73), ($de,$28,$a5,$7a), ($c9,$35,$b7,$61), ($c4,$3e,$b9,$68),
+ ($e7,$0f,$93,$57), ($ea,$04,$9d,$5e), ($fd,$19,$8f,$45), ($f0,$12,$81,$4c),
+ ($6b,$cb,$3b,$ab), ($66,$c0,$35,$a2), ($71,$dd,$27,$b9), ($7c,$d6,$29,$b0),
+ ($5f,$e7,$03,$8f), ($52,$ec,$0d,$86), ($45,$f1,$1f,$9d), ($48,$fa,$11,$94),
+ ($03,$93,$4b,$e3), ($0e,$98,$45,$ea), ($19,$85,$57,$f1), ($14,$8e,$59,$f8),
+ ($37,$bf,$73,$c7), ($3a,$b4,$7d,$ce), ($2d,$a9,$6f,$d5), ($20,$a2,$61,$dc),
+ ($6d,$f6,$ad,$76), ($60,$fd,$a3,$7f), ($77,$e0,$b1,$64), ($7a,$eb,$bf,$6d),
+ ($59,$da,$95,$52), ($54,$d1,$9b,$5b), ($43,$cc,$89,$40), ($4e,$c7,$87,$49),
+ ($05,$ae,$dd,$3e), ($08,$a5,$d3,$37), ($1f,$b8,$c1,$2c), ($12,$b3,$cf,$25),
+ ($31,$82,$e5,$1a), ($3c,$89,$eb,$13), ($2b,$94,$f9,$08), ($26,$9f,$f7,$01),
+ ($bd,$46,$4d,$e6), ($b0,$4d,$43,$ef), ($a7,$50,$51,$f4), ($aa,$5b,$5f,$fd),
+ ($89,$6a,$75,$c2), ($84,$61,$7b,$cb), ($93,$7c,$69,$d0), ($9e,$77,$67,$d9),
+ ($d5,$1e,$3d,$ae), ($d8,$15,$33,$a7), ($cf,$08,$21,$bc), ($c2,$03,$2f,$b5),
+ ($e1,$32,$05,$8a), ($ec,$39,$0b,$83), ($fb,$24,$19,$98), ($f6,$2f,$17,$91),
+ ($d6,$8d,$76,$4d), ($db,$86,$78,$44), ($cc,$9b,$6a,$5f), ($c1,$90,$64,$56),
+ ($e2,$a1,$4e,$69), ($ef,$aa,$40,$60), ($f8,$b7,$52,$7b), ($f5,$bc,$5c,$72),
+ ($be,$d5,$06,$05), ($b3,$de,$08,$0c), ($a4,$c3,$1a,$17), ($a9,$c8,$14,$1e),
+ ($8a,$f9,$3e,$21), ($87,$f2,$30,$28), ($90,$ef,$22,$33), ($9d,$e4,$2c,$3a),
+ ($06,$3d,$96,$dd), ($0b,$36,$98,$d4), ($1c,$2b,$8a,$cf), ($11,$20,$84,$c6),
+ ($32,$11,$ae,$f9), ($3f,$1a,$a0,$f0), ($28,$07,$b2,$eb), ($25,$0c,$bc,$e2),
+ ($6e,$65,$e6,$95), ($63,$6e,$e8,$9c), ($74,$73,$fa,$87), ($79,$78,$f4,$8e),
+ ($5a,$49,$de,$b1), ($57,$42,$d0,$b8), ($40,$5f,$c2,$a3), ($4d,$54,$cc,$aa),
+ ($da,$f7,$41,$ec), ($d7,$fc,$4f,$e5), ($c0,$e1,$5d,$fe), ($cd,$ea,$53,$f7),
+ ($ee,$db,$79,$c8), ($e3,$d0,$77,$c1), ($f4,$cd,$65,$da), ($f9,$c6,$6b,$d3),
+ ($b2,$af,$31,$a4), ($bf,$a4,$3f,$ad), ($a8,$b9,$2d,$b6), ($a5,$b2,$23,$bf),
+ ($86,$83,$09,$80), ($8b,$88,$07,$89), ($9c,$95,$15,$92), ($91,$9e,$1b,$9b),
+ ($0a,$47,$a1,$7c), ($07,$4c,$af,$75), ($10,$51,$bd,$6e), ($1d,$5a,$b3,$67),
+ ($3e,$6b,$99,$58), ($33,$60,$97,$51), ($24,$7d,$85,$4a), ($29,$76,$8b,$43),
+ ($62,$1f,$d1,$34), ($6f,$14,$df,$3d), ($78,$09,$cd,$26), ($75,$02,$c3,$2f),
+ ($56,$33,$e9,$10), ($5b,$38,$e7,$19), ($4c,$25,$f5,$02), ($41,$2e,$fb,$0b),
+ ($61,$8c,$9a,$d7), ($6c,$87,$94,$de), ($7b,$9a,$86,$c5), ($76,$91,$88,$cc),
+ ($55,$a0,$a2,$f3), ($58,$ab,$ac,$fa), ($4f,$b6,$be,$e1), ($42,$bd,$b0,$e8),
+ ($09,$d4,$ea,$9f), ($04,$df,$e4,$96), ($13,$c2,$f6,$8d), ($1e,$c9,$f8,$84),
+ ($3d,$f8,$d2,$bb), ($30,$f3,$dc,$b2), ($27,$ee,$ce,$a9), ($2a,$e5,$c0,$a0),
+ ($b1,$3c,$7a,$47), ($bc,$37,$74,$4e), ($ab,$2a,$66,$55), ($a6,$21,$68,$5c),
+ ($85,$10,$42,$63), ($88,$1b,$4c,$6a), ($9f,$06,$5e,$71), ($92,$0d,$50,$78),
+ ($d9,$64,$0a,$0f), ($d4,$6f,$04,$06), ($c3,$72,$16,$1d), ($ce,$79,$18,$14),
+ ($ed,$48,$32,$2b), ($e0,$43,$3c,$22), ($f7,$5e,$2e,$39), ($fa,$55,$20,$30),
+ ($b7,$01,$ec,$9a), ($ba,$0a,$e2,$93), ($ad,$17,$f0,$88), ($a0,$1c,$fe,$81),
+ ($83,$2d,$d4,$be), ($8e,$26,$da,$b7), ($99,$3b,$c8,$ac), ($94,$30,$c6,$a5),
+ ($df,$59,$9c,$d2), ($d2,$52,$92,$db), ($c5,$4f,$80,$c0), ($c8,$44,$8e,$c9),
+ ($eb,$75,$a4,$f6), ($e6,$7e,$aa,$ff), ($f1,$63,$b8,$e4), ($fc,$68,$b6,$ed),
+ ($67,$b1,$0c,$0a), ($6a,$ba,$02,$03), ($7d,$a7,$10,$18), ($70,$ac,$1e,$11),
+ ($53,$9d,$34,$2e), ($5e,$96,$3a,$27), ($49,$8b,$28,$3c), ($44,$80,$26,$35),
+ ($0f,$e9,$7c,$42), ($02,$e2,$72,$4b), ($15,$ff,$60,$50), ($18,$f4,$6e,$59),
+ ($3b,$c5,$44,$66), ($36,$ce,$4a,$6f), ($21,$d3,$58,$74), ($2c,$d8,$56,$7d),
+ ($0c,$7a,$37,$a1), ($01,$71,$39,$a8), ($16,$6c,$2b,$b3), ($1b,$67,$25,$ba),
+ ($38,$56,$0f,$85), ($35,$5d,$01,$8c), ($22,$40,$13,$97), ($2f,$4b,$1d,$9e),
+ ($64,$22,$47,$e9), ($69,$29,$49,$e0), ($7e,$34,$5b,$fb), ($73,$3f,$55,$f2),
+ ($50,$0e,$7f,$cd), ($5d,$05,$71,$c4), ($4a,$18,$63,$df), ($47,$13,$6d,$d6),
+ ($dc,$ca,$d7,$31), ($d1,$c1,$d9,$38), ($c6,$dc,$cb,$23), ($cb,$d7,$c5,$2a),
+ ($e8,$e6,$ef,$15), ($e5,$ed,$e1,$1c), ($f2,$f0,$f3,$07), ($ff,$fb,$fd,$0e),
+ ($b4,$92,$a7,$79), ($b9,$99,$a9,$70), ($ae,$84,$bb,$6b), ($a3,$8f,$b5,$62),
+ ($80,$be,$9f,$5d), ($8d,$b5,$91,$54), ($9a,$a8,$83,$4f), ($97,$a3,$8d,$46));
+ U4: array[0..255,0..3] of byte= (
+ ($00,$00,$00,$00), ($09,$0d,$0b,$0e), ($12,$1a,$16,$1c), ($1b,$17,$1d,$12),
+ ($24,$34,$2c,$38), ($2d,$39,$27,$36), ($36,$2e,$3a,$24), ($3f,$23,$31,$2a),
+ ($48,$68,$58,$70), ($41,$65,$53,$7e), ($5a,$72,$4e,$6c), ($53,$7f,$45,$62),
+ ($6c,$5c,$74,$48), ($65,$51,$7f,$46), ($7e,$46,$62,$54), ($77,$4b,$69,$5a),
+ ($90,$d0,$b0,$e0), ($99,$dd,$bb,$ee), ($82,$ca,$a6,$fc), ($8b,$c7,$ad,$f2),
+ ($b4,$e4,$9c,$d8), ($bd,$e9,$97,$d6), ($a6,$fe,$8a,$c4), ($af,$f3,$81,$ca),
+ ($d8,$b8,$e8,$90), ($d1,$b5,$e3,$9e), ($ca,$a2,$fe,$8c), ($c3,$af,$f5,$82),
+ ($fc,$8c,$c4,$a8), ($f5,$81,$cf,$a6), ($ee,$96,$d2,$b4), ($e7,$9b,$d9,$ba),
+ ($3b,$bb,$7b,$db), ($32,$b6,$70,$d5), ($29,$a1,$6d,$c7), ($20,$ac,$66,$c9),
+ ($1f,$8f,$57,$e3), ($16,$82,$5c,$ed), ($0d,$95,$41,$ff), ($04,$98,$4a,$f1),
+ ($73,$d3,$23,$ab), ($7a,$de,$28,$a5), ($61,$c9,$35,$b7), ($68,$c4,$3e,$b9),
+ ($57,$e7,$0f,$93), ($5e,$ea,$04,$9d), ($45,$fd,$19,$8f), ($4c,$f0,$12,$81),
+ ($ab,$6b,$cb,$3b), ($a2,$66,$c0,$35), ($b9,$71,$dd,$27), ($b0,$7c,$d6,$29),
+ ($8f,$5f,$e7,$03), ($86,$52,$ec,$0d), ($9d,$45,$f1,$1f), ($94,$48,$fa,$11),
+ ($e3,$03,$93,$4b), ($ea,$0e,$98,$45), ($f1,$19,$85,$57), ($f8,$14,$8e,$59),
+ ($c7,$37,$bf,$73), ($ce,$3a,$b4,$7d), ($d5,$2d,$a9,$6f), ($dc,$20,$a2,$61),
+ ($76,$6d,$f6,$ad), ($7f,$60,$fd,$a3), ($64,$77,$e0,$b1), ($6d,$7a,$eb,$bf),
+ ($52,$59,$da,$95), ($5b,$54,$d1,$9b), ($40,$43,$cc,$89), ($49,$4e,$c7,$87),
+ ($3e,$05,$ae,$dd), ($37,$08,$a5,$d3), ($2c,$1f,$b8,$c1), ($25,$12,$b3,$cf),
+ ($1a,$31,$82,$e5), ($13,$3c,$89,$eb), ($08,$2b,$94,$f9), ($01,$26,$9f,$f7),
+ ($e6,$bd,$46,$4d), ($ef,$b0,$4d,$43), ($f4,$a7,$50,$51), ($fd,$aa,$5b,$5f),
+ ($c2,$89,$6a,$75), ($cb,$84,$61,$7b), ($d0,$93,$7c,$69), ($d9,$9e,$77,$67),
+ ($ae,$d5,$1e,$3d), ($a7,$d8,$15,$33), ($bc,$cf,$08,$21), ($b5,$c2,$03,$2f),
+ ($8a,$e1,$32,$05), ($83,$ec,$39,$0b), ($98,$fb,$24,$19), ($91,$f6,$2f,$17),
+ ($4d,$d6,$8d,$76), ($44,$db,$86,$78), ($5f,$cc,$9b,$6a), ($56,$c1,$90,$64),
+ ($69,$e2,$a1,$4e), ($60,$ef,$aa,$40), ($7b,$f8,$b7,$52), ($72,$f5,$bc,$5c),
+ ($05,$be,$d5,$06), ($0c,$b3,$de,$08), ($17,$a4,$c3,$1a), ($1e,$a9,$c8,$14),
+ ($21,$8a,$f9,$3e), ($28,$87,$f2,$30), ($33,$90,$ef,$22), ($3a,$9d,$e4,$2c),
+ ($dd,$06,$3d,$96), ($d4,$0b,$36,$98), ($cf,$1c,$2b,$8a), ($c6,$11,$20,$84),
+ ($f9,$32,$11,$ae), ($f0,$3f,$1a,$a0), ($eb,$28,$07,$b2), ($e2,$25,$0c,$bc),
+ ($95,$6e,$65,$e6), ($9c,$63,$6e,$e8), ($87,$74,$73,$fa), ($8e,$79,$78,$f4),
+ ($b1,$5a,$49,$de), ($b8,$57,$42,$d0), ($a3,$40,$5f,$c2), ($aa,$4d,$54,$cc),
+ ($ec,$da,$f7,$41), ($e5,$d7,$fc,$4f), ($fe,$c0,$e1,$5d), ($f7,$cd,$ea,$53),
+ ($c8,$ee,$db,$79), ($c1,$e3,$d0,$77), ($da,$f4,$cd,$65), ($d3,$f9,$c6,$6b),
+ ($a4,$b2,$af,$31), ($ad,$bf,$a4,$3f), ($b6,$a8,$b9,$2d), ($bf,$a5,$b2,$23),
+ ($80,$86,$83,$09), ($89,$8b,$88,$07), ($92,$9c,$95,$15), ($9b,$91,$9e,$1b),
+ ($7c,$0a,$47,$a1), ($75,$07,$4c,$af), ($6e,$10,$51,$bd), ($67,$1d,$5a,$b3),
+ ($58,$3e,$6b,$99), ($51,$33,$60,$97), ($4a,$24,$7d,$85), ($43,$29,$76,$8b),
+ ($34,$62,$1f,$d1), ($3d,$6f,$14,$df), ($26,$78,$09,$cd), ($2f,$75,$02,$c3),
+ ($10,$56,$33,$e9), ($19,$5b,$38,$e7), ($02,$4c,$25,$f5), ($0b,$41,$2e,$fb),
+ ($d7,$61,$8c,$9a), ($de,$6c,$87,$94), ($c5,$7b,$9a,$86), ($cc,$76,$91,$88),
+ ($f3,$55,$a0,$a2), ($fa,$58,$ab,$ac), ($e1,$4f,$b6,$be), ($e8,$42,$bd,$b0),
+ ($9f,$09,$d4,$ea), ($96,$04,$df,$e4), ($8d,$13,$c2,$f6), ($84,$1e,$c9,$f8),
+ ($bb,$3d,$f8,$d2), ($b2,$30,$f3,$dc), ($a9,$27,$ee,$ce), ($a0,$2a,$e5,$c0),
+ ($47,$b1,$3c,$7a), ($4e,$bc,$37,$74), ($55,$ab,$2a,$66), ($5c,$a6,$21,$68),
+ ($63,$85,$10,$42), ($6a,$88,$1b,$4c), ($71,$9f,$06,$5e), ($78,$92,$0d,$50),
+ ($0f,$d9,$64,$0a), ($06,$d4,$6f,$04), ($1d,$c3,$72,$16), ($14,$ce,$79,$18),
+ ($2b,$ed,$48,$32), ($22,$e0,$43,$3c), ($39,$f7,$5e,$2e), ($30,$fa,$55,$20),
+ ($9a,$b7,$01,$ec), ($93,$ba,$0a,$e2), ($88,$ad,$17,$f0), ($81,$a0,$1c,$fe),
+ ($be,$83,$2d,$d4), ($b7,$8e,$26,$da), ($ac,$99,$3b,$c8), ($a5,$94,$30,$c6),
+ ($d2,$df,$59,$9c), ($db,$d2,$52,$92), ($c0,$c5,$4f,$80), ($c9,$c8,$44,$8e),
+ ($f6,$eb,$75,$a4), ($ff,$e6,$7e,$aa), ($e4,$f1,$63,$b8), ($ed,$fc,$68,$b6),
+ ($0a,$67,$b1,$0c), ($03,$6a,$ba,$02), ($18,$7d,$a7,$10), ($11,$70,$ac,$1e),
+ ($2e,$53,$9d,$34), ($27,$5e,$96,$3a), ($3c,$49,$8b,$28), ($35,$44,$80,$26),
+ ($42,$0f,$e9,$7c), ($4b,$02,$e2,$72), ($50,$15,$ff,$60), ($59,$18,$f4,$6e),
+ ($66,$3b,$c5,$44), ($6f,$36,$ce,$4a), ($74,$21,$d3,$58), ($7d,$2c,$d8,$56),
+ ($a1,$0c,$7a,$37), ($a8,$01,$71,$39), ($b3,$16,$6c,$2b), ($ba,$1b,$67,$25),
+ ($85,$38,$56,$0f), ($8c,$35,$5d,$01), ($97,$22,$40,$13), ($9e,$2f,$4b,$1d),
+ ($e9,$64,$22,$47), ($e0,$69,$29,$49), ($fb,$7e,$34,$5b), ($f2,$73,$3f,$55),
+ ($cd,$50,$0e,$7f), ($c4,$5d,$05,$71), ($df,$4a,$18,$63), ($d6,$47,$13,$6d),
+ ($31,$dc,$ca,$d7), ($38,$d1,$c1,$d9), ($23,$c6,$dc,$cb), ($2a,$cb,$d7,$c5),
+ ($15,$e8,$e6,$ef), ($1c,$e5,$ed,$e1), ($07,$f2,$f0,$f3), ($0e,$ff,$fb,$fd),
+ ($79,$b4,$92,$a7), ($70,$b9,$99,$a9), ($6b,$ae,$84,$bb), ($62,$a3,$8f,$b5),
+ ($5d,$80,$be,$9f), ($54,$8d,$b5,$91), ($4f,$9a,$a8,$83), ($46,$97,$a3,$8d));
+
+ rcon: array[0..29] of cardinal= (
+ $01, $02, $04, $08, $10, $20, $40, $80, $1b, $36, $6c, $d8, $ab, $4d, $9a,
+ $2f, $5e, $bc, $63, $c6, $97, $35, $6a, $d4, $b3, $7d, $fa, $ef, $c5, $91);
+
+{==============================================================================}
+type
+ PDWord = ^LongWord;
+
+procedure hperm_op(var a, t: integer; n, m: integer);
+begin
+ t:= ((a shl (16 - n)) xor a) and m;
+ a:= a xor t xor (t shr (16 - n));
+end;
+
+procedure perm_op(var a, b, t: integer; n, m: integer);
+begin
+ t:= ((a shr n) xor b) and m;
+ b:= b xor t;
+ a:= a xor (t shl n);
+end;
+
+{==============================================================================}
+function TSynaBlockCipher.GetSize: byte;
+begin
+ Result := 8;
+end;
+
+procedure TSynaBlockCipher.IncCounter;
+var
+ i: integer;
+begin
+ Inc(CV[GetSize]);
+ i:= GetSize -1;
+ while (i> 0) and (CV[i + 1] = #0) do
+ begin
+ Inc(CV[i]);
+ Dec(i);
+ end;
+end;
+
+procedure TSynaBlockCipher.Reset;
+begin
+ CV := IV;
+end;
+
+procedure TSynaBlockCipher.InitKey(Key: AnsiString);
+begin
+end;
+
+procedure TSynaBlockCipher.SetIV(const Value: AnsiString);
+begin
+ IV := PadString(Value, GetSize, #0);
+ Reset;
+end;
+
+function TSynaBlockCipher.GetIV: AnsiString;
+begin
+ Result := CV;
+end;
+
+function TSynaBlockCipher.EncryptECB(const InData: AnsiString): AnsiString;
+begin
+ Result := InData;
+end;
+
+function TSynaBlockCipher.DecryptECB(const InData: AnsiString): AnsiString;
+begin
+ Result := InData;
+end;
+
+function TSynaBlockCipher.EncryptCBC(const Indata: AnsiString): AnsiString;
+var
+ i: integer;
+ s: ansistring;
+ l: integer;
+ bs: byte;
+begin
+ Result := '';
+ l := Length(InData);
+ bs := GetSize;
+ for i:= 1 to (l div bs) do
+ begin
+ s := copy(Indata, (i - 1) * bs + 1, bs);
+ s := XorString(s, CV);
+ s := EncryptECB(s);
+ CV := s;
+ Result := Result + s;
+ end;
+ if (l mod bs)<> 0 then
+ begin
+ CV := EncryptECB(CV);
+ s := copy(Indata, (l div bs) * bs + 1, l mod bs);
+ s := XorString(s, CV);
+ Result := Result + s;
+ end;
+end;
+
+function TSynaBlockCipher.DecryptCBC(const Indata: AnsiString): AnsiString;
+var
+ i: integer;
+ s, temp: ansistring;
+ l: integer;
+ bs: byte;
+begin
+ Result := '';
+ l := Length(InData);
+ bs := GetSize;
+ for i:= 1 to (l div bs) do
+ begin
+ s := copy(Indata, (i - 1) * bs + 1, bs);
+ temp := s;
+ s := DecryptECB(s);
+ s := XorString(s, CV);
+ Result := Result + s;
+ CV := Temp;
+ end;
+ if (l mod bs)<> 0 then
+ begin
+ CV := EncryptECB(CV);
+ s := copy(Indata, (l div bs) * bs + 1, l mod bs);
+ s := XorString(s, CV);
+ Result := Result + s;
+ end;
+end;
+
+function TSynaBlockCipher.EncryptCFB8bit(const Indata: AnsiString): AnsiString;
+var
+ i: integer;
+ Temp: AnsiString;
+ c: AnsiChar;
+begin
+ Result := '';
+ for i:= 1 to Length(Indata) do
+ begin
+ Temp := EncryptECB(CV);
+ c := AnsiChar(ord(InData[i]) xor ord(temp[1]));
+ Result := Result + c;
+ Delete(CV, 1, 1);
+ CV := CV + c;
+ end;
+end;
+
+function TSynaBlockCipher.DecryptCFB8bit(const Indata: AnsiString): AnsiString;
+var
+ i: integer;
+ Temp: AnsiString;
+ c: AnsiChar;
+begin
+ Result := '';
+ for i:= 1 to length(Indata) do
+ begin
+ c:= Indata[i];
+ Temp := EncryptECB(CV);
+ Result := Result + AnsiChar(ord(InData[i]) xor ord(temp[1]));
+ Delete(CV, 1, 1);
+ CV := CV + c;
+ end;
+end;
+
+function TSynaBlockCipher.EncryptCFBblock(const Indata: AnsiString): AnsiString;
+var
+ i: integer;
+ s: AnsiString;
+ l: integer;
+ bs: byte;
+begin
+ Result := '';
+ l := Length(InData);
+ bs := GetSize;
+ for i:= 1 to (l div bs) do
+ begin
+ CV := EncryptECB(CV);
+ s := copy(Indata, (i - 1) * bs + 1, bs);
+ s := XorString(s, CV);
+ Result := Result + s;
+ CV := s;
+ end;
+ if (l mod bs)<> 0 then
+ begin
+ CV := EncryptECB(CV);
+ s := copy(Indata, (l div bs) * bs + 1, l mod bs);
+ s := XorString(s, CV);
+ Result := Result + s;
+ end;
+end;
+
+function TSynaBlockCipher.DecryptCFBblock(const Indata: AnsiString): AnsiString;
+var
+ i: integer;
+ S, Temp: AnsiString;
+ l: integer;
+ bs: byte;
+begin
+ Result := '';
+ l := Length(InData);
+ bs := GetSize;
+ for i:= 1 to (l div bs) do
+ begin
+ s := copy(Indata, (i - 1) * bs + 1, bs);
+ Temp := s;
+ CV := EncryptECB(CV);
+ s := XorString(s, CV);
+ Result := result + s;
+ CV := temp;
+ end;
+ if (l mod bs)<> 0 then
+ begin
+ CV := EncryptECB(CV);
+ s := copy(Indata, (l div bs) * bs + 1, l mod bs);
+ s := XorString(s, CV);
+ Result := Result + s;
+ end;
+end;
+
+function TSynaBlockCipher.EncryptOFB(const Indata: AnsiString): AnsiString;
+var
+ i: integer;
+ s: AnsiString;
+ l: integer;
+ bs: byte;
+begin
+ Result := '';
+ l := Length(InData);
+ bs := GetSize;
+ for i:= 1 to (l div bs) do
+ begin
+ CV := EncryptECB(CV);
+ s := copy(Indata, (i - 1) * bs + 1, bs);
+ s := XorString(s, CV);
+ Result := Result + s;
+ end;
+ if (l mod bs)<> 0 then
+ begin
+ CV := EncryptECB(CV);
+ s := copy(Indata, (l div bs) * bs + 1, l mod bs);
+ s := XorString(s, CV);
+ Result := Result + s;
+ end;
+end;
+
+function TSynaBlockCipher.DecryptOFB(const Indata: AnsiString): AnsiString;
+var
+ i: integer;
+ s: AnsiString;
+ l: integer;
+ bs: byte;
+begin
+ Result := '';
+ l := Length(InData);
+ bs := GetSize;
+ for i:= 1 to (l div bs) do
+ begin
+ Cv := EncryptECB(CV);
+ s := copy(Indata, (i - 1) * bs + 1, bs);
+ s := XorString(s, CV);
+ Result := Result + s;
+ end;
+ if (l mod bs)<> 0 then
+ begin
+ CV := EncryptECB(CV);
+ s := copy(Indata, (l div bs) * bs + 1, l mod bs);
+ s := XorString(s, CV);
+ Result := Result + s;
+ end;
+end;
+
+function TSynaBlockCipher.EncryptCTR(const Indata: AnsiString): AnsiString;
+var
+ temp: AnsiString;
+ i: integer;
+ s: AnsiString;
+ l: integer;
+ bs: byte;
+begin
+ Result := '';
+ l := Length(InData);
+ bs := GetSize;
+ for i:= 1 to (l div bs) do
+ begin
+ temp := EncryptECB(CV);
+ IncCounter;
+ s := copy(Indata, (i - 1) * bs + 1, bs);
+ s := XorString(s, temp);
+ Result := Result + s;
+ end;
+ if (l mod bs)<> 0 then
+ begin
+ temp := EncryptECB(CV);
+ IncCounter;
+ s := copy(Indata, (l div bs) * bs + 1, l mod bs);
+ s := XorString(s, temp);
+ Result := Result + s;
+ end;
+end;
+
+function TSynaBlockCipher.DecryptCTR(const Indata: AnsiString): AnsiString;
+var
+ temp: AnsiString;
+ s: AnsiString;
+ i: integer;
+ l: integer;
+ bs: byte;
+begin
+ Result := '';
+ l := Length(InData);
+ bs := GetSize;
+ for i:= 1 to (l div bs) do
+ begin
+ temp := EncryptECB(CV);
+ IncCounter;
+ s := copy(Indata, (i - 1) * bs + 1, bs);
+ s := XorString(s, temp);
+ Result := Result + s;
+ end;
+ if (l mod bs)<> 0 then
+ begin
+ temp := EncryptECB(CV);
+ IncCounter;
+ s := copy(Indata, (l div bs) * bs + 1, l mod bs);
+ s := XorString(s, temp);
+ Result := Result + s;
+ end;
+end;
+
+constructor TSynaBlockCipher.Create(Key: AnsiString);
+begin
+ inherited Create;
+ InitKey(Key);
+ IV := StringOfChar(#0, GetSize);
+ IV := EncryptECB(IV);
+ Reset;
+end;
+
+{==============================================================================}
+
+procedure TSynaCustomDes.DoInit(KeyB: AnsiString; var KeyData: TDesKeyData);
+var
+ c, d, t, s, t2, i: integer;
+begin
+ KeyB := PadString(KeyB, 8, #0);
+ c:= ord(KeyB[1]) or (ord(KeyB[2]) shl 8) or (ord(KeyB[3]) shl 16) or (ord(KeyB[4]) shl 24);
+ d:= ord(KeyB[5]) or (ord(KeyB[6]) shl 8) or (ord(KeyB[7]) shl 16) or (ord(KeyB[8]) shl 24);
+ perm_op(d,c,t,4,integer($0f0f0f0f));
+ hperm_op(c,t,integer(-2),integer($cccc0000));
+ hperm_op(d,t,integer(-2),integer($cccc0000));
+ perm_op(d,c,t,1,integer($55555555));
+ perm_op(c,d,t,8,integer($00ff00ff));
+ perm_op(d,c,t,1,integer($55555555));
+ d:= ((d and $ff) shl 16) or (d and $ff00) or ((d and $ff0000) shr 16) or
+ ((c and integer($f0000000)) shr 4);
+ c:= c and $fffffff;
+ for i:= 0 to 15 do
+ begin
+ if shifts2[i]<> 0 then
+ begin
+ c:= ((c shr 2) or (c shl 26));
+ d:= ((d shr 2) or (d shl 26));
+ end
+ else
+ begin
+ c:= ((c shr 1) or (c shl 27));
+ d:= ((d shr 1) or (d shl 27));
+ end;
+ c:= c and $fffffff;
+ d:= d and $fffffff;
+ s:= des_skb[0,c and $3f] or
+ des_skb[1,((c shr 6) and $03) or ((c shr 7) and $3c)] or
+ des_skb[2,((c shr 13) and $0f) or ((c shr 14) and $30)] or
+ des_skb[3,((c shr 20) and $01) or ((c shr 21) and $06) or ((c shr 22) and $38)];
+ t:= des_skb[4,d and $3f] or
+ des_skb[5,((d shr 7) and $03) or ((d shr 8) and $3c)] or
+ des_skb[6, (d shr 15) and $3f ] or
+ des_skb[7,((d shr 21) and $0f) or ((d shr 22) and $30)];
+ t2:= ((t shl 16) or (s and $ffff));
+ KeyData[(i shl 1)]:= ((t2 shl 2) or (t2 shr 30));
+ t2:= ((s shr 16) or (t and integer($ffff0000)));
+ KeyData[(i shl 1)+1]:= ((t2 shl 6) or (t2 shr 26));
+ end;
+end;
+
+function TSynaCustomDes.EncryptBlock(const InData: AnsiString; var KeyData: TDesKeyData): AnsiString;
+var
+ l, r, t, u: integer;
+ i: longint;
+begin
+ r := Swapbytes(DecodeLongint(Indata, 1));
+ l := swapbytes(DecodeLongint(Indata, 5));
+ t:= ((l shr 4) xor r) and $0f0f0f0f;
+ r:= r xor t;
+ l:= l xor (t shl 4);
+ t:= ((r shr 16) xor l) and $0000ffff;
+ l:= l xor t;
+ r:= r xor (t shl 16);
+ t:= ((l shr 2) xor r) and $33333333;
+ r:= r xor t;
+ l:= l xor (t shl 2);
+ t:= ((r shr 8) xor l) and $00ff00ff;
+ l:= l xor t;
+ r:= r xor (t shl 8);
+ t:= ((l shr 1) xor r) and $55555555;
+ r:= r xor t;
+ l:= l xor (t shl 1);
+ r:= (r shr 29) or (r shl 3);
+ l:= (l shr 29) or (l shl 3);
+ i:= 0;
+ while i< 32 do
+ begin
+ u:= r xor KeyData[i ];
+ t:= r xor KeyData[i+1];
+ t:= (t shr 4) or (t shl 28);
+ l:= l xor des_SPtrans[0,(u shr 2) and $3f] xor
+ des_SPtrans[2,(u shr 10) and $3f] xor
+ des_SPtrans[4,(u shr 18) and $3f] xor
+ des_SPtrans[6,(u shr 26) and $3f] xor
+ des_SPtrans[1,(t shr 2) and $3f] xor
+ des_SPtrans[3,(t shr 10) and $3f] xor
+ des_SPtrans[5,(t shr 18) and $3f] xor
+ des_SPtrans[7,(t shr 26) and $3f];
+ u:= l xor KeyData[i+2];
+ t:= l xor KeyData[i+3];
+ t:= (t shr 4) or (t shl 28);
+ r:= r xor des_SPtrans[0,(u shr 2) and $3f] xor
+ des_SPtrans[2,(u shr 10) and $3f] xor
+ des_SPtrans[4,(u shr 18) and $3f] xor
+ des_SPtrans[6,(u shr 26) and $3f] xor
+ des_SPtrans[1,(t shr 2) and $3f] xor
+ des_SPtrans[3,(t shr 10) and $3f] xor
+ des_SPtrans[5,(t shr 18) and $3f] xor
+ des_SPtrans[7,(t shr 26) and $3f];
+ u:= r xor KeyData[i+4];
+ t:= r xor KeyData[i+5];
+ t:= (t shr 4) or (t shl 28);
+ l:= l xor des_SPtrans[0,(u shr 2) and $3f] xor
+ des_SPtrans[2,(u shr 10) and $3f] xor
+ des_SPtrans[4,(u shr 18) and $3f] xor
+ des_SPtrans[6,(u shr 26) and $3f] xor
+ des_SPtrans[1,(t shr 2) and $3f] xor
+ des_SPtrans[3,(t shr 10) and $3f] xor
+ des_SPtrans[5,(t shr 18) and $3f] xor
+ des_SPtrans[7,(t shr 26) and $3f];
+ u:= l xor KeyData[i+6];
+ t:= l xor KeyData[i+7];
+ t:= (t shr 4) or (t shl 28);
+ r:= r xor des_SPtrans[0,(u shr 2) and $3f] xor
+ des_SPtrans[2,(u shr 10) and $3f] xor
+ des_SPtrans[4,(u shr 18) and $3f] xor
+ des_SPtrans[6,(u shr 26) and $3f] xor
+ des_SPtrans[1,(t shr 2) and $3f] xor
+ des_SPtrans[3,(t shr 10) and $3f] xor
+ des_SPtrans[5,(t shr 18) and $3f] xor
+ des_SPtrans[7,(t shr 26) and $3f];
+ Inc(i,8);
+ end;
+ r:= (r shr 3) or (r shl 29);
+ l:= (l shr 3) or (l shl 29);
+ t:= ((r shr 1) xor l) and $55555555;
+ l:= l xor t;
+ r:= r xor (t shl 1);
+ t:= ((l shr 8) xor r) and $00ff00ff;
+ r:= r xor t;
+ l:= l xor (t shl 8);
+ t:= ((r shr 2) xor l) and $33333333;
+ l:= l xor t;
+ r:= r xor (t shl 2);
+ t:= ((l shr 16) xor r) and $0000ffff;
+ r:= r xor t;
+ l:= l xor (t shl 16);
+ t:= ((r shr 4) xor l) and $0f0f0f0f;
+ l:= l xor t;
+ r:= r xor (t shl 4);
+ Result := CodeLongInt(Swapbytes(l)) + CodeLongInt(Swapbytes(r));
+end;
+
+function TSynaCustomDes.DecryptBlock(const InData: AnsiString; var KeyData: TDesKeyData): AnsiString;
+var
+ l, r, t, u: integer;
+ i: longint;
+begin
+ r := Swapbytes(DecodeLongint(Indata, 1));
+ l := Swapbytes(DecodeLongint(Indata, 5));
+ t:= ((l shr 4) xor r) and $0f0f0f0f;
+ r:= r xor t;
+ l:= l xor (t shl 4);
+ t:= ((r shr 16) xor l) and $0000ffff;
+ l:= l xor t;
+ r:= r xor (t shl 16);
+ t:= ((l shr 2) xor r) and $33333333;
+ r:= r xor t;
+ l:= l xor (t shl 2);
+ t:= ((r shr 8) xor l) and $00ff00ff;
+ l:= l xor t;
+ r:= r xor (t shl 8);
+ t:= ((l shr 1) xor r) and $55555555;
+ r:= r xor t;
+ l:= l xor (t shl 1);
+ r:= (r shr 29) or (r shl 3);
+ l:= (l shr 29) or (l shl 3);
+ i:= 30;
+ while i> 0 do
+ begin
+ u:= r xor KeyData[i ];
+ t:= r xor KeyData[i+1];
+ t:= (t shr 4) or (t shl 28);
+ l:= l xor des_SPtrans[0,(u shr 2) and $3f] xor
+ des_SPtrans[2,(u shr 10) and $3f] xor
+ des_SPtrans[4,(u shr 18) and $3f] xor
+ des_SPtrans[6,(u shr 26) and $3f] xor
+ des_SPtrans[1,(t shr 2) and $3f] xor
+ des_SPtrans[3,(t shr 10) and $3f] xor
+ des_SPtrans[5,(t shr 18) and $3f] xor
+ des_SPtrans[7,(t shr 26) and $3f];
+ u:= l xor KeyData[i-2];
+ t:= l xor KeyData[i-1];
+ t:= (t shr 4) or (t shl 28);
+ r:= r xor des_SPtrans[0,(u shr 2) and $3f] xor
+ des_SPtrans[2,(u shr 10) and $3f] xor
+ des_SPtrans[4,(u shr 18) and $3f] xor
+ des_SPtrans[6,(u shr 26) and $3f] xor
+ des_SPtrans[1,(t shr 2) and $3f] xor
+ des_SPtrans[3,(t shr 10) and $3f] xor
+ des_SPtrans[5,(t shr 18) and $3f] xor
+ des_SPtrans[7,(t shr 26) and $3f];
+ u:= r xor KeyData[i-4];
+ t:= r xor KeyData[i-3];
+ t:= (t shr 4) or (t shl 28);
+ l:= l xor des_SPtrans[0,(u shr 2) and $3f] xor
+ des_SPtrans[2,(u shr 10) and $3f] xor
+ des_SPtrans[4,(u shr 18) and $3f] xor
+ des_SPtrans[6,(u shr 26) and $3f] xor
+ des_SPtrans[1,(t shr 2) and $3f] xor
+ des_SPtrans[3,(t shr 10) and $3f] xor
+ des_SPtrans[5,(t shr 18) and $3f] xor
+ des_SPtrans[7,(t shr 26) and $3f];
+ u:= l xor KeyData[i-6];
+ t:= l xor KeyData[i-5];
+ t:= (t shr 4) or (t shl 28);
+ r:= r xor des_SPtrans[0,(u shr 2) and $3f] xor
+ des_SPtrans[2,(u shr 10) and $3f] xor
+ des_SPtrans[4,(u shr 18) and $3f] xor
+ des_SPtrans[6,(u shr 26) and $3f] xor
+ des_SPtrans[1,(t shr 2) and $3f] xor
+ des_SPtrans[3,(t shr 10) and $3f] xor
+ des_SPtrans[5,(t shr 18) and $3f] xor
+ des_SPtrans[7,(t shr 26) and $3f];
+ Dec(i,8);
+ end;
+ r:= (r shr 3) or (r shl 29);
+ l:= (l shr 3) or (l shl 29);
+ t:= ((r shr 1) xor l) and $55555555;
+ l:= l xor t;
+ r:= r xor (t shl 1);
+ t:= ((l shr 8) xor r) and $00ff00ff;
+ r:= r xor t;
+ l:= l xor (t shl 8);
+ t:= ((r shr 2) xor l) and $33333333;
+ l:= l xor t;
+ r:= r xor (t shl 2);
+ t:= ((l shr 16) xor r) and $0000ffff;
+ r:= r xor t;
+ l:= l xor (t shl 16);
+ t:= ((r shr 4) xor l) and $0f0f0f0f;
+ l:= l xor t;
+ r:= r xor (t shl 4);
+ Result := CodeLongInt(Swapbytes(l)) + CodeLongInt(Swapbytes(r));
+end;
+
+{==============================================================================}
+
+procedure TSynaDes.InitKey(Key: AnsiString);
+begin
+ Key := PadString(Key, 8, #0);
+ DoInit(Key,KeyData);
+end;
+
+function TSynaDes.EncryptECB(const InData: AnsiString): AnsiString;
+begin
+ Result := EncryptBlock(InData,KeyData);
+end;
+
+function TSynaDes.DecryptECB(const InData: AnsiString): AnsiString;
+begin
+ Result := DecryptBlock(Indata,KeyData);
+end;
+
+{==============================================================================}
+
+procedure TSyna3Des.InitKey(Key: AnsiString);
+var
+ Size: integer;
+ n: integer;
+begin
+ Size := length(Key);
+ key := PadString(key, 3 * 8, #0);
+ DoInit(Copy(key, 1, 8),KeyData[0]);
+ DoInit(Copy(key, 9, 8),KeyData[1]);
+ if Size > 16 then
+ DoInit(Copy(key, 17, 8),KeyData[2])
+ else
+ for n := 0 to high(KeyData[0]) do
+ KeyData[2][n] := Keydata[0][n];
+end;
+
+function TSyna3Des.EncryptECB(const InData: AnsiString): AnsiString;
+begin
+ Result := EncryptBlock(Indata,KeyData[0]);
+ Result := DecryptBlock(Result,KeyData[1]);
+ Result := EncryptBlock(Result,KeyData[2]);
+end;
+
+function TSyna3Des.DecryptECB(const InData: AnsiString): AnsiString;
+begin
+ Result := DecryptBlock(InData,KeyData[2]);
+ Result := EncryptBlock(Result,KeyData[1]);
+ Result := DecryptBlock(Result,KeyData[0]);
+end;
+
+{==============================================================================}
+
+procedure InvMixColumn(a: PByteArray; BC: byte);
+var
+ j: longword;
+begin
+ for j:= 0 to (BC-1) do
+ PDWord(@(a^[j*4]))^:= PDWord(@U1[a^[j*4+0]])^
+ xor PDWord(@U2[a^[j*4+1]])^
+ xor PDWord(@U3[a^[j*4+2]])^
+ xor PDWord(@U4[a^[j*4+3]])^;
+end;
+
+{==============================================================================}
+
+function TSynaAes.GetSize: byte;
+begin
+ Result := 16;
+end;
+
+procedure TSynaAes.InitKey(Key: AnsiString);
+var
+ Size: integer;
+ KC, ROUNDS, j, r, t, rconpointer: longword;
+ tk: array[0..MAXKC-1,0..3] of byte;
+ n: integer;
+begin
+ FillChar(tk,Sizeof(tk),0);
+ //key must have at least 128 bits and max 256 bits
+ if length(key) < 16 then
+ key := PadString(key, 16, #0);
+ if length(key) > 32 then
+ delete(key, 33, maxint);
+ Size := length(Key);
+ Move(PAnsiChar(Key)^, tk, Size);
+ if Size<= 16 then
+ begin
+ KC:= 4;
+ Rounds:= 10;
+ end
+ else if Size<= 24 then
+ begin
+ KC:= 6;
+ Rounds:= 12;
+ end
+ else
+ begin
+ KC:= 8;
+ Rounds:= 14;
+ end;
+ numrounds:= rounds;
+ r:= 0;
+ t:= 0;
+ j:= 0;
+ while (j< KC) and (r< (rounds+1)) do
+ begin
+ while (j< KC) and (t< BC) do
+ begin
+ rk[r,t]:= PDWord(@tk[j])^;
+ Inc(j);
+ Inc(t);
+ end;
+ if t= BC then
+ begin
+ t:= 0;
+ Inc(r);
+ end;
+ end;
+ rconpointer:= 0;
+ while (r< (rounds+1)) do
+ begin
+ tk[0,0]:= tk[0,0] xor S[tk[KC-1,1]];
+ tk[0,1]:= tk[0,1] xor S[tk[KC-1,2]];
+ tk[0,2]:= tk[0,2] xor S[tk[KC-1,3]];
+ tk[0,3]:= tk[0,3] xor S[tk[KC-1,0]];
+ tk[0,0]:= tk[0,0] xor rcon[rconpointer];
+ Inc(rconpointer);
+ if KC<> 8 then
+ begin
+ for j:= 1 to (KC-1) do
+ PDWord(@tk[j])^:= PDWord(@tk[j])^ xor PDWord(@tk[j-1])^;
+ end
+ else
+ begin
+ for j:= 1 to ((KC div 2)-1) do
+ PDWord(@tk[j])^:= PDWord(@tk[j])^ xor PDWord(@tk[j-1])^;
+ tk[KC div 2,0]:= tk[KC div 2,0] xor S[tk[KC div 2 - 1,0]];
+ tk[KC div 2,1]:= tk[KC div 2,1] xor S[tk[KC div 2 - 1,1]];
+ tk[KC div 2,2]:= tk[KC div 2,2] xor S[tk[KC div 2 - 1,2]];
+ tk[KC div 2,3]:= tk[KC div 2,3] xor S[tk[KC div 2 - 1,3]];
+ for j:= ((KC div 2) + 1) to (KC-1) do
+ PDWord(@tk[j])^:= PDWord(@tk[j])^ xor PDWord(@tk[j-1])^;
+ end;
+ j:= 0;
+ while (j< KC) and (r< (rounds+1)) do
+ begin
+ while (j< KC) and (t< BC) do
+ begin
+ rk[r,t]:= PDWord(@tk[j])^;
+ Inc(j);
+ Inc(t);
+ end;
+ if t= BC then
+ begin
+ Inc(r);
+ t:= 0;
+ end;
+ end;
+ end;
+ Move(rk,drk,Sizeof(rk));
+ for r:= 1 to (numrounds-1) do
+ InvMixColumn(@drk[r],BC);
+end;
+
+function TSynaAes.EncryptECB(const InData: AnsiString): AnsiString;
+var
+ r: longword;
+ tempb: array[0..MAXBC-1,0..3] of byte;
+ a: array[0..MAXBC,0..3] of byte;
+ p: pointer;
+begin
+ p := @a[0,0];
+ move(pointer(InData)^, p^, 16);
+ for r:= 0 to (numrounds-2) do
+ begin
+ PDWord(@tempb[0])^:= PDWord(@a[0])^ xor rk[r,0];
+ PDWord(@tempb[1])^:= PDWord(@a[1])^ xor rk[r,1];
+ PDWord(@tempb[2])^:= PDWord(@a[2])^ xor rk[r,2];
+ PDWord(@tempb[3])^:= PDWord(@a[3])^ xor rk[r,3];
+ PDWord(@a[0])^:= PDWord(@T1[tempb[0,0]])^ xor
+ PDWord(@T2[tempb[1,1]])^ xor
+ PDWord(@T3[tempb[2,2]])^ xor
+ PDWord(@T4[tempb[3,3]])^;
+ PDWord(@a[1])^:= PDWord(@T1[tempb[1,0]])^ xor
+ PDWord(@T2[tempb[2,1]])^ xor
+ PDWord(@T3[tempb[3,2]])^ xor
+ PDWord(@T4[tempb[0,3]])^;
+ PDWord(@a[2])^:= PDWord(@T1[tempb[2,0]])^ xor
+ PDWord(@T2[tempb[3,1]])^ xor
+ PDWord(@T3[tempb[0,2]])^ xor
+ PDWord(@T4[tempb[1,3]])^;
+ PDWord(@a[3])^:= PDWord(@T1[tempb[3,0]])^ xor
+ PDWord(@T2[tempb[0,1]])^ xor
+ PDWord(@T3[tempb[1,2]])^ xor
+ PDWord(@T4[tempb[2,3]])^;
+ end;
+ PDWord(@tempb[0])^:= PDWord(@a[0])^ xor rk[numrounds-1,0];
+ PDWord(@tempb[1])^:= PDWord(@a[1])^ xor rk[numrounds-1,1];
+ PDWord(@tempb[2])^:= PDWord(@a[2])^ xor rk[numrounds-1,2];
+ PDWord(@tempb[3])^:= PDWord(@a[3])^ xor rk[numrounds-1,3];
+ a[0,0]:= T1[tempb[0,0],1];
+ a[0,1]:= T1[tempb[1,1],1];
+ a[0,2]:= T1[tempb[2,2],1];
+ a[0,3]:= T1[tempb[3,3],1];
+ a[1,0]:= T1[tempb[1,0],1];
+ a[1,1]:= T1[tempb[2,1],1];
+ a[1,2]:= T1[tempb[3,2],1];
+ a[1,3]:= T1[tempb[0,3],1];
+ a[2,0]:= T1[tempb[2,0],1];
+ a[2,1]:= T1[tempb[3,1],1];
+ a[2,2]:= T1[tempb[0,2],1];
+ a[2,3]:= T1[tempb[1,3],1];
+ a[3,0]:= T1[tempb[3,0],1];
+ a[3,1]:= T1[tempb[0,1],1];
+ a[3,2]:= T1[tempb[1,2],1];
+ a[3,3]:= T1[tempb[2,3],1];
+ PDWord(@a[0])^:= PDWord(@a[0])^ xor rk[numrounds,0];
+ PDWord(@a[1])^:= PDWord(@a[1])^ xor rk[numrounds,1];
+ PDWord(@a[2])^:= PDWord(@a[2])^ xor rk[numrounds,2];
+ PDWord(@a[3])^:= PDWord(@a[3])^ xor rk[numrounds,3];
+
+ Result := StringOfChar(#0, 16);
+ move(p^, pointer(Result)^, 16);
+end;
+
+function TSynaAes.DecryptECB(const InData: AnsiString): AnsiString;
+var
+ r: longword;
+ tempb: array[0..MAXBC-1,0..3] of byte;
+ a: array[0..MAXBC,0..3] of byte;
+ p: pointer;
+begin
+ p := @a[0,0];
+ move(pointer(InData)^, p^, 16);
+ for r:= NumRounds downto 2 do
+ begin
+ PDWord(@tempb[0])^:= PDWord(@a[0])^ xor drk[r,0];
+ PDWord(@tempb[1])^:= PDWord(@a[1])^ xor drk[r,1];
+ PDWord(@tempb[2])^:= PDWord(@a[2])^ xor drk[r,2];
+ PDWord(@tempb[3])^:= PDWord(@a[3])^ xor drk[r,3];
+ PDWord(@a[0])^:= PDWord(@T5[tempb[0,0]])^ xor
+ PDWord(@T6[tempb[3,1]])^ xor
+ PDWord(@T7[tempb[2,2]])^ xor
+ PDWord(@T8[tempb[1,3]])^;
+ PDWord(@a[1])^:= PDWord(@T5[tempb[1,0]])^ xor
+ PDWord(@T6[tempb[0,1]])^ xor
+ PDWord(@T7[tempb[3,2]])^ xor
+ PDWord(@T8[tempb[2,3]])^;
+ PDWord(@a[2])^:= PDWord(@T5[tempb[2,0]])^ xor
+ PDWord(@T6[tempb[1,1]])^ xor
+ PDWord(@T7[tempb[0,2]])^ xor
+ PDWord(@T8[tempb[3,3]])^;
+ PDWord(@a[3])^:= PDWord(@T5[tempb[3,0]])^ xor
+ PDWord(@T6[tempb[2,1]])^ xor
+ PDWord(@T7[tempb[1,2]])^ xor
+ PDWord(@T8[tempb[0,3]])^;
+ end;
+ PDWord(@tempb[0])^:= PDWord(@a[0])^ xor drk[1,0];
+ PDWord(@tempb[1])^:= PDWord(@a[1])^ xor drk[1,1];
+ PDWord(@tempb[2])^:= PDWord(@a[2])^ xor drk[1,2];
+ PDWord(@tempb[3])^:= PDWord(@a[3])^ xor drk[1,3];
+ a[0,0]:= S5[tempb[0,0]];
+ a[0,1]:= S5[tempb[3,1]];
+ a[0,2]:= S5[tempb[2,2]];
+ a[0,3]:= S5[tempb[1,3]];
+ a[1,0]:= S5[tempb[1,0]];
+ a[1,1]:= S5[tempb[0,1]];
+ a[1,2]:= S5[tempb[3,2]];
+ a[1,3]:= S5[tempb[2,3]];
+ a[2,0]:= S5[tempb[2,0]];
+ a[2,1]:= S5[tempb[1,1]];
+ a[2,2]:= S5[tempb[0,2]];
+ a[2,3]:= S5[tempb[3,3]];
+ a[3,0]:= S5[tempb[3,0]];
+ a[3,1]:= S5[tempb[2,1]];
+ a[3,2]:= S5[tempb[1,2]];
+ a[3,3]:= S5[tempb[0,3]];
+ PDWord(@a[0])^:= PDWord(@a[0])^ xor drk[0,0];
+ PDWord(@a[1])^:= PDWord(@a[1])^ xor drk[0,1];
+ PDWord(@a[2])^:= PDWord(@a[2])^ xor drk[0,2];
+ PDWord(@a[3])^:= PDWord(@a[3])^ xor drk[0,3];
+ Result := StringOfChar(#0, 16);
+ move(p^, pointer(Result)^, 16);
+end;
+
+{==============================================================================}
+
+function TestDes: boolean;
+var
+ des: TSynaDes;
+ s, t: string;
+const
+ key = '01234567';
+ data1= '01234567';
+ data2= '0123456789abcdefghij';
+begin
+ //ECB
+ des := TSynaDes.Create(key);
+ try
+ s := des.EncryptECB(data1);
+ t := strtohex(s);
+ result := t = 'c50ad028c6da9800';
+ s := des.DecryptECB(s);
+ result := result and (data1 = s);
+ finally
+ des.free;
+ end;
+ //CBC
+ des := TSynaDes.Create(key);
+ try
+ s := des.EncryptCBC(data2);
+ t := strtohex(s);
+ result := result and (t = 'eec50f6353115ad6dee90a22ed1b6a88a0926e35');
+ des.Reset;
+ s := des.DecryptCBC(s);
+ result := result and (data2 = s);
+ finally
+ des.free;
+ end;
+ //CFB-8bit
+ des := TSynaDes.Create(key);
+ try
+ s := des.EncryptCFB8bit(data2);
+ t := strtohex(s);
+ result := result and (t = 'eb6aa12c2f0ff634b4dfb6da6cb2af8f9c5c1452');
+ des.Reset;
+ s := des.DecryptCFB8bit(s);
+ result := result and (data2 = s);
+ finally
+ des.free;
+ end;
+ //CFB-block
+ des := TSynaDes.Create(key);
+ try
+ s := des.EncryptCFBblock(data2);
+ t := strtohex(s);
+ result := result and (t = 'ebdbbaa7f9286cdec28605e07f9b7f3be1053257');
+ des.Reset;
+ s := des.DecryptCFBblock(s);
+ result := result and (data2 = s);
+ finally
+ des.free;
+ end;
+ //OFB
+ des := TSynaDes.Create(key);
+ try
+ s := des.EncryptOFB(data2);
+ t := strtohex(s);
+ result := result and (t = 'ebdbbaa7f9286cdee0b8b3798c4c34baac87dbdc');
+ des.Reset;
+ s := des.DecryptOFB(s);
+ result := result and (data2 = s);
+ finally
+ des.free;
+ end;
+ //CTR
+ des := TSynaDes.Create(key);
+ try
+ s := des.EncryptCTR(data2);
+ t := strtohex(s);
+ result := result and (t = 'ebdbbaa7f9286cde0dd20b45f3afd9aa1b91b87e');
+ des.Reset;
+ s := des.DecryptCTR(s);
+ result := result and (data2 = s);
+ finally
+ des.free;
+ end;
+end;
+
+function Test3Des: boolean;
+var
+ des: TSyna3Des;
+ s, t: string;
+const
+ key = '0123456789abcdefghijklmn';
+ data1= '01234567';
+ data2= '0123456789abcdefghij';
+begin
+ //ECB
+ des := TSyna3Des.Create(key);
+ try
+ s := des.EncryptECB(data1);
+ t := strtohex(s);
+ result := t = 'e0dee91008dc460c';
+ s := des.DecryptECB(s);
+ result := result and (data1 = s);
+ finally
+ des.free;
+ end;
+ //CBC
+ des := TSyna3Des.Create(key);
+ try
+ s := des.EncryptCBC(data2);
+ t := strtohex(s);
+ result := result and (t = 'ee844a2a4f49c01b91a1599b8eba29128c1ad87a');
+ des.Reset;
+ s := des.DecryptCBC(s);
+ result := result and (data2 = s);
+ finally
+ des.free;
+ end;
+ //CFB-8bit
+ des := TSyna3Des.Create(key);
+ try
+ s := des.EncryptCFB8bit(data2);
+ t := strtohex(s);
+ result := result and (t = '935bbf5210c32cfa1faf61f91e8dc02dfa0ff1e8');
+ des.Reset;
+ s := des.DecryptCFB8bit(s);
+ result := result and (data2 = s);
+ finally
+ des.free;
+ end;
+ //CFB-block
+ des := TSyna3Des.Create(key);
+ try
+ s := des.EncryptCFBblock(data2);
+ t := strtohex(s);
+ result := result and (t = '93754e3d54828fbf4bd81f1739419e8d2cfe1671');
+ des.Reset;
+ s := des.DecryptCFBblock(s);
+ result := result and (data2 = s);
+ finally
+ des.free;
+ end;
+ //OFB
+ des := TSyna3Des.Create(key);
+ try
+ s := des.EncryptOFB(data2);
+ t := strtohex(s);
+ result := result and (t = '93754e3d54828fbf04ef0a5efc926ebdf2d95f20');
+ des.Reset;
+ s := des.DecryptOFB(s);
+ result := result and (data2 = s);
+ finally
+ des.free;
+ end;
+ //CTR
+ des := TSyna3Des.Create(key);
+ try
+ s := des.EncryptCTR(data2);
+ t := strtohex(s);
+ result := result and (t = '93754e3d54828fbf1c51a121d2c93f989e70b3ad');
+ des.Reset;
+ s := des.DecryptCTR(s);
+ result := result and (data2 = s);
+ finally
+ des.free;
+ end;
+end;
+
+function TestAes: boolean;
+var
+ aes: TSynaAes;
+ s, t: string;
+const
+ key1 = #$00#$01#$02#$03#$05#$06#$07#$08#$0A#$0B#$0C#$0D#$0F#$10#$11#$12;
+ data1= #$50#$68#$12#$A4#$5F#$08#$C8#$89#$B9#$7F#$59#$80#$03#$8B#$83#$59;
+ key2 = #$A0#$A1#$A2#$A3#$A5#$A6#$A7#$A8#$AA#$AB#$AC#$AD#$AF#$B0#$B1#$B2#$B4#$B5#$B6#$B7#$B9#$BA#$BB#$BC;
+ data2= #$4F#$1C#$76#$9D#$1E#$5B#$05#$52#$C7#$EC#$A8#$4D#$EA#$26#$A5#$49;
+ key3 = #$00#$01#$02#$03#$05#$06#$07#$08#$0A#$0B#$0C#$0D#$0F#$10#$11#$12#$14#$15#$16#$17#$19#$1A#$1B#$1C#$1E#$1F#$20#$21#$23#$24#$25#$26;
+ data3= #$5E#$25#$CA#$78#$F0#$DE#$55#$80#$25#$24#$D3#$8D#$A3#$FE#$44#$56;
+begin
+ //ECB
+ aes := TSynaAes.Create(key1);
+ try
+ t := aes.EncryptECB(data1);
+ result := t = #$D8#$F5#$32#$53#$82#$89#$EF#$7D#$06#$B5#$06#$A4#$FD#$5B#$E9#$C9;
+ s := aes.DecryptECB(t);
+ result := result and (data1 = s);
+ finally
+ aes.free;
+ end;
+ aes := TSynaAes.Create(key2);
+ try
+ t := aes.EncryptECB(data2);
+ result := result and (t = #$F3#$84#$72#$10#$D5#$39#$1E#$23#$60#$60#$8E#$5A#$CB#$56#$05#$81);
+ s := aes.DecryptECB(t);
+ result := result and (data2 = s);
+ finally
+ aes.free;
+ end;
+ aes := TSynaAes.Create(key3);
+ try
+ t := aes.EncryptECB(data3);
+ result := result and (t = #$E8#$B7#$2B#$4E#$8B#$E2#$43#$43#$8C#$9F#$FF#$1F#$0E#$20#$58#$72);
+ s := aes.DecryptECB(t);
+ result := result and (data3 = s);
+ finally
+ aes.free;
+ end;
+end;
+
+{==============================================================================}
+
+end.
ADDED lib/synapse/source/lib/synadbg.pas
Index: lib/synapse/source/lib/synadbg.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/lib/synadbg.pas
@@ -0,0 +1,156 @@
+{==============================================================================|
+| Project : Ararat Synapse | 001.001.002 |
+|==============================================================================|
+| Content: Socket debug tools |
+|==============================================================================|
+| Copyright (c)2008-2011, Lukas Gebauer |
+| All rights reserved. |
+| |
+| Redistribution and use in source and binary forms, with or without |
+| modification, are permitted provided that the following conditions are met: |
+| |
+| Redistributions of source code must retain the above copyright notice, this |
+| list of conditions and the following disclaimer. |
+| |
+| Redistributions in binary form must reproduce the above copyright notice, |
+| this list of conditions and the following disclaimer in the documentation |
+| and/or other materials provided with the distribution. |
+| |
+| Neither the name of Lukas Gebauer nor the names of its contributors may |
+| be used to endorse or promote products derived from this software without |
+| specific prior written permission. |
+| |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
+| DAMAGE. |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2008-2011. |
+| All Rights Reserved. |
+|==============================================================================|
+| Contributor(s): |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package |
+| (Found at URL: http://www.ararat.cz/synapse/) |
+|==============================================================================}
+
+{:@abstract(Socket debug tools)
+
+Routines for help with debugging of events on the Sockets.
+}
+
+{$IFDEF UNICODE}
+ {$WARN IMPLICIT_STRING_CAST OFF}
+ {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+unit synadbg;
+
+interface
+
+uses
+ blcksock, synsock, synautil, classes, sysutils, synafpc;
+
+type
+ TSynaDebug = class(TObject)
+ class procedure HookStatus(Sender: TObject; Reason: THookSocketReason; const Value: string);
+ class procedure HookMonitor(Sender: TObject; Writing: Boolean; const Buffer: TMemory; Len: Integer);
+ end;
+
+procedure AppendToLog(const value: Ansistring);
+
+var
+ LogFile: string;
+
+implementation
+
+procedure AppendToLog(const value: Ansistring);
+var
+ st: TFileStream;
+ s: string;
+ h, m, ss, ms: word;
+ dt: Tdatetime;
+begin
+ if fileexists(LogFile) then
+ st := TFileStream.Create(LogFile, fmOpenReadWrite or fmShareDenyWrite)
+ else
+ st := TFileStream.Create(LogFile, fmCreate or fmShareDenyWrite);
+ try
+ st.Position := st.Size;
+ dt := now;
+ decodetime(dt, h, m, ss, ms);
+ s := formatdatetime('yyyymmdd-hhnnss', dt) + format('.%.3d', [ms]) + ' ' + value;
+ WriteStrToStream(st, s);
+ finally
+ st.free;
+ end;
+end;
+
+class procedure TSynaDebug.HookStatus(Sender: TObject; Reason: THookSocketReason; const Value: string);
+var
+ s: string;
+begin
+ case Reason of
+ HR_ResolvingBegin:
+ s := 'HR_ResolvingBegin';
+ HR_ResolvingEnd:
+ s := 'HR_ResolvingEnd';
+ HR_SocketCreate:
+ s := 'HR_SocketCreate';
+ HR_SocketClose:
+ s := 'HR_SocketClose';
+ HR_Bind:
+ s := 'HR_Bind';
+ HR_Connect:
+ s := 'HR_Connect';
+ HR_CanRead:
+ s := 'HR_CanRead';
+ HR_CanWrite:
+ s := 'HR_CanWrite';
+ HR_Listen:
+ s := 'HR_Listen';
+ HR_Accept:
+ s := 'HR_Accept';
+ HR_ReadCount:
+ s := 'HR_ReadCount';
+ HR_WriteCount:
+ s := 'HR_WriteCount';
+ HR_Wait:
+ s := 'HR_Wait';
+ HR_Error:
+ s := 'HR_Error';
+ else
+ s := '-unknown-';
+ end;
+ s := inttohex(PtrInt(Sender), 8) + s + ': ' + value + CRLF;
+ AppendToLog(s);
+end;
+
+class procedure TSynaDebug.HookMonitor(Sender: TObject; Writing: Boolean; const Buffer: TMemory; Len: Integer);
+var
+ s, d: Ansistring;
+begin
+ setlength(s, len);
+ move(Buffer^, pointer(s)^, len);
+ if writing then
+ d := '-> '
+ else
+ d := '<- ';
+ s :=inttohex(PtrInt(Sender), 8) + d + s + CRLF;
+ AppendToLog(s);
+end;
+
+initialization
+begin
+ Logfile := changefileext(paramstr(0), '.slog');
+end;
+
+end.
ADDED lib/synapse/source/lib/synafpc.pas
Index: lib/synapse/source/lib/synafpc.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/lib/synafpc.pas
@@ -0,0 +1,141 @@
+{==============================================================================|
+| Project : Ararat Synapse | 001.002.000 |
+|==============================================================================|
+| Content: Utils for FreePascal compatibility |
+|==============================================================================|
+| Copyright (c)1999-2011, Lukas Gebauer |
+| All rights reserved. |
+| |
+| Redistribution and use in source and binary forms, with or without |
+| modification, are permitted provided that the following conditions are met: |
+| |
+| Redistributions of source code must retain the above copyright notice, this |
+| list of conditions and the following disclaimer. |
+| |
+| Redistributions in binary form must reproduce the above copyright notice, |
+| this list of conditions and the following disclaimer in the documentation |
+| and/or other materials provided with the distribution. |
+| |
+| Neither the name of Lukas Gebauer nor the names of its contributors may |
+| be used to endorse or promote products derived from this software without |
+| specific prior written permission. |
+| |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
+| DAMAGE. |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2003-2011. |
+| All Rights Reserved. |
+|==============================================================================|
+| Contributor(s): |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package |
+| (Found at URL: http://www.ararat.cz/synapse/) |
+|==============================================================================}
+
+{:@exclude}
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+//old Delphi does not have MSWINDOWS define.
+{$IFDEF WIN32}
+ {$IFNDEF MSWINDOWS}
+ {$DEFINE MSWINDOWS}
+ {$ENDIF}
+{$ENDIF}
+
+unit synafpc;
+
+interface
+
+uses
+{$IFDEF FPC}
+ dynlibs, sysutils;
+{$ELSE}
+ {$IFDEF MSWINDOWS}
+ Windows;
+ {$ELSE}
+ SysUtils;
+ {$ENDIF}
+{$ENDIF}
+
+{$IFDEF FPC}
+type
+ TLibHandle = dynlibs.TLibHandle;
+
+function LoadLibrary(ModuleName: PChar): TLibHandle;
+function FreeLibrary(Module: TLibHandle): LongBool;
+function GetProcAddress(Module: TLibHandle; Proc: PChar): Pointer;
+function GetModuleFileName(Module: TLibHandle; Buffer: PChar; BufLen: Integer): Integer;
+{$ELSE}
+type
+ {$IFDEF CIL}
+ TLibHandle = Integer;
+ PtrInt = Integer;
+ {$ELSE}
+ TLibHandle = HModule;
+ {$IFNDEF WIN64}
+ PtrInt = Integer;
+ {$ENDIF}
+ {$ENDIF}
+ {$IFDEF VER100}
+ LongWord = DWord;
+ {$ENDIF}
+{$ENDIF}
+
+procedure Sleep(milliseconds: Cardinal);
+
+
+implementation
+
+{==============================================================================}
+{$IFDEF FPC}
+function LoadLibrary(ModuleName: PChar): TLibHandle;
+begin
+ Result := dynlibs.LoadLibrary(Modulename);
+end;
+
+function FreeLibrary(Module: TLibHandle): LongBool;
+begin
+ Result := dynlibs.UnloadLibrary(Module);
+end;
+
+function GetProcAddress(Module: TLibHandle; Proc: PChar): Pointer;
+begin
+ Result := dynlibs.GetProcedureAddress(Module, Proc);
+end;
+
+function GetModuleFileName(Module: TLibHandle; Buffer: PChar; BufLen: Integer): Integer;
+begin
+ Result := 0;
+end;
+
+{$ELSE}
+{$ENDIF}
+
+procedure Sleep(milliseconds: Cardinal);
+begin
+{$IFDEF MSWINDOWS}
+ {$IFDEF FPC}
+ sysutils.sleep(milliseconds);
+ {$ELSE}
+ windows.sleep(milliseconds);
+ {$ENDIF}
+{$ELSE}
+ sysutils.sleep(milliseconds);
+{$ENDIF}
+
+end;
+
+end.
ADDED lib/synapse/source/lib/synaicnv.pas
Index: lib/synapse/source/lib/synaicnv.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/lib/synaicnv.pas
@@ -0,0 +1,363 @@
+{==============================================================================|
+| Project : Ararat Synapse | 001.001.001 |
+|==============================================================================|
+| Content: ICONV support for Win32, Linux and .NET |
+|==============================================================================|
+| Copyright (c)2004-2010, Lukas Gebauer |
+| All rights reserved. |
+| |
+| Redistribution and use in source and binary forms, with or without |
+| modification, are permitted provided that the following conditions are met: |
+| |
+| Redistributions of source code must retain the above copyright notice, this |
+| list of conditions and the following disclaimer. |
+| |
+| Redistributions in binary form must reproduce the above copyright notice, |
+| this list of conditions and the following disclaimer in the documentation |
+| and/or other materials provided with the distribution. |
+| |
+| Neither the name of Lukas Gebauer nor the names of its contributors may |
+| be used to endorse or promote products derived from this software without |
+| specific prior written permission. |
+| |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
+| DAMAGE. |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2004-2010. |
+| All Rights Reserved. |
+|==============================================================================|
+| Contributor(s): |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package |
+| (Found at URL: http://www.ararat.cz/synapse/) |
+|==============================================================================}
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+//old Delphi does not have MSWINDOWS define.
+{$IFDEF WIN32}
+ {$IFNDEF MSWINDOWS}
+ {$DEFINE MSWINDOWS}
+ {$ENDIF}
+{$ENDIF}
+
+{:@abstract(LibIconv support)
+
+This unit is Pascal interface to LibIconv library for charset translations.
+LibIconv is loaded dynamicly on-demand. If this library is not found in system,
+requested LibIconv function just return errorcode.
+}
+unit synaicnv;
+
+interface
+
+uses
+{$IFDEF CIL}
+ System.Runtime.InteropServices,
+ System.Text,
+{$ENDIF}
+ synafpc,
+{$IFNDEF MSWINDOWS}
+ {$IFNDEF FPC}
+ Libc,
+ {$ENDIF}
+ SysUtils;
+{$ELSE}
+ Windows;
+{$ENDIF}
+
+
+const
+ {$IFNDEF MSWINDOWS}
+ DLLIconvName = 'libiconv.so';
+ {$ELSE}
+ DLLIconvName = 'iconv.dll';
+ {$ENDIF}
+
+type
+ size_t = Cardinal;
+{$IFDEF CIL}
+ iconv_t = IntPtr;
+{$ELSE}
+ iconv_t = Pointer;
+{$ENDIF}
+ argptr = iconv_t;
+
+var
+ iconvLibHandle: TLibHandle = 0;
+
+function SynaIconvOpen(const tocode, fromcode: Ansistring): iconv_t;
+function SynaIconvOpenTranslit(const tocode, fromcode: Ansistring): iconv_t;
+function SynaIconvOpenIgnore(const tocode, fromcode: Ansistring): iconv_t;
+function SynaIconv(cd: iconv_t; inbuf: AnsiString; var outbuf: AnsiString): integer;
+function SynaIconvClose(var cd: iconv_t): integer;
+function SynaIconvCtl(cd: iconv_t; request: integer; argument: argptr): integer;
+
+function IsIconvloaded: Boolean;
+function InitIconvInterface: Boolean;
+function DestroyIconvInterface: Boolean;
+
+const
+ ICONV_TRIVIALP = 0; // int *argument
+ ICONV_GET_TRANSLITERATE = 1; // int *argument
+ ICONV_SET_TRANSLITERATE = 2; // const int *argument
+ ICONV_GET_DISCARD_ILSEQ = 3; // int *argument
+ ICONV_SET_DISCARD_ILSEQ = 4; // const int *argument
+
+
+implementation
+
+uses SyncObjs;
+
+{$IFDEF CIL}
+ [DllImport(DLLIconvName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'libiconv_open')]
+ function _iconv_open(tocode: string; fromcode: string): iconv_t; external;
+
+ [DllImport(DLLIconvName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'libiconv')]
+ function _iconv(cd: iconv_t; var inbuf: IntPtr; var inbytesleft: size_t;
+ var outbuf: IntPtr; var outbytesleft: size_t): size_t; external;
+
+ [DllImport(DLLIconvName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'libiconv_close')]
+ function _iconv_close(cd: iconv_t): integer; external;
+
+ [DllImport(DLLIconvName, CharSet = CharSet.Ansi,
+ SetLastError = False, CallingConvention= CallingConvention.cdecl,
+ EntryPoint = 'libiconvctl')]
+ function _iconvctl(cd: iconv_t; request: integer; argument: argptr): integer; external;
+
+{$ELSE}
+type
+ Ticonv_open = function(tocode: pAnsichar; fromcode: pAnsichar): iconv_t; cdecl;
+ Ticonv = function(cd: iconv_t; var inbuf: pointer; var inbytesleft: size_t;
+ var outbuf: pointer; var outbytesleft: size_t): size_t; cdecl;
+ Ticonv_close = function(cd: iconv_t): integer; cdecl;
+ Ticonvctl = function(cd: iconv_t; request: integer; argument: argptr): integer; cdecl;
+var
+ _iconv_open: Ticonv_open = nil;
+ _iconv: Ticonv = nil;
+ _iconv_close: Ticonv_close = nil;
+ _iconvctl: Ticonvctl = nil;
+{$ENDIF}
+
+
+var
+ IconvCS: TCriticalSection;
+ Iconvloaded: boolean = false;
+
+function SynaIconvOpen (const tocode, fromcode: Ansistring): iconv_t;
+begin
+{$IFDEF CIL}
+ try
+ Result := _iconv_open(tocode, fromcode);
+ except
+ on Exception do
+ Result := iconv_t(-1);
+ end;
+{$ELSE}
+ if InitIconvInterface and Assigned(_iconv_open) then
+ Result := _iconv_open(PAnsiChar(tocode), PAnsiChar(fromcode))
+ else
+ Result := iconv_t(-1);
+{$ENDIF}
+end;
+
+function SynaIconvOpenTranslit (const tocode, fromcode: Ansistring): iconv_t;
+begin
+ Result := SynaIconvOpen(tocode + '//IGNORE//TRANSLIT', fromcode);
+end;
+
+function SynaIconvOpenIgnore (const tocode, fromcode: Ansistring): iconv_t;
+begin
+ Result := SynaIconvOpen(tocode + '//IGNORE', fromcode);
+end;
+
+function SynaIconv (cd: iconv_t; inbuf: AnsiString; var outbuf: AnsiString): integer;
+var
+{$IFDEF CIL}
+ ib, ob: IntPtr;
+ ibsave, obsave: IntPtr;
+ l: integer;
+{$ELSE}
+ ib, ob: Pointer;
+{$ENDIF}
+ ix, ox: size_t;
+begin
+{$IFDEF CIL}
+ l := Length(inbuf) * 4;
+ ibsave := IntPtr.Zero;
+ obsave := IntPtr.Zero;
+ try
+ ibsave := Marshal.StringToHGlobalAnsi(inbuf);
+ obsave := Marshal.AllocHGlobal(l);
+ ib := ibsave;
+ ob := obsave;
+ ix := Length(inbuf);
+ ox := l;
+ _iconv(cd, ib, ix, ob, ox);
+ Outbuf := Marshal.PtrToStringAnsi(obsave, l);
+ setlength(Outbuf, l - ox);
+ Result := Length(inbuf) - ix;
+ finally
+ Marshal.FreeCoTaskMem(ibsave);
+ Marshal.FreeHGlobal(obsave);
+ end;
+{$ELSE}
+ if InitIconvInterface and Assigned(_iconv) then
+ begin
+ setlength(Outbuf, Length(inbuf) * 4);
+ ib := Pointer(inbuf);
+ ob := Pointer(Outbuf);
+ ix := Length(inbuf);
+ ox := Length(Outbuf);
+ _iconv(cd, ib, ix, ob, ox);
+ setlength(Outbuf, cardinal(Length(Outbuf)) - ox);
+ Result := Cardinal(Length(inbuf)) - ix;
+ end
+ else
+ begin
+ Outbuf := '';
+ Result := 0;
+ end;
+{$ENDIF}
+end;
+
+function SynaIconvClose(var cd: iconv_t): integer;
+begin
+ if cd = iconv_t(-1) then
+ begin
+ Result := 0;
+ Exit;
+ end;
+{$IFDEF CIL}
+ try;
+ Result := _iconv_close(cd)
+ except
+ on Exception do
+ Result := -1;
+ end;
+ cd := iconv_t(-1);
+{$ELSE}
+ if InitIconvInterface and Assigned(_iconv_close) then
+ Result := _iconv_close(cd)
+ else
+ Result := -1;
+ cd := iconv_t(-1);
+{$ENDIF}
+end;
+
+function SynaIconvCtl (cd: iconv_t; request: integer; argument: argptr): integer;
+begin
+{$IFDEF CIL}
+ Result := _iconvctl(cd, request, argument)
+{$ELSE}
+ if InitIconvInterface and Assigned(_iconvctl) then
+ Result := _iconvctl(cd, request, argument)
+ else
+ Result := 0;
+{$ENDIF}
+end;
+
+function InitIconvInterface: Boolean;
+begin
+ IconvCS.Enter;
+ try
+ if not IsIconvloaded then
+ begin
+{$IFDEF CIL}
+ IconvLibHandle := 1;
+{$ELSE}
+ IconvLibHandle := LoadLibrary(PChar(DLLIconvName));
+{$ENDIF}
+ if (IconvLibHandle <> 0) then
+ begin
+{$IFNDEF CIL}
+ _iconv_open := GetProcAddress(IconvLibHandle, PAnsiChar(AnsiString('libiconv_open')));
+ _iconv := GetProcAddress(IconvLibHandle, PAnsiChar(AnsiString('libiconv')));
+ _iconv_close := GetProcAddress(IconvLibHandle, PAnsiChar(AnsiString('libiconv_close')));
+ _iconvctl := GetProcAddress(IconvLibHandle, PAnsiChar(AnsiString('libiconvctl')));
+{$ENDIF}
+ Result := True;
+ Iconvloaded := True;
+ end
+ else
+ begin
+ //load failed!
+ if IconvLibHandle <> 0 then
+ begin
+{$IFNDEF CIL}
+ FreeLibrary(IconvLibHandle);
+{$ENDIF}
+ IconvLibHandle := 0;
+ end;
+ Result := False;
+ end;
+ end
+ else
+ //loaded before...
+ Result := true;
+ finally
+ IconvCS.Leave;
+ end;
+end;
+
+function DestroyIconvInterface: Boolean;
+begin
+ IconvCS.Enter;
+ try
+ Iconvloaded := false;
+ if IconvLibHandle <> 0 then
+ begin
+{$IFNDEF CIL}
+ FreeLibrary(IconvLibHandle);
+{$ENDIF}
+ IconvLibHandle := 0;
+ end;
+{$IFNDEF CIL}
+ _iconv_open := nil;
+ _iconv := nil;
+ _iconv_close := nil;
+ _iconvctl := nil;
+{$ENDIF}
+ finally
+ IconvCS.Leave;
+ end;
+ Result := True;
+end;
+
+function IsIconvloaded: Boolean;
+begin
+ Result := IconvLoaded;
+end;
+
+ initialization
+begin
+ IconvCS:= TCriticalSection.Create;
+end;
+
+finalization
+begin
+{$IFNDEF CIL}
+ DestroyIconvInterface;
+{$ENDIF}
+ IconvCS.Free;
+end;
+
+end.
ADDED lib/synapse/source/lib/synaip.pas
Index: lib/synapse/source/lib/synaip.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/lib/synaip.pas
@@ -0,0 +1,422 @@
+{==============================================================================|
+| Project : Ararat Synapse | 001.002.001 |
+|==============================================================================|
+| Content: IP address support procedures and functions |
+|==============================================================================|
+| Copyright (c)2006-2010, Lukas Gebauer |
+| All rights reserved. |
+| |
+| Redistribution and use in source and binary forms, with or without |
+| modification, are permitted provided that the following conditions are met: |
+| |
+| Redistributions of source code must retain the above copyright notice, this |
+| list of conditions and the following disclaimer. |
+| |
+| Redistributions in binary form must reproduce the above copyright notice, |
+| this list of conditions and the following disclaimer in the documentation |
+| and/or other materials provided with the distribution. |
+| |
+| Neither the name of Lukas Gebauer nor the names of its contributors may |
+| be used to endorse or promote products derived from this software without |
+| specific prior written permission. |
+| |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
+| DAMAGE. |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c) 2006-2010. |
+| All Rights Reserved. |
+|==============================================================================|
+| Contributor(s): |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package |
+| (Found at URL: http://www.ararat.cz/synapse/) |
+|==============================================================================}
+
+{:@abstract(IP adress support procedures and functions)}
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+{$Q-}
+{$R-}
+{$H+}
+
+{$IFDEF UNICODE}
+ {$WARN IMPLICIT_STRING_CAST OFF}
+ {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+ {$WARN SUSPICIOUS_TYPECAST OFF}
+{$ENDIF}
+
+unit synaip;
+
+interface
+
+uses
+ SysUtils, SynaUtil;
+
+type
+{:binary form of IPv6 adress (for string conversion routines)}
+ TIp6Bytes = array [0..15] of Byte;
+{:binary form of IPv6 adress (for string conversion routines)}
+ TIp6Words = array [0..7] of Word;
+
+{:Returns @TRUE, if "Value" is a valid IPv4 address. Cannot be a symbolic Name!}
+function IsIP(const Value: string): Boolean;
+
+{:Returns @TRUE, if "Value" is a valid IPv6 address. Cannot be a symbolic Name!}
+function IsIP6(const Value: string): Boolean;
+
+{:Returns a string with the "Host" ip address converted to binary form.}
+function IPToID(Host: string): Ansistring;
+
+{:Convert IPv6 address from their string form to binary byte array.}
+function StrToIp6(value: string): TIp6Bytes;
+
+{:Convert IPv6 address from binary byte array to string form.}
+function Ip6ToStr(value: TIp6Bytes): string;
+
+{:Convert IPv4 address from their string form to binary.}
+function StrToIp(value: string): integer;
+
+{:Convert IPv4 address from binary to string form.}
+function IpToStr(value: integer): string;
+
+{:Convert IPv4 address to reverse form.}
+function ReverseIP(Value: AnsiString): AnsiString;
+
+{:Convert IPv6 address to reverse form.}
+function ReverseIP6(Value: AnsiString): AnsiString;
+
+{:Expand short form of IPv6 address to long form.}
+function ExpandIP6(Value: AnsiString): AnsiString;
+
+
+implementation
+
+{==============================================================================}
+
+function IsIP(const Value: string): Boolean;
+var
+ TempIP: string;
+ function ByteIsOk(const Value: string): Boolean;
+ var
+ x, n: integer;
+ begin
+ x := StrToIntDef(Value, -1);
+ Result := (x >= 0) and (x < 256);
+ // X may be in correct range, but value still may not be correct value!
+ // i.e. "$80"
+ if Result then
+ for n := 1 to length(Value) do
+ if not (AnsiChar(Value[n]) in ['0'..'9']) then
+ begin
+ Result := False;
+ Break;
+ end;
+ end;
+begin
+ TempIP := Value;
+ Result := False;
+ if not ByteIsOk(Fetch(TempIP, '.')) then
+ Exit;
+ if not ByteIsOk(Fetch(TempIP, '.')) then
+ Exit;
+ if not ByteIsOk(Fetch(TempIP, '.')) then
+ Exit;
+ if ByteIsOk(TempIP) then
+ Result := True;
+end;
+
+{==============================================================================}
+
+function IsIP6(const Value: string): Boolean;
+var
+ TempIP: string;
+ s,t: string;
+ x: integer;
+ partcount: integer;
+ zerocount: integer;
+ First: Boolean;
+begin
+ TempIP := Value;
+ Result := False;
+ if Value = '::' then
+ begin
+ Result := True;
+ Exit;
+ end;
+ partcount := 0;
+ zerocount := 0;
+ First := True;
+ while tempIP <> '' do
+ begin
+ s := fetch(TempIP, ':');
+ if not(First) and (s = '') then
+ Inc(zerocount);
+ First := False;
+ if zerocount > 1 then
+ break;
+ Inc(partCount);
+ if s = '' then
+ Continue;
+ if partCount > 8 then
+ break;
+ if tempIP = '' then
+ begin
+ t := SeparateRight(s, '%');
+ s := SeparateLeft(s, '%');
+ x := StrToIntDef('$' + t, -1);
+ if (x < 0) or (x > $ffff) then
+ break;
+ end;
+ x := StrToIntDef('$' + s, -1);
+ if (x < 0) or (x > $ffff) then
+ break;
+ if tempIP = '' then
+ if not((PartCount = 1) and (ZeroCount = 0)) then
+ Result := True;
+ end;
+end;
+
+{==============================================================================}
+function IPToID(Host: string): Ansistring;
+var
+ s: string;
+ i, x: Integer;
+begin
+ Result := '';
+ for x := 0 to 3 do
+ begin
+ s := Fetch(Host, '.');
+ i := StrToIntDef(s, 0);
+ Result := Result + AnsiChar(i);
+ end;
+end;
+
+{==============================================================================}
+
+function StrToIp(value: string): integer;
+var
+ s: string;
+ i, x: Integer;
+begin
+ Result := 0;
+ for x := 0 to 3 do
+ begin
+ s := Fetch(value, '.');
+ i := StrToIntDef(s, 0);
+ Result := (256 * Result) + i;
+ end;
+end;
+
+{==============================================================================}
+
+function IpToStr(value: integer): string;
+var
+ x1, x2: word;
+ y1, y2: byte;
+begin
+ Result := '';
+ x1 := value shr 16;
+ x2 := value and $FFFF;
+ y1 := x1 div $100;
+ y2 := x1 mod $100;
+ Result := inttostr(y1) + '.' + inttostr(y2) + '.';
+ y1 := x2 div $100;
+ y2 := x2 mod $100;
+ Result := Result + inttostr(y1) + '.' + inttostr(y2);
+end;
+
+{==============================================================================}
+
+function ExpandIP6(Value: AnsiString): AnsiString;
+var
+ n: integer;
+ s: ansistring;
+ x: integer;
+begin
+ Result := '';
+ if value = '' then
+ exit;
+ x := countofchar(value, ':');
+ if x > 7 then
+ exit;
+ if value[1] = ':' then
+ value := '0' + value;
+ if value[length(value)] = ':' then
+ value := value + '0';
+ x := 8 - x;
+ s := '';
+ for n := 1 to x do
+ s := s + ':0';
+ s := s + ':';
+ Result := replacestring(value, '::', s);
+end;
+{==============================================================================}
+
+function StrToIp6(Value: string): TIp6Bytes;
+var
+ IPv6: TIp6Words;
+ Index: Integer;
+ n: integer;
+ b1, b2: byte;
+ s: string;
+ x: integer;
+begin
+ for n := 0 to 15 do
+ Result[n] := 0;
+ for n := 0 to 7 do
+ Ipv6[n] := 0;
+ Index := 0;
+ Value := ExpandIP6(value);
+ if value = '' then
+ exit;
+ while Value <> '' do
+ begin
+ if Index > 7 then
+ Exit;
+ s := fetch(value, ':');
+ if s = '@' then
+ break;
+ if s = '' then
+ begin
+ IPv6[Index] := 0;
+ end
+ else
+ begin
+ x := StrToIntDef('$' + s, -1);
+ if (x > 65535) or (x < 0) then
+ Exit;
+ IPv6[Index] := x;
+ end;
+ Inc(Index);
+ end;
+ for n := 0 to 7 do
+ begin
+ b1 := ipv6[n] div 256;
+ b2 := ipv6[n] mod 256;
+ Result[n * 2] := b1;
+ Result[(n * 2) + 1] := b2;
+ end;
+end;
+
+{==============================================================================}
+//based on routine by the Free Pascal development team
+function Ip6ToStr(value: TIp6Bytes): string;
+var
+ i, x: byte;
+ zr1,zr2: set of byte;
+ zc1,zc2: byte;
+ have_skipped: boolean;
+ ip6w: TIp6words;
+begin
+ zr1 := [];
+ zr2 := [];
+ zc1 := 0;
+ zc2 := 0;
+ for i := 0 to 7 do
+ begin
+ x := i * 2;
+ ip6w[i] := value[x] * 256 + value[x + 1];
+ if ip6w[i] = 0 then
+ begin
+ include(zr2, i);
+ inc(zc2);
+ end
+ else
+ begin
+ if zc1 < zc2 then
+ begin
+ zc1 := zc2;
+ zr1 := zr2;
+ zc2 := 0;
+ zr2 := [];
+ end;
+ end;
+ end;
+ if zc1 < zc2 then
+ begin
+ zr1 := zr2;
+ end;
+ SetLength(Result, 8*5-1);
+ SetLength(Result, 0);
+ have_skipped := false;
+ for i := 0 to 7 do
+ begin
+ if not(i in zr1) then
+ begin
+ if have_skipped then
+ begin
+ if Result = '' then
+ Result := '::'
+ else
+ Result := Result + ':';
+ have_skipped := false;
+ end;
+ Result := Result + IntToHex(Ip6w[i], 1) + ':';
+ end
+ else
+ begin
+ have_skipped := true;
+ end;
+ end;
+ if have_skipped then
+ if Result = '' then
+ Result := '::0'
+ else
+ Result := Result + ':';
+
+ if Result = '' then
+ Result := '::0';
+ if not (7 in zr1) then
+ SetLength(Result, Length(Result)-1);
+ Result := LowerCase(result);
+end;
+
+{==============================================================================}
+function ReverseIP(Value: AnsiString): AnsiString;
+var
+ x: Integer;
+begin
+ Result := '';
+ repeat
+ x := LastDelimiter('.', Value);
+ Result := Result + '.' + Copy(Value, x + 1, Length(Value) - x);
+ Delete(Value, x, Length(Value) - x + 1);
+ until x < 1;
+ if Length(Result) > 0 then
+ if Result[1] = '.' then
+ Delete(Result, 1, 1);
+end;
+
+{==============================================================================}
+function ReverseIP6(Value: AnsiString): AnsiString;
+var
+ ip6: TIp6bytes;
+ n: integer;
+ x, y: integer;
+begin
+ ip6 := StrToIP6(Value);
+ x := ip6[15] div 16;
+ y := ip6[15] mod 16;
+ Result := IntToHex(y, 1) + '.' + IntToHex(x, 1);
+ for n := 14 downto 0 do
+ begin
+ x := ip6[n] div 16;
+ y := ip6[n] mod 16;
+ Result := Result + '.' + IntToHex(y, 1) + '.' + IntToHex(x, 1);
+ end;
+end;
+
+{==============================================================================}
+end.
ADDED lib/synapse/source/lib/synamisc.pas
Index: lib/synapse/source/lib/synamisc.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/lib/synamisc.pas
@@ -0,0 +1,406 @@
+{==============================================================================|
+| Project : Ararat Synapse | 001.003.001 |
+|==============================================================================|
+| Content: misc. procedures and functions |
+|==============================================================================|
+| Copyright (c)1999-2010, Lukas Gebauer |
+| All rights reserved. |
+| |
+| Redistribution and use in source and binary forms, with or without |
+| modification, are permitted provided that the following conditions are met: |
+| |
+| Redistributions of source code must retain the above copyright notice, this |
+| list of conditions and the following disclaimer. |
+| |
+| Redistributions in binary form must reproduce the above copyright notice, |
+| this list of conditions and the following disclaimer in the documentation |
+| and/or other materials provided with the distribution. |
+| |
+| Neither the name of Lukas Gebauer nor the names of its contributors may |
+| be used to endorse or promote products derived from this software without |
+| specific prior written permission. |
+| |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
+| DAMAGE. |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c) 2002-2010. |
+| All Rights Reserved. |
+|==============================================================================|
+| Contributor(s): |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package |
+| (Found at URL: http://www.ararat.cz/synapse/) |
+|==============================================================================}
+
+{:@abstract(Misc. network based utilities)}
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+{$Q-}
+{$H+}
+
+//Kylix does not known UNIX define
+{$IFDEF LINUX}
+ {$IFNDEF UNIX}
+ {$DEFINE UNIX}
+ {$ENDIF}
+{$ENDIF}
+
+{$TYPEDADDRESS OFF}
+
+{$IFDEF UNICODE}
+ {$WARN IMPLICIT_STRING_CAST OFF}
+ {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+unit synamisc;
+
+interface
+
+{$IFDEF VER125}
+ {$DEFINE BCB}
+{$ENDIF}
+{$IFDEF BCB}
+ {$ObjExportAll On}
+ {$HPPEMIT '#pragma comment( lib , "wininet.lib" )'}
+{$ENDIF}
+
+uses
+ synautil, blcksock, SysUtils, Classes
+{$IFDEF UNIX}
+ {$IFNDEF FPC}
+ , Libc
+ {$ENDIF}
+{$ELSE}
+ , Windows
+{$ENDIF}
+;
+
+Type
+ {:@abstract(This record contains information about proxy setting.)}
+ TProxySetting = record
+ Host: string;
+ Port: string;
+ Bypass: string;
+ end;
+
+{:By this function you can turn-on computer on network, if this computer
+ supporting Wake-on-lan feature. You need MAC number (network card indentifier)
+ of computer for turn-on. You can also assign target IP addres. If you not
+ specify it, then is used broadcast for delivery magic wake-on packet. However
+ broadcasts workinh only on your local network. When you need to wake-up
+ computer on another network, you must specify any existing IP addres on same
+ network segment as targeting computer.}
+procedure WakeOnLan(MAC, IP: string);
+
+{:Autodetect current DNS servers used by system. If is defined more then one DNS
+ server, then result is comma-delimited.}
+function GetDNS: string;
+
+{:Autodetect InternetExplorer proxy setting for given protocol. This function
+working only on windows!}
+function GetIEProxy(protocol: string): TProxySetting;
+
+{:Return all known IP addresses on local system. Addresses are divided by comma.}
+function GetLocalIPs: string;
+
+implementation
+
+{==============================================================================}
+procedure WakeOnLan(MAC, IP: string);
+var
+ sock: TUDPBlockSocket;
+ HexMac: Ansistring;
+ data: Ansistring;
+ n: integer;
+ b: Byte;
+begin
+ if MAC <> '' then
+ begin
+ MAC := ReplaceString(MAC, '-', '');
+ MAC := ReplaceString(MAC, ':', '');
+ if Length(MAC) < 12 then
+ Exit;
+ HexMac := '';
+ for n := 0 to 5 do
+ begin
+ b := StrToIntDef('$' + MAC[n * 2 + 1] + MAC[n * 2 + 2], 0);
+ HexMac := HexMac + char(b);
+ end;
+ if IP = '' then
+ IP := cBroadcast;
+ sock := TUDPBlockSocket.Create;
+ try
+ sock.CreateSocket;
+ sock.EnableBroadcast(true);
+ sock.Connect(IP, '9');
+ data := #$FF + #$FF + #$FF + #$FF + #$FF + #$FF;
+ for n := 1 to 16 do
+ data := data + HexMac;
+ sock.SendString(data);
+ finally
+ sock.Free;
+ end;
+ end;
+end;
+
+{==============================================================================}
+
+{$IFNDEF UNIX}
+function GetDNSbyIpHlp: string;
+type
+ PTIP_ADDRESS_STRING = ^TIP_ADDRESS_STRING;
+ TIP_ADDRESS_STRING = array[0..15] of Ansichar;
+ PTIP_ADDR_STRING = ^TIP_ADDR_STRING;
+ TIP_ADDR_STRING = packed record
+ Next: PTIP_ADDR_STRING;
+ IpAddress: TIP_ADDRESS_STRING;
+ IpMask: TIP_ADDRESS_STRING;
+ Context: DWORD;
+ end;
+ PTFixedInfo = ^TFixedInfo;
+ TFixedInfo = packed record
+ HostName: array[1..128 + 4] of Ansichar;
+ DomainName: array[1..128 + 4] of Ansichar;
+ CurrentDNSServer: PTIP_ADDR_STRING;
+ DNSServerList: TIP_ADDR_STRING;
+ NodeType: UINT;
+ ScopeID: array[1..256 + 4] of Ansichar;
+ EnableRouting: UINT;
+ EnableProxy: UINT;
+ EnableDNS: UINT;
+ end;
+const
+ IpHlpDLL = 'IPHLPAPI.DLL';
+var
+ IpHlpModule: THandle;
+ FixedInfo: PTFixedInfo;
+ InfoSize: Longint;
+ PDnsServer: PTIP_ADDR_STRING;
+ err: integer;
+ GetNetworkParams: function(FixedInfo: PTFixedInfo; pOutPutLen: PULONG): DWORD; stdcall;
+begin
+ InfoSize := 0;
+ Result := '...';
+ IpHlpModule := LoadLibrary(IpHlpDLL);
+ if IpHlpModule = 0 then
+ exit;
+ try
+ GetNetworkParams := GetProcAddress(IpHlpModule,PAnsiChar(AnsiString('GetNetworkParams')));
+ if @GetNetworkParams = nil then
+ Exit;
+ err := GetNetworkParams(Nil, @InfoSize);
+ if err <> ERROR_BUFFER_OVERFLOW then
+ Exit;
+ Result := '';
+ GetMem (FixedInfo, InfoSize);
+ try
+ err := GetNetworkParams(FixedInfo, @InfoSize);
+ if err <> ERROR_SUCCESS then
+ exit;
+ with FixedInfo^ do
+ begin
+ Result := DnsServerList.IpAddress;
+ PDnsServer := DnsServerList.Next;
+ while PDnsServer <> Nil do
+ begin
+ if Result <> '' then
+ Result := Result + ',';
+ Result := Result + PDnsServer^.IPAddress;
+ PDnsServer := PDnsServer.Next;
+ end;
+ end;
+ finally
+ FreeMem(FixedInfo);
+ end;
+ finally
+ FreeLibrary(IpHlpModule);
+ end;
+end;
+
+function ReadReg(SubKey, Vn: PChar): string;
+var
+ OpenKey: HKEY;
+ DataType, DataSize: integer;
+ Temp: array [0..2048] of char;
+begin
+ Result := '';
+ if RegOpenKeyEx(HKEY_LOCAL_MACHINE, SubKey, REG_OPTION_NON_VOLATILE,
+ KEY_READ, OpenKey) = ERROR_SUCCESS then
+ begin
+ DataType := REG_SZ;
+ DataSize := SizeOf(Temp);
+ if RegQueryValueEx(OpenKey, Vn, nil, @DataType, @Temp, @DataSize) = ERROR_SUCCESS then
+ SetString(Result, Temp, DataSize div SizeOf(Char) - 1);
+ RegCloseKey(OpenKey);
+ end;
+end ;
+{$ENDIF}
+
+function GetDNS: string;
+{$IFDEF UNIX}
+var
+ l: TStringList;
+ n: integer;
+begin
+ Result := '';
+ l := TStringList.Create;
+ try
+ l.LoadFromFile('/etc/resolv.conf');
+ for n := 0 to l.Count - 1 do
+ if Pos('NAMESERVER', uppercase(l[n])) = 1 then
+ begin
+ if Result <> '' then
+ Result := Result + ',';
+ Result := Result + SeparateRight(l[n], ' ');
+ end;
+ finally
+ l.Free;
+ end;
+end;
+{$ELSE}
+const
+ NTdyn = 'System\CurrentControlSet\Services\Tcpip\Parameters\Temporary';
+ NTfix = 'System\CurrentControlSet\Services\Tcpip\Parameters';
+ W9xfix = 'System\CurrentControlSet\Services\MSTCP';
+begin
+ Result := GetDNSbyIpHlp;
+ if Result = '...' then
+ begin
+ if Win32Platform = VER_PLATFORM_WIN32_NT then
+ begin
+ Result := ReadReg(NTdyn, 'NameServer');
+ if result = '' then
+ Result := ReadReg(NTfix, 'NameServer');
+ if result = '' then
+ Result := ReadReg(NTfix, 'DhcpNameServer');
+ end
+ else
+ Result := ReadReg(W9xfix, 'NameServer');
+ Result := ReplaceString(trim(Result), ' ', ',');
+ end;
+end;
+{$ENDIF}
+
+{==============================================================================}
+
+function GetIEProxy(protocol: string): TProxySetting;
+{$IFDEF UNIX}
+begin
+ Result.Host := '';
+ Result.Port := '';
+ Result.Bypass := '';
+end;
+{$ELSE}
+type
+ PInternetProxyInfo = ^TInternetProxyInfo;
+ TInternetProxyInfo = packed record
+ dwAccessType: DWORD;
+ lpszProxy: LPCSTR;
+ lpszProxyBypass: LPCSTR;
+ end;
+const
+ INTERNET_OPTION_PROXY = 38;
+ INTERNET_OPEN_TYPE_PROXY = 3;
+ WininetDLL = 'WININET.DLL';
+var
+ WininetModule: THandle;
+ ProxyInfo: PInternetProxyInfo;
+ Err: Boolean;
+ Len: DWORD;
+ Proxy: string;
+ DefProxy: string;
+ ProxyList: TStringList;
+ n: integer;
+ InternetQueryOption: function (hInet: Pointer; dwOption: DWORD;
+ lpBuffer: Pointer; var lpdwBufferLength: DWORD): BOOL; stdcall;
+begin
+ Result.Host := '';
+ Result.Port := '';
+ Result.Bypass := '';
+ WininetModule := LoadLibrary(WininetDLL);
+ if WininetModule = 0 then
+ exit;
+ try
+ InternetQueryOption := GetProcAddress(WininetModule,PAnsiChar(AnsiString('InternetQueryOptionA')));
+ if @InternetQueryOption = nil then
+ Exit;
+
+ if protocol = '' then
+ protocol := 'http';
+ Len := 4096;
+ GetMem(ProxyInfo, Len);
+ ProxyList := TStringList.Create;
+ try
+ Err := InternetQueryOption(nil, INTERNET_OPTION_PROXY, ProxyInfo, Len);
+ if Err then
+ if ProxyInfo^.dwAccessType = INTERNET_OPEN_TYPE_PROXY then
+ begin
+ ProxyList.CommaText := ReplaceString(ProxyInfo^.lpszProxy, ' ', ',');
+ Proxy := '';
+ DefProxy := '';
+ for n := 0 to ProxyList.Count -1 do
+ begin
+ if Pos(lowercase(protocol) + '=', lowercase(ProxyList[n])) = 1 then
+ begin
+ Proxy := SeparateRight(ProxyList[n], '=');
+ break;
+ end;
+ if Pos('=', ProxyList[n]) < 1 then
+ DefProxy := ProxyList[n];
+ end;
+ if Proxy = '' then
+ Proxy := DefProxy;
+ if Proxy <> '' then
+ begin
+ Result.Host := Trim(SeparateLeft(Proxy, ':'));
+ Result.Port := Trim(SeparateRight(Proxy, ':'));
+ end;
+ Result.Bypass := ReplaceString(ProxyInfo^.lpszProxyBypass, ' ', ',');
+ end;
+ finally
+ ProxyList.Free;
+ FreeMem(ProxyInfo);
+ end;
+ finally
+ FreeLibrary(WininetModule);
+ end;
+end;
+{$ENDIF}
+
+{==============================================================================}
+
+function GetLocalIPs: string;
+var
+ TcpSock: TTCPBlockSocket;
+ ipList: TStringList;
+begin
+ Result := '';
+ ipList := TStringList.Create;
+ try
+ TcpSock := TTCPBlockSocket.create;
+ try
+ TcpSock.ResolveNameToIP(TcpSock.LocalName, ipList);
+ Result := ipList.CommaText;
+ finally
+ TcpSock.Free;
+ end;
+ finally
+ ipList.Free;
+ end;
+end;
+
+{==============================================================================}
+
+end.
ADDED lib/synapse/source/lib/synaser.pas
Index: lib/synapse/source/lib/synaser.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/lib/synaser.pas
@@ -0,0 +1,2339 @@
+{==============================================================================|
+| Project : Ararat Synapse | 007.005.002 |
+|==============================================================================|
+| Content: Serial port support |
+|==============================================================================|
+| Copyright (c)2001-2011, Lukas Gebauer |
+| All rights reserved. |
+| |
+| Redistribution and use in source and binary forms, with or without |
+| modification, are permitted provided that the following conditions are met: |
+| |
+| Redistributions of source code must retain the above copyright notice, this |
+| list of conditions and the following disclaimer. |
+| |
+| Redistributions in binary form must reproduce the above copyright notice, |
+| this list of conditions and the following disclaimer in the documentation |
+| and/or other materials provided with the distribution. |
+| |
+| Neither the name of Lukas Gebauer nor the names of its contributors may |
+| be used to endorse or promote products derived from this software without |
+| specific prior written permission. |
+| |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
+| DAMAGE. |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2001-2011. |
+| All Rights Reserved. |
+|==============================================================================|
+| Contributor(s): |
+| (c)2002, Hans-Georg Joepgen (cpom Comport Ownership Manager and bugfixes) |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package |
+| (Found at URL: http://www.ararat.cz/synapse/) |
+|==============================================================================}
+
+{: @abstract(Serial port communication library)
+This unit contains a class that implements serial port communication
+ for Windows, Linux, Unix or MacOSx. This class provides numerous methods with
+ same name and functionality as methods of the Ararat Synapse TCP/IP library.
+
+The following is a small example how establish a connection by modem (in this
+case with my USB modem):
+@longcode(#
+ ser:=TBlockSerial.Create;
+ try
+ ser.Connect('COM3');
+ ser.config(460800,8,'N',0,false,true);
+ ser.ATCommand('AT');
+ if (ser.LastError <> 0) or (not ser.ATResult) then
+ Exit;
+ ser.ATConnect('ATDT+420971200111');
+ if (ser.LastError <> 0) or (not ser.ATResult) then
+ Exit;
+ // you are now connected to a modem at +420971200111
+ // you can transmit or receive data now
+ finally
+ ser.free;
+ end;
+#)
+}
+
+//old Delphi does not have MSWINDOWS define.
+{$IFDEF WIN32}
+ {$IFNDEF MSWINDOWS}
+ {$DEFINE MSWINDOWS}
+ {$ENDIF}
+{$ENDIF}
+
+//Kylix does not known UNIX define
+{$IFDEF LINUX}
+ {$IFNDEF UNIX}
+ {$DEFINE UNIX}
+ {$ENDIF}
+{$ENDIF}
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+ {$IFDEF MSWINDOWS}
+ {$ASMMODE intel}
+ {$ENDIF}
+ {define working mode w/o LIBC for fpc}
+ {$DEFINE NO_LIBC}
+{$ENDIF}
+{$Q-}
+{$H+}
+{$M+}
+
+unit synaser;
+
+interface
+
+uses
+{$IFNDEF MSWINDOWS}
+ {$IFNDEF NO_LIBC}
+ Libc,
+ KernelIoctl,
+ {$ELSE}
+ termio, baseunix, unix,
+ {$ENDIF}
+ {$IFNDEF FPC}
+ Types,
+ {$ENDIF}
+{$ELSE}
+ Windows, registry,
+ {$IFDEF FPC}
+ winver,
+ {$ENDIF}
+{$ENDIF}
+ synafpc,
+ Classes, SysUtils, synautil;
+
+const
+ CR = #$0d;
+ LF = #$0a;
+ CRLF = CR + LF;
+ cSerialChunk = 8192;
+
+ LockfileDirectory = '/var/lock'; {HGJ}
+ PortIsClosed = -1; {HGJ}
+ ErrAlreadyOwned = 9991; {HGJ}
+ ErrAlreadyInUse = 9992; {HGJ}
+ ErrWrongParameter = 9993; {HGJ}
+ ErrPortNotOpen = 9994; {HGJ}
+ ErrNoDeviceAnswer = 9995; {HGJ}
+ ErrMaxBuffer = 9996;
+ ErrTimeout = 9997;
+ ErrNotRead = 9998;
+ ErrFrame = 9999;
+ ErrOverrun = 10000;
+ ErrRxOver = 10001;
+ ErrRxParity = 10002;
+ ErrTxFull = 10003;
+
+ dcb_Binary = $00000001;
+ dcb_ParityCheck = $00000002;
+ dcb_OutxCtsFlow = $00000004;
+ dcb_OutxDsrFlow = $00000008;
+ dcb_DtrControlMask = $00000030;
+ dcb_DtrControlDisable = $00000000;
+ dcb_DtrControlEnable = $00000010;
+ dcb_DtrControlHandshake = $00000020;
+ dcb_DsrSensivity = $00000040;
+ dcb_TXContinueOnXoff = $00000080;
+ dcb_OutX = $00000100;
+ dcb_InX = $00000200;
+ dcb_ErrorChar = $00000400;
+ dcb_NullStrip = $00000800;
+ dcb_RtsControlMask = $00003000;
+ dcb_RtsControlDisable = $00000000;
+ dcb_RtsControlEnable = $00001000;
+ dcb_RtsControlHandshake = $00002000;
+ dcb_RtsControlToggle = $00003000;
+ dcb_AbortOnError = $00004000;
+ dcb_Reserveds = $FFFF8000;
+
+ {:stopbit value for 1 stopbit}
+ SB1 = 0;
+ {:stopbit value for 1.5 stopbit}
+ SB1andHalf = 1;
+ {:stopbit value for 2 stopbits}
+ SB2 = 2;
+
+{$IFNDEF MSWINDOWS}
+const
+ INVALID_HANDLE_VALUE = THandle(-1);
+ CS7fix = $0000020;
+
+type
+ TDCB = record
+ DCBlength: DWORD;
+ BaudRate: DWORD;
+ Flags: Longint;
+ wReserved: Word;
+ XonLim: Word;
+ XoffLim: Word;
+ ByteSize: Byte;
+ Parity: Byte;
+ StopBits: Byte;
+ XonChar: CHAR;
+ XoffChar: CHAR;
+ ErrorChar: CHAR;
+ EofChar: CHAR;
+ EvtChar: CHAR;
+ wReserved1: Word;
+ end;
+ PDCB = ^TDCB;
+
+const
+{$IFDEF UNIX}
+ {$IFDEF DARWIN}
+ MaxRates = 18; //MAC
+ {$ELSE}
+ MaxRates = 30; //UNIX
+ {$ENDIF}
+{$ELSE}
+ MaxRates = 19; //WIN
+{$ENDIF}
+ Rates: array[0..MaxRates, 0..1] of cardinal =
+ (
+ (0, B0),
+ (50, B50),
+ (75, B75),
+ (110, B110),
+ (134, B134),
+ (150, B150),
+ (200, B200),
+ (300, B300),
+ (600, B600),
+ (1200, B1200),
+ (1800, B1800),
+ (2400, B2400),
+ (4800, B4800),
+ (9600, B9600),
+ (19200, B19200),
+ (38400, B38400),
+ (57600, B57600),
+ (115200, B115200),
+ (230400, B230400)
+{$IFNDEF DARWIN}
+ ,(460800, B460800)
+ {$IFDEF UNIX}
+ ,(500000, B500000),
+ (576000, B576000),
+ (921600, B921600),
+ (1000000, B1000000),
+ (1152000, B1152000),
+ (1500000, B1500000),
+ (2000000, B2000000),
+ (2500000, B2500000),
+ (3000000, B3000000),
+ (3500000, B3500000),
+ (4000000, B4000000)
+ {$ENDIF}
+{$ENDIF}
+ );
+{$ENDIF}
+
+{$IFDEF DARWIN}
+const // From fcntl.h
+ O_SYNC = $0080; { synchronous writes }
+{$ENDIF}
+
+const
+ sOK = 0;
+ sErr = integer(-1);
+
+type
+
+ {:Possible status event types for @link(THookSerialStatus)}
+ THookSerialReason = (
+ HR_SerialClose,
+ HR_Connect,
+ HR_CanRead,
+ HR_CanWrite,
+ HR_ReadCount,
+ HR_WriteCount,
+ HR_Wait
+ );
+
+ {:procedural prototype for status event hooking}
+ THookSerialStatus = procedure(Sender: TObject; Reason: THookSerialReason;
+ const Value: string) of object;
+
+ {:@abstract(Exception type for SynaSer errors)}
+ ESynaSerError = class(Exception)
+ public
+ ErrorCode: integer;
+ ErrorMessage: string;
+ end;
+
+ {:@abstract(Main class implementing all communication routines)}
+ TBlockSerial = class(TObject)
+ protected
+ FOnStatus: THookSerialStatus;
+ Fhandle: THandle;
+ FTag: integer;
+ FDevice: string;
+ FLastError: integer;
+ FLastErrorDesc: string;
+ FBuffer: AnsiString;
+ FRaiseExcept: boolean;
+ FRecvBuffer: integer;
+ FSendBuffer: integer;
+ FModemWord: integer;
+ FRTSToggle: Boolean;
+ FDeadlockTimeout: integer;
+ FInstanceActive: boolean; {HGJ}
+ FTestDSR: Boolean;
+ FTestCTS: Boolean;
+ FLastCR: Boolean;
+ FLastLF: Boolean;
+ FMaxLineLength: Integer;
+ FLinuxLock: Boolean;
+ FMaxSendBandwidth: Integer;
+ FNextSend: LongWord;
+ FMaxRecvBandwidth: Integer;
+ FNextRecv: LongWord;
+ FConvertLineEnd: Boolean;
+ FATResult: Boolean;
+ FAtTimeout: integer;
+ FInterPacketTimeout: Boolean;
+ FComNr: integer;
+{$IFDEF MSWINDOWS}
+ FPortAddr: Word;
+ function CanEvent(Event: dword; Timeout: integer): boolean;
+ procedure DecodeCommError(Error: DWord); virtual;
+ function GetPortAddr: Word; virtual;
+ function ReadTxEmpty(PortAddr: Word): Boolean; virtual;
+{$ENDIF}
+ procedure SetSizeRecvBuffer(size: integer); virtual;
+ function GetDSR: Boolean; virtual;
+ procedure SetDTRF(Value: Boolean); virtual;
+ function GetCTS: Boolean; virtual;
+ procedure SetRTSF(Value: Boolean); virtual;
+ function GetCarrier: Boolean; virtual;
+ function GetRing: Boolean; virtual;
+ procedure DoStatus(Reason: THookSerialReason; const Value: string); virtual;
+ procedure GetComNr(Value: string); virtual;
+ function PreTestFailing: boolean; virtual;{HGJ}
+ function TestCtrlLine: Boolean; virtual;
+{$IFDEF UNIX}
+ procedure DcbToTermios(const dcb: TDCB; var term: termios); virtual;
+ procedure TermiosToDcb(const term: termios; var dcb: TDCB); virtual;
+ function ReadLockfile: integer; virtual;
+ function LockfileName: String; virtual;
+ procedure CreateLockfile(PidNr: integer); virtual;
+{$ENDIF}
+ procedure LimitBandwidth(Length: Integer; MaxB: integer; var Next: LongWord); virtual;
+ procedure SetBandwidth(Value: Integer); virtual;
+ public
+ {: data Control Block with communication parameters. Usable only when you
+ need to call API directly.}
+ DCB: Tdcb;
+{$IFDEF UNIX}
+ TermiosStruc: termios;
+{$ENDIF}
+ {:Object constructor.}
+ constructor Create;
+ {:Object destructor.}
+ destructor Destroy; override;
+
+ {:Returns a string containing the version number of the library.}
+ class function GetVersion: string; virtual;
+
+ {:Destroy handle in use. It close connection to serial port.}
+ procedure CloseSocket; virtual;
+
+ {:Reconfigure communication parameters on the fly. You must be connected to
+ port before!
+ @param(baud Define connection speed. Baud rate can be from 50 to 4000000
+ bits per second. (it depends on your hardware!))
+ @param(bits Number of bits in communication.)
+ @param(parity Define communication parity (N - None, O - Odd, E - Even, M - Mark or S - Space).)
+ @param(stop Define number of stopbits. Use constants @link(SB1),
+ @link(SB1andHalf) and @link(SB2).)
+ @param(softflow Enable XON/XOFF handshake.)
+ @param(hardflow Enable CTS/RTS handshake.)}
+ procedure Config(baud, bits: integer; parity: char; stop: integer;
+ softflow, hardflow: boolean); virtual;
+
+ {:Connects to the port indicated by comport. Comport can be used in Windows
+ style (COM2), or in Linux style (/dev/ttyS1). When you use windows style
+ in Linux, then it will be converted to Linux name. And vice versa! However
+ you can specify any device name! (other device names then standart is not
+ converted!)
+
+ After successfull connection the DTR signal is set (if you not set hardware
+ handshake, then the RTS signal is set, too!)
+
+ Connection parameters is predefined by your system configuration. If you
+ need use another parameters, then you can use Config method after.
+ Notes:
+
+ - Remember, the commonly used serial Laplink cable does not support
+ hardware handshake.
+
+ - Before setting any handshake you must be sure that it is supported by
+ your hardware.
+
+ - Some serial devices are slow. In some cases you must wait up to a few
+ seconds after connection for the device to respond.
+
+ - when you connect to a modem device, then is best to test it by an empty
+ AT command. (call ATCommand('AT'))}
+ procedure Connect(comport: string); virtual;
+
+ {:Set communication parameters from the DCB structure (the DCB structure is
+ simulated under Linux).}
+ procedure SetCommState; virtual;
+
+ {:Read communication parameters into the DCB structure (DCB structure is
+ simulated under Linux).}
+ procedure GetCommState; virtual;
+
+ {:Sends Length bytes of data from Buffer through the connected port.}
+ function SendBuffer(buffer: pointer; length: integer): integer; virtual;
+
+ {:One data BYTE is sent.}
+ procedure SendByte(data: byte); virtual;
+
+ {:Send the string in the data parameter. No terminator is appended by this
+ method. If you need to send a string with CR/LF terminator, you must append
+ the CR/LF characters to the data string!
+
+ Since no terminator is appended, you can use this function for sending
+ binary data too.}
+ procedure SendString(data: AnsiString); virtual;
+
+ {:send four bytes as integer.}
+ procedure SendInteger(Data: integer); virtual;
+
+ {:send data as one block. Each block begins with integer value with Length
+ of block.}
+ procedure SendBlock(const Data: AnsiString); virtual;
+
+ {:send content of stream from current position}
+ procedure SendStreamRaw(const Stream: TStream); virtual;
+
+ {:send content of stream as block. see @link(SendBlock)}
+ procedure SendStream(const Stream: TStream); virtual;
+
+ {:send content of stream as block, but this is compatioble with Indy library.
+ (it have swapped lenght of block). See @link(SendStream)}
+ procedure SendStreamIndy(const Stream: TStream); virtual;
+
+ {:Waits until the allocated buffer is filled by received data. Returns number
+ of data bytes received, which equals to the Length value under normal
+ operation. If it is not equal, the communication channel is possibly broken.
+
+ This method not using any internal buffering, like all others receiving
+ methods. You cannot freely combine this method with all others receiving
+ methods!}
+ function RecvBuffer(buffer: pointer; length: integer): integer; virtual;
+
+ {:Method waits until data is received. If no data is received within
+ the Timeout (in milliseconds) period, @link(LastError) is set to
+ @link(ErrTimeout). This method is used to read any amount of data
+ (e. g. 1MB), and may be freely combined with all receviving methods what
+ have Timeout parameter, like the @link(RecvString), @link(RecvByte) or
+ @link(RecvTerminated) methods.}
+ function RecvBufferEx(buffer: pointer; length: integer; timeout: integer): integer; virtual;
+
+ {:It is like recvBufferEx, but data is readed to dynamicly allocated binary
+ string.}
+ function RecvBufferStr(Length: Integer; Timeout: Integer): AnsiString; virtual;
+
+ {:Read all available data and return it in the function result string. This
+ function may be combined with @link(RecvString), @link(RecvByte) or related
+ methods.}
+ function RecvPacket(Timeout: Integer): AnsiString; virtual;
+
+ {:Waits until one data byte is received which is returned as the function
+ result. If no data is received within the Timeout (in milliseconds) period,
+ @link(LastError) is set to @link(ErrTimeout).}
+ function RecvByte(timeout: integer): byte; virtual;
+
+ {:This method waits until a terminated data string is received. This string
+ is terminated by the Terminator string. The resulting string is returned
+ without this termination string! If no data is received within the Timeout
+ (in milliseconds) period, @link(LastError) is set to @link(ErrTimeout).}
+ function RecvTerminated(Timeout: Integer; const Terminator: AnsiString): AnsiString; virtual;
+
+ {:This method waits until a terminated data string is received. The string
+ is terminated by a CR/LF sequence. The resulting string is returned without
+ the terminator (CR/LF)! If no data is received within the Timeout (in
+ milliseconds) period, @link(LastError) is set to @link(ErrTimeout).
+
+ If @link(ConvertLineEnd) is used, then the CR/LF sequence may not be exactly
+ CR/LF. See the description of @link(ConvertLineEnd).
+
+ This method serves for line protocol implementation and uses its own
+ buffers to maximize performance. Therefore do NOT use this method with the
+ @link(RecvBuffer) method to receive data as it may cause data loss.}
+ function Recvstring(timeout: integer): AnsiString; virtual;
+
+ {:Waits until four data bytes are received which is returned as the function
+ integer result. If no data is received within the Timeout (in milliseconds) period,
+ @link(LastError) is set to @link(ErrTimeout).}
+ function RecvInteger(Timeout: Integer): Integer; virtual;
+
+ {:Waits until one data block is received. See @link(sendblock). If no data
+ is received within the Timeout (in milliseconds) period, @link(LastError)
+ is set to @link(ErrTimeout).}
+ function RecvBlock(Timeout: Integer): AnsiString; virtual;
+
+ {:Receive all data to stream, until some error occured. (for example timeout)}
+ procedure RecvStreamRaw(const Stream: TStream; Timeout: Integer); virtual;
+
+ {:receive requested count of bytes to stream}
+ procedure RecvStreamSize(const Stream: TStream; Timeout: Integer; Size: Integer); virtual;
+
+ {:receive block of data to stream. (Data can be sended by @link(sendstream)}
+ procedure RecvStream(const Stream: TStream; Timeout: Integer); virtual;
+
+ {:receive block of data to stream. (Data can be sended by @link(sendstreamIndy)}
+ procedure RecvStreamIndy(const Stream: TStream; Timeout: Integer); virtual;
+
+ {:Returns the number of received bytes waiting for reading. 0 is returned
+ when there is no data waiting.}
+ function WaitingData: integer; virtual;
+
+ {:Same as @link(WaitingData), but in respect to data in the internal
+ @link(LineBuffer).}
+ function WaitingDataEx: integer; virtual;
+
+ {:Returns the number of bytes waiting to be sent in the output buffer.
+ 0 is returned when the output buffer is empty.}
+ function SendingData: integer; virtual;
+
+ {:Enable or disable RTS driven communication (half-duplex). It can be used
+ to communicate with RS485 converters, or other special equipment. If you
+ enable this feature, the system automatically controls the RTS signal.
+
+ Notes:
+
+ - On Windows NT (or higher) ir RTS signal driven by system driver.
+
+ - On Win9x family is used special code for waiting until last byte is
+ sended from your UART.
+
+ - On Linux you must have kernel 2.1 or higher!}
+ procedure EnableRTSToggle(value: boolean); virtual;
+
+ {:Waits until all data to is sent and buffers are emptied.
+ Warning: On Windows systems is this method returns when all buffers are
+ flushed to the serial port controller, before the last byte is sent!}
+ procedure Flush; virtual;
+
+ {:Unconditionally empty all buffers. It is good when you need to interrupt
+ communication and for cleanups.}
+ procedure Purge; virtual;
+
+ {:Returns @True, if you can from read any data from the port. Status is
+ tested for a period of time given by the Timeout parameter (in milliseconds).
+ If the value of the Timeout parameter is 0, the status is tested only once
+ and the function returns immediately. If the value of the Timeout parameter
+ is set to -1, the function returns only after it detects data on the port
+ (this may cause the process to hang).}
+ function CanRead(Timeout: integer): boolean; virtual;
+
+ {:Returns @True, if you can write any data to the port (this function is not
+ sending the contents of the buffer). Status is tested for a period of time
+ given by the Timeout parameter (in milliseconds). If the value of
+ the Timeout parameter is 0, the status is tested only once and the function
+ returns immediately. If the value of the Timeout parameter is set to -1,
+ the function returns only after it detects that it can write data to
+ the port (this may cause the process to hang).}
+ function CanWrite(Timeout: integer): boolean; virtual;
+
+ {:Same as @link(CanRead), but the test is against data in the internal
+ @link(LineBuffer) too.}
+ function CanReadEx(Timeout: integer): boolean; virtual;
+
+ {:Returns the status word of the modem. Decoding the status word could yield
+ the status of carrier detect signaland other signals. This method is used
+ internally by the modem status reading properties. You usually do not need
+ to call this method directly.}
+ function ModemStatus: integer; virtual;
+
+ {:Send a break signal to the communication device for Duration milliseconds.}
+ procedure SetBreak(Duration: integer); virtual;
+
+ {:This function is designed to send AT commands to the modem. The AT command
+ is sent in the Value parameter and the response is returned in the function
+ return value (may contain multiple lines!).
+ If the AT command is processed successfully (modem returns OK), then the
+ @link(ATResult) property is set to True.
+
+ This function is designed only for AT commands that return OK or ERROR
+ response! To call connection commands the @link(ATConnect) method.
+ Remember, when you connect to a modem device, it is in AT command mode.
+ Now you can send AT commands to the modem. If you need to transfer data to
+ the modem on the other side of the line, you must first switch to data mode
+ using the @link(ATConnect) method.}
+ function ATCommand(value: AnsiString): AnsiString; virtual;
+
+ {:This function is used to send connect type AT commands to the modem. It is
+ for commands to switch to connected state. (ATD, ATA, ATO,...)
+ It sends the AT command in the Value parameter and returns the modem's
+ response (may be multiple lines - usually with connection parameters info).
+ If the AT command is processed successfully (the modem returns CONNECT),
+ then the ATResult property is set to @True.
+
+ This function is designed only for AT commands which respond by CONNECT,
+ BUSY, NO DIALTONE NO CARRIER or ERROR. For other AT commands use the
+ @link(ATCommand) method.
+
+ The connect timeout is 90*@link(ATTimeout). If this command is successful
+ (@link(ATresult) is @true), then the modem is in data state. When you now
+ send or receive some data, it is not to or from your modem, but from the
+ modem on other side of the line. Now you can transfer your data.
+ If the connection attempt failed (@link(ATResult) is @False), then the
+ modem is still in AT command mode.}
+ function ATConnect(value: AnsiString): AnsiString; virtual;
+
+ {:If you "manually" call API functions, forward their return code in
+ the SerialResult parameter to this function, which evaluates it and sets
+ @link(LastError) and @link(LastErrorDesc).}
+ function SerialCheck(SerialResult: integer): integer; virtual;
+
+ {:If @link(Lasterror) is not 0 and exceptions are enabled, then this procedure
+ raises an exception. This method is used internally. You may need it only
+ in special cases.}
+ procedure ExceptCheck; virtual;
+
+ {:Set Synaser to error state with ErrNumber code. Usually used by internal
+ routines.}
+ procedure SetSynaError(ErrNumber: integer); virtual;
+
+ {:Raise Synaser error with ErrNumber code. Usually used by internal routines.}
+ procedure RaiseSynaError(ErrNumber: integer); virtual;
+{$IFDEF UNIX}
+ function cpomComportAccessible: boolean; virtual;{HGJ}
+ procedure cpomReleaseComport; virtual; {HGJ}
+{$ENDIF}
+ {:True device name of currently used port}
+ property Device: string read FDevice;
+
+ {:Error code of last operation. Value is defined by the host operating
+ system, but value 0 is always OK.}
+ property LastError: integer read FLastError;
+
+ {:Human readable description of LastError code.}
+ property LastErrorDesc: string read FLastErrorDesc;
+
+ {:Indicates if the last @link(ATCommand) or @link(ATConnect) method was successful}
+ property ATResult: Boolean read FATResult;
+
+ {:Read the value of the RTS signal.}
+ property RTS: Boolean write SetRTSF;
+
+ {:Indicates the presence of the CTS signal}
+ property CTS: boolean read GetCTS;
+
+ {:Use this property to set the value of the DTR signal.}
+ property DTR: Boolean write SetDTRF;
+
+ {:Exposes the status of the DSR signal.}
+ property DSR: boolean read GetDSR;
+
+ {:Indicates the presence of the Carrier signal}
+ property Carrier: boolean read GetCarrier;
+
+ {:Reflects the status of the Ring signal.}
+ property Ring: boolean read GetRing;
+
+ {:indicates if this instance of SynaSer is active. (Connected to some port)}
+ property InstanceActive: boolean read FInstanceActive; {HGJ}
+
+ {:Defines maximum bandwidth for all sending operations in bytes per second.
+ If this value is set to 0 (default), bandwidth limitation is not used.}
+ property MaxSendBandwidth: Integer read FMaxSendBandwidth Write FMaxSendBandwidth;
+
+ {:Defines maximum bandwidth for all receiving operations in bytes per second.
+ If this value is set to 0 (default), bandwidth limitation is not used.}
+ property MaxRecvBandwidth: Integer read FMaxRecvBandwidth Write FMaxRecvBandwidth;
+
+ {:Defines maximum bandwidth for all sending and receiving operations
+ in bytes per second. If this value is set to 0 (default), bandwidth
+ limitation is not used.}
+ property MaxBandwidth: Integer Write SetBandwidth;
+
+ {:Size of the Windows internal receive buffer. Default value is usually
+ 4096 bytes. Note: Valid only in Windows versions!}
+ property SizeRecvBuffer: integer read FRecvBuffer write SetSizeRecvBuffer;
+ published
+ {:Returns the descriptive text associated with ErrorCode. You need this
+ method only in special cases. Description of LastError is now accessible
+ through the LastErrorDesc property.}
+ class function GetErrorDesc(ErrorCode: integer): string;
+
+ {:Freely usable property}
+ property Tag: integer read FTag write FTag;
+
+ {:Contains the handle of the open communication port.
+ You may need this value to directly call communication functions outside
+ SynaSer.}
+ property Handle: THandle read Fhandle write FHandle;
+
+ {:Internally used read buffer.}
+ property LineBuffer: AnsiString read FBuffer write FBuffer;
+
+ {:If @true, communication errors raise exceptions. If @false (default), only
+ the @link(LastError) value is set.}
+ property RaiseExcept: boolean read FRaiseExcept write FRaiseExcept;
+
+ {:This event is triggered when the communication status changes. It can be
+ used to monitor communication status.}
+ property OnStatus: THookSerialStatus read FOnStatus write FOnStatus;
+
+ {:If you set this property to @true, then the value of the DSR signal
+ is tested before every data transfer. It can be used to detect the presence
+ of a communications device.}
+ property TestDSR: boolean read FTestDSR write FTestDSR;
+
+ {:If you set this property to @true, then the value of the CTS signal
+ is tested before every data transfer. It can be used to detect the presence
+ of a communications device. Warning: This property cannot be used if you
+ need hardware handshake!}
+ property TestCTS: boolean read FTestCTS write FTestCTS;
+
+ {:Use this property you to limit the maximum size of LineBuffer
+ (as a protection against unlimited memory allocation for LineBuffer).
+ Default value is 0 - no limit.}
+ property MaxLineLength: Integer read FMaxLineLength Write FMaxLineLength;
+
+ {:This timeout value is used as deadlock protection when trying to send data
+ to (or receive data from) a device that stopped communicating during data
+ transmission (e.g. by physically disconnecting the device).
+ The timeout value is in milliseconds. The default value is 30,000 (30 seconds).}
+ property DeadlockTimeout: Integer read FDeadlockTimeout Write FDeadlockTimeout;
+
+ {:If set to @true (default value), port locking is enabled (under Linux only).
+ WARNING: To use this feature, the application must run by a user with full
+ permission to the /var/lock directory!}
+ property LinuxLock: Boolean read FLinuxLock write FLinuxLock;
+
+ {:Indicates if non-standard line terminators should be converted to a CR/LF pair
+ (standard DOS line terminator). If @TRUE, line terminators CR, single LF
+ or LF/CR are converted to CR/LF. Defaults to @FALSE.
+ This property has effect only on the behavior of the RecvString method.}
+ property ConvertLineEnd: Boolean read FConvertLineEnd Write FConvertLineEnd;
+
+ {:Timeout for AT modem based operations}
+ property AtTimeout: integer read FAtTimeout Write FAtTimeout;
+
+ {:If @true (default), then all timeouts is timeout between two characters.
+ If @False, then timeout is overall for whoole reading operation.}
+ property InterPacketTimeout: Boolean read FInterPacketTimeout Write FInterPacketTimeout;
+ end;
+
+{:Returns list of existing computer serial ports. Working properly only in Windows!}
+function GetSerialPortNames: string;
+
+implementation
+
+constructor TBlockSerial.Create;
+begin
+ inherited create;
+ FRaiseExcept := false;
+ FHandle := INVALID_HANDLE_VALUE;
+ FDevice := '';
+ FComNr:= PortIsClosed; {HGJ}
+ FInstanceActive:= false; {HGJ}
+ Fbuffer := '';
+ FRTSToggle := False;
+ FMaxLineLength := 0;
+ FTestDSR := False;
+ FTestCTS := False;
+ FDeadlockTimeout := 30000;
+ FLinuxLock := True;
+ FMaxSendBandwidth := 0;
+ FNextSend := 0;
+ FMaxRecvBandwidth := 0;
+ FNextRecv := 0;
+ FConvertLineEnd := False;
+ SetSynaError(sOK);
+ FRecvBuffer := 4096;
+ FLastCR := False;
+ FLastLF := False;
+ FAtTimeout := 1000;
+ FInterPacketTimeout := True;
+end;
+
+destructor TBlockSerial.Destroy;
+begin
+ CloseSocket;
+ inherited destroy;
+end;
+
+class function TBlockSerial.GetVersion: string;
+begin
+ Result := 'SynaSer 7.5.0';
+end;
+
+procedure TBlockSerial.CloseSocket;
+begin
+ if Fhandle <> INVALID_HANDLE_VALUE then
+ begin
+ Purge;
+ RTS := False;
+ DTR := False;
+ FileClose(FHandle);
+ end;
+ if InstanceActive then
+ begin
+ {$IFDEF UNIX}
+ if FLinuxLock then
+ cpomReleaseComport;
+ {$ENDIF}
+ FInstanceActive:= false
+ end;
+ Fhandle := INVALID_HANDLE_VALUE;
+ FComNr:= PortIsClosed;
+ SetSynaError(sOK);
+ DoStatus(HR_SerialClose, FDevice);
+end;
+
+{$IFDEF MSWINDOWS}
+function TBlockSerial.GetPortAddr: Word;
+begin
+ Result := 0;
+ if Win32Platform <> VER_PLATFORM_WIN32_NT then
+ begin
+ EscapeCommFunction(FHandle, 10);
+ asm
+ MOV @Result, DX;
+ end;
+ end;
+end;
+
+function TBlockSerial.ReadTxEmpty(PortAddr: Word): Boolean;
+begin
+ Result := True;
+ if Win32Platform <> VER_PLATFORM_WIN32_NT then
+ begin
+ asm
+ MOV DX, PortAddr;
+ ADD DX, 5;
+ IN AL, DX;
+ AND AL, $40;
+ JZ @K;
+ MOV AL,1;
+ @K: MOV @Result, AL;
+ end;
+ end;
+end;
+{$ENDIF}
+
+procedure TBlockSerial.GetComNr(Value: string);
+begin
+ FComNr := PortIsClosed;
+ if pos('COM', uppercase(Value)) = 1 then
+ FComNr := StrToIntdef(copy(Value, 4, Length(Value) - 3), PortIsClosed + 1) - 1;
+ if pos('/DEV/TTYS', uppercase(Value)) = 1 then
+ FComNr := StrToIntdef(copy(Value, 10, Length(Value) - 9), PortIsClosed - 1);
+end;
+
+procedure TBlockSerial.SetBandwidth(Value: Integer);
+begin
+ MaxSendBandwidth := Value;
+ MaxRecvBandwidth := Value;
+end;
+
+procedure TBlockSerial.LimitBandwidth(Length: Integer; MaxB: integer; var Next: LongWord);
+var
+ x: LongWord;
+ y: LongWord;
+begin
+ if MaxB > 0 then
+ begin
+ y := GetTick;
+ if Next > y then
+ begin
+ x := Next - y;
+ if x > 0 then
+ begin
+ DoStatus(HR_Wait, IntToStr(x));
+ sleep(x);
+ end;
+ end;
+ Next := GetTick + Trunc((Length / MaxB) * 1000);
+ end;
+end;
+
+procedure TBlockSerial.Config(baud, bits: integer; parity: char; stop: integer;
+ softflow, hardflow: boolean);
+begin
+ FillChar(dcb, SizeOf(dcb), 0);
+ GetCommState;
+ dcb.DCBlength := SizeOf(dcb);
+ dcb.BaudRate := baud;
+ dcb.ByteSize := bits;
+ case parity of
+ 'N', 'n': dcb.parity := 0;
+ 'O', 'o': dcb.parity := 1;
+ 'E', 'e': dcb.parity := 2;
+ 'M', 'm': dcb.parity := 3;
+ 'S', 's': dcb.parity := 4;
+ end;
+ dcb.StopBits := stop;
+ dcb.XonChar := #17;
+ dcb.XoffChar := #19;
+ dcb.XonLim := FRecvBuffer div 4;
+ dcb.XoffLim := FRecvBuffer div 4;
+ dcb.Flags := dcb_Binary;
+ if softflow then
+ dcb.Flags := dcb.Flags or dcb_OutX or dcb_InX;
+ if hardflow then
+ dcb.Flags := dcb.Flags or dcb_OutxCtsFlow or dcb_RtsControlHandshake
+ else
+ dcb.Flags := dcb.Flags or dcb_RtsControlEnable;
+ dcb.Flags := dcb.Flags or dcb_DtrControlEnable;
+ if dcb.Parity > 0 then
+ dcb.Flags := dcb.Flags or dcb_ParityCheck;
+ SetCommState;
+end;
+
+procedure TBlockSerial.Connect(comport: string);
+{$IFDEF MSWINDOWS}
+var
+ CommTimeouts: TCommTimeouts;
+{$ENDIF}
+begin
+ // Is this TBlockSerial Instance already busy?
+ if InstanceActive then {HGJ}
+ begin {HGJ}
+ RaiseSynaError(ErrAlreadyInUse);
+ Exit; {HGJ}
+ end; {HGJ}
+ FBuffer := '';
+ FDevice := comport;
+ GetComNr(comport);
+{$IFDEF MSWINDOWS}
+ SetLastError (sOK);
+{$ELSE}
+ {$IFNDEF FPC}
+ SetLastError (sOK);
+ {$ELSE}
+ fpSetErrno(sOK);
+ {$ENDIF}
+{$ENDIF}
+{$IFNDEF MSWINDOWS}
+ if FComNr <> PortIsClosed then
+ FDevice := '/dev/ttyS' + IntToStr(FComNr);
+ // Comport already owned by another process? {HGJ}
+ if FLinuxLock then
+ if not cpomComportAccessible then
+ begin
+ RaiseSynaError(ErrAlreadyOwned);
+ Exit;
+ end;
+{$IFNDEF FPC}
+ FHandle := THandle(Libc.open(pchar(FDevice), O_RDWR or O_SYNC));
+{$ELSE}
+ FHandle := THandle(fpOpen(FDevice, O_RDWR or O_SYNC));
+{$ENDIF}
+ if FHandle = INVALID_HANDLE_VALUE then //because THandle is not integer on all platforms!
+ SerialCheck(-1)
+ else
+ SerialCheck(0);
+ {$IFDEF UNIX}
+ if FLastError <> sOK then
+ if FLinuxLock then
+ cpomReleaseComport;
+ {$ENDIF}
+ ExceptCheck;
+ if FLastError <> sOK then
+ Exit;
+{$ELSE}
+ if FComNr <> PortIsClosed then
+ FDevice := '\\.\COM' + IntToStr(FComNr + 1);
+ FHandle := THandle(CreateFile(PChar(FDevice), GENERIC_READ or GENERIC_WRITE,
+ 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL or FILE_FLAG_OVERLAPPED, 0));
+ if FHandle = INVALID_HANDLE_VALUE then //because THandle is not integer on all platforms!
+ SerialCheck(-1)
+ else
+ SerialCheck(0);
+ ExceptCheck;
+ if FLastError <> sOK then
+ Exit;
+ SetCommMask(FHandle, 0);
+ SetupComm(Fhandle, FRecvBuffer, 0);
+ CommTimeOuts.ReadIntervalTimeout := MAXWORD;
+ CommTimeOuts.ReadTotalTimeoutMultiplier := 0;
+ CommTimeOuts.ReadTotalTimeoutConstant := 0;
+ CommTimeOuts.WriteTotalTimeoutMultiplier := 0;
+ CommTimeOuts.WriteTotalTimeoutConstant := 0;
+ SetCommTimeOuts(FHandle, CommTimeOuts);
+ FPortAddr := GetPortAddr;
+{$ENDIF}
+ SetSynaError(sOK);
+ if not TestCtrlLine then {HGJ}
+ begin
+ SetSynaError(ErrNoDeviceAnswer);
+ FileClose(FHandle); {HGJ}
+ {$IFDEF UNIX}
+ if FLinuxLock then
+ cpomReleaseComport; {HGJ}
+ {$ENDIF} {HGJ}
+ Fhandle := INVALID_HANDLE_VALUE; {HGJ}
+ FComNr:= PortIsClosed; {HGJ}
+ end
+ else
+ begin
+ FInstanceActive:= True;
+ RTS := True;
+ DTR := True;
+ Purge;
+ end;
+ ExceptCheck;
+ DoStatus(HR_Connect, FDevice);
+end;
+
+function TBlockSerial.SendBuffer(buffer: pointer; length: integer): integer;
+{$IFDEF MSWINDOWS}
+var
+ Overlapped: TOverlapped;
+ x, y, Err: DWord;
+{$ENDIF}
+begin
+ Result := 0;
+ if PreTestFailing then {HGJ}
+ Exit; {HGJ}
+ LimitBandwidth(Length, FMaxSendBandwidth, FNextsend);
+ if FRTSToggle then
+ begin
+ Flush;
+ RTS := True;
+ end;
+{$IFNDEF MSWINDOWS}
+ result := FileWrite(Fhandle, Buffer^, Length);
+ serialcheck(result);
+{$ELSE}
+ FillChar(Overlapped, Sizeof(Overlapped), 0);
+ SetSynaError(sOK);
+ y := 0;
+ if not WriteFile(FHandle, Buffer^, Length, DWord(Result), @Overlapped) then
+ y := GetLastError;
+ if y = ERROR_IO_PENDING then
+ begin
+ x := WaitForSingleObject(FHandle, FDeadlockTimeout);
+ if x = WAIT_TIMEOUT then
+ begin
+ PurgeComm(FHandle, PURGE_TXABORT);
+ SetSynaError(ErrTimeout);
+ end;
+ GetOverlappedResult(FHandle, Overlapped, Dword(Result), False);
+ end
+ else
+ SetSynaError(y);
+ ClearCommError(FHandle, err, nil);
+ if err <> 0 then
+ DecodeCommError(err);
+{$ENDIF}
+ if FRTSToggle then
+ begin
+ Flush;
+ CanWrite(255);
+ RTS := False;
+ end;
+ ExceptCheck;
+ DoStatus(HR_WriteCount, IntToStr(Result));
+end;
+
+procedure TBlockSerial.SendByte(data: byte);
+begin
+ SendBuffer(@Data, 1);
+end;
+
+procedure TBlockSerial.SendString(data: AnsiString);
+begin
+ SendBuffer(Pointer(Data), Length(Data));
+end;
+
+procedure TBlockSerial.SendInteger(Data: integer);
+begin
+ SendBuffer(@data, SizeOf(Data));
+end;
+
+procedure TBlockSerial.SendBlock(const Data: AnsiString);
+begin
+ SendInteger(Length(data));
+ SendString(Data);
+end;
+
+procedure TBlockSerial.SendStreamRaw(const Stream: TStream);
+var
+ si: integer;
+ x, y, yr: integer;
+ s: AnsiString;
+begin
+ si := Stream.Size - Stream.Position;
+ x := 0;
+ while x < si do
+ begin
+ y := si - x;
+ if y > cSerialChunk then
+ y := cSerialChunk;
+ Setlength(s, y);
+ yr := Stream.read(PAnsiChar(s)^, y);
+ if yr > 0 then
+ begin
+ SetLength(s, yr);
+ SendString(s);
+ Inc(x, yr);
+ end
+ else
+ break;
+ end;
+end;
+
+procedure TBlockSerial.SendStreamIndy(const Stream: TStream);
+var
+ si: integer;
+begin
+ si := Stream.Size - Stream.Position;
+ si := Swapbytes(si);
+ SendInteger(si);
+ SendStreamRaw(Stream);
+end;
+
+procedure TBlockSerial.SendStream(const Stream: TStream);
+var
+ si: integer;
+begin
+ si := Stream.Size - Stream.Position;
+ SendInteger(si);
+ SendStreamRaw(Stream);
+end;
+
+function TBlockSerial.RecvBuffer(buffer: pointer; length: integer): integer;
+{$IFNDEF MSWINDOWS}
+begin
+ Result := 0;
+ if PreTestFailing then {HGJ}
+ Exit; {HGJ}
+ LimitBandwidth(Length, FMaxRecvBandwidth, FNextRecv);
+ result := FileRead(FHandle, Buffer^, length);
+ serialcheck(result);
+{$ELSE}
+var
+ Overlapped: TOverlapped;
+ x, y, Err: DWord;
+begin
+ Result := 0;
+ if PreTestFailing then {HGJ}
+ Exit; {HGJ}
+ LimitBandwidth(Length, FMaxRecvBandwidth, FNextRecv);
+ FillChar(Overlapped, Sizeof(Overlapped), 0);
+ SetSynaError(sOK);
+ y := 0;
+ if not ReadFile(FHandle, Buffer^, length, Dword(Result), @Overlapped) then
+ y := GetLastError;
+ if y = ERROR_IO_PENDING then
+ begin
+ x := WaitForSingleObject(FHandle, FDeadlockTimeout);
+ if x = WAIT_TIMEOUT then
+ begin
+ PurgeComm(FHandle, PURGE_RXABORT);
+ SetSynaError(ErrTimeout);
+ end;
+ GetOverlappedResult(FHandle, Overlapped, Dword(Result), False);
+ end
+ else
+ SetSynaError(y);
+ ClearCommError(FHandle, err, nil);
+ if err <> 0 then
+ DecodeCommError(err);
+{$ENDIF}
+ ExceptCheck;
+ DoStatus(HR_ReadCount, IntToStr(Result));
+end;
+
+function TBlockSerial.RecvBufferEx(buffer: pointer; length: integer; timeout: integer): integer;
+var
+ s: AnsiString;
+ rl, l: integer;
+ ti: LongWord;
+begin
+ Result := 0;
+ if PreTestFailing then {HGJ}
+ Exit; {HGJ}
+ SetSynaError(sOK);
+ rl := 0;
+ repeat
+ ti := GetTick;
+ s := RecvPacket(Timeout);
+ l := System.Length(s);
+ if (rl + l) > Length then
+ l := Length - rl;
+ Move(Pointer(s)^, IncPoint(Buffer, rl)^, l);
+ rl := rl + l;
+ if FLastError <> sOK then
+ Break;
+ if rl >= Length then
+ Break;
+ if not FInterPacketTimeout then
+ begin
+ Timeout := Timeout - integer(TickDelta(ti, GetTick));
+ if Timeout <= 0 then
+ begin
+ SetSynaError(ErrTimeout);
+ Break;
+ end;
+ end;
+ until False;
+ delete(s, 1, l);
+ FBuffer := s;
+ Result := rl;
+end;
+
+function TBlockSerial.RecvBufferStr(Length: Integer; Timeout: Integer): AnsiString;
+var
+ x: integer;
+begin
+ Result := '';
+ if PreTestFailing then {HGJ}
+ Exit; {HGJ}
+ SetSynaError(sOK);
+ if Length > 0 then
+ begin
+ Setlength(Result, Length);
+ x := RecvBufferEx(PAnsiChar(Result), Length , Timeout);
+ if FLastError = sOK then
+ SetLength(Result, x)
+ else
+ Result := '';
+ end;
+end;
+
+function TBlockSerial.RecvPacket(Timeout: Integer): AnsiString;
+var
+ x: integer;
+begin
+ Result := '';
+ if PreTestFailing then {HGJ}
+ Exit; {HGJ}
+ SetSynaError(sOK);
+ if FBuffer <> '' then
+ begin
+ Result := FBuffer;
+ FBuffer := '';
+ end
+ else
+ begin
+ //not drain CPU on large downloads...
+ Sleep(0);
+ x := WaitingData;
+ if x > 0 then
+ begin
+ SetLength(Result, x);
+ x := RecvBuffer(Pointer(Result), x);
+ if x >= 0 then
+ SetLength(Result, x);
+ end
+ else
+ begin
+ if CanRead(Timeout) then
+ begin
+ x := WaitingData;
+ if x = 0 then
+ SetSynaError(ErrTimeout);
+ if x > 0 then
+ begin
+ SetLength(Result, x);
+ x := RecvBuffer(Pointer(Result), x);
+ if x >= 0 then
+ SetLength(Result, x);
+ end;
+ end
+ else
+ SetSynaError(ErrTimeout);
+ end;
+ end;
+ ExceptCheck;
+end;
+
+
+function TBlockSerial.RecvByte(timeout: integer): byte;
+begin
+ Result := 0;
+ if PreTestFailing then {HGJ}
+ Exit; {HGJ}
+ SetSynaError(sOK);
+ if FBuffer = '' then
+ FBuffer := RecvPacket(Timeout);
+ if (FLastError = sOK) and (FBuffer <> '') then
+ begin
+ Result := Ord(FBuffer[1]);
+ System.Delete(FBuffer, 1, 1);
+ end;
+ ExceptCheck;
+end;
+
+function TBlockSerial.RecvTerminated(Timeout: Integer; const Terminator: AnsiString): AnsiString;
+var
+ x: Integer;
+ s: AnsiString;
+ l: Integer;
+ CorCRLF: Boolean;
+ t: ansistring;
+ tl: integer;
+ ti: LongWord;
+begin
+ Result := '';
+ if PreTestFailing then {HGJ}
+ Exit; {HGJ}
+ SetSynaError(sOK);
+ l := system.Length(Terminator);
+ if l = 0 then
+ Exit;
+ tl := l;
+ CorCRLF := FConvertLineEnd and (Terminator = CRLF);
+ s := '';
+ x := 0;
+ repeat
+ ti := GetTick;
+ //get rest of FBuffer or incomming new data...
+ s := s + RecvPacket(Timeout);
+ if FLastError <> sOK then
+ Break;
+ x := 0;
+ if Length(s) > 0 then
+ if CorCRLF then
+ begin
+ if FLastCR and (s[1] = LF) then
+ Delete(s, 1, 1);
+ if FLastLF and (s[1] = CR) then
+ Delete(s, 1, 1);
+ FLastCR := False;
+ FLastLF := False;
+ t := '';
+ x := PosCRLF(s, t);
+ tl := system.Length(t);
+ if t = CR then
+ FLastCR := True;
+ if t = LF then
+ FLastLF := True;
+ end
+ else
+ begin
+ x := pos(Terminator, s);
+ tl := l;
+ end;
+ if (FMaxLineLength <> 0) and (system.Length(s) > FMaxLineLength) then
+ begin
+ SetSynaError(ErrMaxBuffer);
+ Break;
+ end;
+ if x > 0 then
+ Break;
+ if not FInterPacketTimeout then
+ begin
+ Timeout := Timeout - integer(TickDelta(ti, GetTick));
+ if Timeout <= 0 then
+ begin
+ SetSynaError(ErrTimeout);
+ Break;
+ end;
+ end;
+ until False;
+ if x > 0 then
+ begin
+ Result := Copy(s, 1, x - 1);
+ System.Delete(s, 1, x + tl - 1);
+ end;
+ FBuffer := s;
+ ExceptCheck;
+end;
+
+
+function TBlockSerial.RecvString(Timeout: Integer): AnsiString;
+var
+ s: AnsiString;
+begin
+ Result := '';
+ s := RecvTerminated(Timeout, #13 + #10);
+ if FLastError = sOK then
+ Result := s;
+end;
+
+function TBlockSerial.RecvInteger(Timeout: Integer): Integer;
+var
+ s: AnsiString;
+begin
+ Result := 0;
+ s := RecvBufferStr(4, Timeout);
+ if FLastError = 0 then
+ Result := (ord(s[1]) + ord(s[2]) * 256) + (ord(s[3]) + ord(s[4]) * 256) * 65536;
+end;
+
+function TBlockSerial.RecvBlock(Timeout: Integer): AnsiString;
+var
+ x: integer;
+begin
+ Result := '';
+ x := RecvInteger(Timeout);
+ if FLastError = 0 then
+ Result := RecvBufferStr(x, Timeout);
+end;
+
+procedure TBlockSerial.RecvStreamRaw(const Stream: TStream; Timeout: Integer);
+var
+ s: AnsiString;
+begin
+ repeat
+ s := RecvPacket(Timeout);
+ if FLastError = 0 then
+ WriteStrToStream(Stream, s);
+ until FLastError <> 0;
+end;
+
+procedure TBlockSerial.RecvStreamSize(const Stream: TStream; Timeout: Integer; Size: Integer);
+var
+ s: AnsiString;
+ n: integer;
+begin
+ for n := 1 to (Size div cSerialChunk) do
+ begin
+ s := RecvBufferStr(cSerialChunk, Timeout);
+ if FLastError <> 0 then
+ Exit;
+ Stream.Write(PAnsichar(s)^, cSerialChunk);
+ end;
+ n := Size mod cSerialChunk;
+ if n > 0 then
+ begin
+ s := RecvBufferStr(n, Timeout);
+ if FLastError <> 0 then
+ Exit;
+ Stream.Write(PAnsichar(s)^, n);
+ end;
+end;
+
+procedure TBlockSerial.RecvStreamIndy(const Stream: TStream; Timeout: Integer);
+var
+ x: integer;
+begin
+ x := RecvInteger(Timeout);
+ x := SwapBytes(x);
+ if FLastError = 0 then
+ RecvStreamSize(Stream, Timeout, x);
+end;
+
+procedure TBlockSerial.RecvStream(const Stream: TStream; Timeout: Integer);
+var
+ x: integer;
+begin
+ x := RecvInteger(Timeout);
+ if FLastError = 0 then
+ RecvStreamSize(Stream, Timeout, x);
+end;
+
+{$IFNDEF MSWINDOWS}
+function TBlockSerial.WaitingData: integer;
+begin
+{$IFNDEF FPC}
+ serialcheck(ioctl(FHandle, FIONREAD, @result));
+{$ELSE}
+ serialcheck(fpIoctl(FHandle, FIONREAD, @result));
+{$ENDIF}
+ if FLastError <> 0 then
+ Result := 0;
+ ExceptCheck;
+end;
+{$ELSE}
+function TBlockSerial.WaitingData: integer;
+var
+ stat: TComStat;
+ err: DWORD;
+begin
+ if ClearCommError(FHandle, err, @stat) then
+ begin
+ SetSynaError(sOK);
+ Result := stat.cbInQue;
+ end
+ else
+ begin
+ SerialCheck(sErr);
+ Result := 0;
+ end;
+ ExceptCheck;
+end;
+{$ENDIF}
+
+function TBlockSerial.WaitingDataEx: integer;
+begin
+ if FBuffer <> '' then
+ Result := Length(FBuffer)
+ else
+ Result := Waitingdata;
+end;
+
+{$IFNDEF MSWINDOWS}
+function TBlockSerial.SendingData: integer;
+begin
+ SetSynaError(sOK);
+ Result := 0;
+end;
+{$ELSE}
+function TBlockSerial.SendingData: integer;
+var
+ stat: TComStat;
+ err: DWORD;
+begin
+ SetSynaError(sOK);
+ if not ClearCommError(FHandle, err, @stat) then
+ serialcheck(sErr);
+ ExceptCheck;
+ result := stat.cbOutQue;
+end;
+{$ENDIF}
+
+{$IFNDEF MSWINDOWS}
+procedure TBlockSerial.DcbToTermios(const dcb: TDCB; var term: termios);
+var
+ n: integer;
+ x: cardinal;
+begin
+ //others
+ cfmakeraw(term);
+ term.c_cflag := term.c_cflag or CREAD;
+ term.c_cflag := term.c_cflag or CLOCAL;
+ term.c_cflag := term.c_cflag or HUPCL;
+ //hardware handshake
+ if (dcb.flags and dcb_RtsControlHandshake) > 0 then
+ term.c_cflag := term.c_cflag or CRTSCTS
+ else
+ term.c_cflag := term.c_cflag and (not CRTSCTS);
+ //software handshake
+ if (dcb.flags and dcb_OutX) > 0 then
+ term.c_iflag := term.c_iflag or IXON or IXOFF or IXANY
+ else
+ term.c_iflag := term.c_iflag and (not (IXON or IXOFF or IXANY));
+ //size of byte
+ term.c_cflag := term.c_cflag and (not CSIZE);
+ case dcb.bytesize of
+ 5:
+ term.c_cflag := term.c_cflag or CS5;
+ 6:
+ term.c_cflag := term.c_cflag or CS6;
+ 7:
+{$IFDEF FPC}
+ term.c_cflag := term.c_cflag or CS7;
+{$ELSE}
+ term.c_cflag := term.c_cflag or CS7fix;
+{$ENDIF}
+ 8:
+ term.c_cflag := term.c_cflag or CS8;
+ end;
+ //parity
+ if (dcb.flags and dcb_ParityCheck) > 0 then
+ term.c_cflag := term.c_cflag or PARENB
+ else
+ term.c_cflag := term.c_cflag and (not PARENB);
+ case dcb.parity of
+ 1: //'O'
+ term.c_cflag := term.c_cflag or PARODD;
+ 2: //'E'
+ term.c_cflag := term.c_cflag and (not PARODD);
+ end;
+ //stop bits
+ if dcb.stopbits > 0 then
+ term.c_cflag := term.c_cflag or CSTOPB
+ else
+ term.c_cflag := term.c_cflag and (not CSTOPB);
+ //set baudrate;
+ x := 0;
+ for n := 0 to Maxrates do
+ if rates[n, 0] = dcb.BaudRate then
+ begin
+ x := rates[n, 1];
+ break;
+ end;
+ cfsetospeed(term, x);
+ cfsetispeed(term, x);
+end;
+
+procedure TBlockSerial.TermiosToDcb(const term: termios; var dcb: TDCB);
+var
+ n: integer;
+ x: cardinal;
+begin
+ //set baudrate;
+ dcb.baudrate := 0;
+ {$IFDEF FPC}
+ //why FPC not have cfgetospeed???
+ x := term.c_oflag and $0F;
+ {$ELSE}
+ x := cfgetospeed(term);
+ {$ENDIF}
+ for n := 0 to Maxrates do
+ if rates[n, 1] = x then
+ begin
+ dcb.baudrate := rates[n, 0];
+ break;
+ end;
+ //hardware handshake
+ if (term.c_cflag and CRTSCTS) > 0 then
+ dcb.flags := dcb.flags or dcb_RtsControlHandshake or dcb_OutxCtsFlow
+ else
+ dcb.flags := dcb.flags and (not (dcb_RtsControlHandshake or dcb_OutxCtsFlow));
+ //software handshake
+ if (term.c_cflag and IXOFF) > 0 then
+ dcb.flags := dcb.flags or dcb_OutX or dcb_InX
+ else
+ dcb.flags := dcb.flags and (not (dcb_OutX or dcb_InX));
+ //size of byte
+ case term.c_cflag and CSIZE of
+ CS5:
+ dcb.bytesize := 5;
+ CS6:
+ dcb.bytesize := 6;
+ CS7fix:
+ dcb.bytesize := 7;
+ CS8:
+ dcb.bytesize := 8;
+ end;
+ //parity
+ if (term.c_cflag and PARENB) > 0 then
+ dcb.flags := dcb.flags or dcb_ParityCheck
+ else
+ dcb.flags := dcb.flags and (not dcb_ParityCheck);
+ dcb.parity := 0;
+ if (term.c_cflag and PARODD) > 0 then
+ dcb.parity := 1
+ else
+ dcb.parity := 2;
+ //stop bits
+ if (term.c_cflag and CSTOPB) > 0 then
+ dcb.stopbits := 2
+ else
+ dcb.stopbits := 0;
+end;
+{$ENDIF}
+
+{$IFNDEF MSWINDOWS}
+procedure TBlockSerial.SetCommState;
+begin
+ DcbToTermios(dcb, termiosstruc);
+ SerialCheck(tcsetattr(FHandle, TCSANOW, termiosstruc));
+ ExceptCheck;
+end;
+{$ELSE}
+procedure TBlockSerial.SetCommState;
+begin
+ SetSynaError(sOK);
+ if not windows.SetCommState(Fhandle, dcb) then
+ SerialCheck(sErr);
+ ExceptCheck;
+end;
+{$ENDIF}
+
+{$IFNDEF MSWINDOWS}
+procedure TBlockSerial.GetCommState;
+begin
+ SerialCheck(tcgetattr(FHandle, termiosstruc));
+ ExceptCheck;
+ TermiostoDCB(termiosstruc, dcb);
+end;
+{$ELSE}
+procedure TBlockSerial.GetCommState;
+begin
+ SetSynaError(sOK);
+ if not windows.GetCommState(Fhandle, dcb) then
+ SerialCheck(sErr);
+ ExceptCheck;
+end;
+{$ENDIF}
+
+procedure TBlockSerial.SetSizeRecvBuffer(size: integer);
+begin
+{$IFDEF MSWINDOWS}
+ SetupComm(Fhandle, size, 0);
+ GetCommState;
+ dcb.XonLim := size div 4;
+ dcb.XoffLim := size div 4;
+ SetCommState;
+{$ENDIF}
+ FRecvBuffer := size;
+end;
+
+function TBlockSerial.GetDSR: Boolean;
+begin
+ ModemStatus;
+{$IFNDEF MSWINDOWS}
+ Result := (FModemWord and TIOCM_DSR) > 0;
+{$ELSE}
+ Result := (FModemWord and MS_DSR_ON) > 0;
+{$ENDIF}
+end;
+
+procedure TBlockSerial.SetDTRF(Value: Boolean);
+begin
+{$IFNDEF MSWINDOWS}
+ ModemStatus;
+ if Value then
+ FModemWord := FModemWord or TIOCM_DTR
+ else
+ FModemWord := FModemWord and not TIOCM_DTR;
+ {$IFNDEF FPC}
+ ioctl(FHandle, TIOCMSET, @FModemWord);
+ {$ELSE}
+ fpioctl(FHandle, TIOCMSET, @FModemWord);
+ {$ENDIF}
+{$ELSE}
+ if Value then
+ EscapeCommFunction(FHandle, SETDTR)
+ else
+ EscapeCommFunction(FHandle, CLRDTR);
+{$ENDIF}
+end;
+
+function TBlockSerial.GetCTS: Boolean;
+begin
+ ModemStatus;
+{$IFNDEF MSWINDOWS}
+ Result := (FModemWord and TIOCM_CTS) > 0;
+{$ELSE}
+ Result := (FModemWord and MS_CTS_ON) > 0;
+{$ENDIF}
+end;
+
+procedure TBlockSerial.SetRTSF(Value: Boolean);
+begin
+{$IFNDEF MSWINDOWS}
+ ModemStatus;
+ if Value then
+ FModemWord := FModemWord or TIOCM_RTS
+ else
+ FModemWord := FModemWord and not TIOCM_RTS;
+ {$IFNDEF FPC}
+ ioctl(FHandle, TIOCMSET, @FModemWord);
+ {$ELSE}
+ fpioctl(FHandle, TIOCMSET, @FModemWord);
+ {$ENDIF}
+{$ELSE}
+ if Value then
+ EscapeCommFunction(FHandle, SETRTS)
+ else
+ EscapeCommFunction(FHandle, CLRRTS);
+{$ENDIF}
+end;
+
+function TBlockSerial.GetCarrier: Boolean;
+begin
+ ModemStatus;
+{$IFNDEF MSWINDOWS}
+ Result := (FModemWord and TIOCM_CAR) > 0;
+{$ELSE}
+ Result := (FModemWord and MS_RLSD_ON) > 0;
+{$ENDIF}
+end;
+
+function TBlockSerial.GetRing: Boolean;
+begin
+ ModemStatus;
+{$IFNDEF MSWINDOWS}
+ Result := (FModemWord and TIOCM_RNG) > 0;
+{$ELSE}
+ Result := (FModemWord and MS_RING_ON) > 0;
+{$ENDIF}
+end;
+
+{$IFDEF MSWINDOWS}
+function TBlockSerial.CanEvent(Event: dword; Timeout: integer): boolean;
+var
+ ex: DWord;
+ y: Integer;
+ Overlapped: TOverlapped;
+begin
+ FillChar(Overlapped, Sizeof(Overlapped), 0);
+ Overlapped.hEvent := CreateEvent(nil, True, False, nil);
+ try
+ SetCommMask(FHandle, Event);
+ SetSynaError(sOK);
+ if (Event = EV_RXCHAR) and (Waitingdata > 0) then
+ Result := True
+ else
+ begin
+ y := 0;
+ if not WaitCommEvent(FHandle, ex, @Overlapped) then
+ y := GetLastError;
+ if y = ERROR_IO_PENDING then
+ begin
+ //timedout
+ WaitForSingleObject(Overlapped.hEvent, Timeout);
+ SetCommMask(FHandle, 0);
+ GetOverlappedResult(FHandle, Overlapped, DWord(y), True);
+ end;
+ Result := (ex and Event) = Event;
+ end;
+ finally
+ SetCommMask(FHandle, 0);
+ CloseHandle(Overlapped.hEvent);
+ end;
+end;
+{$ENDIF}
+
+{$IFNDEF MSWINDOWS}
+function TBlockSerial.CanRead(Timeout: integer): boolean;
+var
+ FDSet: TFDSet;
+ TimeVal: PTimeVal;
+ TimeV: TTimeVal;
+ x: Integer;
+begin
+ TimeV.tv_usec := (Timeout mod 1000) * 1000;
+ TimeV.tv_sec := Timeout div 1000;
+ TimeVal := @TimeV;
+ if Timeout = -1 then
+ TimeVal := nil;
+ {$IFNDEF FPC}
+ FD_ZERO(FDSet);
+ FD_SET(FHandle, FDSet);
+ x := Select(FHandle + 1, @FDSet, nil, nil, TimeVal);
+ {$ELSE}
+ fpFD_ZERO(FDSet);
+ fpFD_SET(FHandle, FDSet);
+ x := fpSelect(FHandle + 1, @FDSet, nil, nil, TimeVal);
+ {$ENDIF}
+ SerialCheck(x);
+ if FLastError <> sOK then
+ x := 0;
+ Result := x > 0;
+ ExceptCheck;
+ if Result then
+ DoStatus(HR_CanRead, '');
+end;
+{$ELSE}
+function TBlockSerial.CanRead(Timeout: integer): boolean;
+begin
+ Result := WaitingData > 0;
+ if not Result then
+ Result := CanEvent(EV_RXCHAR, Timeout) or (WaitingData > 0);
+ //check WaitingData again due some broken virtual ports
+ if Result then
+ DoStatus(HR_CanRead, '');
+end;
+{$ENDIF}
+
+{$IFNDEF MSWINDOWS}
+function TBlockSerial.CanWrite(Timeout: integer): boolean;
+var
+ FDSet: TFDSet;
+ TimeVal: PTimeVal;
+ TimeV: TTimeVal;
+ x: Integer;
+begin
+ TimeV.tv_usec := (Timeout mod 1000) * 1000;
+ TimeV.tv_sec := Timeout div 1000;
+ TimeVal := @TimeV;
+ if Timeout = -1 then
+ TimeVal := nil;
+ {$IFNDEF FPC}
+ FD_ZERO(FDSet);
+ FD_SET(FHandle, FDSet);
+ x := Select(FHandle + 1, nil, @FDSet, nil, TimeVal);
+ {$ELSE}
+ fpFD_ZERO(FDSet);
+ fpFD_SET(FHandle, FDSet);
+ x := fpSelect(FHandle + 1, nil, @FDSet, nil, TimeVal);
+ {$ENDIF}
+ SerialCheck(x);
+ if FLastError <> sOK then
+ x := 0;
+ Result := x > 0;
+ ExceptCheck;
+ if Result then
+ DoStatus(HR_CanWrite, '');
+end;
+{$ELSE}
+function TBlockSerial.CanWrite(Timeout: integer): boolean;
+var
+ t: LongWord;
+begin
+ Result := SendingData = 0;
+ if not Result then
+ Result := CanEvent(EV_TXEMPTY, Timeout);
+ if Result and (Win32Platform <> VER_PLATFORM_WIN32_NT) then
+ begin
+ t := GetTick;
+ while not ReadTxEmpty(FPortAddr) do
+ begin
+ if TickDelta(t, GetTick) > 255 then
+ Break;
+ Sleep(0);
+ end;
+ end;
+ if Result then
+ DoStatus(HR_CanWrite, '');
+end;
+{$ENDIF}
+
+function TBlockSerial.CanReadEx(Timeout: integer): boolean;
+begin
+ if Fbuffer <> '' then
+ Result := True
+ else
+ Result := CanRead(Timeout);
+end;
+
+procedure TBlockSerial.EnableRTSToggle(Value: boolean);
+begin
+ SetSynaError(sOK);
+{$IFNDEF MSWINDOWS}
+ FRTSToggle := Value;
+ if Value then
+ RTS:=False;
+{$ELSE}
+ if Win32Platform = VER_PLATFORM_WIN32_NT then
+ begin
+ GetCommState;
+ if value then
+ dcb.Flags := dcb.Flags or dcb_RtsControlToggle
+ else
+ dcb.flags := dcb.flags and (not dcb_RtsControlToggle);
+ SetCommState;
+ end
+ else
+ begin
+ FRTSToggle := Value;
+ if Value then
+ RTS:=False;
+ end;
+{$ENDIF}
+end;
+
+procedure TBlockSerial.Flush;
+begin
+{$IFNDEF MSWINDOWS}
+ SerialCheck(tcdrain(FHandle));
+{$ELSE}
+ SetSynaError(sOK);
+ if not Flushfilebuffers(FHandle) then
+ SerialCheck(sErr);
+{$ENDIF}
+ ExceptCheck;
+end;
+
+{$IFNDEF MSWINDOWS}
+procedure TBlockSerial.Purge;
+begin
+ {$IFNDEF FPC}
+ SerialCheck(ioctl(FHandle, TCFLSH, TCIOFLUSH));
+ {$ELSE}
+ {$IFDEF DARWIN}
+ SerialCheck(fpioctl(FHandle, TCIOflush, TCIOFLUSH));
+ {$ELSE}
+ SerialCheck(fpioctl(FHandle, TCFLSH, Pointer(PtrInt(TCIOFLUSH))));
+ {$ENDIF}
+ {$ENDIF}
+ FBuffer := '';
+ ExceptCheck;
+end;
+{$ELSE}
+procedure TBlockSerial.Purge;
+var
+ x: integer;
+begin
+ SetSynaError(sOK);
+ x := PURGE_TXABORT or PURGE_TXCLEAR or PURGE_RXABORT or PURGE_RXCLEAR;
+ if not PurgeComm(FHandle, x) then
+ SerialCheck(sErr);
+ FBuffer := '';
+ ExceptCheck;
+end;
+{$ENDIF}
+
+function TBlockSerial.ModemStatus: integer;
+begin
+ Result := 0;
+{$IFNDEF MSWINDOWS}
+ {$IFNDEF FPC}
+ SerialCheck(ioctl(FHandle, TIOCMGET, @Result));
+ {$ELSE}
+ SerialCheck(fpioctl(FHandle, TIOCMGET, @Result));
+ {$ENDIF}
+{$ELSE}
+ SetSynaError(sOK);
+ if not GetCommModemStatus(FHandle, dword(Result)) then
+ SerialCheck(sErr);
+{$ENDIF}
+ ExceptCheck;
+ FModemWord := Result;
+end;
+
+procedure TBlockSerial.SetBreak(Duration: integer);
+begin
+{$IFNDEF MSWINDOWS}
+ SerialCheck(tcsendbreak(FHandle, Duration));
+{$ELSE}
+ SetCommBreak(FHandle);
+ Sleep(Duration);
+ SetSynaError(sOK);
+ if not ClearCommBreak(FHandle) then
+ SerialCheck(sErr);
+{$ENDIF}
+end;
+
+{$IFDEF MSWINDOWS}
+procedure TBlockSerial.DecodeCommError(Error: DWord);
+begin
+ if (Error and DWord(CE_FRAME)) > 1 then
+ FLastError := ErrFrame;
+ if (Error and DWord(CE_OVERRUN)) > 1 then
+ FLastError := ErrOverrun;
+ if (Error and DWord(CE_RXOVER)) > 1 then
+ FLastError := ErrRxOver;
+ if (Error and DWord(CE_RXPARITY)) > 1 then
+ FLastError := ErrRxParity;
+ if (Error and DWord(CE_TXFULL)) > 1 then
+ FLastError := ErrTxFull;
+end;
+{$ENDIF}
+
+//HGJ
+function TBlockSerial.PreTestFailing: Boolean;
+begin
+ if not FInstanceActive then
+ begin
+ RaiseSynaError(ErrPortNotOpen);
+ result:= true;
+ Exit;
+ end;
+ Result := not TestCtrlLine;
+ if result then
+ RaiseSynaError(ErrNoDeviceAnswer)
+end;
+
+function TBlockSerial.TestCtrlLine: Boolean;
+begin
+ result := ((not FTestDSR) or DSR) and ((not FTestCTS) or CTS);
+end;
+
+function TBlockSerial.ATCommand(value: AnsiString): AnsiString;
+var
+ s: AnsiString;
+ ConvSave: Boolean;
+begin
+ result := '';
+ FAtResult := False;
+ ConvSave := FConvertLineEnd;
+ try
+ FConvertLineEnd := True;
+ SendString(value + #$0D);
+ repeat
+ s := RecvString(FAtTimeout);
+ if s <> Value then
+ result := result + s + CRLF;
+ if s = 'OK' then
+ begin
+ FAtResult := True;
+ break;
+ end;
+ if s = 'ERROR' then
+ break;
+ until FLastError <> sOK;
+ finally
+ FConvertLineEnd := Convsave;
+ end;
+end;
+
+
+function TBlockSerial.ATConnect(value: AnsiString): AnsiString;
+var
+ s: AnsiString;
+ ConvSave: Boolean;
+begin
+ result := '';
+ FAtResult := False;
+ ConvSave := FConvertLineEnd;
+ try
+ FConvertLineEnd := True;
+ SendString(value + #$0D);
+ repeat
+ s := RecvString(90 * FAtTimeout);
+ if s <> Value then
+ result := result + s + CRLF;
+ if s = 'NO CARRIER' then
+ break;
+ if s = 'ERROR' then
+ break;
+ if s = 'BUSY' then
+ break;
+ if s = 'NO DIALTONE' then
+ break;
+ if Pos('CONNECT', s) = 1 then
+ begin
+ FAtResult := True;
+ break;
+ end;
+ until FLastError <> sOK;
+ finally
+ FConvertLineEnd := Convsave;
+ end;
+end;
+
+function TBlockSerial.SerialCheck(SerialResult: integer): integer;
+begin
+ if SerialResult = integer(INVALID_HANDLE_VALUE) then
+{$IFDEF MSWINDOWS}
+ result := GetLastError
+{$ELSE}
+ {$IFNDEF FPC}
+ result := GetLastError
+ {$ELSE}
+ result := fpGetErrno
+ {$ENDIF}
+{$ENDIF}
+ else
+ result := sOK;
+ FLastError := result;
+ FLastErrorDesc := GetErrorDesc(FLastError);
+end;
+
+procedure TBlockSerial.ExceptCheck;
+var
+ e: ESynaSerError;
+ s: string;
+begin
+ if FRaiseExcept and (FLastError <> sOK) then
+ begin
+ s := GetErrorDesc(FLastError);
+ e := ESynaSerError.CreateFmt('Communication error %d: %s', [FLastError, s]);
+ e.ErrorCode := FLastError;
+ e.ErrorMessage := s;
+ raise e;
+ end;
+end;
+
+procedure TBlockSerial.SetSynaError(ErrNumber: integer);
+begin
+ FLastError := ErrNumber;
+ FLastErrorDesc := GetErrorDesc(FLastError);
+end;
+
+procedure TBlockSerial.RaiseSynaError(ErrNumber: integer);
+begin
+ SetSynaError(ErrNumber);
+ ExceptCheck;
+end;
+
+procedure TBlockSerial.DoStatus(Reason: THookSerialReason; const Value: string);
+begin
+ if assigned(OnStatus) then
+ OnStatus(Self, Reason, Value);
+end;
+
+{======================================================================}
+
+class function TBlockSerial.GetErrorDesc(ErrorCode: integer): string;
+begin
+ Result:= '';
+ case ErrorCode of
+ sOK: Result := 'OK';
+ ErrAlreadyOwned: Result := 'Port owned by other process';{HGJ}
+ ErrAlreadyInUse: Result := 'Instance already in use'; {HGJ}
+ ErrWrongParameter: Result := 'Wrong parameter at call'; {HGJ}
+ ErrPortNotOpen: Result := 'Instance not yet connected'; {HGJ}
+ ErrNoDeviceAnswer: Result := 'No device answer detected'; {HGJ}
+ ErrMaxBuffer: Result := 'Maximal buffer length exceeded';
+ ErrTimeout: Result := 'Timeout during operation';
+ ErrNotRead: Result := 'Reading of data failed';
+ ErrFrame: Result := 'Receive framing error';
+ ErrOverrun: Result := 'Receive Overrun Error';
+ ErrRxOver: Result := 'Receive Queue overflow';
+ ErrRxParity: Result := 'Receive Parity Error';
+ ErrTxFull: Result := 'Tranceive Queue is full';
+ end;
+ if Result = '' then
+ begin
+ Result := SysErrorMessage(ErrorCode);
+ end;
+end;
+
+
+{---------- cpom Comport Ownership Manager Routines -------------
+ by Hans-Georg Joepgen of Stuttgart, Germany.
+ Copyright (c) 2002, by Hans-Georg Joepgen
+
+ Stefan Krauss of Stuttgart, Germany, contributed literature and Internet
+ research results, invaluable advice and excellent answers to the Comport
+ Ownership Manager.
+}
+
+{$IFDEF UNIX}
+
+function TBlockSerial.LockfileName: String;
+var
+ s: string;
+begin
+ s := SeparateRight(FDevice, '/dev/');
+ result := LockfileDirectory + '/LCK..' + s;
+end;
+
+procedure TBlockSerial.CreateLockfile(PidNr: integer);
+var
+ f: TextFile;
+ s: string;
+begin
+ // Create content for file
+ s := IntToStr(PidNr);
+ while length(s) < 10 do
+ s := ' ' + s;
+ // Create file
+ try
+ AssignFile(f, LockfileName);
+ try
+ Rewrite(f);
+ writeln(f, s);
+ finally
+ CloseFile(f);
+ end;
+ // Allow all users to enjoy the benefits of cpom
+ s := 'chmod a+rw ' + LockfileName;
+{$IFNDEF FPC}
+ FileSetReadOnly( LockfileName, False ) ;
+ // Libc.system(pchar(s));
+{$ELSE}
+ fpSystem(s);
+{$ENDIF}
+ except
+ // not raise exception, if you not have write permission for lock.
+ on Exception do
+ ;
+ end;
+end;
+
+function TBlockSerial.ReadLockfile: integer;
+{Returns PID from Lockfile. Lockfile must exist.}
+var
+ f: TextFile;
+ s: string;
+begin
+ AssignFile(f, LockfileName);
+ Reset(f);
+ try
+ readln(f, s);
+ finally
+ CloseFile(f);
+ end;
+ Result := StrToIntDef(s, -1)
+end;
+
+function TBlockSerial.cpomComportAccessible: boolean;
+var
+ MyPid: integer;
+ Filename: string;
+begin
+ Filename := LockfileName;
+ {$IFNDEF FPC}
+ MyPid := Libc.getpid;
+ {$ELSE}
+ MyPid := fpGetPid;
+ {$ENDIF}
+ // Make sure, the Lock Files Directory exists. We need it.
+ if not DirectoryExists(LockfileDirectory) then
+ CreateDir(LockfileDirectory);
+ // Check the Lockfile
+ if not FileExists (Filename) then
+ begin // comport is not locked. Lock it for us.
+ CreateLockfile(MyPid);
+ result := true;
+ exit; // done.
+ end;
+ // Is port owned by orphan? Then it's time for error recovery.
+ //FPC forgot to add getsid.. :-(
+ {$IFNDEF FPC}
+ if Libc.getsid(ReadLockfile) = -1 then
+ begin // Lockfile was left from former desaster
+ DeleteFile(Filename); // error recovery
+ CreateLockfile(MyPid);
+ result := true;
+ exit;
+ end;
+ {$ENDIF}
+ result := false // Sorry, port is owned by living PID and locked
+end;
+
+procedure TBlockSerial.cpomReleaseComport;
+begin
+ DeleteFile(LockfileName);
+end;
+
+{$ENDIF}
+{----------------------------------------------------------------}
+
+{$IFDEF MSWINDOWS}
+function GetSerialPortNames: string;
+var
+ reg: TRegistry;
+ l, v: TStringList;
+ n: integer;
+begin
+ l := TStringList.Create;
+ v := TStringList.Create;
+ reg := TRegistry.Create;
+ try
+{$IFNDEF VER100}
+{$IFNDEF VER120}
+ reg.Access := KEY_READ;
+{$ENDIF}
+{$ENDIF}
+ reg.RootKey := HKEY_LOCAL_MACHINE;
+ reg.OpenKey('\HARDWARE\DEVICEMAP\SERIALCOMM', false);
+ reg.GetValueNames(l);
+ for n := 0 to l.Count - 1 do
+ v.Add(reg.ReadString(l[n]));
+ Result := v.CommaText;
+ finally
+ reg.Free;
+ l.Free;
+ v.Free;
+ end;
+end;
+{$ENDIF}
+{$IFNDEF MSWINDOWS}
+function GetSerialPortNames: string;
+var
+ Index: Integer;
+ Data: string;
+ TmpPorts: String;
+ sr : TSearchRec;
+begin
+ try
+ TmpPorts := '';
+ if FindFirst('/dev/ttyS*', $FFFFFFFF, sr) = 0 then
+ begin
+ repeat
+ if (sr.Attr and $FFFFFFFF) = Sr.Attr then
+ begin
+ data := sr.Name;
+ index := length(data);
+ while (index > 1) and (data[index] <> '/') do
+ index := index - 1;
+ TmpPorts := TmpPorts + ' ' + copy(data, 1, index + 1);
+ end;
+ until FindNext(sr) <> 0;
+ end;
+ FindClose(sr);
+ finally
+ Result:=TmpPorts;
+ end;
+end;
+{$ENDIF}
+
+end.
ADDED lib/synapse/source/lib/synautil.pas
Index: lib/synapse/source/lib/synautil.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/lib/synautil.pas
@@ -0,0 +1,2065 @@
+{==============================================================================|
+| Project : Ararat Synapse | 004.015.000 |
+|==============================================================================|
+| Content: support procedures and functions |
+|==============================================================================|
+| Copyright (c)1999-2012, Lukas Gebauer |
+| All rights reserved. |
+| |
+| Redistribution and use in source and binary forms, with or without |
+| modification, are permitted provided that the following conditions are met: |
+| |
+| Redistributions of source code must retain the above copyright notice, this |
+| list of conditions and the following disclaimer. |
+| |
+| Redistributions in binary form must reproduce the above copyright notice, |
+| this list of conditions and the following disclaimer in the documentation |
+| and/or other materials provided with the distribution. |
+| |
+| Neither the name of Lukas Gebauer nor the names of its contributors may |
+| be used to endorse or promote products derived from this software without |
+| specific prior written permission. |
+| |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
+| DAMAGE. |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c) 1999-2012. |
+| Portions created by Hernan Sanchez are Copyright (c) 2000. |
+| Portions created by Petr Fejfar are Copyright (c)2011-2012. |
+| All Rights Reserved. |
+|==============================================================================|
+| Contributor(s): |
+| Hernan Sanchez (hernan.sanchez@iname.com) |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package |
+| (Found at URL: http://www.ararat.cz/synapse/) |
+|==============================================================================}
+
+{:@abstract(Support procedures and functions)}
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+{$Q-}
+{$R-}
+{$H+}
+
+//old Delphi does not have MSWINDOWS define.
+{$IFDEF WIN32}
+ {$IFNDEF MSWINDOWS}
+ {$DEFINE MSWINDOWS}
+ {$ENDIF}
+{$ENDIF}
+
+{$IFDEF UNICODE}
+ {$WARN IMPLICIT_STRING_CAST OFF}
+ {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+ {$WARN SUSPICIOUS_TYPECAST OFF}
+{$ENDIF}
+
+unit synautil;
+
+interface
+
+uses
+{$IFDEF MSWINDOWS}
+ Windows,
+{$ELSE}
+ {$IFDEF FPC}
+ UnixUtil, Unix, BaseUnix,
+ {$ELSE}
+ Libc,
+ {$ENDIF}
+{$ENDIF}
+{$IFDEF CIL}
+ System.IO,
+{$ENDIF}
+ SysUtils, Classes, SynaFpc;
+
+{$IFDEF VER100}
+type
+ int64 = integer;
+{$ENDIF}
+
+{:Return your timezone bias from UTC time in minutes.}
+function TimeZoneBias: integer;
+
+{:Return your timezone bias from UTC time in string representation like "+0200".}
+function TimeZone: string;
+
+{:Returns current time in format defined in RFC-822. Useful for SMTP messages,
+ but other protocols use this time format as well. Results contains the timezone
+ specification. Four digit year is used to break any Y2K concerns. (Example
+ 'Fri, 15 Oct 1999 21:14:56 +0200')}
+function Rfc822DateTime(t: TDateTime): string;
+
+{:Returns date and time in format defined in C compilers in format "mmm dd hh:nn:ss"}
+function CDateTime(t: TDateTime): string;
+
+{:Returns date and time in format defined in format 'yymmdd hhnnss'}
+function SimpleDateTime(t: TDateTime): string;
+
+{:Returns date and time in format defined in ANSI C compilers in format
+ "ddd mmm d hh:nn:ss yyyy" }
+function AnsiCDateTime(t: TDateTime): string;
+
+{:Decode three-letter string with name of month to their month number. If string
+ not match any month name, then is returned 0. For parsing are used predefined
+ names for English, French and German and names from system locale too.}
+function GetMonthNumber(Value: String): integer;
+
+{:Return decoded time from given string. Time must be witch separator ':'. You
+ can use "hh:mm" or "hh:mm:ss".}
+function GetTimeFromStr(Value: string): TDateTime;
+
+{:Decode string in format "m-d-y" to TDateTime type.}
+function GetDateMDYFromStr(Value: string): TDateTime;
+
+{:Decode various string representations of date and time to Tdatetime type.
+ This function do all timezone corrections too! This function can decode lot of
+ formats like:
+ @longcode(#
+ ddd, d mmm yyyy hh:mm:ss
+ ddd, d mmm yy hh:mm:ss
+ ddd, mmm d yyyy hh:mm:ss
+ ddd mmm dd hh:mm:ss yyyy #)
+
+and more with lot of modifications, include:
+@longcode(#
+Sun, 06 Nov 1994 08:49:37 GMT ; RFC 822, updated by RFC 1123
+Sunday, 06-Nov-94 08:49:37 GMT ; RFC 850, obsoleted by RFC 1036
+Sun Nov 6 08:49:37 1994 ; ANSI C's asctime() Format
+#)
+Timezone corrections known lot of symbolic timezone names (like CEST, EDT, etc.)
+or numeric representation (like +0200). By convention defined in RFC timezone
+ +0000 is GMT and -0000 is current your system timezone.}
+function DecodeRfcDateTime(Value: string): TDateTime;
+
+{:Return current system date and time in UTC timezone.}
+function GetUTTime: TDateTime;
+
+{:Set Newdt as current system date and time in UTC timezone. This function work
+ only if you have administrator rights!}
+function SetUTTime(Newdt: TDateTime): Boolean;
+
+{:Return current value of system timer with precizion 1 millisecond. Good for
+ measure time difference.}
+function GetTick: LongWord;
+
+{:Return difference between two timestamps. It working fine only for differences
+ smaller then maxint. (difference must be smaller then 24 days.)}
+function TickDelta(TickOld, TickNew: LongWord): LongWord;
+
+{:Return two characters, which ordinal values represents the value in byte
+ format. (High-endian)}
+function CodeInt(Value: Word): Ansistring;
+
+{:Decodes two characters located at "Index" offset position of the "Value"
+ string to Word values.}
+function DecodeInt(const Value: Ansistring; Index: Integer): Word;
+
+{:Return four characters, which ordinal values represents the value in byte
+ format. (High-endian)}
+function CodeLongInt(Value: LongInt): Ansistring;
+
+{:Decodes four characters located at "Index" offset position of the "Value"
+ string to LongInt values.}
+function DecodeLongInt(const Value: Ansistring; Index: Integer): LongInt;
+
+{:Dump binary buffer stored in a string to a result string.}
+function DumpStr(const Buffer: Ansistring): string;
+
+{:Dump binary buffer stored in a string to a result string. All bytes with code
+ of character is written as character, not as hexadecimal value.}
+function DumpExStr(const Buffer: Ansistring): string;
+
+{:Dump binary buffer stored in a string to a file with DumpFile filename.}
+procedure Dump(const Buffer: AnsiString; DumpFile: string);
+
+{:Dump binary buffer stored in a string to a file with DumpFile filename. All
+ bytes with code of character is written as character, not as hexadecimal value.}
+procedure DumpEx(const Buffer: AnsiString; DumpFile: string);
+
+{:Like TrimLeft, but remove only spaces, not control characters!}
+function TrimSPLeft(const S: string): string;
+
+{:Like TrimRight, but remove only spaces, not control characters!}
+function TrimSPRight(const S: string): string;
+
+{:Like Trim, but remove only spaces, not control characters!}
+function TrimSP(const S: string): string;
+
+{:Returns a portion of the "Value" string located to the left of the "Delimiter"
+ string. If a delimiter is not found, results is original string.}
+function SeparateLeft(const Value, Delimiter: string): string;
+
+{:Returns the portion of the "Value" string located to the right of the
+ "Delimiter" string. If a delimiter is not found, results is original string.}
+function SeparateRight(const Value, Delimiter: string): string;
+
+{:Returns parameter value from string in format:
+ parameter1="value1"; parameter2=value2}
+function GetParameter(const Value, Parameter: string): string;
+
+{:parse value string with elements differed by Delimiter into stringlist.}
+procedure ParseParametersEx(Value, Delimiter: string; const Parameters: TStrings);
+
+{:parse value string with elements differed by ';' into stringlist.}
+procedure ParseParameters(Value: string; const Parameters: TStrings);
+
+{:Index of string in stringlist with same beginning as Value is returned.}
+function IndexByBegin(Value: string; const List: TStrings): integer;
+
+{:Returns only the e-mail portion of an address from the full address format.
+ i.e. returns 'nobody@@somewhere.com' from '"someone" '}
+function GetEmailAddr(const Value: string): string;
+
+{:Returns only the description part from a full address format. i.e. returns
+ 'someone' from '"someone" '}
+function GetEmailDesc(Value: string): string;
+
+{:Returns a string with hexadecimal digits representing the corresponding values
+ of the bytes found in "Value" string.}
+function StrToHex(const Value: Ansistring): string;
+
+{:Returns a string of binary "Digits" representing "Value".}
+function IntToBin(Value: Integer; Digits: Byte): string;
+
+{:Returns an integer equivalent of the binary string in "Value".
+ (i.e. ('10001010') returns 138)}
+function BinToInt(const Value: string): Integer;
+
+{:Parses a URL to its various components.}
+function ParseURL(URL: string; var Prot, User, Pass, Host, Port, Path,
+ Para: string): string;
+
+{:Replaces all "Search" string values found within "Value" string, with the
+ "Replace" string value.}
+function ReplaceString(Value, Search, Replace: AnsiString): AnsiString;
+
+{:It is like RPos, but search is from specified possition.}
+function RPosEx(const Sub, Value: string; From: integer): Integer;
+
+{:It is like POS function, but from right side of Value string.}
+function RPos(const Sub, Value: String): Integer;
+
+{:Like @link(fetch), but working with binary strings, not with text.}
+function FetchBin(var Value: string; const Delimiter: string): string;
+
+{:Fetch string from left of Value string.}
+function Fetch(var Value: string; const Delimiter: string): string;
+
+{:Fetch string from left of Value string. This function ignore delimitesr inside
+ quotations.}
+function FetchEx(var Value: string; const Delimiter, Quotation: string): string;
+
+{:If string is binary string (contains non-printable characters), then is
+ returned true.}
+function IsBinaryString(const Value: AnsiString): Boolean;
+
+{:return position of string terminator in string. If terminator found, then is
+ returned in terminator parameter.
+ Possible line terminators are: CRLF, LFCR, CR, LF}
+function PosCRLF(const Value: AnsiString; var Terminator: AnsiString): integer;
+
+{:Delete empty strings from end of stringlist.}
+Procedure StringsTrim(const value: TStrings);
+
+{:Like Pos function, buf from given string possition.}
+function PosFrom(const SubStr, Value: String; From: integer): integer;
+
+{$IFNDEF CIL}
+{:Increase pointer by value.}
+function IncPoint(const p: pointer; Value: integer): pointer;
+{$ENDIF}
+
+{:Get string between PairBegin and PairEnd. This function respect nesting.
+ For example:
+ @longcode(#
+ Value is: 'Hi! (hello(yes!))'
+ pairbegin is: '('
+ pairend is: ')'
+ In this case result is: 'hello(yes!)'#)}
+function GetBetween(const PairBegin, PairEnd, Value: string): string;
+
+{:Return count of Chr in Value string.}
+function CountOfChar(const Value: string; Chr: char): integer;
+
+{:Remove quotation from Value string. If Value is not quoted, then return same
+ string without any modification. }
+function UnquoteStr(const Value: string; Quote: Char): string;
+
+{:Quote Value string. If Value contains some Quote chars, then it is doubled.}
+function QuoteStr(const Value: string; Quote: Char): string;
+
+{:Convert lines in stringlist from 'name: value' form to 'name=value' form.}
+procedure HeadersToList(const Value: TStrings);
+
+{:Convert lines in stringlist from 'name=value' form to 'name: value' form.}
+procedure ListToHeaders(const Value: TStrings);
+
+{:swap bytes in integer.}
+function SwapBytes(Value: integer): integer;
+
+{:read string with requested length form stream.}
+function ReadStrFromStream(const Stream: TStream; len: integer): AnsiString;
+
+{:write string to stream.}
+procedure WriteStrToStream(const Stream: TStream; Value: AnsiString);
+
+{:Return filename of new temporary file in Dir (if empty, then default temporary
+ directory is used) and with optional filename prefix.}
+function GetTempFile(const Dir, prefix: AnsiString): AnsiString;
+
+{:Return padded string. If length is greater, string is truncated. If length is
+ smaller, string is padded by Pad character.}
+function PadString(const Value: AnsiString; len: integer; Pad: AnsiChar): AnsiString;
+
+{:XOR each byte in the strings}
+function XorString(Indata1, Indata2: AnsiString): AnsiString;
+
+{:Read header from "Value" stringlist beginning at "Index" position. If header
+ is Splitted into multiple lines, then this procedure de-split it into one line.}
+function NormalizeHeader(Value: TStrings; var Index: Integer): string;
+
+{pf}
+{:Search for one of line terminators CR, LF or NUL. Return position of the
+ line beginning and length of text.}
+procedure SearchForLineBreak(var APtr:PANSIChar; AEtx:PANSIChar; out ABol:PANSIChar; out ALength:integer);
+{:Skip both line terminators CR LF (if any). Move APtr position forward.}
+procedure SkipLineBreak(var APtr:PANSIChar; AEtx:PANSIChar);
+{:Skip all blank lines in a buffer starting at APtr and move APtr position forward.}
+procedure SkipNullLines (var APtr:PANSIChar; AEtx:PANSIChar);
+{:Copy all lines from a buffer starting at APtr to ALines until empty line
+ or end of the buffer is reached. Move APtr position forward).}
+procedure CopyLinesFromStreamUntilNullLine(var APtr:PANSIChar; AEtx:PANSIChar; ALines:TStrings);
+{:Copy all lines from a buffer starting at APtr to ALines until ABoundary
+ or end of the buffer is reached. Move APtr position forward).}
+procedure CopyLinesFromStreamUntilBoundary(var APtr:PANSIChar; AEtx:PANSIChar; ALines:TStrings; const ABoundary:ANSIString);
+{:Search ABoundary in a buffer starting at APtr.
+ Return beginning of the ABoundary. Move APtr forward behind a trailing CRLF if any).}
+function SearchForBoundary (var APtr:PANSIChar; AEtx:PANSIChar; const ABoundary:ANSIString): PANSIChar;
+{:Compare a text at position ABOL with ABoundary and return position behind the
+ match (including a trailing CRLF if any).}
+function MatchBoundary (ABOL,AETX:PANSIChar; const ABoundary:ANSIString): PANSIChar;
+{:Compare a text at position ABOL with ABoundary + the last boundary suffix
+ and return position behind the match (including a trailing CRLF if any).}
+function MatchLastBoundary (ABOL,AETX:PANSIChar; const ABoundary:ANSIString): PANSIChar;
+{:Copy data from a buffer starting at position APtr and delimited by AEtx
+ position into ANSIString.}
+function BuildStringFromBuffer (AStx,AEtx:PANSIChar): ANSIString;
+{/pf}
+
+var
+ {:can be used for your own months strings for @link(getmonthnumber)}
+ CustomMonthNames: array[1..12] of string;
+
+implementation
+
+{==============================================================================}
+
+const
+ MyDayNames: array[1..7] of AnsiString =
+ ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');
+var
+ MyMonthNames: array[0..6, 1..12] of String =
+ (
+ ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', //rewrited by system locales
+ 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'),
+ ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', //English
+ 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'),
+ ('jan', 'fév', 'mar', 'avr', 'mai', 'jun', //French
+ 'jul', 'aoû', 'sep', 'oct', 'nov', 'déc'),
+ ('jan', 'fev', 'mar', 'avr', 'mai', 'jun', //French#2
+ 'jul', 'aou', 'sep', 'oct', 'nov', 'dec'),
+ ('Jan', 'Feb', 'Mar', 'Apr', 'Mai', 'Jun', //German
+ 'Jul', 'Aug', 'Sep', 'Okt', 'Nov', 'Dez'),
+ ('Jan', 'Feb', 'Mär', 'Apr', 'Mai', 'Jun', //German#2
+ 'Jul', 'Aug', 'Sep', 'Okt', 'Nov', 'Dez'),
+ ('Led', 'Úno', 'Bøe', 'Dub', 'Kvì', 'Èen', //Czech
+ 'Èec', 'Srp', 'Záø', 'Øíj', 'Lis', 'Pro')
+ );
+
+
+{==============================================================================}
+
+function TimeZoneBias: integer;
+{$IFNDEF MSWINDOWS}
+{$IFNDEF FPC}
+var
+ t: TTime_T;
+ UT: TUnixTime;
+begin
+ __time(@T);
+ localtime_r(@T, UT);
+ Result := ut.__tm_gmtoff div 60;
+{$ELSE}
+begin
+ Result := TZSeconds div 60;
+{$ENDIF}
+{$ELSE}
+var
+ zoneinfo: TTimeZoneInformation;
+ bias: Integer;
+begin
+ case GetTimeZoneInformation(Zoneinfo) of
+ 2:
+ bias := zoneinfo.Bias + zoneinfo.DaylightBias;
+ 1:
+ bias := zoneinfo.Bias + zoneinfo.StandardBias;
+ else
+ bias := zoneinfo.Bias;
+ end;
+ Result := bias * (-1);
+{$ENDIF}
+end;
+
+{==============================================================================}
+
+function TimeZone: string;
+var
+ bias: Integer;
+ h, m: Integer;
+begin
+ bias := TimeZoneBias;
+ if bias >= 0 then
+ Result := '+'
+ else
+ Result := '-';
+ bias := Abs(bias);
+ h := bias div 60;
+ m := bias mod 60;
+ Result := Result + Format('%.2d%.2d', [h, m]);
+end;
+
+{==============================================================================}
+
+function Rfc822DateTime(t: TDateTime): string;
+var
+ wYear, wMonth, wDay: word;
+begin
+ DecodeDate(t, wYear, wMonth, wDay);
+ Result := Format('%s, %d %s %s %s', [MyDayNames[DayOfWeek(t)], wDay,
+ MyMonthNames[1, wMonth], FormatDateTime('yyyy hh":"nn":"ss', t), TimeZone]);
+end;
+
+{==============================================================================}
+
+function CDateTime(t: TDateTime): string;
+var
+ wYear, wMonth, wDay: word;
+begin
+ DecodeDate(t, wYear, wMonth, wDay);
+ Result:= Format('%s %2d %s', [MyMonthNames[1, wMonth], wDay,
+ FormatDateTime('hh":"nn":"ss', t)]);
+end;
+
+{==============================================================================}
+
+function SimpleDateTime(t: TDateTime): string;
+begin
+ Result := FormatDateTime('yymmdd hhnnss', t);
+end;
+
+{==============================================================================}
+
+function AnsiCDateTime(t: TDateTime): string;
+var
+ wYear, wMonth, wDay: word;
+begin
+ DecodeDate(t, wYear, wMonth, wDay);
+ Result := Format('%s %s %d %s', [MyDayNames[DayOfWeek(t)], MyMonthNames[1, wMonth],
+ wDay, FormatDateTime('hh":"nn":"ss yyyy ', t)]);
+end;
+
+{==============================================================================}
+
+function DecodeTimeZone(Value: string; var Zone: integer): Boolean;
+var
+ x: integer;
+ zh, zm: integer;
+ s: string;
+begin
+ Result := false;
+ s := Value;
+ if (Pos('+', s) = 1) or (Pos('-',s) = 1) then
+ begin
+ if s = '-0000' then
+ Zone := TimeZoneBias
+ else
+ if Length(s) > 4 then
+ begin
+ zh := StrToIntdef(s[2] + s[3], 0);
+ zm := StrToIntdef(s[4] + s[5], 0);
+ zone := zh * 60 + zm;
+ if s[1] = '-' then
+ zone := zone * (-1);
+ end;
+ Result := True;
+ end
+ else
+ begin
+ x := 32767;
+ if s = 'NZDT' then x := 13;
+ if s = 'IDLE' then x := 12;
+ if s = 'NZST' then x := 12;
+ if s = 'NZT' then x := 12;
+ if s = 'EADT' then x := 11;
+ if s = 'GST' then x := 10;
+ if s = 'JST' then x := 9;
+ if s = 'CCT' then x := 8;
+ if s = 'WADT' then x := 8;
+ if s = 'WAST' then x := 7;
+ if s = 'ZP6' then x := 6;
+ if s = 'ZP5' then x := 5;
+ if s = 'ZP4' then x := 4;
+ if s = 'BT' then x := 3;
+ if s = 'EET' then x := 2;
+ if s = 'MEST' then x := 2;
+ if s = 'MESZ' then x := 2;
+ if s = 'SST' then x := 2;
+ if s = 'FST' then x := 2;
+ if s = 'CEST' then x := 2;
+ if s = 'CET' then x := 1;
+ if s = 'FWT' then x := 1;
+ if s = 'MET' then x := 1;
+ if s = 'MEWT' then x := 1;
+ if s = 'SWT' then x := 1;
+ if s = 'UT' then x := 0;
+ if s = 'UTC' then x := 0;
+ if s = 'GMT' then x := 0;
+ if s = 'WET' then x := 0;
+ if s = 'WAT' then x := -1;
+ if s = 'BST' then x := -1;
+ if s = 'AT' then x := -2;
+ if s = 'ADT' then x := -3;
+ if s = 'AST' then x := -4;
+ if s = 'EDT' then x := -4;
+ if s = 'EST' then x := -5;
+ if s = 'CDT' then x := -5;
+ if s = 'CST' then x := -6;
+ if s = 'MDT' then x := -6;
+ if s = 'MST' then x := -7;
+ if s = 'PDT' then x := -7;
+ if s = 'PST' then x := -8;
+ if s = 'YDT' then x := -8;
+ if s = 'YST' then x := -9;
+ if s = 'HDT' then x := -9;
+ if s = 'AHST' then x := -10;
+ if s = 'CAT' then x := -10;
+ if s = 'HST' then x := -10;
+ if s = 'EAST' then x := -10;
+ if s = 'NT' then x := -11;
+ if s = 'IDLW' then x := -12;
+ if x <> 32767 then
+ begin
+ zone := x * 60;
+ Result := True;
+ end;
+ end;
+end;
+
+{==============================================================================}
+
+function GetMonthNumber(Value: String): integer;
+var
+ n: integer;
+ function TestMonth(Value: String; Index: Integer): Boolean;
+ var
+ n: integer;
+ begin
+ Result := False;
+ for n := 0 to 6 do
+ if Value = AnsiUppercase(MyMonthNames[n, Index]) then
+ begin
+ Result := True;
+ Break;
+ end;
+ end;
+begin
+ Result := 0;
+ Value := AnsiUppercase(Value);
+ for n := 1 to 12 do
+ if TestMonth(Value, n) or (Value = AnsiUppercase(CustomMonthNames[n])) then
+ begin
+ Result := n;
+ Break;
+ end;
+end;
+
+{==============================================================================}
+
+function GetTimeFromStr(Value: string): TDateTime;
+var
+ x: integer;
+begin
+ x := rpos(':', Value);
+ if (x > 0) and ((Length(Value) - x) > 2) then
+ Value := Copy(Value, 1, x + 2);
+ Value := ReplaceString(Value, ':', TimeSeparator);
+ Result := -1;
+ try
+ Result := StrToTime(Value);
+ except
+ on Exception do ;
+ end;
+end;
+
+{==============================================================================}
+
+function GetDateMDYFromStr(Value: string): TDateTime;
+var
+ wYear, wMonth, wDay: word;
+ s: string;
+begin
+ Result := 0;
+ s := Fetch(Value, '-');
+ wMonth := StrToIntDef(s, 12);
+ s := Fetch(Value, '-');
+ wDay := StrToIntDef(s, 30);
+ wYear := StrToIntDef(Value, 1899);
+ if wYear < 1000 then
+ if (wYear > 99) then
+ wYear := wYear + 1900
+ else
+ if wYear > 50 then
+ wYear := wYear + 1900
+ else
+ wYear := wYear + 2000;
+ try
+ Result := EncodeDate(wYear, wMonth, wDay);
+ except
+ on Exception do ;
+ end;
+end;
+
+{==============================================================================}
+
+function DecodeRfcDateTime(Value: string): TDateTime;
+var
+ day, month, year: Word;
+ zone: integer;
+ x, y: integer;
+ s: string;
+ t: TDateTime;
+begin
+// ddd, d mmm yyyy hh:mm:ss
+// ddd, d mmm yy hh:mm:ss
+// ddd, mmm d yyyy hh:mm:ss
+// ddd mmm dd hh:mm:ss yyyy
+// Sun, 06 Nov 1994 08:49:37 GMT ; RFC 822, updated by RFC 1123
+// Sunday, 06-Nov-94 08:49:37 GMT ; RFC 850, obsoleted by RFC 1036
+// Sun Nov 6 08:49:37 1994 ; ANSI C's asctime() Format
+
+ Result := 0;
+ if Value = '' then
+ Exit;
+ day := 0;
+ month := 0;
+ year := 0;
+ zone := 0;
+ Value := ReplaceString(Value, ' -', ' #');
+ Value := ReplaceString(Value, '-', ' ');
+ Value := ReplaceString(Value, ' #', ' -');
+ while Value <> '' do
+ begin
+ s := Fetch(Value, ' ');
+ s := uppercase(s);
+ // timezone
+ if DecodetimeZone(s, x) then
+ begin
+ zone := x;
+ continue;
+ end;
+ x := StrToIntDef(s, 0);
+ // day or year
+ if x > 0 then
+ if (x < 32) and (day = 0) then
+ begin
+ day := x;
+ continue;
+ end
+ else
+ begin
+ if (year = 0) and ((month > 0) or (x > 12)) then
+ begin
+ year := x;
+ if year < 32 then
+ year := year + 2000;
+ if year < 1000 then
+ year := year + 1900;
+ continue;
+ end;
+ end;
+ // time
+ if rpos(':', s) > Pos(':', s) then
+ begin
+ t := GetTimeFromStr(s);
+ if t <> -1 then
+ Result := t;
+ continue;
+ end;
+ //timezone daylight saving time
+ if s = 'DST' then
+ begin
+ zone := zone + 60;
+ continue;
+ end;
+ // month
+ y := GetMonthNumber(s);
+ if (y > 0) and (month = 0) then
+ month := y;
+ end;
+ if year = 0 then
+ year := 1980;
+ if month < 1 then
+ month := 1;
+ if month > 12 then
+ month := 12;
+ if day < 1 then
+ day := 1;
+ x := MonthDays[IsLeapYear(year), month];
+ if day > x then
+ day := x;
+ Result := Result + Encodedate(year, month, day);
+ zone := zone - TimeZoneBias;
+ x := zone div 1440;
+ Result := Result - x;
+ zone := zone mod 1440;
+ t := EncodeTime(Abs(zone) div 60, Abs(zone) mod 60, 0, 0);
+ if zone < 0 then
+ t := 0 - t;
+ Result := Result - t;
+end;
+
+{==============================================================================}
+
+function GetUTTime: TDateTime;
+{$IFDEF MSWINDOWS}
+{$IFNDEF FPC}
+var
+ st: TSystemTime;
+begin
+ GetSystemTime(st);
+ result := SystemTimeToDateTime(st);
+{$ELSE}
+var
+ st: SysUtils.TSystemTime;
+ stw: Windows.TSystemTime;
+begin
+ GetSystemTime(stw);
+ st.Year := stw.wYear;
+ st.Month := stw.wMonth;
+ st.Day := stw.wDay;
+ st.Hour := stw.wHour;
+ st.Minute := stw.wMinute;
+ st.Second := stw.wSecond;
+ st.Millisecond := stw.wMilliseconds;
+ result := SystemTimeToDateTime(st);
+{$ENDIF}
+{$ELSE}
+{$IFNDEF FPC}
+var
+ TV: TTimeVal;
+begin
+ gettimeofday(TV, nil);
+ Result := UnixDateDelta + (TV.tv_sec + TV.tv_usec / 1000000) / 86400;
+{$ELSE}
+var
+ TV: TimeVal;
+begin
+ fpgettimeofday(@TV, nil);
+ Result := UnixDateDelta + (TV.tv_sec + TV.tv_usec / 1000000) / 86400;
+{$ENDIF}
+{$ENDIF}
+end;
+
+{==============================================================================}
+
+function SetUTTime(Newdt: TDateTime): Boolean;
+{$IFDEF MSWINDOWS}
+{$IFNDEF FPC}
+var
+ st: TSystemTime;
+begin
+ DateTimeToSystemTime(newdt,st);
+ Result := SetSystemTime(st);
+{$ELSE}
+var
+ st: SysUtils.TSystemTime;
+ stw: Windows.TSystemTime;
+begin
+ DateTimeToSystemTime(newdt,st);
+ stw.wYear := st.Year;
+ stw.wMonth := st.Month;
+ stw.wDay := st.Day;
+ stw.wHour := st.Hour;
+ stw.wMinute := st.Minute;
+ stw.wSecond := st.Second;
+ stw.wMilliseconds := st.Millisecond;
+ Result := SetSystemTime(stw);
+{$ENDIF}
+{$ELSE}
+{$IFNDEF FPC}
+var
+ TV: TTimeVal;
+ d: double;
+ TZ: Ttimezone;
+ PZ: PTimeZone;
+begin
+ TZ.tz_minuteswest := 0;
+ TZ.tz_dsttime := 0;
+ PZ := @TZ;
+ gettimeofday(TV, PZ);
+ d := (newdt - UnixDateDelta) * 86400;
+ TV.tv_sec := trunc(d);
+ TV.tv_usec := trunc(frac(d) * 1000000);
+ Result := settimeofday(TV, TZ) <> -1;
+{$ELSE}
+var
+ TV: TimeVal;
+ d: double;
+begin
+ d := (newdt - UnixDateDelta) * 86400;
+ TV.tv_sec := trunc(d);
+ TV.tv_usec := trunc(frac(d) * 1000000);
+ Result := fpsettimeofday(@TV, nil) <> -1;
+{$ENDIF}
+{$ENDIF}
+end;
+
+{==============================================================================}
+
+{$IFNDEF MSWINDOWS}
+function GetTick: LongWord;
+var
+ Stamp: TTimeStamp;
+begin
+ Stamp := DateTimeToTimeStamp(Now);
+ Result := Stamp.Time;
+end;
+{$ELSE}
+function GetTick: LongWord;
+var
+ tick, freq: TLargeInteger;
+{$IFDEF VER100}
+ x: TLargeInteger;
+{$ENDIF}
+begin
+ if Windows.QueryPerformanceFrequency(freq) then
+ begin
+ Windows.QueryPerformanceCounter(tick);
+{$IFDEF VER100}
+ x.QuadPart := (tick.QuadPart / freq.QuadPart) * 1000;
+ Result := x.LowPart;
+{$ELSE}
+ Result := Trunc((tick / freq) * 1000) and High(LongWord)
+{$ENDIF}
+ end
+ else
+ Result := Windows.GetTickCount;
+end;
+{$ENDIF}
+
+{==============================================================================}
+
+function TickDelta(TickOld, TickNew: LongWord): LongWord;
+begin
+//if DWord is signed type (older Deplhi),
+// then it not work properly on differencies larger then maxint!
+ Result := 0;
+ if TickOld <> TickNew then
+ begin
+ if TickNew < TickOld then
+ begin
+ TickNew := TickNew + LongWord(MaxInt) + 1;
+ TickOld := TickOld + LongWord(MaxInt) + 1;
+ end;
+ Result := TickNew - TickOld;
+ if TickNew < TickOld then
+ if Result > 0 then
+ Result := 0 - Result;
+ end;
+end;
+
+{==============================================================================}
+
+function CodeInt(Value: Word): Ansistring;
+begin
+ setlength(result, 2);
+ result[1] := AnsiChar(Value div 256);
+ result[2] := AnsiChar(Value mod 256);
+// Result := AnsiChar(Value div 256) + AnsiChar(Value mod 256)
+end;
+
+{==============================================================================}
+
+function DecodeInt(const Value: Ansistring; Index: Integer): Word;
+var
+ x, y: Byte;
+begin
+ if Length(Value) > Index then
+ x := Ord(Value[Index])
+ else
+ x := 0;
+ if Length(Value) >= (Index + 1) then
+ y := Ord(Value[Index + 1])
+ else
+ y := 0;
+ Result := x * 256 + y;
+end;
+
+{==============================================================================}
+
+function CodeLongInt(Value: Longint): Ansistring;
+var
+ x, y: word;
+begin
+ // this is fix for negative numbers on systems where longint = integer
+ x := (Value shr 16) and integer($ffff);
+ y := Value and integer($ffff);
+ setlength(result, 4);
+ result[1] := AnsiChar(x div 256);
+ result[2] := AnsiChar(x mod 256);
+ result[3] := AnsiChar(y div 256);
+ result[4] := AnsiChar(y mod 256);
+end;
+
+{==============================================================================}
+
+function DecodeLongInt(const Value: Ansistring; Index: Integer): LongInt;
+var
+ x, y: Byte;
+ xl, yl: Byte;
+begin
+ if Length(Value) > Index then
+ x := Ord(Value[Index])
+ else
+ x := 0;
+ if Length(Value) >= (Index + 1) then
+ y := Ord(Value[Index + 1])
+ else
+ y := 0;
+ if Length(Value) >= (Index + 2) then
+ xl := Ord(Value[Index + 2])
+ else
+ xl := 0;
+ if Length(Value) >= (Index + 3) then
+ yl := Ord(Value[Index + 3])
+ else
+ yl := 0;
+ Result := ((x * 256 + y) * 65536) + (xl * 256 + yl);
+end;
+
+{==============================================================================}
+
+function DumpStr(const Buffer: Ansistring): string;
+var
+ n: Integer;
+begin
+ Result := '';
+ for n := 1 to Length(Buffer) do
+ Result := Result + ' +#$' + IntToHex(Ord(Buffer[n]), 2);
+end;
+
+{==============================================================================}
+
+function DumpExStr(const Buffer: Ansistring): string;
+var
+ n: Integer;
+ x: Byte;
+begin
+ Result := '';
+ for n := 1 to Length(Buffer) do
+ begin
+ x := Ord(Buffer[n]);
+ if x in [65..90, 97..122] then
+ Result := Result + ' +''' + char(x) + ''''
+ else
+ Result := Result + ' +#$' + IntToHex(Ord(Buffer[n]), 2);
+ end;
+end;
+
+{==============================================================================}
+
+procedure Dump(const Buffer: AnsiString; DumpFile: string);
+var
+ f: Text;
+begin
+ AssignFile(f, DumpFile);
+ if FileExists(DumpFile) then
+ DeleteFile(DumpFile);
+ Rewrite(f);
+ try
+ Writeln(f, DumpStr(Buffer));
+ finally
+ CloseFile(f);
+ end;
+end;
+
+{==============================================================================}
+
+procedure DumpEx(const Buffer: AnsiString; DumpFile: string);
+var
+ f: Text;
+begin
+ AssignFile(f, DumpFile);
+ if FileExists(DumpFile) then
+ DeleteFile(DumpFile);
+ Rewrite(f);
+ try
+ Writeln(f, DumpExStr(Buffer));
+ finally
+ CloseFile(f);
+ end;
+end;
+
+{==============================================================================}
+
+function TrimSPLeft(const S: string): string;
+var
+ I, L: Integer;
+begin
+ Result := '';
+ if S = '' then
+ Exit;
+ L := Length(S);
+ I := 1;
+ while (I <= L) and (S[I] = ' ') do
+ Inc(I);
+ Result := Copy(S, I, Maxint);
+end;
+
+{==============================================================================}
+
+function TrimSPRight(const S: string): string;
+var
+ I: Integer;
+begin
+ Result := '';
+ if S = '' then
+ Exit;
+ I := Length(S);
+ while (I > 0) and (S[I] = ' ') do
+ Dec(I);
+ Result := Copy(S, 1, I);
+end;
+
+{==============================================================================}
+
+function TrimSP(const S: string): string;
+begin
+ Result := TrimSPLeft(s);
+ Result := TrimSPRight(Result);
+end;
+
+{==============================================================================}
+
+function SeparateLeft(const Value, Delimiter: string): string;
+var
+ x: Integer;
+begin
+ x := Pos(Delimiter, Value);
+ if x < 1 then
+ Result := Value
+ else
+ Result := Copy(Value, 1, x - 1);
+end;
+
+{==============================================================================}
+
+function SeparateRight(const Value, Delimiter: string): string;
+var
+ x: Integer;
+begin
+ x := Pos(Delimiter, Value);
+ if x > 0 then
+ x := x + Length(Delimiter) - 1;
+ Result := Copy(Value, x + 1, Length(Value) - x);
+end;
+
+{==============================================================================}
+
+function GetParameter(const Value, Parameter: string): string;
+var
+ s: string;
+ v: string;
+begin
+ Result := '';
+ v := Value;
+ while v <> '' do
+ begin
+ s := Trim(FetchEx(v, ';', '"'));
+ if Pos(Uppercase(parameter), Uppercase(s)) = 1 then
+ begin
+ Delete(s, 1, Length(Parameter));
+ s := Trim(s);
+ if s = '' then
+ Break;
+ if s[1] = '=' then
+ begin
+ Result := Trim(SeparateRight(s, '='));
+ Result := UnquoteStr(Result, '"');
+ break;
+ end;
+ end;
+ end;
+end;
+
+{==============================================================================}
+
+procedure ParseParametersEx(Value, Delimiter: string; const Parameters: TStrings);
+var
+ s: string;
+begin
+ Parameters.Clear;
+ while Value <> '' do
+ begin
+ s := Trim(FetchEx(Value, Delimiter, '"'));
+ Parameters.Add(s);
+ end;
+end;
+
+{==============================================================================}
+
+procedure ParseParameters(Value: string; const Parameters: TStrings);
+begin
+ ParseParametersEx(Value, ';', Parameters);
+end;
+
+{==============================================================================}
+
+function IndexByBegin(Value: string; const List: TStrings): integer;
+var
+ n: integer;
+ s: string;
+begin
+ Result := -1;
+ Value := uppercase(Value);
+ for n := 0 to List.Count -1 do
+ begin
+ s := UpperCase(List[n]);
+ if Pos(Value, s) = 1 then
+ begin
+ Result := n;
+ Break;
+ end;
+ end;
+end;
+
+{==============================================================================}
+
+function GetEmailAddr(const Value: string): string;
+var
+ s: string;
+begin
+ s := SeparateRight(Value, '<');
+ s := SeparateLeft(s, '>');
+ Result := Trim(s);
+end;
+
+{==============================================================================}
+
+function GetEmailDesc(Value: string): string;
+var
+ s: string;
+begin
+ Value := Trim(Value);
+ s := SeparateRight(Value, '"');
+ if s <> Value then
+ s := SeparateLeft(s, '"')
+ else
+ begin
+ s := SeparateLeft(Value, '<');
+ if s = Value then
+ begin
+ s := SeparateRight(Value, '(');
+ if s <> Value then
+ s := SeparateLeft(s, ')')
+ else
+ s := '';
+ end;
+ end;
+ Result := Trim(s);
+end;
+
+{==============================================================================}
+
+function StrToHex(const Value: Ansistring): string;
+var
+ n: Integer;
+begin
+ Result := '';
+ for n := 1 to Length(Value) do
+ Result := Result + IntToHex(Byte(Value[n]), 2);
+ Result := LowerCase(Result);
+end;
+
+{==============================================================================}
+
+function IntToBin(Value: Integer; Digits: Byte): string;
+var
+ x, y, n: Integer;
+begin
+ Result := '';
+ x := Value;
+ repeat
+ y := x mod 2;
+ x := x div 2;
+ if y > 0 then
+ Result := '1' + Result
+ else
+ Result := '0' + Result;
+ until x = 0;
+ x := Length(Result);
+ for n := x to Digits - 1 do
+ Result := '0' + Result;
+end;
+
+{==============================================================================}
+
+function BinToInt(const Value: string): Integer;
+var
+ n: Integer;
+begin
+ Result := 0;
+ for n := 1 to Length(Value) do
+ begin
+ if Value[n] = '0' then
+ Result := Result * 2
+ else
+ if Value[n] = '1' then
+ Result := Result * 2 + 1
+ else
+ Break;
+ end;
+end;
+
+{==============================================================================}
+
+function ParseURL(URL: string; var Prot, User, Pass, Host, Port, Path,
+ Para: string): string;
+var
+ x, y: Integer;
+ sURL: string;
+ s: string;
+ s1, s2: string;
+begin
+ Prot := 'http';
+ User := '';
+ Pass := '';
+ Port := '80';
+ Para := '';
+
+ x := Pos('://', URL);
+ if x > 0 then
+ begin
+ Prot := SeparateLeft(URL, '://');
+ sURL := SeparateRight(URL, '://');
+ end
+ else
+ sURL := URL;
+ if UpperCase(Prot) = 'HTTPS' then
+ Port := '443';
+ if UpperCase(Prot) = 'FTP' then
+ Port := '21';
+ x := Pos('@', sURL);
+ y := Pos('/', sURL);
+ if (x > 0) and ((x < y) or (y < 1))then
+ begin
+ s := SeparateLeft(sURL, '@');
+ sURL := SeparateRight(sURL, '@');
+ x := Pos(':', s);
+ if x > 0 then
+ begin
+ User := SeparateLeft(s, ':');
+ Pass := SeparateRight(s, ':');
+ end
+ else
+ User := s;
+ end;
+ x := Pos('/', sURL);
+ if x > 0 then
+ begin
+ s1 := SeparateLeft(sURL, '/');
+ s2 := SeparateRight(sURL, '/');
+ end
+ else
+ begin
+ s1 := sURL;
+ s2 := '';
+ end;
+ if Pos('[', s1) = 1 then
+ begin
+ Host := Separateleft(s1, ']');
+ Delete(Host, 1, 1);
+ s1 := SeparateRight(s1, ']');
+ if Pos(':', s1) = 1 then
+ Port := SeparateRight(s1, ':');
+ end
+ else
+ begin
+ x := Pos(':', s1);
+ if x > 0 then
+ begin
+ Host := SeparateLeft(s1, ':');
+ Port := SeparateRight(s1, ':');
+ end
+ else
+ Host := s1;
+ end;
+ Result := '/' + s2;
+ x := Pos('?', s2);
+ if x > 0 then
+ begin
+ Path := '/' + SeparateLeft(s2, '?');
+ Para := SeparateRight(s2, '?');
+ end
+ else
+ Path := '/' + s2;
+ if Host = '' then
+ Host := 'localhost';
+end;
+
+{==============================================================================}
+
+function ReplaceString(Value, Search, Replace: AnsiString): AnsiString;
+var
+ x, l, ls, lr: Integer;
+begin
+ if (Value = '') or (Search = '') then
+ begin
+ Result := Value;
+ Exit;
+ end;
+ ls := Length(Search);
+ lr := Length(Replace);
+ Result := '';
+ x := Pos(Search, Value);
+ while x > 0 do
+ begin
+ {$IFNDEF CIL}
+ l := Length(Result);
+ SetLength(Result, l + x - 1);
+ Move(Pointer(Value)^, Pointer(@Result[l + 1])^, x - 1);
+ {$ELSE}
+ Result:=Result+Copy(Value,1,x-1);
+ {$ENDIF}
+ {$IFNDEF CIL}
+ l := Length(Result);
+ SetLength(Result, l + lr);
+ Move(Pointer(Replace)^, Pointer(@Result[l + 1])^, lr);
+ {$ELSE}
+ Result:=Result+Replace;
+ {$ENDIF}
+ Delete(Value, 1, x - 1 + ls);
+ x := Pos(Search, Value);
+ end;
+ Result := Result + Value;
+end;
+
+{==============================================================================}
+
+function RPosEx(const Sub, Value: string; From: integer): Integer;
+var
+ n: Integer;
+ l: Integer;
+begin
+ result := 0;
+ l := Length(Sub);
+ for n := From - l + 1 downto 1 do
+ begin
+ if Copy(Value, n, l) = Sub then
+ begin
+ result := n;
+ break;
+ end;
+ end;
+end;
+
+{==============================================================================}
+
+function RPos(const Sub, Value: String): Integer;
+begin
+ Result := RPosEx(Sub, Value, Length(Value));
+end;
+
+{==============================================================================}
+
+function FetchBin(var Value: string; const Delimiter: string): string;
+var
+ s: string;
+begin
+ Result := SeparateLeft(Value, Delimiter);
+ s := SeparateRight(Value, Delimiter);
+ if s = Value then
+ Value := ''
+ else
+ Value := s;
+end;
+
+{==============================================================================}
+
+function Fetch(var Value: string; const Delimiter: string): string;
+begin
+ Result := FetchBin(Value, Delimiter);
+ Result := TrimSP(Result);
+ Value := TrimSP(Value);
+end;
+
+{==============================================================================}
+
+function FetchEx(var Value: string; const Delimiter, Quotation: string): string;
+var
+ b: Boolean;
+begin
+ Result := '';
+ b := False;
+ while Length(Value) > 0 do
+ begin
+ if b then
+ begin
+ if Pos(Quotation, Value) = 1 then
+ b := False;
+ Result := Result + Value[1];
+ Delete(Value, 1, 1);
+ end
+ else
+ begin
+ if Pos(Delimiter, Value) = 1 then
+ begin
+ Delete(Value, 1, Length(delimiter));
+ break;
+ end;
+ b := Pos(Quotation, Value) = 1;
+ Result := Result + Value[1];
+ Delete(Value, 1, 1);
+ end;
+ end;
+end;
+
+{==============================================================================}
+
+function IsBinaryString(const Value: AnsiString): Boolean;
+var
+ n: integer;
+begin
+ Result := False;
+ for n := 1 to Length(Value) do
+ if Value[n] in [#0..#8, #10..#31] then
+ //ignore null-terminated strings
+ if not ((n = Length(value)) and (Value[n] = AnsiChar(#0))) then
+ begin
+ Result := True;
+ Break;
+ end;
+end;
+
+{==============================================================================}
+
+function PosCRLF(const Value: AnsiString; var Terminator: AnsiString): integer;
+var
+ n, l: integer;
+begin
+ Result := -1;
+ Terminator := '';
+ l := length(value);
+ for n := 1 to l do
+ if value[n] in [#$0d, #$0a] then
+ begin
+ Result := n;
+ Terminator := Value[n];
+ if n <> l then
+ case value[n] of
+ #$0d:
+ if value[n + 1] = #$0a then
+ Terminator := #$0d + #$0a;
+ #$0a:
+ if value[n + 1] = #$0d then
+ Terminator := #$0a + #$0d;
+ end;
+ Break;
+ end;
+end;
+
+{==============================================================================}
+
+Procedure StringsTrim(const Value: TStrings);
+var
+ n: integer;
+begin
+ for n := Value.Count - 1 downto 0 do
+ if Value[n] = '' then
+ Value.Delete(n)
+ else
+ Break;
+end;
+
+{==============================================================================}
+
+function PosFrom(const SubStr, Value: String; From: integer): integer;
+var
+ ls,lv: integer;
+begin
+ Result := 0;
+ ls := Length(SubStr);
+ lv := Length(Value);
+ if (ls = 0) or (lv = 0) then
+ Exit;
+ if From < 1 then
+ From := 1;
+ while (ls + from - 1) <= (lv) do
+ begin
+ {$IFNDEF CIL}
+ if CompareMem(@SubStr[1],@Value[from],ls) then
+ {$ELSE}
+ if SubStr = copy(Value, from, ls) then
+ {$ENDIF}
+ begin
+ result := from;
+ break;
+ end
+ else
+ inc(from);
+ end;
+end;
+
+{==============================================================================}
+
+{$IFNDEF CIL}
+function IncPoint(const p: pointer; Value: integer): pointer;
+begin
+ Result := PAnsiChar(p) + Value;
+end;
+{$ENDIF}
+
+{==============================================================================}
+//improved by 'DoggyDawg'
+function GetBetween(const PairBegin, PairEnd, Value: string): string;
+var
+ n: integer;
+ x: integer;
+ s: string;
+ lenBegin: integer;
+ lenEnd: integer;
+ str: string;
+ max: integer;
+begin
+ lenBegin := Length(PairBegin);
+ lenEnd := Length(PairEnd);
+ n := Length(Value);
+ if (Value = PairBegin + PairEnd) then
+ begin
+ Result := '';//nothing between
+ exit;
+ end;
+ if (n < lenBegin + lenEnd) then
+ begin
+ Result := Value;
+ exit;
+ end;
+ s := SeparateRight(Value, PairBegin);
+ if (s = Value) then
+ begin
+ Result := Value;
+ exit;
+ end;
+ n := Pos(PairEnd, s);
+ if (n = 0) then
+ begin
+ Result := Value;
+ exit;
+ end;
+ Result := '';
+ x := 1;
+ max := Length(s) - lenEnd + 1;
+ for n := 1 to max do
+ begin
+ str := copy(s, n, lenEnd);
+ if (str = PairEnd) then
+ begin
+ Dec(x);
+ if (x <= 0) then
+ Break;
+ end;
+ str := copy(s, n, lenBegin);
+ if (str = PairBegin) then
+ Inc(x);
+ Result := Result + s[n];
+ end;
+end;
+
+{==============================================================================}
+
+function CountOfChar(const Value: string; Chr: char): integer;
+var
+ n: integer;
+begin
+ Result := 0;
+ for n := 1 to Length(Value) do
+ if Value[n] = chr then
+ Inc(Result);
+end;
+
+{==============================================================================}
+// ! do not use AnsiExtractQuotedStr, it's very buggy and can crash application!
+function UnquoteStr(const Value: string; Quote: Char): string;
+var
+ n: integer;
+ inq, dq: Boolean;
+ c, cn: char;
+begin
+ Result := '';
+ if Value = '' then
+ Exit;
+ if Value = Quote + Quote then
+ Exit;
+ inq := False;
+ dq := False;
+ for n := 1 to Length(Value) do
+ begin
+ c := Value[n];
+ if n <> Length(Value) then
+ cn := Value[n + 1]
+ else
+ cn := #0;
+ if c = quote then
+ if dq then
+ dq := False
+ else
+ if not inq then
+ inq := True
+ else
+ if cn = quote then
+ begin
+ Result := Result + Quote;
+ dq := True;
+ end
+ else
+ inq := False
+ else
+ Result := Result + c;
+ end;
+end;
+
+{==============================================================================}
+
+function QuoteStr(const Value: string; Quote: Char): string;
+var
+ n: integer;
+begin
+ Result := '';
+ for n := 1 to length(value) do
+ begin
+ Result := result + Value[n];
+ if value[n] = Quote then
+ Result := Result + Quote;
+ end;
+ Result := Quote + Result + Quote;
+end;
+
+{==============================================================================}
+
+procedure HeadersToList(const Value: TStrings);
+var
+ n, x, y: integer;
+ s: string;
+begin
+ for n := 0 to Value.Count -1 do
+ begin
+ s := Value[n];
+ x := Pos(':', s);
+ if x > 0 then
+ begin
+ y:= Pos('=',s);
+ if not ((y > 0) and (y < x)) then
+ begin
+ s[x] := '=';
+ Value[n] := s;
+ end;
+ end;
+ end;
+end;
+
+{==============================================================================}
+
+procedure ListToHeaders(const Value: TStrings);
+var
+ n, x: integer;
+ s: string;
+begin
+ for n := 0 to Value.Count -1 do
+ begin
+ s := Value[n];
+ x := Pos('=', s);
+ if x > 0 then
+ begin
+ s[x] := ':';
+ Value[n] := s;
+ end;
+ end;
+end;
+
+{==============================================================================}
+
+function SwapBytes(Value: integer): integer;
+var
+ s: AnsiString;
+ x, y, xl, yl: Byte;
+begin
+ s := CodeLongInt(Value);
+ x := Ord(s[4]);
+ y := Ord(s[3]);
+ xl := Ord(s[2]);
+ yl := Ord(s[1]);
+ Result := ((x * 256 + y) * 65536) + (xl * 256 + yl);
+end;
+
+{==============================================================================}
+
+function ReadStrFromStream(const Stream: TStream; len: integer): AnsiString;
+var
+ x: integer;
+{$IFDEF CIL}
+ buf: Array of Byte;
+{$ENDIF}
+begin
+{$IFDEF CIL}
+ Setlength(buf, Len);
+ x := Stream.read(buf, Len);
+ SetLength(buf, x);
+ Result := StringOf(Buf);
+{$ELSE}
+ Setlength(Result, Len);
+ x := Stream.read(PAnsiChar(Result)^, Len);
+ SetLength(Result, x);
+{$ENDIF}
+end;
+
+{==============================================================================}
+
+procedure WriteStrToStream(const Stream: TStream; Value: AnsiString);
+{$IFDEF CIL}
+var
+ buf: Array of Byte;
+{$ENDIF}
+begin
+{$IFDEF CIL}
+ buf := BytesOf(Value);
+ Stream.Write(buf,length(Value));
+{$ELSE}
+ Stream.Write(PAnsiChar(Value)^, Length(Value));
+{$ENDIF}
+end;
+
+{==============================================================================}
+function GetTempFile(const Dir, prefix: AnsiString): AnsiString;
+{$IFNDEF FPC}
+{$IFDEF MSWINDOWS}
+var
+ Path: AnsiString;
+ x: integer;
+{$ENDIF}
+{$ENDIF}
+begin
+{$IFDEF FPC}
+ Result := GetTempFileName(Dir, Prefix);
+{$ELSE}
+ {$IFNDEF MSWINDOWS}
+ Result := tempnam(Pointer(Dir), Pointer(prefix));
+ {$ELSE}
+ {$IFDEF CIL}
+ Result := System.IO.Path.GetTempFileName;
+ {$ELSE}
+ if Dir = '' then
+ begin
+ SetLength(Path, MAX_PATH);
+ x := GetTempPath(Length(Path), PChar(Path));
+ SetLength(Path, x);
+ end
+ else
+ Path := Dir;
+ x := Length(Path);
+ if Path[x] <> '\' then
+ Path := Path + '\';
+ SetLength(Result, MAX_PATH + 1);
+ GetTempFileName(PChar(Path), PChar(Prefix), 0, PChar(Result));
+ Result := PChar(Result);
+ SetFileattributes(PChar(Result), GetFileAttributes(PChar(Result)) or FILE_ATTRIBUTE_TEMPORARY);
+ {$ENDIF}
+ {$ENDIF}
+{$ENDIF}
+end;
+
+{==============================================================================}
+
+function PadString(const Value: AnsiString; len: integer; Pad: AnsiChar): AnsiString;
+begin
+ if length(value) >= len then
+ Result := Copy(value, 1, len)
+ else
+ Result := Value + StringOfChar(Pad, len - length(value));
+end;
+
+{==============================================================================}
+
+function XorString(Indata1, Indata2: AnsiString): AnsiString;
+var
+ i: integer;
+begin
+ Indata2 := PadString(Indata2, length(Indata1), #0);
+ Result := '';
+ for i := 1 to length(Indata1) do
+ Result := Result + AnsiChar(ord(Indata1[i]) xor ord(Indata2[i]));
+end;
+
+{==============================================================================}
+
+function NormalizeHeader(Value: TStrings; var Index: Integer): string;
+var
+ s, t: string;
+ n: Integer;
+begin
+ s := Value[Index];
+ Inc(Index);
+ if s <> '' then
+ while (Value.Count - 1) > Index do
+ begin
+ t := Value[Index];
+ if t = '' then
+ Break;
+ for n := 1 to Length(t) do
+ if t[n] = #9 then
+ t[n] := ' ';
+ if not(AnsiChar(t[1]) in [' ', '"', ':', '=']) then
+ Break
+ else
+ begin
+ s := s + ' ' + Trim(t);
+ Inc(Index);
+ end;
+ end;
+ Result := TrimRight(s);
+end;
+
+{==============================================================================}
+
+{pf}
+procedure SearchForLineBreak(var APtr:PANSIChar; AEtx:PANSIChar; out ABol:PANSIChar; out ALength:integer);
+begin
+ ABol := APtr;
+ while (APtr0 then
+ begin
+ APtr := bol;
+ Break;
+ end;
+ end;
+end;
+{/pf}
+
+{pf}
+procedure CopyLinesFromStreamUntilNullLine(var APtr:PANSIChar; AEtx:PANSIChar; ALines:TStrings);
+var
+ bol: PANSIChar;
+ lng: integer;
+ s: ANSIString;
+begin
+ // Copying until body separator will be reached
+ while (APtr#0) do
+ begin
+ SearchForLineBreak(APtr,AEtx,bol,lng);
+ SkipLineBreak(APtr,AEtx);
+ if lng=0 then
+ Break;
+ SetString(s,bol,lng);
+ ALines.Add(s);
+ end;
+end;
+{/pf}
+
+{pf}
+procedure CopyLinesFromStreamUntilBoundary(var APtr:PANSIChar; AEtx:PANSIChar; ALines:TStrings; const ABoundary:ANSIString);
+var
+ bol: PANSIChar;
+ lng: integer;
+ s: ANSIString;
+ BackStop: ANSIString;
+ eob1: PANSIChar;
+ eob2: PANSIChar;
+begin
+ BackStop := '--'+ABoundary;
+ eob2 := nil;
+ // Copying until Boundary will be reached
+ while (APtrAETX then
+ exit;
+ if strlcomp(MatchPos,#13#10,2)=0 then
+ inc(MatchPos,2);
+ if (MatchPos+2+Lng)>AETX then
+ exit;
+ if strlcomp(MatchPos,'--',2)<>0 then
+ exit;
+ inc(MatchPos,2);
+ if strlcomp(MatchPos,PANSIChar(ABoundary),Lng)<>0 then
+ exit;
+ inc(MatchPos,Lng);
+ if ((MatchPos+2)<=AEtx) and (strlcomp(MatchPos,#13#10,2)=0) then
+ inc(MatchPos,2);
+ Result := MatchPos;
+end;
+{/pf}
+
+{pf}
+function MatchLastBoundary(ABOL,AETX:PANSIChar; const ABoundary:ANSIString): PANSIChar;
+var
+ MatchPos: PANSIChar;
+begin
+ Result := nil;
+ MatchPos := MatchBoundary(ABOL,AETX,ABoundary);
+ if not Assigned(MatchPos) then
+ exit;
+ if strlcomp(MatchPos,'--',2)<>0 then
+ exit;
+ inc(MatchPos,2);
+ if (MatchPos+2<=AEtx) and (strlcomp(MatchPos,#13#10,2)=0) then
+ inc(MatchPos,2);
+ Result := MatchPos;
+end;
+{/pf}
+
+{pf}
+function BuildStringFromBuffer(AStx,AEtx:PANSIChar): ANSIString;
+var
+ lng: integer;
+begin
+ Lng := 0;
+ if Assigned(AStx) and Assigned(AEtx) then
+ begin
+ Lng := AEtx-AStx;
+ if Lng<0 then
+ Lng := 0;
+ end;
+ SetString(Result,AStx,lng);
+end;
+{/pf}
+
+
+
+
+{==============================================================================}
+var
+ n: integer;
+begin
+ for n := 1 to 12 do
+ begin
+ CustomMonthNames[n] := ShortMonthNames[n];
+ MyMonthNames[0, n] := ShortMonthNames[n];
+ end;
+end.
ADDED lib/synapse/source/lib/synsock.pas
Index: lib/synapse/source/lib/synsock.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/lib/synsock.pas
@@ -0,0 +1,77 @@
+{==============================================================================|
+| Project : Ararat Synapse | 005.002.001 |
+|==============================================================================|
+| Content: Socket Independent Platform Layer |
+|==============================================================================|
+| Copyright (c)1999-2011, Lukas Gebauer |
+| All rights reserved. |
+| |
+| Redistribution and use in source and binary forms, with or without |
+| modification, are permitted provided that the following conditions are met: |
+| |
+| Redistributions of source code must retain the above copyright notice, this |
+| list of conditions and the following disclaimer. |
+| |
+| Redistributions in binary form must reproduce the above copyright notice, |
+| this list of conditions and the following disclaimer in the documentation |
+| and/or other materials provided with the distribution. |
+| |
+| Neither the name of Lukas Gebauer nor the names of its contributors may |
+| be used to endorse or promote products derived from this software without |
+| specific prior written permission. |
+| |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
+| DAMAGE. |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2001-2011. |
+| All Rights Reserved. |
+|==============================================================================|
+| Contributor(s): |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package |
+| (Found at URL: http://www.ararat.cz/synapse/) |
+|==============================================================================}
+
+{:@exclude}
+
+unit synsock;
+
+{$MINENUMSIZE 4}
+
+//old Delphi does not have MSWINDOWS define.
+{$IFDEF WIN32}
+ {$IFNDEF MSWINDOWS}
+ {$DEFINE MSWINDOWS}
+ {$ENDIF}
+{$ENDIF}
+
+{$IFDEF CIL}
+ {$I ssdotnet.inc}
+{$ELSE}
+ {$IFDEF MSWINDOWS}
+ {$I sswin32.inc}
+ {$ELSE}
+ {$IFDEF WINCE}
+ {$I sswin32.inc} //not complete yet!
+ {$ELSE}
+ {$IFDEF FPC}
+ {$I ssfpc.inc}
+ {$ELSE}
+ {$I sslinux.inc}
+ {$ENDIF}
+ {$ENDIF}
+ {$ENDIF}
+{$ENDIF}
+
+end.
+
ADDED lib/synapse/source/lib/tlntsend.pas
Index: lib/synapse/source/lib/tlntsend.pas
==================================================================
--- /dev/null
+++ lib/synapse/source/lib/tlntsend.pas
@@ -0,0 +1,364 @@
+{==============================================================================|
+| Project : Ararat Synapse | 001.003.001 |
+|==============================================================================|
+| Content: TELNET and SSH2 client |
+|==============================================================================|
+| Copyright (c)1999-2010, Lukas Gebauer |
+| All rights reserved. |
+| |
+| Redistribution and use in source and binary forms, with or without |
+| modification, are permitted provided that the following conditions are met: |
+| |
+| Redistributions of source code must retain the above copyright notice, this |
+| list of conditions and the following disclaimer. |
+| |
+| Redistributions in binary form must reproduce the above copyright notice, |
+| this list of conditions and the following disclaimer in the documentation |
+| and/or other materials provided with the distribution. |
+| |
+| Neither the name of Lukas Gebauer nor the names of its contributors may |
+| be used to endorse or promote products derived from this software without |
+| specific prior written permission. |
+| |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
+| DAMAGE. |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2002-2010. |
+| All Rights Reserved. |
+|==============================================================================|
+| Contributor(s): |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package |
+| (Found at URL: http://www.ararat.cz/synapse/) |
+|==============================================================================}
+
+{:@abstract(Telnet script client)
+
+Used RFC: RFC-854
+}
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+
+{$IFDEF UNICODE}
+ {$WARN IMPLICIT_STRING_CAST OFF}
+ {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+unit tlntsend;
+
+interface
+
+uses
+ SysUtils, Classes,
+ blcksock, synautil;
+
+const
+ cTelnetProtocol = '23';
+ cSSHProtocol = '22';
+
+ TLNT_EOR = #239;
+ TLNT_SE = #240;
+ TLNT_NOP = #241;
+ TLNT_DATA_MARK = #242;
+ TLNT_BREAK = #243;
+ TLNT_IP = #244;
+ TLNT_AO = #245;
+ TLNT_AYT = #246;
+ TLNT_EC = #247;
+ TLNT_EL = #248;
+ TLNT_GA = #249;
+ TLNT_SB = #250;
+ TLNT_WILL = #251;
+ TLNT_WONT = #252;
+ TLNT_DO = #253;
+ TLNT_DONT = #254;
+ TLNT_IAC = #255;
+
+type
+ {:@abstract(State of telnet protocol). Used internaly by TTelnetSend.}
+ TTelnetState =(tsDATA, tsIAC, tsIAC_SB, tsIAC_WILL, tsIAC_DO, tsIAC_WONT,
+ tsIAC_DONT, tsIAC_SBIAC, tsIAC_SBDATA, tsSBDATA_IAC);
+
+ {:@abstract(Class with implementation of Telnet/SSH script client.)
+
+ Note: Are you missing properties for specify server address and port? Look to
+ parent @link(TSynaClient) too!}
+ TTelnetSend = class(TSynaClient)
+ private
+ FSock: TTCPBlockSocket;
+ FBuffer: Ansistring;
+ FState: TTelnetState;
+ FSessionLog: Ansistring;
+ FSubNeg: Ansistring;
+ FSubType: Ansichar;
+ FTermType: Ansistring;
+ function Connect: Boolean;
+ function Negotiate(const Buf: Ansistring): Ansistring;
+ procedure FilterHook(Sender: TObject; var Value: AnsiString);
+ public
+ constructor Create;
+ destructor Destroy; override;
+
+ {:Connects to Telnet server.}
+ function Login: Boolean;
+
+ {:Connects to SSH2 server and login by Username and Password properties.
+
+ You must use some of SSL plugins with SSH support. For exammple CryptLib.}
+ function SSHLogin: Boolean;
+
+ {:Logout from telnet server.}
+ procedure Logout;
+
+ {:Send this data to telnet server.}
+ procedure Send(const Value: string);
+
+ {:Reading data from telnet server until Value is readed. If it is not readed
+ until timeout, result is @false. Otherwise result is @true.}
+ function WaitFor(const Value: string): Boolean;
+
+ {:Read data terminated by terminator from telnet server.}
+ function RecvTerminated(const Terminator: string): string;
+
+ {:Read string from telnet server.}
+ function RecvString: string;
+ published
+ {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.}
+ property Sock: TTCPBlockSocket read FSock;
+
+ {:all readed datas in this session (from connect) is stored in this large
+ string.}
+ property SessionLog: Ansistring read FSessionLog write FSessionLog;
+
+ {:Terminal type indentification. By default is 'SYNAPSE'.}
+ property TermType: Ansistring read FTermType write FTermType;
+ end;
+
+implementation
+
+constructor TTelnetSend.Create;
+begin
+ inherited Create;
+ FSock := TTCPBlockSocket.Create;
+ FSock.Owner := self;
+ FSock.OnReadFilter := FilterHook;
+ FTimeout := 60000;
+ FTargetPort := cTelnetProtocol;
+ FSubNeg := '';
+ FSubType := #0;
+ FTermType := 'SYNAPSE';
+end;
+
+destructor TTelnetSend.Destroy;
+begin
+ FSock.Free;
+ inherited Destroy;
+end;
+
+function TTelnetSend.Connect: Boolean;
+begin
+ // Do not call this function! It is calling by LOGIN method!
+ FBuffer := '';
+ FSessionLog := '';
+ FState := tsDATA;
+ FSock.CloseSocket;
+ FSock.LineBuffer := '';
+ FSock.Bind(FIPInterface, cAnyPort);
+ FSock.Connect(FTargetHost, FTargetPort);
+ Result := FSock.LastError = 0;
+end;
+
+function TTelnetSend.RecvTerminated(const Terminator: string): string;
+begin
+ Result := FSock.RecvTerminated(FTimeout, Terminator);
+end;
+
+function TTelnetSend.RecvString: string;
+begin
+ Result := FSock.RecvTerminated(FTimeout, CRLF);
+end;
+
+function TTelnetSend.WaitFor(const Value: string): Boolean;
+begin
+ Result := FSock.RecvTerminated(FTimeout, Value) <> '';
+end;
+
+procedure TTelnetSend.FilterHook(Sender: TObject; var Value: AnsiString);
+begin
+ Value := Negotiate(Value);
+ FSessionLog := FSessionLog + Value;
+end;
+
+function TTelnetSend.Negotiate(const Buf: Ansistring): Ansistring;
+var
+ n: integer;
+ c: Ansichar;
+ Reply: Ansistring;
+ SubReply: Ansistring;
+begin
+ Result := '';
+ for n := 1 to Length(Buf) do
+ begin
+ c := Buf[n];
+ Reply := '';
+ case FState of
+ tsData:
+ if c = TLNT_IAC then
+ FState := tsIAC
+ else
+ Result := Result + c;
+
+ tsIAC:
+ case c of
+ TLNT_IAC:
+ begin
+ FState := tsData;
+ Result := Result + TLNT_IAC;
+ end;
+ TLNT_WILL:
+ FState := tsIAC_WILL;
+ TLNT_WONT:
+ FState := tsIAC_WONT;
+ TLNT_DONT:
+ FState := tsIAC_DONT;
+ TLNT_DO:
+ FState := tsIAC_DO;
+ TLNT_EOR:
+ FState := tsDATA;
+ TLNT_SB:
+ begin
+ FState := tsIAC_SB;
+ FSubType := #0;
+ FSubNeg := '';
+ end;
+ else
+ FState := tsData;
+ end;
+
+ tsIAC_WILL:
+ begin
+ case c of
+ #3: //suppress GA
+ Reply := TLNT_DO;
+ else
+ Reply := TLNT_DONT;
+ end;
+ FState := tsData;
+ end;
+
+ tsIAC_WONT:
+ begin
+ Reply := TLNT_DONT;
+ FState := tsData;
+ end;
+
+ tsIAC_DO:
+ begin
+ case c of
+ #24: //termtype
+ Reply := TLNT_WILL;
+ else
+ Reply := TLNT_WONT;
+ end;
+ FState := tsData;
+ end;
+
+ tsIAC_DONT:
+ begin
+ Reply := TLNT_WONT;
+ FState := tsData;
+ end;
+
+ tsIAC_SB:
+ begin
+ FSubType := c;
+ FState := tsIAC_SBDATA;
+ end;
+
+ tsIAC_SBDATA:
+ begin
+ if c = TLNT_IAC then
+ FState := tsSBDATA_IAC
+ else
+ FSubNeg := FSubNeg + c;
+ end;
+
+ tsSBDATA_IAC:
+ case c of
+ TLNT_IAC:
+ begin
+ FState := tsIAC_SBDATA;
+ FSubNeg := FSubNeg + c;
+ end;
+ TLNT_SE:
+ begin
+ SubReply := '';
+ case FSubType of
+ #24: //termtype
+ begin
+ if (FSubNeg <> '') and (FSubNeg[1] = #1) then
+ SubReply := #0 + FTermType;
+ end;
+ end;
+ Sock.SendString(TLNT_IAC + TLNT_SB + FSubType + SubReply + TLNT_IAC + TLNT_SE);
+ FState := tsDATA;
+ end;
+ else
+ FState := tsDATA;
+ end;
+
+ else
+ FState := tsData;
+ end;
+ if Reply <> '' then
+ Sock.SendString(TLNT_IAC + Reply + c);
+ end;
+
+end;
+
+procedure TTelnetSend.Send(const Value: string);
+begin
+ Sock.SendString(ReplaceString(Value, TLNT_IAC, TLNT_IAC + TLNT_IAC));
+end;
+
+function TTelnetSend.Login: Boolean;
+begin
+ Result := False;
+ if not Connect then
+ Exit;
+ Result := True;
+end;
+
+function TTelnetSend.SSHLogin: Boolean;
+begin
+ Result := False;
+ if Connect then
+ begin
+ FSock.SSL.SSLType := LT_SSHv2;
+ FSock.SSL.Username := FUsername;
+ FSock.SSL.Password := FPassword;
+ FSock.SSLDoConnect;
+ Result := FSock.LastError = 0;
+ end;
+end;
+
+procedure TTelnetSend.Logout;
+begin
+ FSock.CloseSocket;
+end;
+
+
+end.
ADDED lib/synapse/synapse_logo.gif
Index: lib/synapse/synapse_logo.gif
==================================================================
--- /dev/null
+++ lib/synapse/synapse_logo.gif
cannot compute difference between binary files
ADDED lib/synapse/winsock2.txt
Index: lib/synapse/winsock2.txt
==================================================================
--- /dev/null
+++ lib/synapse/winsock2.txt
@@ -0,0 +1,25 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+WINDOWS:
+
+Remember, Synapse work with Winsock2 on Windows! (on Win98 and WinNT 4.0 or higher)
+
+If you must use this unit on Win95, download Winsock2 from Microsoft
+and distribute it with your application!
+
+On WinNT standardly RAW sockets work if program is running under user with
+administrators provilegies. To use RAW sockets under another users, you must
+create the following registry variable and set its value to DWORD 1:
+
+HKLM\System\CurrentControlSet\Services\Afd\Parameters\DisableRawSecurity
+
+After you change the registry, you need to restart your computer!
+
+
+LINUX:
+
+Remember, some of functions or classes work only with root rights!
+If you need this for another user then root, you must assign root right
+for your binary file.
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
ADDED mailjanitor.lpi
Index: mailjanitor.lpi
==================================================================
--- /dev/null
+++ mailjanitor.lpi
@@ -0,0 +1,77 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
ADDED mailjanitor.pas
Index: mailjanitor.pas
==================================================================
--- /dev/null
+++ mailjanitor.pas
@@ -0,0 +1,109 @@
+#!/usr/bin/env instantfpc
+{$mode objfpc}{$H+}
+uses
+ Classes, SysUtils,
+ IniFiles,
+ imapsend in 'lib/synapse/source/lib/imapsend.pas',
+ blcksock in 'lib/synapse/source/lib/blcksock.pas',
+ synafpc in 'lib/synapse/source/lib/synafpc.pas',
+ synsock in 'lib/synapse/source/lib/synsock.pas',
+ synautil in 'lib/synapse/source/lib/synautil.pas',
+ synacode in 'lib/synapse/source/lib/synacode.pas',
+ synaip in 'lib/synapse/source/lib/synaip.pas';
+
+
+type
+
+ { TMailJanitor }
+
+ TMailJanitor = class
+ private
+ FIni: TIniFile;
+ FServer: TIMAPSend;
+ public
+ constructor Create(const ConfigFile: string);
+ destructor Destroy; override;
+
+ procedure Execute;
+
+ property Config: TIniFile read FIni;
+ end;
+
+
+var
+ MJ: TMailJanitor;
+
+{ TMailJanitor }
+
+constructor TMailJanitor.Create(const ConfigFile: string);
+var
+ Password: string;
+begin
+ FIni := TIniFile.Create(ConfigFile);
+ FServer := TIMAPSend.Create;
+
+ // TODO: open cache database
+
+ // TODO: move this to a Connect procedure
+ FServer.TargetHost := FIni.ReadString('Server', 'Host', '');
+ FServer.TargetPort := FIni.ReadString('Server', 'Port', '');
+ FServer.AutoTLS := Fini.ReadBool('Server', 'AutoTLS', False);
+ FServer.StartTLS := Fini.ReadBool('Server', 'StartTLS', False);
+
+ FServer.UserName := FIni.ReadString('Server', 'UserName', '');
+ Password := FIni.ReadString('Server', 'Password*', '');
+ if Password <> '' then begin
+ // TODO: decrypt password
+ FServer.Password := Password;
+ end else if Password = '' then begin
+ Password := FIni.ReadString('Server', 'Password', '');
+ FServer.Password := Password;
+ // TODO: encrypt password on first pass, and save it as Password*=
+ Password := Password;
+ FIni.DeleteKey('Server', 'Password');
+ FIni.WriteString('Server', 'Password*', Password);
+ end;
+ FServer.Login;
+end {TMailJanitor.Create};
+
+destructor TMailJanitor.Destroy;
+begin
+ FServer.Free;
+ FIni.Free;
+ inherited Destroy;
+end;
+
+procedure TMailJanitor.Execute;
+begin
+ // TODO: read requested folder(s)
+ // TODO: search for new messages according to the specified criteria
+
+end;
+
+begin
+ try
+ MJ := TMailJanitor.Create(ParamStr(1));
+ try
+ MJ.Execute;
+ (*
+ // TODO: for each requested server:
+ // TODO: open SQLite database for this server
+ // TODO: connect to IMAP server
+ // TODO: login
+ // TODO: read requested folders (or all)?
+ // TODO: search for messages according to specified criteria
+ // TODO: save new relevant messages to the db
+ // TODO: group messages as necessary
+ // TODO: filter and identify messages to be moved, deleted etc.
+ *)
+ finally
+ MJ.Free;
+ end;
+ except
+ on E: Exception do begin
+ Beep;
+ ShowException(ExceptObject, ExceptAddr);
+ end;
+ end;
+end.
+