SEMO.Pa3x

السلام عليكم ورحمة الله وبركاته.. اولاً: جلب الوقت والتاريخ من time.windows.com ثم ضبط وقت وتاريخ الكومبيوتر.. العملية كلها بطرفة عين البرنامج مكتوب 100% بلغة Visual Studio .NET يمكنك تشغيله بالاكسس بـ shell السورس كود للفائدة (شرحت فيه كل شيء): Imports System.Net Imports System.Net.Sockets Module Main 'c0ded by: SEMO.Pa3x 'date: 23-09-2024 - 06:36 PM 'enjoy (: Sub Main() Try Dim computerDate As String = GetNetworkTime.ToShortDateString Dim computerTime As String = GetNetworkTime.ToShortTimeString ' قم بتشغيل العملية لتعيين التاريخ والوقت معاً Dim processInfo As New ProcessStartInfo("cmd.exe") processInfo.UseShellExecute = True processInfo.Verb = "runas" ' طلب صلاحيات المسؤول processInfo.Arguments = "/C date " & computerDate & " && time " & computerTime.Replace("ص", "AM").Replace("م", "PM") Process.Start(processInfo) Catch ex As Exception Console.WriteLine(ex.Message) Console.ReadLine() End Try End Sub Public Function GetNetworkTime() As DateTime ' خادم الوقت الافتراضي Const ntpServer As String = "time.windows.com" ' حجم رسالة NTP - 16 بايت من بيانات الهضم (RFC 2030) Dim ntpData As Byte() = New Byte(47) {} ' إعداد القيم LI = 0 (بدون تحذير)، VN = 3 (IPv4 فقط)، Mode = 3 (وضع العميل) ntpData(0) = &H1B ' الحصول على عناوين IP الخاصة بالخادم Dim addresses As IPAddress() = Dns.GetHostEntry(ntpServer).AddressList ' منفذ UDP المستخدم من قبل NTP هو 123 Dim ipEndPoint As New IPEndPoint(addresses(0), 123) ' استخدام UDP Using socket As New Socket(AddressFamily.InterNetwork, SocketType.Dgram, ProtocolType.Udp) socket.Connect(ipEndPoint) ' إيقاف تعليق الكود إذا تم حظر NTP socket.ReceiveTimeout = 3000 ' إرسال الطلب واستقبال الرد socket.Send(ntpData) socket.Receive(ntpData) socket.Close() End Using ' إزاحة للحصول على حقل "Transmit Timestamp" Const serverReplyTime As Byte = 40 ' الحصول على الجزء الخاص بالثواني Dim intPart As ULong = BitConverter.ToUInt32(ntpData, serverReplyTime) ' الحصول على الكسر الخاص بالثواني Dim fractPart As ULong = BitConverter.ToUInt32(ntpData, serverReplyTime + 4) ' تحويل البيانات من big-endian إلى little-endian intPart = SwapEndianness(intPart) fractPart = SwapEndianness(fractPart) ' تحويل البيانات إلى ميلي ثانية Dim milliseconds As ULong = (intPart * 1000UL) + ((fractPart * 1000UL) / &H100000000UL) ' الوقت بناءً على التوقيت العالمي UTC Dim networkDateTime As DateTime = (New DateTime(1900, 1, 1, 0, 0, 0, DateTimeKind.Utc)).AddMilliseconds(CLng(milliseconds)) ' إعادة الوقت المحلي Return networkDateTime.ToLocalTime() End Function ' دالة لتحويل البيانات من big-endian إلى little-endian Private Function SwapEndianness(x As ULong) As UInteger Return CUInt(((x And &HFFUL) << 24) + ((x And &HFF00UL) << 8) + ((x And &HFF0000UL) >> 8) + ((x And &HFF000000UL) >> 24)) End Function End Module اهداء للمعلم جعفر @jjafferr لا تنسوني ووالدي من صالح دعائكم. SetDateTimeInternetSEMO.zip

