загрузка файла на сервер по http

[quit]

привет ,
тут у меня появилась проблемка .. и надеюсь на вашу помощь ..
до того как появилась эта задача, заливка файла на сервер у меня была реализована через ftp , но сейчас по политике безопасности решили доступ через ftp убрать =(( и я сейчас в загоне .. (не могу сам)
написать скрипт на vbs для заливки через http
НАПИСАЛ СКРИПТ НА PHP для заливки на сайте..


и немного попробовал написать скрипт на vbs

Код: Выделить всё

Set objIE = CreateObject("InternetExplorer.Application")
objIE.Navigate "http://ссссс.ru/111.php"
objIE.Visible = True
While objIE.Busy
    WScript.Sleep 200
Wend
Set objForm = objIE.Document.forms(0)
objForm.elements("userfile").value = "c:\1.gif"
objForm.submit()
While objIE.Busy
    WScript.Sleep 200
Wend

set WshShell = Nothing

set objIE = Nothing

WScript.Quit(0)

что не так Я идиот! Убейте меня, кто-нибудь!
укажите на ошибку... либо у кого есть уже готовый релиз, покажите.

[Antonariy]

Уже вроде показывали.

[quit]

блин этот пример не катит ..
во первых , там реально класс выдачи ответа - что мне не надо ...
во вторых .. - я попробовал подставить свои значения - эээ толи лыжи не едут толи я е*** . второе = 1

плиззз помогите, киньте кости , я её об грызу... только без класса выдачи отчета .. он нах мне не нужен... мне тупа заливка на сервер по форме которая на рисунке сверху...


p.s/ буду ооооочень признателен .. войдите в мое положение..
залил форму и скрипт на сайт .. если что
http://mossur.ru/test/111.php
на всякий случай убрал права , что бы не залил что попало м не туда.. =)

[ALX_2002]

А собственно в чём проблема то ?

Код: Выделить всё


Option Explicit

Const cdlOFNExplorer = &H80000
Const cdlOFNFileMustExist = &H1000
Const cdlOFNHideReadOnly = &H4
Const cdlOFNPathMustExist = &H800

Dim CommonDialog
Set CommonDialog = CreateObject("UserAccounts.CommonDialog")
With CommonDialog
    .Flags = cdlOFNExplorer OR cdlOFNFileMustExist OR cdlOFNHideReadOnly OR cdlOFNPathMustExist
    .Filter = "Файлы изображений (*.bmp;*.gif;*.jpg;*.jpeg;*.png)|*.bmp;*.gif;*.jpg;*.jpeg;*.png"
    .ShowOpen 'Display dialog
End With

if CommonDialog.FileName = "" Then WScript.Quit

Dim WebForm
'/// Создаём новый класс формы
Set WebForm = New WebFormClass
'/// Указываем куда будем отправлять данные
WebForm.Action = "http://mossur.ru/test/111.php"
'/// Устанавливаем метод передачи POST
WebForm.Method = "POST"
'/// Для того чтобы передались файлы устанавливаем тип кодирования multipart/form-data
WebForm.Enctype = "multipart/form-data"
'/// Добавляем файл
WebForm.AddFile "file", CommonDialog.FileName
'/// Запускаем процедуру отправку     
Submit WebForm

Sub Submit(WebForm)
    '/// Создаём объект отправки данных
    Dim XMLHTTP
    Set XMLHTTP = CreateObject("MSXML2.XMLHTTP")
    '/// Открываем соединение с URL
    XMLHTTP.Open WebForm.Method, WebForm.Action, False
    '/// Если тип передачи данных POST, то добавляем к пакету заголовки
    If WebForm.Method = "POST" Then
        '/// Если отправляем с кодированием "multipart/form-data", то добавляем информацию о разделителе данных
        If WebForm.Enctype = "multipart/form-data" Then
            XMLHTTP.setrequestheader "Content-type", WebForm.Enctype & "; boundary=" & WebForm.Boundary
        Else '/// В ином случае добавляем информацию о том, что данные отправляются формой
            XMLHTTP.setrequestheader "Content-type", WebForm.Enctype
        End If
    End If
   
    '/// Отправляем запрос
    XMLHTTP.Send WebForm.VarBody
    '/// Смотрим статус ответа
    Select Case XMLHTTP.Status
    '/// Если 200 - OK. Данные переданы успешно
    Case 200
        MsgBox "Загрузка завершена",vbInformation
    Case Else
        MsgBox XMLHTTP.Status & " " & StatusText, vbCritical, "Ошибка при передаче данных !"
    End Select
End Sub


'/// Класс формы
Class WebFormClass
        Private Fields, Files
        Private PropertyEnctype, PropertyMethod, PropertyBoundary, PropertyAction

        Private Sub Class_Initialize()
            Fields = Array()
            Files = Array()
            PropertyEnctype = "application/x-www-form-urlencoded"
            PropertyMethod = "GET"
            PropertyBoundary = String(27, "-") & GenerateBoundary
            PropertyAction = "about:blank"
        End Sub

        Public Property Let Action(Value)
            PropertyAction = Value
        End Property

        Public Property Get Action()
            Action = PropertyAction
            If PropertyMethod = "GET" Then
                Dim Params
                Params = VarBody
                If VarBody <> "" Then Action = Action & "?" & Params
            End If
        End Property

        Public Property Get Boundary()
            Boundary = PropertyBoundary
        End Property

        Public Property Get Method()
            Method = PropertyMethod
        End Property

        Public Property Let Method(Value)
            Value = UCase(Value)
            If Value = "GET" Or Value = "POST" Then PropertyMethod = Value
        End Property

        Public Property Get Enctype()
            Enctype = PropertyEnctype
        End Property

        Public Property Let Enctype(Value)
            Value = LCase(Value)
            If Value = "multipart/form-data" Or Value = "application/x-www-form-urlencoded" Then PropertyEnctype = Value
        End Property

        Public Sub AddField(Name, Value)
            SetElement Fields, Name, Value
        End Sub

        Public Sub AddFile(Name, Value)
            SetElement Files, Name, Value
        End Sub

        Private Function SetElement(ArrayRef, Name, Value)
            Dim ElementID
            For ElementID = 0 To UBound(ArrayRef)
                If ArrayRef(ElementID)(0) = Name Then
                    ArrayRef(ElementID)(1) = Value
                    Exit Function
                End If
            Next
            ReDim Preserve ArrayRef(UBound(ArrayRef) + 1)
            ArrayRef(UBound(ArrayRef)) = Array(Name, Value)
        End Function
         

        Public Property Get VarBody()
            If PropertyMethod = "POST" And PropertyEnctype = "multipart/form-data" Then
                Const DefaultBoundary = "--"
                Dim Stream
                Set Stream = CreateObject("ADODB.Stream")
                Stream.Type = 2
                Stream.Mode = 3
                Stream.Charset = "Windows-1251"
                Stream.Open
               
                Dim Field,FieldHeader, FieldsBody
               
                For Each Field In Fields
                    FieldHeader = "Content-Disposition: form-data; name=""" & Field(0) & """"
                    FieldsBody = FieldsBody & DefaultBoundary & PropertyBoundary & vbCrLf & FieldHeader & vbCrLf & Field(1) & vbCrLf
                Next
               
                Stream.WriteText FieldsBody
               
                Dim File,FileHeader,Data
               
                For Each File In Files
                    If LoadFile(File(1), Data) Then
                        FileHeader = DefaultBoundary & Boundary & vbCrLf & "Content-Disposition: form-data; name=""" & File(0) & """; filename=""" & File(1) & """" & vbCrLf & "Content-Type: octet/stream" & vbCrLf & vbCrLf
                        Stream.WriteText FileHeader
                        Stream.Position = 0
                        Stream.Type = 1
                        Stream.Position = Stream.Size
                        Stream.write Data
                        Stream.Position = 0
                        Stream.Type = 2
                        Stream.Position = Stream.Size
                    End If
                Next
               
                Stream.Position = 0
                Stream.Type = 2
                Stream.Position = Stream.Size
                Stream.WriteText vbCrLf & DefaultBoundary & PropertyBoundary & DefaultBoundary
               
                Stream.Position = 0
                Stream.Type = 1
               
                VarBody = Stream.Read
            Else
                For Each Field In Fields
                    VarBody = VarBody & Escape(Field(0)) & "=" & Escape(Field(1)) & "&"
                Next
                For Each File In Files
                    VarBody = VarBody & Escape(File(0)) & "=" & Escape(File(1)) & "&"
                Next
                if Len(VarBody) > 0 Then VarBody = Left(VarBody, Len(VarBody) - 1)
            End If
        End Property

        Private Function LoadFile(Path, Data)
            On Error Resume Next
            Dim Stream
            Set Stream = CreateObject("ADODB.Stream")
            Stream.Type = 1
            Stream.Mode = 3
            Stream.Open
            Stream.LoadFromFile Path
            If Err.Number <> 0 Then Exit Function
            Data = Stream.Read
            LoadFile = True
        End Function

        Private Function GenerateBoundary()
            Dim Char
            Dim N
            For N = 1 To 12
                Randomize
                Char = Chr(CLng(Rnd * 25) + 97)
                If N Mod 2 Then Char = UCase(Char)
                GenerateBoundary = GenerateBoundary & Char
            Next
        End Function
End Class


[quit]

спасибо ALX_2002
благодаря ему , в голове появилась ясность ..
ещё раз спасибо !