اجعل برنامجك يعمل على النواتين 32بت و 64بت

[jjafferr]

السلام عليكم 🙂

 

اذا عملنا برنامج على الاكسس 32بت ، وفيه مكتبات الوندوز الـ 32بت (لاحظ الرقم 32 في اسم المكتبة: comdlg32.dll) ، ثم شغلنا البرنامج على اكسس 64بت ، فنحصل على هذا الخطأ :

.

يوجد ملف في موقع مايكروسوف (مرفق نسخة Win32API_PtrSafe.zip) ، وفيه طريقة عمل مناداة النواتين :

https://www.microsoft.com/en-us/download/details.aspx?id=9970

وتوجد مواقع مجهزة الكود للنواتين ، مثل (فقط ابحث عن الدالة ، واعمل نسخ/لصق للكود) :

http://www.jkp-ads.com/articles/apideclarations.asp

------------------------------------------------------------------------------------------------------------------

 

ولكني هنا سأناقش كيف يمكننا تعديل المكتبة بدون الرجوع لهذه الروابط  (للأسف ، سنضطر للرجوع لهذه الروابط لبعض المكتبات) !!

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

 

الخطوة الاولى والاهم هي اضافة كلمة PtrSafe بعد كلمة Declare ، للنواتين 32بت و 64بت.

 

أ. الدالة : Sleep

نناديها بنواة 32بت هكذا :

Private Declare Sub Sleep Lib "kernel32" (ByVal lngMilliSeconds As Long)

وهنا مثال لعملها : 1.Sleep.32bits.accdb.zip

 

عندنا الطرق التالية (وجميعها تعمل وصحيحة) لنبدا العمل لجعل المكتبة تعمل على النواتين 32بت و64بت (وستكون طريقة عملنا بأحد هذه الطرق لجميع المكتبات) :

نلاحظ ان الفرق بين كود 32بت (اعلاه) ، واول كود 64بت (ادناه) هو اضافة كلمة PtrSafe بعد كلمة Declare ، والتي يقبلها نظام 32بت كذلك ،

وفي الطرق الثلاثة التالية ، نستخدم نفس الكود رقم 1 ، ولكننا نغلفه بالامر IF# ،

ولهذا المثال ، سوف استخدم الطريقة رقم 3 :

'1
'Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal lngMilliSeconds As Long)



'2
'#If VBA7 Then
'  Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal lngMilliSeconds As Long)
'#Else
'  Public Declare Sub Sleep Lib "kernel32" (ByVal lngMilliSeconds As Long)
'#End If



'3
#If VBA7 And Win64 Then
  Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal lngMilliSeconds As Long)
#Else
  Public Declare Sub Sleep Lib "kernel32" (ByVal lngMilliSeconds As Long)
#End If



'4
'#If Win64 Then
'  Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal lngMilliSeconds As Long)
'#Else
'  Public Declare Sub Sleep Lib "kernel32" (ByVal lngMilliSeconds As Long)
'#End If

.

ولكن ، لما نفتح الكود في الاكسس 64بت ، نلاحظ انه جعل كود 32بت باللون الاحمر :

.

على الرغم من البرنامج عمل لنا هذا السطر باللون الاحمر ، إلا ان الكود يعمل بطريقة صحيحة ، فلا تهتم به ،

وبعد كل خطوة نعملها ، يجب ان نعمل Compile :

 

حتى نعرف الخطأ التالي ، ونعدل عليه 🙂

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

والحمدلله ، هذه الدالة اصبحت جاهزة للعمل بالنواتين بهذا التغيير ، وتم تجربة الملف المرفق على النواتين🙂

وهذه النسخة بعد تحديثها للعمل على النواتين 32بت و64بت : 1.Sleep.64bits.accdb.zip

------------------------------------------------------------------------------------------------------

 

ب. الدوال: GetSystemDirectory ، GetWindowsDirectory ، GetTempDir

نواة 32بت :

Private Declare Function apiGetSystemDirectory& Lib "kernel32" _
        Alias "GetSystemDirectoryA" _
        (ByVal lpBuffer As String, ByVal nSize As Long)

Private Declare Function apiGetWindowsDirectory& Lib "kernel32" _
        Alias "GetWindowsDirectoryA" _
        (ByVal lpBuffer As String, ByVal nSize As Long)

Private Declare Function apiGetTempDir Lib "kernel32" _
        Alias "GetTempPathA" (ByVal nBufferLength As Long, _
        ByVal lpBuffer As String) As Long

والبرنامج : 2.System_Directories.32bits.accdb.zip

 

64بت، خطوات التعديل ، بإضافة PtrSafe فقط:

