Lave upload om til selv at lave fil navn?
Er der en der kan lave denne upload funktion om så den selv laver et filnavn og gemmer i en mappe. Jeg skal bruge dette her som den er jeg kan bare ikke finde ud at hvor det er jeg lave om så den endten bruger navn som filen her eller selv laver et. Håber der er en der kan hjælpe.<%
FLname = ""
FLsize = ""
FLtype = ""
FUerror = 0
Randomize
Call Main
Sub Main()
Call PasswordTest()
End Sub
Function NoCache()
NoCache = Int(9999 * Rnd) + 1
End Function
Sub PasswordTest()
if Session("secure") <> "ok" AND request("test") <> 1 Then
response.redirect("../logon.asp")
end if
if Session("secure") <> "ok" AND request("test") = 1 Then
Set con = Server.CreateObject("ADODB.Connection")
con.Open Adminstrconn, "", ""
strSQL = "SELECT * FROM control WHERE id = 1"
Set rst = Server.CreateObject("ADODB.Recordset")
rst.Open strSQL, con, adOpenStatic, adLockReadOnly, adCmdText
If Not rst.EOF Then
pword = rst("pword")
End If
rst.Close
set rst = nothing
con.Close
set con = nothing
If NOT ( Trim(request("password")) = pword ) Then
response.redirect("../logon.asp")
end if
Session("secure") = "ok"
end if
if Session("secure") <> "ok" Then
response.redirect("../logon.asp")
end if
End Sub
Function FileExists(fspath)
On Error Resume Next
FileExists = False
set fs = CreateObject("Scripting.FileSystemObject")
Err.Clear
set istream = fs.OpenTextFile(fspath)
if Err.Number = 0 then
FileExists = True
istream.Close
end if
set istream = Nothing
set fs = Nothing
End Function
Sub Delete(where)
On Error Resume Next
If FileExists(where) Then
Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFile(where)
f.Delete
Set f = nothing
Set fso = nothing
End If
End Sub
Class FileUploader
Public Files
Private mcolFormElem
Private Sub Class_Initialize()
Set Files = Server.CreateObject("Scripting.Dictionary")
Set mcolFormElem = Server.CreateObject("Scripting.Dictionary")
End Sub
Private Sub Class_Terminate()
If IsObject(Files) Then
Files.RemoveAll()
Set Files = Nothing
End If
If IsObject(mcolFormElem) Then
mcolFormElem.RemoveAll()
Set mcolFormElem = Nothing
End If
End Sub
Public Property Get Form(sIndex)
Form = ""
If mcolFormElem.Exists(LCase(sIndex)) Then Form = mcolFormElem.Item(LCase(sIndex))
End Property
Public Default Sub Upload()
Dim biData, sInputName
Dim nPosBegin, nPosEnd, nPos, vDataBounds, nDataBoundPos
Dim nPosFile, nPosBound
biData = Request.BinaryRead(Request.TotalBytes)
nPosBegin = 1
nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(13)))
If (nPosEnd-nPosBegin) <= 0 Then Exit Sub
vDataBounds = MidB(biData, nPosBegin, nPosEnd-nPosBegin)
nDataBoundPos = InstrB(1, biData, vDataBounds)
Do Until nDataBoundPos = InstrB(biData, vDataBounds & CByteString("--"))
nPos = InstrB(nDataBoundPos, biData, CByteString("Content-Disposition"))
nPos = InstrB(nPos, biData, CByteString("name="))
nPosBegin = nPos + 6
nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(34)))
sInputName = CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))
nPosFile = InstrB(nDataBoundPos, biData, CByteString("filename="))
nPosBound = InstrB(nPosEnd, biData, vDataBounds)
If nPosFile <> 0 And nPosFile < nPosBound Then
Dim oUploadFile, sFileSpec
Set oUploadFile = New UploadedFile
nPosBegin = nPosFile + 10
nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(34)))
sFileSpec = CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))
oUploadFile.FileSpec = Right(sFileSpec, Len(sFileSpec)-InStrRev(sFileSpec, "\"))
nPos = InstrB(nPosEnd, biData, CByteString("Content-Type:"))
nPosBegin = nPos + 14
nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(13)))
oUploadFile.ContentType = CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))
nPosBegin = nPosEnd+4
nPosEnd = InstrB(nPosBegin, biData, vDataBounds) - 2
oUploadFile.FileData = MidB(biData, nPosBegin, nPosEnd-nPosBegin)
If oUploadFile.FileSize > 0 Then Files.Add LCase(sInputName), oUploadFile
Else
nPos = InstrB(nPos, biData, CByteString(Chr(13)))
nPosBegin = nPos + 4
nPosEnd = InstrB(nPosBegin, biData, vDataBounds) - 2
If Not mcolFormElem.Exists(LCase(sInputName)) Then mcolFormElem.Add LCase(sInputName), CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))
End If
nDataBoundPos = InstrB(nDataBoundPos + LenB(vDataBounds), biData, vDataBounds)
Loop
End Sub
Private Function CByteString(sString)
Dim nIndex
For nIndex = 1 to Len(sString)
CByteString = CByteString & ChrB(AscB(Mid(sString,nIndex,1)))
Next
End Function
Private Function CWideString(bsString)
Dim nIndex
CWideString =""
For nIndex = 1 to LenB(bsString)
CWideString = CWideString & Chr(AscB(MidB(bsString,nIndex,1)))
Next
End Function
End Class
Class UploadedFile
Public ContentType
Public FileSpec
Public FileData
Public Property Get FileSize()
FileSize = LenB(FileData)
End Property
Public Sub SaveToDisk(sPath)
Dim oFS, oFile
Dim nIndex
If sPath = "" Or FileSpec = "" Then Exit Sub
If Mid(sPath, Len(sPath)) <> "\" Then sPath = sPath & "\"
Set oFS = Server.CreateObject("Scripting.FileSystemObject")
If Not oFS.FolderExists(sPath) Then Exit Sub
Set oFile = oFS.CreateTextFile(sPath & "demoimage.jpg", True)
For nIndex = 1 to LenB(FileData)
oFile.Write Chr(AscB(MidB(FileData,nIndex,1)))
Next
oFile.Close
End Sub
Public Sub SaveToDatabase(ByRef oField)
If LenB(FileData) = 0 Then Exit Sub
If IsObject(oField) Then
oField.AppendChunk FileData
End If
End Sub
End Class
%>
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=windows-1252">
<title></title>
<script language="javascript">
<!--
function rusure(value) {
if (confirm("Warning ! Once you delete this item you can not go back and recover it. Are you sure that you want to delete it?."))
{ document.location.href = value;
}
}
// -->
</script>
