File dialog in classic asp.

[dabiri]

Hi,
I have a classic asp page that has been working for a while. the user has requested that a file dialog be added so that they can view text files that are in the directory on the server where the asp page is. I have tried some ways in vbs and it works. but, i'm not sure how it's done in asp. any ideas would be appreciated.

regards,

 

[ChrisHirst]

Somewhere in my code archives I have a couple of ASP vbscript class files for such operations, I'll see if I can locate them.


Chris.

Indifference will be the downfall of mankind, but who cares?
Time flies like an arrow, however, fruit flies like a banana.
Webmaster Forum

 

[dabiri]

thanks a bunch.
I appreciate that.

 

[ChrisHirst]

This is a class of methods for handling text files

<%
class clTextFuncs


public function FolderName(byval p_sValue)
dim l_sFolderName : l_sFolderName = p_sValue
if l_sFolderName > "" then
	dim RegEx
	set RegEx = New RegExp
		RegEx.Pattern = "[=\/:;*<>|_" & chr(20) & chr(34) & "]"
		RegEx.Global = True
	l_sFolderName = Replace(l_sFolderName,"-","~")
	l_sFolderName = RegEx.replace(lcase(l_sFolderName), "-")
	l_sFolderName = Replace(l_sFolderName,"'","")
	l_sFolderName = Replace(l_sFolderName,"?","")
	l_sFolderName = Replace(l_sFolderName," ","-")
	l_sFolderName = Replace(l_sFolderName,"_","-")
	l_sFolderName = replace(l_sFolderName,"&","and")
	set regEx = nothing
	FolderName = l_sFolderName
else
	FolderName = ""
end if
end function


public function CheckFile(p_sFileName)
	' Check that a file exists first
	Dim objFSO, objTextFile
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	CheckFile = objFSO.FileExists(server.mappath(p_sFileName))
	Set objFSO = Nothing
End function

public Sub StreamText(p_sFileName)
	' read in a file and stream it out to the browser
	Dim l_oFSO, l_oFSFile
	Set l_oFSO = CreateObject("Scripting.FileSystemObject")
	Set l_oFSFile = l_oFSO.OpenTextFile(Server.MapPath(p_sFileName))
	do until l_oFSFile.AtEndOfStream
		response.write (l_oFSFile.ReadLine)  & vbCrLf
	Loop
	l_oFSFile.close
	Set l_oFSFile = Nothing
	Set l_oFSO = Nothing
End Sub

public function ReadTextFile(ByVal p_sFileName)
	' read in a text file
	'	response.write p_sFileName
	Dim l_oFSO, l_oFSFile
	Set l_oFSO = CreateObject("Scripting.FileSystemObject")
	Set l_oFSFile = l_oFSO.OpenTextFile(Server.MapPath(p_sFileName))

	ReadTextFile = l_oFSFile.ReadAll

	l_oFSFile.close
	Set l_oFSFile = Nothing
	Set l_oFSO = Nothing
End function

public function stripQuotes(ByVal p_sIn)
	stripQuotes = replace(p_sIn, "'", "''")
	'stripQuotes =  StripChars(stripQuotes)
end function
'***********************************

public function StripChars(ByVal p_sIn)
	dim l_asBlock
	dim i
	l_asBlock = array("select", "drop", ";", "--", "insert","delete", "xp_")
	for i = lBound(l_asBlock) to uBound(l_asBlock)
	p_sIn = replace(p_sIn, l_asBlock(i), "")
	next
	StripChars = p_sIn
end function
'*************************************

function CodeWrap(strIn, intWrapLen)
     dim strOut
     dim intLenStrIn
	 dim intCurrPos
     dim intLineStart
     dim intWrapPos

     intLenStrIn = Len(strIn)

     intCurrPos = 1
     intLineStart = 1

     do while intCurrPos < intLenStrIn
          if mid(strIn, intCurrPos, 1) = " " then
               intWrapPos = intCurrPos
          end if
          if intCurrPos = intLineStart + intWrapLen then
               strOut = strOut & trim(mid(strIn,intLineStart,intWrapPos - intLineStart + 1)) & " _ " & vbCrLf & vbTab

               intLineStart = intWrapPos + 1

               do while mid(strIn, intLineStart, 1) = " "
                    intLineStart = intLineStart + 1
               loop
          end if

          intCurrPos = intCurrPos + 1
     loop

     strOut = strOut & trim(mid(strIn,intLineStart)) & vbCrLf

     CodeWrap = strOut
end function

public sub Class_Initialize()

