نسخ الملفات باستخدام الدالة Api CopyFileEx مع اظهار حالة النسخ فى Progressbar
صفحة 1 من اصل 1 • شاطر
نسخ الملفات باستخدام الدالة Api CopyFileEx مع اظهار حالة النسخ فى Progressbar
ستخدم المثال التالي الدالة Api CopyFileEx التي تسمح لنا بنسخ ملف وإظهار حالة التقدم الملف ، في عنصر تحكم Progressbar
كما يسمح أيضًا بتصور الحالة النهائية للنتيجة ما إذا انتهت بشكل صحيح أو حدث خطأ أو تم إلغاؤه.
ضع عناصر التحكم التالية على نموذج form1:
مربع النص Text1: هنا يجب الإشارة إلى مسار المصدر من الملف
مربع النص Text2: مسار الوجهة
أداة التسمية Label1 : يعرض عنصر التحكم في التسمية هذا حالة عملية النسخ ، إذا كان قد تم الانتهاء من صحته ، أو إذا تم إلغاؤه أو كان هناك خطأ (وهو باللون الأحمر)
Progressbar1 : شريط التقدم لمشاهدة التقدم: الخاصية Max ضع قيمتها 100 و Min Property في 0 (يتم افتراضياً بالفعل)
Command1 : لبدء عملية النسخ
Command2 : إلغاء عملية النسخ.
كتابة الشفرات
افتح وحدة نمطية módulo واكتب الشفرات التالية :
فى حدث النقر على زر التحميل نكتب الشفرة التالية :
أما فى زر الغاء النسخ نكتفي بالشفرة التالية
كما يسمح أيضًا بتصور الحالة النهائية للنتيجة ما إذا انتهت بشكل صحيح أو حدث خطأ أو تم إلغاؤه.
ضع عناصر التحكم التالية على نموذج form1:
مربع النص Text1: هنا يجب الإشارة إلى مسار المصدر من الملف
مربع النص Text2: مسار الوجهة
أداة التسمية Label1 : يعرض عنصر التحكم في التسمية هذا حالة عملية النسخ ، إذا كان قد تم الانتهاء من صحته ، أو إذا تم إلغاؤه أو كان هناك خطأ (وهو باللون الأحمر)
Progressbar1 : شريط التقدم لمشاهدة التقدم: الخاصية Max ضع قيمتها 100 و Min Property في 0 (يتم افتراضياً بالفعل)
Command1 : لبدء عملية النسخ
Command2 : إلغاء عملية النسخ.
كتابة الشفرات
افتح وحدة نمطية módulo واكتب الشفرات التالية :
- الكود:
Option Explicit
'الاعلان عن متغيرات Api CopyFileEx
'*************************************
Public Const PROGRESS_CANCEL = 1
Public Const PROGRESS_CONTINUE = 0
Public Const PROGRESS_QUIET = 3
Public Const PROGRESS_STOP = 2
Public Const COPY_FILE_FAIL_IF_EXISTS = &H1
Public Const COPY_FILE_RESTARTABLE = &H2
'الاعلان عن الدالة Api CopyFileEx
Public Declare Function CopyFileEx Lib "kernel32.dll" Alias "CopyFileExA" ( _
ByVal lpExistingFileName As String, _
ByVal lpNewFileName As String, _
ByVal lpProgressRoutine As Long, _
lpData As Any, _
ByRef pbCancel As Long, _
ByVal dwCopyFlags As Long) As Long
' الاعلان عن متغير لالغاء عملية النسخ
Public Cancelar As Long
'إنشاء وظيفة للنسخ
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function CopiarArchivo(ByVal TotalFileSize As Currency, ByVal _
TotalBytesTransferred As Currency, _
ByVal StreamSize As Currency, _
ByVal StreamBytesTransferred As Currency, _
ByVal dwStreamNumber As Long, _
ByVal dwCallbackReason As Long, _
ByVal hSourceFile As Long, _
ByVal hDestinationFile As Long, _
ByVal lpData As Long) As Long
'إظهار حالة التقدم
Form1.ProgressBar1.Value = CStr(Int((TotalBytesTransferred * 10000) / _
(TotalFileSize * 10000) * 100))
DoEvents
CopiarArchivo = PROGRESS_CONTINUE
End Function
فى حدث النقر على زر التحميل نكتب الشفرة التالية :
- الكود:
Private Sub Command1_Click()
Dim Ret As Long
Cancelar = 0
Label1.Caption = "جاري نسخ الملف: " & Text1 & " الى: " & Text2
Ret = CopyFileEx(Trim$(Text1.Text), Trim$(Text2.Text), AddressOf CopiarArchivo, _
ByVal 0&, Cancelar, COPY_FILE_RESTARTABLE)
Label1.Caption = "حالة النسخ: " + IIf(Ret = 0, _
"(Error/Abortado)", _
"تم النسخ")
End Sub
أما فى زر الغاء النسخ نكتفي بالشفرة التالية
- الكود:
Private Sub Command2_Click()
Cancelar = 1
End Sub
جورج صبحى- ......
- تاريخ التسجيل : 18/02/2011
المساهمات : 127
النقاط : 259
التقيم : 6
الجنس :
رد: نسخ الملفات باستخدام الدالة Api CopyFileEx مع اظهار حالة النسخ فى Progressbar
تحياتى [ندعوك للتسجيل في المنتدى أو التعريف بنفسك لمعاينة هذا الرابط]
ـــــــــــــــــــ التوقيع ــــــــــــــــــــ
سبحان الله وبحمدة .....سبحان الله العظيم
رد: نسخ الملفات باستخدام الدالة Api CopyFileEx مع اظهار حالة النسخ فى Progressbar
كود جميع شكرا جزيلا
المبرمج الطموح- الاشراف
- تاريخ التسجيل : 18/02/2011
المساهمات : 207
النقاط : 368
التقيم : 17
الدولة :
الجنس :
| |
صفحة 1 من اصل 1
صلاحيات هذا المنتدى:
لاتستطيع الرد على المواضيع في هذا المنتدى
الأحد مارس 17, 2024 1:52 pm من طرف رانيا حماد
» افضل شركة نقل عفش بالرياض نقل باكستاني 40% خصم | موقع الانوار
الأحد مارس 17, 2024 1:25 pm من طرف رانيا حماد
» افضل معلم جبس بالرياض تركيب جبس بورد بالرياض 20% خصم اتصل الآن
الأحد مارس 17, 2024 1:09 pm من طرف رانيا حماد
» شراء اثاث مستعمل بالكويت بخصم 30%
الأحد مارس 17, 2024 12:54 pm من طرف رانيا حماد
» افضل فني كهربائي منازل بالرياض جودة 100% | اتصل الآن
الأحد مارس 17, 2024 12:36 pm من طرف رانيا حماد
» أفضل فني سباك بالرياض ممتاز بالرياض | اتصل الآن
الأحد مارس 17, 2024 12:25 pm من طرف رانيا حماد
» افضل شركة تنظيف اثاث بالرياض تنظيف كنب واجهات حجر بخصم 40%
الأحد مارس 17, 2024 11:52 am من طرف رانيا حماد
» افضل شركة تنظيف فلل بالرياض | الانوار
الأحد مارس 17, 2024 11:22 am من طرف رانيا حماد
» افضل شركة تنظيف واجهات زجاج بالرياض 30% خصم
الأحد مارس 17, 2024 10:38 am من طرف رانيا حماد
» افضل شركة نقل عفش بالكويت بخصم 20%
الخميس مارس 14, 2024 1:36 pm من طرف رانيا حماد