نجوم المشاركات

الاكواد المستخدمة :- نحن استخدمنا هذه الوحدة النمطية بها اربع فانكشن Option Compare Database Public Function NumMoaalic() ' لاستخراج سريال المعالج ' Microsoft WMI Scripting v2.1 library ستحتاج مكتبة Dim varObjectToId As String Dim varSerial As String On Error Resume Next varObjectToId = "Win32_Processor,ProcessorId" Set SWbemSet = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf(Split(varObjectToId, ",")(0)) varSerial = "" For Each SWbemObj In SWbemSet varSerial = SWbemObj.Properties_(Split(varObjectToId, ",")(1)) varSerial = Trim(varSerial) If Len(varSerial) < 1 Then varSerial = "Unknown value" Next NumMoaalic = varSerial End Function Public Function NumHard() ' لاستخراج سريال ھارد ' Microsoft WMI Scripting v2.1 library ستحتاج مكتبة Dim varObjectToId As String Dim varSerial As String On Error Resume Next varObjectToId = "Win32_OperatingSystem,SerialNumber" Set SWbemSet = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf(Split(varObjectToId, ",")(0)) varSerial = "" For Each SWbemObj In SWbemSet varSerial = SWbemObj.Properties_(Split(varObjectToId, ",")(1)) varSerial = Trim(varSerial) If Len(varSerial) < 1 Then varSerial = "Unknown value" Next NumHard = varSerial End Function Function TxtToNumber(ByVal C As String) As String ' مساعد لتحويل الحروف والرموز الى الارقام ' حسب ما تريدون تقدرون ان تغير الارقام والحروف حسب رغبتكم Select Case C Case "A", "J", "R": TxtToNumber = 9 Case "B", "K", "S": TxtToNumber = 1 Case "C", "L", "T": TxtToNumber = 7 Case "D", "M", "U": TxtToNumber = 3 Case "E", "N", "V": TxtToNumber = 5 Case "F", "O", "W": TxtToNumber = 8 Case "G", "P", "X": TxtToNumber = 2 Case "H", "Y": TxtToNumber = 6 Case "I", "Q", "Z": TxtToNumber = 4 Case "-", "_", "\", " ", "/", ";", ":": TxtToNumber = "" Case Else TxtToNumber = C End Select End Function Function TxtInTextToNumber(SText) ' لتغيير الحروف والرموز الى الارقام Dim Numbers Dim I As Integer ' سيبحث عن الكل الحروف و الرموز وسيغير حسب فانكشن الاعلى For I = 1 To Len(SText) If IsNumeric(Mid(SText, I, 1)) Then Numbers = Numbers & Mid(SText, I, 1) Else Numbers = Numbers & TxtToNumber(Mid(SText, I, 1)) End If Next TxtInTextToNumber = Trim(Numbers) End Function وفي النموذج استخدمنا هذه الاكواد مع شرح Option Compare Database ' تم اعداد من قبل ' Shivan Rekany شفان ريکاني ' وليس لدينا مانع استخدامه في برامجكم فقط نريد منكم الدعاء Dim WqtTascil As Long ' متغير لتعرف عن الوقت التسجيل Private Sub Form_Load() ' كود عند تحميل النموذج 'On Error Resume Next Dim NumBeforeTascil, NumForTascil ' متغيران واحد لکي نعرف رقم الاول للتسجيل قبل استخدام الوقت والاخر رقم تسجيل الحقيقي Dim Spl() As String, LookAllMNT As String ' متغيران الثاني لكي نعرف كل معلومات في الجدول اذا تم تسجيل البرامج من قبل والاخر للتجزئة المعلومات Dim LookMyNm, LookMyNh, LookMyNTascil ' مساعد تجزئة المعومات Dim FrqDate As Integer ' متغير نستخدم لفرق بين تاريخ التسجيل و الدخول Dim FDate As Date, EDate As Date ' متغيران واحد للتاريخ التسجيل والثاني لاخر مرة لفتح البرامج ' رقم قبل تسجيل يساوي رقم واحد مع تحول سريال المعالج الى الارقام مع تحويل سريال الارد تقسيم واحد مع تحويل سريال الهارد NumBeforeTascil = Trim(Round(((1 & TxtInTextToNumber(NumMoaalic) & TxtInTextToNumber(NumHard)) / (1 & TxtInTextToNumber(NumHard))))) ' جميع المعلومات يساوي جلب بيانات الحقل سريال المعالج و الهارد ورقم التسجيل و مدة التسجيل و تاريخ التسجيل و تاريخ اخر مرة الدخول في جدول تبل التسجيل ' بشرط ان يكون سريال المعالج والهارد في جدول بيكون يساوي مع سريال المعالج والهارد اللي يخررجه الفانكشن LookAllMNT = Nz(DLookup("[NumForMoaalic] & ""|"" & [NumForHard] & ""|"" & [NumTascil] & ""|"" & [midda] & ""|"" &[firstdate] & ""|"" & [EndDate] ", "TblTascil", _ "[NumForHard]='" & NumHard & "'" & "and [NumForMoaalic]='" & NumMoaalic & "'"), "") If LookAllMNT <> "" Then ' اذا يجد المعلوماتولم يكون فارغة Spl = Split(LookAllMNT, "|") ' قم بتجزئة كل المعلوةمات حسب رمز هذا الرمز | ' الان عطينا لكل متغير جزئه حسب ما جلبنا في الجدول LookMyNm = Spl(0): LookMyNh = Spl(1): LookMyNTascil = Spl(2): Me.Midde = Spl(3): FDate = Spl(4): EDate = Spl(5) ' فرق بين تاريخين تاريخ الان مع اضافة مدة التفعيل مع اخر تاريخ الدخول FrqDate = DateDiff("d", Now, DateAdd("d", Me.Midde, FDate)) If Me.Midde.Column(0) = 1 Then ' اذا كان عمود المرقم بصفر في كومبوبوكس مدة بيكون يساوي رقم 1 WqtTascil = Format(FDate, "yyyymmdd") ' وقت التسجيل بيكون هذا النوع ' ورقم التسجيل بيكون 15 ارقام من تقسيم رقم قبل التسجيل تقسيم وقت التسجيل * 212 و استبدال نقطة (.) ب لا شيء NumForTascil = Mid(Replace(((NumBeforeTascil / WqtTascil)) * 212, ".", ""), 1, 15) ElseIf Me.Midde.Column(0) = 7 Then ' اذا كان عمود المرقم بصفر في كومبوبوكس مدة بيكون يساوي رقم 1 WqtTascil = Format(FDate, "yyyymmdd") + 3 ' وقت التسجيل يساوي سنة و شهر و يوم زائد 3 ' ورقم التسجيل بيكون 15 ارقام من تقسيم رقم قبل التسجيل تقسيم وقت التسجيل ضرب 3 تقسيم 212 و استبدال نقطة (.) ب لا شيء NumForTascil = Mid(Replace(((NumBeforeTascil / WqtTascil) * 3) / 212, ".", ""), 1, 15) ElseIf Me.Midde.Column(0) = 30 Then ' اذا كان عمود المرقم بصفر في كومبوبوكس مدة بيكون يساوي رقم 30 WqtTascil = Format(FDate, "yyyymmdd") + 15 ' وقت التسجيل يساوي سنة و شهر و يوم زائد 15 ' ورقم التسجيل بيكون 15 ارقام من تقسيم رقم قبل التسجيل تقسيم وقت التسجيل ضرب 15 تقسيم 212 و استبدال نقطة (.) ب لا شيء NumForTascil = Mid(Replace(((NumBeforeTascil / WqtTascil) * 15) / 212, ".", ""), 1, 15) ElseIf Me.Midde.Column(0) = 90 Then ' اذا كان عمود المرقم بصفر في كومبوبوكس مدة بيكون يساوي رقم 90 WqtTascil = Format(FDate, "yyyymm") + 45 ' وقت التسجيل يساوي سنة و شهر زائد 45 ' ورقم التسجيل بيكون 15 ارقام من تقسيم رقم قبل التسجيل تقسيم وقت التسجيل ضرب 45 تقسيم 212 و استبدال نقطة (.) ب لا شيء NumForTascil = Mid(Replace(((NumBeforeTascil / WqtTascil) * 45) / 212, ".", ""), 1, 15) ElseIf Me.Midde.Column(0) = 180 Then ' اذا كان عمود المرقم بصفر في كومبوبوكس مدة بيكون يساوي رقم 180 WqtTascil = Format(FDate, "yyyymm") + 90 ' وقت التسجيل يساوي سنة و شهر زائد 90 ' ورقم التسجيل بيكون 15 ارقام من تقسيم رقم قبل التسجيل تقسيم وقت التسجيل ضرب 90 تقسيم 212 و استبدال نقطة (.) ب لا شيء NumForTascil = Mid(Replace(((NumBeforeTascil / WqtTascil) * 90) / 212, ".", ""), 1, 15) ElseIf Me.Midde.Column(0) = 365 Then ' اذا كان عمود المرقم بصفر في كومبوبوكس مدة بيكون يساوي رقم 365 WqtTascil = Format(FDate, "yyyymm") + 182 ' وقت التسجيل يساوي سنة و شهر زائد 182 ' ورقم التسجيل بيكون 15 ارقام من تقسيم رقم قبل التسجيل تقسيم وقت التسجيل ضرب 182 تقسيم 212 و استبدال نقطة (.) ب لا شيء NumForTascil = Mid(Replace(((NumBeforeTascil / WqtTascil) * 182) / 212, ".", ""), 1, 15) ElseIf Me.Midde.Column(0) = 18250 Then ' اذا كان عمود المرقم بصفر في كومبوبوكس مدة بيكون يساوي رقم 18250 WqtTascil = Format(FDate, "yyyymm") + 9125 ' وقت التسجيل يساوي سنة و شهر زائد 9125 ' ورقم التسجيل بيكون 15 ارقام من تقسيم رقم قبل التسجيل تقسيم وقت التسجيل ضرب 9125 تقسيم 212 و استبدال نقطة (.) ب لا شيء NumForTascil = Mid(Replace(((NumBeforeTascil / WqtTascil) * 9125) / 212, ".", ""), 1, 15) End If End If ' اذا احد من رقم التسجيل في جدول او سريال الهارد او المعالج بيكون مخالف مع رقم التسجيل او سريال المعالج او الهارد الجهاز If LookMyNTascil <> NumForTascil Or LookMyNm <> NumMoaalic Or LookMyNh <> NumHard Then Me.LblTxt.Caption = "يجب عليك ان تعمل تسجيل البرامج اولا ... للتسجيل اتصل بالمبرمج " Me.NM = NumMoaalic ' مربع في النموذج اللي باسم نون ميم بيكون يساوي سريال المعالج Me.NH = NumHard ' مربع في النموذج اللي باسم نون ئيج بيكون يساوي سريال الهارد ElseIf FDate > Now Or EDate > Now Then ' اذا اول تاريخ بيكون اكبر من الوقت الحاضر او تاريخ اخر مرة للدخول اكبر من الوقت الحاضر MsgBox "تم تلاعب بتاريخ الجهاز ... وهذا غير مقبول , سيتم اغلاق البرامج" DoCmd.Quit ' اغلاق القاعدة ElseIf FrqDate <= 15 And FrqDate > 0 Then ' اذا فرق بين تاريخين يساوي او اقل من 15 يوم و فرق بين تاريخين اكبر من رقم صفر ' بيظهر الرسالة وبيظهر باقي عدد ايام المتبقية لتفعيل البرامج ويسأل هل يريد تسجيله من جديد اذا يختار نعم If MsgBox("باقي عندك " & "( " & FrqDate & " )" & " يوم لانتهاء فترة التسجيل , هل تريد ان تعمل تسجيل من جديد ؟ ", vbMsgBoxRtlReading + vbYesNo + vbQuestion + vbMsgBoxRight, "تسجيل البرامج") = vbYes Then Me.LblTxt.Caption = "يجب عليك ان تعمل تسجيل البرامج اولا ... للتسجيل اتصل بالمبرمج " Me.NM = NumMoaalic ' مربع في النموذج اللي باسم نون ميم بيكون يساوي سريال المعالج Me.NH = NumHard ' مربع في النموذج اللي باسم نون ئيج بيكون يساوي سريال الهارد Else ' والا DoCmd.OpenForm "frmsereki", acNormal ' فتح نموذج اخر DoCmd.Close acForm, Me.Name ' اغلاق هذا النموذج End If ElseIf FrqDate <= 0 Then ' اذا صفر بيكون اكبر او يساوي فرق بين تاريخين ' يظهر الرسالة ويخبره بان تم انتهاء مدة التفعيل والسؤال عن تسجيل من جديد واذا اختار نعم If MsgBox("انتهت مدة التفعيل البرامج , هل تريد ان تعمل تسجيل من جديد ؟", vbMsgBoxRtlReading + vbYesNo + vbQuestion + vbMsgBoxRight, "تسجيل البرامج") = vbYes Then Me.LblTxt.Caption = "يجب عليك ان تعمل تسجيل البرامج اولا ... للتسجيل اتصل بالمبرمج " Me.NM = NumMoaalic ' مربع في النموذج اللي باسم نون ميم بيكون يساوي سريال المعالج Me.NH = NumHard ' مربع في النموذج اللي باسم نون ئيج بيكون يساوي سريال الهارد Else ' والا اي اذا اختار لا يريد التسجيل من جديد DoCmd.Quit ' سيغلق القاعدة End If Else ' واذا لم يكون هناك اي شيء من الاول DoCmd.OpenForm "frmsereki", acNormal ' فتح نموذج الاخر DoCmd.Close acForm, Me.Name ' واغلاق نموذج الحالي End If DoCmd.SetWarnings False ' اسكات الرسائل التنبيهية ' تحديث اخر تاريخ الدخول في جدول بتاريخ الان DoCmd.RunSQL "UPDATE TblTascil SET TblTascil.EndDate = Now() WHERE (((TblTascil.NumForHard)=NumHard()) AND ((TblTascil.NumForMoaalic)=NumMoaalic()));" DoCmd.SetWarnings True ' تفعيل تنبيهات الافتراضية End Sub Private Sub Tascil_Click() ' كود عند الضغط على زر التسجيل On Error Resume Next ' "1";"7";"30";"90";"180";"365";"18250" Dim NumBeforeTascil, NumForTascil ' متغيران واحد لکي نعرف رقم الاول للتسجيل قبل استخدام الوقت والاخر رقم تسجيل الحقيقي Dim Spl() As String, LookAllMNT As String ' متغيران الثاني لكي نعرف كل معلومات في الجدول اذا تم تسجيل البرامج من قبل والاخر للتجزئة المعلومات Dim LookMyNm, LookMyNh, LookMyNTascil ' مساعد تجزئة المعومات Dim FrqDate As Integer ' متغير نستخدم لفرق بين تاريخ التسجيل و الدخول ' اذا كان كومبوبوكس مدة التفعيل في النموذج بيكون خالي من البيانات يظهر رسالة ويخبره و يركز على الكومبوبوكس وينتهي مشوار ضغط على الزر If Len(Me.Midde & "") = 0 Then MsgBox "اختر مدة التفعيل": Me.Midde.SetFocus: Exit Sub ' رقم قبل تسجيل يساوي رقم واحد مع تحول سريال المعالج الى الارقام مع تحويل سريال الارد تقسيم واحد مع تحويل سريال الهارد NumBeforeTascil = Trim(Round(((1 & TxtInTextToNumber(NumMoaalic) & TxtInTextToNumber(NumHard)) / (1 & TxtInTextToNumber(NumHard))))) ' جميع المعلومات يساوي جلب بيانات الحقل سريال المعالج و الهارد ورقم التسجيل و مدة التسجيل و تاريخ التسجيل و تاريخ اخر مرة الدخول في جدول تبل التسجيل ' بشرط ان يكون سريال المعالج والهارد في جدول بيكون يساوي مع سريال المعالج والهارد اللي يخررجه الفانكشن LookAllMNT = Nz(DLookup("[NumForMoaalic] & ""|"" & [NumForHard] & ""|"" & [NumTascil] ", "TblTascil", _ "[NumForHard]='" & NumHard & "'" & "and [NumForMoaalic]='" & NumMoaalic & "'"), "") Spl = Split(LookAllMNT, "|") ' قم بتجزئة كل المعلوةمات حسب رمز هذا الرمز | ' الان عطينا لكل متغير جزئه حسب ما جلبنا في الجدول LookMyNm = Spl(0): LookMyNh = Spl(1): LookMyNTascil = Spl(2) ' فرق بين تاريخين تاريخ الان مع اضافة مدة التفعيل مع اخر تاريخ الدخول FrqDate = DateDiff("d", Now, DateAdd("d", Me.Midde, FDate)) If Me.Midde.Column(0) = 1 Then ' اذا كان عمود المرقم بصفر في كومبوبوكس مدة بيكون يساوي رقم 1 WqtTascil = Format(Date, "yyyymmdd") ' وقت التسجيل بيكون هذا النوع ' ورقم التسجيل بيكون 15 ارقام من تقسيم رقم قبل التسجيل تقسيم وقت التسجيل * 212 و استبدال نقطة (.) ب لا شيء NumForTascil = Mid(Replace(((NumBeforeTascil / WqtTascil)) * 212, ".", ""), 1, 15) ElseIf Me.Midde.Column(0) = 7 Then ' اذا كان عمود المرقم بصفر في كومبوبوكس مدة بيكون يساوي رقم 1 WqtTascil = Format(Date, "yyyymmdd") + 3 ' وقت التسجيل يساوي سنة و شهر و يوم زائد 3 ' ورقم التسجيل بيكون 15 ارقام من تقسيم رقم قبل التسجيل تقسيم وقت التسجيل ضرب 3 تقسيم 212 و استبدال نقطة (.) ب لا شيء NumForTascil = Mid(Replace(((NumBeforeTascil / WqtTascil) * 3) / 212, ".", ""), 1, 15) ElseIf Me.Midde.Column(0) = 30 Then ' اذا كان عمود المرقم بصفر في كومبوبوكس مدة بيكون يساوي رقم 30 WqtTascil = Format(Date, "yyyymmdd") + 15 ' وقت التسجيل يساوي سنة و شهر و يوم زائد 15 ' ورقم التسجيل بيكون 15 ارقام من تقسيم رقم قبل التسجيل تقسيم وقت التسجيل ضرب 15 تقسيم 212 و استبدال نقطة (.) ب لا شيء NumForTascil = Mid(Replace(((NumBeforeTascil / WqtTascil) * 15) / 212, ".", ""), 1, 15) ElseIf Me.Midde.Column(0) = 90 Then ' اذا كان عمود المرقم بصفر في كومبوبوكس مدة بيكون يساوي رقم 90 WqtTascil = Format(Date, "yyyymm") + 45 ' وقت التسجيل يساوي سنة و شهر زائد 45 ' ورقم التسجيل بيكون 15 ارقام من تقسيم رقم قبل التسجيل تقسيم وقت التسجيل ضرب 45 تقسيم 212 و استبدال نقطة (.) ب لا شيء NumForTascil = Mid(Replace(((NumBeforeTascil / WqtTascil) * 45) / 212, ".", ""), 1, 15) ElseIf Me.Midde.Column(0) = 180 Then ' اذا كان عمود المرقم بصفر في كومبوبوكس مدة بيكون يساوي رقم 180 WqtTascil = Format(Date, "yyyymm") + 90 ' وقت التسجيل يساوي سنة و شهر زائد 90 ' ورقم التسجيل بيكون 15 ارقام من تقسيم رقم قبل التسجيل تقسيم وقت التسجيل ضرب 90 تقسيم 212 و استبدال نقطة (.) ب لا شيء NumForTascil = Mid(Replace(((NumBeforeTascil / WqtTascil) * 90) / 212, ".", ""), 1, 15) ElseIf Me.Midde.Column(0) = 365 Then ' اذا كان عمود المرقم بصفر في كومبوبوكس مدة بيكون يساوي رقم 365 WqtTascil = Format(Date, "yyyymm") + 182 ' وقت التسجيل يساوي سنة و شهر زائد 182 ' ورقم التسجيل بيكون 15 ارقام من تقسيم رقم قبل التسجيل تقسيم وقت التسجيل ضرب 182 تقسيم 212 و استبدال نقطة (.) ب لا شيء NumForTascil = Mid(Replace(((NumBeforeTascil / WqtTascil) * 182) / 212, ".", ""), 1, 15) ElseIf Me.Midde.Column(0) = 18250 Then ' اذا كان عمود المرقم بصفر في كومبوبوكس مدة بيكون يساوي رقم 18250 WqtTascil = Format(Date, "yyyymm") + 9125 ' وقت التسجيل يساوي سنة و شهر زائد 9125 ' ورقم التسجيل بيكون 15 ارقام من تقسيم رقم قبل التسجيل تقسيم وقت التسجيل ضرب 9125 تقسيم 212 و استبدال نقطة (.) ب لا شيء NumForTascil = Mid(Replace(((NumBeforeTascil / WqtTascil) * 9125) / 212, ".", ""), 1, 15) End If If Me.NTascil = NumForTascil Then ' اذا كان رقم التسجيل المدخلة بيكون يساوي مع رقم التسجيل الحقيقي للبرامج If LookAllMNT <> "" Then ' اذا هذه ليس اول مرة يسجل على هذه الجهاز DoCmd.SetWarnings False ' اطفاء تنبيهات الافتراضية للنظام ' تحديث المعلومات في الجدول حسب معلومات التفعيل الجديدة DoCmd.RunSQL "UPDATE TblTascil SET TblTascil.NumForMoaalic = [Forms]![FrmTescil]![NM], TblTascil.NumForHard = [Forms]![FrmTescil]![NH]," & _ "TblTascil.NumTascil = [Forms]![FrmTescil]![NTascil], TblTascil.Midda = [Forms]![FrmTescil]![Midde], TblTascil.firstdate = Now(), " & _ " TblTascil.EndDate = Now() WHERE (((TblTascil.NumForMoaalic)=NumMoaalic()) AND ((TblTascil.NumForHard)=NumHard()));" DoCmd.SetWarnings True ' تشغيل تنبيهات الافتراضية للنظام Else ' واذا هذه المرة هي اول مرة للتسجيل ' اضافة معلومات التفعيل الى جدول DoCmd.SetWarnings False ' اطفاء تنبيهات الافتراضية للنظام DoCmd.RunSQL "INSERT INTO TblTascil ( NumForMoaalic, NumForHard, NumTascil, Midda, firstdate, EndDate ) " & _ "SELECT [Forms]![FrmTescil]![NM] AS Expr1, [Forms]![FrmTescil]![NH] AS Expr2, [Forms]![FrmTescil]![NTascil] AS Expr3," & _ "[Forms]![FrmTescil]![Midde] aS Expr4, Now() AS Expr5, Now() AS Expr6;" DoCmd.SetWarnings True ' تشغيل تنبيهات الافتراضية للنظام End If MsgBox "تم تسجيل البرامج لمدة " & Me.Midde.Column(1) ' اظهار رسالة ويظهر للمستخدم ان تم تفعيل لمدة المحددة DoCmd.OpenForm "frmsereki", acNormal ' فتح نموذج الاخر DoCmd.Close acForm, Me.Name, acSaveYes ' اغلاق النموذج الحالية وهو نموذج التسجيل ElseIf Len(Me.NTascil & "") = 0 Then ' اذا كان مربع نصي لرقم التسجيل بيكون فارغا MsgBox "اکتب رقم التسجيل ... وحاول مجددأ" ' اظهار رسالة ويخبره بان رقم التسجيل المدخلة خطأ Me.NTascil.SetFocus 'تركيز على مربع نصي لرقم التسجيل في النموذج Else ' والا MsgBox "خطأ في رقم التسجيل ... حاول مجددأ" ' اظهار رسالة ويخبره بان رقم التسجيل المدخلة خطأ Me.NTascil = "" 'قم بافراغ مربع نصي رقم التسجيل في نموذج Me.NTascil.SetFocus 'تركيز على مربع رقم التسجيل في نموذج End If End Sub Private Sub BtnQuit_Click() ' كود عند ضغط على زر اغلاق ' اغلاق القاعدة DoCmd.Quit End Sub وراح نستخدم هذين فانكشنين في وحدة نمطية في قاعدة كراك هو نفس وحدة الفانكشن الاعلى اللس استخدمناه في القاعدة اللي نعطيه للعميل Option Compare Database Function TxtToNumber(ByVal C As String) As String Select Case C Case "A", "J", "R": TxtToNumber = 9 Case "B", "K", "S": TxtToNumber = 1 Case "C", "L", "T": TxtToNumber = 7 Case "D", "M", "U": TxtToNumber = 3 Case "E", "N", "V": TxtToNumber = 5 Case "F", "O", "W": TxtToNumber = 8 Case "G", "P", "X": TxtToNumber = 2 Case "H", "Y": TxtToNumber = 6 Case "I", "Q", "Z": TxtToNumber = 4 Case "-", "_", "\", " ", "/", ";", ":": TxtToNumber = "" Case Else TxtToNumber = C End Select End Function Function TxtInTextToNumber(SText) Dim Numbers Dim I As Integer For I = 1 To Len(SText) If IsNumeric(Mid(SText, I, 1)) Then Numbers = Numbers & Mid(SText, I, 1) Else Numbers = Numbers & TxtToNumber(Mid(SText, I, 1)) End If Next TxtInTextToNumber = Trim(Numbers) End Function مع هذا الكود في النموذج التسجيل في قاعدة كراك Option Compare Database ' تم اعداد من قبل ' Shivan Rekany شفان ريکاني ' وليس لدينا مانع استخدامه في برامجكم فقط نريد منكم الدعاء Private Sub Tascil_Click() ' كود عند الضغط على زر التسجيل On Error Resume Next Dim NumBeforeTascil, NumForTascil ' متغيران واحد لکي نعرف رقم الاول للتسجيل قبل استخدام الوقت والاخر رقم تسجيل الحقيقي Dim WqtTascil ' ھو رقم من التاريخ لکي يقسم عليھ رقم قبل التسجيل ' اذا كان كومبوبوكس مدة التفعيل في النموذج بيكون خالي من البيانات يظهر رسالة ويخبره و يركز على الكومبوبوكس وينتهي مشوار ضغط على الزر If Len(Me.Midde & "") = 0 Then MsgBox "اختر مدة التفعيل": Me.Midde.SetFocus: Exit Sub ' اذا كان كومبوبوكس مدة التفعيل في النموذج بيكون خالي من البيانات يظهر رسالة ويخبره و يركز على الكومبوبوكس وينتهي مشوار ضغط على الزر If Len(Me.NM & "") = 0 Then MsgBox "اكتب رقم المعالج": Me.NM.SetFocus: Exit Sub ' اذا كان كومبوبوكس مدة التفعيل في النموذج بيكون خالي من البيانات يظهر رسالة ويخبره و يركز على الكومبوبوكس وينتهي مشوار ضغط على الزر If Len(Me.NH & "") = 0 Then MsgBox "اكتب رقم الهارد": Me.NH.SetFocus: Exit Sub ' رقم قبل تسجيل يساوي رقم واحد مع تحول سريال المعالج الى الارقام مع تحويل سريال الارد تقسيم واحد مع تحويل سريال الهارد NumBeforeTascil = Trim(Round(((1 & TxtInTextToNumber(Me.NM) & TxtInTextToNumber(Me.NH)) / (1 & TxtInTextToNumber(Me.NH))))) If Me.Midde.Column(0) = 1 Then ' اذا كان عمود المرقم بصفر في كومبوبوكس مدة بيكون يساوي رقم 1 WqtTascil = Format(Date, "yyyymmdd") ' وقت التسجيل بيكون هذا النوع ' ورقم التسجيل بيكون 15 ارقام من تقسيم رقم قبل التسجيل تقسيم وقت التسجيل * 212 و استبدال نقطة (.) ب لا شيء NumForTascil = Mid(Replace(((NumBeforeTascil / WqtTascil)) * 212, ".", ""), 1, 15) ElseIf Me.Midde.Column(0) = 7 Then ' اذا كان عمود المرقم بصفر في كومبوبوكس مدة بيكون يساوي رقم 1 WqtTascil = Format(Date, "yyyymmdd") + 3 ' وقت التسجيل يساوي سنة و شهر و يوم زائد 3 ' ورقم التسجيل بيكون 15 ارقام من تقسيم رقم قبل التسجيل تقسيم وقت التسجيل ضرب 3 تقسيم 212 و استبدال نقطة (.) ب لا شيء NumForTascil = Mid(Replace(((NumBeforeTascil / WqtTascil) * 3) / 212, ".", ""), 1, 15) ElseIf Me.Midde.Column(0) = 30 Then ' اذا كان عمود المرقم بصفر في كومبوبوكس مدة بيكون يساوي رقم 30 WqtTascil = Format(Date, "yyyymmdd") + 15 ' وقت التسجيل يساوي سنة و شهر و يوم زائد 15 ' ورقم التسجيل بيكون 15 ارقام من تقسيم رقم قبل التسجيل تقسيم وقت التسجيل ضرب 15 تقسيم 212 و استبدال نقطة (.) ب لا شيء NumForTascil = Mid(Replace(((NumBeforeTascil / WqtTascil) * 15) / 212, ".", ""), 1, 15) ElseIf Me.Midde.Column(0) = 90 Then ' اذا كان عمود المرقم بصفر في كومبوبوكس مدة بيكون يساوي رقم 90 WqtTascil = Format(Date, "yyyymm") + 45 ' وقت التسجيل يساوي سنة و شهر زائد 45 ' ورقم التسجيل بيكون 15 ارقام من تقسيم رقم قبل التسجيل تقسيم وقت التسجيل ضرب 45 تقسيم 212 و استبدال نقطة (.) ب لا شيء NumForTascil = Mid(Replace(((NumBeforeTascil / WqtTascil) * 45) / 212, ".", ""), 1, 15) ElseIf Me.Midde.Column(0) = 180 Then ' اذا كان عمود المرقم بصفر في كومبوبوكس مدة بيكون يساوي رقم 180 WqtTascil = Format(Date, "yyyymm") + 90 ' وقت التسجيل يساوي سنة و شهر زائد 90 ' ورقم التسجيل بيكون 15 ارقام من تقسيم رقم قبل التسجيل تقسيم وقت التسجيل ضرب 90 تقسيم 212 و استبدال نقطة (.) ب لا شيء NumForTascil = Mid(Replace(((NumBeforeTascil / WqtTascil) * 90) / 212, ".", ""), 1, 15) ElseIf Me.Midde.Column(0) = 365 Then ' اذا كان عمود المرقم بصفر في كومبوبوكس مدة بيكون يساوي رقم 365 WqtTascil = Format(Date, "yyyymm") + 182 ' وقت التسجيل يساوي سنة و شهر زائد 182 ' ورقم التسجيل بيكون 15 ارقام من تقسيم رقم قبل التسجيل تقسيم وقت التسجيل ضرب 182 تقسيم 212 و استبدال نقطة (.) ب لا شيء NumForTascil = Mid(Replace(((NumBeforeTascil / WqtTascil) * 182) / 212, ".", ""), 1, 15) ElseIf Me.Midde.Column(0) = 18250 Then ' اذا كان عمود المرقم بصفر في كومبوبوكس مدة بيكون يساوي رقم 18250 WqtTascil = Format(Date, "yyyymm") + 9125 ' وقت التسجيل يساوي سنة و شهر زائد 9125 ' ورقم التسجيل بيكون 15 ارقام من تقسيم رقم قبل التسجيل تقسيم وقت التسجيل ضرب 9125 تقسيم 212 و استبدال نقطة (.) ب لا شيء NumForTascil = Mid(Replace(((NumBeforeTascil / WqtTascil) * 9125) / 212, ".", ""), 1, 15) End If Me.NTascil = NumForTascil ' مربع رقم التسجيل يساوي رقم التسجيل End Sub Private Sub BtnQuit_Click() ' كود عند ضغط على زر اغلاق ' اغلاق القاعدة DoCmd.Quit End Sub * قاعدة الكراك راح يكون عند المبرمج والاخر سيكون في قاعدة بيانات البرامج اللي يعمله المبرمج ويعطيه للعميل * من الممكن ان يتغير ارقام اي نوع عطاء رقم التفعيل حسب الرغة اتمنى ان يستفيد منه اكبر عدد ممكن من الاعضاء تقبلوا تحياتي ShivanHimaye.rar

