رسالة (السيرفر لا يعمل ... او الشبكة غير متصلة )

للرفع لعل وعسى ان يرزقنا جواب ..........

اخي فتى الوادي

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

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

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

Declare Function WNetAddConnection2 Lib "mpr.dll" Alias _ 
	  "WNetAddConnection2A" (lpNetResource As NETRESOURCE, _ 
	  ByVal lpPassword As String, ByVal lpUserName As String, _ 
	  ByVal dwflags As Long) As Long 
	  Declare Function WNetCancelConnection2 Lib "mpr.dll" Alias _ 
	  "WNetCancelConnection2A" (ByVal lpName As String, _ 
	  ByVal dwflags As Long, ByVal fForce As Long) As Long 
	  Declare Function WNetGetConnection Lib "mpr.dll" Alias _ 
					   "WNetGetConnectionA" _ 
					   (ByVal lpszLocalName As String, _ 
					   ByVal lpszRemoteName As String, _ 
					   cbRemoteName As Long) As Long 

	  Type NETRESOURCE 
		dwScope As Long 
		dwType As Long 
		dwDisplayType As Long 
		dwUsage As Long 
		lpLocalName As String 
		lpRemoteName As String 
		lpComment As String 
		lpProvider As String 
	  End Type 

	  Public Const NO_ERROR = 0 
	  Public Const CONNECT_UPDATE_PROFILE = &H1 
	  ' The following includes all the constants defined for NETRESOURCE, 
	  ' not just the ones used in this example. 
	  Public Const RESOURCETYPE_DISK = &H1 
	  Public Const RESOURCETYPE_PRINT = &H2 
	  Public Const RESOURCETYPE_ANY = &H0 
	  Public Const RESOURCE_CONNECTED = &H1 
	  Public Const RESOURCE_REMEMBERED = &H3 
	  Public Const RESOURCE_GLOBALNET = &H2 
	  Public Const RESOURCEDISPLAYTYPE_DOMAIN = &H1 
	  Public Const RESOURCEDISPLAYTYPE_GENERIC = &H0 
	  Public Const RESOURCEDISPLAYTYPE_SERVER = &H2 
	  Public Const RESOURCEDISPLAYTYPE_SHARE = &H3 
	  Public Const RESOURCEUSAGE_CONNECTABLE = &H1 
	  Public Const RESOURCEUSAGE_CONTAINER = &H2 
	  ' Error Constants: 
	  Public Const ERROR_ACCESS_DENIED = 5& 
	  Public Const ERROR_ALREADY_ASSIGNED = 85& 
	  Public Const ERROR_BAD_DEV_TYPE = 66& 
	  Public Const ERROR_BAD_DEVICE = 1200& 
	  Public Const ERROR_CONNECTION_UNAVAIL = 1201& 
	  Public Const ERROR_BAD_NET_NAME = 67& 
	  Public Const ERROR_BAD_PROFILE = 1206& 
	  Public Const ERROR_BAD_PROVIDER = 1204& 
	  Public Const ERROR_BUSY = 170& 
	  Public Const ERROR_CANCELLED = 1223& 
	  Public Const ERROR_CANNOT_OPEN_PROFILE = 1205& 
	  Public Const ERROR_DEVICE_ALREADY_REMEMBERED = 1202& 
	  Public Const ERROR_EXTENDED_ERROR = 1208& 
	  Public Const ERROR_INVALID_PASSWORD = 86& 
	  Public Const ERROR_NO_NET_OR_BAD_PATH = 1203& 
	  Public Const ERROR_MORE_DATA = 234 
	  Public Const ERROR_NOT_SUPPORTED = 50& 
	  Public Const ERROR_NO_NETWORK = 1222& 
	  Public Const ERROR_NOT_CONNECTED = 2250& 

	  Sub Net_Connect(NetLocalName As String, NetRemoteName As String, Optional NetComment As String) 
	'  Call Net_Connect("X:", "\\ServerName\ShareName")	 'هنا يتم الاتصال مع المجلد المشترك على السيرفر  

	  Dim NetR As NETRESOURCE 
	  Dim ErrInfo As Long 
	  Dim MyPass As String, MyUser As String 

