WinHTTP Profis

  • #1
S

Swacken

Neues Mitglied
Themenersteller
Dabei seit
07.12.2005
Beiträge
3
Reaktionspunkte
0
:'(

Ich hoffe einer von euch kann mir vielleicht helfen.

Denn ich möchte bzw. mus ein Script ( VBS ) entwickeln welches eine HTTP verbindung erstellt und von dort die Delta Files ( Delta Files = nur die Files die sich via letztem mal geändert haben  ) runter läd.

Klar werden hierbei noch einige Features hinzukommen welches aber leichtere Sachen sind wie z. B.  Log-Files vom Download erstellen oder einen Proxy vorgeben.

Meine Frage zielt eigentlich mehr darauf ab, ob jemand von euch schon Erfahrung mit dem Befehl WinHTTP gemacht welches aber dann nur Deltas runterläd. Sprich ich bräuchte noch einen Befehl welcher das Object z.B. anhand der Erstellungszeit vergleicht.

Ich würde mich sehr über Musterbeispiele freuen.

Wichtig ist aber das ich mit WinHTTP arbeitet, da es der neuere Microsoft Befehl ist und auch in Zukunft noch auf den Systemen zur verfügung stehen wird, daher versuche ich ja auch von dem XMLHTTP Befehl weg zu kommen.

Und noch ein bisschen Background wissen für euch:

Das Script soll für den Virenscanner zum Einsatz kommen.
Hierbei möchte ich das Script über einen Zeitgesteuerten Task mehrmals am Tag laufen lassen.
Im Hinterground soll dann ständig die Scan_Engines überprüft bzw. verglichen werden und bei einer neueren Version gleich herrunter geladen werden.

Hier noch die URL meiner begierde:


Danke an alle die sich jetzt schon den Kopf zerprechen.  ;)





Hier habe ich schon einmal eine kleine Basis gefunden mit dem ich in der Lage bin URL's in einem Ordner vor zu definieren und das Script mir die kompletten Files automatisch beim Shutdown downloaded.

Option Explicit

If MsgBox(This script will run until system shutdown downloading dropped URLs. Okay to continue?, vbYesNo) = vbYes Then
    Main
End If

Sub Main
Dim strUrlPath, strUrl, strFilePath, strFile
Dim fils, fil, fs, ts
Const ForReading = 1
   ->Create objects
    Set fs = CreateObject(Scripting.FileSystemObject)
   ->Get the directory name where the user will drop internet shortcuts
    strUrlPath = BrowseForFolder(Where will you drop the URLs?)
    If strUrlPath = Then Exit Sub
    If Not fs.FolderExists(strUrlPath) Then Exit Sub
   ->Get the directory name where we should store downloaded files
    strFilePath = BrowseForFolder(Where should I store the files?)
    If strFilePath = Then Exit Sub
    If Not fs.FolderExists(strFilePath) Then Exit Sub
   ->Let WSCRIPT users know we didn't just go away
    CreateObject(WScript.Shell).Popup Program is running!, 5
    Set fils = fs.GetFolder(strUrlPath).Files
    Do
        For Each fil In fils
            If Lcase(Right(fil.Path, 4)) = .url Then
                Set ts = fs.OpenTextFile(fil.Path, ForReading)
                strUrl = ts.ReadAll
                ts.Close
                If InStr(strUrl, ) <> 0 Then
                    strUrl = Mid(strUrl, InStr(strUrl, ))
                    If InStr(strUrl, vbCr) <> 0 Then
                        strUrl = Left(strUrl, InStr(strUrl, vbCr) - 1)
                    End If
                    If InStr(strUrl, vbLf) <> 0 Then
                        strUrl = Left(strUrl, InStr(strUrl, vbLf) - 1)
                    End If
                    strFile = Mid(strUrl, InStrRev(strUrl, /) + 1)
                    Status strFile
                    If SaveWebBinary(strUrl, fs.BuildPath(strFilePath, strFile)) Then
                        Status .... Done! & vbCrLf
                        fs.DeleteFile fil.Path
                    Else
                        Status .... FAILED & vbCrLf
                    End If
                End If
            End If
        Next
        Wscript.Sleep 5000
    Loop
End Sub

Sub Status (strMessage)
'If the program was run with CSCRIPT, this writes a
'line into the DOS box. If run with WSCRIPT, it does nothing.
    If Lcase(Right(Wscript.FullName, 12)) = \cscript.exe Then
        Wscript.Echo strMessage
    End If
End Sub

