دخول

**vbnet** · 12-10-14, 11:28 PM

.....

جرب هذا التغيير في نسخة مؤقتة من المشروع (على افتراض أن العملية تبدأ من خلال الضغط على Button1)
طبعاً لم أجربه لأنه لايوجد لدي كامل المشروع بما في ذلك قاعدة بيانات المنتديين MyBB وvBulletin

كود :

' المجموع العام للأسطر

Dim rowsCount As Integer

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

    ' معرفة المجموع الإجمالي لأسطر النتائج المراد جلب بياناتها كامله

    vbcon.Open()

    rowsCount = New MySqlCommand(" SELECT COUNT(`userid`) FROM `user` ", vbcon).ExecuteScalar

    vbcon.Close()

    If rowsCount > 0 Then tuser_importer.RunWorkerAsync()

End Sub

' حجم المجموعة الواحدة

Dim limit As Integer = 100

Dim offset As Integer = 0

Private Sub tuser_importer_DoWork(ByVal sender As Object, ByVal e As System.ComponentModel.DoWorkEventArgs) Handles tuser_importer.DoWork

    ' إذا كان هذا الجزء يستخدم مرة واحدة فلا يوضع داخل هذا الحدث -------------------------

    Using conn As New MySqlConnection(gmybbstr)

        Using comm As New MySqlCommand("ALTER TABLE `mybb_users` MODIFY COLUMN `salt` VARCHAR(30)", conn)

            Try

                ff("تعديل قيمة العمود salt لرفع الطول")

                conn.Open()

                comm.ExecuteNonQuery()

                conn.Close()

            Catch ex As Exception

                ff(Err.Description)

                Exit Sub

            End Try

        End Using

    End Using

    '-----------------------------------------------------------------------------------

    ' جدول بيانات

    Using dt As New DataTable

        ' dt قراءة مجموعة من المستخدمين ووضع النتائج في جدول البيانات

        ' vb إنشاء إتصال مع

        Using conn As New MySqlConnection(gvbstr)

            Dim sql As String = " SELECT * FROM `user` ORDER BY `userid` ASC LIMIT " & offset & ", " & limit ' تحديد حجم المجموعة بقيمة متغير

            Using da As New MySqlDataAdapter(sql, conn)

                ff("الان .. النظر في جدول المستخدمين")

                da.Fill(dt)

            End Using

        End Using

        ' حلقة في أسطر جدول البيانات

        For Each row As DataRow In dt.Rows

            'tuser_importer.ReportProgress(offset)

            Dim theid As String = row("userid")

            Dim url As String = "http://127.0.0.1/" & gvbfolder & "/member.php?u=" & row("userid")

            Dim html As String = ""

            ' HtmlAgilityPack لم أتطرق لهذا الجزء لعدم استخدامي لـ ---------------------

            Dim wc As New WebClient

            wc.Headers.Add("cookie", gco)

            html = wc.DownloadString(url)

            Dim hdoc As New HtmlAgilityPack.HtmlDocument

            hdoc.LoadHtml(html)

            Dim nod As HtmlAgilityPack.HtmlNode = hdoc.GetElementbyId("userinfo")

            Dim u As New HtmlAgilityPack.HtmlDocument

            u.LoadHtml(nod.InnerHtml)

            Dim th As HtmlAgilityPack.HtmlNode = u.DocumentNode.SelectSingleNode("//span[@class='member_username']")

            Dim th2 As HtmlAgilityPack.HtmlNode = u.DocumentNode.SelectSingleNode("//span[@class='usertitle']")

            Dim about As HtmlAgilityPack.HtmlNode = hdoc.GetElementbyId("view-aboutme")

            Dim h As New HtmlAgilityPack.HtmlDocument

            h.LoadHtml(about.InnerHtml)

            Dim toqee As HtmlAgilityPack.HtmlNode = h.DocumentNode.SelectSingleNode("//div//div")

            '-------------------------------------------------------------------

            ' mybb إنشاء إتصال مع

            Using conn As New MySqlConnection(gmybbstr)

                ' تكوين جملة إسكويل للإضافة

                Dim sql As String = _

                    " INSERT INTO `mybb_users` " & _

                    "   ( `username`, `password`, `salt`, `email`, `postnum`, `threadnum`, `website`, `usertitle`, `usergroup`, `additionalgroups`, `signature`, `buddylist`, `ignorelist`, `pmfolders`, `notepad`, `usernotes` ) " & _

                    " VALUES " & _

                    "   ( @username , @password , @salt , @email , @postnum , @threadnum , @website , @usertitle , @usergroup , @additionalgroups , @signature , @buddylist , @ignorelist , @pmfolders , @notepad , @usernotes  ) "

                Using comm As New MySqlCommand(sql, conn)

                    ff("________________________________________" & vbNewLine & "حفظ اسم المستخدم: " & th.InnerText.Trim)

                    comm.Parameters.AddWithValue("@username", th.InnerText.Trim)

                    comm.Parameters.AddWithValue("@password", row("password"))

                    comm.Parameters.AddWithValue("@salt", row("salt"))

                    comm.Parameters.AddWithValue("@email", row("email"))

                    comm.Parameters.AddWithValue("@postnum", "0")

                    comm.Parameters.AddWithValue("@threadnum", "0")

                    comm.Parameters.AddWithValue("@website", row("homepage"))

                    comm.Parameters.AddWithValue("@usertitle", th2.InnerText.Trim)

                    Select Case row("usergroupid")

                        Case "1" : comm.Parameters.AddWithValue("@usergroup", "1")

                        Case "2" : comm.Parameters.AddWithValue("@usergroup", "2")

                        Case "3" : comm.Parameters.AddWithValue("@usergroup", "5")

                        Case "4" : comm.Parameters.AddWithValue("@usergroup", "5")

                        Case "5" : comm.Parameters.AddWithValue("@usergroup", "3")

                        Case "6" : comm.Parameters.AddWithValue("@usergroup", "4")

                        Case "7" : comm.Parameters.AddWithValue("@usergroup", "6")

                        Case "8" : comm.Parameters.AddWithValue("@usergroup", "7")

                    End Select

                    comm.Parameters.AddWithValue("@additionalgroups", row("membergroupids"))

                    comm.Parameters.AddWithValue("@signature", toqee.InnerHtml)

                    comm.Parameters.AddWithValue("@buddylist", "")

                    comm.Parameters.AddWithValue("@ignorelist", "")

                    comm.Parameters.AddWithValue("@pmfolders", "")

                    comm.Parameters.AddWithValue("@notepad", "")

                    comm.Parameters.AddWithValue("@usernotes", "")

                    Try

                        ff("بانتظار تفعيل وتنفيذ الحفظ.....")

                        conn.Open()

                        comm.ExecuteNonQuery()

                        conn.Close()

                        ff("تم حفظ العضو: " & th.InnerText.Trim) '& " بنجاح" & vbNewLine & "________________________________________")

                    Catch ex As Exception

                        ff(Err.Description)

                    End Try

                End Using ' comm

            End Using ' conn

        Next

    End Using ' dt

