للنقاش موضوع للنقاش بخصوص أداة جديدة لتحويل الأكواد من 32 بت لتتوافق مع النواتين ( 32 و 64 )

[Foksh]

السلام عليكم ورحمة الله وبركاته ،،

في طور تحسين الأداة الجديدة ( لم يعلن عنها بعد ) ، للتعامل مع الأكواد التي تعمل على 32 ولا تعمل على 64 ، ما زال العمل جاري على تحسين أداء الأداة ، بحيث من خلال النقاش المفتوح نأتي للوصول الى أفضل أداء ونتيجة .

مرفق صورة توضيحية للوضع الحالي للأداة ، مع طرح مثال لكود قبل وبعد التحويل الناتج من الأداة . 

 

الكود الذي تمت التجربة عليه كمثال ( لا الحصر ) :-

Option Compare Database
Option Explicit
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As _
Any) As Long

Public Const WM_SETREDRAW = &HB
Public Sub FillChildren(twTree As MSComctllib.TreeView, rst As dao.Recordset, _
            ByVal nChild As MSComctllib.nodX, _
            strParentField As String, strIDField As String, _
            strTextField As String, Optional strTextField2 As Variant, Optional strTextField3 As Variant, Optional strTextField4 As Variant, Optional strTextField5 As Variant, _
            Optional strKeyPrefix As String, _
            Optional varImage As Variant, _
            Optional varImageRst As Variant, _
            Optional fBold As Boolean)
On Local Error GoTo FillChildren_Err

    Dim strCriteria As String, IMAGE As Variant, strPrefix As String, strText As String, newnodx As MSComctllib.nodX

    If strKeyPrefix = "" Then
        strPrefix = "a"
    Else
        strPrefix = strKeyPrefix
    End If

    If Mid(nChild.key, 2) = "0" Then
        strCriteria = BuildCriteria(strParentField, rst.Fields(strParentField).Type, "=" & Mid(nChild.key, 2) & " or is null")
    Else
        strCriteria = BuildCriteria(strParentField, rst.Fields(strParentField).Type, "=" & Mid(nChild.key, 2))
    End If
    rst.FindFirst strCriteria
    Do Until rst.NoMatch
        strText = Nz(rst(strTextField), " ")
        If Not IsMissing(strTextField2) Then strText = strText & (" " + rst(strTextField2))
        If Not IsMissing(strTextField3) Then strText = strText & (" " + rst(strTextField3))
        If Not IsMissing(strTextField4) Then strText = strText & (" " + rst(strTextField4))
        If Not IsMissing(strTextField5) Then strText = strText & (" " + rst(strTextField5))
        If Not IsMissing(varImageRst) Then
            IMAGE = rst(varImageRst)
        End If
        If (Not IsMissing(varImage)) And (Len(Nz(IMAGE)) = 0) Then
            IMAGE = varImage
        End If
        IMAGE = Nz(IMAGE, "Default")
        Set newnodx = twTree.Nodes.Add(nChild, tvwChild, strPrefix & rst(strIDField), strText, IMAGE)
        rst.FindNext strCriteria
    Loop

FillChildren_End:
On Error Resume Next
    Exit Sub

FillChildren_Err:
    Select Case Err.Number
        Case 35601, 35603
            'Image not found!!!
            IMAGE = "FlagDefault"

            Resume
        Case 35602
            'key not unique!!!
            Set newnodx = twTree.Nodes(strPrefix & rst(strIDField))
            Resume Next
        Case Else
            MsgBox "Error in FillChildren!!! " & Err.Number & Err.Description
            Stop
            Resume
    End Select
End Sub

 

النتيجة من الأداة بعد التحسينات والتعديلات :-

'Code converted to 64-bit compatibility By Foksh ( Officena.Net )
'Generated on: 2025-05-23 15:22:26
'Tool version:  Ver : 1.0

Option Compare Database
Option Explicit

#If VBA7 Then
    Public Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As LongPtr, ByVal wParam As Long, lParam As 
 Any) As Long
#Else
    Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
 (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As 
 Any) As Long

#End If

Public Const WM_SETREDRAW = &HB


Public Sub FillChildren(twTree As MSComctllib.TreeView, rst As dao.Recordset, _

            ByVal nChild As MSComctllib.nodX, _

            strParentField As String, strIDField As String, _

            strTextField As String, Optional strTextField2 As Variant, Optional strTextField3 As Variant, Optional strTextField4 As Variant, Optional strTextField5 As Variant, _

            Optional strKeyPrefix As String, _

            Optional varImage As Variant, _

            Optional varImageRst As Variant, _

            Optional fBold As Boolean)