السلام عليكم ورحمة اله تعالى وبركاته أما بعد .. استكمالاً لمشاركتي في الموضوع السابق اضع بين ايديكم البرنامج + ملف توليد السيريال .. واعتذر على التأخير ملاحظة : جميع البيانات في الجدول يمكن تشفيرها كلاً حسب طريقته لذلك تركتها بدون تشفير لكي تتضح طريقة عمل البرنامج اتمنى ان ينال اعجابكم تحياتي count-sec.mdb registration_key.mdb

السلام عليكم شكراً للقائمين على هذا المنتدى العملاق من مشرفين واعضاء لني تعلمت منهم الاكثير واتمنى لهم الموفقية والصحة الدائمة ان شاء الله تعالى. اخوتي انا اعرف ان في هذا المنتدى عمالقة التصميم والبرمجة وانا اعلم ان في هذا المنتدى افضل من هذا البرنامج ولكن لرد الجميل هذا المنتدى ارفع هذه نسخة من برنامج الصادر والوارد مفتوح المصدر برابط خارجي صممتة لصديق لي يعمل في شركة .... تحياتي لكم جميعاً.... https://up.top4top.net/downloadf-1058tvebj1-rar.html

السلام عليكم ورحمة الله تعالى وبركاته موضوع اليوم هى اداة صممتها بفيجول بيسك دوت نت مجرد حلقة وصل بين المستخدم وقاعدة البيانات بمعنى اكثر انت كمصمم برامج من خلال قواعد بيانات اكسس سيقلقك موضوع تمكين المحتوى الخاص بك اى تمكين كافة وحدات الماكرو لكى تعمل قاعدة البيانات بصورة طبيعية ولا يقلق العميل وبالتالى لن تذهب الى كل عميل لتخبره ان قاعدة بياناته لا تعمل لانه عليه اولا اتباع خطوات كذا وكذا لتمكين الماكرو الاخوة هنا مشكورين قامو بشرح اكثر من مرة تمكين المحتوى بشتى الطرق اى انا لم اتى بجديد فقط وفرت عليك عناء الاكواد كل ما عليك فعله هو تسمية قاعدة بياناتك باسم AccessSoft ولا يهم اصدارها فالاداة تعمل على الاصدارات من 2003 حتى 2016 وبعد تسميتها تضعها فى نفس مسار الاداة وسيتم فتح قاعدة البيانات الخاصة بك من خلال الاداة اى انه يمكنك تحزيم قاعدة بياناتك مع الاداة باى برنامج تحويل قاعدة البيانات الى ملف تنفيذى .exe وعند التحزيم ستخبر البرنامج ان يتم العمل من خلال الاداة وليس قاعدة البيانات ويمكنك التحزيم ببرنامج Setup Factory وهذه صورة منه تعقيب بسيط قام اخونا الفاضل جعفر @jjafferr بشرح طريقته الخاصة فى ذلك فى هذا الموضوع ولا غبار على المبتكرين نحن فقط نتعلم منهم ولكن كانت مشكلة بسيط لم اجد لها حل عند كتابة كود الاستاذ جعفر كان لابد من وضع يدويا مسار محدد لقاعدة البيانات داخل الكود كانت هذه مشكله اذ يمكن تغير المسار فى وقت او قد تختلف المسارات من جهاز الى اخر فقط اضفت كود بسيط لحل هذه المشكلة عن طريق هذه الاداة والان مع الاداة الصور مع الشرح ملحوظة لايهم نوع قواعد البيانات حتى لو كانت .mde او .accde الاداة ستقرأها فقط ضع قاعدة البيانات الخاصة بك فى نفس مسار الاداة وقم بتسمية قاعدة البيانات الى AccessSoft واضغط على الاداة وستقوم بفتح قاعدة بيانات ثم الاختفاء والاغلاق لتتعامل مع قاعدة بيناتاك بكل اريحية عند تحميل تحديث جديد ستجده فى نفس مسار قاعدة البيانات اتمنى من الله ان اكون قد وفقت فى الشرح اتمنى التجربة واعلامى بالنتيجة Link2securityDb.rar

