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

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

ما شاء الله ، مبدع فيما طرحت . أثار الموضوع اهتمامي سابقاً في مناقشة سابقة ومداخلة قوية لك ، مما جعلني أتحرى عن موضوع الحقن بشكل عميق وأحاول تنفيذه في مشاريعي تالياً .. ومن سياق الحديث الذي طرحته ، اعتقد أن استخدام المعلمات بدلاً من سلاسل نصية سيكون من خطوات الأمان التي قد يجب تنفيذها . أيضاً على ما أعتقد استخدامنا لمطهرات النصوص قد يأتي بنتيجة جيدة ومساعدة ,, على سبيل المثال ، هذه فكرة بسيطة أيضاً وقد تكون قابلة للتطوير والتحديث بشمولية ,, If InStr(Me.txtUser, "'") > 0 Or InStr(Me.txtUser, ";") > 0 Then MsgBox "تم استخدام رموز غير مسموح بها في اسم المستخدم", vbExclamation Exit Sub End If ولهذا السبب كنت قد استخدمت محاولة لم أقم بتجربتها بعد ، على أحد المشاريع باستخدام هذه الدالة :- Public Function Sanitizer(ByVal userInput As String, Optional ByVal context As String = "sql") As String Dim sanitized As String sanitized = Trim(userInput) Select Case LCase(context) Case "sql" sanitized = Replace(sanitized, "'", "''") sanitized = Replace(sanitized, ";", "") sanitized = Replace(sanitized, "--", "") Case "name" sanitized = Replace(sanitized, "'", "") sanitized = Replace(sanitized, ";", "") sanitized = Replace(sanitized, "*", "") sanitized = Replace(sanitized, "=", "") Case "pure" Case Else sanitized = Replace(sanitized, "'", "''") End Select Sanitizer = sanitized End Function وعلى سبيل المثال كإستخدام في الاستعلامات :- Dim filter As String filter = "[U_UserName]='" & Sanitizer(Me.txtUser, "sql") & "' AND [U_Password]='" & Sanitizer(Me.txtPass, "sql") & "'" DoCmd.OpenForm "frmDashboard", , , filter وكمثال على ما طرحته سابقاً لفتح نموذج بفلترة .. DoCmd.ApplyFilter , "[U_UserName]='" & Sanitizer(Me.txtSearch, "sql") & "'" أو حتى في نموذج تسجيل الدخول لاسم المستخدم ، كانت المحاولة :- Dim newUser As String newUser = Sanitizer(Me.txtNewUser, "name") هذه كانت الفكرة التي خطرت لي ، ولكن لاحقاً قمت بتحديثها لإظهار رسالة تحذيرية تلقائية إذا تم رصد مدخل خطير أو محاولات حقن نصية 😁

طيب و بمناسبة الرفع والشوط والله مش هزعلك اتفضل 1- Show And Hdie لاخفاء واظهار الامر الخاص باخفاء واظهار الملفات والمجلدات بعد الاخفاء سوف تكون بهذا الشكل طبعا اى مجلدات او ملفات مخفيه لن يستطيع المستخدم الذى يريد العبث اعادة اظهارها والاطلاع عليها لان أمر اظهار الملفات او المجلدات المخفيه اساسا اختفى 2- usb Open And Lock تفعيل / عدم تفعيل قراءة اى شئ من منفذ USB عند استخدام : USB LOOK لو عندك الف منفذ Usb ادخل بهم اى فلاشة او هردات محمولة لن يتم قرائتها مطلقا usb Open And Lock.zip Show And Hdie.zip

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

تسلم .. بل صقر .. عندي برنامج صغير جدا يحذف حماية ميكروسوف نفسها من جذورها مع مجلداتها اقصد ببرنامج حماية اوفيس اللي هو microsoft Defender بترجع تقول اعمل حماية ما تقدر تدخل فلاشة ونستمر هكذا انا ارفع وانت تشوت ...

ولماذا ادخل من اجل احذف شيئا الأسرع احذف البرنامج من جذوره واجهات وجداول وكل ما يحويه مجلد البرنامج .. وأريح راسي .. وراس صاحب البرنامج