السلام عليكم ورحمة الله وبركاته.. كنت اعمل على مشروع للقرآن الكريم، يكون ضمن تطبيق قوت القلوب، صورته في التوقيع 🥰 البرنامج من تصميمي وبرمجتي 100% فاحتجت للقرآن الكريم مرتل ومقسم لايات قمت بالعثور على ختمات كاملة وللعديد من القرآء في موقع Archive.org فقمت بتحويل الروابط الى قاعدة بيانات SQLite تتضمن ترتيل القرآن الكريم على شكل ايات كل آية على حدا وبرابط مباشر، أي ستقوم بتشغيل الصوت من الرابط مباشرة بدون تنزيلة طبعا يمكنكم تشغيل الصوت مباشرة من الويب باستخدام الكثير من المكتبات المجانية مثل NAudio.dll وغيرها... قبل كل شيء، هذا الكود لإنشاء الجدول sounds الذي ستكون فيه روابط الصوت لايات القرآن الكريم في قاعدة البيانات.. 1. تسلسل السورة 2. رقم الآية 3. رابط الملف الصوتي للآية 4. معرف القارئ CREATE TABLE "sounds" ( "surah_number" INTEGER, "ayah_number" INTEGER, "audio_url" TEXT, "reader_id" INTEGER ); 0. احمد نعينع 1. الطبلاوي 2. عبد الباسط 3. المنشاوي 4. الحصري السورس كود للفائدة، الذي يقوم بتوليد الايات حسب السور بلغة NET. Sub GenerateQuranAudioLinks(ByVal baseUrl As String, ByVal reader_id As String) ' عدد الآيات لكل سورة من القرآن الكريم Dim surahAyatCounts As Integer() = { 7, 286, 200, 176, 120, 165, 206, 75, 129, 109, 123, 111, 43, 52, 99, 128, 111, 110, 98, 135, 112, 78, 118, 64, 77, 227, 93, 88, 69, 60, 34, 30, 73, 54, 45, 83, 182, 88, 75, 85, 54, 53, 89, 59, 37, 35, 38, 29, 18, 45, 60, 49, 62, 55, 78, 96, 29, 22, 24, 13, 14, 11, 11, 18, 12, 12, 30, 52, 52, 44, 28, 28, 20, 56, 40, 31, 50, 40, 46, 42, 29, 19, 36, 25, 22, 17, 19, 26, 30, 20, 15, 21, 11, 8, 8, 19, 5, 8, 8, 11, 11, 8, 3, 9, 5, 4, 7, 3, 6, 3, 5, 4, 5, 6 } ' حلقة لتوليد جمل SQL لكل سورة وآياتها For surah As Integer = 1 To 114 Dim surahNumber As String = surah.ToString("D3") ' تحويل رقم السورة إلى 3 أرقام Dim ayatCount As Integer = surahAyatCounts(surah - 1) ' توليد جمل SQL بناءً على عدد الآيات لكل سورة For ayah As Integer = 0 To ayatCount Dim ayahNumber As String = ayah.ToString("D3") ' تحويل رقم الآية إلى 3 أرقام Dim fileUrl As String = baseUrl & surahNumber & ".zip" & "/" & surahNumber & ayahNumber & ".mp3" Dim sqlInsert As String = "INSERT INTO sounds (surah_number, ayah_number, audio_url, reader_id) VALUES (" & surah & "," & ayah & "," & "'" & fileUrl & "'" & "," & reader_id & ");" My.Computer.FileSystem.WriteAllText(Application.StartupPath & "\sql_" & reader_id & ".txt", sqlInsert & vbNewLine, True) Next Next '' تشغيل كل عملية في ثريد منفصل باستخدام Task 'Task.Run(Sub() GenerateQuranAudioLinks("https://archive.org/download/128kb---a7mad--n3ena3---morattal------quran----6236---ayaat-----__verse--by---_189/", "1")) 'احمد نعينع 'Task.Run(Sub() GenerateQuranAudioLinks("https://archive.org/download/64kb__---mp3------------quran----6236---ayaat-----__verse--by---verse----_-by-/", "2")) 'الطبلاوي 'Task.Run(Sub() GenerateQuranAudioLinks("https://archive.org/download/192kb----morattal----quran----6236---ayaat-----__verse--by---verse----_-by--ab_525/", "3")) 'عبد الباسط 'Task.Run(Sub() GenerateQuranAudioLinks("https://archive.org/download/128kb____--mp3-------full-----quran----6236---ayaat-----__verse--by---verse---/", "4")) 'المنشاوي 'Task.Run(Sub() GenerateQuranAudioLinks("https://archive.org/download/64kb___--mp3-----quran----6236---ayaat-----__verse--by---verse----_-by---alhos/", "5")) 'الحصري End Sub ارفقت لكم البيانات على شكل ملفات TXT لكي تعدلو عليها كيفما شئتم. لا تنسوني ووالدي من صالح دعائكم SQLite.zip

