نمايش كپي فايل توسط progress bar

[shahram_g]

دوستان عزيزم سلام. مي خواستم ببينم چطوري مي تونم كپي كردن يك فايل توسط ويژوال بيسيك رو توسط يك progress bar نمايش بدم. روشي كه به نظر خودم رسيد استفاده از حجم فايل فايل مقصد در هر لحظه و نسبتش با فايل اصلي بود كه توسط يك تايمر چك بشه ولي مشكل اينجاست كه هنگامي كه از دستورات copy در ويژوال بيسيك استفاده مي كنم تا كار كپي تموم نشه برنامه در همون خط كپي باقي مي مونه و به رويداد تايمر پاسخ نميده.حتي Doevents هم جواب نميده. دوستان راه حلي براي حل اين مشكل يا اصلا روش بهتري سراغ دارند؟

[ba_maram_shiraz]

والا تا اونجا که من می دونم شما باید اول اجرای کد max از progress رو مشخص کنی وهر بار مقدار رو +1 کنی تا به مکس برسه.

خودمم نفهمیدم چی گفتم

[shahram_g]

مشكلي در انتخاب max و پله هاي افزايشي progress bar نيست.ولي همينجوري كه نميشه 1 واحد اضافه كني.همانطور كه گفتم اين نمايش بايد واقعي باشه و نسبت فايل كپي شده به فايل اصلي رو نشون بده.
حالا اين 1 واحد به قول شما رو چه موقع اضافه كنه؟
مشكل اينه كه چون در دستور copy برنامه ميمونه به بقيه قسمتهاي برنامه كه كار چك كردن حجم فايل كپي شده رو بر عهده داره پاسخي نميده.

[hamed_Arfaee]

با سلام

اینا رو تو ماژول بنویسین :

کد:

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 Const COPY_FILE_FAIL_IF_EXISTS = &H1
Public Const COPY_FILE_RESTARTABLE = &H2
Public bCancel As Long
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
On Error Resume Next
Form1.ProgressBar1.Value = CStr(Int((TotalBytesTransferred * 10000) / (TotalFileSize * 10000) * 100))
DoEvents
CopyProgressRoutine = PROGRESS_CONTINUE
End Function

اینم برا دکمه کپی

کد:

ret = CopyFileEx("From", "To", AddressOf CopyProgressRoutine, ByVal 1&, bCancel, COPY_FILE_RESTARTABLE)

[shahram_g]

دوست عزيز واقعا سپاسگذارم.
موفق باشيد.

[EleRam]

اين كد مورد نداشت؟! واسه من همون اول كپي مي كنه (20 درصد كار قطع كردم برنامه رو... بعد ديدم فايل خيلي وقته كپي شده!)

[hamed_Arfaee]

فایلی که کپی شده بود کار هم کرد ؟

[EleRam]

بله سالم سالم...

[hamed_Arfaee]

نه نمیتونه سالم باشه
فقط از نظر حجمی مثل همون هست نه دیتا

[m_vb66]

برای کپی فایل یک راه بهتر هم هست و اون استفاده از تابع
Private Declare Function SHFileOperation Lib "shell32.dll" Alias " SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
هست
از نظر سرعت کپی هم سرعتش نسبت به copyfile بهتره امکاناتش هم بیشتره این هم یک نمونه

Private Const FO_COPY = &H2

Private Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As String ' only used if FOF_SIMPLEPROGRESS
End Type

Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long

Private Sub Command1_Click()
Dim ret_val As Long

Dim sh_op1 As SHFILEOPSTRUCT
Dim sh_op2 As SHFILEOPSTRUCT

Dim path1 As String
Dim pathh1 As String

Dim path2 As String
Dim pathh2 As String

path1 = "c:\tozi\marsol.dbf"
path2 = "c:\tozi\marcol.dbf"

pathh1 = "g:\tozi\marsol.dbf"
pathh2 = "g:\tozi\marcol.dbf"


With sh_op1
.hwnd = 0
.wFunc = FO_COPY
.pFrom = path1
.pTo = pathh1
End With

With sh_op2
.hwnd = 0
.wFunc = FO_COPY
.pFrom = path2
.pTo = pathh2
End With

ret_val = SHFileOperation(sh_op1)
ret_val = SHFileOperation(sh_op2)
End Sub

[EleRam]

نه نمیتونه سالم باشه
فقط از نظر حجمی مثل همون هست نه دیتا

من ميگم فايل سالمه و از اول تا آخر عين آدم كار مي كنه بعد شما ميگي....؟!