Ich rufe eine Funktion auf, die einen Post-Request eines HTML Formulares durchführen soll.
Das ganze funktioniert aber nur wenn man dies über einen Button von einem Formular aufruft.
Wenn ich dies automatisch z.b. über Form_Load starte wird die Seite nicht ausgeführt.
Hier ein Auszug aus meinem Code:
Aufruf: gpsdistance("datei.txt")
Beim Aufruf über form_load bleibt er immer im Code:
While Not blnConnected
DoEvents
Wend
hängen.
Hoffe es kann mir jemand weiterhelfen.
Das ganze funktioniert aber nur wenn man dies über einen Button von einem Formular aufruft.
Wenn ich dies automatisch z.b. über Form_Load starte wird die Seite nicht ausgeführt.
Hier ein Auszug aus meinem Code:
Aufruf: gpsdistance("datei.txt")
Quellcode
- Public Function gpsdistance(datei As String) As Double
- Dim strFile As String
- Dim strHttp As String
- Dim DestUrl As URL
- Dim intdisplay As Integer
- strdatei = Mid(datei, InStrRev(datei, "\", -1) + 1)
- strUrl = "http://www.gpsvisualizer.com/convert?output"
- strName = "uploaded_file_1"
- strname2 = "convert_add_distance"
- strMIMEType = "multipart/form-data"
- If blnConnected Then Exit Function
- ' check that a file was selected
- If datei = vbNullString Then
- MsgBox "No File Chosen", vbCritical, "ERROR"
- Exit Function
- End If
- ' extract the URL using a helper function
- DestUrl = ExtractUrl(strUrl)
- If DestUrl.Host = vbNullString Then
- MsgBox "Invalid Host", vbCritical, "ERROR"
- Exit Function
- End If
- ' clear the old response
- strResponse = ""
- ' read the file contents as a string
- ' N.B: in HTTP everything is a string, even binary files
- strFile = GetFileContents(datei)
- ' build the HTTP request
- strHttp = BuildFileUploadRequest2(strFile, DestUrl, strName, strdatei, strname2, strMIMEType)
- ' assign the protocol host and port
- Winsock1.Protocol = sckTCPProtocol
- Winsock1.RemoteHost = DestUrl.Host
- If DestUrl.Port <> 0 Then
- Winsock1.RemotePort = DestUrl.Port
- Else
- Winsock1.RemotePort = 80
- End If
- ' make the connection and send the HTTP request
- Winsock1.Connect
- While Not blnConnected
- DoEvents
- Wend
- strRequest = strHttp
- Clipboard.Clear
- Clipboard.SetText strHttp
- Winsock1.SendData strHttp
- While blnConnected
- DoEvents
- Wend
- 'Clipboard.SetText strResponse
- 'Debug.Print Len(strResponse)
- Dim intview As Integer
- Dim pfad As String
- intdisplay = InStr(1, strResponse, "display")
- If intdisplay > 0 Then
- pfad = "www.gpsvisualizer.com" & Mid(strResponse, intdisplay - 1, InStr(intdisplay, strResponse, ">") - intdisplay)
- gpsdistance = distance(pfad)
- ' gpslink = Mid(pfad, InStrRev(pfad, "/", -1))
- 'gpslink = "http://www.gpsvisualizer.com/display" & gpslink & " "
- Else
- gpsdistance = 0
- End If
- If blnConnected Then blnConnected = False
- End Function
Quellcode
- Private Function BuildFileUploadRequest2(ByRef strData As String, _
- ByRef DestUrl As URL, _
- ByVal UploadName As String, _
- ByVal FileName As String, _
- ByVal uploadname2 As String, _
- ByVal MimeType As String) As String
- Dim strHttp As String ' holds the entire HTTP request
- Dim strBoundary As String 'the boundary between each entity
- Dim strBody As String ' holds the body of the HTTP request
- Dim lngLength As Long ' the length of the HTTP request
- ' create a boundary consisting of a random string
- strBoundary = RandomAlphaNumString(32)
- wert1 = "convert_add_distance"
- wert2 = "true"
- ' create the body of the http request in the form
- '
- ' --boundary
- ' Content-Disposition: form-data; name="UploadName"; filename="FileName"
- ' Content-Type: MimeType
- '
- ' file data here
- '--boundary--
- strBody = "--" & strBoundary & vbCrLf
- strBody = strBody & "Content-Disposition: form-data; name=""" & wert1 & """" & vbCrLf & vbCrLf & " True "
- strBody = strBody & vbCrLf & "--" & strBoundary & vbCrLf
- strBody = strBody & "Content-Disposition: form-data; name=""" & UploadName & """; filename=""" & _
- FileName & """" & vbCrLf
- strBody = strBody & "Content-Type: " & MimeType & vbCrLf
- strBody = strBody & vbCrLf & strData
- strBody = strBody & vbCrLf & "--" & strBoundary & "--"
- 'strBody = strBody & "--" & strBoundary & vbCrLf
- lngLength = Len(strBody)
- ' construct the HTTP request in the form:
- '
- ' POST /path/to/reosurce HTTP/1.0
- ' Host: host
- ' Content-Type: multipart-form-data, boundary=boundary
- ' Content-Length: len(strbody)
- '
- ' HTTP request body
- strHttp = "POST " & DestUrl.URI & "?" & DestUrl.Query & " HTTP/1.0" & vbCrLf
- strHttp = strHttp & "Host: " & DestUrl.Host & vbCrLf
- strHttp = strHttp & "Content-Type: multipart/form-data, boundary=" & strBoundary & vbCrLf
- strHttp = strHttp & "Content-Length: " & lngLength & vbCrLf & vbCrLf
- strHttp = strHttp & strBody
- BuildFileUploadRequest2 = strHttp
- End Function
Beim Aufruf über form_load bleibt er immer im Code:
While Not blnConnected
DoEvents
Wend
hängen.
Hoffe es kann mir jemand weiterhelfen.