end sub

private sub class_terminate()

end sub

end class
%>

And this is a "filesystem" class

<%
class clFileSystem

dim m_sDefaultDoc

	public property let DefaultDoc(ByVal val)
	m_sDefaultDoc = val
end property

private function CreateFolder(ByVal p_FolderName)
	Dim l_oFSO
	Set l_oFSO= Server.CreateObject("Scripting.FileSystemObject")
	'	response.write p_FolderName
	If l_oFSO.FolderExists(p_FolderName) then
	  CreateFolder = False
	else
	  l_oFSO.CreateFolder(p_FolderName)
	  CreateFolder = True
	End If
	set l_oFSO = nothing
End Function

public function MakeFolders(ByVal p_FolderName)
	dim l_sPathName
		l_sPathName = Server.MapPath(p_FolderName)
		MakeFolders = createfolder(l_sPathName)
		setUploadDoc(p_FolderName)
end function

function RemoveFolder(p_sFolderName)
	dim l_oFSO, l_sFolder
	p_sFolderName = Globals.ShopFolder & p_sFolderName
	response.write p_sFolderName & g_sBR
	l_sFolder = server.mappath(p_sFolderName)
	set l_oFSO=CreateObject("Scripting.FileSystemObject")
	If l_oFSO.FolderExists(l_sFolder) Then
	response.write l_sFolder & g_sBR
		'l_oFSO.DeleteFolder(l_sFolder)
	End If
	set l_oFSO = Nothing
end function

function RemoveImageFolder(ByVal p_sFolderName)
	dim l_oFSO, l_sFolder
	p_sFolderName = Globals.GalleryFolder & p_sFolderName
	response.write p_sFolderName & g_sBR
	l_sFolder = server.mappath(p_sFolderName)
	set l_oFSO=CreateObject("Scripting.FileSystemObject")
	If l_oFSO.FolderExists(l_sFolder) Then
	response.write l_sFolder & g_sBR
		'l_oFSO.DeleteFolder(l_sFolder)
	End If
	set l_oFSO = Nothing
end function

private sub setUploadDoc(ByVal p_sFolder)
	dim l_sBodyText
		l_sBodyText ="<!--#include virtual="
		l_sBodyText = l_sBodyText & chr(34)
		l_sBodyText = l_sBodyText & "/common_files/include/code/inc_code_upload.asp"
		l_sBodyText = l_sBodyText & chr(34)
		l_sBodyText = l_sBodyText & "-->"
		l_sBodyText = l_sBodyText & vbcrlf
	WriteUploadFile p_sFolder, l_sBodyText
end sub

private sub WriteUploadFile(ByVal p_sFolder, p_sText)
	dim l_oFSO, l_oOpenFile
	set l_oFSO = CreateObject ("Scripting.FileSystemObject")
	set l_oOpenFile = l_oFSO.CreateTextFile(Server.MapPath(p_sFolder) & "/" & m_sDefaultDoc ,true)
	l_oOpenFile.Write p_sText
	l_oOpenFile.Close
	set l_oOpenFile = Nothing
	set l_oFSO = Nothing
end sub

function CheckFileExt(strIn, Pattern)
	dim objRE
	set objRE = New RegExp
	objRE.pattern = "(" & replace(Pattern,",","|") & ")"
	' response.write objRE.pattern
	CheckFileExt = objRE.Test(strIn)
	set objRE = nothing
end function

public function GetPath(FldrCount)
	dim ThisPage
	ThisPage = Split(Request.ServerVariables("PATH_INFO"), "/")
	if FldrCount > ubound(ThisPage) then
	else
	GetPath = ThisPage(ubound(ThisPage)- FldrCount)
	end if
end function

function GetFolders(ByVal p_iFldrCount)
	dim ThisPage
	ThisPage = Split(Request.ServerVariables("PATH_INFO"), "/")
	if p_iFldrCount > ubound(ThisPage) then
	else
	GetFolders = ThisPage(ubound(ThisPage)- p_iFldrCount)
	end if
end function

function GetRootPath()
	GetRootPath = replace(lcase(request.servervariables("PATH_TRANSLATED")),lcase(GetPath(0)),"")
end function


end class
%>

They are part of a 'inhouse' intranet ASP CMS that I wrote because all the available ones around at the time were lacking features that we required.



Chris.

Indifference will be the downfall of mankind, but who cares?
Time flies like an arrow, however, fruit flies like a banana.
Webmaster Forum

 

[dabiri]

thanks much.
was able to get it to work.