لمنع موضوع الحق انا استخدم الداله Public Function SafeSql(strValue As String) As String If IsNull(strValue) Or strValue = "" Then SafeSql = "NULL" Else SafeSql = "'" & Replace(strValue, "'", "''") & "'" End If End Function وامرر لها اسم المستخدم وكلمة المرور strUserName = SafeSql(strUserName)

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

في المعايير النصية لبعض الاستعلامات نستخدم WHERE U_UserName = '" & strUser & "' AND U_Password = '" & strPass & "'") وكذلك الحال في دوال تجميع المجال "[U_FullName]='" & [tx3] & "'") ايضا عندما نضع معيار نصي لفتح فورم من خلال فورم اخر DoCmd.OpenForm "frm2", , , "[U_UserName]='" & [tx2] & "'" وكذلك الحال عند الفلترة بمعيار نصي DoCmd.ApplyFilter , "[U_UserName]='" & [tx9] & "'" وحيث ان الحقول النصية تقبل كتابة أي احرف أو أرقام أو رموز خاصة وبالتي يمكن توظيفها بطريقة معينة لتنفيذ اجراء غير شرعي الحقيقة التي يعلمها اي شخص لديه خبرة في الحماية أن الرموز الخاصة ورسائل الخطأ غير المعالجة تمثل الطريق الأسهل للاختراق في الحالة الاولى معيار نصي في استعلام يمكن تسجيل دخول غير شرعي بكافة صلاحيات مستخدم رقم 1 ويمكن تنفيذ استعلام حذف او الحاق او او ... الخ في حالة رقم 2 مع دوال تجميع المجال يمكن تنفيذ الدالة دون معرفة المعيار وتعود باول او اخر او اكبر سجل وفقا لنوع الدالة في الحالة الثالثة نحتاج أحيانا لفتح فورم وإحضار بيانات محددة للعرض و يمكن من خلال توظيف الرمز فتح الفور مع اول سجل او كافة السجلات ويمكن استعراضها والتنقل بينها هنا لا داعي لمعرفة المعيار فقط رموز ونجوم يتم كتابتها بطريقة معينة وكذلك في الحالة الرابعة الفلترة يمكن فلترة كافة البيانات والتنقل بدون الحاجة لمعرفة المعيار والسؤال هل هذا هو الرمز الوحيد الذي يمكن استغلاله (') الاجابة لا ولكن ركزنا عليه لكونه الأكثر استخدام في قاعدة البيانات اخيرا هل يمكن انهاء المشكلة وخصوصا ان الرمز مطلوب للمعايير النصية نعم يمكن بتتبع المدخلات للحقول النصية المرتبطة باجراء ومن اسهل الطرق استخدام دالة Replace strPass = Replace(Me.U_Password, "'", "_") ايضا استخدام رسائل معالجة الاخطاء وتحديد الاجراء عند حدوث خطأ ونكتفي بهذا القدر عن الرمز (') وقد نتحدث غن رمز اخر لايقل خطورة والله الموفق الشايب

