Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0501: Datei per HTTP uploaden

 von 

Beschreibung 

Dies ist eine Funktion, die eine Datei mittells HTTP (und wininet.dll) uploaded, als ob man sie per Browser über ein Formular abschicken wurde.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

HttpAddRequestHeadersA (HttpAddRequestHeaders), HttpOpenRequestA (HttpOpenRequest), HttpSendRequestA (HttpSendRequest), InternetCloseHandle, InternetConnectA (InternetConnect), InternetOpenA (InternetOpen), InternetReadFile

Download:

Download des Beispielprojektes [3,18 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Textfeld "txtFile"
' Steuerelement: Textfeld "txtUrl"
' Steuerelement: Textfeld "txtServer"
' Steuerelement: Schaltfläche "Command2"
' Steuerelement: Beschriftungsfeld "Label4"
' Steuerelement: Beschriftungsfeld "Label3"
' Steuerelement: Beschriftungsfeld "Label2"
' Steuerelement: Beschriftungsfeld "Label1"
' von Peter Molnar (peter.molnar@wm.sk)
'
' Auf dem Server wird noch ein Script
' zum empfangen der Dateien benötigt.
' Hier ein kleines PHP-Script:
'
' <?
' echo "-[$variable1]-[$variable2]-".is_uploaded_file($datei)."-";
' copy ($HTTP_POST_FILES['datei']['tmp_name'],"c:/temp/test.gif");
' ?>



Private Declare Function InternetOpen Lib "wininet.dll" _
    Alias "InternetOpenA" _
    (ByVal lpszCallerName As String, _
    ByVal dwAccessType As Long, _
    ByVal lpszProxyName As String, _
    ByVal lpszProxyBypass As String, _
    ByVal dwFlags As Long) As Long

Private Declare Function InternetConnect Lib "wininet.dll" _
    Alias "InternetConnectA" _
    (ByVal hInternetSession As Long, _
    ByVal lpszServerName As String, _
    ByVal nProxyPort As Integer, _
    ByVal lpszUsername As String, _
    ByVal lpszPassword As String, _
    ByVal dwService As Long, _
    ByVal dwFlags As Long, _
    ByVal dwContext As Long) As Long

Private Declare Function InternetReadFile Lib "wininet.dll" _
    (ByVal hFile As Long, _
    ByVal sBuffer As String, _
    ByVal lNumBytesToRead As Long, _
    lNumberOfBytesRead As Long) As Integer

Private Declare Function HttpOpenRequest Lib "wininet.dll" _
    Alias "HttpOpenRequestA" _
    (ByVal hInternetSession As Long, _
    ByVal lpszVerb As String, _
    ByVal lpszObjectName As String, _
    ByVal lpszVersion As String, _
    ByVal lpszReferer As String, _
    ByVal lpszAcceptTypes As Long, _
    ByVal dwFlags As Long, _
    ByVal dwContext As Long) As Long

Private 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 Boolean

Private Declare Function InternetCloseHandle Lib "wininet.dll" _
    (ByVal hInternetHandle As Long) As Boolean

Private Declare Function HttpAddRequestHeaders Lib "wininet.dll" _
    Alias "HttpAddRequestHeadersA" _
    (ByVal hHttpRequest As Long, _
    ByVal sHeaders As String, _
    ByVal lHeadersLength As Long, _
    ByVal lModifiers As Long) As Integer

Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Private Const INTERNET_SERVICE_HTTP = 3
Private Const INTERNET_DEFAULT_HTTP_PORT = 80
Private Const INTERNET_FLAG_RELOAD = &H80000000
Private Const HTTP_ADDREQ_FLAG_ADD = &H20000000
Private Const HTTP_ADDREQ_FLAG_REPLACE = &H80000000


' Gibt TRUE zuruck wenn die datei erfolgreich gepostet wurde.
' Anderenfalls gibt FALSE zuruck.
' Die antwort des skripts wird in ptrResult geschrieben.
' Beispiel: c:\autoexec.bat ans Skript http://www.dom.de/uploadPic.php schicken:
' httpPostFile("www.dom.de","/uploadPic.php","c:\autoexec.bat",result$)

Private Function httpPostFile(server$, url$, file$, ByRef ptrResult$) As Boolean

Dim hInternetOpen&, hInternetConnect&, hHttpOpenRequest&, lNumberOfBytesRead&
Dim bRet As Boolean, bDoLoop As Boolean
Dim sReadBuffer As String * 2048, sPostData$
Dim nFile%

On Error Goto errorLabel

hInternetOpen = 0
hInternetConnect = 0
hHttpOpenRequest = 0

hInternetOpen = InternetOpen(App.EXEName, INTERNET_OPEN_TYPE_PRECONFIG, _
    vbNullString, vbNullString, 0)

If hInternetOpen = 0 Then Goto errorLabel

hInternetConnect = InternetConnect(hInternetOpen, server, INTERNET_DEFAULT_HTTP_PORT, _
    vbNullString, "HTTP/1.0", INTERNET_SERVICE_HTTP, 0, 0)

If hInternetConnect = 0 Then Goto errorLabel

hHttpOpenRequest = HttpOpenRequest(hInternetConnect, "POST", url, "HTTP/1.0", _
    vbNullString, 0, INTERNET_FLAG_RELOAD, 0)

If hHttpOpenRequest = 0 Then Goto errorLabel

sHeader = "Content-Type: multipart/form-data, boundary=AaB03x" & vbCrLf
bRet = HttpAddRequestHeaders(hHttpOpenRequest, sHeader, Len(sHeader), _
    HTTP_ADDREQ_FLAG_REPLACE Or HTTP_ADDREQ_FLAG_ADD)

'Datei zum posten in einen string lesen
nFile = FreeFile
Open file For Binary As #nFile
    sPostData = String(LOF(nFile), " ")
    Get #nFile, , sPostData
Close #nFile

'Die datei posten
sPostData = _
"--AaB03x" & vbCrLf & _
"Content-Disposition: form-data; name=""datei""; filename=""" & file & """" & vbCrLf & _
"Content-Transfer-Encoding: binary" & vbCrLf & _
"Content-Type: application/octet-stream" & vbCrLf & vbCrLf & _
sPostData & vbCrLf

'Noch zwei andere variablen posten
sPostData = sPostData & _
"--AaB03x" & vbCrLf & _
"Content-Disposition: form-data; name=""variable1""" & vbCrLf & vbCrLf & _
"meine variable numero uno" & vbCrLf & _
"--AaB03x" & vbCrLf & _
"Content-Disposition: form-data; name=""variable2""" & vbCrLf & vbCrLf & _
"meine variable zwei" & vbCrLf & _
"--AaB03x--"

bRet = HttpSendRequest(hHttpOpenRequest, vbNullString, 0, sPostData, Len(sPostData))

ptrResult = ""

Do
    sReadBuffer = vbNullString
    bDoLoop = InternetReadFile(hHttpOpenRequest, sReadBuffer, Len(sReadBuffer), lNumberOfBytesRead)
    ptrResult = ptrResult & Left(sReadBuffer, lNumberOfBytesRead)
    If Not CBool(lNumberOfBytesRead) Or Not bDoLoop Then Exit Do
Loop

httpPostFile = True
Goto closeHandles

errorLabel:
httpPostFile = False

closeHandles:

If hInternetOpen <> 0 Then InternetCloseHandle hInternetOpen
If hInternetConnect <> 0 Then InternetCloseHandle hInternetConnect
If hHttpOpenRequest <> 0 Then InternetCloseHandle hHttpOpenRequest
End Function

Private Sub Command2_Click()
Dim strResult As String
httpPostFile txtServer.Text, txtUrl.Text, txtFile.Text, strResult
MsgBox strResult
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 16 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.

Kommentar von Berthold am 01.05.2009 um 15:52

Gibts dies Funktion auch irgendwie mit der winsock/?

Kommentar von Berthoold am 01.05.2009 um 14:53

Wie kann man den Code so ändern dass er
1.) mit Benutzeanmeldung an ein fertiges anderes PHP Script funktioniert,
2.) mit Fortschrittsanzeige funktioniert.
antwort entweder hier oder per E-Mail