'	  NetR.lpLocalName = "X:" ' If undefined, Connect with no device 
'	  NetR.lpRemoteName = "\\ServerName\ShareName"   ' Your valid share 
'	  NetR.lpComment = "Optional Comment" 
'	  NetR.lpProvider =	' Leave this undefined 

	  NetR.dwScope = RESOURCE_GLOBALNET 
	  NetR.dwType = RESOURCETYPE_DISK 
	  NetR.dwDisplayType = RESOURCEDISPLAYTYPE_SHARE 
	  NetR.dwUsage = RESOURCEUSAGE_CONNECTABLE 
	  NetR.lpLocalName = NetLocalName ' If undefined, Connect with no device 
	  NetR.lpRemoteName = NetRemoteName   ' Your valid share 

	  If Len(Trim(Nz(NetComment))) > 0 Then 
		  NetR.lpComment = NetComment 
	  End If 

	  ' If the UserName and Password arguments are NULL, the user context 
	  ' for the process provides the default user name. 

	  ErrInfo = WNetAddConnection2(NetR, MyPass, MyUser, _ 
	  CONNECT_UPDATE_PROFILE) 
	  If ErrInfo = NO_ERROR Then 
		MsgBox "الاتصال بحالة ممتازه", vbInformation, "الاتصال ممتاز" 
	  Else 
		MsgBox "ERROR: " & ErrInfo & " - Net Connection Failed!",  vbExclamation, "لا يوجد اتصال للمشاركه" 
	  End If 
	  End Sub 
	  'قطع الاتصال بين السيرفر والجهاز الفرعي
	  Sub Net_Disconnect(XName As String) 
'	 Call Net_Disconnect("X:")   oder 
'	 Call Net_Disconnect("\\ServerName\ShareName") 

	  ' You may specify either the lpRemoteName or lpLocalName 
'	  strLocalName = "\\ServerName\ShareName"  'اسم المجلد المشترك على السيرفر
'	  strLocalName = "X:"  'اسم محرك الاقراص على السيرفر

	  Dim ErrInfo As Long 
	  Dim strLocalName As String 
	  strLocalName = XName 
	  ErrInfo = WNetCancelConnection2(strLocalName, _ 
	  CONNECT_UPDATE_PROFILE, False) 
	  If ErrInfo = NO_ERROR Then 
		MsgBox "تم قطع الاتصال بنجاح", vbInformation,  "قطع الاتصال مع المجلد المشترك" 
	  Else 
		MsgBox "ERROR: " & ErrInfo & " - Net Disconnection Failed!", _ 
		vbExclamation, "Share not Disconnected" 
	  End If 
	  End Sub

لتجربة الكود بعد حفظه :

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

Call Net_Connect("X:", "\\ServerName\ShareName")

حيث X يمثل اسم المحرك

و ServerName\ShareName هي اسم السيرفر ومجلد المشاركه

قم بتغييرها بما يناسبك

لقطع الاتصال مع محرك الاقراص ايضا ضع زر امر على النموذج واعطي زر الامر اسم قطع الاتصال مع المحرك وضع به هذا الامر

Call Net_Disconnect("X:")

ولقطع الاتصال مع مجلد المشاركه ضع هذا تحت زر امر واعطه اسم قطع الاتصال مع المجلد

Call Net_Disconnect("\\ServerName\ShareName")

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

وعدم الاتصال

Public Function GetUNCPath(strDriveLetter As String) As String 
On Local Error GoTo GetUNCPath_Err 
Dim Msg As String, lngReturn As Long 
Dim lpszLocalName As String 
Dim lpszRemoteName As String 
Dim cbRemoteName As Long 
lpszLocalName = strDriveLetter 
lpszRemoteName = String$(255, Chr$(32)) 
cbRemoteName = Len(lpszRemoteName) 
lngReturn = WNetGetConnection(lpszLocalName, lpszRemoteName, cbRemoteName) 
Select Case lngReturn 
	Case ERROR_BAD_DEVICE 
		Msg = "خطأ: الجهاز متعطل" 
	Case ERROR_CONNECTION_UNAVAIL 
		Msg = "خطأ: الاتصال غير فعال" 
	Case ERROR_EXTENDED_ERROR 
		Msg = "خطأ: خطأ خارجي" 
	Case ERROR_MORE_DATA 
		Msg = "خطأ: معلومات اضافية" 
	Case ERROR_NOT_SUPPORTED 
		Msg = "خطأ: غير متوفر في الوقت الراهن" 
	Case ERROR_NO_NET_OR_BAD_PATH 
		Msg = "خطأ: الشبكه غير عاملة او المسار خاطىء " 
	Case ERROR_NO_NETWORK 
		Msg = "خطأ: لايوجد شبكه عامله" 
	Case ERROR_NOT_CONNECTED 
			   Msg = "خطأ: لا يوجد اتصال" 
	Case NO_ERROR 
	' اذا لم تظهر اي رسالة فهذا يعني ان حالة الاتصال ممتازه
