[Amin_Mansouri]

downlaod source code download File Vb6

در سورس زیر یاد میگیرید که چطوری یک فایل رو دانلود کنید :

کد :

کد:

'// VBSCRIPT
Option Explicit

'// SETTINGS
Const sProgram = "VBS Downloader"
Const sRemote  = "http://www.somewebsite.com/myFile.zip"
Const sLocal   = "c:\myFile.zip"

'// TEST SCRIPT
Call Download(sRemote, sLocal, True)

'// START DOWNLOAD
Sub Download(Src, Dest, Enabled)
    Dim sReturn
    sReturn = GetFile(Src, Dest, Enabled)
    MsgBox sReturn, vbOkOnly, sProgram
End Sub

'// DOWNWLOAD FILE
Function GetFile(Src, Dest, Enabled)
    Dim objHttp, Status, Text
    On Error Resume Next
    Set objHttp = CreateObject("Microsoft.XMLHTTP")
    objHttp.Open "GET", Src, False
    If Err = 0 Then
        If Enabled Then
            MsgBox "Downloading ..", vbOkOnly, sProgram
        End If
        objHttp.Send ""  
        Status = objHttp.Status
        Text = HTTPResponse(Status)
        If Status <> 200 Then  
            GetFile = "RESPONSE ERROR" & _
            vbCrLf & Status & ": " & Text
        Else      
        GetFile = PutFile(objHttp, Dest)
        End If            
    Else
        GetFile = "Download Error!" & _
        vbCrLf & Err.Description
    End If    
    Set objHttp = Nothing
End Function

'// WRITE TO LOCAL FILE
Function PutFile(objHttp, Dest)
    Dim objStream
    On Error Goto 0
    On Error Resume Next
    Set objStream = Createobject("Adodb.Stream")
        objStream.Type = 1
        objStream.Open
        objStream.Write objHttp.ResponseBody
        objStream.Savetofile Dest, 2
        objStream.Close
    Set objStream = Nothing
    If Err Then
        PutFile = "File Error!" & _
        vbCrLf & Err.Description
    Else
        PutFile = "Download Complete"
    End If
End Function
  
