ATOUTFOX
COMMUNAUTÉ FRANCOPHONE DES PROFESSIONNELS FOXPRO
Visual FoxPro : le développement durable

Comment trouver le serveur SMTP, le port SMTP, l'authentification d'une adresse par defaut   


L'auteur

Mike Gagnon
Canada Canada
Membre Simple
# 0000000025
enregistré le 14/10/2004

Gagnon Mike
Pointe Cla H9R 3K8
de la société Carver Technologies Inc.
Fiche personnelle

Note des membres
pas de note

Contributions > 05 - API et appels systèmes

Comment trouver le serveur SMTP, le port SMTP, l'authentification d'une adresse par defaut
# 0000000830
ajouté le 11/07/2012 12:40:32 et modifié le 11/07/2012
consulté 8840 fois
Niveau initié

Version(s) Foxpro :
VFP 9.0
Description

Le code qui suit a été testé avec VFP9 et
Windows 7 32 bit ET 64 bit.

Il est possible que données de la base de registre soit à un endroit different.

Code source :
Private  goApp
Local loOutlook,ns
Private lcDefaultEmail,lcFolder,lcSMTPServer
Declare Integer RegCloseKey In advapi32 Integer hKey
Declare Integer RegOpenKeyEx In advapi32;
  INTEGER hKey, String lpSubKey, Integer ulOptions,;
  INTEGER samDesired, Integer @phkResult
Declare Integer RegEnumValue In advapi32;
  INTEGER hKey, Integer dwIndex, String @lpValueName,;
  INTEGER @lpcValueName, Integer lpReserved, Integer @lpType,;
  STRING @lpData, Integer @lpcbData
loOutlook  = Createobject('outlook.application') && Get the default e-mail address from Outlook
ns = loOutlook.GetNameSpace('MAPI')
lcDefaultEmail = ns.CurrentUser.Address
&& Now lets find out in which folder in the registry this e-mail address belongs to
goApp = Createobject('capp')
For i = 1 To 10  && Change this in case there are more than 10 e-mail addresses
  lcFolder = ''
  lcFolder=getfolder(i,lcDefaultEmail)
  If lcFolder <> -1
    Exit
  Endif
Endfor
lcFolder=Padl(lcFolder,8,'0')
lcSubKey = 'Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\Outlook\9375CFF0413111d3B88A00104B2A6676\'+lcFolder
lcSMTPServer=goApp.ReadReg('HCU',lcSubKey,'SMTP Server')
lcSMTPPort=goApp.ReadReg('HCU',lcSubKey,'SMTP Port')
lcSMTPSecureconnection=goApp.ReadReg('HCU',lcSubKey,'SMTP Secure Connection')
lcSMTPUseAuth=goApp.ReadReg('HCU',lcSubKey,'SMTP Use Auth')
? 'Adresse courriel par defaut: ' +lcDefaultEmail
? 'Serveur SMTP : '+lcSMTPServer
? 'Port SMTP: '+lcSMTPPort
? 'Connection SMTP: '+lcSMTPSecureconnection
? 'Authorization: '+lcSMTPUseAuth
**************************************************
*
Define Class capp As Container
  *-- Reads the windows Registry.
  Procedure ReadReg
    * Start of Code
    Lparameters tcKey,tcSubKey,tcValue
    If Pcount() = 2
      tcValue = ""
    Endif

    * setup environment

    Local nKey, cSubKey, cValue,  cValueRead

    #Define HKEY_USERS                  -2147483645
    #Define HKEY_LOCAL_MACHINE          -2147483646
    #Define HKEY_CURRENT_USER           -2147483647
    #Define HKEY_CLASSES_ROOT            -2147483648

    Do Case
      Case m.tcKey == "HCR"
        nKey = HKEY_CLASSES_ROOT
      Case m.tcKey == "HLM"
        nKey = HKEY_LOCAL_MACHINE
      Case m.tcKey = "HCU"
        nKey = HKEY_CURRENT_USER
      Case m.tcKey = "HCR"
        nKey = HKEY_CLASSES_ROOT
      Otherwise
        nKey = m.tcKey
    Endcase


    cSubKey = m.tcSubKey
    cValue  = m.tcValue

    * here is where we will actually read the registry
    if tcValue = 'SMTP Server'
      cValueRead = This.ReadREG_bin(nKey, cSubKey, cValue)
      endif
      if tcValue = 'SMTP Port'
       cValueRead = This.ReadREG_dword(nKey, cSubKey, cValue)
      endif
      if tcValue = 'SMTP Secure Connection'
         cValueRead = This.ReadREG_dword(nKey, cSubKey, cValue)
      endif
       if tcValue = 'SMTP Use Auth'
         cValueRead = This.ReadREG_dword(nKey, cSubKey, cValue)
      endif
    If (Empty(cValueRead)) Then
      cValueRead = "REGISTRY KEY NOT FOUND"
      * MESSAGEBOX("Function Not Successful.")  && testing only
    Else
      * MESSAGEBOX("Function Successful.    " + cValueRead)  && testing only
    Endif
    Return  cValueRead

  Endproc


  *-- API's used by the ReadReg method.
  Procedure ReadREG_bin