End Select 
If Len(Msg) Then 
	MsgBox Msg, vbInformation 
	Else 
	'اظهار مسار الشبكه في رسالة
		MsgBox Left$(lpszRemoteName, cbRemoteName) 
		GetUNCPath = Left$(lpszRemoteName, cbRemoteName) 
End If 
GetUNCPath_End: 
	Exit Function 
GetUNCPath_Err: 
	MsgBox Err.Description, vbInformation 
	Resume GetUNCPath_End 
End Function

لكي تقوم بعملية الفحص لهذا الكود بعد وضعه في احد الاجهزه كل ما عليك هو حفظه اولا ثم ضعه تحت زر امر في نموذج وضع به هذا التعبير

GetUNCPath("H:")

حيث H يمثل اسم محرك الاقراص على الجهاز الخادم او السيرفر قم بتغييره حسب ما هو موجود لديك

قم بتجربة الاكواد سواء في حالة كان هناك اتصال بالشبكة او عدم الاتصال لترى الرسائل التي تظهر وابلغنا بالنتيجه

بسم الله ما شاء الله عليكي

اللهم لا حسد ... اللهم اني صايم

انتي ممتازة جدا يا زهرة المنتدي

ربنا يكرمك ويزيدك علم علشان خاطرنا

كل سنة وانت طيبة العيد قرب وعايزيين منك هدية العيد

اخوكي فى الله

بارك الله فيك استاذنا احمد

هذا برنامج صغير يبين حالة الاتصال وعنوان الاتصال ونوع الاتصال و ...............

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

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

coshrs10.rar

اختنا زهرة المنتدي الجميل

اولا انتي اللي استاذة

واحنا تلاميذ عندك --- والله مش مجاملة لانني لا احب المجاملات تماما

انتي اضافتي لكل فئات اعضاء هذا المنتدي افكار وتوسعة مدارك وده اهم من اي علوم اخري

ربنا يكرمك

بس احنا عندنا فى مصر هدية العيد فلوس يعني مصاري :-)))))))))))))))))

البرنامج ممتاز وهاجربه فى اقرب فرصة مع احد الاصدقاء

كل سنة وانتي طيبة

اما بخصوص هدية العيد خليها فى العيد علشان تكون الفرحة اثنين

اخوكي فى الله

الله يهب لك عافية ... ويتقبل منا ومنك صالح الأعمال .... ويجعلنا وإياكم من المقبولين .....

سأجرب البرنامج ...

أنا مستعجل لهدايا العيد ... علشاني مسافر في العيد للحبايب .... وين الهدية ؟

طبعا بعد اذن الاستاذة زهره

انا عندي طريقة اخرى قد تكون بدائية جدا ولكنها تعمل معي 100%

وبالنسبة لي فانا اصنع ملف تشغيل "EXE" من الفيجول بيسك ليقوم بتشغبل برنامجي بالاكسس

وفي هذا الملف اقوم بوضع كود قبل تشغيل البرنامج يتأكد من وجود ملف الداتا او المعلومات في السيرفر قبل التشغيل فاذا كان الملف موجود "يعني الشبكة شغالة" يقوم بالتشغيل

واذا لم يشاهد ملف المعلومات "اذا الشبكة لاتعمل" يعطيك رسالة وطبعا الرسالة تقدر تكتب فيها بالشكل المناسب لك

شاهد الملف المرفق "طبعا اذا عندك برنامج فيجول بيسك بيفتح معاك الملف" وتقدر تعدل فيه على كيفك مثل موقع ملف المعلومات في السيرفر وبعدين تحوله الى EXE

PROG.zip

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

Private Sub Form_Load()

On Error GoTo Err_Prog01

Dim Prog1, Prog2, Prog3 As String

Prog1 = "\\NameServer\Data.mdb"

Prog2 = "\\NameServer\Data.mdw"

Prog3 = "C:\Basem\Prog.mde"

Prog01:

On Error GoTo Err_Prog02

Name Prog1 As Prog1

Name Prog2 As Prog2

Name Prog3 As Prog3

Call Shell("C:\Program Files\Microsoft Office\Office\Msaccess.exe /Nostartup /Excl /Wrkgrp \\NameServer\Data.mdw C:\Prog.mde", 1)

End

Prog02:

On Error GoTo Exit_Program

Beep

MsgBox "لايمكن تشغيل البرنامج يوجد لديك مشكلة", vbInformation, "باسم النعيم 0555922269"

End

Exit_Program:

End

End Sub

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