السلام عليكم ورحمة الله تفضل تكت التليفون والعنوان.xls

السلام عليكم ورحمة الله وبركاته على الرغبة السيد @محمد عبد الشفيع من هنا https://www.officena.net/ib/topic/86775-دمج-برنامج-الحماية-مع-برنامج-الفترة-التجريبية تم فتح هذا الموضوع و ان شاء الله ساشرح خطوة خطوة حسب وقتي حتى اخلص من الموضوع وفي النهاية راح اسمع اراء و مقترحاتكم والان نحن نحتاج جدول واحد لكي نحفظ فيه تسلسل و رقم هارد و المعالج و رقم التفعيل البرامج و مدة التفعيل و تاريخ التفعيل و تاريخ اخر مرة فتح البرامج وسنسمي هكذا بالتسلسل كما مبينة في الصورة ID من نوع ترقیم تلقائی NumForMoaalic من نوع نصي NumForHard من نوع نصي NumTascil من نوع نصي Midda من نوع رقم و مصدره يكون عمودين واحد لكتابة رقم ايا عدد ايام التفعيل والاخر لكتابة مثلا يوم واحد او اسبوع واحد هكذا وهذا هو مصدره "1";"يوم واحد";"7";"اسبوع واحد";"30";"شهر واحد";"90";"ثلاث اشهر";"180";"ستة اشهر";"365";"سنة واحدة";"18250";"مدى الحياة" شوف الصورة لكي نعرف خصائص هذا الحقل جيداً و ايضا عندنا حقل باسم firstdate من نوع وقت والتاريخ واخر حقل هو EndDate من نوع وقت والتاريخ وتم تسمية الجدول باسم TblTascil ولان ليس لدي وقت اليوم ان اكون على جهاز لابتوب غدا او يوم السبت ان شاء الله راح اكمل الشرح ونبدأ بعمل النماذج والسلام عليكم ورحمة الله وبركاته