On Local Error GoTo FillChildren_Err



    Dim strCriteria As String, IMAGE As Variant, strPrefix As String, strText As String, newnodx As MSComctllib.nodX



    If strKeyPrefix = "" Then

        strPrefix = "a"

    Else

        strPrefix = strKeyPrefix

    End If



    If Mid(nChild.key, 2) = "0" Then

        strCriteria = BuildCriteria(strParentField, rst.Fields(strParentField).Type, "=" & Mid(nChild.key, 2) & " or is null")

    Else

        strCriteria = BuildCriteria(strParentField, rst.Fields(strParentField).Type, "=" & Mid(nChild.key, 2))

    End If

    rst.FindFirst strCriteria

    Do Until rst.NoMatch

        strText = Nz(rst(strTextField), " ")

        If Not IsMissing(strTextField2) Then strText = strText & (" " + rst(strTextField2))

        If Not IsMissing(strTextField3) Then strText = strText & (" " + rst(strTextField3))

        If Not IsMissing(strTextField4) Then strText = strText & (" " + rst(strTextField4))

        If Not IsMissing(strTextField5) Then strText = strText & (" " + rst(strTextField5))

        If Not IsMissing(varImageRst) Then

            IMAGE = rst(varImageRst)

        End If

        If (Not IsMissing(varImage)) And (Len(Nz(IMAGE)) = 0) Then

            IMAGE = varImage

        End If

        IMAGE = Nz(IMAGE, "Default")

        Set newnodx = twTree.Nodes.Add(nChild, tvwChild, strPrefix & rst(strIDField), strText, IMAGE)

        rst.FindNext strCriteria

    Loop



FillChildren_End:

On Error Resume Next

    Exit Sub



FillChildren_Err:

    Select Case Err.Number

        Case 35601, 35603

            'Image not found!!!

            IMAGE = "FlagDefault"



            Resume

        Case 35602

            'key not unique!!!

            Set newnodx = twTree.Nodes(strPrefix & rst(strIDField))

            Resume Next

        Case Else

            MsgBox "Error in FillChildren!!! " & Err.Number & Err.Description

            Stop

            Resume

    End Select

End Sub

 

 

باب النقاش مفتوح لأي تعليقات وتوضيحات وتحديثات للجميع ..

الأداة حصرية وليس لها أي أساس في أي موقع أجنبي أو عربي ( فقط في أوفيسنا  )

 

*ملاحظة :-

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

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

نحن نتكاتف هنا لنتشارك معرفتنا وعلمنا الذي علمنا إياه الله - ولا علم إلا علمه . لذا متأملاً منهم خصوصاً مشاركتنا أفكارهم .

 

تم تعديل منذ 6 ساعات بواسطه Foksh
إضافة ملاحظتي الأخيرة ..

[ناقل]

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

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

وعليكم السلام ورحمة الله وبركاته
اشارك برأي من باب المشاركة ولست خبيرا ,,,,, لأنك انت من طلب من غير الخبراء المشاركة 😃

عن تعديل الكود اعتقد يجب النظر في كل المتغيرات والدوال مثلا هناك دوال تحتاج الى تعديل للعمل في بيئة 64 bit مثل :::::::::::::::

1. FindWindow
2. GetWindowLong / SetWindowLong
3. GetTickCount
4. ShellExecute
5. Sleep
6. GetSystemMetrics
7. GetCursorPos
8. OpenProcess
9. CreateFile

                                                                          والله اعلم

[ابوخليل]

اداة مهمة تختصر الوقت والجهد ..

لدي فكرة حول هذه الأداة .. و أرى ان وقت الفكرة المناسب هو بعد اكتمال الأداة تماما

وكما يقولون .. كل شيء بوقته حلو

[jjafferr]

وعليكم السلام

 

اهلا اخي فادي 🙂

اهم شيء في هذا الموضوع، هو الرجوع الى تعليمات مايكروسوفت في التعامل مع دوال نواة 64 بت ، في الرابط التالي: https://www.microsoft.com/en-us/download/details.aspx?id=9970

ملف النص في الرابط اعلاه يعطيك تفاصيل الدالة على نواة 64 بت.

 

المثال الذي استعملته انت، وانا متأكد بأنك كنت حريص في انتقاء الدالة، توجد به 3 فروقات عن الدالة في ملف مايكروسوفت (السطر الثاني من ملف مايكروسوفت) :

والمسألة لا تتوقف عند هذا السطر فقط، فهناك دوال معقدة تحتاج الى استعمال if# في دالتي الخاصة.

 

 

رجاء قراءة الموضوعين التاليين ، فطريقة العمل تختلفان ، وفيهما بعض الامثلة المختلفة:

.

.

 

 

[kkhalifa1960]

اعتقد بعد هذه الكوكبة من علمائنا الافاضل ..... وفي هذا الموضوع المهم والحيوي واقتراب موعد عدم اثراء أي برامج تعتمد عى 32 بت ...... وحتى تحصين برامجنا التي نعمل عليها .

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