عليكم السلام ورحمة الله وبركاته... Function DeterminePromotionStatus(Grade As String, Gender As String, Total_T As String) As String If Grade = "الأول" Then If Gender = "ذكر" Then If Total_T = "غ" Then DeterminePromotionStatus = "منقول للصف الثاني" Else DeterminePromotionStatus = "منقول للصف الثاني" End If ElseIf Gender = "انثي" Then If Total_T = "غ" Then DeterminePromotionStatus = "منقولة للصف الثاني" Else DeterminePromotionStatus = "منقولة للصف الثاني" End If End If End If End Function في استعلام qryNtejah_End_Lwo، يمكنك استخدام هذه الدالة المخصصة ضمن حقل جديد لتحديد الحالة كما يلي: SELECT StudentName, Grade, Gender, Total_T, DeterminePromotionStatus([Grade], [Gender], [Total_T]) AS PromotionStatus FROM Tbl_degree_Detail; شرح: DeterminePromotionStatus: هذه الدالة تقوم بتحليل القيم في الحقول Grade, Gender, و Total_T لتحديد النتيجة. تطبيق الدالة في الاستعلام: بإضافة حقل جديد باسم PromotionStatus في الاستعلام، سيتم حساب الحالة استنادًا إلى الدالة.

وعليكم السلام ورحمة الله وبركاته... Sub ExportToExcel() Dim xlApp As Object Dim xlBook As Object Dim xlSheet As Object Dim rs As DAO.Recordset Dim i As Integer Dim j As Integer ' افتح تطبيق إكسل Set xlApp = CreateObject("Excel.Application") Set xlBook = xlApp.Workbooks.Add Set xlSheet = xlBook.Worksheets(1) ' افتح سجل البيانات (Recordset) الذي تريد تصديره Set rs = CurrentDb.OpenRecordset("اسم_الجدول_أو_الاستعلام") ' تصدير العناوين For i = 0 To rs.Fields.Count - 1 xlSheet.Cells(1, i + 1).Value = rs.Fields(i).Name Next i ' تصدير البيانات rs.MoveFirst i = 2 Do While Not rs.EOF For j = 0 To rs.Fields.Count - 1 xlSheet.Cells(i, j + 1).Value = rs(j) Next j i = i + 1 rs.MoveNext Loop ' تنسيق العناوين With xlSheet.Rows(1) .Font.Bold = True .Font.Size = 16 .Interior.Color = RGB(255, 255, 0) ' خلفية صفراء .HorizontalAlignment = -4108 ' توسيط النص End With ' تنسيق البيانات With xlSheet.Range(xlSheet.Cells(2, 1), xlSheet.Cells(i - 1, rs.Fields.Count)) .Font.Size = 14 .Font.Bold = True .HorizontalAlignment = -4108 ' توسيط النص End With ' توسيع الأعمدة لتلائم المحتوى xlSheet.Columns.AutoFit ' عرض تطبيق إكسل xlApp.Visible = True ' تنظيف الذاكرة Set rs = Nothing Set xlSheet = Nothing Set xlBook = Nothing Set xlApp = Nothing End Sub

وعليكم السلام ورحمة الله وبركاته... Sub CountUniqueRecordsWithFilteredData() Dim rs As Recordset Dim uniqueIDs As Collection Set rs = Me.YourSubForm_sub.Form.RecordsetClone Set uniqueIDs = New Collection rs.MoveFirst Do Until rs.EOF On Error Resume Next uniqueIDs.Add rs!Id, CStr(rs!Id) On Error GoTo 0 rs.MoveNext Loop uniqueCount = uniqueIDs.Count Set rs = Nothing Set uniqueIDs = Nothing End Sub

