⭐ هدية ~ طريقة ابداعية للتحديث من خلال الانترنت ⭐

**Foksh** · منذ 22 ساعات

السلام عليكم ورحمة الله وبركاته ، أخواني وأساتذتي ومعلمينا ( دون استثناء )

بالإشارة الى الموضوع الذي أعلنت عنه سابقاً في هذا الرابط هنا ، اسمحوا لي بأن أطرح هذه الفكرة الجديدة والتي تم تجربتها مراراً وتكراراً إلى أن خرجت بهذه النتيجة فيما يتعلق بموضوع التحديث الهوائي أو Online أو OTA ( Over-The-Air ) .

الموضوع بداية بسيط جداً ولن يحتاج تعقيد في تنفيذ هذه الطريقة . حيث ما يلزمنا أولاً هو حساب على Google Drive ( لماذا ؟ = لأن 95 % من الأشخاص عندهم هذا الحساب ) . و حساب على موقع Dropbox ( لماذا ؟ = لأنه يعطينا امكانية التحميل برابط مباشر خلافاً في جوجل درايف ) وهو ما يميزه عن Google Drive .

بناءً على ما سلف ، نبدأ شرح الخطوات والمتطلبات على بركة الله :-

1. سنحتاج جدول واحد مرفق وهو ( Settings ) ، ولا أنصح بالتلاعب به ما لم يكن على أساس صحيح ؛ ويحتوي على الحقول التالية :-

الحقل Ver = رقمي = لتحديد الإصدار الحالي للنسخة الحالية في قاعدة البيانات الحالية.
الحقل Link = نصي = لتحديد رابط الملف النصي الذي سيتم قراءة الإصدار الجديد منه ومقارنته مع قيمة الحقل Ver لتحديد ما اذا كان هناك نسخة جديدة أم لا .
الحقل URLS = نصي = سيتم ادراج رابط التحميل للإصدار الجديد من خلال الكود تلقائياً.
الحقل DBName = نصي = سيمكانك هنا من تحديد اسم قاعدة البيانات التي سيتم حفظ التحديث الجديد بها . وهنا لتسهيل فكرة اسم القاعدة القديمة واستبدالها بالنسخة الجديدة سيتم جلب القيمة تلقائياً .
الحقل Auto_Check = نوع Yes/No = لتفعيل ميزة الفحص التلقائي للتحديثات ( فكرة شبيهة بتلك التي في أجهزة الجوال والمحمول عند تفعيلها يصلك إشعارك بوجود نسخة جديدة إن كانت الميزة مفعلة طبعاً )

2. تحميل الإصدار الجديد على موقع Dropbox ونسخ رابط الملف ( مع التأكد أن الملف عند مشاركته قد تمت مشاركته للجميع - الموقع يجعلها قيمة افتراضية - ولكن للتأكيد ) .

3. ملف نصي واحد ( TxT. ) سميه ما شئت وهو ثابت غير قابل للتبديل ، ويكون محتواه ما يلي :-
large_Dot1.png.2bfd26d85907114f648748b220636475.png السطر الأول نضع رقم الإصدار الجديد . اي انه في الملف القديم لنفترض ان قيمة الحقل Ver = 0.1 . هنا في الملف النصي سنضع الإصدار الأحدث أي مثلاً ( 0.2 ).
large_Dot1.png.2bfd26d85907114f648748b220636475.png السطر الثاني نضع رابط النسخة الحديثة التي تم رفعها على Dropbox في النقطة السابقة 2 .

أي انه سيكون لدينا ملف نصي يحتوي سطرين الأول رقم الإصدار الحديث والذي ستتم قراءته و مقارنته مع الحقل Ver في الإصدار الذي لدى العميل ، والسطر الثاني رابط النسخة الأحدث من دروب بوكس .

