المشاركات : 7,394
المواضيع 803
الإنتساب : Sep 2013
السمعة :
847
الشكر: 13249
تم شكره 18797 مرات في 4415 مشاركات
السلام عليكم جميعا
هل توجد امكانية resume لدى Backgroundworker
اريد عند الضغط على زر يتوقف ويرتاح ثم عند نقر زر آخر يستانف اي يكمل
هل هذا ممكن؟
شكر الله لكم جميعا.
المشاركات : 403
المواضيع 2
الإنتساب : Feb 2014
السمعة :
65
الشكر: 32
تم شكره 835 مرات في 278 مشاركات
16-10-14, 07:43 AM
(آخر تعديل لهذه المشاركة : 22-10-14, 08:31 AM {2} بواسطة vbnet.
تعديل السبب: توجد إجابة أفضل
)
.....
طريقة الأستاذ (الشاكي لله) أفضل في المشاركة ( هل توجد امكانية resume لدى Backgroundworker)
.....
المشاركات : 7,394
المواضيع 803
الإنتساب : Sep 2013
السمعة :
847
الشكر: 13249
تم شكره 18797 مرات في 4415 مشاركات
ماشاء الله تبارك الله
فعلا هذا الكود...
هل لديك متسع من الوقت لارسل لك الكود الخاص بنسخ الاقسام والمنتديات و.....الى المرفقات باستثناء الاعضاء فقد جعلت لهم اجراء مستقل.
اريد ان تصحح الاخطاء وتختصر بعد الامور ...
المشاركات : 403
المواضيع 2
الإنتساب : Feb 2014
السمعة :
65
الشكر: 32
تم شكره 835 مرات في 278 مشاركات
.....
نعم، بقدر ما يتسع له وقتي.
.....
المشاركات : 7,394
المواضيع 803
الإنتساب : Sep 2013
السمعة :
847
الشكر: 13249
تم شكره 18797 مرات في 4415 مشاركات
(16-10-14, 08:52 AM)vbnet كتب : .....
نعم، بقدر ما يتسع له وقتي.
.....
طيب اخي الكريم الاجراء التالي كما تعلم ضمن backgroundworker وهو لنسخ الاقسام والمنتديات والمواضيع والمشاركات والمرفقات لا يتم الانتقال من قسم حتى يتم نسخ كافة منتدياته ولن يتم الانتقال من منتدى حتى يتم نسخ كافة مواضيعه ولن يتم الانتقال من موضوع حتى يتم نسخ كافة ردوده وكذلك المرفقات....وسبب ذلك الترقيم التلقائي فلقد جربت نسخ كافة الاقسام والمنتديات وحدهم ثم نسخت المواضيع وحدهم وكذلك الردود ووقعت في مشاكل المواضيع اليتيمة والمشاركات وايضا المنتديات التي فقدت اقسامها .
هذه الطريقة ناجحة لكن هل توجد طريقة افضل؟
كود :
Private Sub forums_importer_DoWork(sender As Object, e As System.ComponentModel.DoWorkEventArgs) Handles forums_importer.DoWork
Dim vbcon As New MySqlConnection(gvbstr)
Dim vbcom As New MySqlCommand("", vbcon)
ff("=======================================================")
vbcom.CommandText = "select * from `forum` where `parentid`='-1' order by forumid"
If vbcon.State = ConnectionState.Closed Then
vbcon.Open()
End If
Using vbdr As MySqlDataReader = vbcom.ExecuteReader
Do While vbdr.Read
If forums_importer.CancellationPending = True Then Exit Do : Exit Sub
Dim cfinsertcon As New MySqlConnection(gmybbstr)
Dim cfinsertcom As New MySqlCommand("", cfinsertcon)
'insertcom.CommandText = "insert into mybb_forums(name,description,linkto,type,pid,parentlist,disporder,active,open,threads,posts,lastposter,lastposteruid,lastposttid,lastpostsubject,allowhtml,allowmycode,allowsmilies,allowimgcode,allowvideocode,allowpicons,allowtratings,usepostcounts,usethreadcounts,requireprefix,password,showinjump,style,overridestyle,rulestype,rulestitle,rules,unapprovedthreads,unapprovedposts,deletedthreads,deletedposts,defaultdatecut,defaultsortby,defaultsortorder) values(@name,@description,@linkto,@type,@pid,@parentlist,@disporder,@active,@open,@threads,@posts,@lastposter,@lastposteruid,@lastposttid,@lastpostsubject,@allowhtml,@allowmycode,@allowsmilies,@allowimgcode,@allowvideocode,@allowpicons,@allowtratings,@usepostcounts,@usethreadcounts,@requireprefix,@password,@showinjump,@style,@overridestyle,@rulestype,@rulestitle,@rules,@unapprovedthreads,@unapprovedposts,@deletedthreads,@deletedposts,@defaultdatecut,@defaultsortby,@defaultsortorder)"
cfinsertcom.CommandText = "insert into mybb_forums(name,description,linkto,type,pid,parentlist,disporder,active,open,allowhtml,allowmycode,allowsmilies,allowimgcode,allowvideocode,allowpicons,allowtratings,requireprefix,password,showinjump,style,overridestyle,rulestype,rulestitle,rules,defaultdatecut,defaultsortby,defaultsortorder) values(@name,@description,@linkto,@type,@pid,@parentlist,@disporder,@active,@open,@allowhtml,@allowmycode,@allowsmilies,@allowimgcode,@allowvideocode,@allowpicons,@allowtratings,@requireprefix,@password,@showinjump,@style,@overridestyle,@rulestype,@rulestitle,@rules,@defaultdatecut,@defaultsortby,@defaultsortorder)"
Dim cforumurl As String = "http://127.0.0.1/" & gvbfolder() & "/forumdisplay.php?f=" & vbdr.Item("forumid")
ff("الاستعلام عن الاقسام")
ff("قراءة رابط القسم: " & cforumurl)
Dim cfhtml As String = ghtmlsrc(cforumurl)
Dim cfdoc As New HtmlAgilityPack.HtmlDocument
cfdoc.LoadHtml(cfhtml)
Dim qn As String = cfdoc.DocumentNode.SelectSingleNode("//title").InnerText.Trim
cfinsertcom.Parameters.AddWithValue("@name", qn)
ff(" حفظ القسم: " & qn)
fl("قراءة القسم : " & qn)
Try
Dim qd As String = cfdoc.DocumentNode.SelectSingleNode("//p[@class='description']").InnerText.Trim
cfinsertcom.Parameters.AddWithValue("@description", qd)
ff(" وصف القسم : " & qd)
Catch ex As Exception
cfinsertcom.Parameters.AddWithValue("@description", "")
End Try
cfinsertcom.Parameters.AddWithValue("@linkto", "")
cfinsertcom.Parameters.AddWithValue("@type", "c")
cfinsertcom.Parameters.AddWithValue("@pid", "0")
cfinsertcom.Parameters.AddWithValue("@parentlist", "")
cfinsertcom.Parameters.AddWithValue("@disporder", vbdr.Item("displayorder"))
cfinsertcom.Parameters.AddWithValue("@active", "1")
cfinsertcom.Parameters.AddWithValue("@open", "1")
cfinsertcom.Parameters.AddWithValue("@allowhtml", "0")
cfinsertcom.Parameters.AddWithValue("@allowmycode", "1")
cfinsertcom.Parameters.AddWithValue("@allowsmilies", "1")
cfinsertcom.Parameters.AddWithValue("@allowimgcode", "1")
cfinsertcom.Parameters.AddWithValue("@allowvideocode", "1")
cfinsertcom.Parameters.AddWithValue("@allowpicons", "1")
cfinsertcom.Parameters.AddWithValue("@allowtratings", "1")
cfinsertcom.Parameters.AddWithValue("@requireprefix", "0")
cfinsertcom.Parameters.AddWithValue("@password", vbdr.Item("password"))
cfinsertcom.Parameters.AddWithValue("@showinjump", "1")
cfinsertcom.Parameters.AddWithValue("@style", vbdr.Item("styleid"))
cfinsertcom.Parameters.AddWithValue("@overridestyle", 0)
cfinsertcom.Parameters.AddWithValue("@rulestype", 0)
cfinsertcom.Parameters.AddWithValue("@rulestitle", "")
cfinsertcom.Parameters.AddWithValue("@rules", "")
cfinsertcom.Parameters.AddWithValue("@defaultdatecut", 0)
cfinsertcom.Parameters.AddWithValue("@defaultsortby", "")
cfinsertcom.Parameters.AddWithValue("@defaultsortorder", "")
If cfinsertcon.State = ConnectionState.Closed Then
cfinsertcon.Open()
End If
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
cfinsertcom.ExecuteNonQuery()
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
ff(" تم حفظ القسم: " & qn & " بنجاح")
ff("=======================================================")
'الان نبدا بحفظ المنتديات التابعة للاقسام
Dim fcon As New MySqlConnection(gvbstr)
Dim fcom As New MySqlCommand("", fcon)
fcom.CommandText = "select * from `forum` where `parentid`='" & vbdr.Item("forumid") & "' order by forumid"
If fcon.State = ConnectionState.Closed Then
fcon.Open()
End If
Using fdr As MySqlDataReader = fcom.ExecuteReader
If fdr.HasRows Then
ff("الاستعلام عن المنتديات التابعة للقسم")
ff("تم الحصول على منتديات تابعة للقسم: " & qn)
Do While fdr.Read
If forums_importer.CancellationPending = True Then Exit Do : Exit Do : Exit Sub
Dim mcon As New MySqlConnection(gmybbstr)
Dim minsert As New MySqlCommand("", mcon)
minsert.CommandText = "insert into mybb_forums(name,description,linkto,type,pid,parentlist,disporder,active,open,allowhtml,allowmycode,allowsmilies,allowimgcode,allowvideocode,allowpicons,allowtratings,requireprefix,password,showinjump,style,overridestyle,rulestype,rulestitle,rules,defaultdatecut,defaultsortby,defaultsortorder) values(@name,@description,@linkto,@type,@pid,@parentlist,@disporder,@active,@open,@allowhtml,@allowmycode,@allowsmilies,@allowimgcode,@allowvideocode,@allowpicons,@allowtratings,@requireprefix,@password,@showinjump,@style,@overridestyle,@rulestype,@rulestitle,@rules,@defaultdatecut,@defaultsortby,@defaultsortorder)"
Dim fforumurl As String = "http://127.0.0.1/" & gvbfolder() & "/forumdisplay.php?f=" & fdr.Item("forumid")
ff("قراءة رابط المنتدى: " & fforumurl)
Dim ffhtml As String = ghtmlsrc(fforumurl)
Dim ffdoc As New HtmlAgilityPack.HtmlDocument
ffdoc.LoadHtml(ffhtml)
Dim fnn As String = ffdoc.DocumentNode.SelectSingleNode("//title").InnerText.Trim
Dim fd As String = ffdoc.DocumentNode.SelectSingleNode("//p[@class='description']").InnerText.Trim
minsert.Parameters.AddWithValue("@name", fnn)
ff(" حفظ المنتدى: " & fnn)
fl(" نسخ المنتدى : " & fnn & " التابع للقسم : " & qn)
Try
minsert.Parameters.AddWithValue("@description", fd)
ff(" حفظ الوصف:" & fd)
Catch ex As Exception
minsert.Parameters.AddWithValue("@description", "")
End Try
minsert.Parameters.AddWithValue("@linkto", "")
minsert.Parameters.AddWithValue("@type", "f")
Dim maxcon As New MySqlConnection(gmybbstr)
Dim maxcom As New MySqlCommand("", maxcon)
If maxcon.State = ConnectionState.Closed Then
maxcon.Open()
End If
maxcom.CommandText = "select max(`fid`) from `mybb_forums` where `pid`='0'"
ff(" معرفة القسم الاب لهذا المنتدى")
minsert.Parameters.AddWithValue("@pid", maxcom.ExecuteScalar)
If maxcon.State = ConnectionState.Open Then
maxcon.Close()
End If
minsert.Parameters.AddWithValue("@parentlist", "")
minsert.Parameters.AddWithValue("@disporder", fdr.Item("displayorder"))
minsert.Parameters.AddWithValue("@active", "1")
minsert.Parameters.AddWithValue("@open", "1")
'threads,posts,lastposter,lastposteruid,lastposttid,lastpostsubject
'minsert.Parameters.AddWithValue("@threads", fdr.Item("threadcount"))
'minsert.Parameters.AddWithValue("@posts", fdr.Item("replycount"))
minsert.Parameters.AddWithValue("@allowhtml", "0")
minsert.Parameters.AddWithValue("@allowmycode", "1")
minsert.Parameters.AddWithValue("@allowsmilies", "1")
minsert.Parameters.AddWithValue("@allowimgcode", "1")
minsert.Parameters.AddWithValue("@allowvideocode", "1")
minsert.Parameters.AddWithValue("@allowpicons", "1")
minsert.Parameters.AddWithValue("@allowtratings", "1")
minsert.Parameters.AddWithValue("@requireprefix", "0")
minsert.Parameters.AddWithValue("@password", fdr.Item("password"))
minsert.Parameters.AddWithValue("@showinjump", "1")
minsert.Parameters.AddWithValue("@style", fdr.Item("styleid"))
minsert.Parameters.AddWithValue("@overridestyle", 0)
minsert.Parameters.AddWithValue("@rulestype", 0)
minsert.Parameters.AddWithValue("@rulestitle", "")
minsert.Parameters.AddWithValue("@rules", "")
minsert.Parameters.AddWithValue("@defaultdatecut", 0)
minsert.Parameters.AddWithValue("@defaultsortby", "")
minsert.Parameters.AddWithValue("@defaultsortorder", "")
If mcon.State = ConnectionState.Closed Then
mcon.Open()
End If
'@@@@@@@@@@@@@@@@@@@@@@@@@
minsert.ExecuteNonQuery()
ff(" تم حفظ المنتدى: " & fnn & " بنجاح")
ff("=======================================================")
'@@@@@@@@@@@@@@@@@@@@@@@@@@@
If mcon.State = ConnectionState.Open Then
mcon.Close()
End If
''القراءة من الثريدز
Dim threadcon As New MySqlConnection(gvbstr)
Dim threadcom As New MySqlCommand("", threadcon)
threadcom.CommandText = "select * from `thread` where `forumid`=" & fdr.Item("forumid") & " order by threadid asc"
If threadcon.State = ConnectionState.Closed Then
threadcon.Open()
End If
Using thrd As MySqlDataReader = threadcom.ExecuteReader
If thrd.HasRows Then
Do While thrd.Read
' ff(" الاستعلام عن مواضيع تابعة للمنتدى : " & fnn)
If forums_importer.CancellationPending = True Then Exit Do : Exit Do : Exit Do : Exit Sub
Dim threadinsertcon As New MySqlConnection(gmybbstr)
Dim threadinsertcom As New MySqlCommand("", threadinsertcon)
'الاضافة الى جدول الثريدز
threadinsertcom.CommandText = "insert into mybb_threads(fid,subject,uid,username,firstpost,lastpost,lastposter,lastposteruid,views,replies,closed,sticky,notes,visible,dateline) values(@fid,@subject,@uid,@username,@firstpost,@lastpost,@lastposter,@lastposteruid,@views,@replies,@closed,@sticky,@notes,@visible,@dateline)"
Dim maxfcon As New MySqlConnection(gmybbstr)
Dim maxfid As New MySqlCommand("", maxfcon)
maxfid.CommandText = "select max(`fid`) from `mybb_forums` where `type`='f'"
Dim lfid As String = ""
If maxfcon.State = ConnectionState.Closed Then
maxfcon.Open()
End If
lfid = maxfid.ExecuteScalar
threadinsertcom.Parameters.AddWithValue("@fid", maxfid.ExecuteScalar)
If maxfcon.State = ConnectionState.Open Then
maxfcon.Close()
End If
Dim thurl As String = "http://localhost/" & gvbfolder() & "/showthread.php?t=" & thrd.Item("threadid")
Dim thtml As String = ghtmlsrc(thurl)
Dim kateb As String = gusername(thtml)
Dim enwan As String = gtitle(thtml)
'ff("------------------------------------------")
ff("_____________________________________________________")
ff(thurl)
ff("العنوان: " & enwan & " الكاتب: " & kateb)
threadinsertcom.Parameters.AddWithValue("@subject", enwan)
' fl("نسخ الموضوع رقم: " & thrd.Item("threadid") & " التابع لمنتدى رقم: " & fdr.Item("forumid") & " التابع لقسم رقم: " & vbdr.Item("forumid"))
threadinsertcom.Parameters.AddWithValue("@uid", thrd.Item("postuserid"))
'Dim tunod As HtmlAgilityPack.HtmlNode = thdoc.DocumentNode.SelectSingleNode("//div[@class='userinfo']/div/div/a")
threadinsertcom.Parameters.AddWithValue("@username", kateb)
threadinsertcom.Parameters.AddWithValue("@firstpost", thrd.Item("firstpostid"))
threadinsertcom.Parameters.AddWithValue("@lastpost", thrd.Item("lastpostid"))
threadinsertcom.Parameters.AddWithValue("@lastposter", "")
'lastposteruid
threadinsertcom.Parameters.AddWithValue("@lastposteruid", thrd.Item("postuserid"))
'views,replies,closed,sticky,notes,visible,dateline
threadinsertcom.Parameters.AddWithValue("@views", thrd.Item("views"))
threadinsertcom.Parameters.AddWithValue("@replies", thrd.Item("replycount"))
If thrd.Item("open") = "0" Then
threadinsertcom.Parameters.AddWithValue("@closed", "1")
Else
threadinsertcom.Parameters.AddWithValue("@closed", "0")
End If
threadinsertcom.Parameters.AddWithValue("@sticky", thrd.Item("sticky"))
threadinsertcom.Parameters.AddWithValue("@notes", "")
threadinsertcom.Parameters.AddWithValue("@visible", thrd.Item("visible"))
threadinsertcom.Parameters.AddWithValue("@dateline", thrd.Item("dateline"))
If threadinsertcon.State = ConnectionState.Closed Then
threadinsertcon.Open()
End If
'================================
threadinsertcom.ExecuteNonQuery()
ff(" تم حفظ العنوان: " & enwan & " بنجاح")
ff("=============================")
' ff("_____________________________________________________")
'================================
'الان القراءة من البوستس
Dim postcon As New MySqlConnection(gmybbstr)
Dim maxtid As New MySqlCommand("select max(`tid`) from `mybb_threads`", postcon)
If postcon.State = ConnectionState.Closed Then
postcon.Open()
End If
Dim ltid As String = maxtid.ExecuteScalar
If postcon.State = ConnectionState.Open Then
postcon.Close()
End If
Dim vbc As New MySqlConnection(gvbstr)
Dim postcom As New MySqlCommand("", vbc)
postcom.CommandText = "select * from `post` where `threadid`=" & thrd.Item("threadid") & " order by postid asc"
If vbc.State = ConnectionState.Closed Then
vbc.Open()
End If
Dim mpostcon As New MySqlConnection(gmybbstr)
Using post As MySqlDataReader = postcom.ExecuteReader
If post.HasRows Then
Do While post.Read
If forums_importer.CancellationPending = True Then Exit Do : Exit Do : Exit Do : Exit Do : Exit Sub
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
Dim postinsert As New MySqlCommand("", mpostcon)
postinsert.CommandText = "insert into mybb_posts(tid,subject,uid,fid,username,dateline,message,ipaddress,includesig,smilieoff,visible) values(@tid,@subject,@uid,@fid,@username,@dateline,@message,@ipaddress,@includesig,@smilieoff,@visible)"
'gtitle(thtml)
Dim url2 As String = "http://127.0.0.1/" & gvbfolder.Trim & "/showthread.php?t=" & thrd.Item("threadid").ToString.Trim & "&p=" & post.Item("postid").ToString.Trim
Dim phtml As String = ghtmlsrc(url2)
Dim poenwan As String = gtitle(phtml)
Dim pokateb As String = gpostusername(phtml, post.Item("postid"))
ff("الاستعلام عن المشاركات التابعة للموضوع: " & enwan)
ff(url2)
ff(" حفظ المشاركة: " & poenwan & " الكاتب: " & pokateb)
postinsert.Parameters.AddWithValue("@tid", ltid)
' fl("موضوع رقم: " & thrd.Item("threadid") & " مشاركة رقم: " & post.Item("postid"))
postinsert.Parameters.AddWithValue("@subject", poenwan)
postinsert.Parameters.AddWithValue("@uid", post.Item("userid"))
postinsert.Parameters.AddWithValue("@fid", lfid)
postinsert.Parameters.AddWithValue("@username", pokateb)
postinsert.Parameters.AddWithValue("@dateline", post.Item("dateline"))
postinsert.Parameters.AddWithValue("@message", gpostmessage(phtml, post.Item("postid")))
postinsert.Parameters.AddWithValue("@ipaddress", post.Item("ipaddress"))
'showsignature
postinsert.Parameters.AddWithValue("@includesig", post.Item("showsignature"))
'smilieoff,visible
If post.Item("allowsmilie") = "0" Then
postinsert.Parameters.AddWithValue("@smilieoff", "1")
Else
postinsert.Parameters.AddWithValue("@smilieoff", "0")
End If
postinsert.Parameters.AddWithValue("@visible", post.Item("visible"))
If mpostcon.State = ConnectionState.Closed Then
mpostcon.Open()
End If
'------------------------------
postinsert.ExecuteNonQuery()
ff(" تم حفظ المشاركة بنجاح ")
' ff("=======================================================")
'-------------------------------
'النظر الى المرفقات
'النظر الى مرفقات المشاركة
Dim atacon As New MySqlConnection(gvbstr)
Dim atacom As New MySqlCommand("", atacon)
atacom.CommandText = "select * from `attachment` where `contentid`=" & post.Item("postid") & " order by attachmentid"
If atacon.State = ConnectionState.Closed Then
atacon.Open()
End If
Using atard As MySqlDataReader = atacom.ExecuteReader
If atard.HasRows Then
ff("الاستعلام عن المرفقات")
ff("<<<<<<<<<< تم الحصول على مرفقات >>>>>>>>>>")
Do While atard.Read
If forums_importer.CancellationPending = True Then Exit Do : Exit Do : Exit Do : Exit Do : Exit Do : Exit Sub
Dim ataurl As String = "http://localhost/" & gvbfolder() & "/attachment.php?attachmentid=" & atard.Item("attachmentid")
Dim mbcon As New MySqlConnection(gmybbstr)
Dim toatt As New MySqlCommand("", mbcon)
toatt.CommandText = "insert into `mybb_attachments` (pid,uid,filename,filetype,filesize,attachname,visible) values(@pid,@uid,@filename,@filetype,@filesize,@attachname,@visible)"
Dim lpost As New MySqlConnection(gmybbstr)
Dim plastid As New MySqlCommand("", lpost)
plastid.CommandText = "select max(`pid`) from `mybb_posts`"
If lpost.State = ConnectionState.Closed Then
lpost.Open()
End If
toatt.Parameters.AddWithValue("@pid", plastid.ExecuteScalar)
toatt.Parameters.AddWithValue("@uid", atard.Item("userid"))
ff(" حفظ المرفق : " & atard.Item("filename"))
toatt.Parameters.AddWithValue("@filename", atard.Item("filename"))
toatt.Parameters.AddWithValue("@filetype", gfet(IO.Path.GetExtension(atard.Item("filename"))))
toatt.Parameters.AddWithValue("@filesize", gfs(ataurl))
If atard.Item("state") = "visible" Then
toatt.Parameters.AddWithValue("@visible", "1")
Else
toatt.Parameters.AddWithValue("@visible", "0")
End If
Dim fa As String = IO.Path.GetFileNameWithoutExtension(atard.Item("filename"))
Dim fn As String = "post_" & atard.Item("userid") & "_" & ToTimeStamp(Date.UtcNow) & "_" & random_str() & ".attach"
toatt.Parameters.AddWithValue("@attachname", "attachments\" & fn)
If mbcon.State = ConnectionState.Closed Then
mbcon.Open()
End If
Dim fold As String = "C:\inetpub\wwwroot\mybb\uploads\attachments\"
If IO.Directory.Exists(fold) = False Then
IO.Directory.CreateDirectory(fold)
End If
ff("يتم استخراج الملف الى مسار مجلد " & vbNewLine & "./uploads/attachments" & vbNewLine & "قد يتطلب الامر التشغيل كمسؤول")
Threading.Thread.Sleep(3000)
Dim wc As New WebClient
wc.Headers.Add("cookie", gco)
wc.DownloadFile(ataurl, fold & fn)
'0000000000000000000000000
toatt.ExecuteNonQuery()
' ff("تم حفظ المرفق: " & atard.Item("filename") & " بنجاح")
'xxxxxxxxxx تم حفظ المرفق xxxxxxxxxx
ff("<<<<<<<<<< تم حفظ المرفق بنجاح >>>>>>>>>>")
ff("=============================")
'00000000000000000000000000
Loop
atard.Close()
Else
' ff("لم يتم العثور على مرفقات")
ff("=============================")
End If
End Using
'انتهاء النظر الى مرفقات المشاركة
If atacon.State = ConnectionState.Open Then
atacon.Close()
End If
Loop
post.Close()
End If
End Using
Loop
thrd.Close()
End If
End Using
'حلقة القراءة من جدول المنتديات
Loop
fdr.Close()
Else
ff("لا يوجد منتدى")
End If
End Using
If fcon.State = ConnectionState.Open Then
fcon.Close()
End If
'حلقة القراءة من جدول الاقسام
Loop
End Using
If vbcon.State = ConnectionState.Open Then
vbcon.Close()
End If
End Sub
وهذا الموديول
كود :
Imports MySql.Data.MySqlClient
Imports System.Net
Imports Microsoft.Win32
Module Module1
Public vbstr As String = ""
Public mybbstr As String = ""
Public co As String = ""
Public vbfolder As String = ""
Public mybbfolder As String = ""
Public ok As String = ""
'ALTER TABLE tablename AUTO_INCREMENT = 1
Public Function toutf8(ByVal str As String) As String
'supply True as the construction parameter to indicate
'that you wanted the class to emit BOM (Byte Order Mark)
'NOTE: this BOM value is the indicator of a UTF-8 string
Dim utf8Encoding As New System.Text.UTF8Encoding(True)
Dim encodedString() As Byte
encodedString = utf8Encoding.GetBytes(str)
Return utf8Encoding.GetString(encodedString)
End Function
Public Function gvbstr()
Dim hdoc As New HtmlAgilityPack.HtmlDocument
hdoc.Load(Application.StartupPath & "\config.txt")
vbstr = hdoc.DocumentNode.SelectSingleNode("//vbhost").InnerText.Trim
Return vbstr
End Function
Public Function gok()
Dim hdoc As New HtmlAgilityPack.HtmlDocument
hdoc.Load(Application.StartupPath & "\config.txt")
ok = hdoc.DocumentNode.SelectSingleNode("//ok").InnerText.Trim
Return ok
End Function
Public Function gmybbstr()
Dim hdoc As New HtmlAgilityPack.HtmlDocument
hdoc.Load(Application.StartupPath & "\config.txt")
mybbstr = hdoc.DocumentNode.SelectSingleNode("//mybbhost").InnerText.Trim
Return mybbstr
End Function
Public Function gco()
Dim hdoc As New HtmlAgilityPack.HtmlDocument
hdoc.Load(Application.StartupPath & "\config.txt")
co = hdoc.DocumentNode.SelectSingleNode("//vbcookie").InnerText.Trim
Return co
End Function
Public Function gvbfolder()
Dim hdoc As New HtmlAgilityPack.HtmlDocument
hdoc.Load(Application.StartupPath & "\config.txt")
vbfolder = hdoc.DocumentNode.SelectSingleNode("//vbfolder").InnerText.Trim
Return vbfolder
End Function
Public Function gmybbfolder()
Dim hdoc As New HtmlAgilityPack.HtmlDocument
hdoc.Load(Application.StartupPath & "\config.txt")
mybbfolder = hdoc.DocumentNode.SelectSingleNode("//mybbfolder").InnerText.Trim
Return mybbfolder
End Function
Public Function ghtmlsrc(ByVal url As String) As String
Dim wc As New WebClient
wc.Headers.Add("cookie", gco)
Return wc.DownloadString(url)
End Function
Public Function ToTimeStamp(ByVal target As DateTime) As Integer
Dim [date] As New DateTime(1970, 1, 1, 0, 0, 0, target.Kind)
Dim hubspotTimestamp As Integer = System.Convert.ToInt64((target - [date]).TotalSeconds)
Return hubspotTimestamp '* 1000
End Function
Public Function random_str(Optional ByVal size = 8) As String
Dim salt As String = String.Empty
Dim characterList As String = "aAbBcCdDeEfFgGhHiIjJkKlLmMnNoOpPqQrRsStTuUvVwWxXyYzZ123456789"
Dim rnd As New Random
For i = 0 To size - 1
salt &= characterList(rnd.Next(0, (Len(characterList) - 1)))
Next
Return salt
End Function
Public Function gfet(ByVal fileExtension As String) As String
Dim FileExtensionName As String = ""
For Each subKey As String In Registry.ClassesRoot.GetSubKeyNames()
If String.IsNullOrEmpty(subKey) Then
Continue For
End If
If subKey.CompareTo(fileExtension) = 0 Then
Dim defaultValue As String = Registry.ClassesRoot.OpenSubKey(subKey).GetValue("").ToString()
If defaultValue.Length = 0 Then
Exit For
End If
If FileExtensionName.Length = 0 Then
FileExtensionName = defaultValue
fileExtension = FileExtensionName
Else
If defaultValue.Length > 0 Then
FileExtensionName = defaultValue
End If
Exit For
End If
End If
Next
Return FileExtensionName
End Function
Public Function gtitle(ByVal content As String) As String
Dim hdoc As New HtmlAgilityPack.HtmlDocument
hdoc.LoadHtml(content)
Return hdoc.DocumentNode.SelectSingleNode("//title").InnerText.Trim
End Function
Public Function gusername(ByVal content As String) As String
Dim hdoc As New HtmlAgilityPack.HtmlDocument
hdoc.LoadHtml(content)
Try
Return hdoc.DocumentNode.SelectSingleNode("//div[@class='userinfo']/div/div/a").InnerText.Trim
Catch ex As Exception
Return "زائر او محذوف"
End Try
End Function
Public Function gpostusername(ByVal content As String, ByVal id As String) As String
Dim hdoc As New HtmlAgilityPack.HtmlDocument
hdoc.LoadHtml(content)
Dim nod1 As HtmlAgilityPack.HtmlNode = hdoc.GetElementbyId("post_" & id)
Dim doc2 As New HtmlAgilityPack.HtmlDocument
doc2.LoadHtml(nod1.InnerHtml)
Try
Return doc2.DocumentNode.SelectSingleNode("//div[@class='userinfo']/div/div/a").InnerText.Trim
Catch ex As Exception
Return "محذوف او زائر"
End Try
End Function
Public Function gpostmessage(ByVal content As String, ByVal id As String) As String
Dim hdoc As New HtmlAgilityPack.HtmlDocument
hdoc.LoadHtml(content)
Dim nod1 As HtmlAgilityPack.HtmlNode = hdoc.GetElementbyId("post_" & id)
Dim doc2 As New HtmlAgilityPack.HtmlDocument
doc2.LoadHtml(nod1.InnerHtml)
Try
' Return doc2.GetElementbyId("post_message_" & id).InnerHtml
Dim m As HtmlAgilityPack.HtmlNode = doc2.GetElementbyId("post_message_" & id)
Dim mm As New HtmlAgilityPack.HtmlDocument
mm.LoadHtml(m.InnerHtml)
Dim h As HtmlAgilityPack.HtmlNode = mm.DocumentNode.SelectSingleNode("//blockquote")
Return h.InnerHtml
Catch ex As Exception
Return "ناسف لحدوث خطا"
End Try
End Function
Public Function gfs(ByVal url As String) As String
Dim req As WebRequest = WebRequest.Create(url)
req.Headers.Add("cookie", gco)
Dim res As HttpWebResponse = req.GetResponse
Return res.ContentLength
res.Close()
End Function
End Module
المشاركات : 1,733
المواضيع 147
الإنتساب : Sep 2012
السمعة :
215
الشكر: 8484
تم شكره 12163 مرات في 1145 مشاركات
17-10-14, 07:08 AM
(آخر تعديل لهذه المشاركة : 17-10-14, 07:11 AM {2} بواسطة الشاكي لله.)
السلام عليكم
الطريقة الصحيحة لايقاف Thread او حتى BackgroundWorker هي باستخدام كائن يسمى ManualRestEvent وليست باستعمال الloop مع الSleep
هذا المثال التالي يشرح كيفية عمل ذلك :
كود :
Private mre As New ManualResetEvent(True)
Private Sub Form1_Load(sender As Object, e As EventArgs)
Control.CheckForIllegalCrossThreadCalls = False
backgroundWorker1.RunWorkerAsync()
End Sub
Private Sub backgroundWorker1_DoWork(sender As Object, e As DoWorkEventArgs)
'....
'....
'....
'....
For i As Integer = 0 To 9999999
mre.WaitOne()
' الكود اعلاه سيقوم بايقاف هذا الاجراء عندما يتم اعطاءه اشارة سلبية من اجراء اخر
'الاشارة اما ان تكون ايجابية او سلبية
'السلبية ستعني ايقاف هذا الاجراء
'Reset() ويتم اعطاء الاشارة السلبية بواسطة الدالة
'Set() ويتم اعطاء الاشارة الايجابية التي ستقوم باكمال هذا الاجراء بواسطة الدالة
label1.Text = i.ToString()
Next
'....
'....
'....
'....
End Sub
Private Sub PauseButton_Click(sender As Object, e As EventArgs)
mre.Reset()
'اعطاء اشارة سلبية
End Sub
Private Sub ResumeButton_Click(sender As Object, e As EventArgs)
mre.Set()
'اعطاء اشارة ايجابية
End Sub
البرنامج :-
هذي هي الطريقة الصحيحة التي لاترهق المعالج وتقوم بوظيفتها على اكمل وجه
تحياتي
|