End Sub

Private Sub tuser_importer_ProgressChanged(ByVal sender As Object, ByVal e As System.ComponentModel.ProgressChangedEventArgs) Handles tuser_importer.ProgressChanged

    offset += limit

End Sub

Private Sub tuser_importer_RunWorkerCompleted(ByVal sender As Object, ByVal e As System.ComponentModel.RunWorkerCompletedEventArgs) Handles tuser_importer.RunWorkerCompleted

    If e.Cancelled Then

        ff("تم الايقاف")

    ElseIf IsNothing(e.Error) = False Then

        ff("عفوا يوجد خطا " & vbNewLine & Err.Description)

    ElseIf IsNothing(e.Error) Then

        If tuser_importer.IsBusy = False Then

            If offset < rowsCount Then

                tuser_importer.RunWorkerAsync()

                ff("################################" & vbNewLine & "# تم استيراد الاعضاء  عدد السجلات المضافة : " & (offset) & vbNewLine & "################################")

            Else

                ff("################################" & vbNewLine & "# تم استيراد الاعضاء  عدد السجلات المضافة : " & (rowsCount) & vbNewLine & "################################")

            End If

        End If

    End If

End Sub

.....

دخول
إسم المستخدم
كلمة المرور :	فقدت كلمة المرور ؟
	تذكرني بالمرة القادمة