Update Homepage: Difference between revisions
m →Author |
mNo edit summary |
||
| Line 31: | Line 31: | ||
call RxFuncAdd "FtpLoadFuncs", "rxFtp", "FtpLoadFuncs" | call RxFuncAdd "FtpLoadFuncs", "rxFtp", "FtpLoadFuncs" | ||
call FtpLoadFuncs | call FtpLoadFuncs | ||
/* | /* | ||
| Line 52: | Line 50: | ||
call LINEOUT LOGFILE, '*** 'DATE()' 'TIME()' Begin session', 1 | call LINEOUT LOGFILE, '*** 'DATE()' 'TIME()' Begin session', 1 | ||
end /* do */ | end /* do */ | ||
/* | /* | ||
| Line 76: | Line 71: | ||
files.n "<dir> <localsize> <remotesize> <aattr> <filename>" | files.n "<dir> <localsize> <remotesize> <aattr> <filename>" | ||
*/ | */ | ||
/* Login */ | /* Login */ | ||
| Line 203: | Line 194: | ||
call WriteLog '** Create remote directories' | call WriteLog '** Create remote directories' | ||
do i = 1 to dirs.0 | do i = 1 to dirs.0 | ||
if WORD(dirs.i, 2) = 1 then do | if WORD(dirs.i, 2) = 1 then do /* Check if directory exists locally */ | ||
if WORD(dirs.i,3) = 0 then do | if WORD(dirs.i,3) = 0 then do /* Check is directory DOESN'T exist on ftp server */ | ||
call chftpdir WORD(dirs.i,1) | call chftpdir WORD(dirs.i,1) /* Change to parent directory on ftp server */ | ||
say ' - Creating remote directory "'WORD(dirs.i,4)'".' | say ' - Creating remote directory "'WORD(dirs.i,4)'".' | ||
rc = FtpMkDir(WORD(dirs.i,4)) | rc = FtpMkDir(WORD(dirs.i,4)) | ||
| Line 284: | Line 275: | ||
end /* do */ | end /* do */ | ||
exit | exit | ||
Terminate: | Terminate: | ||
| Line 320: | Line 309: | ||
end | end | ||
return 0 | return 0 | ||
LocateFileInDir: | LocateFileInDir: | ||
parse arg indir, istartsearch, findfilename | parse arg indir, istartsearch, findfilename | ||
do ifnd = istartsearch to files.0 | do ifnd = istartsearch to files.0 /* Loop though the last couple of entries */ | ||
if WORD(files.ifnd, 1) = indir then do | if WORD(files.ifnd, 1) = indir then do /* Check if directories match */ | ||
if WORD(files.ifnd, 5) = findfilename then do | if WORD(files.ifnd, 5) = findfilename then do /* Check if filenames match */ | ||
return ifnd | return ifnd | ||
end | end | ||
| Line 333: | Line 320: | ||
end | end | ||
return 0 | return 0 | ||
/* | /* | ||
| Line 350: | Line 333: | ||
str = INSERT(newWord' ', str, iwrdndx-1) | str = INSERT(newWord' ', str, iwrdndx-1) | ||
return str | return str | ||
WriteLog: | WriteLog: | ||
| Line 359: | Line 340: | ||
end | end | ||
return | return | ||
/* | /* | ||
| Line 404: | Line 384: | ||
call WriteLog 'getlocaldir returning: "'HOMEPAGEBASE''gotodir'"' | call WriteLog 'getlocaldir returning: "'HOMEPAGEBASE''gotodir'"' | ||
return HOMEPAGEBASE''gotodir | return HOMEPAGEBASE''gotodir | ||
</pre> | |||
==Update homepage v2== | ==Update homepage v2== | ||
<pre> | <pre> | ||
| Line 430: | Line 410: | ||
call RxFuncAdd "FtpLoadFuncs", "rxFtp", "FtpLoadFuncs" | call RxFuncAdd "FtpLoadFuncs", "rxFtp", "FtpLoadFuncs" | ||
call FtpLoadFuncs | call FtpLoadFuncs | ||
/* | /* | ||
| Line 451: | Line 429: | ||
call LINEOUT LOGFILE, '*** 'DATE()' 'TIME()' Begin session', 1 | call LINEOUT LOGFILE, '*** 'DATE()' 'TIME()' Begin session', 1 | ||
end /* do */ | end /* do */ | ||
/* | /* | ||
| Line 475: | Line 450: | ||
files.n "<dir> <localsize> <remotesize> <aattr> <filename>" | files.n "<dir> <localsize> <remotesize> <aattr> <filename>" | ||
*/ | */ | ||
/* Login */ | /* Login */ | ||
| Line 585: | Line 556: | ||
icurrentdir = icurrentdir + 1 | icurrentdir = icurrentdir + 1 | ||
end /* do while icurrentdir < dirs.0 */ | end /* do while icurrentdir < dirs.0 */ | ||
/* Dump directories */ | /* Dump directories */ | ||
| Line 606: | Line 576: | ||
call WriteLog '** Create remote directories' | call WriteLog '** Create remote directories' | ||
do i = 1 to dirs.0 | do i = 1 to dirs.0 | ||
if WORD(dirs.i, 2) = 1 then do | if WORD(dirs.i, 2) = 1 then do /* Check if directory exists locally */ | ||
if WORD(dirs.i,3) = 0 then do | if WORD(dirs.i,3) = 0 then do /* Check is directory DOESN'T exist on ftp server */ | ||
call chftpdir WORD(dirs.i,1) | call chftpdir WORD(dirs.i,1) /* Change to parent directory on ftp server */ | ||
say ' - Creating remote directory "'WORD(dirs.i,4)'".' | say ' - Creating remote directory "'WORD(dirs.i,4)'".' | ||
rc = FtpMkDir(WORD(dirs.i,4)) | rc = FtpMkDir(WORD(dirs.i,4)) | ||
| Line 687: | Line 657: | ||
end /* do */ | end /* do */ | ||
exit | exit | ||
Terminate: | Terminate: | ||
| Line 723: | Line 691: | ||
end | end | ||
return 0 | return 0 | ||
LocateFileInDir: | LocateFileInDir: | ||
parse arg indir, istartsearch, findfilename | parse arg indir, istartsearch, findfilename | ||
do ifnd = istartsearch to files.0 | do ifnd = istartsearch to files.0 /* Loop though the last couple of entries */ | ||
if WORD(files.ifnd, 1) = indir then do | if WORD(files.ifnd, 1) = indir then do /* Check if directories match */ | ||
if WORD(files.ifnd, 5) = findfilename then do | if WORD(files.ifnd, 5) = findfilename then do /* Check if filenames match */ | ||
return ifnd | return ifnd | ||
end | end | ||
| Line 736: | Line 702: | ||
end | end | ||
return 0 | return 0 | ||
/* | /* | ||
| Line 753: | Line 715: | ||
str = INSERT(newWord' ', str, iwrdndx-1) | str = INSERT(newWord' ', str, iwrdndx-1) | ||
return str | return str | ||
WriteLog: | WriteLog: | ||
| Line 762: | Line 722: | ||
end | end | ||
return | return | ||
/* | /* | ||
| Line 807: | Line 766: | ||
call WriteLog 'getlocaldir returning: "'HOMEPAGEBASE''gotodir'"' | call WriteLog 'getlocaldir returning: "'HOMEPAGEBASE''gotodir'"' | ||
return HOMEPAGEBASE''gotodir | return HOMEPAGEBASE''gotodir | ||
ReplaceHTMLDateTime: PROCEDURE | ReplaceHTMLDateTime: PROCEDURE | ||
| Line 882: | Line 836: | ||
return p | return p | ||
</pre> | </pre> | ||
==Licence== | ==Licence== | ||
* Copyrighted freeware | *Copyrighted freeware | ||
*Author: [[Jan M. Danielsson]] | |||
[[Category:Software written in REXX]] | [[Category:Software written in REXX]] | ||
Revision as of 03:57, 1 January 2018
A couple of fairly simple scripts written by Jan M. Danielsson, who kept updating his homepages but forgetting to copy portions of them on the actual web server, so he wrote a REXX script that automatically updated the remote server from a local folder. There are two versions of the script, version one is feature complete and runs on Classic REXX and version two which is functional as is but unfinished and requires Object REXX
Key features:
- Only uploads modified files (compares file sizes and checks the archive attribute of the local files).
- Doesn't use any separate databases for keeping track of what needs to be done.
- Logs its activities.
- Removes any files/directories from WWW/FTP server if it doesn't exist on hard drive.
- New in V2: Automatically update date and time stamp in html pages.
Usage
Change the FTP server address, user name and password, you may also have to change the parsing routines to fit the output the FTP server that your local ISP uses. To use the new auto update features in version two, add the comments:
<!-- lastupdate_date --> immediately followed by a yyyy-mm-dd formatted date <!-- lastupdate_time --> immediately followed by a hh:mm:ss.
Warning: Trekkie references in script comments, try not to groan too loudly.
Update homepage v1
/* Update Homepage Rexx script
* by Jan M. Danielsson (os2@telia.com) on 2000-07-01
* Resistance is futile.
*/
/* OS/2 API-functions */
call RxFuncAdd "SysLoadFuncs", "RexxUtil", "SysLoadFuncs"
call SysLoadFuncs
/* OS/2 Rexx-Ftp-API */
call RxFuncAdd "FtpLoadFuncs", "rxFtp", "FtpLoadFuncs"
call FtpLoadFuncs
/*
* Configuration variables
*/
FTPSERVER="your.isp.ftp.server"
FTPUSER="youruser"
FTPPASSWORD="yourpass"
HOMEPAGEBASE = "c:\internet\homepage\OS!2"
HPBASELEN = LENGTH(HOMEPAGEBASE)
LOGFILE = "work.log"
fWriteLog = "yes"
if fWriteLog = "yes" then do
'@del 'LOGFILE
call LINEOUT LOGFILE, '*** 'DATE()' 'TIME()' Begin session', 1
end /* do */
/*
dirs.0
dirs.n "<1> <2> <3> <4>"
<1> parent directory (1 - root)
<2> directory exists locally (0 - doesn't exist, 1 - exists)
<3> directory exists remotely (0 - doesn't exist, 1 - exists)
<4> name of directory
files.0
files.n "<1> <2> <3> <4> <5>
<1> which directory file belogs to (1 - root)
<2> local file size ("-" if it doesn't exist locally)
<3> remote file size ("-" if it doesn't exist remotely)
<4> Archive flag for local file ('-' archived flag is not set, 'A' archived flag is set)
<5> filename
dirs.n "<parentdir> <local> <remote> <name>"
files.n "<dir> <localsize> <remotesize> <aattr> <filename>"
*/
/* Login */
if FtpSetUser(FTPSERVER, FTPUSER, FTPPASSWORD) then do
say 'Logged in'
/* Set binary mode */
rc = FtpSetBinary("Binary")
if rc = 0 then do
say 'ERROR: Could not set binary mode.'
call WriteLog '*** ERROR: Could not set binary mode.'
exit
end
/* There is always a root */
dirs.0 = 1
dirs.1 = "0 1 1 <root>"
files.0 = 0
icurrentdir = 0
say '- Gathering data'
do while icurrentdir < dirs.0
idir = icurrentdir+1
say ' - Processing directory 'idir' of 'dirs.0
/* Start scanning for existing files and directories here */
ifilestart = files.0
idirstart = dirs.0
/* Start by checking the ftp files */
if WORD(dirs.idir, 3) = "1" then do
call chftpdir idir
rc=FtpDir(".", "ftpfilelist.")
do i=1 to ftpfilelist.0
/* say ftpfilelist.i */
if SUBSTR(ftpfilelist.i,1,1) = "d" then do
/* Add directory to list */
dirs.0 = dirs.0 + 1
imax = dirs.0
dirs.imax = idir' 0 1 'WORD(ftpfilelist.i,9)
call WriteLog ' Dir('imax'): 'dirs.imax
end
else if SUBSTR(ftpfilelist.i,1,1) = "-" then do
/* Add file to list */
files.0 = files.0 + 1
imax = files.0
files.imax = idir' - 'WORD(ftpfilelist.i,5)' - 'WORD(ftpfilelist.i,9)
call WriteLog 'File('imax'): 'files.imax
end
end
end
/* Check local files */
if WORD(dirs.idir, 2) = "1" then do
currentpath = getlocaldir(idir)
call SysFileTree currentpath'\*', 'localfilelist', , '*****'
do i=1 to localfilelist.0
/* say localfilelist.i */
ichar = LASTPOS("\", localfilelist.i)
parsedname = SUBSTR(localfilelist.i, ichar+1)
if SUBSTR(localfilelist.i,32,1) = "D" then do
/* A local directory */
/* Attempt to locate directory in list */
ifound = LocateDirInDir(idir, idirstart, parsedname)
if ifound <> 0 then do
/* Mark directory as 'local' */
call WriteLog '! Directory "'parsedname'" is already in list'
dirs.ifound = ReplaceWord(dirs.ifound, 2, "1")
call WriteLog ' Dir('ifound'): 'dirs.ifound
end
else do
/* Add directory */
dirs.0 = dirs.0 + 1
imax = dirs.0
dirs.imax = idir' 1 0 'parsedname
call WriteLog ' Dir('imax'): 'dirs.imax
end
end
else do
/* A local file */
ifound = LocateFileInDir(idir, ifilestart, parsedname)
if ifound <> 0 then do
/* Mark local file */
files.ifound = ReplaceWord(files.ifound, 2, WORD(localfilelist.i,3))
files.ifound = ReplaceWord(files.ifound, 4, SUBSTR(localfilelist.i,31,1))
call WriteLog 'File('ifound'): 'files.ifound
end /* do */
else do
/* File hasn't been added before -- add a new entry */
files.0 = files.0 + 1
imax = files.0
files.imax = idir' 'WORD(localfilelist.i,3)' - 'SUBSTR(localfilelist.i,31,1)' 'parsedname
call WriteLog 'File('imax'): 'files.imax
end
end
end
end
icurrentdir = icurrentdir + 1
end /* do while icurrentdir < dirs.0 */
/* Dump directories */
call WriteLog ''
call WriteLog '** Directory list'
do i = 1 to dirs.0
call WriteLog 'Dir('i'): 'dirs.i
end
/* Dump files */
call WriteLog ''
call WriteLog '** File list'
do i = 1 to files.0
call WriteLog 'File('i'): 'files.i
end
/* Create remote directories */
say '- Create remote directories'
call WriteLog ''
call WriteLog '** Create remote directories'
do i = 1 to dirs.0
if WORD(dirs.i, 2) = 1 then do /* Check if directory exists locally */
if WORD(dirs.i,3) = 0 then do /* Check is directory DOESN'T exist on ftp server */
call chftpdir WORD(dirs.i,1) /* Change to parent directory on ftp server */
say ' - Creating remote directory "'WORD(dirs.i,4)'".'
rc = FtpMkDir(WORD(dirs.i,4))
if rc = 0 then do
call WriteLog 'Directory "'WORD(dirs.i,4)'" created on server'
end
else do
call WriteLog '*** ERROR: Could not create directory "'WORD(dirs.i,4)'" on server'
end
end
end
end
say '- Upload new/updated files, and remove unused files.'
call WriteLog ''
call WriteLog '** Upload new/updated files and remove unused files.'
do i = 1 to files.0
if (WORD(files.i, 2) <> "-") & ((WORD(files.i, 2) <> WORD(files.i, 3)) | (WORD(files.i, 4) = "A")) then do
/* Change to target directory on server */
call chftpdir WORD(files.i,1)
/* Upload file */
local = getlocaldir(WORD(files.i,1))
local = local'\'WORD(files.i, 5)
say ' - Uploading file "'local'".'
rc = FtpPut(local, WORD(files.i, 5))
if rc = 0 then do
call WriteLog 'File "'WORD(files.i,5)'" uploaded to server'
/* If successful; reset archived attribute for file*/
call SysFileTree local, 'localfilelist', F, '*****', '-****'
end
else do
call WriteLog '*** ERROR: Could not upload file "'WORD(files.i,5)'" to server'
end
end
else if WORD(files.i, 2) = '-' then do
/* File is unused (does not exist locally) -- remove it */
call chftpdir WORD(files.i,1)
call WriteLog 'Delete file "'WORD(files.i, 5)'" from server because it is unused'
rc = FtpDelete(WORD(files.i, 5))
if rc = 0 then do
call WriteLog 'File "'WORD(files.i,5)'" was deleted from server.'
end
else do
call WriteLog '*** ERROR: Could not delete file "'WORD(files.i,5)'" from server.'
end
end
else do
call WriteLog 'Skipping file "'WORD(files.i,5)'"; probably unchanged.'
end
end
say '- Remove unused directories.'
call WriteLog ''
call WriteLog '** Remove empty/unused directories'
i = dirs.0
do while i > 1
if WORD(dirs.i, 2) = "0" then do
call WriteLog 'Directory "'WORD(dirs.i,4)'" will be removed since it is unused.'
call chftpdir WORD(dirs.i,1)
say ' - Removing remote directory "'WORD(dirs.i,4)'".'
rc = FtpRmDir(WORD(dirs.i,4))
if rc = 0 then call WriteLog 'Directory "'WORD(dirs.i,4)'" successfully removed.'
else call WriteLog '*** ERROR: Could not remove directory "'WORD(dirs.i,4)'".'
end
i = i - 1
end
rc = FtpLogoff()
if rc = 0 then say '*** Logout successful!'
else say '*** Logout failed!'
end
if fWriteLog = "yes" then do
call WriteLog '*** 'DATE()' 'TIME()' End session'
end /* do */
exit
Terminate:
rc = FtpLogoff()
if rc = 0 then do
say 'Logoff successful'
call WriteLog 'Logged out'
end
else do
say 'Logout failed!'
call WriteLog '*** ERROR: FtpLogoff() failed'
end
call WriteLog '*** 'DATE()' 'TIME()' End session'
exit
/*
* Find out if a directory exists in dirs.n
* Parameters:
* indir - in which directory to look
* istartsearch - serach range dirs.istartsearch to dirs.0
* findname - name to search for
*
* returns:
* 0 - directory doesn't exist
* n - directory exists at index <n>
*/
LocateDirInDir:
parse arg indir, istartsearch, finddirname
do ifnd = istartsearch to dirs.0
if WORD(dirs.ifnd, 1) = indir then do
if WORD(dirs.ifnd, 4) = finddirname then return ifnd
end
end
return 0
LocateFileInDir:
parse arg indir, istartsearch, findfilename
do ifnd = istartsearch to files.0 /* Loop though the last couple of entries */
if WORD(files.ifnd, 1) = indir then do /* Check if directories match */
if WORD(files.ifnd, 5) = findfilename then do /* Check if filenames match */
return ifnd
end
end
end
return 0
/*
* Patameters:
* str - The string on which the word to replace is in
* iWord - Word index
* newWord - String to replace with
*/
ReplaceWord: PROCEDURE
parse arg str, iWord, newWord
iwrdndx = WORDINDEX(str, iWord)
str = DELWORD(str, iWord, 1)
str = INSERT(newWord' ', str, iwrdndx-1)
return str
WriteLog:
parse arg str
if fWriteLog = "yes" then do
call LINEOUT LOGFILE, str
end
return
/*
* Change directory on FTP server
*/
chftpdir:
parse arg dirnum
if dirnum = 1 then do
gotodir = "/"
end
else do
gotodir = '/'WORD(dirs.dirnum,4)
iparent = WORD(dirs.dirnum,1)
do while iparent <> 1
parentdir = WORD(dirs.iparent,4)
gotodir = '/'parentdir''gotodir
iparent = WORD(dirs.iparent,1)
end
end
call WriteLog 'Change server directory to "'gotodir'".'
rc = FtpChDir(gotodir)
if rc = 0 then call WriteLog 'Server directory changed to "'gotodir'".'
else do
call WriteLog '*** ERROR: Could not change directory to "'gotodir'".'
end
return rc
getlocaldir:
parse arg dirnum
if dirnum = 1 then do
gotodir = ''
end
else do
gotodir = ''
do while dirnum <> 1
gotodir = '\'WORD(dirs.dirnum,4)''gotodir
dirnum = WORD(dirs.dirnum,1)
end
end
call WriteLog 'getlocaldir returning: "'HOMEPAGEBASE''gotodir'"'
return HOMEPAGEBASE''gotodir
Update homepage v2
* Update Homepage Rexx script
* by Jan M. Danielsson (os2@telia.com) on 2000-11-16
* Resistance is futile.
*
* Nota bene: Requires ObjectRexx
*
* How to use the auto page date update feature:
* Anywhere in your HTML script, you can place the "identifiers":
* <!-- LASTUPDATE_DATE -->0000-00-00 (ISO format, yyyy-mm-dd)
* <!-- LASTUPDATE_TIME -->00:00:00 (24h format)
*
* For now, you *must* include the "0000-00-00" and "00:00:00" strings.
* I'll probably add code which inserts them if they don't exist, but for now, you need them.
*/
/* OS/2 API-functions */
call RxFuncAdd "SysLoadFuncs", "RexxUtil", "SysLoadFuncs"
call SysLoadFuncs
/* OS/2 Rexx-Ftp-API */
call RxFuncAdd "FtpLoadFuncs", "rxFtp", "FtpLoadFuncs"
call FtpLoadFuncs
/*
* Configuration variables
*/
FTPSERVER="your.isp.ftp.server"
FTPUSER="youruser"
FTPPASSWORD="yourpass"
HOMEPAGEBASE = "c:\internet\homepage\OS!2"
HPBASELEN = LENGTH(HOMEPAGEBASE)
LOGFILE = "work.log"
fWriteLog = "yes"
if fWriteLog = "yes" then do
'@del 'LOGFILE
call LINEOUT LOGFILE, '*** 'DATE()' 'TIME()' Begin session', 1
end /* do */
/*
dirs.0
dirs.n "<1> <2> <3> <4>"
<1> parent directory (1 - root)
<2> directory exists locally (0 - doesn't exist, 1 - exists)
<3> directory exists remotely (0 - doesn't exist, 1 - exists)
<4> name of directory
files.0
files.n "<1> <2> <3> <4> <5>
<1> which directory file belogs to (1 - root)
<2> local file size ("-" if it doesn't exist locally)
<3> remote file size ("-" if it doesn't exist remotely)
<4> Archive flag for local file ('-' archived flag is not set, 'A' archived flag is set)
<5> filename
dirs.n "<parentdir> <local> <remote> <name>"
files.n "<dir> <localsize> <remotesize> <aattr> <filename>"
*/
/* Login */
if FtpSetUser(FTPSERVER, FTPUSER, FTPPASSWORD) then do
say 'Logged in'
/* Set binary mode */
rc = FtpSetBinary("Binary")
if rc = 0 then do
say 'ERROR: Could not set binary mode.'
call WriteLog '*** ERROR: Could not set binary mode.'
exit
end
/* There is always a root */
dirs.0 = 1
dirs.1 = "0 1 1 <root>"
files.0 = 0
icurrentdir = 0
say '- Gathering data'
do while icurrentdir < dirs.0
idir = icurrentdir+1
say ' - Processing directory 'idir' of 'dirs.0
/* Start scanning for existing files and directories here */
ifilestart = files.0
idirstart = dirs.0
/* Start by checking the ftp files */
if WORD(dirs.idir, 3) = "1" then do
call chftpdir idir
rc=FtpDir(".", "ftpfilelist.")
do i=1 to ftpfilelist.0
/* say ftpfilelist.i */
if SUBSTR(ftpfilelist.i,1,1) = "d" then do
/* Add directory to list */
dirs.0 = dirs.0 + 1
imax = dirs.0
dirs.imax = idir' 0 1 'WORD(ftpfilelist.i,9)
call WriteLog ' Dir('imax'): 'dirs.imax
end
else if SUBSTR(ftpfilelist.i,1,1) = "-" then do
/* Add file to list */
files.0 = files.0 + 1
imax = files.0
files.imax = idir' - 'WORD(ftpfilelist.i,5)' - 'WORD(ftpfilelist.i,9)
call WriteLog 'File('imax'): 'files.imax
end
end
end
/* Check local files */
if WORD(dirs.idir, 2) = "1" then do
currentpath = getlocaldir(idir)
call SysFileTree currentpath'\*', 'localfilelist', , '*****'
do i=1 to localfilelist.0
/* say localfilelist.i */
ichar = LASTPOS("\", localfilelist.i)
parsedname = SUBSTR(localfilelist.i, ichar+1)
if SUBSTR(localfilelist.i,32,1) = "D" then do
/* A local directory */
/* Attempt to locate directory in list */
ifound = LocateDirInDir(idir, idirstart, parsedname)
if ifound <> 0 then do
/* Mark directory as 'local' */
call WriteLog '! Directory "'parsedname'" is already in list'
dirs.ifound = ReplaceWord(dirs.ifound, 2, "1")
call WriteLog ' Dir('ifound'): 'dirs.ifound
end
else do
/* Add directory */
dirs.0 = dirs.0 + 1
imax = dirs.0
dirs.imax = idir' 1 0 'parsedname
call WriteLog ' Dir('imax'): 'dirs.imax
end
end
else do
/* A local file */
if RIGHT(parsedname, 5) = '.html' then do
call ReplaceHTMLDateTime ''currentpath'\'parsedname
end /* do */
ifound = LocateFileInDir(idir, ifilestart, parsedname)
if ifound <> 0 then do
/* Mark local file */
files.ifound = ReplaceWord(files.ifound, 2, WORD(localfilelist.i,3))
files.ifound = ReplaceWord(files.ifound, 4, SUBSTR(localfilelist.i,31,1))
call WriteLog 'File('ifound'): 'files.ifound
end /* do */
else do
/* File hasn't been added before -- add a new entry */
files.0 = files.0 + 1
imax = files.0
files.imax = idir' 'WORD(localfilelist.i,3)' - 'SUBSTR(localfilelist.i,31,1)' 'parsedname
call WriteLog 'File('imax'): 'files.imax
end
end
end
end
icurrentdir = icurrentdir + 1
end /* do while icurrentdir < dirs.0 */
/* Dump directories */
call WriteLog ''
call WriteLog '** Directory list'
do i = 1 to dirs.0
call WriteLog 'Dir('i'): 'dirs.i
end
/* Dump files */
call WriteLog ''
call WriteLog '** File list'
do i = 1 to files.0
call WriteLog 'File('i'): 'files.i
end
/* Create remote directories */
say '- Create remote directories'
call WriteLog ''
call WriteLog '** Create remote directories'
do i = 1 to dirs.0
if WORD(dirs.i, 2) = 1 then do /* Check if directory exists locally */
if WORD(dirs.i,3) = 0 then do /* Check is directory DOESN'T exist on ftp server */
call chftpdir WORD(dirs.i,1) /* Change to parent directory on ftp server */
say ' - Creating remote directory "'WORD(dirs.i,4)'".'
rc = FtpMkDir(WORD(dirs.i,4))
if rc = 0 then do
call WriteLog 'Directory "'WORD(dirs.i,4)'" created on server'
end
else do
call WriteLog '*** ERROR: Could not create directory "'WORD(dirs.i,4)'" on server'
end
end
end
end
say '- Upload new/updated files, and remove unused files.'
call WriteLog ''
call WriteLog '** Upload new/updated files and remove unused files.'
do i = 1 to files.0
if (WORD(files.i, 2) <> "-") & ((WORD(files.i, 2) <> WORD(files.i, 3)) | (WORD(files.i, 4) = "A")) then do
/* Change to target directory on server */
call chftpdir WORD(files.i,1)
/* Upload file */
local = getlocaldir(WORD(files.i,1))
local = local'\'WORD(files.i, 5)
say ' - Uploading file "'local'".'
rc = FtpPut(local, WORD(files.i, 5))
if rc = 0 then do
call WriteLog 'File "'WORD(files.i,5)'" uploaded to server'
/* If successful; reset archived attribute for file*/
call SysFileTree local, 'localfilelist', F, '*****', '-****'
end
else do
call WriteLog '*** ERROR: Could not upload file "'WORD(files.i,5)'" to server'
end
end
else if WORD(files.i, 2) = '-' then do
/* File is unused (does not exist locally) -- remove it */
call chftpdir WORD(files.i,1)
call WriteLog 'Delete file "'WORD(files.i, 5)'" from server because it is unused'
rc = FtpDelete(WORD(files.i, 5))
if rc = 0 then do
call WriteLog 'File "'WORD(files.i,5)'" was deleted from server.'
end
else do
call WriteLog '*** ERROR: Could not delete file "'WORD(files.i,5)'" from server.'
end
end
else do
call WriteLog 'Skipping file "'WORD(files.i,5)'"; probably unchanged.'
end
end
say '- Remove unused directories.'
call WriteLog ''
call WriteLog '** Remove empty/unused directories'
i = dirs.0
do while i > 1
if WORD(dirs.i, 2) = "0" then do
call WriteLog 'Directory "'WORD(dirs.i,4)'" will be removed since it is unused.'
call chftpdir WORD(dirs.i,1)
say ' - Removing remote directory "'WORD(dirs.i,4)'".'
rc = FtpRmDir(WORD(dirs.i,4))
if rc = 0 then call WriteLog 'Directory "'WORD(dirs.i,4)'" successfully removed.'
else call WriteLog '*** ERROR: Could not remove directory "'WORD(dirs.i,4)'".'
end
i = i - 1
end
rc = FtpLogoff()
if rc = 0 then say '*** Logout successful!'
else say '*** Logout failed!'
end
if fWriteLog = "yes" then do
call WriteLog '*** 'DATE()' 'TIME()' End session'
end /* do */
exit
Terminate:
rc = FtpLogoff()
if rc = 0 then do
say 'Logoff successful'
call WriteLog 'Logged out'
end
else do
say 'Logout failed!'
call WriteLog '*** ERROR: FtpLogoff() failed'
end
call WriteLog '*** 'DATE()' 'TIME()' End session'
exit
/*
* Find out if a directory exists in dirs.n
* Parameters:
* indir - in which directory to look
* istartsearch - serach range dirs.istartsearch to dirs.0
* findname - name to search for
*
* returns:
* 0 - directory doesn't exist
* n - directory exists at index <n>
*/
LocateDirInDir:
parse arg indir, istartsearch, finddirname
do ifnd = istartsearch to dirs.0
if WORD(dirs.ifnd, 1) = indir then do
if WORD(dirs.ifnd, 4) = finddirname then return ifnd
end
end
return 0
LocateFileInDir:
parse arg indir, istartsearch, findfilename
do ifnd = istartsearch to files.0 /* Loop though the last couple of entries */
if WORD(files.ifnd, 1) = indir then do /* Check if directories match */
if WORD(files.ifnd, 5) = findfilename then do /* Check if filenames match */
return ifnd
end
end
end
return 0
/*
* Parameters:
* str - The string on which the word to replace is in
* iWord - Word index
* newWord - String to replace with
*/
ReplaceWord: PROCEDURE
parse arg str, iWord, newWord
iwrdndx = WORDINDEX(str, iWord)
str = DELWORD(str, iWord, 1)
str = INSERT(newWord' ', str, iwrdndx-1)
return str
WriteLog:
parse arg str
if fWriteLog = "yes" then do
call LINEOUT LOGFILE, str
end
return
/*
* Change directory on FTP server
*/
chftpdir:
parse arg dirnum
if dirnum = 1 then do
gotodir = "/"
end
else do
gotodir = '/'WORD(dirs.dirnum,4)
iparent = WORD(dirs.dirnum,1)
do while iparent <> 1
parentdir = WORD(dirs.iparent,4)
gotodir = '/'parentdir''gotodir
iparent = WORD(dirs.iparent,1)
end
end
call WriteLog 'Change server directory to "'gotodir'".'
rc = FtpChDir(gotodir)
if rc = 0 then call WriteLog 'Server directory changed to "'gotodir'".'
else do
call WriteLog '*** ERROR: Could not change directory to "'gotodir'".'
end
return rc
getlocaldir:
parse arg dirnum
if dirnum = 1 then do
gotodir = ''
end
else do
gotodir = ''
do while dirnum <> 1
gotodir = '\'WORD(dirs.dirnum,4)''gotodir
dirnum = WORD(dirs.dirnum,1)
end
end
call WriteLog 'getlocaldir returning: "'HOMEPAGEBASE''gotodir'"'
return HOMEPAGEBASE''gotodir
ReplaceHTMLDateTime: PROCEDURE
parse arg htmlfile
ret = STREAM(htmlfile, 'c', 'open')
fdatetime = SysGetFileDateTime(htmlfile, 'WRITE')
fdate = WORD(fdatetime, 1)
ftime = WORD(fdatetime, 2)
cur_line = 1
do while LINES(htmlfile)
line_pos = STREAM(htmlfile, 'c', 'seek +0')
line_buf = LINEIN(htmlfile)
rewrite_line = 0
p = LocatePageDate(line_buf)
if p <> 0 then do
/* This line should contain a date */
q = p + 24
pagedate = SUBSTR(line_buf, q, 10)
if COMPARE(fdate, pagedate) <> 0 then do
line_buf = OVERLAY(fdate, line_buf, q, 10)
rewrite_line = 1
end
end
p = LocatePageTime(line_buf)
if p <> 0 then do
/* This line should contain a time */
q = p + 24
pagetime = SUBSTR(line_buf, q, 8)
if COMPARE(ftime, pagetime) <> 0 then do
line_buf = OVERLAY(ftime, line_buf, q, 8)
rewrite_line = 1
end
end
if rewrite_line <> 0 then do
new_line_pos = STREAM(htmlfile, 'c', 'seek +0')
q = STREAM(htmlfile, 'c', 'seek ='line_pos)
q = LINEOUT(htmlfile, line_buf)
q = STREAM(htmlfile, 'c', 'seek ='new_line_pos)
/* Reset the file's date and time */
say 'Updated line 'cur_line' in 'htmlfile
end
cur_line = cur_line + 1
end /* do */
ret = STREAM(htmlfile, 'c', 'close')
/* The date must be reset after any modifications have been made */
Call SysSetFileDateTime htmlfile, fdate, ftime
return
LocatePageDate: PROCEDURE
PARSE UPPER ARG linebuf
p = POS('<!-- LASTUPDATE_DATE -->', linebuf)
return p
LocatePageTime: PROCEDURE
PARSE UPPER ARG linebuf
p = POS('<!-- LASTUPDATE_TIME -->', linebuf)
return p
Licence
- Copyrighted freeware
- Author: Jan M. Danielsson