4. سنقوم برفع هذا الملف النصي على جوجل درايف ( السبب : دروب بوكس لم يدعم فكرة قراءة الملف النصي وجلب قيمة رقم الاصدار في السطر الأول لمقارنتها مع القيمة في النسخة التي لدى العميل في الحقل Ver ) .

5. ثم سنقوم بنسخ الرابط لهذا الملف النصي ومشاركته للجميع - أو بمعنى آخر لمن يملك الرابط - ولصقه في الجدول الثابت Settings في الحقل Link وهو هنا سيكون أيضاً قيمة ثابتة لن تتغير . أي أنك ستقوم بتغيير فقط رقم الإصدار في النسخة الجديدة في الحقل Ver . وإعادة رفع الملف النصي بعد تحديث قيمة رقم الاصدار الجديد فقط .

طبعاً هنا بالإفتراض جدلاً وبعد تجربة متكررة أنه عندما تقوم برفع ملف موجود مسبقاً على أي موقع من ( جوجل درايف أو دروب بوكس ) فأن العنوان لهذا الملف لن يتغير لأنه سيتم استبدال الملف القديم بالجديد . ( وهي نقطة جيدة استفدنا منها لصالحنا ).

6. الآن الفكرة بشكل عام واضحة ولا تحتاج لتعقيد في الشرح ( وأي فكرة أو طريقة في البداية ستحتاج مرات معدودة لتصبح سهلة في تطبيقها عن ظهر قلب )

الآن وما هو مهم للجميع ، الكود التالي للمديول :-

'**********************************************
'***                                        ***
'***   FFFFFF   OOO   KK KK    SSSS  HH  HH ***
'***   FF      O   O  KK KK   SS     HH  HH ***
'***   FFFFF   O   O  KKK      SS    HHHHHH ***
'***   FF      O   O  KK KK     SS   HH  HH ***
'***   FF       OOO   KK  KK  SSSSS  HH  HH ***
'***                                        ***
'*************** ( 28/12/2024 ) ***************

Option Compare Database
Option Explicit

Public Function IsInternetConnected() As Boolean
    On Error GoTo ErrorHandler
    Dim xhr As Object
    Set xhr = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    xhr.SetOption 2, 13056
    xhr.Open "GET", "https://www.google.com", False
    xhr.send
    IsInternetConnected = (xhr.Status = 200)
    Set xhr = Nothing
    Exit Function
    
ErrorHandler:
    IsInternetConnected = False
    If Not xhr Is Nothing Then Set xhr = Nothing
End Function

Public Function ConvertGoogleDriveLink(ByVal originalLink As String) As String
    On Error GoTo ErrorHandler
    Dim FileID As String
    If InStr(1, originalLink, "/d/") > 0 Then
        FileID = Mid(originalLink, InStr(1, originalLink, "/d/") + 3)
        FileID = Left(FileID, InStr(1, FileID, "/") - 1)
    ElseIf InStr(1, originalLink, "id=") > 0 Then
        FileID = Mid(originalLink, InStr(1, originalLink, "id=") + 3)
        If InStr(1, FileID, "&") > 0 Then
            FileID = Left(FileID, InStr(1, FileID, "&") - 1)
        End If
    End If
    If Len(FileID) > 0 Then
        ConvertGoogleDriveLink = "https://drive.google.com/uc?id=" & FileID
    Else
        ConvertGoogleDriveLink = originalLink
    End If
    Exit Function
    
ErrorHandler:
    ConvertGoogleDriveLink = originalLink
End Function

