الماسنجر

نظراً لعدم وجود شرح وافي حول مشروع الماسنجر

سأقوم بشرح هذا المشروع خطوة بخطوة

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

نقص أو زيادة لا داعي لها او خطأ في الكود نفسه .. فلنبدأ ..

بسم الله الرحمن الرحيم

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

سنقوم بعمل موديول Module1 وسنضع بداخله

هذا الكود كله وسوف نقوم بشرحه فيما بعد

Option Explicit

'For popup window messaging
Public strSendMessagePopup As String

'Var for editing privacy prefs
Public blnPrivacyEdit As Boolean

Private Const OFN_ALLOWMULTISELECT = &H200
Private Const OFN_CREATEPROMPT = &H2000
Private Const OFN_ENABLEHOOK = &H20
Private Const OFN_ENABLETEMPLATE = &H40
Private Const OFN_ENABLETEMPLATEHANDLE = &H80
Private Const OFN_EXPLORER = &H80000
Private Const OFN_EXTENSIONDIFFERENT = &H400
Private Const OFN_FILEMUSTEXIST = &H1000
Private Const OFN_HIDEREADONLY = &H4
Private Const OFN_LONGNAMES = &H200000
Private Const OFN_NOCHANGEDIR = &H8
Private Const OFN_NODEREFERENCELINKS = &H100000
Private Const OFN_NOLONGNAMES = &H40000
Private Const OFN_NONETWORKBUTTON = &H20000
Private Const OFN_NOREADONLYRETURN = &H8000
Private Const OFN_NOTESTFILECREATE = &H10000
Private Const OFN_NOVALIDATE = &H100
Private Const OFN_OVERWRITEPROMPT = &H2
Private Const OFN_PATHMUSTEXIST = &H800
Private Const OFN_READONLY = &H1
Private Const OFN_SHAREAWARE = &H4000
Private Const OFN_SHAREFALLTHROUGH = 2
Private Const OFN_SHARENOWARN = 1
Private Const OFN_SHAREWARN = 0
Private Const OFN_SHOWHELP = &H10

Private 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" (pOpenfilename As OPENFILENAME) 
As Long
' هنا قم بتعديل هذا الكود ليكون على  سطر موحد 
Private Declare Function GetSaveFileName Lib "comdlg32.dll" 
Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) 
As Long



Function SaveDialog(Form1 As Form, Filter As String, Title As String, InitDir As String) As String
    
    Dim OFN As OPENFILENAME
    Dim A As Long
    OFN.lStructSize = Len(OFN)
    OFN.hwndOwner = Form1.hWnd
    OFN.hInstance = App.hInstance
    If Right$(Filter, 1) <> "|" Then Filter = Filter + "|"


    For A = 1 To Len(Filter)
        If Mid$(Filter, A, 1) = "|" Then Mid$(Filter, A, 1) = Chr$(0)
    Next
    OFN.lpstrFilter = Filter
    OFN.lpstrFile = Space$(254)
    OFN.nMaxFile = 255
    OFN.lpstrFileTitle = Space$(254)
    OFN.nMaxFileTitle = 255
    OFN.lpstrInitialDir = InitDir
    OFN.lpstrTitle = Title
    OFN.flags = OFN_HIDEREADONLY Or OFN_OVERWRITEPROMPT Or OFN_CREATEPROMPT
    A = GetSaveFileName(OFN)


    If (A) Then
        SaveDialog = Trim$(OFN.lpstrFile)
    Else
        SaveDialog = ""
    End If
End Function

' هنا قم بتعديل هذا الكود ليكون على  سطر موحد 
Public Function ShowOpen
(Frm As Form, Optional StartDirectory As String =
 "", Optional FileFilter As String = "",
 Optional WindowTitle As String = "Select A File") 
As String
    
    Dim OFN As OPENFILENAME, lngResult As Long
    
    OFN.lStructSize = Len(OFN)
    OFN.hwndOwner = Frm.hWnd
    OFN.hInstance = App.hInstance
    OFN.lpstrFilter = FileFilter
    OFN.lpstrFile = Space(255)
    OFN.nMaxFile = 256
    OFN.lpstrFileTitle = Space(255)
    OFN.nMaxFileTitle = 256
    OFN.lpstrInitialDir = StartDirectory
    OFN.lpstrTitle = WindowTitle
    OFN.flags = OFN_HIDEREADONLY Or OFN_FILEMUSTEXIST
    lngResult = GetOpenFileName(OFN)
   
    If lngResult = 1 Then
        ShowOpen = Trim(OFN.lpstrFile)
    Else
        ShowOpen = ""
    End If
    
End Function

بعدها سنعمل صنف أو كلاس Class1 ونسمية :

clsConnect ونضع بداخله هذا الكود

وأيضاً سنقوم بشرحه فيما بعد ..

Option Explicit
'HnHn
'User reference for identifying collection,
'always the users logon(email address)
Private strCollectionName As String

'Sending Message To
Private strMsgTo As String

'Index of the control
Private intIndex As Integer

'SessionID
Private lngSessionID As Long

'NS Server Address
Private strAddress As String

'Cookie
Private strAuthenticationInfo As String

'Type of class
Public Enum CITYPE
    CMSG = 0
    CSB = 1
    CMSGOUT = 2
    CXFR = 3
End Enum

'Type of class
Private intType As CITYPE

'For File Transfers
Private strFilePath As String 'Path of file
Private strFileName As String 'File name
Private lngFileSize As Long 'file size
Private lngCookie As Long 'Invite cookie
Private lngACookie As Long 'Auth cookie

