(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