Public Function CheckForUpdate() As Boolean
    On Error GoTo ErrorHandler
    Dim currentVer As Double
    Dim onlineVer As Double
    Dim xhr As Object
    Dim onlineContent As String
    Dim driveLink As String
    Dim contentLines() As String
    Dim updateURL As String
    Dim currentDBName As String
    currentDBName = CurrentDb.Name
    currentDBName = Mid(currentDBName, InStrRev(currentDBName, "\") + 1)
    currentDBName = Left(currentDBName, InStrRev(currentDBName, ".") - 1)
    CurrentDb.Execute "UPDATE Settings SET DBName = '" & Replace(currentDBName, "'", "''") & "'"
    currentVer = DLookup("Ver", "Settings")
    If Not IsInternetConnected() Then
        Forms!Frm_Index!Lbl_Load.Caption = "أنت تستخدم الإصدار: " & currentVer
        CheckForUpdate = False
        Exit Function
    End If
    driveLink = ConvertGoogleDriveLink(DLookup("Link", "Settings"))
    Set xhr = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    xhr.SetOption 2, 13056
    xhr.Open "GET", driveLink, False
    xhr.setRequestHeader "User-Agent", "Mozilla/5.0"
    xhr.send
    If xhr.ReadyState = 4 Then
        If xhr.Status = 200 Then
            onlineContent = Trim(xhr.responseText)
            contentLines = Split(onlineContent, vbCrLf)
            If UBound(contentLines) >= 1 Then
                onlineVer = Val(contentLines(0))
                updateURL = Trim(contentLines(1))
                If onlineVer > 0 Then
                    If onlineVer > currentVer Then
                        CurrentDb.Execute "UPDATE Settings SET URLS = '" & updateURL & "'"
                        Forms!Frm_Index!Lbl_Load.Caption = " تحديث جديد متوفر الآن : " & onlineVer & "  Ver - انقر للتحميل  "
                        Forms!Frm_Index!ImgUpdate.Visible = True
                        CheckForUpdate = True
                        Forms!Frm_Index!Tx_User.Enabled = True
                        Forms!Frm_Index!Tx_Pass.Enabled = True
                        Forms!Frm_Index!Tx_User.SetFocus
                    Else
                        Forms!Frm_Index!Lbl_Load.Caption = "أنت تستخدم أحدث إصدار : " & onlineVer & "  Ver "
                        Forms!Frm_Index!Tx_User.Enabled = True
                        Forms!Frm_Index!Tx_Pass.Enabled = True
                        Forms!Frm_Index!Tx_User.SetFocus
                    End If
                End If
            End If
        End If
    End If
    Set xhr = Nothing
    Exit Function

ErrorHandler:
    CheckForUpdate = False
    If Not xhr Is Nothing Then Set xhr = Nothing
End Function

Sub UpdateURLSAndOpenNewDatabase()
    Dim UrlValue As String, NameValue As String
    Dim TargetDb As DAO.Database
    Dim rs As DAO.Recordset
    Dim CurrentDbPath As String
    Dim NewDbPath As String
    CurrentDbPath = CurrentProject.Path & "\" & Dir(CurrentProject.FullName)
    NewDbPath = CurrentProject.Path & "\Data\Update.accdb"
    If Dir(CurrentProject.Path & "\Data\Update.Dll") <> "" Then
        Name CurrentProject.Path & "\Data\Update.Dll" As NewDbPath
    Else
        MsgBox "الملف Update.Dll غير موجود", vbCritical
        Exit Sub
    End If
    On Error GoTo ErrorHandler
    UrlValue = Nz(CurrentDb.OpenRecordset("SELECT URLS FROM Settings").Fields("URLS").Value, "")
    NameValue = Nz(CurrentDb.OpenRecordset("SELECT DBName FROM Settings").Fields("DBName").Value, "")
    If UrlValue = "" Or NameValue = "" Then
        MsgBox "خطأ في تحميل التحديث", vbCritical
        Exit Sub
    End If
    Set TargetDb = DBEngine.OpenDatabase(NewDbPath)
    Set rs = TargetDb.OpenRecordset("Settings", dbOpenDynaset)
    If rs.EOF Then
        rs.AddNew
        rs.Fields("URLS").Value = UrlValue
        rs.Fields("DBName").Value = NameValue
        rs.Update
    Else
        rs.MoveFirst
        rs.Edit
        rs.Fields("URLS").Value = UrlValue
        rs.Fields("DBName").Value = NameValue
        rs.Update
    End If
    rs.Close
    TargetDb.Close
    Shell "msaccess.exe """ & NewDbPath & """", vbNormalFocus
    Application.Quit
    Exit Sub

ErrorHandler:
    MsgBox "حدث خطأ: " & Err.Description, vbCritical
    If Not rs Is Nothing Then rs.Close
    If Not TargetDb Is Nothing Then TargetDb.Close
    Exit Sub
End Sub

Public Function ExtractAttachmentFile() As Boolean
    On Error GoTo ErrorHandler
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim rsAttach As DAO.Recordset2
    Dim fld As DAO.Field2
    Dim dataFolder As String
    dataFolder = CurrentProject.Path
    If Dir(dataFolder, vbDirectory) = "" Then
        MkDir dataFolder
    End If
    Set db = CurrentDb
    Set rs = db.OpenRecordset("Settings")
    If Not rs.EOF Then
        Set fld = rs.Fields("DBFiles")
        If Not IsNull(fld) Then
            Set rsAttach = fld.Value
            If Not rsAttach.EOF Then
                rsAttach.Fields("FileData").SaveToFile dataFolder & "\" & rsAttach.Fields("FileName").Value
                ExtractAttachmentFile = True
            End If
            rsAttach.Close
        End If
    End If
    
CleanUp:
    If Not rs Is Nothing Then rs.Close
    Set rs = Nothing
    Set db = Nothing
    Exit Function
    
ErrorHandler:
    ExtractAttachmentFile = False
    Resume CleanUp
End Function

وما يلي كود النموذج لجميع الأجزاء والمكونات داخله :-

'**********************************************
'***                                        ***
'***   FFFFFF   OOO   KK KK    SSSS  HH  HH ***
'***   FF      O   O  KK KK   SS     HH  HH ***
'***   FFFFF   O   O  KKK      SS    HHHHHH ***
'***   FF      O   O  KK KK     SS   HH  HH ***
'***   FF       OOO   KK  KK  SSSSS  HH  HH ***
'***                                        ***
'*************** ( 28/12/2024 ) ***************

Option Compare Database
Option Explicit
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private bMessage20Displayed As Boolean
Private bMessage35Displayed As Boolean
Private bMessage50Displayed As Boolean
Private LoginAttempts As Integer
Dim TimeCount As Long

Private Sub Btn_Quit_Click()
    Dim userResponse As VbMsgBoxResult
        userResponse = MsgBox("إغلاق النظام؟", _
                              vbYesNo + vbInformation + vbMsgBoxRight, "تأكيد عملية الإغلاق")
        If userResponse = vbYes Then
            DoCmd.Quit
        ElseIf userResponse = vbNo Then
            DoCmd.CancelEvent
        End If
End Sub

Private Sub Form_Load()
    ExtractAttachmentFile
    LoginAttempts = 0
    Me.Caption = "Foksh - Officena.Net - 2025"
    DoEvents
    If Check_Auto = -1 Then
    Me.TimerInterval = 1000
    Else
    Me.TimerInterval = 0
    Me.Lbl_Load.Caption = ""
    End If
End Sub

Private Sub Form_Timer()
    Me.TimerInterval = 0
    CheckForUpdate
End Sub

Private Sub ImgUpdate_Click()
    On Error GoTo ErrorHandler
    Dim userResponse As VbMsgBoxResult
        userResponse = MsgBox("التحديث الآن؟", _
                              vbYesNo + vbInformation + vbMsgBoxRight, "تأكيد عملية التحديث")
        If userResponse = vbYes Then
            UpdateURLSAndOpenNewDatabase
        ElseIf userResponse = vbNo Then
            DoCmd.CancelEvent
        End If
ErrorHandler:
    Resume Next
End Sub

ما يتم تنفيذه عند استعمال الفكرة :-

أولاً عند الفتح للمشروع سيتم استخراج ملف DLL مرفق داخل قاعدة البيانات .
ثانياً عند اكتمال التحديث سيتم استبدال النسخة القديمة بالنسخة الجديدة ، وشأنه شأن أي عملية تحديث ؛ فإنك ستفقد النسخة القديمة كاملةً ( وهنا الحاجة الماسة لاعتماد فكرة تقسيم قاعدة البيانات ) .

ملف الواجهة المرفق مفتوح المصدر 👈 [ Main.accdb ]

* عذراً إن كانت طريقتي في العمل مزعجة أو غريبة نوعاً ما ، لكن هو طبعي 😅 . فماذا أفعل ؟؟!!

تم تعديل منذ 4 ساعات بواسطه Foksh
تعديلات نصية وتصحيح أخطاء إملائية 💡

Eng Feras Abu Saleh · منذ 22 ساعات

اللهم نور له قبره وآنس وحشته ووسع مدخله، اللهمّ افسح له في قبره مدّ بصره، وافرش قبره من فراش الجنّة،اللهمّ احشره مع أصحاب اليمين، واجعل تحيّته سلامٌ لك من أصحاب اليمين

تم تعديل منذ 22 ساعات بواسطه Eng Feras Abu Saleh

فريدالطحان · منذ 21 ساعات

اللهم نور له قبره وآنس وحشته ووسع مدخله، اللهمّ افسح له في قبره مدّ بصره، وافرش قبره من فراش الجنّة،اللهمّ احشره مع أصحاب اليمين، واجعل تحيّته سلامٌ لك من أصحاب اليمين

gamal gamal · منذ 21 ساعات

جزاك الله خيرا ونفع بك

ورحم الله والديك وأسكنهم

جنات النعيم ...

عاشق الرقي · منذ 19 ساعات

بارك الله في جهودك وجميع الأعضاء بلا إستثناء

ثم نسأل الله العلي القدير ان يغفر لوالدينا وجميع موتى المسلمين

الله أغفر لهم وارحمهم وآنس وحشتهم ووسع مدخلهم وأكرم نزلهم وأفرش لهم من فرش الجنة يارب

**Foksh** · منذ 4 ساعات

:excl: سيتم تحديث الملف الذي يتم تنزيله من التحديث بين فترة وأخرى ، لضمان أن الفكرة تعمل بدون مشاكل

**ابو جودي** · منذ 3 ساعات

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

18 ساعات مضت, Foksh said:

* عذراً إن كانت طريقتي في العمل مزعجة أو غريبة نوعاً ما ، لكن هو طبعي 😅 . فماذا أفعل ؟؟!!

بل السؤال الصحيح ماذا نفعل نحن :biggrin2:

جزاكم الله خيـــــرا على الافكار النيرة

**Foksh** · منذ 3 ساعات

25 دقائق مضت, ابو جودي said:

بل السؤال الصحيح ماذا نفعل نحن

إحنا نروح الشرطة :biggrin:

**Moosak** · منذ 2 ساعات

غفر الله لك ولوالديك ، وأسكن الله موتاكم وموتانا وموتى المسلمين مساكن الأنبياء والصالحين والصديقين والشهداء وحسن أولئك رفيقا ..
وزادك الله من علمه وهداه وتقواه، وأغناك الله من واسع فضله، وفتح لك فتوح العارفين، وألبسك لباس الصالحين .. يارب العالمين 🙂🤲🏻🌷🌹

ما شاء الله .. قطعة فنية نسجها محترف عارف بها 😊✌
جربتها .. وهي شغالة 10/10 تبارك الرحمن .. 😎👌🏻

تسجيل الدخول

⭐ هدية ~ طريقة ابداعية للتحديث من خلال الانترنت ⭐

الردود الموصى بها

Foksh

Eng Feras Abu Saleh

فريدالطحان

gamal gamal

عاشق الرقي

Foksh

ابو جودي

Foksh

Moosak

Join the conversation

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

تصفح الموقع

تصفح جديد الموقع

Support

Important Information