Ciao a tutti.. stavo cercando uno script per la gestione in sicurezza del download... e fin qui tutto bene.. ora il mio problema è di intercettare il momento in cui il down è finito... e a quel punto in caso positivo.. diciamo di voler incrementare una variabile... cercando e cercando.. o trovato questo codice per vb.. che compilando in dll.. permette di poter scaricare un file (come facevo prima con asp semplicemente)... e mi pare che possa intercettare anche il momento del termine down.. qualcuno ha idea come, modificando questa dll... il possa raggiungere il mio scopo..
This is a very basic up and download component. Developed to give you an idea of how to set a binary stream and download files. Full source code is included in this zip file.
Disclaimer: Use at your own risk, Patrick Santry assumes no responsibilty for the use of this object.
Sample routines that you insert into your ASP code:
Sub UploadFile
Set ObjUpload = Server.CreateObject("WinASP.FileAction")
ObjUpload.DoUpload(Request("Path"))
Set ObjUpload = Nothing
End Sub
'_________________________________________________ ____
Sub DownloadFile
Set ObjDownload = Server.CreateObject("WinASP.FileAction")
ObjDownload.Download = True
ObjDownload.MIMEType = True
ObjDownload.DoDownload Request("File"), Request("Path")
Set ObjDownload = Nothing
End Sub
To register the included DLL for use in your ASP.
Go to the command prompt and type:
regsvr32 <drive>:\FileLocation\WinASP.dll
contenuto file cls:
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 1 'NoTransaction
END
Attribute VB_Name = "FileAction"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
'----- DECLARE ASP OBJECTS
Private MyScriptingContext As ScriptingContext
Private MyRequest As Request
Private MyResponse As Response
Private blnHandleMIME As Boolean
Private blnDownload As Boolean
Public Property Let MIMEType(sMimes As Boolean)
blnHandleMIME = sMimes
End Property
Public Property Let Download(sDownload As Boolean)
blnDownload = sDownload
End Property
Public Sub OnStartPage(PassedScriptingContext As ScriptingContext)
'----- CREATE ASP OBJECTS
Set MyScriptingContext = PassedScriptingContext
Set MyRequest = MyScriptingContext.Request
Set MyResponse = MyScriptingContext.Response
End Sub
Public Sub DoUpload(strPathInfo)
'~~~~~ VARIABLES ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dim varByteCount
Dim binArray() As Byte
Dim lngFileDataStart As Long
Dim lngFileDataEnd As Long
Dim strHeadData As String
Dim intFileTagStart As Integer
Dim strPathName As String
Dim intPathNameStart As String
Dim strFileName As String
Dim intFileNameStart As Integer
Dim intFileNameEnd As Integer
Dim strDelimeter As String
Dim intCount As Integer
Dim lngCount As Long
Dim SourceFile As String
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'~~~~~ BYTE COUNT OF RAW FORM DATA ~~~~~~~~~~~~
varByteCount = MyRequest.TotalBytes
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'~~~~~ PLACE RAW DATA INTO BYTE ARRAY ~~~~~~~~~
ReDim binArray(varByteCount)
binArray = MyRequest.BinaryRead(varByteCount)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'~~~~~ PARSE HEADER DATA OF FIRST ELEMENT FROM BYTE ARRAY ~~~~~~~~~~~~~~~~~~~~~~
intCount = 0 'binArray is base zero
Do Until Right(strHeadData, 4) = vbCrLf & vbCrLf
strHeadData = strHeadData & Chr(binArray(intCount))
intCount = intCount + 1
Loop
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'~~~~~ PARSE FILE NAME ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~
'#1 Find the beginning of the file tag name (UploadFormName)
intFileTagStart = InStr(strHeadData, "UploadFormName")
'#2 Find the beginning of the FilePath ('filename=' plus 10 chars)
intPathNameStart = InStr(intFileTagStart, strHeadData, "filename=") + 10
'#3 Find the quote at the end of the file name sent by the user
intFileNameEnd = InStr(intFileTagStart, strHeadData, vbCrLf) - 1
' Check if no file name was sent (exit sub for this example)
If intPathNameStart = intFileNameEnd Then Exit Sub
'#4 Parse the path name
strPathName = Mid(strHeadData, intPathNameStart, intFileNameEnd - intPathNameStart)
'#5 Find the starting position the file name
For intCount = intFileNameEnd To intPathNameStart Step -1
If Mid(strHeadData, intCount, 1) = "\" Then
intFileNameStart = intCount + 1
Exit For
End If
Next
'#6 Now parse the file name
strFileName = Mid(strHeadData, intFileNameStart, intFileNameEnd - intFileNameStart)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'~~~~~ PARSE DELIMETER FROM HEADER ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
strDelimeter = Left(strHeadData, InStr(strHeadData, vbCrLf) - 1)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'~~~~~ START AND END OF THE UPLOAD FILE DATA ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
lngFileDataStart = InStr(intFileTagStart, strHeadData, vbCrLf & vbCrLf) + 4
lngFileDataEnd = CLng(varByteCount) - (Len(strDelimeter) + 6)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'~~~~~ SAVE THE FILE DATA ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~
If Mid(strPathInfo, 1, Len(strPathInfo)) <> "\" Then
strPathInfo = strPathInfo & "\"
End If
SourceFile = strPathInfo & strFileName
Open SourceFile For Binary Access Write As #1
' binArray is base zero...thus the decrementing
For lngCount = lngFileDataStart - 1 To lngFileDataEnd - 1
Put #1, , (binArray(lngCount))
Next
Close #1
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
End Sub
Public Sub DoDownload(strFileName As Variant, strPathInfo As Variant)
Dim SourceNum As Integer
Dim SourceSize As Long
Dim binArray() As Byte
Dim SourceFile As String
Dim varByteCount As Variant
Dim i As Long
If Mid(strPathInfo, 1, Len(strPathInfo)) <> "\" Then
strPathInfo = strPathInfo & "\"
End If
SourceFile = strPathInfo & strFileName
SourceNum = FreeFile
Open SourceFile For Binary Access Read As SourceNum
varByteCount = LOF(SourceNum)
If varByteCount = 0 Then
'empty file or does not exist
MyResponse.ContentType = "text/html"
MyResponse.Write "Error in download routine."
MyResponse.End
Else
ReDim binArray(varByteCount)
For i = 0 To varByteCount - 1
Get SourceNum, , binArray(i)
DoEvents
Next i
MyResponse.AddHeader "Connection", "keep-alive"
If blnDownload = True Then
MyResponse.AddHeader "Content-Disposition", "attachment; filename=" & strFileName
End If
MyResponse.ContentType = GetMIMEType(FindExtension(strFileName))
MyResponse.AddHeader "Content-Length", varByteCount - 1
MyResponse.BinaryWrite (binArray)
MyResponse.End
End If
Close SourceNum
End Sub
Private Function FindExtension(strFileName) As String
Dim i As Integer
Dim tempExt As String
Dim blnExt As Boolean
blnExt = False
For i = 1 To Len(strFileName)
If blnExt = True Then
tempExt = tempExt & Mid(strFileName, i, 1)
End If
If Mid(strFileName, i, 1) = "." Then
blnExt = True
End If
Next i
If Trim(tempExt) = "" Then
tempExt = "."
End If
FindExtension = tempExt
End Function
Private Function GetMIMEType(strExtension) As String
If blnHandleMIME = True Then
Select Case LCase(strExtension)
Case "txt"
GetMIMEType = "text/plain"
Case "html", "htm"
GetMIMEType = "text/html"
Case "xml"
GetMIMEType = "text/xml"
Case "jpg", "jpeg"
GetMIMEType = "image/jpeg"
Case "gif"
GetMIMEType = "image/gif"
Case "doc"
GetMIMEType = "application/msword"
Case "pdf"
GetMIMEType = "application/pdf"
Case "exe"
GetMIMEType = "application/x-msdownload"
Case Else
GetMIMEType = "binary/octet-stream"
End Select
Else
GetMIMEType = "application/unknown"
End If
End Function
Private Sub Class_Initialize()
If IsEmpty(blnHandleMIME) = True Then
blnHandleMIME = True
End If
If IsEmpty(blnDownload) = True Then
blnDownload = False
End If
End Sub
Il post è un pò lunghino scusate... qualcuno può aiutarmi.. sarebbe interessante comunque per tutta la comunità capire se si può fare.. come.. e con quale mezzi..
Rispondi quotando