لان طريقة الارسال تكون Ctrl+C, Ctrl+V فلا يمكن ارسال اي شيء سوى الصور غريب! ربما هنالك مشكلة في ارسال نص مع صورة، هل جربت ارسال نص فقط؟ او صورة فقط؟؟ سارى المشكلة عندما اعود مساءً الى المنزل. شكرا لك الله يحفظك حبيبي الله يجزاك الجنة اخوي ابو خليل الطيب.. نعم اصبح الارسال الان من داخل جهاز الكومبيوتر عن طريق CMD

السلام عليكم ورحمة الله وبركاته.. كنت قد طرحت سابقًا موضوع يتكلم عن ارسال رسائل الى الواتس اب لعدد X من المستخدمين من خلال الاكسس وهنا X معناها عدد معين كأن يكون 10 مستخدمين او اكثر او اقل.. الموضوع القديم كان فيه مشكلة وهو ان رسائل الواتس اب الطويلة لا يمكن ارسال او تُرسل بشكل مقطوع! الحمدلله في هذا الاصدار تم التغلب نهائيًا على هذه المشكلة واصبح البرنامج يرسل عدد كلمات بالعدد الذي يسمح به الواتس اب الجديد في هذا الاصدار: امكانية ارسال المرفقات ( الصور فقط ) 1- يمكنك ارسال رسائل فقط 2- يمكنك ارسال صور فقط 3- يمكنك ارسال رسالة مع صورة صورة مشروع الاكسس: قم بتحديد الاشخاص الذين تريد ارسال الرسالة لهم مع وضع نص الرسالة مع امكانية تحديد الكل يمكنك شروط البرنامج بحسب ماتراه مناسباً. النتيجة: ملاحظة يجب ان يكون برنامج الواتس اب موجود في جهاز الكومبيوتر واهم ملاحظة هي يجب كتاب رقم الواتس اب الذي تريد ان ترسل له الرسالة كما يظهر في البرنامج، مثال: لتحميل الواتس اب من الرابط الاتي: https://www.whatsapp.com/download بالمناسبة: الحمدلله انتهيت من برنامج تحويل الصور الى نصوص مهما كانت اللغة ( OCR ) وخصوصا اللغة العربية وحتى الصور التي تكون مكتوبة بخط اليد يتم تحويلها الى نصوص يسهل التعديل عليها في برنامج الوورد البرنامج يعمل بطريقتين: 1- يمكنك تحويل الصور بشكل مباشر 2- يمكنك استخدام الاكسس في ارسال CommandLine يتضمن مسار الصورة ومسار ملف التكست للنص الذي سوف يحفظ وسيقوم البرنامج بعمله لا تنسوني ووالدي من صالح دعائكم. تم بحمد الله. SendWhatsAppMessages.rar

حياك الله اخي الكريم، الحمدلله انا في خير وصحة.. اسال الله ان تكون انت كذلك

مبدع دائما عزيزي موسى، سلمت اناملك. بالمناسبة كنت اعتقد انك شخص عجوز 😄 لكن واضح من صوتك انك شاب 😅

اهلا اهلا اخوي العزيز ابو خليل حياك الله الكلمات عمانية 😄 مثل ما يقول اخي موسى معاني الكلمات : المتدوده بالعماني : هو الشخص الغائب عن وعيه وفاقد للتركيز في لحظة ما 🙂 غاوي بالعماني : الشخص الجميل او الوسيم

الف شكر لكم اخواني لتقديم المساعدة تم حل المشكلة بفضل الله وفضلكم وشكرا خاص لاخوي موسى، همسة (الله يبعد عنك المتدودة يا غاوي) 😄

=DSum("[bCountRooms]","[tbl_bookings]","[IsEnd] =true And [bToDate] = #" & Format([bFromDate],'mm/dd/yyyy') & "# ") المجموع = 9 انا لا اريد الحجوزات المغادرة وانما اريد الغرف المغادرة 😂 طبعا انا كنت ناسي الحقل bCountRooms وهو مفتاح حل جميع المشاكل 😁

نعم حبيبي النتيجة خطأ!، يطلعلي 6 غرف المفروض العدد يكون 9

خطأ المفروض الغرف المغادرة لتاريخ 10-2-2023 يكون 9 غرف مغادرة والغرف التي تم حجزها في هذا التاريخ هي 27 غرفة

ارفقت لك قاعدة بيانات فيها هذا المعيار