Kommentar von Thomas am 20.09.2008 um 00:56

ich soll ein Image (Bitmap) auf einene Server laden (ohne webBrowser) das ganze soll unter vbscript laufen. ist dies mit diesen Routinene möglich, wenn ja, wie ?

ich bin ein absolute beginner, was Vb betrifft, habe vb6 als Compiler, falls einen DLL zu erstellen wäre (wovonich auch keien Ahnung habe)

bitte hilfe, danke.

Kommentar von Manlio am 11.04.2007 um 13:51

Hello guys,

I tried this very nice code, but I receive this error: "406 Not Acceptable".

Do you have any suggestion?

Thank you! Manlio

Kommentar von gabriel am 03.04.2007 um 00:33

do you have any solution that make your project work
with php files ??

you made vary good program and it works vary good with asp files
if you have somthink work with php file it will be
perfect any way it is vary vary good program.
thank you

Kommentar von s2k am 09.03.2007 um 21:41

Funktioniert super, allerdings reagiert VB während des Uploadvorgangs leider nicht? Ein DoEvents in der Schleife hat mich auch nicht weiter gebracht. Lässt sich dies irgendwie beheben?
Und was mich auch interessieren würde, wäre, ob es eine Möglichkeit gibt, eine Progress-Bar anzuzeigen, die den Fortschritt des Uploads anzeigt.