*    * This function reads a REG_BINARY value from the registry. If successful,
    * it will return the value read. If not successful, it will return an empty string.

    Parameters  nKey, cSubKey, cValue
    * nKey The root key to open. It can be any of the constants defined below.
    *  #DEFINE HKEY_CLASSES_ROOT           -2147483648
    *  #DEFINE HKEY_CURRENT_USER           -2147483647
    *  #DEFINE HKEY_LOCAL_MACHINE          -2147483646
    *  #DEFINE HKEY_USERS                  -2147483645
    * cSubKey The SubKey to open.
    * cValue The value that is going to be read.

    * Constants that are needed for Registry functions
    #Define REG_BINARY    3


    * WIN 32 API functions that are used
    Declare Integer RegOpenKey In Win32API ;
      Integer nHKey, String @cSubKey, Integer @nResult
    Declare Integer RegQueryValueEx In Win32API ;
      Integer nHKey, String lpszValueName, Integer dwReserved,;
      Integer @lpdwType, String @lpbData, Integer @lpcbData
    * Local variables used
    Local nErrCode      && Error Code returned from Registry functions
    Local nKeyHandle    && Handle to Key that is opened in the Registry
    Local lpdwValueType && Type of Value that we are looking for
    Local lpbValue      && The data stored in the value
    Local lpcbValueSize && Size of the variable
    Local lpdwReserved  && Reserved Must be 0

    * Initialize the variables
    nKeyHandle = 0
    lpdwReserved = 0
    lpdwValueType = REG_BINARY
    lpbValue = ""

    nErrCode = RegOpenKey(nKey, cSubKey, @nKeyHandle)
    * If the error code isn't 0, then the key doesn't exist or can't be opened.
    If (nErrCode # 0) Then
      Return ""
    Endif

    lpcbValueSize = 1
    * Get the size of the data in the value
    nErrCode=RegQueryValueEx(nKeyHandle, cValue, lpdwReserved, @lpdwValueType, @lpbValue, @lpcbValueSize)

    * Make the buffer big enough
    lpbValue = Space(lpcbValueSize)
    nErrCode=RegQueryValueEx(nKeyHandle, cValue, lpdwReserved, @lpdwValueType, @lpbValue, @lpcbValueSize)

    =RegCloseKey(nKeyHandle)
    If (nErrCode # 0) Then
      Return ""
    Endif

    lpbValue = Left(lpbValue, lpcbValueSize - 1)
    lpbValue =u2a( lpbValue )
    Return lpbValue
  Endproc
   Procedure ReadREG_dword
    * This function reads a REG_DWORD value from the registry. If successful,
    * it will return the value read. If not successful, it will return an empty string.

    Parameters  nKey, cSubKey, cValue
    * Constants that are needed for Registry functions
    #DEFINE REG_DWORD     4
    * WIN 32 API functions that are used
    Declare Integer RegOpenKey In Win32API ;
      Integer nHKey, String @cSubKey, Integer @nResult
    Declare Integer RegQueryValueEx In Win32API ;
      Integer nHKey, String lpszValueName, Integer dwReserved,;
      Integer @lpdwType, String @lpbData, Integer @lpcbData
    * Local variables used
    Local nErrCode      && Error Code returned from Registry functions
    Local nKeyHandle    && Handle to Key that is opened in the Registry
    Local lpdwValueType && Type of Value that we are looking for
    Local lpbValue      && The data stored in the value
    Local lpcbValueSize && Size of the variable
    Local lpdwReserved  && Reserved Must be 0

    * Initialize the variables
    nKeyHandle = 0
    lpdwReserved = 0
    lpdwValueType = REG_DWORD
    lpbValue = ""

    nErrCode = RegOpenKey(nKey, cSubKey, @nKeyHandle)
    * If the error code isn't 0, then the key doesn't exist or can't be opened.
    If (nErrCode # 0) Then
      Return ""
    Endif

    lpcbValueSize = 1
    * Get the size of the data in the value
    nErrCode=RegQueryValueEx(nKeyHandle, cValue, lpdwReserved, @lpdwValueType, @lpbValue, @lpcbValueSize)

    * Make the buffer big enough
    lpbValue = Space(lpcbValueSize)
    nErrCode=RegQueryValueEx(nKeyHandle, cValue, lpdwReserved, @lpdwValueType, @lpbValue, @lpcbValueSize)
    lpbValue= alltrim(str(buf2dword(PADR(lpbValue,4,Chr(0)))))

    =RegCloseKey(nKeyHandle)
    If (nErrCode # 0) Then
      Return ""
    Endif
       Return lpbValue
  Endproc


Enddefine
*====================================================
Function u2a(cText)
  #Define CP_ACP         0
  Declare Integer WideCharToMultiByte In kernel32;
    INTEGER CodePg, Integer dwFlags,;
    STRING lpWideCharStr, Integer cchWideChar,;
    STRING @lpMultiByteStr, Integer cbMultiByte,;
    STRING lpDefaultChar, Integer lpUsedDefaultChar


  * converting a Unicode string to an ANSI string
  Local lcBuffer, lnBufsize
  cText = Substr(cText, 1, At(Chr(0)+Chr(0),cText))

  * first calling to define required buffer size
  lcBuffer = ""
  lnBufsize = WideCharToMultiByte(CP_ACP, 0,;
    cText, Len(cText), @lcBuffer, 0, Chr(0), 0)

  lcBuffer = Repli(Chr(0), lnBufsize)
  = WideCharToMultiByte(CP_ACP, 0,;
    cText, Len(cText), @lcBuffer, lnBufsize, Chr(0), 0)
  Return Substr(lcBuffer, 1, At(Chr(0),lcBuffer)-1)
Endfunc
*===================================================
Procedure getfolder(tcfolder,tcEmailaddress)
  #Define ERROR_SUCCESS 0
  #Define KEY_READ 0x020019
  #Define KEY_ALL_ACCESS 0x0F003F
  #Define HKEY_CURRENT_USER 0x80000001
  hBaseKey = 0
  lcBaseKey = "Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\Outlook\9375CFF0413111d3B88A00104B2A6676\"
  lcBaseKey = lcBaseKey+Padl(tcfolder,8,'0')
  If RegOpenKeyEx(HKEY_CURRENT_USER, lcBaseKey,;
      0, KEY_ALL_ACCESS, @hBaseKey) <> ERROR_SUCCESS
    Return
  Endif
  dwIndex = 0
  Do While .T.
    lnValueLen = 250
    lcValueName = Repli(Chr(0), lnValueLen)
    lnType = 0
    lnDataLen = 250
    lcData = Repli(Chr(0), lnDataLen)

    lnResult = RegEnumValue(hBaseKey, dwIndex,;
      @lcValueName, @lnValueLen, 0,;
      @lnType, @lcData, @lnDataLen)

    * for this case on return the type of data (lnType)
    * is always equal to 1 (REG_SZ)
    * that means null-terminated string

    If lnResult <> ERROR_SUCCESS
      Exit
    Endif

    lcValueName = Left(lcValueName, lnValueLen)
    lcData = Left(lcData, lnDataLen-1)
     lcData=u2a(lcData)
       If lcValueName = 'Email' And  tcEmailaddress $ lcData
      = RegCloseKey(hBaseKey)
      Return tcfolder
    Endif
    dwIndex = dwIndex + 1
  Enddo
  = RegCloseKey(hBaseKey)
  return -1
endproc
*========================================================
FUNCTION buf2dword(lcBuffer)
RETURN Asc(SUBSTR(lcBuffer, 1,1)) + ;
    BitLShift(Asc(SUBSTR(lcBuffer, 2,1)),  8) +;
    BitLShift(Asc(SUBSTR(lcBuffer, 3,1)), 16) +;
    BitLShift(Asc(SUBSTR(lcBuffer, 4,1)), 24)
Commentaires
Aucun commentaire enregistré ...
www.atoutfox.org - Site de la Communauté Francophone des Professionnels FoxPro - v3.4.0 - © 2004-2024.
Cette page est générée par un composant COM+ développé en Visual FoxPro 9.0-SP2-HF3