Function SaveWebBinary(strUrl, strFile)->As Boolean
Const adTypeBinary = 1
Const adSaveCreateOverWrite = 2
Const ForWriting = 2
Dim web, varByteArray, strData, strBuffer, lngCounter, ado
    On Error Resume Next
   ->Download the file with any available object
    Err.Clear
    Set web = Nothing
    Set web = CreateObject(WinHttp.WinHttpRequest.5.1)
    If web Is Nothing Then Set web = CreateObject(WinHttp.WinHttpRequest)
    If web Is Nothing Then Set web = CreateObject(MSXML2.ServerXMLHTTP)
    If web Is Nothing Then Set web = CreateObject(Microsoft.XMLHTTP)
    web.Open GET, strURL, False
    web.Send
    If Err.Number <> 0 Then
        SaveWebBinary = False
        Set web = Nothing
        Exit Function
    End If
    If web.Status <> 200 Then
        SaveWebBinary = False
        Set web = Nothing
        Exit Function
    End If
    varByteArray = web.ResponseBody
    Set web = Nothing
   ->Now save the file with any available method
    On Error Resume Next
    Set ado = Nothing
    Set ado = CreateObject(ADODB.Stream)
    If ado Is Nothing Then
        Set fs = CreateObject(Scripting.FileSystemObject)
        Set ts = fs.OpenTextFile(strFile, ForWriting, True)
        strData =
        strBuffer =
        For lngCounter = 0 to UBound(varByteArray)
            ts.Write Chr(255 And Ascb(Midb(varByteArray,lngCounter + 1, 1)))
        Next
        ts.Close
    Else
        ado.Type = adTypeBinary
        ado_Open
        ado.Write varByteArray
        ado.SaveToFile strFile, adSaveCreateOverWrite
        ado.Close
    End If
    SaveWebBinary = True
End Function

Function BrowseForFolder(strPrompt)
'Uses the Shell.Application (only present in Win98 and newer)
'to bring up a file/folder selection window. Falls back to an
'ugly input box under Win95.
'Shell32.ShellSpecialFolderConstants
Const ssfPERSONAL = 5->My Documents
Const ssfDRIVES = 17->My Computer
Const SFVVO_SHOWALLOBJECTS = 1
Const SFVVO_SHOWEXTENSIONS = 2
    Dim sh, fol, fs, lngView, strPath
    Set sh = CreateObject(Shell.Application)
    If Instr(TypeName(sh), Shell) = 0 Then
    BrowseForFolder = InputBox(strPrompt, Select Folder, CreateObject(Scripting.FileSystemObject).GetParentFolderName(WScript.ScriptFullName))
    Exit Function
    End If
    Set fs = CreateObject(Scripting.FileSystemObject)
    lngView = SFVVO_SHOWALLOBJECTS Or SFVVO_SHOWEXTENSIONS
    strPath =
    Set fol = sh.BrowseForFolder(&0, strPrompt, lngView, ssfDRIVES)
    Err.Clear
    On Error Resume Next
    strPath = fol.ParentFolder.ParseName(fol.Title).Path
   ->An error occurs if the user selects a drive instead of a folder
    If Err.Number <> 0 Then
        BrowseForFolder = Left(Right(fol.Title, 3), 2) & \
    Else
        BrowseForFolder = strPath
    End If
End Function
 
  • #2
Hoi ich habe mich jetzt gerade auch mal über eine andere Variante hergemacht,
aber irgendwie bin ich doch wieder auf den XMLHTTP-Befehl zurück gekommen 

Hat von euch einer eine Idee

Hier mein neustes Beispiel mit alle Funktionen drinnen die ich benötige um das Delta-File ausfindig zu machen und auch gleich runter geladen wird.

Es ist aber auch ein bisschen Java mit eingeflossen

( FYI )


<job>
    <runtime>
    </runtime>
    <script language=JScript>
function getTimeZoneOffset()
{
    return -(new Date()).getTimezoneOffset();
}   
    </script>
    <script language=VBScript>
Option Explicit

Dim URL : URL = WScript.Arguments(0)
Dim OutputFilePath : OutputFilePath = WScript.Arguments(1)

Dim FSO : Set FSO = CreateObject(Scripting.FileSystemObject)

Dim HTTP : Set HTTP = CreateObject(Microsoft.XMLHTTP)
Dim LastModifiedTime

' Get the header information

If FSO.FileExists(OutputFilePath) Then

    HTTP.open HEAD, URL, False
    HTTP.send

   -> Did everything go ok? If not, stop.

    If HTTP.status <> 200 Then
        Fatal HTTP.status & & HTTP.statusText
    End If   

    LastModifiedTime = HTTP.getResponseHeader(Last-Modified)
    LastModifiedTime = ParseWebTimeToLocalTime (LastModifiedTime)
    Echo Remote file time: & LastModifiedTime

    Dim OutputFile : Set OutputFile = FSO.GetFile(OutputFilePath)
    Echo Local file time : & OutputFile.DateLastModified
   
    If OutputFile.DateLastModified >= LastModifiedTime Then
       
        Echo Local file is up to date or more recent.
        WScript.Quit 1
   
    End If
   
