سريال نمبر الهارد ديسك الحقيقى

[omar elhosseini]

السلام عليكم ورحمة الله وبركاتة

منذ فترة قدمت لكم كيفية الحصول على سريال نمبر الهارد ديسك الحقيقى

الذى لا يتغير ععند عمل فورمات للهارد ديسك

وكان معه ملف مساعد لابد من نسخة الى ملفات النظام يدويا

كان على هذا الرابط لمن اراد الاطلاع على بداية الموضوع :

سريال نمبر الهارد ديسك الحقيقى الذى لا يتغير عند عمل فورمات

ومنذ بضعة ايام اعترض احد الاخوة على انه عند عمل الفورمات يكون الملف المساعد قد تم ازالته

رغم علمنا انه عند عمل الفورمات نقوم بنركيب برامجنا التى نعمل عليها

فلا يجوز ان نحاول تشغيل ملف اكسيل بدون تركيب برنامج الاكسيل من جديد بعد الفورمات

ولكنى وجدت انها فكرة جيده ان يكون استخراج السريال نمر يتضمن نسخ الملف المساعد اتوماتيكيا بدون تدخل

وكان هذا البرنامج

المرفق عبارة عن ملف هو نفس الملف الموجود بالرابط اعلاه ولكن يقوم بنسخ الملف الساعد ( DLL ) اتوماتيكيا

Omar_1.rar

تم تعديل يونيو 4, 2009 بواسطه أبو تامر

[خالد الشاعر]

اشكرك يا استاذى العزيز ابو تامر

واريد اضافة امر If ليقارن السريال مع خالية لمعرفة الصح

اما اذا كانت خطاء فيقفل البرنامج

هل هذا الامر ينفع برجاء التصحيح لخبرتى القليلة

If Sheets("main").Range("a1").Value = 1 Then

Sheets("s1").Range("a2").Value = DriveSerial("c")

الف شكر

[خالد الشاعر]

للرفع

[خالد الشاعر]

للرفع

[ابو احمد 3]

السلام عليكم ورحمة الله وبركاتة

استاذى العزيز ابو تامر

الملف يظهر error '48

ولايستطيع اظهار سريال الهارديسك

[omar elhosseini]

السلام عليكم ورحمة الله وبركاتة

الاخ khhanna

لقد اهتممت هنا بجزئية استخراج السريال نمبر الحقيقى

وليس الخاص بأحد الدريفات سى مثلا الذى يتغير عند عمل الفورمات

وموضوعات الحماية بالسريال نمبر كثيرة بالمنتدى

يمكن استخدام الرقم الحقيقى خاصتنا بدلا من الرقم الخاص بالدريف سى المستخدم مع احد هذه البرامج

ولكنى فى القريب سأقوم بتجهز نموذوج للحماية ولكن بدون وعد منا إن شاء الله

الاخ ابو احمد 3

هذا الخطأ يعنى حدوث خطأ اثناء تشغيل ملف ( DLL )

فقد يكون الملف به خطأ واحتمالات ذلك كثير ( فيرس - حدوث خطأ يالهارد ديسك نتيجة فصل التيار الكهربى)

يمكن مسح هذا الملف من ملفات النظام يدويا فى فلدر (System32)

ثم تحميل البرنامج من المشاركة الاولى لضمان صلاحيته واعادة التشغيل

على العموم مرفق ملف عند الضغط على الزر يقوم بإلعاء ملف ( DLL ) اتوماتيكيا

( يجب غلق الاكسيل او جميع ملفات الاكسيل اولا ثم تشغيل المرفق )

ملحوظة :

اذا لم يتم تصحيح الاوضاع يجب اخبارى او التأكد من الاتى :::

1 - هل تم استخرج السريال نمبر عن طريق ملفنا حتى ولو مرة واحدة ثم حصل هذا المشكل

2 - التجربة على جهاز اخر بنسخة محملة من المنتدى مأمونة

المرفق

Del_DLL.rar

[ابو احمد 3]

استاذنا الفاضل أبو تامر

شكرا على سرعة الرد

وللعلم انا حصلت على السريال نمر عن طريق ملفكم الاول الغير اتوماتيكيا

والمشكلة حدثت عند استخدام نسخ الملف المساعد اتوماتيكيا

جارى اتباع الارشادات والتنفيذ والافادة بما حدث

[يوسف عطا]

عندى سؤال

ماهى ضرورة معرفة رقم السيريال نمبر للهارد ؟؟

الف شكر

[Akram Galal]

الأساتذة االأفاضل الملف لا يعمل مع ويندوز 7

لا يظهر أي شيء عند الضغط علي الزر

أرجو المساعدة

وشكراً .

هذا هو 