Private Declare PtrSafe Function apiGetSystemDirectory& Lib "kernel32" _
        Alias "GetSystemDirectoryA" _
        (ByVal lpBuffer As String, ByVal nSize As Long)

Private Declare PtrSafe Function apiGetWindowsDirectory& Lib "kernel32" _
        Alias "GetWindowsDirectoryA" _
        (ByVal lpBuffer As String, ByVal nSize As Long)

Private Declare PtrSafe Function apiGetTempDir Lib "kernel32" _
        Alias "GetTempPathA" (ByVal nBufferLength As Long, _
        ByVal lpBuffer As String) As Long

وعمل البرنامج بشكل صحيح للنواتين : 2.System_Directories.64bits.accdb.zip

------------------------------------------------------------------------------------------------------

 

ج. الدالة: EnumFontFamilies

عرض الخطوط fornts في مربع تحرير وسرد في الاكسس - قسم الأكسيس Access - أوفيسنا (officena.net)

لأخونا @kanory 🙂 

32بت :

Private Declare Function EnumFontFamilies Lib "gdi32" Alias "EnumFontFamiliesA" (ByVal hdc As Long, ByVal lpszFamily As String, ByVal lpEnumFontFamProc As Long, lParam As Any) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function GetFocus Lib "user32" () As Long

والبرنامج: 4.Kan_Fonts.32bits.accdb.zip

 

64بت، خطوات التعديل ، بإضافة PtrSafe فقط:

Private Declare PtrSafe Function EnumFontFamilies Lib "gdi32" Alias "EnumFontFamiliesA" (ByVal hdc As Long, ByVal lpszFamily As String, ByVal lpEnumFontFamProc As Long, lParam As Any) As Long
Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare PtrSafe Function GetFocus Lib "user32" () As Long

 

- لما نعمل Compile نحصل على الخطأ في السطر التالي:

.

اذن الخطأ في المتغير الثالث من الدالة EnumFontFamilies ، والذي نوعه Long ، فيجب تغييره في الدالة الى LongPtr ،

الخطوة الثانية تغيير النوع Long الى LongPtr في الدالة

وطبعا اذا عملنا التغيير على السطر اعلاه، فالنواة 32بت ستعطيك خطأ هنا ، لذا يجب تغليف الدالة بالامر IF# ، هكذا :

.

وعند عمل Compile مرة اخرى ، لا نحصل على خطأ ، والبرنامج يعمل بطريقة صحيحة ،

البرنامج يعمل بطريقة صحيحة : 4.Kan_Fonts.64bits.accdb.zip

------------------------------------------------------------------------------------------------------

 

د. دعوة لتجربة الاصدار الثالث من برنامج القران الكريم - صفحه 2 - قسم الأكسيس Access - أوفيسنا (officena.net)

برنامج الذكر الحكيم لأخونا @ابا جودى 🙂

 برنامج 32بت: 5.الذكر الحكيم V. 3.0.2.32bits.mdb.zip

 

وقبل تشغيله على 64بت ، نضيف الامر PtrSafe الى جميع الدوال ، سواء لنواة 32بت او 64بت (ومنها تم عمله) ، ومنهم :

Private Declare Sub ChooseColor Lib "msaccess.exe" Alias "#53" (ByVal hwnd As Long, clr As Long) '---color Picer
  
  الى 
Private Declare PtrSafe Sub ChooseColor Lib "msaccess.exe" Alias "#53" (ByVal hwnd As Long, clr As Long) '---color Picer
  

 

والنتيجة تمام : 5.الذكر الحكيم V. 3.0.2.64bits.mdb.zip

------------------------------------------------------------------------------------------------------

 

هـ. عندما يعطي برنامج الاكسس اخطاء - النسخة رقم 3 - قسم الأكسيس Access - أوفيسنا (officena.net)

مع ان الوحدة النمطية Shell_n_Wait تم اخذها من هذا الموقع :

https://github.com/xxdoc/vb6-Shell-Wait/blob/master/Shell %26 Wait v2/modShellWait.bas

والتي تم عملها للنواتين 32بت و64بت ، ولكن لايزال البرنامج يعطي اخطاء في بيئة 64بت ، فنفتحة في برنامج 64بت ،

نضيف الامر PtrSafe الى جميع الدوال ، ونعمل Compile ، 

وجدنا خطأ ، ونلاحظ اننا ننادي الدالة MoveWindow والتي تعطي قيمتها الى المتغير retval :

.

والآن لنرى الدالة نفسها ،

ولكن الدالة جاهزة من الاصل للنواة 64بت ، ولا تحتاج الى تعديل :

.

