الأقتراح الأول ::
حفظ بيانات الأعضاء المتصلين حاليا ....
طريقة بسيطة و عملية لحفظ بيانات الأعضاء المتصلين حاليا
، و أستخدام هذا البيانات لعرض أسماء الأعضاء المتصلين حاليا
في الصفحة الرئيسية في المنتدى ، و في صفحة المواضيع ......
الطريقة::
يتم حفظ أسماء الأعضاء و أرقامهم و تاريخ الأتصال في مصفوفة ثنائية
الأتجاه و تحفظ هذه المصفوفة في متغير عام Application
شكل المصفوفة:
الرقم الأسم التاريخ
1 أبو تركي 1/1/2002
2 محمد 1/1/2002
... .... .....
م .... .....
كود الأقتراح الأول :::
حفظ بيانات الأعضاء المتصلين حاليا ....
Const RefreshRate=5
Const ConsiderOffLineAffter=5
Sub OnLine_AddUser(Name,ID)
Dim OnLineUsers
Dim Loc
OnLineUsers=Application("OnLineUsers")
if Not IsArray(OnLineUsers) Then
Redim OnLineUsers(2,0)
Loc=0
Else
Loc=UBound(OnLineUsers,2)+1
Redim Preserve OnLineUsers(2,Loc)
end if
OnLineUsers(0,Loc)=ID
OnLineUsers(1,Loc)=Name
OnLineUsers(2,Loc)=Now
Application.Lock
Application("OnLineUsers")=OnLineUsers
Application.unLock
End Sub
Function OnLine_GetOnlineList()
Dim OnLineUsers
Dim n,HTML
OnLineUsers=Application("OnLineUsers")
HTML=""
if isArray(OnLineUsers) Then
for n=0 to UBound(OnLineUsers,2)
HTML=HTML & _
"" & _
OnLineUsers(1,n) & ""
if n<> UBound(OnLineUsers,2) then HTML=HTML & ","
next
end if
OnLine_GetOnlineList=HTML
End Function
Sub OnLine_RefreshOnlineList()
Dim OnLineUsers
Dim OnLineUsers_Refresh
Dim n,LastRefreshTime
Dim HowManyOffLineUser
OnLineUsers=Application("OnLineUsers")
LastRefreshTime=Application("LastRefreshTime")
if Not isDate(LastRefreshTime) Then LastRefreshTime=Now
HowManyOffLineUser=0
if Not isArray(OnLineUsers) OR _
DateDiff("n",LastRefreshTime,Now)Application.Lock
Application("LastRefreshTime")=LastRefreshTime
Application.unLock
Exit Sub
end if
for n=0 to UBound(OnLineUsers,2)
If DateDiff("n",OnLineUsers(2,n),Now)>ConsiderOffLineAffter Then
OnLineUsers(0,n)=-1
HowManyOffLineUser=HowManyOffLineUser+1
End if
next
if HowManyOffLineUser=0 Then Exit Sub
Dim HowManyOnline
HowManyOnline=UBound(OnLineUsers,2)-HowManyOffLineUser
Redim OnLineUsers_Refresh(2,HowManyOnline)
for n=0 to UBound(OnLineUsers_Refresh,2)
If OnLineUsers(0,n)<>-1 Then
OnLineUsers_Refresh(0,n)=OnLineUsers(0,n)
OnLineUsers_Refresh(1,n)=OnLineUsers(1,n)
OnLineUsers_Refresh(2,n)=Now
End if
next
Application.Lock
Application("OnLineUsers")=OnLineUsers_Refresh
Application("LastRefreshTime")=LastRefreshTime
Application.unLock
End Sub
Function OnLine_IsOnline(ID)
Dim OnLineUsers
Dim n
OnLineUsers=Application("OnLineUsers")
if isArray(OnLineUsers) Then
for n=0 to UBound(OnLineUsers,2)
if OnLineUsers(0,n)=ID Then
OnLine_IsOnline=True
Exit Function
End if
next
end if
OnLine_IsOnline=False
End Functionلتشغيل الكود:
أحفظ هذا الكود في ملف ليكن أسمه
OnlineFriends.asp
و أضفة في المف العام للمنتدى
و أضف هذا الكود في الملف العام
Call OnLine_RefreshOnlineList()
لأضافة المستخدمين
أضف هذا الكود في دالة الدخول إلى المنتدى
Call OnLine_AddUser(Name,ID)
في الكود أعلاه:
Name = أسم المشترك
ID = رقمه
