ابو جودي

وعليكم السلام ورحمة الله تعالى وبركاته ولكن لا يمكن الاعتماد عليه كليا سواء قرأت شرح الكود قبل او بعد الترجمة اعتقد قراءة وتحليل الكود افضل بكثيـــــــــــــــر جرب الكود الاتى بالموقع وقول لى رأيك هو مش كودى وانا اللى كتبته بعد وضعه بالموقع ولله انا ضيعت وماصيرت فاهم شئ بالكود Function MySpid( _ ByRef strFieldName As String, _ ByRef strTableName As String, _ Optional strPrefixe As String = vbNullString, _ Optional strResetYYorMMorDD As String = "YY", _ Optional nDay As Integer = 0, _ Optional nMonth As Integer = 0, _ Optional nYear As Integer = 0) As String Dim strLinkCriteria As String Dim strOldID As String Dim strNxtID As Long Dim intLenPrefixe As Integer Const intNumberOfZeros = 6 intLenPrefixe = Len(strPrefixe) + 1 If nDay = 0 Then nDay = Format(Date, "dd") If nMonth = 0 Then nMonth = Format(Date, "mm") If nYear = 0 Then nYear = Year(Date) - 2000 Select Case strResetYYorMMorDD Case Is = "YY": strLinkCriteria = Nz(Right(Mid(Nz(DLast(strFieldName, strTableName), 0), intLenPrefixe, 6), 2), 0) = nYear ' Yearly Reset Case Is = "MM": strLinkCriteria = Nz(Right(Mid(Nz(DLast(strFieldName, strTableName), 0), intLenPrefixe, 4), 2), 0) = nMonth ' Monthly Reset Case Is = "DD": strLinkCriteria = Nz(Right(Mid(Nz(DLast(strFieldName, strTableName), 0), intLenPrefixe, 2), 2), 0) = nDay ' Daily Reset End Select strOldID = Nz(DLast("" & strFieldName & "", strTableName, strLinkCriteria), 0) strNxtID = CLng(Right(strOldID, intNumberOfZeros)) strNxtID = strNxtID + 1 MySpid = strPrefixe & Format(nDay, "00") & Format(nMonth, "00") & Format(nYear, "00") & _ String(intNumberOfZeros - Len(CStr(strNxtID)), "0") & CStr(strNxtID) End Function

اثراء للموضوع وغير ما يلزمك بالوحدة النمطية لتحصل على الترقيم بالشكل اللى يريحك وغير ما

الموضوع انى لما قمت بوضع الافكار بالمرفق وقمت باستدعاء احد دوال الـ API لم اضع فى الاعتبار وقتها دعم 32 , 64 بت تم تعديل الكود اتفضل المرفق print only one time (64 , 32 Bit).mdb

لا اعتقد ولكن الاعتماد على الرقم هذا فقط غير مناسب لان بعض المعالجات لا تظهر لها رقم كما ان Getint هو اسم وضعه المبرمج ولايشير لما يحتويه الا ان وضعت لنا الكود لنرد عليك بالرد المناسب فيما يخص الكود ولو تكرمت لو تشاركنا افكارك فى وضع التشقير والية الحماية وانا انصحك بالاعتماد على رقم الـ UUID ويمكنك الخصول عليه من الكود الاتى Public Function GetUUID() Dim strComputer As String Dim objWMIService, colItems, objItem strComputer = "." Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2") Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystemProduct", , 48) For Each objItem In colItems GetUUID = objItem.UUID Next End Function

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

لا انا لم اقل لك تحدى ولكن قلت لك ابشر شتان ما بين الكلمتان ومعناهما

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

جزانا الله واياكم .. يا اهلا بك

انا جربت على اوفيس 2021 64 , 32 وكان كل شئ تمام طيب ممكن طلب عند حضرتك مانع ادخل ريموت على الجهاز عند حضرتك اون لاين لارى المشكلة بنفسى وحضرتك مشكورا راح تتابع معى كل شئ لو موافق ممكن نستخدم AnyDesk طلبت ذلك ايضا من والدى الدكتور @الحلبي ولكن لم يصلنى الرد

لا يمكن عمل ذلك من الاستعلام بطريقة مباشرة ولكن يمكن اذا كان الكود الاتى فى وحدة نمطية لتتمكن استدعاء الكود فى زوايا التطبيق المختلفة حتى لو فى استعلام الروتين المستخدم فى الوخدة النمطية : Public Function CheckFolder(strFolderPath As String) As Boolean Dim strIsFolder As String strFolderPath = strFolderPath strIsFolder = Dir(strFolderPath, vbDirectory) If strIsFolder = "" Then CheckFolder = False Else: CheckFolder = True End Function الان فى الاستعلام وحسب ما اشرتم فى رأس الموضوع اضف فى حقل جديد السطر الاتى CheckFolder([folderName]) مع العلم ان حقل الـ folderName فى الاستعلام لابد وان يحتوى على المسار كاملا للمجلد

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

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