وبعد التمعن ، نرى ان الخطأ موجود في نوع المتغير retval ، حيث اننا اعلنا انه Long ، بينما في بيئة 64بت نلاحظ انه LongPtr ،

فالحل يكون ، اما ان نعمل IF# في الكود الاول ، واما ان نوقف الاعلان في الكود الاول ، ونضيفه في الكود الثاني ، كل حسب نوعه ، وانا سأعمل المقترح الثاني:

#If VBA7 Then
    Declare PtrSafe Function MoveWindow Lib "User32.dll" (ByVal HWnd As LongPtr, ByVal X As LongPtr, ByVal Y As LongPtr, ByVal nWidth As LongPtr, _
    ByVal nHeight As LongPtr, ByVal bRepaint As LongPtr) As LongPtr

    Public retval As LongPtr

#Else
    Declare Function MoveWindow Lib "User32.dll" (ByVal HWnd As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, _
    ByVal nHeight As Long, ByVal bRepaint As Long) As Long

    Public retval As Long

#End If

.

نعمل Compile مرة اخرى ، لنحصل على الخطأ التالي:

.

والدوال:

.

فالحل هو ان نغلف الدوال بالامر IF# ،

ونجعل بيئة 64بت ان يكون LongPtr ، فقط للمتغير الاول لهذه الدالة ، 

.

نعمل Compile مرة اخرى ، لنحصل على الخطأ التالي:

.

والتعديل :

.

وهكذا الى بقية الاخطاء المشابهة .....

الخطأ التالي ، والغير عن الاخطاء اعلاه :

.

بالبحث ، لا نجد له دالة ، وانما نجد انه تم الاعلان عنه:

.

فيجب حذفه من هذا الاعلان ، وإضافته الى التغليف IF# ، فيكون اعلاه للبيئة 32بت ، واما للنواة 64بت فيكون LongPtr ،

وبعد جميع التعديلات ، تكون النسخة تعمل على النواتين ، كما في المرفق: 

عندما يعطي برنامج الاكسس اخطاء - النسخة رقم 4 + عمل نسخ احتياطية - قسم الأكسيس Access - أوفيسنا (officena.net)

------------------------------------------------------------------------------------------------------

 

واخيرا:

و. دالة فتح نافذة اختيار/حفظ الملف: GetOpenFileName و GetSaveFileName

والتعديل على هذه الدوال لا يعتمد على التغليف IF# ، وجعل الاعلان عن المتغير فيه ، ونما نحتاج الى تغيير Len الى LenB ، ونحتاج الى تعديل هذه الجزئية كذلك:

.

وهذا الملف للنواتين: 9.Allow_ByPass_Key.64bits.mdb.zip

 

 

بهذه الطرق ، نستطيع ان نحول برامجنا لتعمل على نواتي اكسس 32بت و64بت 🙂

الموضوع فني بحت ، وتحتاج ان يكون عندك نواتي اكسس ، حتى تعدل على النواتين ، ثم تجربهم الاثنين 🙂

 

------------------------------------------------------

وهناك طريقة ثانية ، اعتقد بأنها اسهل واستعملها دائما :

 

 

جعفر

1.Sleep.64bits.accdb.zip 1.Sleep.32bits.accdb.zip

Win32API_PtrSafe.zip

[kanory]

مشكور حبيبنا @jjafferr

بارك الله فيك ... 

رائع دائما ..

[abouelhassan]

اعزك الله وجعلها بميزان حسناتك يارب

كنز معلومات مهم يجب اغتنامه سأحتفظ به لحين اتمكن من استخدامه حفظك الله وادام نعمه وخيره عليك اخى استاذ جعفر 

بارك الله فيك ولك وبك اللهم امين يارب

 

[ابوبسمله]

جزاك الله خيرا اخى ومعلمنا العزيز جعفر 💐

الدرس ده محتاج يكون لدينا النواتين للتجربه والاستفاده القصوى مع فنجانين قهوه مع حضور اصحابك مع اصحابنا والبخور عمانى علشان يكونوا شغالين تمام 😀

ان شاء الله نستفيد منه اذا توفر لدينا النواتين حيث اعمل ع نواه 32 بت حاليا ولعل اخواننا الذين يتوفر لديهم النواتين يشارك بالتجارب

بارك الله لنا فيك وبارك لك فى اهلك ومالك ووقتك وكل ما تحب

 

[محمد سلامة]

جزاك الله خيراً

هل يمكن تصطيب اوفيس نواتين (32-64) علي نفس الجهاز ..انا بصراحة مجربتش 

تحياتي 🌹

[ابوآمنة]

شكراً معلمنا جعفر 

