<%@ LANGUAGE="VBSCRIPT" %>
<% Option Explicit %>
<!--
Getting A Unique File Name
Jon Vote, Idioma Software Inc.
03/2002
www.idioma-software.com
This ASP Program Returns a Unique Filename
made up of the year, month, day and a
unique sequence number.
-->
<HTML>
<HEAD>
<META HTTP-EQUIV="Content-Type" content="text/html; charset=iso-8859-1">
<TITLE>Getting a Unique File Name</TITLE>
</HEAD>
<BODY>
<Center>
<H3>Getting a Unique File Name</H3>
Jon Vote, Idioma Software Inc.<BR>
02/2002
</Center>
<Center>
This ASP Example was provided by <A Href="http://www.idioma-software.com">
Idioma Software Inc.</A><BR><BR>
</Center>
<BlockQuote>
<B>This Program Displays a Unique File Name:</B><BR>
</BlockQuote>
<% PaintScreen %>
</BODY>
</HTML>
<% 'PaintScreen - Demo GetUniqueFileName
Private Sub PaintScreen()
Dim strPath
Dim strExt
'We will use
'Request.ServerVariables("APPL_PHYSICAL_PATH")
'as the Path Name
strPath = Request.ServerVariables("APPL_PHYSICAL_PATH")
'Get a unique file name in this path
Response.Write "Here are some unique file names."
strExt = "txt"
Response.Write "<BlockQuote><UL>"
Response.Write "<LI>" & strPath & "\" & GetUniqueFileName(strPath, strExt)
strExt = "asp"
Response.Write "<LI>" & strPath & "\" & GetUniqueFileName(strPath, strExt)
strExt = "html"
Response.Write "<LI>" & strPath & "\" & GetUniqueFileName(strPath, strExt)
Response.Write "</UL></BlockQuote>"
End Sub
%>
<%
'************************************************
'** - These routines can be used to return
'** - a unique file name.
'** - Normally these routines would be put in an
'** - include file be put in an include file
'** - to use in many projects.
'************************************************
%>
<% 'GetUniqueFileName - Accepts Path Name, Extension
'Returns Unique File Name in the Path
Public Function GetUniqueFileName(ByVal strPathName, ByVal strExt)
Dim objFSO
Dim strFileName
Dim strTemp
Dim strTemp2
Dim intFileNumber
Dim strFolder
If strExt = "" Then
strExt = "txt"
End If
If Right(strPathName, 1) <> "\" Then
strPathName = strPathName & "\"
End If
'Set the file system object
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
'NowYYYYMMDD will return today's date
'as YYYYMMDD
strFileName = NowYYYYMMDD()
'Append a number to the end of the file name to make it unique
for intFileNumber = 0 to 1000
if intFileNumber < 10 then
strTemp = strFileName & "0" & intFileNumber
else
strTemp = strFileName & intFileNumber
end if
strTemp = strTemp & "." & strExt
strtemp2 = strtemp
strTemp = strPathName & strTemp
'See if the file exists
If objFSO.FileExists(strTemp) then
Else
exit for
End If
next
'Make sure we didn't overflow
if intfilenumber >= 1000 then
GetUniqueFileName = ""
else
GetUniqueFileName = strTemp2
end if
Set objFSO = Nothing
end function
%>
<% 'NowYYYYMMDD ' Returns Current YYYYMMDD
Public Function NowYYYYMMDD()
Dim strTemp
Dim strFileName
'Create a filename based on the date/time...
'...Year
strTemp = DatePart("yyyy", Now)
strFileName = strTemp
'...Two digit month
strTemp = DatePart("m", Now)
if strTemp < 10 then
strTemp = "0" & strTemp
end if
'...Two digit day
strFileName = strFileName & strTemp
strTemp = DatePart("d", Now)
if strTemp < 10 then
strTemp = "0" & strTemp
end if
strFileName = strFileName & strTemp
NowYYYYMMDD = strFileName
End Function
%>