'// COPYRIGHT (C) 2006 RORYK
Function HTTPResponse(ByVal iCode)
    Dim tmp: Select Case iCode
        Case 200: tmp = "OK"
        Case 201: tmp = "CREATED"
        Case 202: tmp = "ACCEPTED"
        Case 203: tmp = "NON-AUTHORITATIVE INFORMATION"
        Case 204: tmp = "NO CONTENT"
        Case 205: tmp = "RESET CONTENT"
        Case 206: tmp = "PARTIAL CONTENT"
        Case 300: tmp = "MULTIPLE CHOICES"
        Case 301: tmp = "MOVED PERMANENTLY"
        Case 302: tmp = "FOUND"
        Case 303: tmp = "SEE OTHER"
        Case 304: tmp = "NOT MODIFIED"
        Case 305: tmp = "USE ......."
        Case 306: tmp = "UNUSED"
        Case 307: tmp = "TEMPORARY REDIRECT"
        Case 400: tmp = "BAD REQUEST"
        Case 401: tmp = "NAUTHORIZED"
        Case 402: tmp = "PAYMENT REQUIRED"
        Case 403: tmp = "FORBIDDEN"
        Case 404: tmp = "NOT FOUND"
        Case 405: tmp = "METHOD NOT ALLOWED"
        Case 406: tmp = "NOT ACCEPTABLE"
        Case 407: tmp = "....... AUTHENTICATION REQUIRED"
        Case 408: tmp = "REQUEST TIMEOUT"
        Case 409: tmp = "CONFLICT"
        Case 410: tmp = "GONE"
        Case 411: tmp = "LENGTH REQUIRED"
        Case 412: tmp = "PRECONDITION FAILED"
        Case 413: tmp = "REQUEST ENTITY TOO LARGE"
        Case 414: tmp = "REQUEST-URI TOO LONG"
        Case 415: tmp = "UNSUPPORTED MEDIA TYPE"
        Case 416: tmp = "REQUESTED RANGE NOT SATISFIABLE"
        Case 417: tmp = "EXPECTATION FAILED"
        Case 500: tmp = "INTERNAL SERVER ERROR"
        Case 501: tmp = "NOT IMPLEMENTED"
        Case 502: tmp = "BAD GATEWAY"
        Case 503: tmp = "SERVICE UNAVAILABLE"
        Case 504: tmp = "GATEWAY TIMEOUT"
        Case 505: tmp = "HTTP VERSION NOT SUPPORTED"
        Case 12000: tmp = "ERROR BASE"
        Case 12001: tmp = "OUT OF HANDLES"
        Case 12002: tmp = "TIMEOUT"
        Case 12003: tmp = "EXTENDED ERROR"
        Case 12004: tmp = "INTERNAL ERROR"
        Case 12005: tmp = "INVALID URL"
        Case 12006: tmp = "UNRECOGNIZED SCHEME"
        Case 12007: tmp = "NAME NOT RESOLVED"
        Case 12008: tmp = "PROTOCOL NOT FOUND"
        Case 12009: tmp = "INVALID OPTION"
        Case 12010: tmp = "BAD OPTION LENGTH"
        Case 12011: tmp = "OPTION NOT SETTABLE"
        Case 12012: tmp = "SHUTDOWN"
        Case 12013: tmp = "INCORRECT USER NAME"
        Case 12014: tmp = "INCORRECT PASSWORD"
        Case 12015: tmp = "LOGIN FAILURE"
        Case 12016: tmp = "INVALID OPERATION"
        Case 12017: tmp = "OPERATION CANCELLED"
        Case 12018: tmp = "INCORRECT HANDLE TYPE"
        Case 12019: tmp = "INCORRECT HANDLE STATE"
        Case 12020: tmp = "NOT ....... REQUEST"
        Case 12021: tmp = "REGISTRY VALUE NOT FOUND"
        Case 12022: tmp = "BAD REGISTRY PARAMETER"
        Case 12023: tmp = "NO DIRECT ACCESS"
        Case 12024: tmp = "NO CONTEXT"
        Case 12025: tmp = "NO CALLBACK"
        Case 12026: tmp = "REQUEST PENDING"
        Case 12027: tmp = "INCORRECT FORMAT"
        Case 12028: tmp = "ITEM NOT FOUND"
        Case 12029: tmp = "CANNOT CONNECT"
        Case 12030: tmp = "CONNECTION ABORTED"
        Case 12031: tmp = "CONNECTION RESET"
        Case 12032: tmp = "FORCE RETRY"
        Case 12033: tmp = "INVALID ....... REQUEST"
        Case 12034: tmp = "NEED UI"
        Case 12036: tmp = "HANDLE EXISTS"
        Case 12037: tmp = "SEC CERT DATE INVALID"
        Case 12038: tmp = "SEC CERT CN INVALID"
        Case 12039: tmp = "HTTP TO HTTPS ON REDIR"
        Case 12040: tmp = "HTTPS TO HTTP ON REDIR"
        Case 12041: tmp = "MIXED SECURITY"
        Case 12042: tmp = "CHG POST IS NON SECURE"
        Case 12043: tmp = "POST IS NON SECURE"
        Case 12044: tmp = "CLIENT AUTH CERT NEEDED"
        Case 12045: tmp = "INVALID CA"
        Case 12046: tmp = "CLIENT AUTH NOT SETUP"
        Case 12047: tmp = "ASYNC THREAD FAILED"
        Case 12048: tmp = "REDIRECT SCHEME CHANGE"
        Case 12049: tmp = "DIALOG PENDING"
        Case 12050: tmp = "RETRY DIALOG"
        Case 12052: tmp = "HTTPS HTTP SUBMIT REDIR"
        Case 12053: tmp = "INSERT CDROM"
        Case 12054: tmp = "FORTEZZA LOGIN NEEDED"
        Case 12055: tmp = "SEC CERT ERRORS"
        Case 12056: tmp = "SEC CERT NO REV"
        Case 12057: tmp = "SEC CERT REV FAILED"
        Case 12152: tmp = "ERROR HTTP INVALID SERVER RESPONSE"
        Case 12157: tmp = "SECURITY CHANNEL ERROR"
        Case 12158: tmp = "UNABLE TO CACHE FILE"
        Case 12159: tmp = "TCPIP NOT INSTALLED"
        Case 12163: tmp = "DISCONNECTED"
        Case 12164: tmp = "SERVER UNREACHABLE"
        Case 12165: tmp = "....... SERVER UNREACHABLE"
        Case 12166: tmp = "BAD AUTO ....... SCRIPT"
        Case 12167: tmp = "UNABLE TO DOWNLOAD SCRIPT"
        Case 12169: tmp = "SEC INVALID CERT"
        Case 12170: tmp = "SEC CERT REVOKED"
        Case Else: tmp = "UNKNOWN RESPONSE CODE"
    End Select: HTTPResponse = tmp
End Function