• Home
 · 
• Internet/HTML
 · 
• How to make a UploadASP.dll for upload files into your asp server

How to make a UploadASP.dll for upload files into your asp server

How to make a UploadASP.dll for upload files into your asp server

API Declarations



Attribute VB_Name = "modWinInet"
Option Explicit

Declare Function GetProcessHeap Lib "kernel32" () As Long
Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long
Public Const HEAP_ZERO_MEMORY = &H8
Public Const HEAP_GENERATE_EXCEPTIONS = &H4

Declare Sub CopyMemory1 Lib "kernel32" Alias "RtlMoveMemory" ( _
hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
Declare Sub CopyMemory2 Lib "kernel32" Alias "RtlMoveMemory" ( _
hpvDest As Long, hpvSource As Any, ByVal cbCopy As Long)

Public Const MAX_PATH = 260
Public Const NO_ERROR = 0
Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_SYSTEM = &H4
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FILE_ATTRIBUTE_TEMPORARY = &H100
Public Const FILE_ATTRIBUTE_COMPRESSED = &H800
Public Const FILE_ATTRIBUTE_OFFLINE = &H1000

Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type

Public Const ERROR_NO_MORE_FILES = 18

Public Declare Function InternetFindNextFile Lib "wininet.dll" Alias "InternetFindNextFileA" _
(ByVal hFind As Long, lpvFindData As WIN32_FIND_DATA) As Long

Public Declare Function FtpFindFirstFile Lib "wininet.dll" Alias "FtpFindFirstFileA" _
(ByVal hFtpSession As Long, ByVal lpszSearchFile As String, _
lpFindFileData As WIN32_FIND_DATA, ByVal dwFlags As Long, ByVal dwContent As Long) As Long

Public Declare Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" _
(ByVal hFtpSession As Long, ByVal lpszRemoteFile As String, _
ByVal lpszNewFile As String, ByVal fFailIfExists As Boolean, ByVal dwFlagsAndAttributes As Long, _
ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean

Public Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" _
(ByVal hFtpSession As Long, ByVal lpszLocalFile As String, _
ByVal lpszRemoteFile As String, _
ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean

Public Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" _
(ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
Public Declare Function FtpGetCurrentDirectory Lib "wininet.dll" Alias "FtpGetCurrentDirectoryA" _
(ByVal hFtpSession As Long, ByVal lpszDirectory As String, ByRef lpdwCurrentDirectory As Long) As Boolean
' Initializes an application's use of the Win32 Internet functions
Public Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" _
(ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, _
ByVal sProxyBypass As String, ByVal lFlags As Long) As Long

' User agent constant.
Public Const scUserAgent = "vb wininet"

' Use registry access settings.
Public Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Public Const INTERNET_OPEN_TYPE_DIRECT = 1
Public Const INTERNET_OPEN_TYPE_PROXY = 3
Public Const INTERNET_INVALID_PORT_NUMBER = 0

Public Const FTP_TRANSFER_TYPE_ASCII = &H1
Public Const FTP_TRANSFER_TYPE_BINARY = &H2

' Opens a HTTP session for a given site.
Public Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" _
(ByVal hInternetSession As Long, ByVal sServerName As String, ByVal nServerPort As Integer, _
ByVal sUsername As String, ByVal sPassword As String, ByVal lService As Long, _
ByVal lFlags As Long, ByVal lContext As Long) As Long

Public Declare Function InternetGetLastResponseInfo Lib "wininet.dll" Alias "InternetGetLastResponseInfoA" ( _
lpdwError As Long, _
ByVal lpszBuffer As String, _
lpdwBufferLength As Long) As Boolean

' Number of the TCP/IP port on the server to connect to.
Public Const INTERNET_DEFAULT_FTP_PORT = 21
Public Const INTERNET_DEFAULT_GOPHER_PORT = 70
Public Const INTERNET_DEFAULT_HTTP_PORT = 80
Public Const INTERNET_DEFAULT_HTTPS_PORT = 443
Public Const INTERNET_DEFAULT_SOCKS_PORT = 1080

Public Const INTERNET_OPTION_CONNECT_TIMEOUT = 2
Public Const INTERNET_OPTION_RECEIVE_TIMEOUT = 6
Public Const INTERNET_OPTION_SEND_TIMEOUT = 5

Public Const INTERNET_OPTION_USERNAME = 28
Public Const INTERNET_OPTION_PASSWORD = 29
Public Const INTERNET_OPTION_PROXY_USERNAME = 43
Public Const INTERNET_OPTION_PROXY_PASSWORD = 44

' Type of service to access.
Public Const INTERNET_SERVICE_FTP = 1
Public Const INTERNET_SERVICE_GOPHER = 2
Public Const INTERNET_SERVICE_HTTP = 3

' Opens an HTTP request handle.
Public Declare Function HttpOpenRequest Lib "wininet.dll" Alias "HttpOpenRequestA" _
(ByVal hHttpSession As Long, ByVal sVerb As String, ByVal sObjectName As String, ByVal sVersion As String, _
ByVal sReferer As String, ByVal something As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long

Public Const GENERIC_READ = &H80000000
Public Const GENERIC_WRITE = &H40000000

' Sends the specified request to the HTTP server.
Public Declare Function HttpSendRequest Lib "wininet.dll" Alias "HttpSendRequestA" (ByVal _
hHttpRequest As Long, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal sOptional As _
String, ByVal lOptionalLength As Long) As Integer


' Queries for information about an HTTP request.
Public Declare Function HttpQueryInfo Lib "wininet.dll" Alias "HttpQueryInfoA" _
(ByVal hHttpRequest As Long, ByVal lInfoLevel As Long, ByRef sBuffer As Any, _
ByRef lBufferLength As Long, ByRef lIndex As Long) As Integer


Rate How to make a UploadASP.dll for upload files into your asp server

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "aspupload"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
 'Global Scripting Context

Dim ASPsc As ScriptingContext
Dim Application As Object
Dim Request As Object
Dim Session As Object
Dim Response As Object
Dim Server As Object

Dim UploadControl
Dim UploadRequest
Public filename
' Aqui van las variables publicas
' ej: Public Snombre
Public sfoto
Public destino
Public resultado
Public redirect
Public fecha



Public Sub Main()

End Sub


Public Sub OnStartPage(ASPScriptingContext As ScriptingContext)
'Set global variable to reference in other functions and subs
Set ASPsc = ASPScriptingContext
End Sub


Public Sub OnEndPage()
Set ASPsc = Nothing
End Sub



Public Sub save(destino)

Set Application = ASPsc.Application
Set Request = ASPsc.Request
Set Session = ASPsc.Session
Set Response = ASPsc.Response
Set Server = ASPsc.Server
dominio = Request.ServerVariables("server_name")
Response.Expires = 0
Response.Buffer = True
Response.Clear
byteCount = Request.TotalBytes
RequestBin = Request.BinaryRead(byteCount)
Set UploadRequest = CreateObject("Scripting.Dictionary")
BuildUploadRequest RequestBin
ContentType = UploadRequest.Item("foto").Item("ContentType")
filepathname = UploadRequest.Item("foto").Item("FileName")
directorio = destino



'saca solo el nombre de la foto
filename = Right(filepathname, Len(filepathname) - InStrRev(filepathname, "\"))
Value = UploadRequest.Item("foto").Item("Value")
'Create FileSytemObject Component
 Set ScriptObject = Server.CreateObject("Scripting.FileSystemObject")
'Create and Write to a File

    ' -----------------------
    'Dim campos
     '  For Each campos In UploadRequest
     '      campos = UploadRequest.Item("" & campos & "").Item("Value")
     ' Next
    '---------------- 


 Set MyFile = ScriptObject.CreateTextFile(directorio & "\" & filename & ".jpg")
   For i = 1 To LenB(Value)
      MyFile.Write Chr(AscB(MidB(Value, i, 1)))
   Next




 
     
        
End Sub




Sub BuildUploadRequest(RequestBin)
    
    comienzo = 1
    final = InStrB(comienzo, RequestBin, getByteString(Chr(13)))
    boundary = MidB(RequestBin, comienzo, final - comienzo)
    BoundaryPos = InStrB(1, RequestBin, boundary)
    
    Do Until (BoundaryPos = InStrB(RequestBin, boundary & getByteString("--")))

            
        Set UploadControl = CreateObject("Scripting.Dictionary")

        
        pos = InStrB(BoundaryPos, RequestBin, getByteString("Content-Disposition"))
        pos = InStrB(pos, RequestBin, getByteString("name="))
        comienzo = pos + 6
        final = InStrB(comienzo, RequestBin, getByteString(Chr(34)))
        Name = getString(MidB(RequestBin, comienzo, final - comienzo))
        PosFile = InStrB(BoundaryPos, RequestBin, getByteString("filename="))
        PosBound = InStrB(final, RequestBin, boundary)

        
        If PosFile <> 0 And (PosFile < PosBound) Then
            'Get Filename, content-type and content of file
            comienzo = PosFile + 10
            final = InStrB(comienzo, RequestBin, getByteString(Chr(34)))
            filename = getString(MidB(RequestBin, comienzo, final - comienzo))

            'Add filename to dictionary object
            UploadControl.Add "FileName", filename
            pos = InStrB(final, RequestBin, getByteString("Content-Type:"))
            comienzo = pos + 14
            final = InStrB(comienzo, RequestBin, getByteString(Chr(13)))

            
            ContentType = getString(MidB(RequestBin, comienzo, final - comienzo))
            UploadControl.Add "ContentType", ContentType

            
            comienzo = final + 4
            final = InStrB(comienzo, RequestBin, boundary) - 2
            Value = MidB(RequestBin, comienzo, final - comienzo)
            Else

            pos = InStrB(pos, RequestBin, getByteString(Chr(13)))
            comienzo = pos + 4
            final = InStrB(comienzo, RequestBin, boundary) - 2
            Value = getString(MidB(RequestBin, comienzo, final - comienzo))
        End If

    
    UploadControl.Add "Value", Value
        
 
    UploadRequest.Add Name, UploadControl
 
    BoundaryPos = InStrB(BoundaryPos + LenB(boundary), RequestBin, boundary)
    
    Loop

End Sub




Private Function GetWebData(strUrl As String) As String
Dim hInternet, hSession, lngDataReturned As Long
Dim intReadFileResult As Integer
Dim strBuffer As String * 128
Dim strTotalData As String

    'retrieve a handle to the current internet session
    hSession = InternetOpen("vb wininet", 1, vbNullString, vbNullString, 0)

    If hSession Then
        'retrieve a handle to the strUrl
        hInternet = InternetOpenUrl(hSession, strUrl, vbNullString, 0, INTERNET_FLAG_NO_CACHE_WRITE, 0)
    End If

    If hInternet Then
        'start reading the web page into a buffer, 128 bytes at a time
        intReadFileResult = InternetReadFile(hInternet, strBuffer, STRING_SIZE, lngDataReturned)
        
        'copy the contents of the buffer to strTotalData
        strTotalData = strBuffer
            
        'While there is still data left,
        Do While lngDataReturned <> 0
            'keep reading the web page into the buffer,
            intReadFileResult = InternetReadFile(hInternet, strBuffer, STRING_SIZE, lngDataReturned)
        
            'and keep appending the contents of strTotalData
            strTotalData = strTotalData + Mid(strBuffer, 1, lngDataReturned)
        Loop
    End If
   
    'return our internet handle
    intReadFileResult = InternetCloseHandle(hInternet)

    GetWebData = strTotalData

    'manually clear the string, just in case
    strTotalData = ""
End Function



Sub LoadHttp(URL As String)

Set Application = ASPsc.Application
Set Request = ASPsc.Request
Set Session = ASPsc.Session
Set Response = ASPsc.Response
Set Server = ASPsc.Server
resultado = GetWebData(URL)
Response.Write resultado
End Sub