رقم التفعيل: الاول ... FCCCC-42139-42842-64294-26824-42942-84294-2 -------- رقم التفعيل: الثانى ... FCCCC-42138-42842-64205-26824-42052-84294-2 اتفضل يا باش مهندس @Moosak

طيب يا دكتور @الحلبي انا ارسلت اليكم رسالة خاصة وقى انتظار رد معاليكم يا افندم ويا باش مهندس @Moosak فى انتظار ردك بعد تجربة التقعيل ولقد لاحظت بعد الـ Bug , بما لا تؤثر سلبا على الية الترخيص ضد اعادة التسمية او التلاعب فى الجداول او البيانات بداخلها والتفرد برقم تقعيل لكل تطبيق على حدة لنفس الجهاز ببصمة الجهاز هذه النسخة مجرد نسخة تحريبية للتأكد من القاعلية وتجميع الاراء وستتم معالجة كل شئ ان شاء الله فى النسخة النهائية ولذلك رجاء من يستطيع التجربة مرارا وتكرارا على اكصر من جهاز فليتكرم بعمل ذلك والرجوع بسرد نقاط الضعف والمشاكل والاراء و وضع التصورات الافضل لاتمام العمل قدر الامكان على اكمل وجه بما يناسب متطلبات الجميع بأمر الله تعالى

رقم تقعيل التطبيق الأول FFDCC-FAEFE-BADEF-42139-42842-64294-26824-42942-84294-2 ---------- رقم تقعيل التطبيق الثانى FFDCC-FAEFE-BADEF-42138-42842-64205-26824-42052-84294-2

طيب دقايق واكون مع سيدتك يا دكتور

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

الاصدار الجديد دعوة للتجربة قبل فتح موضوع خاص به المميزات : - عدم تفعيل اكثر من تطبيق لنفس العميل على نفس الحاسوب بنفس رقم التفعيل - تقليص واختصار رقم التفعيل قدر الامكان وهذا مراعاة للمشاركات تنويه .. بناء على طلب الدكتور @الحلبي كنت قد شرعت بعمل التطبيق يعتمد على رقم الهارد ديسك الحقيقى وليس رقم اى قطاع من قطاعات الهارد ديسك لانها يتغيير بعمل فورمات للقطاع ولكن فكرت قليلا لو حدث عطب بالهارد ديسك ! وتم استبداله يوجد مرفقين للتجربة اللى ما ينفتح معه النموذج الرئيسى يخبرنى واللى يجرب يأتينى برقم ال Activation Number من خلال الضغط على زر الامر Copy , والموجود يمين الرقم برجاء احضار ارقام التطبيقين حيث لكل منها رقم مختلف عن الاخر بعد ذلك سوف أرسل لكم رقم التفعيل لكليهما * ملاحظة أخرى فى حالة تغيير اسم التطبيق حتى ولو تملك رقم التفعيل لن يعمل التطبيق My App.zip

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

انشاء قاعدة بيانات مشفرة بكلمة مرور تستدعى القانك بأسمة من اى مكان وفى اى حدث على حسب هواك بالسطر التالى Call MkDbByPassword وتغير فى الفانك بس على التوالى المسار , اسم القاعدة الجديدة التى تريد انشاءها . كلمة المرور التى تريدها فى المتغيرات strDbPath >>>---->> المسار strNewDbName >>>---->> اسم قاعدة البيانات الجديدة ولا تنسى الامتداد strPassNewDb >>>---->> كلمة المرور التى تريد تشفير القاعدة بها Public Function MkDbByPassword() Dim wrkDefault As Workspace Dim dbsNew As DAO.Database Dim strDbPath As String Dim strNewDbName As String Dim strPassNewDb As String strDbPath = CurrentProject.Path & "\" strNewDbName = "NewDB.mdb" strPassNewDb = "00" Set wrkDefault = DBEngine.Workspaces(0) If Dir(strDbPath & strNewDbName) <> "" Then Kill strDbPath & strNewDbName Set dbsNew = wrkDefault.CreateDatabase(strDbPath & strNewDbName, dbLangGeneral & ";PWD=" & strPassNewDb) End Function

اى اى دايب دوووووووووووووب ☺️ انا بالاول كتبت الكود هنا بالمنتدى دون مرفق لانى كنت مستعجل وقتها ههههههههه يعنى ما كنت اكتب الكود بمحرر اكواد الاكسس وهاد مثل ما ينحكى غلطة الشاطر بألف

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

انا اللى غلط واانا اكتب الكود ووضعتها مزدوجه انا اسف اكتب بسرعة وكنت اركز فى شئ آخر

تم اعداد وتصميم هذا المرفق عام 2019 فقط قمت بتعديل روابط البث ولذلك وسمته ب ذكريات

------------------------ لفد وضعت الكود على اعتبار تعدد القيم وتعدد الالوان تبعا لتعدد القيم بوجه عام الكود بكل بساطه Dim colorA As Long: colorA = 255 Dim colorB As Long: colorB = 16711680 With Me.txtQty .BackColor = (IIf(.BackColor = colorA, colorB, colorA)) End With