ok, I've written this script so that I have a mechanism for publishing and
viewing the file in the active editor window to a remote (LAN) based HTTP
server.
The script opens the document for preview in the system's current default
browser. There is no way to tell PSPad's internal preview engine what URL to
open, so this is the best I could do.
Assumptions:
The current file is part of a project.
The project's Default Directory, Document Root and Web Server properties are set
as follows:
_Project Default Directory:_ Local Path to Working Directory
_Server:_ URL Path to root of published project. If project is in root of
HTDOCS then Server would be set to just the server name. If project is a
subdirectory of HTDOCS then Server would be set to <servername>/<projectdir>
_Document Root:_ Full path to the root of the published root directory.
e.g. C:\HTDOCS\ or C:\HTDOCS\sub directory. *Supports UNC paths too.:*
\\<server>\htdocs\sub directory
What it does...
The current file is copied to a location that includes the directory structure
in the local project default directory. e.g.
Project Default Directory = D:\my web\test\
Server = webserver/test
Document Root: \\webserver\htdocs\test
Current File: D:\my web\test\demo dir\index.php
Published File Path = \\webserver\htdocs\test\demo dir\index.php
Preview URL = HTTP://webserver/test/demo%20dir/index.php
It is a little rough around the edges but does appear to do the job. Please feel
free to edit it/update it as you see fit. I cannot offer any support on the
script as I really don't have the time to add things in on request, sorry :/
'----------------------------------------------------------------------
'
' Module : LANPreview.vbs
' Created : 17/01/2008
' Author : John Marden
' Purpose : Copies the current document to the remote directory and
' launches the preview window to view from remote server.
'-----------------------------------------------------------------------
' Dependancies :
' Assumptions : Project Default Directory, Document Root and Web Server
' are all set to paths appropriate of the project.
' Last Updated :
'-----------------------------------------------------------------------
option explicit
'*************** Module Constants ****************
const module_name = "LANPreview" 'this name must be unique !!!
const module_desc = "Copy and Preview current Document from a Remote Server."
const module_ver = "0.001a" 'version
const INI_CONFIG = "Config"
const INI_INET = "Internet"
const INI_PHP_DOCS = "PHPDocs"
const INI_PRJ_DIR = "DefaultDir"
const INI_DOC_ROOT = "DocumentRoot"
const INI_WEB_SVR = "HTServer"
dim nbDebug
dim nsDocRoot, nsWebServer, nsProjectRoot
sub npCopyandPreviewDoc()
'----------------------------------------------------------------------
' Procedure : LANPreview.npCopyandPreviewDoc
' Author : John Marden
' Date Created : 17/01/2008
'-----------------------------------------------------------------------
' Purpose : grabs the source path and copies to the remote
' Notes :
' Last Updated :
'---------------------------------------------------------------------
on error resume next
dim loCurEdit
dim loFSO
dim lsSourceFilename
dim lsSourcePath
dim lsExtraPathInfo
if (editorsCount > 0) then
if nbDebug then
logAddLine vbnullstring
logAddLine "Preparing LAN Preview..."
end if
'Grab the document to preview...
on error resume next
set loCurEdit = newEditor()
if (err.number = 0) then
'Crack on with the sync...
loCurEdit.assignActiveEditor
if (err.number = 0) then
on error goto 0
if nfbLoadSettings then
'Get the File to Preview
if nbDebug then logAddLine "Working File: " & loCurEdit.fileName
on error resume next
set loFSO = CreateObject("Scripting.FileSystemObject")
if err.number = 0 then
on error goto 0
'Split the source filepath into component parts
with loFSO.GetFile(loCurEdit.fileName)
lsSourceFilename = .Name
lsSourcePath = .ParentFolder.Path
end with
if right(lsSourcePath, 1) <> "\" then lsSourcePath =
lsSourcePath & "\"
'See if there is extra path information in the source...
lsExtraPathInfo = replace(lsSourcePath, nsProjectRoot,
vbNullstring)
'Now we need to make sure that the destination directory
structure is in place
if nfbMakeDirStructure(nsDocRoot & lsExtraPathInfo) then
'Tell the user what we are going to do
logAddLine "Copying " & loCurEdit.fileName & " to " &
nsDocRoot & lsExtraPathInfo
if nfbCopyFile(loCurEdit.fileName, nsDocRoot &
lsExtraPathInfo & lsSourceFilename) then
'Build the URL to preview
npBrowserPreview
nfsGetURLPathFromDocRoot(lsExtraPathInfo, lsSourceFilename)
else
logAddLine "Failed to Copy File to Remote Server."
end if
else
logAddLine "Failed to Validate Remote Directory Structure
[" & nsDocRoot & lsExtraPathInfo & "]"
end if
else
logAddLine "Failed to Determine Remote Target Folder Name."
end if
else
on error goto 0
logAddLine "Failed to Load Remote Server and Document Root
Settings."
end if
else
logAddLine "Failed to Link to Current Document."
logAddLine "Err: " & err.description
end if
else
logAddLine "Failed to Reference Editor."
logAddLine "Err: " & err.description
end if
on error goto 0
else
msgbox "Please Open a Document to Preview.", vbInformation, module_name
end if
set loFSO = nothing
set loCurEdit = nothing
end sub
private sub npBrowserPreview(vsFullURL)
'----------------------------------------------------------------------
' Procedure : LANPreview.npBrowserPreview
' Author : John Marden
' Date Created : 18/01/2008
'-----------------------------------------------------------------------
' Purpose : Get the Shell to load the URl in the default browser
' Notes :
' Last Updated :
'-----------------------------------------------------------------------
on error resume next
dim loShell
set loShell = CreateObject("WScript.Shell")
if err.number = 0 then
logAddLine "Previewing: " & vsFullURL
loShell.Run vsFullURL, 1, false
else
logAddLine "Failed to Link to Browser."
end if
set loShell = nothing
end sub
private function nfbMakeDirStructure(vsPath)
'----------------------------------------------------------------------
' Procedure : LANPreview.nfbMakeDirStructure
' Author : John Marden
' Date Created : 18/01/2008
'-----------------------------------------------------------------------
' Purpose : Generate the URL Path on which the document should be
' found.
' Notes :
' Last Updated :
'-----------------------------------------------------------------------
on error resume next
dim lbReturn
dim lsTarget
dim loFSO
dim lsDrive
dim lsDirParts
dim llCount
dim llPos
lbReturn = false
lsTarget = vsPath
set loFSO = CreateObject("Scripting.FileSystemObject")
if err.number = 0 then
on error goto 0
'See if the target exists
if not loFSO.FolderExists(vsPath) then
if nbDebug then logAddLine "Creating Path [" & vsPath & "]"
if mid(vsPath, 2, 1) = ":" then
lsDrive = mid(vsPath, 1, 3)
elseif left(vsPath, 2) = "\\" then
llPos = instr(3, vsPath, "\")
lsDrive = mid(vsPath, 1, llPos -1)
end if
if len(lsDrive) > 0 then vsPath = right(vsPath, len(vsPath) -
len(lsDrive))
lsDirParts = split(vsPath, "\")
if ubound(lsDirParts) >= 0 then
'Start building the directory
for llCount = 0 to ubound(lsDirParts)
if len(lsDirParts(llCount)) > 0 then
lsDrive = lsDrive & "\" & lsDirParts(llCount)
if not loFSO.FolderExists(lsDrive) then
loFSO.CreateFolder(lsDrive)
if not loFSO.FolderExists(lsDrive) then
logAddLine "Failed to Create Directory [" & lsDrive & "]"
llCount = ubound(lsDirParts) + 1
lbReturn = false
end if
end if
end if
next
end if
'So is it there now ?
lbReturn = loFSO.FolderExists(lsTarget)
else
lbReturn = true
end if
else
logAddLine "Failed to Reference FileSystemObject."
end if
set loFSO = nothing
nfbMakeDirStructure = lbReturn
end function
private function nfsGetURLPathFromDocRoot(vsPath, vsFilename)
'----------------------------------------------------------------------
' Procedure : LANPreview.nfsGetURLPathFromDocRoot
' Author : John Marden
' Date Created : 17/01/2008
'-----------------------------------------------------------------------
' Purpose : Generate the URL Path on which the document should be
' found.
' Notes :
' Last Updated :
'-----------------------------------------------------------------------
dim lbAddProto
dim lsReturn
vsPath = replace(vsPath, "\", "/")
if right(vsPath, 1) <> "/" then vsPath = vsPath & "/"
if left(vsPath, 1) <> "/" then vsPath = "/" & vsPath
'Need to Take protcols into account...
if (ucase(left(nsWebServer, 7)) = "HTTP://") then
lsReturn = "HTTP://" & escape(mid(nsWebServer, 8))
elseif (ucase(left(nsWebServer, 8)) = "HTTPS://") then
lsReturn = "HTTPS://" & escape(mid(nsWebServer, 9))
else
lsReturn = "HTTP://" & escape(nsWebServer)
end if
nfsGetURLPathFromDocRoot = lsReturn & escape(vsPath & vsFilename)
end function
private function nfbCopyFile(vsSource, vsDestination)
'----------------------------------------------------------------------
' Procedure : LANPreview.nfbCopyFile
' Author : John Marden
' Date Created : 17/01/2008
'-----------------------------------------------------------------------
' Purpose : Copies the source to the destination...dur !
' Notes :
' Last Updated :
'-----------------------------------------------------------------------
dim loFSO
dim lbReturn
lbReturn = true
on error resume next
set loFSO = CreateObject("Scripting.FileSystemObject")
if err.number = 0 then
loFSO.CopyFile vsSource, vsDestination
if err.number = 0 then
lbReturn = loFSO.FileExists(vsDestination)
else
logAddLine "Error: " & err.description
lbReturn = False
end if
else
logAddLine "Failed to Reference FSO !"
lbReturn = False
end if
set loFSO = nothing
nfbCopyFile = lbReturn
end function
private function nfbLoadSettings()
'----------------------------------------------------------------------
' Procedure : LANPreview.nfbLoadSettings
' Author : John Marden
' Date Created : 17/01/2008
'-----------------------------------------------------------------------
' Purpose : Loads in the application and project defined document
' root and webserver settings.
' Notes :
' Last Updated :
'-----------------------------------------------------------------------
dim loIniFile
dim lbReturn
lbReturn = false
set loIniFile = new IniFile
if (err.number = 0) then
'See if there are project level settings...
loIniFile.FileName = projectFileName
if nbDebug then logAddLine "Project: " & loIniFile.FileName
if (mid(loIniFile.FileName, 2, 2) = ":\") OR (left( loIniFile.FileName, 2) =
"\\") then
'See if there are project settings to use too...
loIniFile.Section = INI_CONFIG
loIniFile.Key = INI_DOC_ROOT
nsDocRoot = loIniFile.Value
'Project server
loIniFile.Key = INI_WEB_SVR
nsWebServer = loIniFile.Value
'Project Default Directory
loIniFile.Key = INI_PRJ_DIR
nsProjectRoot = loIniFile.Value
end if
if (len(nsDocRoot) = 0) OR (len(nsWebServer) = 0) then
loIniFile.FileName = nfsGetUserInIFile()
if nbDebug then logAddLine "Ini File: " & loIniFile.FileName
'Application Defined Document Root...
if len(nsDocRoot) = 0 then
loIniFile.Section = INI_CONFIG
loIniFile.Key = INI_PHP_DOCS
nsDocRoot = loIniFile.Value
if nbDebug then logAddLine vbtab & "App Doc Root: " & nsDocRoot
end if
'Application defined HTTP Server
if len(nsWebServer) = 0 then
loIniFile.Section = INI_INET
loIniFile.Key = INI_WEB_SVR
nsWebServer = loIniFile.Value
if nbDebug then logAddLine vbtab & "App HTTP Server: " & nsWebServer
end if
end if
if len(nsDocRoot) > 0 then
if right(nsDocRoot, 1) <> "\" then nsDocRoot = nsDocRoot & "\"
end if
if len(nsProjectRoot) > 0 then
if right(nsProjectRoot, 1) <> "\" then nsProjectRoot = nsProjectRoot &
"\"
end if
if nbDebug then
logAddLine vbtab & "Project Dir: " & nsProjectRoot
logAddLine vbtab & "Doc Root: " & nsDocRoot
logAddLine vbtab & "HTTP Server: " & nsWebServer
end if
else
logAddLine "Failed to Reference INI I/O Class."
logAddLine "Err: " & err.description
lbReturn = false
end if
if len(nsProjectRoot) > 0 then
lbReturn = (len(nsDocRoot & nsWebServer) > 0)
else
logAddLine "No Project Default Directory Defined."
end if
nfbLoadSettings = lbReturn
end function
private function nfsGetUserInIFile()
'----------------------------------------------------------------------
' Procedure : LANPreview.nfsGetUserInIFile
' Author : John Marden
' Date Created : 17/01/2008
'-----------------------------------------------------------------------
' Purpose : Generates the fullpath to the current users PSPad Ini
' file (probably in their user profile).
' Notes :
' Last Updated :
'-----------------------------------------------------------------------
dim lsReturn
dim llDirLen
llDirLen = 0
lsReturn = vbnullstring
lsReturn = getVarValue("%AppData%")
if len(lsReturn) > 0 then
on error resume next
'Test that the directory exists...
llDirLen = len(dir(lsReturn))
if (err.number <> 0) or (llDirLen <= 2) then
'Going to have to try and manually find the ini file...
lsReturn = getVarValue("%UserProfile%")
'Any luck ?
if len(lsReturn) > 0 then
if right(lsReturn, 1) <> "\" then lsReturn = lsReturn & "\"
lsReturn = lsReturn & "Application Data\PSpad\"
else
lsReturn = vbnullstring
end if
end if
on error goto 0
'Stick on the ini filename we're interested in...
if len(lsReturn) > 0 then
if right(lsReturn, 1) <> "\" then lsReturn = lsReturn & "\"
lsReturn = lsReturn & "PSPad.INI"
end if
end if
nfsGetUserInIFile = lsReturn
end function
sub npDebugMode()
nbDebug = true
npCopyandPreviewDoc
End Sub
sub Init
nbDebug = false
'addMenuItem "Current Doc w/ Debug", module_name, "npDebugMode"
addMenuItem "Current Document", module_name, "npCopyandPreviewDoc"
end sub
' ___________________________________________________________________
'
' VBScript File: IniFileClass.vbs
' Author: Frank-Peter Schultze
'
' Updates: http://www.fpschultze.de/modules/smartfaq/faq.php?faqid=51
' Enhancement Req.
' and Bug Reports: [EMAIL PROTECTED]
'
' Built/Tested On: Windows 2003
' Requirements: WSH 1.0+, VBScript 5.0+
'
' Purpose: Provides a class to read from/write to ini files
'
' Last Update: John Marden 17/01/2008
' Update Note: Updated to support loading into PSPad
' ___________________________________________________________________
'
' This script is a rewritten/improved version of Jean-Luc Antoine's
' class to accesss ini files, class_ini.vbs. URL of original code:
' http://www.interclasse.com/scripts/class_ini.php
' ___________________________________________________________________
Class IniFile
Public Filename
Public Section
Public Key
Private objFso
Private objIni
Private Sub Class_Initialize
Set objFso = WScript.CreateObject("Scripting.FileSystemObject")
End Sub
Private Sub Class_Terminate
Set objFso = Nothing
End Sub
Private Sub SectionStartEnd(ByRef lngSectionStart, ByRef lngSectionEnd)
Dim arrContent, i, s
lngSectionStart = -2
lngSectionEnd = -1
arrContent = Split(Content, vbNewLine, -1, 1)
If (UBound(arrContent) > -1) Then
If (Section <> "") Then
For i = LBound(arrContent) To UBound(arrContent)
s = Trim(arrContent(i))
If (LCase(s) = "[" & LCase(Section) & "]") Then
lngSectionStart = i
ElseIf (Left(s, 1) = "[") AND _
(Right(s, 1) = "]") AND _
(lngSectionStart >= 0) Then
lngSectionEnd = i - 1
Exit For
End If
Next
If (lngSectionStart >= 0) AND (lngSectionEnd < 0) Then
lngSectionEnd = UBound(arrContent)
End If
Else
lngSectionStart = -1
lngSectionEnd = UBound(arrContent)
End If
If (lngSectionStart > -2) Then
If (arrContent(lngSectionEnd) = "") Then
lngSectionEnd = lngSectionEnd - 1
End If
End If
End If
End Sub
Property Get Content
Const FOR_READING = 1
Content = ""
If objFso.FileExists(FileName) Then
Set objIni = objFso.OpenTextFile(Filename, FOR_READING)
Content = objIni.ReadAll
objIni.Close
Set objIni = Nothing
End If
End Property
Property Let Content(strContent)
Const OVERWRITE = True
Set objIni = objFso.CreateTextFile(Filename, OVERWRITE)
objIni.Write strContent
objIni.Close
Set objIni = Nothing
End Property
Property Get Value
Dim lngSectionStart, lngSectionEnd, lngIndex, arrContent
Dim strLine, i, s
Value = ""
SectionStartEnd lngSectionStart, lngSectionEnd
If (lngSectionStart > -2) Then
arrContent = Split(Content, vbNewLine, -1, 1)
For lngIndex = lngSectionStart + 1 To lngSectionEnd
strLine = arrContent(lngIndex)
i = InStr(1, strLine, "=", 1)
If (i > 0) Then
s = Left(strLine, i - 1)
s = Trim(s)
If (LCase(s) = LCase(Key)) Then
Value = Mid(strLine, i + 1)
Value = Trim(Value)
Exit For
End If
End If
Next
End If
End Property
Property Let Value(strValue)
Dim lngSectionStart, lngSectionEnd, arrContent
Dim lngIndex, lngIndex2, strContent, blnKeyNotFound
Dim strLine, i, s
SectionStartEnd lngSectionStart, lngSectionEnd
If (lngSectionStart < -1) AND (strValue <> "") Then
strContent = Content & vbNewLine _
& "[" & Section & "]" & vbNewLine _
& Key & "=" & strValue
Else
blnKeyNotFound = True
arrContent = Split(Content, vbNewLine, -1, 1)
For lngIndex = lngSectionStart + 1 To lngSectionEnd
strLine = arrContent(lngIndex)
i = InStr(1, strLine, "=", 1)
If (i > 0) Then
s = Left(strLine, i - 1)
s = Trim(s)
If (LCase(s) = LCase(Key)) Then
blnKeyNotFound = False
If (strValue <> "") Then
arrContent(lngIndex) = Key & "=" & strValue
Else
For lngIndex2 = lngIndex To UBound(arrContent) - 1
arrContent(lngIndex2) = arrContent(lngIndex2 +
1)
Next
Redim Preserve arrContent(UBound(arrContent) - 1)
End If
Exit For
End If
End If
Next
If blnKeyNotFound AND (strValue <> "") Then
Redim Preserve arrContent(UBound(arrContent) + 1)
For lngIndex = UBound(arrContent) To lngSectionEnd + 2 Step -1
arrContent(lngIndex) = arrContent(lngIndex - 1)
Next
arrContent(lngSectionEnd + 1) = Key & "=" & strValue
End If
strContent = arrContent(0)
For lngIndex = 1 To UBound(arrContent)
strContent = strContent & vbNewLine & arrContent(lngIndex)
Next
End If
Content = strContent
End Property
End Class
--
<http://forum.pspad.com/read.php?2,44406,44406>
PSPad freeware editor http://www.pspad.com
