{*_* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Author: Angus Robertson, Magenta Systems Ltd Description: TIcsFtpMultiW is a high level FTP Delphi component that allows uploading or downloading of multiple files from or to an FTP server, from a single function call. W version supports widestring/Unicode for Delphi 2007 Creation: May 2001 Updated: Oct 2022 Version: 8.69 EMail: francois.piette@overbyte.be http://www.overbyte.be Support: https://en.delphipraxis.net/forum/37-ics-internet-component-suite/ Legal issues: Copyright (C) 2022 by Angus Robertson, Magenta Systems Ltd, Croydon, England. delphi@magsys.co.uk, https://www.magsys.co.uk/delphi/ This software is provided 'as-is', without any express or implied warranty. In no event will the author be held liable for any damages arising from the use of this software. Permission is granted to anyone to use this software for any purpose, including commercial applications, and to alter it and redistribute it freely, subject to the following restrictions: 1. The origin of this software must not be misrepresented, you must not claim that you wrote the original software. If you use this software in a product, an acknowledgment in the product documentation would be appreciated but is not required. 2. Altered source versions must be plainly marked as such, and must not be misrepresented as being the original software. 3. This notice may not be removed or altered from any source distribution. 4. You must register this software by sending a picture postcard to the author. Use a nice stamp and mention your name, street address, EMail address and any comment you like to say. TIcsFtpMultiW is a high level FTP Delphi component that allows uploading or downloading of multiple files from or to an FTP server, from a single function call. The component handles listing local and remote files, including subdirectories, and comparing them to avoid unnecessary transfers, selection using a file mask, deletion of old files, resuming failed FTP downloads, unzipping of downloaded files, or zipping before upload, deletion after uploading or downloading, archive copy after upload. A progress event provides various levels of information for logging or display, depending upon application requirements, and allows transfers to be cancelled. TIcsFtpMultiW descends from ICS TFtpClient, and publishes all it's logon and proxy properties and events. The component is undocumented, except for source code comments, but end user help is available describing most of the functionality in Magenta Systems DUN Manager application (from https://www.magsys.co.uk/dunman/), look under Scheduled Task Properties, FTP General, FTP Common, FTP Upload and FTP Download. DUN Manager also provides a compiled test application for TIcsFtpMulti (but DM source code is not available). Requires Kevin Boylan's TVCLZip component for zipping from http://www.vclzip.net/, if you don't purchase this component you will need to suppress DEFINE Zipping from MAGZIP.INC so the zip code is not linked. Main functions: FtpDir - build file directory from FTP server FtpLogon - connect and logon to FTP server DispFtpDir - logon and return formatted file directory from FTP server FtpDownload - logon and download files from FTP server FtpUpload - logon and upload files to FTP server Cancel - abort FTP xfers 14 May 2001 - baseline 5 June 2001 - added ReplRO to replace read only files on download 8 June 2001 - added Fr to TFileRec elements so names are unique 25 June 2001 - added LogLevelDelimFile and LogLevelDelimTot to return info for each file suitable for further processing 29 June 2001 - fixed problem with fMask not getting all files to check 9 July 2001 - added HostName1 and HostName2 as alternates 1 Aug 2001 - use AbortXfer instead of Abort, cleaner 6 Aug 2001 - added archive directory move after upload 8 Aug 2001 - added zipping of uploads and downloads using VCLZip component from http://vclzip.bizland.com/ 2 Sept 2001 - more error handling in delete after ftp upload, fixed case comparison 12 Dec 2001 - added TIcsTaskResult to distinguish results better 22 Dec 2001 - finally made zipping a conditional compile for those that have not bought it 8 Jan 2002 - fixed UNIX dates being last year if greater than today - don't change case of directories if mixed specified 21 Apr 2002 - free VCLZIP arhivestream (needed for 2.23) 11 July 2002 - added ResFailed and MinResSize, allow FTP resume of partial downloads 4 Sept 2002 - added IgnoreFileExt - list is tmp;ftp;xxx;etc 08 Oct 2002 - no longer using trailing slashes on directories internally, still seems to work 09 Dec 2002 - slight change in UNIX directory detection uploads, added UpImmed to optionally delete/move after each file done time comparisons, added UseUTC to optionally with UTC/GMT time 07 Jan 2003 - better error handling when connection lost use FEAT command to see what FTP server will do try and use MDTM and SIZE command to get and set upload time stamp 03 Feb 2003 - show FTP host being contacted at info log level 24 Apr 2003 - no longer supporting UTC time, upload MDTM now standard time download deleting empty directories building FTP dirs now uses real temp file to avoid conflicts between multiple DMs 2 May 2003 - changed GetDirList with new params 17 Jun 2003 - added duration (ms) to LogLevelDelimFile events 24 Aug 2003 - ensure unzip directory exists, might help trap unzipping errors unzip errors in task log 4 Oct 2003 - when deleting old local files, don't delete FTP/TMP resume files 26 Oct 2003 - support MLSD directory list command - but ws_ftp server returns local date, not UTC fixed double slash in FTP download PC name added SpecificFiles property with | delimited list passed in SrcFName, up and down added unzip error handler - VCLZIP 3 only check each file mod date and size before download, more accurate than DIR set upload date in UTC use streams for DIR listing to avoid temporary files 15 Dec 2003 - check both sockets are closed, otherwise abort, reset fCancelFlag at start 30 Dec 2003 - allow FTP DIR response to be logged using fDispRemList fixed a problem with a blank subdir stopping directory listing (introduced with DIR streams) 4 Jan 2003 - using magsubs1 for common stuff instead of magsubs4 - using TIcsFileCopy for events 11 Jan 2004 - made Delphi 5 compatible, SpecificFiles not supported (no TStringList.Delimiter) 12 Feb 2004 - clear progress event, correct upload none response message 28 Aug 2004 - added FtpLogoff, FtpDownFiles (same as FtpDownload but already logged-on) added FtpDownOneFile, FtpUpOneFile and FtpCheckFile FtpDir no longer changes directories when listing (except LIST dirname fails if it contains a IcsSpace on IIS/5) added workaround for error sending PORT command when PO lost, causing xfer failure fUpImmed forced, by checking each upload file after it's done to avoid directory afterwards if remote directory listing fails for uploads, give up to stop all files being uploaded, unless replacing all files FCReplNewer also replaces if target file empty and source file not empty support MFMT modify file modification time command if available support MD5 get has sum for download or upload file check corruption repeat failed download up to three times if FailRepeat<>0 upload to temporary file and rename once checked successfully uploads now supporting resume on failure fixed divide by zero error calculating total upload duration (fixed download already) override WaitUntilReady in ftpcli.pas to avoid slow down problems 12 Oct 2004 - added file sizes when upload fails due to wrong size always log single line LIST/MLSD used for checking single files messing with updating UTC time stamps 29 Nov 2004 - suppressed state/request logging, more cancel breakouts and logging 13 Jan 2005 - removed sleep from WaitUntilReady 14 Feb 2005 - count failed resumed uploads/downloads, limit retries to five 10 Apr 2005 - fixed FTP MS-DOS LIST date 12:30AM being converted to 12:30 not 00:30 - trim src and tar directories 18 Apr 2005 - using new IcsGetTickCount functions that support wrapping at 49 days 30 July 2005 - TIcsFindList moved to magclasses.pas 11 Aug 2005 - more error handling to trap lost connection during upload/download and prevent false OK 20 Aug 2005 - corrected false fail with no connection for all uploads 6 Sept 2005 - cleaned up unused variables, wait up to 5 secs for sockets to close after quit - 64-bit support, FtpCheckFile has 64-bit size (not backward compatible) - prevent too rapid progress messages, which slow down transfers, ProgressSecs = 5 - FtpCli v2.100 fixes problem uploading files about 10K in size 19 Oct 2005 - fixed bug with short or zero upload or download duration showing as 120 hours don't retry for 501 permission error 3 Nov 2005 - latest ICS needs OnProgress64 not OnProgre64 5 Dec 2005 - now supporting ICS v5 SSL dated Nov 2005 or later - support Mode Z compression 26 Jan 2006 - support for new icslogger (not here), new SSL version 15 Feb 2006 - report error descriptions as well as numbers 16 Mar 2006 - check for single file use MDTM if MLST fails - ignore MLSD cdir and pdir lines with names 24 June 2006 - if xfer cancelled, set abort in progress to stop data being written resume download assume end of part file corrupt and start fMinResSize earlier increased fMinResSize default from 10K to 65K if xfer cancelled, still report download result 6 Aug 2006 - added KeepAliveSecs property in TFtpCli, if not zero sets Winsock keepalive for control connection to stop it being closed by firewalls, typically 30 secs supporting XCRC command if MD5 command not available, to check files xfer'd OK 3 Sept 2006 - fixed some logging that broke on files large than 2 gigs fixed FtpCheckFile now allowing for MLST mixed case facts (Serv-U) 18 Sep 2006 - unit is now MagentaFtp supporting ICS V6 31 Oct 2006 - use callback during MD5/CRC calculations for progress and processmessages 6 Nov 2006 - new SSL session cache 6 Jan 2007 - allow for base directory with drive (ie c:) when setting root directory stopped using LIST path (CD instead) since some servers don't support it 19 July 2007 - ensure resume position reset before directory commands report DIR error if FtpCheckFile fails more logging for resumed downloads 6 Aug 2007 - MLSD listings don't ignore single character files and directories 03 Mar 2008 - MSLD fix for Serv-U where it only listed directories and no files new NoFeatCmd property which stops FEAT command being sent where servers have not implemented features 'correctly' causing FTP to fail using ALLO command to check IcsSpace on server before uploads send CLNT client string on logon use SITE DMLSD command to list directories including subdirectore and SITE CMLSD for single dirs (ICS FTP server only at present) LookupFTPReq and LookupFTPState moved to TFtpCli LogLevelDelimFile has actual xfer size after duration, including failures using XMD5 if available, log time taken by MD5/CRC commands adding File/Delim logging for failed MD5/CRC on download and report MD5/CRC error for upload failed (not FTP response) don't use ModeZ for directory listing, except recursive added ZlibNoCompExt property which is list of file extensions which should no use Mode Z, defaults to '.zip;.rar;.7z;.cab;.lzh;.gz;.avi;.wmv;.mpg;.mp3;.jpg;.png;' added ZlibMaxSize property maximum file size for Mode Z (servers may struggle with large files) don't attempt to resume xfer if partial file larger than new file don't repeatedly abort as errors reported, which may cause problem with Zlib errors added MaxResumeAttempts property, default 10 (was fixed 5) added MaxXferAttempts property, default 3 if download tmp file already open, use tmp2 instead check more than fMinResSize downloaded for file size mismatch in case file is smaller on resume when downloading, get server file size/date before each repeat attempt in case changed if passive connection fails, Abort xfer so server cleans up retry on 501 errors added MagFtpOps property to disable advanced features: magftpNoFeat, magftpNoZlib, magftpNoMd5Crc, magftpNoTmpFile when no new files to upload, still delete old target files warn if ignoring delete old target files 11 Jun 2008 - ensure lists set as sorted after sorting 7 Aug 2008 - 2.3 - updated for latest ICS V6 and V7, and for Delphi 2009 compatibility Note: FTP does not yet support Unicode commands 22 Sept 2008 - 3.0 - Unicode vesion unit renamed MagentaFtpW with TIcsFtpMultiW support UTF8 FTP commands and file listings with ICS V7 - currently ICS V6 not supported added magftpNoUtf8 property to turn off UTF8, and magftpIgnoreUtf8 if server will not turn it off support Unicode file listing and xfers with Delphi 2007 and earlier (note this meant replacing vast numbers of Ansi functions with widestring versions) don't attempt to access files or directories with Unicode substitution ? character check file names only have ANSI characters unless UTF8 is enabled don't keep upload resume files unless some data actually sent don't attempt to upload _xxx.ftp resume files uploading always allowed to create base directory, and it now works properly WS_FTP MLST with 501 Invalid number of arguments with spaces, so try quoting file name SSL send PBSZ before PROT to keep MS FTP7 happy send HOST command before logon unless magftpNoHost specified (for virtual FTP servers) 22 Oct 2008 - 3.1 - fixed zipping for Unicode changes, but still VCLZip 3 fixed bug if PWD returned blank rather than '/' (Indy) directory listings now Unicode using private wide ICS units, OverbyteIcsFtpcliW, OverbyteIcsFtpSrvWT which support Unicode with D2007 ensure Progress event called xfer starts rather than after 2 secs 18 Nov 2008 - 3.2 - renamed to MagentaFtp3w, support XDMLSD and XCLMSD commands fixed PASS argument not being sanitised all FTP display events now UnicodeString 17 May 2009 - 3.4 - don't ignore failed MD5/XMD5 command but report error, prefer MD5 to XMD5 added MaskLocDir and MaskRemDir flags to take masked directory from SrcFName and add to local and/or remote directory, typically for dated directories Unicode MD5sum and CRC32B, add magftpNoMd5 and magftpNoCrc to allow them to be tested separately 22 May 2009 - 3.5 - fix bug to stop looping listing sub directories if CWD returns 550 7 June 2010 - 3.5 - fix a problem parsing UNIX file listing with strange upper case file attributes 11 Aug 2011 - 3.7 - ICS changes, new throttling, zlib 1.2.5 support MultiThreaded using TIcsWndControl.MessagePump instead of Application.ProcessMessages some checksum Info logging should only have been File logging added TIcsFtpMultiThreadW component which runs TIcsFtpMultiW in a thread, tested with 250 threads running together added NoProgress property to skip LogLevelProg progress log events FTP empty directories if EmptyDirs property set fixed bug listing sub-directories from root with MLSD command 20 Oct 2011 - 3.8 - log time and speed of each download most file sizes now reported in Kbytes. Mbytes, Gbytes instead of bytes 24 Aug 2012 - 4.0 - updated to support ICS V8 with IPv6 24 Jul 2013 - 4.1 - default to allowing IPv4 or IPv6 host names added IgnorePaths, ignore files where source has specific partial path, list is c:\temp;c:\temp2\;c:\temp3\;etc, or destination for deletion marches partial path added Wow64RedirDisable property for Win64 allow all files to be copied correctly from Win32 added new ProgressEvent which passes TCopyProgress record updated for progress of current file and session including total bytes copied allowing percentage progress display using TIcsStringBuild to build listings Fixed bug in WaitUntilReady that meant some sync methods with multiple commands randomly terminated prematurely allowing further commands to be sent usually resulting in not ready errors, reproduced with resumed uploads. 13 Jul 2015 - 4.2 - better SSL handshake reporting added SSL server certificate checking 23 Oct 2015 - 4.3 - better SSL certificate reporting failed certificate report error as last FTP error Warning, self signed certificates are not trusted 23 Feb 2016 - 4.4 - fixed a bug that always treated upload file names as lower case 7 Dec 2016 - 4.5 - more friendly errors removed TX509Ex now using TX509Base using OpenSSL certificate verification host checking set SSL session caching correctly only check and report SSL certificates once per session 6 Mar 2017 - 4.6 - simplified SSL certificate reporting set SSL security level low, ideally should be configurable 18 Jun 2018 - 4.7 - Use built-in CA bundle if file missing. Added SslCliSecurity property to set security level to TSslCliSecurity 18 Mar 2019 - V8.60 - Adapted for main ICS packages and FMX support. SSL only. Renamed TMagFtp to TIcsFtpMulti. Most Types have Ics added, so: TIcsTaskResult now TIcsTaskResult. No longer needs Forms. Using TWideStringList instead of UStringArray, not Delphi 7 7 Aug 2019 - V8.62 - Support NO_DEBUG_LOG properly. 3 Nov 2019 - V8.63 - Added SslCliSecurity, FtpType and IgnorePaths to TIcsFtpMultiThread. 17 Dec 2020 - V8.65 - If SSL handshake fails due to bad certificate or chain, remove SSL session from cache so an immediate retry does not succeed by skipping the certificate checks. Builds without SSL again. May 24, 2021 - V8.67 - Replaced Stream.Seek with Stream.Position. Jan 04, 2022 - V8.68 - BOOL to Boolean. Remove SSL session cache port so data session can use control session. Apr 14, 2022 - V8.69 - Previously the FtpSslRevocation property was only effective when checking the windows certificate store, now it also works with bundle files using the TOcspHttp component and OCSP stapling if available. Oct 21, 2022 - V8.70 Simplified ZLIB support to allow use of System.ZLib. pending - use VclZip v4 widestring version pending - average speed should only time actual download and ignore MD5 and checking Unicode Compatibility with various web servers Note: UTF8 support may not include Unicode characters outside ANSI codeset OPTS UTF8 or OPTS UTF8 ON command must be sent before most servers support UTF8 file listings or uploads ICS V6 - does not support UTF8 ICS V7 - support UTF8, fully Unicode capable when build with Delphi 2009 or later, defaults to UTF8 OFF and returns ANSI file listings, OPTS UTF8 or OPTS UTF8 ON enables UTF8 file listings and uploads ICS V7 Wide - support UTF8, fully Unicode capable when build with Delphi 2007 or later defaults to UTF8 OFF and returns ANSI file listings, OPTS UTF8 or OPTS UTF8 ON enables UTF8 file listings and uploads Microsoft IIS/5 and IIS/6 no UTF8 support Microsoft FTP7 IIS/7 for Windows 2008 - fully Unicode capable, defaults to UTF8 OFF and returns ANSI file listings, OPTS UTF8 or OPTS UTF8 ON enables UTF8 file listings and uploads FileZilla Server - fully Unicode capable, defaults to UTF8 ON returning UFT8 file listings and uploads, but can be disabled with OPTS UTF8 OFF command when listings revert to ANSI WS_FTP Server 6.1.1 and 7.0.0 - fully Unicode capable, defaults to UTF8 OFF and returns ANSI file listings, OPTS UTF8 or OPTS UTF8 ON enables UTF8 file listings and uploads, UTF8 can not be set off so don't send command if ANSI needed MLST fails with 501 if file name includes a space RhinoSoft Serv-U FTP Server v7.2 - no Unicode support, defaults to UTF8 OFF but returns UTF8 file listings (with ? for non-supported unicode characters), OPTS UTF8 ON enables UTF8 uploads. OPTS UTF8 OFF command reverts listings to ANSI MLST fails with 550 for file names with any UTF8 escaped characters MDTM YYYYMMDDHHMMSS fail if timezone used (worked in earlier releases) v7.3 fixes the MLST and MDTM errors, and adds MFMT, v8 will support Unicode Gene6 FTP Server v3.10.0 - fully Unicode capable, defaults to UTF8 OFF and returns ANSI file listings, OPTS UTF8 or OPTS UTF8 ON enables UTF8 file listings and uploads, UTF8 can not be set off so don't send command if ANSI needed. MLSD fails with a Unicode sub-directory argument (but CWD works OK with Unicode) Indy 10 FTP Server component built with Delphi 2007 - no UTF8 support (probably, but may be configured using some hidden option) MLST fails with 250 end if a file name is passed * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} unit OverbyteIcsFtpMultiW; {$I Include\OverbyteIcsDefs.inc} {$I Include\OverbyteVclZip.inc} {$IFDEF COMPILER14_UP} {$IFDEF NO_EXTENDED_RTTI} {$RTTI EXPLICIT METHODS([]) FIELDS([]) PROPERTIES([])} {$ENDIF} {$ENDIF} {$B-} { Enable partial boolean evaluation } {$T-} { Untyped pointers } {$X+} { Enable extended syntax } {$H+} { Use long strings } {$IFDEF BCB} {$ObjExportAll On} {$ENDIF} interface uses Windows, Messages, SysUtils, Classes, Forms, StrUtils, WideStrings, OverbyteIcsWndControl, OverbyteIcsWSocket, OverbyteIcsFtpcliW, OverbyteIcsFtpSrvWT, OverbyteIcsFileCopyW, OverbyteIcsMd5, OverbyteIcsCRC, OverbyteIcsBlacklist, OverbyteIcsTypes, OverbyteIcsUtils, OverbyteIcsLogger, {$IFDEF Zipping} VCLZip, VCLUnZip, kpZipObj,{$ENDIF} OverbyteIcsSSLEAY, OverbyteIcsLIBEAY, OverbyteIcsSslSessionCache, OverbyteIcsSslX509Utils, OverbyteIcsMsSslUtils, OverbyteIcsWinCrypt, OverbyteIcsSslHttpRest; { V8.69 } { NOTE - these components only build with SSL, there is no non-SSL option } {$IFDEF USE_SSL} const FtpMultiCopyRight : String = ' TIcsFtpMultiW (c) 2022 V8.70 '; type // host type, for directory listing THostType = (FTPTYPE_NONE, FTPTYPE_UNIX, FTPTYPE_DOS, FTPTYPE_MVS, FTPTYPE_AS400, FTPTYPE_MLSD) ; TXferMode = (XferModeBinary, XferModeAscii) ; TBulkMode = (BulkModeNone, BulkModeDownload, BulkModeUpload) ; TCaseFile = (FileLowerCase, FileMixedCase) ; TFtpType = (FtpTypeNone, FtpTypeAuthSslCtl, FtpTypeAuthSslData, FtpTypeAuthSslBoth, FtpTypeConnSslCtl, FtpTypeConnSslData, FtpTypeConnSslBoth); { AuthSsl = explicit encryption on port 21 using AUTH command } { ConnSsl = implicit encryption on port 990 forced on connection } TMagFtpOpt = (magftpNoFeat, magftpNoZlib, magftpNoMd5Crc, magftpNoTmpFile, magftpNoUtf8, magftpIgnoreUtf8, magftpNoHost, magftpNoMd5, magftpNoCrc); // 15 Apr 2009 TMagFtpOpts = set of TMagFtpOpt; TFtpThreadOpt = (ftpthdList, ftpthdDownCheck, ftpthdDownFiles, ftpthdUpCheck, ftpthdUpFiles) ; // 14 Feb 2011 TFtpSslVerifyMethod = (ftpSslVerNone, ftpSslVerBundle, ftpSslVerWinStore) ; const FtpTypeStrings: array[Low(TFtpType)..High(TFtpType)] of String = ('Not Secured', 'Secured SSL/TLS Auth - Control Only', 'Secured SSL/TLS Auth - Data Only', 'Secured SSL/TLS Auth - Control and Data', 'Secured SSL/TLS Conn - Control Only', 'Secured SSL/TLS Conn - Data Only', 'Secured SSL/TLS Conn - Control and Data') ; ResInfServer = 0 ; ResInfFName = 1 ; ResInfStamp = 2 ; ResInfSize = 3 ; ResInfAttempts = 4 ; ResInfLastBytes = 5 ; type TIcsFtpMultiW = class(TSslFtpClientW) private { Private declarations } fCancelFlag: boolean ; fProgFileSize: Int64 ; fLoggedIn: boolean ; fFtpErrFlag: boolean ; fIcsFileCopy: TIcsFileCopyW ; fFtpType: TFtpType ; // 11 Nov 2005, settable even if no SSL fFtpSslVerMethod: TFtpSslVerifyMethod; // 20 Apr 2015 fFtpSslRootFile: string ; // 20 Apr 2015 fFtpSslPort: string ; fFtpSslRevocation: boolean; fFtpSslReportChain: boolean ; fFtpSslCliSecurity: TSslCliSecurity; // June 2018 fSslSessCache: boolean ; fSslContext: TSslContext ; fExternalSslSessionCache: TSslAvlSessionCache ; FMsCertChainEngine: TMsCertChainEngine; FOcspHttp: TOcspHttp; { V8.69 } protected { Protected declarations } fBulkMode: TBulkMode ; fHostName1: string ; fHostName2: string ; fSrcDir: UnicodeString ; fSrcFName: UnicodeString ; fTarDir: UnicodeString ; fCopyType: TIcsFileCopyType ; fSubDirs: Boolean ; fDelDone: Boolean ; fDelOldTar: Boolean ; fMask: Boolean ; fPrev: Boolean ; fRepl: TIcsFileCopyRepl ; fReplRO: boolean ; fSafe: Boolean ; fTimeStamp: boolean ; fLocalHost: Ansistring ; fDispLog: boolean ; fDispFiles: boolean ; fDispLDir: boolean ; fDispRDir: boolean ; fHostType: THostType ; fXferMode: TXferMode ; fCaseFile: TCaseFile ; fDiffStampMins: integer ; fCopyEvent: TBulkCopyEventW ; fReqResponse: String ; fServRootDir: UnicodeString ; fServBaseDir: UnicodeString ; fMaxAttempts: integer ; // logon attempts fAttemptDelay: integer ; fUpArchDir: UnicodeString ; fUpArchive: Boolean ; fResFailed: Boolean ; fMinResSize: Int64 ; // also used for Resume Overlap 24 June 2006 fIgnoreFileExt: UnicodeString ; fUpImmed: Boolean ; // 17 Aug 2004 - now ignored fSpecificFiles: boolean ; // 14 Oct 03 fDispRemList: boolean ; // 30 Dec 2003 fCurRemDir: UnicodeString ; // 10 Aug 2004 fFailRepeat: integer ; // 20 Aug 2004 fProgressSecs: integer ; // 5 Sept 2005 fUseCompression: boolean ; // 2 Dec 2005 fUsingCompression: boolean ; // 5 Dec 2005 fTimeZoneStr: string ; // 8 Nov 2007 fZlibNoCompExt: string ; // 2 Dec 2007 fZlibMaxSize: int64 ; // 9 Dec 2007 - zero means no compression fMaxResumeAttempts: integer ; // 31 Dec 2007 resume attempts fMagFtpOpts: TMagFtpOpts; // 5 Jan 2008 fMaskLocDir: boolean ; // 8 Apr 2009 fMaskRemDir: boolean ; // 8 Apr 2009 fNoProgress: boolean ; // 15 Feb 2011 fEmptyDirs: boolean ; // 17 Feb 2011 fIgnorePaths: UnicodeString ; // 22 May 2013 fCopyProg: TIcsCopyProgressW ; // 22 May 2013 replaces most fTotxx/fProcxx variables fWow64RedirDisable: boolean ; // 22 May 2013 fProgressEvent: TProgressEventW ; // 22 May 2013 {$IFDEF Zipping} fZipDownDel: Boolean ; fZipped: Boolean ; fZipExtFmt: TIcsZipExtFmt ; fZipPath: TIcsZipPath ; fZipDir: String ; {$ENDIF} procedure doCopyEvent (const LogLevel: TIcsCopyLogLevel; const Info: UnicodeString) ; procedure onFtpClientProg64 (Sender: TObject; Count: Int64; var Abort: Boolean); procedure onFtpClientDisplay (Sender: TObject; var Msg: UnicodeString); procedure onFtpError(Sender: TObject; var Msg: UnicodeString); procedure OnFtpResponse (Sender: TObject) ; procedure OnFtpSessConn (Sender: TObject; Error: word) ; procedure OnFtpSessClosed (Sender: TObject; Error: word) ; procedure OnFtpRequestDone (Sender: TObject; RqType: TFtpRequest; Error: Word) ; procedure OnFtpStateChange (Sender: TObject) ; procedure OnFTPSocksConnected (Sender: TObject; Error: word) ; procedure onMagCopyEvent (LogLevel: TIcsCopyLogLevel ; Info: UnicodeString ; var Cancel: boolean) ; procedure EndUnZipEvent (Sender: TObject; FileIndex: Integer; FName: String) ; procedure UnZipHandleMessage(Sender: TObject; const MessageID: Integer; const Msg1, Msg2: String; const flags: Cardinal; var Return: Integer); function IntDownOne (const RemDir, RemFile, RemFull, LocFileFull: UnicodeString ; const RFSize: Int64; RFileUDT: TDateTime): integer ; function IntUpOne (const LocFileFull, RemDir, RemFile: UnicodeString ; const RFSize: Int64; RFileUDT: TDateTime): integer ; function WaitUntilReady : Boolean; Override ; procedure SetSrcDir (S: UnicodeString) ; procedure SetTarDir (S: UnicodeString) ; procedure onZlibProg (Sender: TObject; Count: Int64; var Cancel: Boolean); // 9 Dec 2007 procedure sysDelayX (aMs: longword); procedure OnFTPSslVerifyPeer(Sender: TObject; var Ok: Integer; Cert : TX509Base); procedure OnFTPSslCliNewSession(Sender: TObject; SslSession: Pointer; WasReused: Boolean; var IncRefCount : Boolean); procedure OnFTPSslCliGetSession(Sender: TObject; var SslSession: Pointer; var FreeSession : Boolean); procedure OnFTPSslHandshakeDone(Sender: TObject; ErrCode: Word; PeerCert: TX509Base; var Disconnect: Boolean); procedure OnFTPSslCliCertRequest(Sender: TObject; var Cert: TX509Base); procedure IcsProgEvent (Sender: TObject; LogOption: TLogOption; const Msg : String) ; { V8.69 } public { Public declarations } SrcFiles: TIcsFDirRecsW ; SrcFileList: TIcsFindList ; TotSrcFiles: integer ; TarFiles: TIcsFDirRecsW ; TarFileList: TIcsFindList ; TotTarFiles: integer ; // CurDelFiles: integer ; /// 22 May 2013 LogRcvdCerts: boolean ; // 20 Apr 2015 Utf8DiagFlag: boolean ; // 13 Nov 2008 constructor Create (Aowner: TComponent) ; override ; destructor Destroy ; override ; function DispFtpDir (var dirlisting: UnicodeString): TIcsTaskResult ; function FtpDir (var FtpFiles: TIcsFDirRecsW; var FtpFileList: TIcsFindList; const ListDirs: boolean = false): TIcsTaskResult ; // 17 Feb 2011 function FtpLogon: TIcsTaskResult ; function FtpDownload (const CheckFiles: boolean): TIcsTaskResult ; function FtpUpload (const CheckFiles: boolean): TIcsTaskResult ; procedure Cancel ; function UnpackFtpFDir (DirStream: TStream; RemDir, BaseDir: UnicodeString; Level: integer ; var DCodePage: Cardinal ; var HostType: THostType; var TotFiles: integer; var RemFiles: TIcsFDirRecsW): integer ; procedure FtpLogoff ; function FtpDownFiles (const CheckFiles: boolean): TIcsTaskResult ; function FtpDownOneFile (const FdirSrc, Fnamesrc, Fnametar: UnicodeString ; Replopt: TIcsFileCopyRepl) : TIcsTaskResult ; function FtpUpOneFile (const LocFileFull, RemTarDir, RemTarFile: UnicodeString; Replopt: TIcsFileCopyRepl) : TIcsTaskResult ; function FtpCheckFile (const RemDir, RemFile: UnicodeString ; var FSize: Int64; var FileUDT: TDateTime): boolean; { Pass it the string that you get back when you get the { Current path for the FTP site. It returns { FTPType of FTP_TYPE_NONE or FTP_TYPE_MVS depending { if it looks like the folder string format is that of an VMS system { or not. After using this function, you will need to use the FTP_ConvertLines { to further determine if the server type is DOS/WINDOWS or UNIX or AS-400} Procedure SetupVMS(const BaseFolder: string; var HostType: THostType); published { Published declarations } property BulkMode: TBulkMode read fBulkMode write fBulkMode ; property HostName1: string read fHostName1 write fHostName1 ; property HostName2: string read fHostName2 write fHostName2 ; property SrcDir: UnicodeString read fSrcDir write SetSrcDir ; property SrcFName: UnicodeString read fSrcFName write fSrcFName ; property TarDir: UnicodeString read fTarDir write SetTarDir ; property CopyType: TIcsFileCopyType read fCopyType write fCopyType ; property SubDirs: Boolean read fSubDirs write fSubDirs ; property DelDone: Boolean read fDelDone write fDelDone ; property DelOldTar: Boolean read fDelOldTar write fDelOldTar ; property Mask: Boolean read fMask write fMask ; property Prev: Boolean read fPrev write fPrev ; property Repl: TIcsFileCopyRepl read fRepl write fRepl ; property ReplRO: boolean read fReplRO write fReplRO ; property Safe: Boolean read fSafe write fSafe ; property TimeStamp: boolean read fTimeStamp write fTimeStamp ; property LocalHost: AnsiString read fLocalHost write fLocalHost ; property DispLog: boolean read fDispLog write fDispLog ; property DispFiles: boolean read fDispFiles write fDispFiles ; property DispLDir: boolean read fDispLDir write fDispLDir ; property DispRDir: boolean read fDispRDir write fDispRDir ; property HostType: THostType read fHostType write fHostType ; property XferMode: TXferMode read fXferMode write fXferMode ; property CaseFile: TCaseFile read fCaseFile write fCaseFile ; property DiffStampMins: integer read fDiffStampMins write fDiffStampMins ; property FailRepeat: integer read fFailRepeat write fFailRepeat ; // 20 Aug 2004 property ProgressSecs: integer read fProgressSecs write fProgressSecs ; // 5 Sept 2005 property CopyEvent: TBulkCopyEventW read fCopyEvent write fCopyEvent ; property FtpType: TFtpType read fFtpType write fFtpType ; // 11 Nov 2005 property UseCompression: boolean read fUseCompression write fUseCompression ; // 3 Dec 2005 property SslSessCache: boolean read fSslSessCache write fSslSessCache ; // 11 Nov 2005 property FtpSslPort: string read fFtpSslPort write fFtpSslPort ; // 11 Nov 2005 property FtpSslVerMethod: TFtpSslVerifyMethod read fFtpSslVerMethod write fFtpSslVerMethod ; // 20 Apr 2015 property FtpSslRootFile: string read fFtpSslRootFile write fFtpSslRootFile ; // 20 Apr 2015 property FtpSslRevocation: boolean read fFtpSslRevocation write fFtpSslRevocation ; // 20 Apr 2015 property FtpSslReportChain: boolean read fFtpSslReportChain write fFtpSslReportChain; // 20 Apr 2015 property FtpSslCliSecurity: TSslCliSecurity read fFtpSslCliSecurity write fFtpSslCliSecurity; // June 2018 property OcspHttp: TOcspHttp read FOcspHttp write FOcspHttp; { V8.69 } property TotProcFiles: integer read fCopyProg.TotProcFiles ; property ProcOKFiles: integer read fCopyProg.ProcOKFiles ; property DelOKFiles: integer read fCopyProg.DelOKFiles ; property ProcFailFiles: integer read fCopyProg.ProcFailFiles ; property ReqResponse: string read fReqResponse ; property SkippedFiles: integer read fCopyProg.SkippedFiles ; property ServRootDir: UnicodeString read fServRootDir ; property ServBaseDir: UnicodeString read fServBaseDir ; property LoggedIn: boolean read fLoggedIn ; property MaxAttempts: integer read fMaxAttempts write fMaxAttempts ; // logon attempts property AttemptDelay: integer read fAttemptDelay write fAttemptDelay ; property PassiveX: Boolean read FPassive write FPassive; property UpArchDir: UnicodeString read fUpArchDir write fUpArchDir ; property UpArchive: Boolean read fUpArchive write fUpArchive ; property ResFailed: Boolean read fResFailed write fResFailed ; property MinResSize: Int64 read fMinResSize write fMinResSize ; property IgnoreFileExt: UnicodeString read fIgnoreFileExt write fIgnoreFileExt ; property UpImmed: Boolean read fUpImmed write fUpImmed ; property SpecificFiles: Boolean read fSpecificFiles write fSpecificFiles ; property DispRemList: boolean read fDispRemList write fDispRemList ; property ZlibNoCompExt: string read fZlibNoCompExt write fZlibNoCompExt ; // 2 Dec 2007 property ZlibMaxSize: Int64 read fZlibMaxSize write fZlibMaxSize ; // 9 Dec 2007 property MaxResumeAttempts: integer read fMaxResumeAttempts write fMaxResumeAttempts ; // 31 Dec 2007 property MagFtpOpts: TMagFtpOpts read fMagFtpOpts write fMagFtpOpts ; // 5 Jan 2008 property MaskLocDir: boolean read fMaskLocDir write fMaskLocDir ; // 8 Apr 2009 property MaskRemDir: boolean read fMaskRemDir write fMaskRemDir ; // 8 Apr 2009 property NoProgress: boolean read fNoProgress write fNoProgress ; // 15 Feb 2011 property EmptyDirs: Boolean read fEmptyDirs write fEmptyDirs ; // 17 Feb 2011 property IgnorePaths: UnicodeString read fIgnorePaths write fIgnorePaths ; // 22 May 2013 property CopyProg: TIcsCopyProgressW read fCopyProg ; // 22 May 2013 property Wow64RedirDisable: boolean read fWow64RedirDisable write fWow64RedirDisable ; // 22 May 2013 property ProgressEvent: TProgressEventW read fProgressEvent write fProgressEvent; // 22 May 2013 {$IFDEF Zipping} property ZipDownDel: Boolean read fZipDownDel write fZipDownDel ; property Zipped: Boolean read fZipped write fZipped ; property ZipExtFmt: TIcsZipExtFmt read fZipExtFmt write fZipExtFmt ; property ZipPath: TIcsZipPath read fZipPath write fZipPath ; property ZipDir: String read fZipDir write fZipDir ; {$ENDIF} end; // 23 Sept 2010 threaded version of TMagFtp TThreadEventW = Procedure (LogLevel: TIcsCopyLogLevel ; const Id, Info: UnicodeString ; var Cancel: boolean) of object ; TIcsFtpMultiThreadW = class(TThread) private FFtpThreadOpt: TFtpThreadOpt ; FTaskRes: TIcsTaskResult ; FDirListing: UnicodeString ; FLogLevel: TIcsCopyLogLevel ; FInfo: String ; FId: String ; FAbort: boolean ; FLogmaskName: UnicodeString ; FBuffLogStream: TIcsBuffLogStream ; {$IFNDEF NO_DEBUG_LOG} FIcsLog: TIcsLogger; {$ENDIF} // protected // from TCustomWSocket FLocalAddr : String; { IP address for local interface to use } // from TIcsWndControl FMultiThreaded : Boolean; // from TCustomFtpCli FTimeout : Integer; { Given in seconds } FHostName : String; FPort : String; FSocketFamily : TSocketFamily; // March 2013 FSocketErrs : TSocketErrs; // Nov 2016 FCodePage : LongWord; // FSystemCodepage : LongWord; FDataPortRangeStart : DWORD; FDataPortRangeEnd : DWORD; // FLastDataPort : DWORD; FDSocketSndBufSize : Integer;{AG V7.26} FDSocketRcvBufSize : Integer;{AG V7.26} // FLocalAddr : UnicodeString; FUserName : UnicodeString; FPassWord : UnicodeString; FAccount : UnicodeString; // FLocalFileName : UnicodeString; // FHostFileName : UnicodeString; // FHostDirName : UnicodeString; // FDnsResult : UnicodeString; // FType : WideChar; // FShareMode : Word; FConnectionType : TFTPConnectionType; FProxyServer : String; FProxyPort : String; FOptions : TFtpOptions; FPassive : Boolean; FNewOpts : String; { V2.102 arguments for OPTS command } FTransferMode : TFtpTransMode; { V2.102 new tranfer mode } // FSupportedExtensions : TFtpExtensions; { V2.94 which features server supports } FKeepAliveSecs : integer; { V2.107 zero means window default } FClientIdStr : UnicodeString; { V2.113 string sent for CLNT command } FSocksPassword : String; { V7.00 } FSocksPort : String; { V7.00 } FSocksServer : String; { V7.00 } FSocksUserCode : String; { V7.00 } FLanguage : String; { V7.01 language argment for LANG command } FLangSupport : String; { V7.01 list of languages server supports } {$IF DEFINED(UseBandwidthControl) or DEFINED(BUILTIN_THROTTLE)} FBandwidthLimit : Integer; // Bytes per second FBandwidthSampling : Integer; // mS sampling interval {$IFEND} // from TMagFtp fFtpType: TFtpType ; fFtpSslVerMethod: TFtpSslVerifyMethod; // 20 Apr 2015 fFtpSslPort: String; fFtpSslRevocation: boolean; // 20 Apr 2015 fFtpSslReportChain: boolean ; // 20 Apr 2015 fFtpSslRootFile: string ; // 20 Apr 2015 fFtpSslCliSecurity: TSslCliSecurity; // V8.63 fSslSessCache: boolean ; fBulkMode: TBulkMode ; fHostName1: String ; fHostName2: String ; fSrcDir: UnicodeString ; fSrcFName: UnicodeString ; fTarDir: UnicodeString ; fCopyType: TIcsFileCopyType ; fSubDirs: Boolean ; fDelDone: Boolean ; fDelOldTar: Boolean ; fMask: Boolean ; fPrev: Boolean ; fRepl: TIcsFileCopyRepl ; fReplRO: boolean ; fSafe: Boolean ; fTimeStamp: boolean ; fLocalHost: String ; fDispLog: boolean ; fDispFiles: boolean ; fDispLDir: boolean ; fDispRDir: boolean ; fHostType: THostType ; fXferMode: TXferMode ; fCaseFile: TCaseFile ; fDiffStampMins: integer ; fTotProcFiles: integer ; fProcOKFiles: integer ; fDelOKFiles: integer ; fProcFailFiles: integer ; fSkippedFiles: integer ; fReqResponse: String ; fMaxAttempts: integer ; fAttemptDelay: integer ; fUpArchDir: UnicodeString ; fUpArchive: Boolean ; fResFailed: Boolean ; fMinResSize: Int64 ; fIgnoreFileExt: UnicodeString ; fSpecificFiles: boolean ; fDispRemList: boolean ; fFailRepeat: integer ; fProgressSecs: integer ; fUseCompression: boolean ; fZlibNoCompExt: String ; fZlibMaxSize: int64 ; fMaxResumeAttempts: integer ; fMagFtpOpts: TMagFtpOpts; fMaskLocDir: boolean ; fMaskRemDir: boolean ; fNoProgress: boolean ; fEmptyDirs: boolean ; fIgnorePaths: UnicodeString ; // V8.63 public IcsFTPMultiCli: TIcsFtpMultiW ; FThreadEvent: TThreadEventW ; Utf8DiagFlag: boolean ; constructor CreateThread; procedure LogEvent (LogLevel: TIcsCopyLogLevel ; Info: UnicodeString ; var Cancel: boolean) ; procedure IcsLogEvent (Sender: TObject; LogOption: TLogOption; const Msg : String) ; procedure CallThreadEvent ; procedure Execute; override; property FtpThreadOpt : TFtpThreadOpt read FFtpThreadOpt write FFtpThreadOpt; property TaskRes : TIcsTaskResult read FTaskRes; property DirListing : UnicodeString read FDirListing; property LogmaskName : UnicodeString read FLogmaskName write FLogmaskName; property ID : String read FID write FID; property Timeout : Integer read FTimeout write FTimeout; property MultiThreaded : Boolean read FMultiThreaded write FMultiThreaded; property CodePage : LongWord read FCodePage write FCodePage; property KeepAliveSecs : Integer read FKeepAliveSecs write FKeepAliveSecs; property Options : TFtpOptions read FOptions write FOptions; property ClientIdStr : UnicodeString read FClientIdStr write FClientIdStr; property BandwidthLimit : Integer read FBandwidthLimit write FBandwidthLimit; property BandwidthSampling : Integer read FBandwidthSampling write FBandwidthSampling; property TransferMode : TFtpTransMode read FTransferMode write FTransferMode; property NewOpts : String read FNewOpts write FNewOpts; property HostName : String read FHostName write FHostName; property Port : String read FPort write FPort; property DataPortRangeStart : DWORD read FDataPortRangeStart write FDataPortRangeStart; property DataPortRangeEnd : DWORD read FDataPortRangeEnd write FDataPortRangeEnd; property DataSocketSndBufSize : Integer read FDSocketSndBufSize {AG V7.26} write FDSocketSndBufSize; property DataSocketRcvBufSize : Integer read FDSocketRcvBufSize {AG V7.26} write FDSocketRcvBufSize; property LocalAddr : String read FLocalAddr write FLocalAddr; property UserName : UnicodeString read FUserName write FUserName; property PassWord : UnicodeString read FPassWord write FPassWord; // property Binary : Boolean read FBinary // write SetBinary; // property Passive : Boolean read FPassive // write FPassive; // property ShareMode : TFtpShareMode read GetShareMode // write SetFShareMode; property ConnectionType : TFtpConnectionType read FConnectionType write FConnectionType; property ProxyServer : String read FProxyServer write FProxyServer; property ProxyPort : String read FProxyPort write FProxyPort; property SocksPassword : String read FSocksPassword write FSocksPassword; property SocksPort : String read FSocksPort write FSocksPort; property SocksServer : String read FSocksServer write FSocksServer; property SocksUserCode : String read FSocksUserCode write FSocksUserCode; property Account : UnicodeString read FAccount write FAccount; property Language : String read FLanguage write FLanguage; property LangSupport : String read FLangSupport; property BulkMode: TBulkMode read fBulkMode write fBulkMode ; property HostName1: string read fHostName1 write fHostName1 ; property HostName2: string read fHostName2 write fHostName2 ; property SrcDir: UnicodeString read fSrcDir write fSrcDir ; property SrcFName: UnicodeString read fSrcFName write fSrcFName ; property TarDir: UnicodeString read fTarDir write fTarDir ; property CopyType: TIcsFileCopyType read fCopyType write fCopyType ; property SubDirs: Boolean read fSubDirs write fSubDirs ; property DelDone: Boolean read fDelDone write fDelDone ; property DelOldTar: Boolean read fDelOldTar write fDelOldTar ; property Mask: Boolean read fMask write fMask ; property Prev: Boolean read fPrev write fPrev ; property Repl: TIcsFileCopyRepl read fRepl write fRepl ; property ReplRO: boolean read fReplRO write fReplRO ; property Safe: Boolean read fSafe write fSafe ; property TimeStamp: boolean read fTimeStamp write fTimeStamp ; property LocalHost: string read fLocalHost write fLocalHost ; property DispLog: boolean read fDispLog write fDispLog ; property DispFiles: boolean read fDispFiles write fDispFiles ; property DispLDir: boolean read fDispLDir write fDispLDir ; property DispRDir: boolean read fDispRDir write fDispRDir ; property HostType: THostType read fHostType write fHostType ; property XferMode: TXferMode read fXferMode write fXferMode ; property CaseFile: TCaseFile read fCaseFile write fCaseFile ; property DiffStampMins: integer read fDiffStampMins write fDiffStampMins ; property FailRepeat: integer read fFailRepeat write fFailRepeat ; property ProgressSecs: integer read fProgressSecs write fProgressSecs ; property FtpType: TFtpType read fFtpType write fFtpType ; property UseCompression: boolean read fUseCompression write fUseCompression ; property SocketFamily: TSocketFamily read FSocketFamily write FSocketFamily ; property SocketErrs: TSocketErrs read FSocketErrs write FSocketErrs; { Nov 2016} property SslSessCache: boolean read fSslSessCache write fSslSessCache ; property FtpSslPort: string read fFtpSslPort write fFtpSslPort ; property FtpSslVerMethod: TFtpSslVerifyMethod read fFtpSslVerMethod write fFtpSslVerMethod ; // 20 Apr 2015 property FtpSslRootFile: string read fFtpSslRootFile write fFtpSslRootFile ; // 20 Apr 2015 property FtpSslRevocation: boolean read fFtpSslRevocation write fFtpSslRevocation ; // 20 Apr 2015 property FtpSslReportChain: boolean read fFtpSslReportChain write fFtpSslReportChain; // 20 Apr 2015 property FtpSslCliSecurity: TSslCliSecurity read fFtpSslCliSecurity write fFtpSslCliSecurity; // V8.63 property TotProcFiles: integer read fTotProcFiles ; property ProcOKFiles: integer read fProcOKFiles ; property DelOKFiles: integer read fDelOKFiles ; property ProcFailFiles: integer read fProcFailFiles ; property ReqResponse: String read fReqResponse ; property SkippedFiles: integer read fSkippedFiles ; property MaxAttempts: integer read fMaxAttempts write fMaxAttempts ; property AttemptDelay: integer read fAttemptDelay write fAttemptDelay ; property PassiveX: Boolean read FPassive write FPassive; property UpArchDir: UnicodeString read fUpArchDir write fUpArchDir ; property UpArchive: Boolean read fUpArchive write fUpArchive ; property ResFailed: Boolean read fResFailed write fResFailed ; property MinResSize: Int64 read fMinResSize write fMinResSize ; property IgnoreFileExt: UnicodeString read fIgnoreFileExt write fIgnoreFileExt ; property SpecificFiles: Boolean read fSpecificFiles write fSpecificFiles ; property DispRemList: boolean read fDispRemList write fDispRemList ; property ZlibNoCompExt: String read fZlibNoCompExt write fZlibNoCompExt ; property ZlibMaxSize: Int64 read fZlibMaxSize write fZlibMaxSize ; property MaxResumeAttempts: integer read fMaxResumeAttempts write fMaxResumeAttempts ; property MagFtpOpts: TMagFtpOpts read fMagFtpOpts write fMagFtpOpts ; property MaskLocDir: boolean read fMaskLocDir write fMaskLocDir ; property MaskRemDir: boolean read fMaskRemDir write fMaskRemDir ; property NoProgress: boolean read fNoProgress write fNoProgress ; property EmptyDirs: Boolean read fEmptyDirs write fEmptyDirs ; property IgnorePaths: UnicodeString read fIgnorePaths write fIgnorePaths ; // V8.63 end ; const AppTicksPerFtp = 50 ; // 22 May 2013 millisecs to open file when calculation session duration procedure Register; {$ENDIF USE_SSL} implementation {$IFDEF USE_SSL} procedure Register; begin RegisterComponents('Magenta Systems', [TIcsFtpMultiW]); end; function ConvUSADate (info: string): TDateTime ; // mm/dd/yyyy var yy, mm, dd: word ; begin result := 0 ; info := trim (info) ; if length (info) <> 10 then exit ; yy := StrToIntDef (copy (info, 7, 4), 0); mm := StrToIntDef (copy (info, 1, 2), 0); dd := StrToIntDef (copy (info, 4, 2), 0); if NOT TryEncodeDate (yy, mm, dd, result) then result := 0 ; end ; { function GetWinsockErr (error: integer): string ; begin result := WSocketErrorDesc (error) + ' (' + IntToStr (error) + ')' ; end ; function atoi64(value : String) : Int64; var i : Integer; begin Result := 0; i := 1; while (i <= Length(Value)) and (Value[i] = ' ') do i := i + 1; while (i <= Length(Value)) and (Value[i] >= '0') and (Value[i] <= '9')do begin Result := Result * 10 + ord(Value[i]) - ord('0'); i := i + 1; end; end; function CalcSpeed (DurTicks, FSize: int64): int64 ; // 12 Oct 2011 begin if DurTicks <= 0 then DurTicks := 10 ; // stop division by zero result := (1000 * FSize) div DurTicks; end ; } constructor TIcsFtpMultiW.Create(Aowner:TComponent); begin inherited create(AOwner); // winsock bug fix for fast connections FControlSocket.ComponentOptions := [wsoNoReceiveLoop] ; FDataSocket.ComponentOptions := [wsoNoReceiveLoop] ; fIcsFileCopy := TIcsFileCopyW.Create (self) ; fIcsFileCopy.CopyEvent := onMagCopyEvent ; fIcsFileCopy.MultiThreaded := FMultiThreaded ; // 16 Sept 2010 SrcFileList := TIcsFindList.Create ; TarFileList := TIcsFindList.Create ; SetLength (SrcFiles, 0) ; SetLength (TarFiles, 0) ; TotSrcFiles := 0 ; TotTarFiles := 0 ; { fTotProcFiles := 0 ; fProcOKFiles := 0 ; fProcFailFiles := 0 ; fSkippedFiles := 0 ; } fCancelFlag := false ; fLoggedIn := false ; fMaxAttempts := 3 ; fAttemptDelay := 5 ; // seconds fProgressSecs := 2 ; // update progress every two seconds default fUseCompression := false ; fResFailed := false ; fMinResSize := 65535 ; // also used for resume overlap fFailRepeat := 3 ; // 31 Dec 2007 was 0 fSpecificFiles := false ; fDispRemList := false ; fCurRemDir := 'xXx' ; onDisplay := onFTPClientDisplay ; OnProgress64 := onFTPClientProg64 ; onError := onFtpError ; // this event stops FtpClient raising exceptions OnResponse := onFTPResponse ; OnSessionConnected := onFTPSessConn ; OnSessionClosed := onFTPSessClosed ; OnRequestDone := onFTPRequestDone ; onStateChange := onFTPStateChange ; FControlSocket.OnSocksConnected := OnFTPSocksConnected ; fFtpType := FtpTypeNone ; // 11 Nov 2005, even for no SSL // fSslCertCheck := SslCCNone ; fFtpSslVerMethod := ftpSslVerNone ; // 20 Apr 2015 fFtpSslRootFile := 'RootCaCertsBundle.pem' ; // 20 Apr 2015 fFtpSslPort := '990' ; fZlibNoCompExt := '.zip;.rar;.7z;.cab;.lzh;.gz;.avi;.wmv;.mpg;.mp3;.jpg;.png;'; // 2 Dec 2007 fZlibMaxSize := 500000000 ; // 9 Dec 2007 - 500 meg OnZlibProgress := onZlibProg ; // 9 Dec 2007 not working yet... fMaxResumeAttempts := 10 ; // 31 Dec 2007 fMagFtpOpts := [] ; // 5 Jan 2008 FSocketFamily := sfAny ; // March 2013 allow IPv4 or IPv6 IcsCopyProgClearAll (fCopyProg) ; // 22 May 2013 fSslSessCache := false ; // true ; fExternalSslSessionCache := nil ; OnSslVerifyPeer := onFTPSslVerifyPeer ; OnSslCliGetSession := onFTPSslCliGetSession ; OnSslCliNewSession := onFTPSslCliNewSession ; OnSslHandshakeDone := onFTPSslHandshakeDone ; OnSslCliCertRequest := onFTPSslCliCertRequest ; fSslContext := TSslContext.Create (self) ; SslContext := fSslContext ; fSslContext.SslVerifyPeer := false ; fFtpSslCliSecurity := sslCliSecIgnore; // June 2018 FOcspHttp := TOcspHttp.Create(Self); { V8.69 } FOcspHttp.OnOcspProg := IcsProgEvent; { V8.69 } FOcspHttp.CacheFName := 'ocsftpcache.recs'; { V8.69 } end ; destructor TIcsFtpMultiW.Destroy; begin FOcspHttp.Free; { V8.69 } fIcsFileCopy.Free ; SrcFileList.Free ; TarFileList.Free ; FreeAndNil (FMsCertChainEngine) ; FreeAndNil (fExternalSslSessionCache) ; FreeAndNil (fSslContext) ; inherited Destroy; end; procedure TIcsFtpMultiW.OnFTPSslVerifyPeer(Sender: TObject; var Ok: Integer; Cert : TX509Base); var info: string ; begin OK := 1; // don't check certificate until handshaking over if LogRcvdCerts then // 20 Apr 2015 begin info := 'Received Certificate, Depth ' + IntToStr (Cert.VerifyDepth) + #13#10 + 'Verify Result: ' + Cert.VerifyErrMsg + #13#10 + Cert.CertInfo (true) + #13#10 ; // Mar 2017 simplify doCopyEvent (LogLevelDiag, info); end; end ; procedure TIcsFtpMultiW.OnFTPSslCliNewSession(Sender: TObject; SslSession: Pointer; WasReused: Boolean; var IncRefCount : Boolean); var FtpCli: TSslFtpClientW ; begin { SslCliNewSession/SslCliGetSession allow external, client-side session } { caching. } doCopyEvent (LogLevelDiag, 'Starting SSL Session'); if not fSslSessCache then Exit; if (not WasReused) then begin FtpCli := Sender as TSslFtpClientW ; fExternalSslSessionCache.CacheCliSession (SslSession, FtpCli.ControlSocket.PeerAddr{+ FtpCli.ControlSocket.PeerPort}, IncRefCount); { V8.68 no port so data session can use control session } doCopyEvent (LogLevelDiag, 'Cache SSL Session: New'); end else doCopyEvent (LogLevelDiag, 'Cache SSL Session: Reuse'); // IncRefCount := false ; // Dec 2016 should not be here end ; procedure TIcsFtpMultiW.OnFTPSslCliGetSession(Sender: TObject; var SslSession: Pointer; var FreeSession : Boolean); var FtpCli: TSslFtpClientW ; begin { SslCliNewSession/SslCliGetSession allow external, client-side session } { caching. } if not fSslSessCache then Exit; doCopyEvent (LogLevelDiag, 'Check for Old SSL Session'); FtpCli := Sender as TSslFtpClientW ; SslSession := fExternalSslSessionCache.GetCliSession( FtpCli.ControlSocket.PeerAddr{+ FtpCli.ControlSocket.PeerPort}, FreeSession); { V8.68 no port so data session can use control session } // FreeSession := True; // Dec 2016 should not be here if Assigned (SslSession) then // Dec 2016 doCopyEvent (LogLevelDiag, 'Old SSL Session Found Cached') else doCopyEvent (LogLevelDiag, 'No Old SSL Session Cached'); end ; procedure TIcsFtpMultiW.OnFTPSslHandshakeDone(Sender: TObject; ErrCode: Word; PeerCert: TX509Base; var Disconnect: Boolean); var CertChain: TX509List; ChainVerifyResult: LongWord; info, VerifyInfo: String; Safe: Boolean; FtpCtl: TWSocket ; // Dec 2016 begin FtpCtl := (Sender as TSslFtpClientW).ControlSocket ; // Dec 2016 // nothing much to do if SSL failed or event said disconnect if (ErrCode <> 0) or Disconnect then begin doCopyEvent (LogLevelInfo, FtpCtl.SslServerName + ' SSL Handshake Failed - ' + FtpCtl.SslHandshakeRespMsg) ; // Dec 2014 Disconnect := TRUE; exit; end ; doCopyEvent (LogLevelInfo, FtpCtl.SslServerName + ' ' + FtpCtl.SslHandshakeRespMsg) ; // Dec 2014 if (SslAcceptableHosts.IndexOf (FtpCtl.SslServerName + PeerCert.Sha1Hex) >= 0) or // Dec 2016 done it already FtpCtl.SslSessionReused OR (fFtpSslVerMethod = ftpSslVerNone) then begin exit; // nothing to do, go ahead end ; // Property SslCertChain contains all certificates in current verify chain CertChain := FtpCtl.SslCertChain; // see if validating against Windows certificate store if fFtpSslVerMethod = ftpSslVerWinStore then begin // start engine if not Assigned (FMsCertChainEngine) then FMsCertChainEngine := TMsCertChainEngine.Create; // see if checking revoocation, CRL checks and OCSP checks in Vista+, very slow!!!! if fFtpSslRevocation then FMsCertChainEngine.VerifyOptions := [mvoRevocationCheckChainExcludeRoot] else FMsCertChainEngine.VerifyOptions := []; // This option doesn't seem to work, at least when a DNS lookup fails FMsCertChainEngine.UrlRetrievalTimeoutMsec := 10000; { Pass the certificate and the chain certificates to the engine } FMsCertChainEngine.VerifyCert (PeerCert, CertChain, ChainVerifyResult, True); Safe := (ChainVerifyResult = 0) or { We ignore the case if a revocation status is unknown. } (ChainVerifyResult = CERT_TRUST_REVOCATION_STATUS_UNKNOWN) or (ChainVerifyResult = CERT_TRUST_IS_OFFLINE_REVOCATION) or (ChainVerifyResult = CERT_TRUST_REVOCATION_STATUS_UNKNOWN or CERT_TRUST_IS_OFFLINE_REVOCATION); { The MsChainVerifyErrorToStr function works on chain error codes } VerifyInfo := MsChainVerifyErrorToStr (ChainVerifyResult); // Nov 2016 // MSChain ignores host name, so see if it failed using OpenSSL if PeerCert.VerifyResult = X509_V_ERR_HOSTNAME_MISMATCH then begin // Nov 2016 Safe := False; VerifyInfo := PeerCert.FirstVerifyErrMsg; end; end else if fFtpSslVerMethod = ftpSslVerBundle then begin VerifyInfo := PeerCert.FirstVerifyErrMsg; // Nov 2016 Safe := (PeerCert.VerifyResult = X509_V_OK); { check whether SSL chain verify result was OK } { V8.69 check OCSP to see if revoked, if we got a chain of certificates } { note this is a soft check, if we don't have a stapled OCSP response from the TLS handshake, we get it from an OCSP HTTP server and cache it but don't wait for the response. So next attempt comes from cache. } if (Safe and FFtpSslRevocation and PeerCert.IsCertLoaded and (CertChain.Count > 0)) then begin FOcspHttp.ClearOcsp; FOcspHttp.DebugLevel := DebugConn; FOcspHttp.OcspCert := PeerCert; FOcspHttp.OcspInters := CertChain; if (Length(FtpCtl.OcspStapleRaw) > 50) and (FtpCtl.OcspStapleStatus = OCSP_RESPONSE_STATUS_SUCCESSFUL) then FOcspHttp.OcspRespRaw := FtpCtl.OcspStapleRaw; if FOcspHttp.CheckOcspRevoked(fSslContext.GetX509Store, 0) then Safe := False; VerifyInfo := FOcspHttp.OcspLastResp; FOcspHttp.OcspInters := Nil; doCopyEvent (LogLevelInfo, FtpCtl.SslServerName + ' ' + VerifyInfo) end; end else begin exit ; // unknown method end ; // tell user verification failed if NOT Safe then begin FErrorMessage := 'SSL Chain Verification Failed: ' + VerifyInfo + ', Domain: '; if PeerCert.SubAltNameDNS = '' then FErrorMessage := FErrorMessage + IcsUnwrapNames (PeerCert.SubjectCName) else FErrorMessage := FErrorMessage + IcsUnwrapNames (PeerCert.SubAltNameDNS) ; // Nov 2016 FErrorMessage := FErrorMessage + ', Expected: ' + FtpCtl.SslServerName ; // Nov 2016 doCopyEvent (LogLevelInfo, FErrorMessage); end else begin doCopyEvent (LogLevelInfo, FtpCtl.SslServerName + ' SSL Chain Verification Succeeded') ; SslAcceptableHosts.Add (FtpCtl.SslServerName + PeerCert.Sha1Hex) ; // Dec 2016 save it end; // if certificate checking failed, see if the host is specifically listed as being allowed anyway if (NOT Safe) and (SslAcceptableHosts.IndexOf (FtpCtl.SslServerName) > -1) then // 19 Oct 2015 begin Safe := true ; doCopyEvent (LogLevelInfo, FtpCtl.SslServerName + ' SSL Succeeded with Acceptable Host Name') ; end ; // tell user about all the certificates we found if fFtpSslReportChain and (CertChain.Count > 0) then begin info := FtpCtl.SslServerName + ' ' + IntToStr (CertChain.Count) + ' SSL Certificates in the verify chain:' + #13#10 + CertChain.AllCertInfo (true, true) + #13#10 ; // Mar 2017 report all certs, backwards doCopyEvent (LogLevelInfo, info); end; // all failed, V8.65 need to remove cached SSL session so it's not reused!!! if NOT Safe then begin Disconnect := TRUE; if fSslSessCache then begin if fExternalSslSessionCache.RemoveSession(FtpCtl.PeerAddr{ + FtpCtl.PeerPort}) then { V8.68 no port so data session can use control session } doCopyEvent (LogLevelDiag, 'SSL Session Uncached After Failure') else doCopyEvent (LogLevelDiag, 'SSL Session Not Found in Cache'); end; end; end ; procedure TIcsFtpMultiW.IcsProgEvent (Sender: TObject; LogOption: TLogOption; const Msg : String) ; { V8.69 } begin doCopyEvent (LogLevelInfo, Msg) ; end ; procedure TIcsFtpMultiW.OnFTPSslCliCertRequest(Sender: TObject; var Cert: TX509Base); begin doCopyEvent (LogLevelDiag, 'Certificate Request Ignored') ; end; procedure TIcsFtpMultiW.SetSrcDir (S: UnicodeString) ; begin fSrcDir := Trim (S) ; end ; procedure TIcsFtpMultiW.SetTarDir (S: UnicodeString) ; begin fTarDir := Trim (S) ; end ; function TIcsFtpMultiW.WaitUntilReady : Boolean; var DummyHandle : THandle; begin Result := TRUE; { Assume success } FTimeStop := LongInt(GetTickCount) + LongInt(FTimeout) * 1000; while TRUE do begin // 24 July 2013 InternalReady happens between multiple commands, ignore it if FState in [ftpReady {, ftpInternalReady}] then begin { Back to ready state, the command is finished } Result := (FRequestResult = 0); break; end; if FMultiThreaded then // 21 Sept 2010 stop threads using all CPU begin if ftpWaitUsingSleep in FOptions then Sleep(0) else begin DummyHandle := INVALID_HANDLE_VALUE; MsgWaitForMultipleObjects(0, {PChar(0)^}DummyHandle, FALSE, 1000, QS_ALLINPUT {or QS_ALLPOSTMESSAGE}); end; end; if Application.Terminated or FTerminated or ((FTimeout > 0) and (LongInt(GetTickCount) > FTimeStop)) then begin { Timeout occured } AbortAsync; FErrorMessage := '426 Timeout'; FStatusCode := 426; Result := FALSE; { Command failed } break; end; MessagePump; end; end; procedure TIcsFtpMultiW.sysDelayX (aMs: longword); var Trg: longword; begin Trg := IcsGetTrgMsecs (aMs) ; while True do begin MessagePump ; // 15 Sept 2010 needed to support MultiThreaded if Application.Terminated or FTerminated then break ; if IcsTestTrgTick (Trg) then break ; end ; end; (* APPLE UNIX TYPE drwx--x--x 2 64 512 Feb 5 06:30 mpo -rw-r--r-- 1 root 0 Nov 11 1999 mswin.qif drwxr-xr-x 2 57 512 Nov 5 1999 neural d-wx-wx--x 3 root 1536 Feb 4 23:30 outgoing drwxr-xr-x 3 208 512 Nov 5 1999 papers drwxr-xr-x 2 134 512 Nov 5 1999 patch lrwxr-xr-x 1 root 12 Jan 26 19:00 pii -> winsock2/pii drwxr-xr-x 2 78 512 Nov 5 1999 pld_fpga drwxr-xr-x 2 770 1024 Jan 18 00:32 reqadm drwxr-xr-x 3 70 512 Nov 5 1999 rmx UNIX TYPE drwx--x--x 2 64 root 512 Feb 5 06:30 mpo -rw-r--r-- 1 root root 0 Nov 11 1999 mswin.qif drwxr-xr-x 2 57 root 512 Nov 5 1999 neural d-wx-wx--x 3 root 50 1536 Feb 4 23:30 outgoing drwxr-xr-x 3 208 root 512 Nov 5 1999 papers drwxr-xr-x 2 134 root 512 Nov 5 1999 patch lrwxr-xr-x 1 root root 12 Jan 26 19:00 pii -> winsock2/pii drwxr-xr-x 2 78 root 512 Nov 5 1999 pld_fpga drwxr-xr-x 2 770 root 1024 Jan 18 00:32 reqadm drwxr-xr-x 3 70 root 512 Nov 5 1999 rmx drwxr-xr-x 2 root root 512 Nov 5 1999 rz1000 drwxr-xr-x 5 676 root 512 Nov 5 1999 sal drwxr-xr-x 2 root root 512 Nov 5 1999 sbios lrwxr-xr-x 7 109 root 512 Nov 5 1999 support -> ../win95/support lrwxr-x--x 116 730 50 2048 Feb 5 02:21 swdev -> support drwxr-xr-x 2 67 root 512 Nov 5 1999 tis -rw-r--r-- 1 root root 0 Nov 11 1999 unix.qif drwxr-xr-x 2 91 root 512 Nov 5 1999 winsock2 -rw-r--r-- 1 root root 0 May 21 1996 .hide lrwxrwxrwx 1 root root 13 Apr 30 1998 ld-linux.so -> ld-linux.so.1 lrwxrwxrwx 1 root root 18 Apr 30 1998 ld-linux.so.1 -> ld-linux.so.1.8.10 -rwxr-xr-x 1 root root 82412 Mar 16 1997 ld-linux.so.1.8.10 -rwxr-xr-x 1 root root 17412 May 21 1996 ld.so lrwxrwxrwx 1 root root 14 Mar 21 1998 libc.so.4 -> libc.so.4.6.27 -rwxr-xr-x 1 root root 634880 May 21 1996 libc.so.4.6.27 lrwxrwxrwx 1 root root 14 Apr 30 1998 libc.so.5 -> libc.so.5.4.23 -rwxr-xr-x 1 root root 602076 Apr 30 1998 libc.so.5.4.23 lrwxrwxrwx 1 root root 14 Mar 21 1998 libm.so.4 -> libm.so.4.6.27 -rwxr-xr-x 1 root root 110592 May 21 1996 libm.so.4.6.27 list at 7 Jan drwxrwxr-x 2 cixip cixip 1024 Jun 13 2001 . drwxrwxr-x 6 cixip cixip 1536 Dec 23 13:03 .. -rw-rw-r-- 1 cixip cixip 268 Dec 23 13:09 .htaccess -rw-r--r-- 1 cixip cixip 1260608 Jan 2 15:57 codelook.zip -rw-r--r-- 1 cixip cixip 32759 Dec 15 17:33 dialacc.htm -rw-r--r-- 1 cixip cixip 402646 Dec 15 17:33 dialimob.htm -rw-r--r-- 1 cixip cixip 322159 Dec 15 17:34 dialintl.htm -rw-r--r-- 1 cixip cixip 9585 Dec 18 00:28 index.shtml -rw-rw-r-- 1 cixip cixip 3640 Oct 11 1998 maglogo.gif -rw-rw-r-- 1 cixip cixip 2763 Oct 11 1998 maglogo2.gif -rw-rw-r-- 1 cixip cixip 67350 Dec 15 17:35 tarifcod.htm -rw-rw-r-- 1 cixip cixip 867377 Dec 15 17:36 tariffr.zip -rw-rw-r-- 1 cixip cixip 722470 Dec 15 17:37 tariffrz.zip -rw-rw-r-- 1 cixip cixip 152289 Jul 6 2001 tarifmob1.htm -rw-rw-r-- 1 cixip cixip 99824 Jul 6 2001 tarifmob2.htm -rw-rw-r-- 1 cixip cixip 1126 Oct 11 1998 tcback.gif magsys web merula drw-rw-rw- 1 user group 0 Dec 2 00:01 . drw-rw-rw- 1 user group 0 Dec 2 00:01 .. -rw-rw-rw- 1 user group 380560 Sep 2 00:00 ex020901.log -rw-rw-rw- 1 user group 825953 Sep 3 00:00 ex020902.log -rw-rw-rw- 1 user group 926278 Sep 4 00:00 ex020903.log -rw-rw-rw- 1 user group 906454 Sep 5 00:00 ex020904.log -rw-rw-rw- 1 user group 930487 Sep 6 00:00 ex020905.log DOS/WINDOWS TYPE 02-04-00 12:16AM