Gruß,
s2k

Kommentar von Adam am 06.01.2007 um 16:36

Hallo,
mit VB6 läuft es ja wudnerbar, aber hat jemand eine Idee wie sowas unter .NET aussehen könnte?

viellen Dank schon mal im voraus.

Kommentar von Christian Engel am 21.12.2005 um 12:35

Dieses Script funktioniert mit allen Dateien:

<?
echo "-[$variable1]-[$variable2]-".is_uploaded_file($datei)."-";
copy ($HTTP_POST_FILES['datei']['tmp_name'],$variable1);
?>


Allerdings müssen die mitgeposteten Variablen dazu verändert werden. Variable1 muss den kompletten Pfad + Dateinamen der Datei auf der Festplatte enthalten.

Kommentar von Sebastian Steiner am 24.04.2005 um 21:10

Hallo,

<?
echo "-[$variable1]-[$variable2]-".is_uploaded_file($datei)."-";
copy ($HTTP_POST_FILES['datei']['tmp_name'],"c:/temp/test.gif");
?>

bei mir klappt anscheinend das PHP Script nicht. Ich habe es genauso als script.php gespeichert und geuploadet. (Der Webspace ist PHP-fähig.) Da kommt nur ein Fehler in strResult. Ich frage mich allerdings auch, wofür diese GIF-Datei darin steht. Ich möchte eine andere Datei, die im VB-Programm angegebene, hochladen.
Naja, vielleicht könnte mir ja jemand ein funktionstüchtiges Script per Mail zusenden: sebastian_steiner@gmx.de

Vielen Dank im Voraus und viele Grüße!
Sebastian

Kommentar von Yves Rösener am 25.03.2004 um 10:46

Ok womit genau kommst du nicht klar ???

Wenn du kein PHP hast gucke mal ob du cgi (perl) Scripte installieren kannst, denn das geht dann auch !!!

Gruß Yves

http://www.yves-roesener.de

Kommentar von Ng am 21.03.2004 um 18:49

Noch ne Frage giebt es auch ein nicht PHP Script dafür auf meinemm webserver ist kein php installiert....
nochmal thx
Mail@Nilsg.org

Kommentar von Ng am 21.03.2004 um 14:53

Hallo, Kann mir jemand bei dem Script helfen oder hat schon eins ich komm damit überhauptnich zurande
thx
Mail@Nilsg.org

Kommentar von MDM am 30.10.2003 um 10:53

Kann mir vieleicht jemand über e-mail das script zusenden?

Kommentar von Thomas am 08.10.2003 um 19:38

keine Ahnung aber läuft (XP, VB6):
sPostData = _
"--AaB03x" & vbCrLf & _
"Content-Disposition: form-data; name=""datei""; filename=""" & file _
& """" & vbCrLf & _
"Content-Transfer-Encoding: binary " & vbCrLf & vbCrLf & _
sPostData & vbCrLf

Kommentar von Jens am 01.08.2003 um 10:41

Es liegt am script - probier' statt "userfile" mal "datei"!

Allerding hängt ermir immer einen Teil des Headers vor die Datei - und zwar:
ntent-Type: application/octet-stream

Hat jemand eine Idee?

Kommentar von Yves Rösener am 31.01.2003 um 13:10

Hallo Peter Molnar,

also bei mir klappt es weder unter W2K noch unter WXP. Nun vielleicht liegt das auch an me8inem PHP Script, falls du es dir ansehen willst
http://www.haldensleben.de/tester/fileupload/upload.php
vieleciht fällt dir auf, das nur der NAme definiert wird, der Datei nur leider habe ich in deinem SourceCode allein Probleme mit den erweiterten Variablen. Bei meinem Script wird nur der Dateiname abgefragt 'userfile'.

Vielleicht kann mir jemand helfen ???

Danke im voraus

Yves