by Luis Mariscal (11 Submissions)
Category: Internet/HTML
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Mon 20th December 2004
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
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
VBcoders
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
No comments have been posted about How to make a UploadASP.dll for upload files into your asp server. Why not be the first to post a comment about How to make a UploadASP.dll for upload files into your asp server.