Public Property Get CName() As String

    CName = strCollectionName

End Property

Public Property Let CName(ByVal strName As String)

    strCollectionName = strName

End Property

Public Property Get CIndex() As Integer

    CIndex = intIndex

End Property

Public Property Let CIndex(ByVal intCIndex As Integer)

    intIndex = intCIndex

End Property

Public Property Get CSessionID() As Long

    CSessionID = lngSessionID

End Property

Public Property Let CSessionID(ByVal lngID As Long)
'HnHn

    lngSessionID = lngID

End Property

Public Property Get CAddress() As String

    CAddress = strAddress

End Property

Public Property Let CAddress(ByVal strAddr As String)

    strAddress = strAddr

End Property

Public Property Get CAuthenticate() As String

    CAuthenticate = strAuthenticationInfo

End Property

Public Property Let CAuthenticate(ByVal strAuthInfo As String)

    strAuthenticationInfo = strAuthInfo

End Property

Public Property Get CType() As CITYPE

    CType = intType

End Property

Public Property Let CType(ByVal intIType As CITYPE)

    intType = intIType

End Property

Public Property Get CMsgTo() As String

    CMsgTo = strMsgTo

End Property

Public Property Let CMsgTo(ByVal strTo As String)

    strMsgTo = strTo

End Property




Public Property Get CFilePath() As String

    CFilePath = strFilePath

End Property

Public Property Let CFilePath(ByVal FilePath As String)

    strFilePath = FilePath

End Property

Public Property Get CFileName() As String

    CFileName = strFileName

End Property

Public Property Let CFileName(ByVal FileName As String)

    strFileName = FileName

End Property

Public Property Get CFileSize() As Long

    CFileSize = lngFileSize

End Property

Public Property Let CFileSize(ByVal FileSize As Long)
'HnHn
    lngFileSize = FileSize

End Property

Public Property Get CInviteCookie() As Long

    CInviteCookie = lngCookie

End Property

Public Property Let CInviteCookie(ByVal Cookie As Long)

    lngCookie = Cookie
    
End Property

Public Property Get CAuthCookie() As Long

    CAuthCookie = lngACookie

End Property

Public Property Let CAuthCookie(ByVal Cookie As Long)

    lngACookie = Cookie

End Property

أولاً : نافذة تسجيل الدخول ..

وتتكون Form 1 مـــن

Text1وسيكون شكله هكذا txtLogon

Text2وسيكون شكله هكذا txtPassword

Lable1

Lable2

Command1 وسيكون شكله هكذا cmdSignon

Timer1 وسيكون شكله هكذا tmrMain

سنقوم بتسمية Lable1 بهذا الأسم

E-Mail Address:

وسنقوم بتسمية Lable2 بهذا الأسم

Password:

وسنقوم بتسمية Command1 بهذا الأسم

Sign On

الآن نأتي لبرمجة هذا الفورم

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

Private Sub LoadContacts()

    Dim strContacts As String, arrContacts() As String, arrSplit() As String
    Dim intLoop As Integer, rNode As Node, mNode As Node
    
    On Error Resume Next
    Set mNode = frmOnline.tvContacts.Nodes.Add(, , "Online", "Online")
    mNode.Expanded = True
    Set mNode = frmOnline.tvContacts.Nodes.Add(, , "Offline", "Offline")
    mNode.Expanded = True
    
    strContacts = frmOnline.XMSNC1.MSNRetrieveContacts
    
    If strContacts = "" Then
        Exit Sub
    End If
    
    arrContacts = Split(strContacts, ";")
    
    For intLoop = 0 To UBound(arrContacts)
    
        If arrContacts(intLoop) <> "" Then
            arrSplit() = Split(arrContacts(intLoop), ",")
            Set mNode = frmOnline.tvContacts.Nodes.Add("Offline", tvwChild, arrSplit(0), arrSplit(1))
        End If
        
    Next intLoop

End Sub

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

Private Sub Form_Load()

    txtPassword.PasswordChar = "*"
    lblInfo.Caption = "Waiting To Connect..."
    
End Sub

وفي حدث التايمر Timer1 سنكتب الكود التالي

Private Sub tmrMain_Timer()

    Dim strTemp As String
    
    strTemp = lblInfo.Caption
    strTemp = Replace(strTemp, "Connecting... ", "")
    lblInfo.Caption = "Connecting... " & Val(strTemp) - 1

End Sub

وسيكون الكود تحت زر التسجيل cmdSignon كما يلي ..

Private Sub cmdSignon_Click()
    
    Me.MousePointer = 1

    If txtLogon = "" Then
        MsgBox "Invalid Email Address"
        Exit Sub
    ElseIf txtPassword.Text = "" Then
        MsgBox "Invalid Password"
        Exit Sub
    End If

    frmOnline.XMSNC1.MSNLogonName = txtLogon
    frmOnline.XMSNC1.MSNPassword = txtPassword
    frmOnline.XMSNC1.MSNReverseListSetting = MANUAL
    LoadContacts
    frmOnline.XMSNC1.MSNConnect
    
    frmSignOn.Caption = "Signing On"
    frmSignOn.MousePointer = 11
    
    lblInfo.Caption = "Connecting... 35"
    tmrMain.Enabled = True

End Sub

وبهذا نكون قد عملنا نافذة تسجيل الدخول وسوف نكمل بعد ثلاثة أيام