Parsi Coders

نسخه‌ی کامل: سورس کد دانلود فایل
شما در حال مشاهده نسخه آرشیو هستید. برای مشاهده نسخه کامل کلیک کنید.
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
(10-14-2011، 11:38 AM)'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

سلام
یه توضیحات مختصری هم میدادید عالی میشد