INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Jobs

File dialog in classic asp.

File dialog in classic asp.

(OP)
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,

RE: File dialog in classic asp.

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

RE: File dialog in classic asp.

(OP)
thanks a bunch.
I appreciate that.

RE: File dialog in classic asp.

This is a class of methods for handling text files

CODE -->

<%
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

CODE --> ASP

<%
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

RE: File dialog in classic asp.

(OP)
thanks much.
was able to get it to work.

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members!

Resources

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close