سلمت يمينك 

ودائماً تتطرق لأمور مهمة يحتاجها مبرمج أكسيس .

بارك الله في جهودكم 

زادك الله علماً وعملاً

[ابوخليل]

شرح وافي متكامل ودقيق 

ومرجع مهم للمبرمج تكثر الحاجة اليه

شكرا جزيلا استاذ جعفر  ، جعله الله في موازين اعمالك .

[jjafferr]

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

 

 

12 ساعات مضت, محمد سلامة said:

هل يمكن تصطيب اوفيس نواتين (32-64) علي نفس الجهاز

مباشرة وبالطريقة العادية ، لا ، ولكن يمكن هكذا :

 

 

جعفر

[محمد سلامة]

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

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

 

 

مباشرة وبالطريقة العادية ، لا ، ولكن يمكن هكذا :

 

 

جعفر

جزاك الله خيراً أستاذ جعفر مشاركة قيمة استفدت منها 

سؤال اخير

 

هل يمكن تنزيل 2 وندوز علي نفس الهارد كل ويندوز في برتشن ؟ 

 

 

[jjafferr]

32 دقائق مضت, محمد سلامة said:

هل يمكن تنزيل 2 وندوز علي نفس الهارد كل ويندوز في برتشن ؟ 

نعم ، وتم مناقشة هذه النقطة في الرابط الذي ارفقته لك ، هنا في هذه المشاركة لأخونا @kha9009lid :

 

 

جعفر

[Ali Mohamed Ali]

بارك الله فيك استاذ جعفر وزادك الله من فضله

[hafez81]

كل الاحترام

[عبدالله المجرب]

بارك الله فيك استاذ جعفر

شرح كافي ووافي 

ان شاءالله اجربه في برنامجي

[الهمة]

بارك الله فيك أستاذ جعفر معلومات قيمة

[عذاب الزمان]

الله يوفقك استاذ جعفر ويزيدك من العلم والفهم بعدد ما احاط به علمه

موضوع جميل جدا وساحتفظ به عندي 

حقيقة انتم في هذا المنتدى كنوز ثمينه حفظكم الله من كل سوء ومكروه .

[عبدالله المجرب]

السلام عليكم 

 

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

 

 

هذا هو الكود المستخدم عندي 

 

 

Option Compare Database
Option Explicit

Type OPENFILENAME
  lStructSize As Long
  hwndOwner As Long
  hInstance As Long
  lpstrFilter As String
  lpstrCustomFilter As String
  nMaxCustFilter As Long
  nFilterIndex As Long
  lpstrFile As String
  nMaxFile As Long
  lpstrFileTitle As String
  nMaxFileTitle As Long
  lpstrInitialDir As String
  lpstrTitle As String
  Flags As Long
  nFileOffset As Integer
  nFileExtension As Integer
  lpstrDefExt As String
  lCustData As Long
  lpfnHook As Long
  lpTemplateName As String
End Type

Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
  "GetOpenFileNameA" (OFN As OPENFILENAME) As Boolean

Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias _
  "GetSaveFileNameA" (OFN As OPENFILENAME) As Boolean

Private Const ALLFILES = "All files"

Function MakeFilterString(ParamArray varFilt() As Variant) As String
  Dim strFilter As String
  Dim intRes As Integer
  Dim intNum As Integer

  intNum = UBound(varFilt)
  If (intNum <> -1) Then
    For intRes = 0 To intNum
      strFilter = strFilter & varFilt(intRes) & vbNullChar
    Next
    If intNum Mod 2 = 0 Then
      strFilter = strFilter & "*.*" & vbNullChar
    End If

    strFilter = strFilter & vbNullChar
  End If

  MakeFilterString = strFilter
End Function

Private Sub InitOFN(OFN As OPENFILENAME)
  With OFN
    .hwndOwner = hWndAccessApp
    .hInstance = 0
    .lpstrCustomFilter = vbNullString
    .nMaxCustFilter = 0
    .lpfnHook = 0
    .lpTemplateName = 0
    .lCustData = 0
    .nMaxFile = 511
    .lpstrFileTitle = String(512, vbNullChar)
    .nMaxFileTitle = 511
    .lStructSize = Len(OFN)
    If .lpstrFilter = "" Then
      .lpstrFilter = MakeFilterString(ALLFILES)
    End If
    .lpstrFile = .lpstrFile & String(512 - Len(.lpstrFile), vbNullChar)
  End With
End Sub

Function OpenDialog(OFN As OPENFILENAME) As Boolean
  Dim intRes As Integer
  InitOFN OFN
  intRes = GetOpenFileName(OFN)
  If intRes Then
    With OFN
      .lpstrFile = Left$(.lpstrFile, InStr(.lpstrFile, vbNullChar) - 1)
    End With
  End If
  OpenDialog = intRes
