میخوام زمان یه عمل رو تو سیستم به دست بیارم یعنی وقتی برنامم داره یه سری فایل رو کپی یا پاک میکنه یه progsess شروع بشه به پر شدن و وقتی عمل کپی شدن تموم شد progsess هم پر بشه
ممنون :8:
Printable View
میخوام زمان یه عمل رو تو سیستم به دست بیارم یعنی وقتی برنامم داره یه سری فایل رو کپی یا پاک میکنه یه progsess شروع بشه به پر شدن و وقتی عمل کپی شدن تموم شد progsess هم پر بشه
ممنون :8:
با سلامنقل قول:
کاری که من در سیستم عامل دیدم اینجوری که ابتدا اگه برای progsess مثلا تنظیم شده باشه روی 100 ابتدا شما تا
90 اونو پر کن زمانی که به 90 رسید فایلتون رو کپی کنید بعد مجداا progsess رو فعال کنید اینجوری به نظر میرسه progsess با کپی فایل همزمان انجام میشه کارراحتی هم هست
زمان انجام یک عمل مثل کپی کردن فایل روی سیستم های مختلف فرق میکنه و روی یک سیستم هم ممکنه در زمان های مختلف فرق بکنه یعنی یکبار مثلا 1 ثانیه یک بار سیستم شلوغ تره و 2.5 ثانیه و ...نقل قول:
به هر حال برای بدست آوردن این زمان توی ویبی میشه از API ی GetTickCount استفاده کرد:
البته همونطور که گفتم توی زمان های مختلف این زمان میتونه متفاوت باشه و برای ساختن یک Progress این روش جالبی نیست.کد:Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Sub Form_Load()
Dim StartTime As Long, EndTime As Long
StartTime = GetTickCount
Call FileCopy("D:\Music Video\Other\Videoclip Massari - Real Love.mpg", "D:\Music Video\Other\Videoclip Massari - Real Love - 2.mpg")
EndTime = GetTickCount
MsgBox "Operation Time : " & (EndTime - StartTime) & " ms"
End Sub
واسه ساختن Progress میشه از API ی CopyFileEx استفاده کرد که در حین کپی کردن یک فایل بوسیله یک تابع CallBack , اون مقداری از عملیات که پیش رفته رو مدام به ما اعلام میکنه, یه Module درست کن و کد زیر رو داخلش کپی کن :
و برای استفاده از کد توی فرم ت کافیه تابع FileCopyProgress رو فراخوانی کنی.آرگومان اول آدرس فایل مبدا, دومی آدرس فایل مقصد. سومی هم اگه True باشه و فایل مقصد از قبل وجود داشته باشه عمل کپی انجام نمیشه:کد:'Written by M3HRZ4D, Mehrzad.net
Option Explicit
Private Const CALLBACK_CHUNK_FINISHED As Long = &H0
Private Const CALLBACK_STREAM_SWITCH As Long = &H1
Private Const PROGRESS_CONTINUE As Long = &H0
Private Const PROGRESS_CANCEL As Long = &H1
Private Const PROGRESS_STOP As Long = &H2
Private Const PROGRESS_QUIET As Long = &H3
Private Const COPY_FILE_FAIL_IF_EXISTS As Long = &H1
Private Const COPY_FILE_RESTARTABLE As Long = &H2
Private Const COPY_FILE_ALLOW_DECRYPTED_DESTINATION As Long = &H8
Private Declare Function CopyFileEx Lib "kernel32" Alias "CopyFileExA" (ByVal lpExistingFileName As String, _
ByVal lpNewFileName As String, _
ByVal lpProgressRoutine As Long, _
ByVal lpData As Long, _
ByVal pbCancel As Long, _
ByVal dwCopyFlags As Long) As Long
Dim bCancel As Boolean
Public Function FileCopyProgress(ByVal lpExistingFileName As String, _
ByVal lpNewFileName As String, _
ByVal bFailIfExists As Long) As Long
Dim CopyFlags As Long
CopyFlags = COPY_FILE_ALLOW_DECRYPTED_DESTINATION
If (bFailIfExists = True) Then CopyFlags = CopyFlags Or COPY_FILE_FAIL_IF_EXISTS
bCancel = False
FileCopyProgress = CopyFileEx(lpExistingFileName, lpNewFileName, AddressOf CopyProgressRoutine, ByVal 0&, ByVal VarPtr(bCancel), ByVal CopyFlags)
End Function
Public Sub CancelCopy()
bCancel = True
End Sub
Public Function CopyProgressRoutine(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
Static PreviousValue As Long
Dim NewValue As Long
NewValue = CLng((TotalBytesTransferred / TotalFileSize) * 100)
If (NewValue <> PreviousValue) Then
Form1.Caption = CStr(NewValue) & "% completed"
PreviousValue = NewValue
End If
DoEvents
CopyProgressRoutine = PROGRESS_CONTINUE
End Function
با زدن دکمه ی Command1 , عمل کپی شروع میشه و تابع CopyProgressRoutine به طور پی در پی تا کامل شدن عمل کپی فراخوانی میشه و خطی که Bold ش کردم اجرا میشه و Tile فرم درصد رو از 0 تا 100 نشون میده.میتونی برای نشون دادن یک ProgressBar این خط کد رو به دلخواه عوض کنی و مقدار ProgressBar ی که توی فرم داری رو اضافه کنی یا هر کار دیگه..کد:Private Sub Command1_Click()
Call FileCopyProgress("D:\Music Video\Other\Videoclip Massari - Real Love.mpg", "D:\Music Video\Other\Videoclip Massari - Real Love - 2.mpg", False)
End Sub
ضمن اینکه با فراخوای تابع CancelCopy در هر لحظه میشه عمل کپی شدن رو Cancel کرد:
-------------کد:Private Sub Command2_Click()
CancelCopy
Form1.Caption = "Canceled!"
End Sub
علت استفاده از نوع Curreny در تابع CallBack اینه که API ی CopyFileEx این پارامتر رو LARGE_INTEGER که هشت بایتی هست در نظر میگیره که توی VB نداریم و چون این پارامتر ها به صورت فراخوانی با مقدار (نه آدرس) مقدار دهی میشن نمیشه از Structure استفاده کرد.
سلام
در مورد تابع callback زیر
CopyProgressRoutine
میشه بگی اینو از کجا باید بیاریم
اینو باید خودمون بنوسیم که توضیحات اینکه چطور باید بنویسیم و پارامتر هاش چی هستن توی MSDN مایکروسافت همش توضیح داده شده. (البته اکثرا به صورت کد C نه VB)نقل قول:
وقتی به قسمت مربوط به CopyFileEx میری اونجا تک تک پارامتر ها توضیح داده شدن و این تابع CopyProgressRoutine هم لینک صفحه ای که در موردش توضیح داده شده توش هست:
msdn2.microsoft.com/en-us/library/aa363854.aspx اینجا CopyProgressRoutine توضیح داده شده
msdn2.microsoft.com/en-us/library/aa363852.aspx اینجا هم CopyFileEx
البته اگه فقط در مورد همین CopyFileEx و CopyProgressRoutine توضیح میخوای(نه CallBack های دیگه), اینجا توضیح این کدی که نوشتم رو کامل دادم:
weblog.mehrzad.net/default.aspx?id=42