السلام عليكم ورحمة الله تعالى وبركاته
اليوم أقدم لكم أكواد كيف تقوم بتحميل ملف من الانترنت بـ visual basic 6 وكدلك كيف تقوم بفتحه .
أحببت أن أطرح هدا الموضوع لأني أنا كدلك واجهت مشكلة في تحميل الملفات من الانترنت بالفيجوال بيسك 6 ،بحت في كوكل كثيرا وفي المواقع حتى لقيت في بعض المواقع الأجنبية الأكواد مفرقة فقمت بترقيعها وأحببت أن أشارككم إياها ليستفيد منها عشاق البرمجة بالفيجوال بيسك 6 .
تقوم بفتح مشروع جديد في الفيجوال بيسك 6
تم تقوم باضافة زر بوتون واحد
تم تقوم باضافو مويل جديد وتعطيه الإسم clsDownload
تم تضع الكود التالي داخل الموديل
--------------------------------------------------------
Option Explicit
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Private Declare Function InternetOpen Lib "wininet" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet" (ByVal hInet As Long) As Integer
Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Const INTERNET_FLAG_EXISTING_CONNECT = &H20000000
Const INTERNET_OPEN_TYPE_DIRECT = 1
Const INTERNET_OPEN_TYPE_PROXY = 3
Const INTERNET_FLAG_RELOAD = &H80000000
Public Function Get_File(sURLFileName As String, sSaveFileName As String) As Boolean
Dim lRet As Long
On Error GoTo err_Fix
lRet = InternetOpen("", INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
lRet = URLDownloadToFile(0, sURLFileName, sSaveFileName, 0, 0)
Get_File = True
Exit Function
err_Fix:
Debug.Print Err.LastDllError, lRet
Err.Clear
Get_File = False
End Function
-------------------------------------------------------------
تم تضع الكود التالي في الزر
--------------------------------------------------------
Dim obj As clsDownload
Set obj = New clsDownload
Dim bRet As Boolean
Screen.MousePointer = vbHourglass
bRet = obj.Get_File(Trim("https://www.blog.ard-d.com/file.exe"), Trim("C:\ard.exe"))
Screen.MousePointer = vbDefault
Set obj = Nothing
--------------------------------------------------------
رابط الملف الدي أريد تحميله
https://www.blog.ard-d.com/file.exe
قم بتغيير إلى رابط مباشر للملف المراد تحميله أو صورة
أما الكود
C:\ard.exe
فدلك مسار الملف الدي قمنا بتحميله
يمكنك تغييره بأي إسم تريد مع مراعات الإمتداد إدا كانت صورة ستغير الإمتداد كدلك .
لفتح الملف سستضع الكود التالي مباشرة بعد الكود الثاني في الزر
Shell ("c:\ard.exe"), vbNormalFocus
إدا إضفت الكود سيقوم بتحميل الملف وفتحه مباشرة
أتمنا الكود يكون واضع وأي استفسار ضعه في التعليق
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Private Declare Function InternetOpen Lib "wininet" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet" (ByVal hInet As Long) As Integer
Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Const INTERNET_FLAG_EXISTING_CONNECT = &H20000000
Const INTERNET_OPEN_TYPE_DIRECT = 1
Const INTERNET_OPEN_TYPE_PROXY = 3
Const INTERNET_FLAG_RELOAD = &H80000000
Public Function Get_File(sURLFileName As String, sSaveFileName As String) As Boolean
Dim lRet As Long
On Error GoTo err_Fix
lRet = InternetOpen("", INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
lRet = URLDownloadToFile(0, sURLFileName, sSaveFileName, 0, 0)
Get_File = True
Exit Function
err_Fix:
Debug.Print Err.LastDllError, lRet
Err.Clear
Get_File = False
End Function
-------------------------------------------------------------
تم تضع الكود التالي في الزر
--------------------------------------------------------
Dim obj As clsDownload
Set obj = New clsDownload
Dim bRet As Boolean
Screen.MousePointer = vbHourglass
bRet = obj.Get_File(Trim("https://www.blog.ard-d.com/file.exe"), Trim("C:\ard.exe"))
Screen.MousePointer = vbDefault
Set obj = Nothing
--------------------------------------------------------
رابط الملف الدي أريد تحميله
https://www.blog.ard-d.com/file.exe
قم بتغيير إلى رابط مباشر للملف المراد تحميله أو صورة
أما الكود
C:\ard.exe
فدلك مسار الملف الدي قمنا بتحميله
يمكنك تغييره بأي إسم تريد مع مراعات الإمتداد إدا كانت صورة ستغير الإمتداد كدلك .
لفتح الملف سستضع الكود التالي مباشرة بعد الكود الثاني في الزر
Shell ("c:\ard.exe"), vbNormalFocus
إدا إضفت الكود سيقوم بتحميل الملف وفتحه مباشرة
أتمنا الكود يكون واضع وأي استفسار ضعه في التعليق
تعليقات