Dragon Drop - A Software Consultancy
| Dragon Drop | |
|
Dragon Drop - A Software Consultancy
|
|
| Home Our Products Consultancy Web Page Development Services Coding Windows External Resources | |
| Links Newsletter News And Issues Books etc. About Us | |
| CODING: Exchange Visual Basic VBA HomeSite | Coding Tools Software Clinic |
One of the irritations that we have with the HomeSite FTP scripts is that if one goes for the iterative option then the process of uploading files takes far too long to execute. This is because the default script compares each file's datestamp on the host server with that stored in the project folder.
For someone who has about a hundred files in a project and yet only have one or two updated files to load this is a massive strain on one's resources and not to mention patience. The alternative is to use something like CuteFTP to manually locate and upload the files. Though this the quicker method there is the danger that some of the updated files could be missed out in the manual FTP process.
Clearly something had to be written to improve the speed of the operation. This script does this but filters out the time consuming process of checking the datestamps on the host server by the rather obvious method of looking at the datestamps of the files on the development server.
This code takes considerably less time to upload the updated pages than before. This code ought to work for any Project (unlike the script derived from the wizard the name of the Project .apf file need not be hard coded) and should work for any of one's sites.
The only thing which needs to be hard coded is the name of the Deployment Server and this value is to be edited in the CONST statement in the Main() routine.
Quite simply there is a text file created within the project's root folder called, Date.txt, it contains the date of the last time this code was run. Then each of the files within the project have the datestamp compared to the date in the file. If the file was modified in the same day or later than the date in the file then it is uploaded.
At the end of the run the date within the file is updated.
If there is no file to be located in the project's root folder (as will be the case when this first runs) then a default date of the first of January 1900 is used. All of the files within the project will be expected to be modified after this date and thus uploaded. At the end of the run the file will be created within the project's root folder.
With this tool one can replace a ten minute FTP run with something that is over in about 20 seconds if there are only a few updates.
option explicit
Sub Main
' Written by Malcolm Smith, 2002
' http://www.dragondrop.com
' malcolm.smith@dragondrop.com
dim oApp
dim sActiveProjectFile
dim oProjectManager
dim sProjectPath
dim sDateFile
dim sDate, sFileDate
dim oFSO, oTextStream, oFile
dim DeploymentManager
dim i,j,n, sServerName,sFolderName,sDeployPath,sFromFile, sTargetFile
dim objFile
' Change This Line
const DEPLOYMENT_SERVER = "ftp://ntwebftp.mailbox.co.uk"
on error resume next
set oApp = Application
set oProjectManager = oApp.Project
set DeploymentManager = Application.DeploymentManager
sActiveProjectFile = oProjectManager.Path
sProjectPath = GetProjectPath(sActiveProjectFile)
sDateFile = sProjectPath & "Date.txt"
' Set Default Date
sDate = "01/01/1900"
' Open the Date File
set oFSO = CreateObject ("Scripting.FileSystemObject")
if oFSO.FileExists(sDateFile) then
set oTextStream = oFSO.OpenTextFile (sDateFile,1, true)
sDate = oTextStream.Readline
oTextStream.Close
set oTextStream = Nothing
end if
msgbox "Uploading files updated on and since " & DateValue(sDate), , "Fast FTP by Dragon Drop"
DeploymentManager.OpenProject(sActiveProjectFile)
DeploymentManager.SetDeployState DEPLOYMENT_SERVER, true
' Set Deployment Flags...
DeploymentManager.CreateFolder = true
DeploymentManager.UploadOnlyIfNewer = true
DeploymentManager.EncryptCFML = false
DeploymentManager.ForceLowerCase = false
for i = 0 to DeploymentManager.ServerCount - 1
if DeploymentManager.GetDeployServerStatus(i) then
sServerName = DeploymentManager.GetDeployServername(i)
DeploymentManager.CheckServerFolders(sServerName)
' ===================================================================
' Iterate through Project Folders
' ===================================================================
for j=0 to DeploymentManager.FolderCount-1
sFolderName = DeploymentManager.GetFolderName(j)
sDeployPath = DeploymentManager.GetFolderDeployPath(j)
if (DeploymentManager.IsFolderDeployable(sFolderName)) then
' Iterate through Folder Files
for n = 0 to DeploymentManager.GetFolderFileCount(sFolderName)-1
sFromFile = DeploymentManager.GetFolderFileName(sFolderName,n)
set objFile = oFSO.GetFile(sFromFile)
sFileDate = objFile.DateLastModified
if DateValue(sDate) <= DateValue(sFileDate) then
sTargetFile = DeploymentManager.GetDeployTargetName(sServerName,sFolderName,n)
DeploymentManager.UploadFile sFromFile,sTargetFile
end if
next
end if
next
end if
next
' Write the date to the Date File
sDate = Date()
set oFSO = CreateObject ("Scripting.FileSystemObject")
set oTextStream = oFSO.OpenTextFile (sDateFile,2, true)
oTextStream.Writeline Now()
oTextStream.Close
set oTextStream = Nothing
DeploymentManager.CloseProject()
set oFSO = Nothing
end sub
Function GetProjectPath(sProjectFile)
' Gets the Project Folder Path from the Project File Name
Dim sBuffer
Dim nPosn
sBuffer = Trim(sProjectFile)
If Len(sBuffer) > 0 Then
nPosn = InStrRev(sBuffer, "\", -1, vbTextCompare)
If nPosn > 0 Then
sBuffer = Left(sBuffer, nPosn)
End If
End If
GetProjectPath = sBuffer
End Function
If there are any suggestions for updates then please drop me a mail at malcolm.smith@dragondrop.com.