End Function

 

[jjafferr]

29 دقائق مضت, عبدالله المجرب said:

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

موجودة في المشاركة

 

https://www.officena.net/ib/applications/core/interface/file/attachment.php?id=190590

[ابو جودي]

وممكن استبدالها يا استاذ @عبدالله المجرب بالكود الاتى 
 

Public Function SelectFile()

On Error GoTo ErrorHandler

Dim FileDialog  As Object
Dim sPath       As String
Dim sFile       As String
  

  Set FileDialog = Access.Application.FileDialog(3)
    With FileDialog
      .AllowMultiSelect = False
      .Filters.Clear
      .Filters.Add "Pic Files", "*.png"
      .Show
      .Title = "Please select a File"
      SelectFile = .SelectedItems(1)
    End With

ExitHandler:
   Exit Function
ErrorHandler:
  MsgBox "Error Number : " & Err.Number & vbNewLine & "Error Description : " & Err.Description
  Resume ExitHandler

End Function

 

طبعا مع مراعاة تغير الامتداد حسب رغبتك

.Filters.Add "Pic Files", "*.png"

 

[عبدالله المجرب]

لا زلت اعاني من هذه المشكلة 

جربت التعديلات المطلوبة على حسب معرفتي (عملت #If VBA7 Then -      وكذلك PtrSafe  بدلت المتغيرات التي تحتاج الى تغيير مثل Len الى LenB طبعاً حسب الحاجة) 

لا زالت المشكلة عندي انه اذا شغلت البرنامج على اوفيس 64 بت فانه يعمل لمدة 5 دقائق وبعدها فجأة يغلق ويقوم بعمل نسخة إحتياطية ثم تشغيل البرنامح 

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

طبعاً عملت  Compile  ولكن لا توجد اخطاء في الكود ويصبخ غير مفعل اي انه لا اخطاء في الأكواد

 

ما الحل من فضلكم 

 

[jjafferr]

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

 

عيدك مبارك اخوي عبدالله 🙂

 

1. هناك مكتبات تعمل على النواتين ، فقط تضيف PtrSafe  لما تصرح عن المكتبة باستعمال Declare ،

2. وهناك مكتبات تحتاج الى تصريح خاص لنواة 32بت ، وتصريح آخر لنواة 64بت ،

3. وهناك مكتبات لا تعمل على 64بت ، ولا تعطي خطأ ، وهذه يجب ان تجد البديل لعملها او طريقة اخرى للقيام بما تريد.

 

اما ان البرنامج يعمل لفترة معينة ثم يُغلق ، فلم اسمع عنها !!

ارفق المكتبة ، والجزئية التي تستعملها في البرنامج ، وخلينا نشوف طريقة المثلى للتعامل معاها 🙂

 

جعفر

[Moosak]

12 ساعات مضت, jjafferr said:

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

 

عيدك مبارك اخوي عبدالله 🙂

 

1. هناك مكتبات تعمل على النواتين ، فقط تضيف PtrSafe  لما تصرح عن المكتبة باستعمال Declare ،

2. وهناك مكتبات تحتاج الى تصريح خاص لنواة 32بت ، وتصريح آخر لنواة 64بت ،

3. وهناك مكتبات لا تعمل على 64بت ، ولا تعطي خطأ ، وهذه يجب ان تجد البديل لعملها او طريقة اخرى للقيام بما تريد.

 

اما ان البرنامج يعمل لفترة معينة ثم يُغلق ، فلم اسمع عنها !!

ارفق المكتبة ، والجزئية التي تستعملها في البرنامج ، وخلينا نشوف طريقة المثلى للتعامل معاها 🙂

 

جعفر

الحمدلله على سلامتك عمي جعفر 😊🌷

عودا حميدا .. افتقدناك 🙂 

[jjafferr]

الله يسلمك ويعافيك اخوي موسى 🙂

مو اخبار الشواء هالعيد 😋

 

جعفر

[Moosak]

12 دقائق مضت, jjafferr said:

مو اخبار الشواء هالعيد 

😋

جارِ القضاء عليه 😋😅

[jjafferr]

بالصحة والعافية 🙂

 

جعفر

[عبدالله المجرب]

كل عام وانت بخير استاذ جعفر 

شكرا للرد 

لكنه الواقع والمشكلة التي اصادفها هي انه بعد حوالي 5 دقائق يغلق البرنامج وتظهر له نسخة احتياطية ثم يفتح من جديد وهكذا