بعد اذن استاذنا عماد وذلك بكتابة السطر الأول داخل الخلية ثم الضغط على Alt+Enter وكتابة السطر الثانى جزاك الله كل خير

السلام عليكم ورحمة الله وبركاته اولا : كيف نعرف ان هذا الطالب راسب ام ناجح و بأي مواد بعدين نقدر نعمل لك ماتريد

اتفضل اليك هذا Private Sub cmdBrowse_Click() Dim spl() As String Dim tmp As String tmp = GetBrowseFolder("اختيار المجلد المطلوب :") If Len(tmp) > 0 Then Source = tmp Me.path.SetFocus path.Text = Source spl = Split(Me.path, "\") Me.dn = spl(UBound(spl)) Me.sn = spl(UBound(spl) - 1) End If End Sub Database1_2.accdb

وعليكم السلام وهذه طريقتي 🙂 نعمل استعلام لجمع الفواتير المدفوعة ، ثم نربط الاستعلامين ، ونأخذ جميع الفواتر من الاستعلام الاصل . والنتيجة: . جعفر 985.PROGRMS.accdb.zip

عدتا بعد تعديل الملاحظات واضافة شرح ضبط الاعدادات تجاوبا لبعض الاعضاء البرنامج يعمل على اكسس 2003- 2007- 2010 كما هو موضح قي الصور 2007 2010 👌 شرح طريقة ضبط الاعدادات قبل الاستخدام رابط الشرح الفديو مقسم الى جزين الاول https://drive.google.com/file/d/1wTO7bK9rgC0hTJ0TawMbzmxPVeSXKzKt/view?usp=sharing الثاني https://drive.google.com/file/d/1HXHmTHP475ow6dxdsQ0Mhpct3fWz7kSx/view?usp=sharing رابط تخميل البرنامج بعد التعديل https://drive.google.com/file/d/1SPwK-vzTwxVnogh-fuasgkxq4NsJ7Xuj/view?usp=sharing لاتنسونا من دعاكم

نعم ستفتح قاعدة الاولى راح يفتح نموذج التسجيل اذا لم يتم التسجيل من قبل راح يظهر لك سريال المعالج و سريال الهارد الجهاز نفترض انك مبرمج وانا مستخدم عندما يظهر لي ذلك النموذج ويظهر الارقام المعالج والهارد راح اشوف في كومبوبوكس مدة التفعيل ساتصل بك ةاقو لك انا اريد اجرب البرامج لمدة اسبوع مثلا وراح اعطيك سريال المعالج وهارد و مدة اللي انا اريد اسبوع واحد انت كمبرمج راح تفتح كراك عندك و تختار اسبوع و تدخل سريال الهارد والمعالج وتضغط على زر كشف رقم التفعيل سيظهر لك رقم التفعيل في مربع رقم التفعيل وراح تعطي لي كمستخدم وانا راح اختار اسبو و ادخل رقم التفعيل للعلم ذلك الكود لا يجوز لاي مدة اخر فقط للاسبوع واحد استخدمه راح تعرف اكثر ان شاء الله

شيت كنترول المرحلة الابتدائية 2019 شيت كامل به كل الصفوف و خفيف جدا و به كل الامكانيات التى تحتاجها تم اضافة النتيجة و الشهادات تقديرات فقط للصفوف الثلاثة الأولى كلمة المرور : 333 منتظر آراء و اقتراحات حضراتكم التحميل http://www.mediafire.com/file/dqq5rjnu5bqtp21/شيت+مستر+ملاك+2019+للمرحلة+الابتدائية.rar

نشكرك استاذنا الفاضل على مجهودك وتعبك معنا وباذن الله ستتم التجربة وابداء الملاحظات ونرجو ان يتسع صدرك ووقتك لها لى استفسار صغير عن عملية تشفير الجدول ماذا تقصد بها وكيف هى ولو ذكرت طريقة لنا نكون شاكرين جدا اخونا الكريم

حقاً يجدر بنا نحن العرب الافتخار بان لدينا اساتذة وخبراء قهروا اعظم البرامج وصنعوا من لا اجابة اجابات وحلول وابتكارات هي فخر لنا كل الاحترام والتقدير لك اخي ابو ادم

تفضل تم التعديل Entharat.rar

لان حقل لديك هو جزء من مصدر التقرير ( جدول او استعلام او جملة اس كيو ال) ولكنه ليس مضافا كاحد عناصر التقرير .. بالتوفيق

=[The number field] & " " & "في" & " " & [The Date field]

تم انا جربت وليس هناك مشكلة القي نظرتا الى الصور و لستة اشهر نعم وكان خطأ من عندي في مصدر كومبوبوكس لمدة التفعيل في كلا الملفين انا كتبت 265 بدل ان اكتب 365 وتم تصحيح هذا الخطأ وقريبا ساضع بين ايديكم في نفس المشاركة الاكواد كان هناك موضوع اخر انا عملت عن الحماية واستخدمت DLookUp اکثر من ثلاث مرات لكن هنا انا استخدمت مرة واحدة لا اظن ان يبطئ العمل وعندي هذا المشكلة غير موجودة ! لا اعرف ماذا اقول لك !! انها سهل جدا وحاول ان تضيفه عدد سنوات حسب رغبتك , انا فتحت هذا الموضوع لكي يسهل عليكم لكي تعرف الطريقة اذا تتم التسجيل في اي فترات من الترات الموجودة سيتم اظهار الرسالة اذا قرب من انهاء الفترة التسجيل ب 15 يوم او اقل من ذلك

نعم ... اعتذر

سبب السجل الجديد هو: عند اختيارك كود الموظف (ولأنه مربوط/مضمن) فإنك في واقع الامر تضيف معلومة الى سجل جديد ، فينتج عنه الخطأ.

اخي الفاضل ، خلينا نتكلم عن الموظف رقم 2 فقط. في الجدول عنده هذه السجلات . بينما في الاستعلام عنده هذه السجلات . هل قصدك ان تأخذ السجلات من الجدول الى الاستعلام بنفس الالوان والقيم اللي ذكرتها في الصورة التالية: . جعفر

السلام عليكم هذا موضوع الاخ @حمدى الظابط الخاص بالسحب والافلات: جعفر

السلام عليكم تفضل: الاستعلام اصبح: . ونتائج النموذج: . والوحدة النمطية: Public Function Calc_Diff(DE1 As Date, DE2 As Date) As Long Dim Time_Left_day1 As Long Dim Time_day2_Morning_Til_DE2 As Long Dim Time_days_Between_day1_day2 As Long Dim Interval As Long 'all the calculations are in minutes 'DE1 = Date 1st Employee finished his task 'DE2 = Date 2nd Employee finished his task 'DE1 & DE2 finished the same day If Format(DE1, "yyyymmdd") = Format(DE2, "yyyymmdd") Then Interval = DateDiff("n", DE1, DE2) 'DE2 finished next day ElseIf DateDiff("d", DE1, DE2) = 1 Then 'time from DE1 til the end of the day Time_Left_day1 = DateDiff("n", DE1, DateSerial(Year(DE1), Month(DE1), Day(DE1)) & " 2:00:00 PM") 'time from morning til DE2 finished Time_day2_Morning_Til_DE2 = DateDiff("n", DateSerial(Year(DE2), Month(DE2), Day(DE2)) & " 7:00:00 AM", DE2) 'add the above Interval = Time_Left_day1 + Time_day2_Morning_Til_DE2 'DE2 didn't finish next day Else 'time from DE1 til the end of the day Time_Left_day1 = DateDiff("n", DE1, DateSerial(Year(DE1), Month(DE1), Day(DE1)) & " 2:00:00 PM") 'time from morning til DE2 finished Time_day2_Morning_Til_DE2 = DateDiff("n", DateSerial(Year(DE2), Month(DE2), Day(DE2)) & " 7:00:00 AM", DE2) 'time days between day1 and day2 Time_days_Between_day1_day2 = DateDiff("d", DE1, DE2) * 420 ' 1 working day = 7 hours x 60 minutes/hour = 420 minutes 'add the above Interval = Time_Left_day1 + Time_day2_Morning_Til_DE2 + Time_days_Between_day1_day2 End If ' Format and print the time interval in days, hours, minutes and seconds. 'Calc_Diff = Minutes2Duration(Interval) Calc_Diff = Interval End Function Public Function Minutes2Duration(minutes As Long) As String Dim dd As Long, hh As Integer, mm As Integer 'from: http://bytes.com/topic/access/answers/696226-converting-minutes-days-hours-minutes ' modified by jjafferr based on the working day hours ' 1 day = 24 hours x 60 minutes/hour = 1440 minutes ' 1 working day = 7 hours x 60 minutes/hour = 420 minutes ' dd = minutes \ 420 minutes = minutes - dd * 420 hh = minutes \ 60 mm = minutes Mod 60 ' If dd = 0 Then 'No day adjustment Minutes2Duration = Format(dd, "000") & ":" & Format(hh, "00") & ":" & Format(mm, "00") ' Else 'needs day adjustment ' Minutes2Duration = Format(dd - 1, "000") & ":" & Format(hh, "00") & ":" & Format(mm, "00") ' End If End Function جعفر 973.1.قاعدة البيانات8.mdb.zip

أبدأ بحمد الله أولا وأخيرا على ما انعم ووفق وأصلي واسلم على الرحمة المهداة والسراج المنير نبينا محمد وعلى آله وصحبه وسلم ... وبعد كل عام وأنتم بخير وأعاد الله علينا أيامه الكريمة بالخير واليمن والبركات في موضوع اخي الكريم ابو عبدالرحمن وطلبه لواجهة برنامج لتسجيل الأطفال لرياض الاطفال او الروضة علي هذا الرابط فضلت ان تكون في مشاركة منفصلة لتعميم الفائدة ان شاء الله تعالى بشكل بسيط وجذاب صدقة جارية لفارس من فرسان منتدانا أوفيسنا أخي ومعلمنا عماد الحسامي رحمة الله عليه ورحم جميع المسلمين وغفر لهم الأحياء منهم والأموات حتي لا أطيل عليكم شرح مبسط للبرنامج أترككم لتجربة البرنامج في المرفقات وارحب بمشاركتكم في اجراء اية تعديلات وفقنا الله واياكم للصالحات مع تحياتي // ضاحي الغريب KG_Dahy.rar الان الاصدار الثاني علي الرابط التالي اضغط هنا