Discussion :

[Webselect]

Je suis en train de faire un programme pour envoyer automatiquement un fichier par protocol http. Je ne veux pas prendre ftp. Avec un browser web normal je suis capable : http://autoconsignation.com/testupload/default.asp

Mais avec mon programme je ne réussi pas dutout.
Quelqu'un peux m'aider.
Merci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
 
Public Sub EnvoyerPhoto(ByRef objForm As Form)
    Dim strImage As String
    Dim strUrl As String
    Dim strHtml As String
 
    strImage = "C:\web\AutoConsignation\Photo\M1301-1.jpg"
    strUrl = "http://autoconsignation.com/testupload/getfile.asp?fichier=" & strImage
 
 
    Dim objXMLHTTP As MSXML.XMLHttpRequest
 
    Set objXMLHTTP = CreateObject("Microsoft.XMLHTTP")
    objXMLHTTP.Open "POST", strUrl, False
    objXMLHTTP.setRequestHeader "enctype", "multipart/form-data"
 
    objXMLHTTP.send
    strHtml = objXMLHTTP.responseText
    Set objXMLHTTP = Nothing
 
 
 
    Response strUrl, objForm.Text1
    WriteInFile "essai.html", strHtml
 
End Sub

[Chad11]

Uhh quelle méthode HTTP utilisera tu? POST ou GET ?

[Webselect]

Uhh quelle méthode HTTP utilisera tu? POST ou GET ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

objXMLHTTP.Open "POST", strUrl, False

[Webselect]

Toujours pas trouvé

[Webselect]

Voici ce que j'ai trouver et ca fonctionne

Me reste juste a le rendre optimal(il ya aucune variable de déclarer :S)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
'******************* upload - begin
'Upload file using input type=file
Sub UploadFichier(DestURL, FileName, FieldName)
  'Boundary of fields.
  'Be sure this string is Not In the source file
  Const Boundary = "---------------------------0123456789012"
 
  Dim FileContents, FormData
  'Get source file As a binary data.
  FileContents = GetFile(FileName)
 
  'Build multipart/form-data document
  FormData = BuildFormData(FileContents, Boundary, FileName, FieldName)
 
  'Post the data To the destination URL
  WinHTTPPostRequest DestURL, FormData, Boundary
End Sub
 
'Build multipart/form-data document with file contents And header info
Function BuildFormData(FileContents, Boundary, FileName, FieldName)
  Dim FormData, Pre, Po
  Const ContentType = "application/upload"
 
  'The two parts around file contents In the multipart-form data.
  Pre = "--" + Boundary + vbCrLf + mpFields(FieldName, FileName, ContentType)
  Po = vbCrLf + "--" + Boundary + "--" + vbCrLf
 
  'Build form data using recordset binary field
  Const adLongVarBinary = 205
  Dim RS: Set RS = CreateObject("ADODB.Recordset")
  RS.Fields.Append "b", adLongVarBinary, Len(Pre) + LenB(FileContents) + Len(Po)
  RS.Open
  RS.AddNew
    Dim LenData
    'Convert Pre string value To a binary data
    LenData = Len(Pre)
    RS("b").AppendChunk (StringToMB(Pre) & ChrB(0))
    Pre = RS("b").GetChunk(LenData)
    RS("b") = ""
 
    'Convert Po string value To a binary data
    LenData = Len(Po)
    RS("b").AppendChunk (StringToMB(Po) & ChrB(0))
    Po = RS("b").GetChunk(LenData)
    RS("b") = ""
 
    'Join Pre + FileContents + Po binary data
    RS("b").AppendChunk (Pre)
    RS("b").AppendChunk (FileContents)
    RS("b").AppendChunk (Po)
  RS.Update
  FormData = RS("b")
  RS.Close
  BuildFormData = FormData
End Function
 
 
 
'sends multipart/form-data To the URL using WinHttprequest/XMLHTTP
'FormData - binary (VT_UI1 | VT_ARRAY) multipart form data
Function WinHTTPPostRequest(URL, FormData, Boundary)
  Dim http 'As New MSXML2.XMLHTTP
 
  'Create XMLHTTP/ServerXMLHTTP/WinHttprequest object
  Set http = CreateObject("Microsoft.XMLHTTP")
 
  'Open URL As POST request
  http.Open "POST", URL, False
 
  'Set Content-Type header
  http.setRequestHeader "Content-Type", "multipart/form-data; boundary=" + Boundary
 
  'Send the form data To URL As POST binary request
  http.send FormData
 
  'Get a result of the script which has received upload
  WinHTTPPostRequest = http.responseText
End Function
 
'Infrormations In form field header.
Function mpFields(FieldName, FileName, ContentType)
  Dim MPTemplate 'template For multipart header
  MPTemplate = "Content-Disposition: form-data; name=""{field}"";" + _
   " filename=""{file}""" + vbCrLf + _
   "Content-Type: {ct}" + vbCrLf + vbCrLf
  Dim Out
  Out = Replace(MPTemplate, "{field}", FieldName)
  Out = Replace(Out, "{file}", FileName)
  mpFields = Replace(Out, "{ct}", ContentType)
End Function
 
 
Sub Wait(Seconds, Message)
  On Error Resume Next
  CreateObject("wscript.shell").Popup Message, Seconds, "", 64
End Sub
 
 
'Returns file contents As a binary data
Function GetFile(FileName)
  Dim Stream: Set Stream = CreateObject("ADODB.Stream")
  Stream.Type = 1 'Binary
  Stream.Open
  Stream.LoadFromFile FileName
  GetFile = Stream.Read
  Stream.Close
End Function
 
'Converts OLE string To multibyte string
Function StringToMB(S)
  Dim I, B
  For I = 1 To Len(S)
    B = B & ChrB(Asc(Mid(S, I, 1)))
  Next
  StringToMB = B
End Function
'******************* upload - end
 
'******************* Support
'Basic script info
Sub InfoEcho()
  Dim Msg
  Msg = Msg + "Upload file using http And multipart/form-data" & vbCrLf
  Msg = Msg + "Copyright (C) 2001 Antonin Foller, PSTRUH Software" & vbCrLf
  Msg = Msg + "use" & vbCrLf
  Msg = Msg + "[cscript|wscript] fupload.vbs file url [fieldname]" & vbCrLf
  Msg = Msg + "  file ... Local file To upload" & vbCrLf
  Msg = Msg + "  url ... URL which can accept uploaded data" & vbCrLf
  Msg = Msg + "  fieldname ... Name of the source form field." & vbCrLf
  Msg = Msg + vbCrLf + CheckRequirements
  WScript.Echo Msg
  WScript.Quit
End Sub
 
'Checks If all of required objects are installed
Function CheckRequirements()
  Dim Msg
  Msg = "This script requires some objects installed To run properly." & vbCrLf
  Msg = Msg & CheckOneObject("ADODB.Recordset")
  Msg = Msg & CheckOneObject("ADODB.Stream")
  Msg = Msg & CheckOneObject("InternetExplorer.Application")
  CheckRequirements = Msg
'  MsgBox Msg
End Function
 
'Checks If the one object is installed.
Function CheckOneObject(oClass)
  Dim Msg
  On Error Resume Next
  CreateObject oClass
  If Err = 0 Then Msg = "OK" Else Msg = "Error:" & Err.Description
  CheckOneObject = oClass & " - " & Msg & vbCrLf
End Function
'******************* Support - end

[morgan_fr]

Bjr, j'ai pas compris la variable fieldName et à koi ca sert
eske vous pouvez m'expliquer svp?