Imports System.ManagementPublic Class License    Public Shared Function GetHDDSerialN(Optional ByVal DriverLetter As String = "C")        If DriverLetter = "C" Or DriverLetter = Nothing Then            DriverLetter = "C"        End If        Dim myHDD = New ManagementObject("Win32_logicalDisk.DeviceID=""" & DriverLetter & ":""")        myHDD.Get()        Return myHDD("VolumeSerialNumber").ToString    End Function    Public Shared Function GetPrimarykey(ByVal HDDSerial As String)        Dim Primary_key As String = ""        Dim HDD_SeryalN As String = HDDSerial.ToUpper        For i As Integer = 0 To HDD_SeryalN.Length - 1            Dim OledChr As Char = HDD_SeryalN(i)            Dim newChr As Char            If IsNumeric(OledChr) Then                newChr = Chr(((Val(OledChr) + i + 5) Mod 10) + 48)                Primary_key += newChr            Else                newChr = Chr(((Val(Asc(OledChr) - 65) + i + 3) Mod 27) + 65)                Primary_key += newChr            End If        Next        Return Primary_key    End Function    Public Shared Function GetFinalKey(ByVal Primarykey As String) As String        Dim Finalkey As String = ""        Dim Primary_key As String = Primarykey.ToUpper        For i As Integer = 0 To Primary_key.Length - 1            Dim OledChr As Char = Primary_key(i)            Dim NewChr As Char            If IsNumeric(OledChr) Then                NewChr = Chr(((Val(OledChr) + i + 3) Mod 10) + 48)                Finalkey += NewChr            Else                NewChr = Chr(((Val(Asc(OledChr) - 65) + i + 5) Mod 27) + 65)                Finalkey += NewChr            End If        Next        Return Finalkey    End Function    Public Shared Function GetSerial(ByVal Key As String) As String        Try            'Key= KJDFLKSJDFEPOR            Dim NativeSerial As String = "1111122222333334444455555"            Dim Serial As String = ""            Dim OledChar As Char            Dim newChar As Char            Dim Index As Integer = 0            For I As Integer = 0 To NativeSerial.Length - 1                Index = I Mod (Key.Length - 1)                OledChar = NativeSerial(I)                newChar = Chr((Asc(OledChar) - 65 + Asc(Key(Index))) Mod 26 + 65)                Serial += newChar            Next            Return Serial        Catch ex As Exception        End Try    End FunctionEnd Class2_Add FormImports DevExpress.XtraEditorsImports DevExpress.LookAndFeelImports System.ObjectImports Microsoft.Win32Public Class FrmSerial    Dim RE = Microsoft.Win32.Registry.GetValue("HKEY_CURRENT_USER\Worldtec", "t", "10")    'Dim RE1 = Microsoft.Win32.Registry.GetValue("HKEY_CURRENT_USER\Worldtec", "statlog", "")    'Dim RE2 = Microsoft.Win32.Registry.GetValue("HKEY_CURRENT_USER\Worldtec", "t", "10")    Public selecvalue As Integer    Private Sub Login_Load(sender As Object, e As EventArgs) Handles Me.Load        LookAndFeel.SkinName = My.Settings.Skin        DefaultLookAndFeel1.LookAndFeel.SkinName = My.Settings.Skin        If Microsoft.Win32.Registry.GetValue("HKEY_CURRENT_USER\Worldtec", "statlog", "") = "exp" Then            HyperlinkLabelControl4.Enabled = False            If RE Is Nothing Then                Microsoft.Win32.Registry.CurrentUser.CreateSubKey("Worldtec")                Microsoft.Win32.Registry.SetValue("HKEY_CURRENT_USER\Worldtec", "t", "10")            Else                If RE <= "0" Then                    ProgressBar1.Position = RE                    Lex.Text = "انتهت صلاحية استخدام البرنامج"                    LblSerial.Text = "Not Serial Number"                Else                    RE = RE - 1                    Microsoft.Win32.Registry.SetValue("HKEY_CURRENT_USER\Worldtec", "t", RE)                    ProgressBar1.Position = RE                    Lex.Text = "باقي لك على استخدام البرنامج " & RE & " مرة "                    FrmMain.Show()                End If            End If        Else        End If        Dim HDDserial As String = License.GetHDDSerialN        T1.Text = License.GetPrimarykey(HDDserial)        If Microsoft.Win32.Registry.GetValue("HKEY_CURRENT_USER\Worldtec", "statlog", "") = "serial" Then            If T1.Text <> "" Then                Dim Primarykey As String = License.GetPrimarykey(T1.Text)                Dim finalKey As String = License.GetFinalKey(Primarykey)                Dim serial As String = License.GetSerial(finalKey)                S1.Text = Microsoft.Win32.Registry.GetValue("HKEY_CURRENT_USER\Worldtec", "S1", "")                S2.Text = Microsoft.Win32.Registry.GetValue("HKEY_CURRENT_USER\Worldtec", "S2", "")                S3.Text = Microsoft.Win32.Registry.GetValue("HKEY_CURRENT_USER\Worldtec", "S3", "")                S4.Text = Microsoft.Win32.Registry.GetValue("HKEY_CURRENT_USER\Worldtec", "S4", "")                S5.Text = Microsoft.Win32.Registry.GetValue("HKEY_CURRENT_USER\Worldtec", "S5", "")                If S1.Text + S2.Text + S3.Text + S4.Text + S5.Text = serial Then                    serialtrue()                    ActeveSerial.Text = "لقد قمت بالفعل بتفعيل الرقم التسلسلي  "                    ActeveSerial.ForeColor = Color.Green                    HyperlinkLabelControl4.Enabled = False                Else                    serialFalse()                    ActeveSerial.Text = "الرجاء ادخال الرقم التسلسلي "                    ActeveSerial.ForeColor = Color.Red                End If            End If        End If        If Microsoft.Win32.Registry.GetValue("HKEY_CURRENT_USER\Worldtec", "statlog", "") = "" Then            serialFalse()            ActeveSerial.Text = "الرجاء ادخال الرقم التسلسلي "            ActeveSerial.ForeColor = Color.Red        End If         End Sub    Private Sub PictureBox1_MouseDown(sender As Object, e As MouseEventArgs)        x = Control.MousePosition.X - Me.Location.X        y = Control.MousePosition.Y - Me.Location.Y    End Sub    Private Sub PictureBox1_MouseMove(sender As Object, e As MouseEventArgs)        If e.Button = Windows.Forms.MouseButtons.Left Then            newpoint = Control.MousePosition            newpoint.X -= x            newpoint.Y -= y            Me.Location = newpoint            Application.DoEvents()        End If    End Sub    Public pos As Integer    Private Sub Login_MouseDown(sender As Object, e As MouseEventArgs) Handles Me.MouseDown        x = Control.MousePosition.X - Me.Location.X        y = Control.MousePosition.Y - Me.Location.Y    End Sub    Private Sub Login_MouseMove(sender As Object, e As MouseEventArgs) Handles Me.MouseMove        If e.Button = Windows.Forms.MouseButtons.Left Then            newpoint = Control.MousePosition            newpoint.X -= x            newpoint.Y -= y            Me.Location = newpoint            Application.DoEvents()        End If    End Sub    Sub serialtrue()        'TabLogin.        S1.Enabled = False        S2.Enabled = False        S3.Enabled = False        S4.Enabled = False        S5.Enabled = False        ApplySerial.Enabled = False        HyperlinkLabelControl3.Enabled = False        FrmMain.Show()        Me.Hide()    End Sub    Sub serialFalse()        S1.Enabled = True        S2.Enabled = True        S3.Enabled = True        S4.Enabled = True        S5.Enabled = True        ApplySerial.Enabled = True        HyperlinkLabelControl3.Enabled = True        Me.Show()        LblSerial.Text = "Not Serial Number"    End Sub    Private Sub SimpleButton1_Click_1(sender As Object, e As EventArgs) Handles ApplySerial.Click        If T1.Text <> "" Then            Dim HDDserial As String = License.GetHDDSerialN            Dim Primarykey As String = License.GetPrimarykey(T1.Text)            Dim finalKey As String = License.GetFinalKey(Primarykey)            Dim serial As String = License.GetSerial(finalKey)            If S1.Text + S2.Text + S3.Text + S4.Text + S5.Text = serial Then                Microsoft.Win32.Registry.SetValue("HKEY_CURRENT_USER\Worldtec", "S1", S1.Text)                Microsoft.Win32.Registry.SetValue("HKEY_CURRENT_USER\Worldtec", "S2", S2.Text)                Microsoft.Win32.Registry.SetValue("HKEY_CURRENT_USER\Worldtec", "S3", S3.Text)                Microsoft.Win32.Registry.SetValue("HKEY_CURRENT_USER\Worldtec", "S4", S4.Text)                Microsoft.Win32.Registry.SetValue("HKEY_CURRENT_USER\Worldtec", "S5", S5.Text)                Microsoft.Win32.Registry.SetValue("HKEY_CURRENT_USER\Worldtec", "statlog", "serial")                serialtrue()                LblSerial.Text = HDDserial                ActeveSerial.Text = "الرقم التسلسلي صحيح"                ActeveSerial.ForeColor = Color.Green            Else                serialFalse()                ActeveSerial.Text = "الرقم التسلسلي خاطئ"                ActeveSerial.ForeColor = Color.Red            End If        End If    End Sub    Private Sub HyperlinkLabelControl3_Click(sender As Object, e As EventArgs) Handles HyperlinkLabelControl3.Click        S1.Text = ""        S2.Text = ""        S3.Text = ""        S4.Text = ""        S5.Text = ""    End Sub    Private Sub HyperlinkLabelControl4_Click(sender As Object, e As EventArgs) Handles HyperlinkLabelControl4.Click        Microsoft.Win32.Registry.SetValue("HKEY_CURRENT_USER\Worldtec", "statlog", "exp")        XtraMessageBox.Show("سوف يتم اغلاق البرنامج قم بإعادة فتحه من جديد", "تجريبي", MessageBoxButtons.OK, MessageBoxIcon.Warning)        End    End Sub  End Class