End If

Echo Downloading & URL

HTTP.Open GET, URL, False
HTTP.Send

Dim Content
Content = HTTP.ResponseBody
If Err.Number <> 0 Or HTTP.Status <> 200 Then
    Fatal HTTP.status & & HTTP.statusText
End If

LastModifiedTime = HTTP.getResponseHeader(Last-Modified)
LastModifiedTime = ParseWebTimeToLocalTime (LastModifiedTime)

Set HTTP = Nothing

Dim Stream
Set Stream = CreateObject(ADODB.Stream)
Stream.Type = 1-> Binary
Stream.Open
Stream.Write Content
Stream.SaveToFile OutputFilePath, 2
Set Stream = Nothing

Touch OutputFilePath, LastModifiedTime

Echo Downloaded ( & LastModifiedTime & )

Sub Fatal(ByVal Message)

    Echo Message
    WScript.Quit -1

End Sub

Function ParseWebTimeToLocalTime(WebTimeString)

    ParseWebTimeToLocalTime = DateAdd(n, getTimeZoneOffset(), ParseWebTime(WebTimeString))

End Function

Function ParseWebTime(WebTimeString)

   -> DOW, DD MMM YYYY HH:MM:SS GMT
   ->
   -> DOW   = Day of week (e.g. Mon, Tue, Wed, etc.)
   -> DD    = Two digit day
   -> MMM   = 3 letter name of month (e.g. Jan, Fed, Mar, etc.)
   -> YYYY  = Four digit year
   -> HH    = Two digit hour
   -> HH    = Two digit month
   -> HH    = Two digit seconds
   
    Dim OldLocale : OldLocale = SetLocale(en-US)
    Dim Day : Day = CInt(Mid(WebTimeString, 6, 2))
    Dim Month : Month = Mid(WebTimeString, 9, 3)
    Month = ((InStr(JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC, UCase(Month)) - 1) / 4) + 1
    Dim Year : Year = CInt(Mid(WebTimeString, 13, 4))
    Dim Time : Time = CDate(Mid(WebTimeString, 18, 8))
    SetLocale(OldLocale)
    ParseWebTime = DateSerial(Year, Month, Day) + TimeValue(Time)
   
End Function

Sub Touch(Path, NewDate)
       
    Path = FSO.GetAbsolutePathName(Path)
    Dim LastSlashIndex : LastSlashIndex = Len(Path) - InStr(StrReverse(Path), \)
   
    Dim FolderPath : FolderPath = Mid(Path, 1, LastSlashIndex)
    Dim FileName : FileName = Mid(Path, LastSlashIndex + 2)
             
    Dim App : Set App = CreateObject(Shell.Application)
    Dim Folder : Set Folder = App.NameSpace(FolderPath)
    Dim File : Set File = Folder.ParseName(FileName)
     
    File.ModifyDate = NewDate

End Sub

Sub Echo(ByVal Text)

    WScript.StdOut.WriteLine(Text)
   
End Sub
    </script>
</job>
 
  • #3
Meine Frage zielt eigentlich mehr darauf ab, ob jemand von euch schon Erfahrung mit dem Befehl WinHTTP gemacht welches aber dann nur Deltas runterläd.
Du hast es wohl inzwischen gemerkt. Diese Befehle senden nur HTTP-Requests und werten die Responses aus.
Lies Dir mal diese Beschreibung von HTTP durch, damit Du besser verstehst, was da abgeht:


..aber irgendwie bin ich doch wieder auf den XMLHTTP-Befehl zurück gekommen
Mit WinHTTP

kannst Du ebenfalls mit der GetResponseHeader-Methode auf Response-Header zugreifen:


Es ist aber auch ein bisschen Java mit eingeflossen
JScript ist die Schwestersprache von VBS. Beide werden vom Windows Script Host ausgeführt. Was ihre Möglichkeiten angeht, Dinge mit CreateObject einzubinden, sind beide vollkommen identisch. Sie unterscheiden sich dort nur in der Syntax. Mit Java hat JScript gar nichts zu tun.
 
  • #4
Mercy,
bin schon am studieren der Seiten.

Wobei ich die MSDN Seite eh schon immer als Grundlage her nehmen.

:)
 
Thema:

WinHTTP Profis

ANGEBOTE & SPONSOREN

Statistik des Forums

Themen
113.840
Beiträge
707.967
Mitglieder
51.494
Neuestes Mitglied
Flensburg45
Oben