اذهب الي المحتوي
أوفيسنا

ابو جودي

أوفيسنا
 عرض الملف الشخصي  عرض المشاركات

  • Posts

    6997

  • تاريخ الانضمام

  • Days Won

    202

 نوع المحتوي 

كل منشورات العضو ابو جودي

  1. ابو جودي
    'طيب اولا لست انا من قام بكتابة الكود ثانيا يا سيدى الكود هذا افضل كود تشفير تعاملت معه لعدة اسبب -هذا الكود عند تشفير نفس الكلمة أكثر من مرة فى كل مره تحصل على رموز مختلفة ولكن عند اعادتها من اى رمز حلصلت عليه اثناء التشقير تعود اليك تلك الكلمة -يتم تصدير الكود كما هو مشفر لان هناك بعد الأكود عند تصدير القيم الناتجة عنه الى الريجسترى عادت الى الحروف الأصلية أما بخصوص المتعير b هو معامل التشفير الذى يعتمد الكود عليه يعنى مثلا عاوز اشفر الاسم موسى باستخدام الكواد على سبيل المثال يكون incode("موسي","FrstName") انا استخدمت معامل التشفير هنا كلمة FrstName اذا لابد من استخدامها كما هى لاعادة الكلمة الى اصلها يعنى هذا التشفير كGFـغصظ×ظضضصسرج والذى تم الحصول عليه من كلمة موسي لابد لاعادته الى اصله من استخدام نفس معامل التشفير المستخدم بيكون عند الفك للتشفير decode("كGFـغصظ×ظضضصسرج","FrstName") طيب جرب تغيير حالة حرف مثلا ?decode("كGFـغصظ×ظضضصسرج","Frstname") لاحظ حرف الـ N , n بذلك لن تستطيع اعادة العملية وليش الراحة مطلوب البحث والتحرى لو ع الراحة اقوم بتقفيل قاعدة وارفقها فى شكلها النهائى وارتاح واريح
  2. ابو جودي
    3- استخلاص قيم من مكونات الجهاز تستخدم فى عملية الترخيص - رقم الـ UUID رقم ثابت لا يتغير بتغيير الهارد ديسك او ختى بعملية الفورمات أو إعادة التقسيم للهارد ديسك - Public Function GetUUID(Optional strHost As String = ".") As String On Error GoTo ErrorHandler Dim objComputerSystemProduct As Object Dim objWMIService As Object Dim objItems As Object Dim objDiskDriveSerial As Object Set objWMIService = GetObject("winmgmts:\\" & strHost & "\root\cimv2") Set objComputerSystemProduct = objWMIService.ExecQuery("Select * from Win32_ComputerSystemProduct", , 48) For Each objItems In objComputerSystemProduct GetUUID = objItems.UUID Next Set objItems = Nothing Set objWMIService = Nothing Set objComputerSystemProduct = Nothing ExitHandler: On Error Resume Next If Not objItems Is Nothing Then Set objItems = Nothing If Not objDiskDriveSerial Is Nothing Then Set objDiskDriveSerial = Nothing If Not objWMIService Is Nothing Then Set objWMIService = Nothing Exit Function ErrorHandler: MsgBox "The following error has occurred." & vbCrLf & vbCrLf & _ "Error Number: " & Err.Number & vbCrLf & _ "Error Source: GetUUID" & vbCrLf & _ "Error Description: " & Err.Description, _ vbCritical, "An Error has Occurred!" Resume ExitHandler End Function - ويتم استدعاءه فقط من خلال GetUUID() - رقم وموديل الهارد ديسك ثابت ولا يتغير Public Function GetDDSerialNumber(Optional strHost As String = ".", Optional strSymbol As String = ",") As String On Error GoTo ErrorHandler Dim objComputerSystemProduct As Object Dim objWMIService As Object Dim objItems As Object Dim objDiskDriveSerial As Object Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strHost & "\root\cimv2") Set objDiskDriveSerial = objWMIService.ExecQuery("SELECT DeviceID, SerialNumber FROM Win32_DiskDrive") For Each objItems In objDiskDriveSerial GetDDSerialNumber = Trim(GetDDSerialNumber) & Trim(objItems.SerialNumber & strSymbol) Next If Right(GetDDSerialNumber, 1) = strSymbol Then GetDDSerialNumber = Left(GetDDSerialNumber, Len(GetDDSerialNumber) - 1) Set objItems = Nothing Set objWMIService = Nothing Set objDiskDriveSerial = Nothing ExitHandler: On Error Resume Next If Not objItems Is Nothing Then Set objItems = Nothing If Not objDiskDriveSerial Is Nothing Then Set objDiskDriveSerial = Nothing If Not objWMIService Is Nothing Then Set objWMIService = Nothing Exit Function ErrorHandler: MsgBox "The following error has occurred." & vbCrLf & vbCrLf & _ "Error Number: " & Err.Number & vbCrLf & _ "Error Source: GetDDSerialNumber" & vbCrLf & _ "Error Description: " & Err.Description, _ vbCritical, "An Error has Occurred!" Resume ExitHandler End Function -ويتم فقط استدعاءه من خلال GetDDSerialNumber() التطبيق فى القاعدة المرفقة .. يتبع ... 3- ارقام القطع UUID - HDD.accdb
  3. ابو جودي
    ان شاء الله جارى العمل على تحضير باقى الافكار تباعا ولكن قبل الاستكمال هل هناك ما يحتاج الى شرح أو توضيح فيما سبق ؟!
  4. ابو جودي
    السلام عليكم ورحمة الله وبركاته بفضل الله تعالى بدأت السلسلة... رجاء تابع واسأل فيما تريد فى حالة تعذر الفهم او التطبيق
  5. ابو جودي
    2-تشفير البيانات نستخدم الأكواد الاتية فى وحدة نمطيه Function incode(A As String, b As String) As String Dim r, i As Integer, s, u As String 1: u = "" s = ctrs(A, 3) If Len(s) Mod 2 = 1 Then s = s + Trim(Str(Int(8 * Rnd(-Timer)))) i = 3 * Rnd(-Timer) + 1 For r = 1 To i u = Chr(100 * Rnd(-Timer) + 155) + u Next u = Trim(Str(i)) + u u = u + s u = getcode(u, b) If decode(u, b) = A Then incode = u Else GoTo 1: End If End Function Function decode(A, b As String) As String On Error Resume Next Dim r, i As Integer, s, u As String u = getcode(A, b) i = Val(Mid(u, 1, 1)) + 1 u = Mid(u, i + 1, Len(u) - i) If Len(u) Mod 3 <> 0 Then u = Mid(u, 1, Len(u) - 1) s = "" For r = 1 To Len(u) - 2 Step 3 s = s + Chr(Val(Mid(u, r, 3))) Next decode = s End Function Function getcode(A, b As String) As String On Error Resume Next Dim L, r As Integer, c As Long, q As String c = 0 For r = 1 To Len(b) c = c + Asc(Mid(b, r, 1)) * (10 ^ r) Next q = Str(c) c = 0 For r = 1 To Len(q) c = c + Val(Mid(q, r, 1)) Next q = "" For r = 1 To Len(A) L = 256 - Asc(Mid(A, r, 1)) - r - Len(A) If L + c > 255 Then q = q + Chr(L - c) Else q = q + Chr(L + c) End If Next getcode = q End Function Function ctrs(s As String, y As Byte) As String Dim r, i As Integer, u, T As String u = "" For r = 1 To Len(s) T = Trim(Str(Asc(Mid(s, r, 1)))) For i = 1 To y - Len(T) T = "0" + T Next i u = u + T Next ctrs = u End Function التطبيق فى القاعدة المرفقة .. يتبع ... 02-Encode Decode.accdb
  6. ابو جودي
    السلام عليكم ورحمة الله تعالى وبركاته طبعا لن اضع افكارى صريحة لتطبيق فكرة محددة لا أنوى أن اعطيكم سمكا بل انوى أن أعلمكم الصيد ... لذلك سوف اضع الاكواد والافكار على وجه العموم وعلى سبيل الشرح ليس الا وليدل كل منكم بدلوه فى التطبيق وليستحضر بنات افكاره كما يترأى له 1- الحماية عن طريق اضافة بيانات الحماية فى الريجسترى نستخدم الأكواد الاتية فى وحدة نمطيه التطبيق فى القاعدة المرفقة .. تم وضع بعض التلميحات على الأكواد Public Const MyRegPath As String = "HKEY_CURRENT_USER\Software\Officena.net" Public Const MyRegKey As String = "Judy" Public Const myStringValue As String = "محمد" Public Const myValueData As String = "ابو جودى" 'returns True if the registry key i_RegKey was found 'and False if not Function RegKeyExists(i_RegKey As String) As Boolean Dim myWS As Object On Error GoTo ErrorHandler 'access Windows scripting Set myWS = CreateObject("WScript.Shell") 'try to read the registry key myWS.RegRead i_RegKey 'key was found RegKeyExists = True Exit Function ErrorHandler: 'key was not found RegKeyExists = False End Function Function RegKeyRead(i_RegKey As String) As String Dim myWS As Object On Error Resume Next 'access Windows scripting Set myWS = CreateObject("WScript.Shell") 'read key from registry RegKeyRead = myWS.RegRead(i_RegKey) End Function Function RegKeySave(i_RegKey As String, _ i_Value As String, _ Optional i_Type As String = "REG_SZ") Dim myWS As Object 'access Windows scripting Set myWS = CreateObject("WScript.Shell") 'write registry key myWS.RegWrite i_RegKey, i_Value, i_Type End Function Function RegKeyDelete(i_RegKey As String) As Boolean Dim myWS As Object On Error GoTo ErrorHandler 'access Windows scripting Set myWS = CreateObject("WScript.Shell") 'delete registry key myWS.RegDelete i_RegKey 'deletion was successful RegKeyDelete = True Exit Function ErrorHandler: 'deletion wasn't successful RegKeyDelete = False End Function يتبع.. القاعدة المرفقة 01-Dealing with the registry.accdb
  7. ابو جودي
    طبعا لا
  8. ابو جودي
    اسال الله تعالى ان يرزقنى واياكم وكل المسلمين فضل دعائكم اخى الحبيب اللهم امين 🤲 لان الموضوع لم يكن ذو اهمية قصوى بالنسبة لى ليس هناك افكار او قاعدة عامة ولكن الان ارتب افكارى واضع النقاط العريضة للوصول للمطلوب للحصول على افضل نتيجة من وجهة نظرى المتواضعة بامر الله تعالى ابشر بالخيـــــر
  9. ابو جودي
    اتفضل راجع الموضوعات الاتيه
  10. ابو جودي
    لا احيانا بعض الاكواد تعمل كما هى وتارة تحتاج الاى تعديلات ولكن هناك اكود لا تعمل بتاتا وابدا
  11. ابو جودي
    قبل ان تفكر فى موضوع التحويل لابد من استيعاب الاتى :- اذا اردت تشفير قاعدة البيانات بتحويلها من Accdb الى Accde لابد من عمل قاعدتان امامية واخرى خلفية طبعا قاعدة البيانات الخلفية والخاصة بالجداول لابد ان تكون غير مشفرة اى Accdb اما الامامية ان اردت تشفيرها الى Accde لابد من عمل ذلك مرتين 1- على جهاز يحتوى على اوفيس 32 بيت 2- على جهاز يحتوى على اوفيس 64 بيت وتعطى للعميل مع قاعدة الجداول الخلفية القاعدتان الاماميتان والمشفرتان الـقاعـدة الامامية ذات النواة 32x المشفرة ذات الامتداد Accde والقاعدة الامامية ذات النواة 64x المشفرة ذات الامتداد Accde حتى يستخدم القاعدة الامامية التى تتوافق مع نواة الاوفيس لديه او اذا قام العميل فى احد الايام بتغيير الاوفيس بإصدار آخر ونواة مختلفة يعمل بالقاعدة الاخرى او اذا كان العميل يملك اكثر من جهاز وقد تختلف انوية اصدارات الاوفيس من جهاز لاخر لأن accDE الذى تم تجميعه فى بيئة النواة 64x لن يعمل الا فى نفسة البيئه على اوفيس 64x و الـ accDE الذى تم تجميعه فى بيئة النواة 32x لن يعمل الا فى نفسة البيئه على اوفيس 32x فكما لاحظتم ان مرفق الاستاذ @ابوخليل والذى تم تجميعة فى بيئة النواة 32x لم يعمل على الاجهزة التى تحتوى على اوفيس 64x الا اللهم انك ان اردت عمل ذلك لابد ان تقوم بتجميع الملف الخاص بقاعدة النماذج (القاعدة الامامية) على جهازين محتلفين احدهما به اوفيس 64x والاخر به اوفيس 32x
  12. ابو جودي
    طيب قبل التعديل هل تريد حفظ المرفق فقط داخل المجلد باسمه القديم ام برقم الـ ID الحالى
  13. ابو جودي
    اذا اردت تشفير قاعدة البيانات بتحويلها من Accdb الى Accde لابد من عمل قاعدتان امامية واخرى خلفية طبعا قاعدة البيانات الخلفية والخاصة بالجداول لابد ان تكون غير مشفرة اى Accdb اما الامامية ان اردت تشفيرها الى Accde لابد من عمل ذلك مرتين 1- على جهاز يحتوى على اوفيس 32 بيت 2- على جهاز يحتوى على اوفيس 64 بيت وتعطى للعميل مع قاعدة الجداول الخلفية القاعدتان الاماميتان والمشفرتان الـقاعـدة الامامية ذات النواة 32x المشفرة ذات الامتداد Accde والقاعدة الامامية ذات النواة 64x المشفرة ذات الامتداد Accde حتى يستخدم القاعدة الامامية التى تتوافق مع نواة الاوفيس لديه او اذا قام العميل فى احد الايام بتغيير الاوفيس بإصدار آخر ونواة مختلفة يعمل بالقاعدة الاخرى او اذا كان العميل يملك اكثر من جهاز وقد تختلف انوية اصدارات الاوفيس من جهاز لاخر
  14. ابو جودي
    السلام عليكم ورحمة الله تعالى وبركاته على كل مصممى ومطورى قواعد البيانات ببساطة عند محاولة تشفير قاعدة البيانات الى accDE لابد من إنشاؤها مره باستخدام office (Access) x64 و إنشاؤها مره أخرى باستخدام office (Access) x32 حتى لا تحدث مشكلة عند العملاء بسبب إختلاف أنوية الأوفيس للاسف الشديد . للعلم الموضوع مختص فقط بتشفير القاعدة بالامتداد Accde فقط اى أنه لا علاقة للموضوع بالامتداد Accdb ولا علاقة للموضوع باستخدام دوال API حتى لو تم الاخذ فى الاعتبار عند كتابة الكود مراعاة عمل الكود عند استخدام دوال API على كلتا النواتان 64x , 32 x هذه لقطة من مقال المصدر : >>--> مايكروسوفت لذلك فإن accDE الخاص بـ x32 accDE و x64 خاصان جدًا بحجم النواه والبنية التي تم تجميعهما بها ويجب أن تعمل الأجهزة المستهدفة بنفس حجم النواة لاستعمال accDE الذي تم إنشاؤه باستخدامه ولا توجد استثناءات لهذه القاعدة
  15. ابو جودي
    وانا كذلك بسبب هذا المرفق قمت بالبحث عن السبب وتوصلت الى هذه النتيجة هذه لقطة من مقال المصدر : مايكروسوفت لذلك فإن accDE الخاص بـ x32 accDE و x64 خاصان جدًا بحجم النواه والبنية التي تم تجميعهما بها ويجب أن تعمل الأجهزة المستهدفة بنفس حجم النواة لاستعمال accDE الذي تم إنشاؤه باستخدامه ولا توجد استثناءات لهذه القاعدة ولذلك على كل مصمم ببساطة عند محاولة تشفير قاعدته الى accDE بمجرد تجميعها لابد من إنشاؤها مره باستخدام office (Access) x64 و إنشاؤها مره أخرى باستخدام office (Access) x32 للاسف الشديد حتى لا تحدث مشكلة عند العملاء بأختلاف أنوية الأوفيس.
  16. ابو جودي
    ملاحظة هامة اذا تم تشفير قاعدة الى Accde من النواة الـ 32x لن تعمل على النواة الـ 64x للاسف
  17. ابو جودي
    --- ولو اردتم أن أقوم بفتح موضوع لادراج الافكار تدريجيا و تباعا مع التطبيق لكل فكرة فى قاعدة منفصلة والشرح من البداية إلى أن ينتهى المشروع فقط أخبرونى ولكن تحلمونى فى التأخير إن صار منى فى الرد والمتابعة لأنه ليس لوالدتى الأن من بعد رب العزة سبحانه وتعالى غيرى..
  18. ابو جودي
    استاذى الجليل و معلمى القدير و والدى الجبيب تحية طيبة لم ولن استطع التجربة بسبب اننى اعمل على اصدار الاوفيس ذو النواة 64 على الرغم من أننى كنت أتمنى ذلك ولكن عندما فكرت فى موضوع جلب التاريخ من الانترنت تراجعت للاسباب الاتية - امكانية انقطاع الانترنت لاى سبب -عدم وجود انترنت أصلا عند المستخدم ملاحظة جارى العمل على مشروع إن شاء الله تعالى يرى النور قريبا ولكن اردس وارتب الافكار فى الوقت الحالى
  19. ابو جودي
    جزاكم الله خيرا 🌹 لم اقم بحفظ اسم الملف نظرا لان الكود القديم كان يقوم بعمل حفظ للمرفق برقم ال ID لذلك لم تستدعى الحاجه لإضافة بيانات وحقل بلا داعى 😉
  20. ابو جودي
    جزاكم الله خيرا اخبرونا عن السبيل والالية
  21. ابو جودي
    اتفضل وهذا المرفق الجديد وان شاء الله يعمل على كلتا النواتان 32X , 64X وبدون اى مشاكل نسخه من مرفق (2).accdb
  22. ابو جودي
    لم يتم عمل التحويل الصحيح لأكواد استدعاء دوال الـ Api داخل الموديل لتتناسب مع النواة 64 ولكن الكود طويل جدا جدا جدا وزحمة ع الفاضى وما يستاهل حتى الواحد يتعب فيه وعلى مقولة انسف حمامك القديم سأقوم بعمل التعديلات الازمة
  23. ابو جودي
    اتفضل ser2.rar
  24. ابو جودي
    بشركم الله بما يسركم .. وكف عنكم مايضركم .. وثبت يقينكم .. ورزقكم حلالا يكفيكم .. وأبعد عنكم كل شئ يؤذيكم .. وغفر لكم ولوالديكم ولكل المسلمين والمسلمات يوم العرض .. اللهم آمين 🤲
  25. ابو جودي
    اولا بالاصالة عن نفسي وبالنيابة عن اساتذتى جميعا والله من يضع الحل او يشارك بفكرة او يساهم لم ولا ولن ينتظر حتى كلمة شكـر بفضل الله تعالى الكل يبتغى وجه الله عزوجل ثانيا ولم احاول الاستدراك كثيرا فى الرد عليكم حتى لا أكون مثقلا عليكم فى شئ او تسبب كلماتى بعض الحرج لكم فتضعون المرفق النهائى على استحياء ويكون ذلك ضد رغبتكم ولكن فى كل الاحوال هناك حكمة القارئ كالحالب والسامع كالشارب فالمستفيد الاكبر هم طلاب العلم من تلك الحوارات والمناقشات وانا وجهة نظرى المتواضعة وكما اسلفت سابقا هى من باب تسهيل العلم فقط ليس الا واثناء كتابتى لهذا الرد وضع معلمى الجليل واستاذى القدير و والدى الحبيب الاستاذ @ابوخليل مشاركته هنا وطبعا استوجب قدر استاذى ان اتوقف لأرى كلماته ورده اولا ويعلم الله تعالى كان هذا ردى اولا للاستاذ @حمدى الظابط على رسالته لى قبل دقائق قليلة وردا على استاذى والله الذى لا اله الا هو لا علاقة لى بأى شئ لا من قريب ولا بعيد ولن اقوم حتى بتحميل المرفق او الاطلاع عليه ليس كبرا ولكن ضيق وقتى وظروفى فى الوقت الحالى تمنعنى من المتابعة والتحليل والتمحيص بتمعن وشغف كما عهدتمونى فقط أقحمنى اخوانى بذكر اسمى وانا والله ادركت حسن النية من الطرفان فاستوجب ان أقوم بالرد اتمنى على الله تعالى ثم عليكم مشاركتى وكل طلاب العلم هذا العمل
×
×
  • اضف...

Important Information

  I accept