تفضل أخي الكريم ، محاولتي البسيطة . حيث في الورقة الثانية = موقف الغياب اليومي ، قمت بإضافة زر للتحديث ، وتم استدعاءه للدالة التي تم انشاؤها في مديول عام :- Sub ExtractAbsentEmployees() Dim wsMain As Worksheet Dim wsReport As Worksheet Dim targetDate As Date Dim dayNum As Integer Dim targetCol As Integer Dim lastRow As Long Dim i As Long Dim reportRow As Long Set wsMain = ThisWorkbook.Sheets("MainSheet") Set wsReport = ThisWorkbook.Sheets("موقف الغياب اليومي") wsReport.Range("A5:D" & wsReport.Rows.Count).ClearContents targetDate = wsReport.Range("C2").Value dayNum = Day(targetDate) targetCol = 3 + dayNum If targetCol < 4 Or targetCol > 34 Then MsgBox ".تاريخ غير صالح يجب أن يكون اليوم بين 1 و 31", vbExclamation Exit Sub End If lastRow = wsMain.Cells(wsMain.Rows.Count, "B").End(xlUp).Row reportRow = 5 For i = 4 To lastRow If wsMain.Cells(i, targetCol).Value = "غ" Then wsReport.Cells(reportRow, 1).Value = wsMain.Cells(i, 1).Value wsReport.Cells(reportRow, 2).Value = wsMain.Cells(i, 2).Value wsReport.Cells(reportRow, 3).Value = wsMain.Cells(i, 3).Value wsReport.Cells(reportRow, 4).Value = targetDate reportRow = reportRow + 1 End If Next i If reportRow = 5 Then MsgBox "لا يوجد موظفين متغيبين في هذا التاريخ", vbInformation End If End Sub وفي الورقة الثالثة "موقف الغياب الشهري" ، أيضاً تم انشاء زر لاستدعاءه الدالة التالية من نفس المديول :- Sub GenerateMonthlyAbsenceReport() Dim wsMain As Worksheet Dim wsReport As Worksheet Dim startDate As Date, endDate As Date Dim currentDate As Date Dim dayNum As Integer, targetCol As Integer Dim lastRow As Long, reportRow As Long, i As Long Dim empName As String, empJob As String Dim dateList As String, dayList As String Dim dateCount As Integer Dim dayName As String Set wsMain = ThisWorkbook.Sheets("MainSheet") Set wsReport = ThisWorkbook.Sheets("موقف الغياب الشهري") If Not IsDate(wsReport.Range("C2").Value) Or Not IsDate(wsReport.Range("C3").Value) Then MsgBox "الرجاء إدخال تاريخين صالحين في الخلايا C2 و C3", vbExclamation + vbMsgBoxRight, "" Exit Sub End If startDate = wsReport.Range("C2").Value endDate = wsReport.Range("C3").Value If startDate > endDate Then MsgBox "خطأ: تاريخ البداية يجب أن يكون قبل تاريخ النهاية", vbExclamation + vbMsgBoxRight, "" Exit Sub End If Application.ScreenUpdating = False Application.Calculation = xlCalculationManual With wsReport .Range("A6:F" & .Rows.Count).ClearContents .Range("6:" & .Rows.Count).RowHeight = 15 End With lastRow = wsMain.Cells(wsMain.Rows.Count, "B").End(xlUp).Row reportRow = 6 For i = 4 To lastRow empName = wsMain.Cells(i, 2).Value empJob = wsMain.Cells(i, 3).Value If empName = "" Then GoTo NextEmployee dateList = "" dayList = "" dateCount = 0 currentDate = startDate Do While currentDate <= endDate dayNum = Day(currentDate) targetCol = 3 + dayNum If targetCol >= 4 And targetCol <= 34 Then If wsMain.Cells(i, targetCol).Value = "غ" Then dayName = wsMain.Cells(2, targetCol).Value If dateList <> "" Then dateList = dateList & vbLf & Format(currentDate, "yyyy-mm-dd") dayList = dayList & vbLf & dayName Else dateList = Format(currentDate, "yyyy-mm-dd") dayList = dayName End If dateCount = dateCount + 1 End If End If currentDate = DateAdd("d", 1, currentDate) Loop If dateCount > 0 Then With wsReport .Cells(reportRow, 1).Value = reportRow - 5 .Cells(reportRow, 2).Value = empName .Cells(reportRow, 3).Value = empJob .Cells(reportRow, 4).Value = dateCount .Cells(reportRow, 5).Value = dateList .Cells(reportRow, 6).Value = dayList .Cells(reportRow, 5).WrapText = True .Cells(reportRow, 6).WrapText = True If dateCount > 1 Then .Rows(reportRow).RowHeight = 15 * dateCount End If End With reportRow = reportRow + 1 End If NextEmployee: Next i Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic If reportRow > 6 Then ' MsgBox "تم إنشاء التقرير بنجاح", vbInformation + vbMsgBoxRight, "" Else MsgBox "لا توجد أيام غياب في الفترة المحددة", vbInformation + vbMsgBoxRight, "" End If End Sub وتركت لك التعديل متاحاً من خلال تحديد الصف أو العمود ... إلخ . وهذا ملفك بعد التعديل . راجعه وأخبرنا بالنتيجة .. موقف غياب موظفين.zip

