رتبه موضوع:
  • 26 رای - 2.08 میانگین
  • 1
  • 2
  • 3
  • 4
  • 5
سورس کد دانلود فایل
#1
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
در صورتی که سوال دارید و سوالتون مختصر هست با شماره 09120642214 میتونید تماس بگیرید.
کسانی که دوست دارن در کانال فروشگاه ما و یا کانال انجمن عضو بشن یک پیامک در تلگرام برای من بفرستید که عضوشون میکنم.

ادرس فروشگاه :

http://www.amshop.ir



ای ام شاپ را در اینستگرام دنبال کنید

ای ام شاپ رو در کانال تلگرام دنبال کنید



This forum uses Lukasz Tkacz MyBB addons.
پاسخ
#2
(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

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

 
پاسخ


موضوعات مشابه ...
موضوع نویسنده پاسخ بازدید آخرین ارسال
  دانلود نسخه اصلی Visual Basic 6 + Msdn Amin_Mansouri 4 11,902 11-18-2015، 11:19 PM
آخرین ارسال: Amin_Mansouri
  چگونه فایل exe با ویژوال بیسیک بسازیم ؟ Amin_Mansouri 4 7,835 08-13-2015، 10:08 PM
آخرین ارسال: Amin_Mansouri
  سورس کد کار با وب کم (ویژوال بسیک 6) Amin_Mansouri 1 5,258 04-20-2015، 10:10 PM
آخرین ارسال: hackert41389
  دانلود قسمتی از یه سایت در برنامه aghamali 1 1,076 11-07-2014، 09:40 PM
آخرین ارسال: Amin_Mansouri
  ذخیره و فرخوانی فایل تکست aghamali 3 1,577 11-01-2014، 01:58 PM
آخرین ارسال: aghamali
  سورس کد ذخیره میخوام روشنا 5 3,540 06-25-2014، 08:46 AM
آخرین ارسال: Amin_Mansouri
  دریافت سورس سایت بصورت یونیکد aleas 3 1,925 06-07-2014، 09:19 PM
آخرین ارسال: aleas
  سورس کدهای ویژوال بیسیک Amin_Mansouri 6 7,105 05-30-2014، 12:41 AM
آخرین ارسال: kalam
  سورس جمع آوری وبلاگ های بروز میهن بلاگ saeedh 7 3,263 05-26-2014، 04:09 PM
آخرین ارسال: Amin_Mansouri
  سریعترین روش دریافت سورس سایت aleas 0 1,557 05-20-2014، 12:17 AM
آخرین ارسال: aleas

پرش به انجمن:


کاربران در حال بازدید این موضوع: 1 مهمان
<------> <____> <<<<----------------->>>> <<<<--->>>>>
This forum uses Lukasz Tkacz MyBB addons.