تفضل Sub FormatUniqueCellsInRow() Dim ws As Worksheet Dim lastRow As Long, startRow As Long Dim r As Long, i As Long, j As Long Dim values(1 To 7) As Variant Dim count As Long Dim data As Variant On Error GoTo ErrorHandler Set ws = ThisWorkbook.Sheets("Sheet1") ' تأكد من تغيير "Sheet1" إلى اسم الورقة الفعلي startRow = 3 ' الصف الذي تبدأ منه البيانات lastRow = ws.Range("C3:I" & ws.Rows.Count).Find(What:="*", _ SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row ' تنظيف التنسيقات السابقة من الأعمدة C:I و O With ws.Range("C" & startRow & ":I" & lastRow & ",O" & startRow & ":O" & lastRow) .Interior.ColorIndex = xlNone .Font.ColorIndex = xlAutomatic .Font.Bold = False End With ' تحميل النطاق إلى مصفوفة data = ws.Range("C" & startRow & ":I" & lastRow).Value ' المرور على كل صف For r = 1 To lastRow - startRow + 1 ' تخزين قيم الصف الحالي For i = 1 To 7 values(i) = data(r, i) Next i ' فحص القيم الفريدة For i = 1 To 7 count = 0 If Not IsEmpty(values(i)) Then For j = 1 To 7 If CStr(values(j)) = CStr(values(i)) Then count = count + 1 End If Next j ' إذا كانت القيمة فريدة If count = 1 Then ' تطبيق التنسيق على الخلية في C:I With ws.Cells(r + startRow - 1, i + 2) .Interior.Color = RGB(255, 255, 0) ' تعبئة صفراء .Font.Color = RGB(255, 0, 0) ' خط أحمر .Font.Bold = True ' خط عريض End With ' تطبيق نفس التنسيق على الخلية في العمود O في نفس الصف With ws.Cells(r + startRow - 1, "O") .Interior.Color = RGB(255, 255, 0) ' تعبئة صفراء .Font.Color = RGB(255, 0, 0) ' خط أحمر .Font.Bold = True ' خط عريض End With End If End If Next i Next r MsgBox "تمت معالجة البيانات بنجاح!", vbInformation Exit Sub ErrorHandler: MsgBox "حدث خطأ: " & Err.Description, vbCritical End Sub

تمام انار الله دربك .. هذا ما اعنيه وضعت الحماية ووضعت تجاوز الحماية سواء كان التنفيذ عبر ملف مساعد يختصر العملية او التنفيذ يكون يدويا يوجد حل احتياطي أقوى لمن كان في عمل مشترك لزيادة الاطمئنان : وهو تعيين كلمة مرور وندوز .. وضبط فترة الإسبات أما اذا قاعدة البيانات على الشبكة فكان الله في عونهم

اتفضل الطريقة نعم بدون حبة الملح : Salt ولحالة آمن ولكن حبة الملح هذه تزيد من قوة التأمين فى فى التشفير جدا جدا جدا

تعملها ويطلع منك

ما هو لو حد رخم زى حلاتى ممكن يكون عامل حماية للمجلد من حذف ما فيه

تفتكر هيكون آمن إذا استخدم لوحده بدون ( Salt ) ؟؟ وحبة الملح دي هي اللي ممكن تزيد من مستوى الحماية في كلمات المرور ..

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

البيانات .. مفهوم منه انها هي ما تحويه الجداول وهنا تعني منع التمكن من دخول التطبيق الفرق واضح ..

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

اما بالنسبة لكلمة المرور راى المتواضع عدم استخدامها بشكل صريح وكذلك لا احبذ تشفير ثنائى الاتجاه بل الافضل ان يكون احادى الاتجاه ثنائى الاتجاه يمكن التعرف عليه من خلال الهندسة العكسية طيب كنت قد كتبت داله تعتمد على تشفير : MD5 ولكن انا كتبتها بدون الاعتماد على اى مكتبات تخص ال .net وكذلك اعتمد على التشفير : SHA256 لانه اكثر امانا من سابقه الا انه يعتمد على .net ولكن بما اننى بقدر الامكان لا احب الاعتماد على اى مراجع ومكتبات خارجية بقدر الامكان فكرتى كانت الدمج بين التشفيرين بحيث اذا توفرت المكتة اللازمة يتم التشفير بناء على : SHA256 وان لم تتوفر فى نظام التشغيل يتم الاعتماد على التشفير : MD5 والاكواد كالاتى Private Function ToLong(ByVal dblValue As Double) As Long dblValue = dblValue - 4294967296# * Int(dblValue / 4294967296#) If dblValue < 0 Then dblValue = dblValue + 4294967296# If dblValue > 2147483647# Then ToLong = CLng(dblValue - 4294967296#) Else ToLong = CLng(dblValue) End If End Function Private Function RotateLeft32(ByVal lngValue As Long, ByVal intBits As Integer) As Long Dim dblValue As Double dblValue = CDbl(lngValue And &HFFFFFFFF) RotateLeft32 = ToLong(dblValue * (2 ^ intBits) + dblValue / (2 ^ (32 - intBits))) End Function Private Function GenerateSalt() As String Dim strChars As String, strResult As String Dim i As Long strChars = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" Randomize For i = 1 To 16 strResult = strResult & Mid(strChars, Int(Rnd() * Len(strChars)) + 1, 1) Next GenerateSalt = strResult End Function Public Function MD5Hash(ByVal strText As String) As String Dim arrK(0 To 63) As Long, arrS(0 To 63) As Integer Dim a As Long, b As Long, c As Long, d As Long, f As Long, g As Long, temp As Long Dim h0 As Long, h1 As Long, h2 As Long, h3 As Long Dim msg() As Byte, msgLen As Long, paddedLength As Long Dim lenInBits As Currency Dim chunk(0 To 15) As Long Dim i As Long, offset As Long For i = 0 To 63 arrK(i) = ToLong(Abs(Sin(i + 1)) * 4294967296#) Next i For i = 0 To 15: arrS(i) = Array(7, 12, 17, 22)(i Mod 4): Next i For i = 16 To 31: arrS(i) = Array(5, 9, 14, 20)(i Mod 4): Next i For i = 32 To 47: arrS(i) = Array(4, 11, 16, 23)(i Mod 4): Next i For i = 48 To 63: arrS(i) = Array(6, 10, 15, 21)(i Mod 4): Next i msg = StrConv(strText, vbFromUnicode) msgLen = UBound(msg) + 1 paddedLength = ((msgLen + 8) \ 64 + 1) * 64 ReDim Preserve msg(0 To paddedLength - 1) msg(msgLen) = &H80 lenInBits = msgLen * 8 For i = 0 To 7 msg(paddedLength - 8 + i) = (lenInBits / (2 ^ (8 * i))) And &HFF Next i h0 = &H67452301 h1 = &HEFCDAB89 h2 = &H98BADCFE h3 = &H10325476 For offset = 0 To paddedLength - 1 Step 64 For i = 0 To 15 chunk(i) = ToLong(CDbl(msg(offset + i * 4)) + _ CDbl(msg(offset + i * 4 + 1)) * &H100 + _ CDbl(msg(offset + i * 4 + 2)) * &H10000 + _ CDbl(msg(offset + i * 4 + 3)) * &H1000000) Next i a = h0: b = h1: c = h2: d = h3 For i = 0 To 63 If i < 16 Then f = (b And c) Or ((Not b) And d) g = i ElseIf i < 32 Then f = (d And b) Or ((Not d) And c) g = (5 * i + 1) Mod 16 ElseIf i < 48 Then f = b Xor c Xor d g = (3 * i + 5) Mod 16 Else f = c Xor (b Or (Not d)) g = (7 * i) Mod 16 End If temp = d d = c c = b b = ToLong(CDbl(b) + RotateLeft32(ToLong(CDbl(a) + f + arrK(i) + chunk(g)), arrS(i))) a = temp Next i h0 = ToLong(CDbl(h0) + a) h1 = ToLong(CDbl(h1) + b) h2 = ToLong(CDbl(h2) + c) h3 = ToLong(CDbl(h3) + d) Next offset MD5Hash = LCase( _ Right("00000000" & Hex(h0), 8) & _ Right("00000000" & Hex(h1), 8) & _ Right("00000000" & Hex(h2), 8) & _ Right("00000000" & Hex(h3), 8)) End Function Public Function HashPasswordSHA256(ByVal Password As String) As String Dim xmlObj As Object Dim bytes() As Byte Dim hash() As Byte Dim i As Integer Dim result As String ' استخدام كائن MSXML2 Set xmlObj = CreateObject("System.Security.Cryptography.SHA256Managed") ' تحويل النص إلى مصفوفة بايتات bytes = StrConv(Password, vbFromUnicode) ' حساب التجزئة hash = xmlObj.ComputeHash_2(bytes) ' تحويل النتيجة إلى سلسلة نصوص For i = LBound(hash) To UBound(hash) result = result & LCase(Right("0" & Hex(hash(i)), 2)) Next i ' إعادة النتيجة النهائية HashPasswordSHA256 = result ' تنظيف الموارد Set xmlObj = Nothing End Function Public Function HashPassword(strPassword As String, Optional ByRef strSalt As String) As String If strSalt = "" Then strSalt = GenerateSalt() On Error GoTo UseMD5 ' المحاولة الأولى باستخدام SHA-256 HashPassword = HashPasswordSHA256(strPassword & strSalt) Exit Function UseMD5: HashPassword = MD5Hash(strPassword & strSalt) End Function Public Sub UpdateExistingPasswords() On Error GoTo ErrHandler Dim rs As DAO.Recordset Dim strSalt As String ' تحديث جدول المستخدمين النشطين Set rs = CurrentDb.OpenRecordset("SELECT UserID, UserPassword, Salt FROM tblUsers", dbOpenDynaset) Do While Not rs.EOF If IsNull(rs!salt) Then strSalt = GenerateSalt() rs.Edit rs!salt = strSalt rs!UserPassword = HashPassword(rs!UserPassword, strSalt) rs.Update LogEvent "تم تحديث مستخدم: " & rs!UserID, Information, "UpdateExistingPasswords" End If rs.MoveNext Loop rs.Close Set rs = Nothing ' تحديث جدول المستخدمين المعلقين Set rs = CurrentDb.OpenRecordset("SELECT UserID, UserPassword, Salt FROM tbl01PendingUsers", dbOpenDynaset) Do While Not rs.EOF If IsNull(rs!salt) Then strSalt = GenerateSalt() rs.Edit rs!salt = strSalt rs!UserPassword = HashPassword(rs!UserPassword, strSalt) rs.Update LogEvent "تم تحديث مستخدم معلق: " & rs!UserID, Information, "UpdateExistingPasswords" End If rs.MoveNext Loop rs.Close Set rs = Nothing MsgBox "تم تحديث كلمات المرور القديمة بنجاح.", vbInformation Exit Sub ErrHandler: HandleError "UpdateExistingPasswords", "حدث خطأ أثناء تحديث كلمات المرور" If Not rs Is Nothing Then rs.Close End Sub Public Sub UpdateExistingPasswordsByUserID(lngUserID As Long) On Error GoTo ErrHandler Dim rs As DAO.Recordset Dim strSalt As String ' تحديث جدول المستخدمين النشطين Set rs = CurrentDb.OpenRecordset("SELECT UserID, UserPassword, Salt FROM tblUsers WHERE UserID = " & lngUserID, dbOpenDynaset) If Not rs.EOF Then If IsNull(rs!salt) Then strSalt = GenerateSalt() rs.Edit rs!salt = strSalt rs!UserPassword = HashPassword(rs!UserPassword, strSalt) rs.Update LogEvent "تم تحديث مستخدم: " & rs!UserID, Information, "UpdateExistingPasswordsByUserID" End If End If rs.Close Set rs = Nothing ' تحديث جدول المستخدمين المعلقين Set rs = CurrentDb.OpenRecordset("SELECT UserID, UserPassword, Salt FROM tbl01PendingUsers WHERE UserID = " & lngUserID, dbOpenDynaset) If Not rs.EOF Then If IsNull(rs!salt) Then strSalt = GenerateSalt() rs.Edit rs!salt = strSalt rs!UserPassword = HashPassword(rs!UserPassword, strSalt) rs.Update LogEvent "تم تحديث مستخدم معلق: " & rs!UserID, Information, "UpdateExistingPasswordsByUserID" End If End If rs.Close Set rs = Nothing MsgBox "تم تحديث كلمة المرور بنجاح للمستخدم: " & lngUserID, vbInformation Exit Sub ErrHandler: HandleError "UpdateExistingPasswordsByUserID", "حدث خطأ أثناء تحديث كلمة المرور للمستخدم: " & lngUserID If Not rs Is Nothing Then rs.Close End Sub طبعا الدوال الاخيرة : Public Sub UpdateExistingPasswords() Public Sub UpdateExistingPasswordsByUserID(lngUserID As Long) هى خاصة بقاعدتى من تعجبه فكرة التشفير لضمان زيادة الامان يستطيع التعديل عليهم باسماء الجداول والحقول الخاصة به هو وجميعنا يعلم ان الامان هو : مسألة نسبية ولكن الجميع يحاول جاهد تأمين البيانات وتأمين الاكواد اما من العبث الغير مقصود او العبث المقصود او حفظا للحقوق موضوع التأمين يختلف حسب توجهات كل شخص فى النهاية وقوة وضعف التأمين تعتمد على افكار المبرمج فى النهاية بجانب لغة البرمجة

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

بعد اذن اخي فادي تفضل من عمل اخونا صالح حمادي جربته وأستخدمه دوما في الشاشات التي تفتح على كامل الشاشة .. يعمل 100% ملائمة النموذج حسب حجم الشاشة صالح حمادي.rar

السلام عليكم ورحمة الله وبركاته يمكن بواسطة معادلة =IFERROR(AVERAGEIFS(table1!$A:$A; table1!$C:$C; $C5; table1!$E:$E; D$4);"") او كود يفوم بجلب الاصناف مع متوسط كل صنف Sub حساب_المتوسط_و_جلب_الاصناف() Dim wsIn As Worksheet, wsOut As Worksheet Dim lastRowIn As Long Dim dataArr As Variant Dim i As Long Dim prod As String, price As Double Dim dt As Variant, mon As Long Dim sums As Object, counts As Object, uniqueProds As Object Dim key As String Dim prodList As Variant Dim r As Long, c As Long Dim lastRowOut As Long Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False Set wsIn = Sheets("table1") Set wsOut = Sheets("sheet1") Set sums = CreateObject("Scripting.Dictionary") Set counts = CreateObject("Scripting.Dictionary") Set uniqueProds = CreateObject("Scripting.Dictionary") lastRowIn = wsIn.Cells(wsIn.Rows.Count, "A").End(xlUp).Row If lastRowIn < 2 Then Exit Sub dataArr = wsIn.Range("A2:D" & lastRowIn).Value For i = 1 To UBound(dataArr, 1) prod = CStr(dataArr(i, 3)) dt = dataArr(i, 4) If Len(prod) > 0 And IsDate(dt) Then mon = Month(dt) price = dataArr(i, 1) key = prod & "_" & mon If Not sums.Exists(key) Then sums(key) = 0 counts(key) = 0 End If sums(key) = sums(key) + price counts(key) = counts(key) + 1 If Not uniqueProds.Exists(prod) Then uniqueProds(prod) = True End If End If Next i wsOut.Range("C5:C10000").ClearContents prodList = uniqueProds.Keys For i = 0 To UBound(prodList) wsOut.Cells(5 + i, "C").Value = prodList(i) Next i lastRowOut = wsOut.Cells(wsOut.Rows.Count, "C").End(xlUp).Row For r = 5 To lastRowOut prod = wsOut.Cells(r, "C").Value For c = 4 To 15 mon = wsOut.Cells(4, c).Value key = prod & "_" & mon If sums.Exists(key) Then wsOut.Cells(r, c).Value = sums(key) / counts(key) Else wsOut.Cells(r, c).ClearContents End If Next c Next r Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True End Sub تحيانى لك ولمعلمنا الفاضل أ / محمد صالح متوسط الاصناف كود.xlsb متوسط الاصناف معادلة.xlsx

الاستاذ محمد صالح احتاج متوسط السعر (average) وليس اجمالى(sum) السعر شكرا على جهودك

وعليكم السلام ورحمة الله تعالى وبركاته =TEXT((A4-INT(A4))*1000,"000")

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

طيب كفكرة ممكن تعمل الساعة لحالها في نموذج فرعي وتعمل الحدث في النموذج الفرعي بدون ما يأثر على أحداث النموذج الرئيسي 🙂 Clock In Sub Form.accdb

جزاك الله خير يا استاذنا فكرة ممتازه كانت تنقصنى وفى شغلى شكرا لحضرتك