# ftsItem_content

c0Title: You Cannot Programmatically Add an E-mail Address to a Distribution List
c1Code:
OL2000: (IMO) You Cannot Programmatically Add an E-mail Address to a Distribution List (Q269861)

--------------------------------------------------------------------------------
The information in this article applies to:


Microsoft Outlook 2000 


--------------------------------------------------------------------------------
NOTE : These procedures only apply if you have installed Outlook with the Internet Mail Only option. To determine your installation type, on the Help menu, click About Microsoft Outlook . In About Microsoft Outlook , you should see "Internet Mail Only" if you have the Internet Mail Only option installed. 

For information about differences between Microsoft Outlook and Microsoft Outlook Express e-mail clients, click the article number below to view the article in the Microsoft Knowledge Base: 
Q257824 OL2000: Differences Between Outlook and Outlook Express 


SYMPTOMS
The AddMembers method of a Distribution List item does not work unless the e-mail address can be resolved to a Contact item. 



WORKAROUND
To work around this behavior, create a Contact for each e-mail address before you add it to the Distribution List item. The following Outlook Visual Basic for Applications (VBA) code example demonstrates how you can programmatically create a Contact item and add it to a new Distribution List item: 

Sub CreateDistributionList()

Dim myOlApp As Application
Dim myNameSpace As NameSpace
Dim myContact As ContactItem
Dim myDistList As DistListItem
Dim myMailItem As MailItem
Dim myRecipients As Recipients

   Set myOlApp = CreateObject("Outlook.Application")
   Set myNameSpace = myOlApp.GetNamespace("MAPI")

   'Create the new Contact
   Set myContact = myOlApp.CreateItem(olContactItem)
   myContact.FullName = "User Name"
   myContact.Email1Address = "username@domain.com"
   myContact.Save
   myContact.Display

   'Create the Distribution List item
   Set myDistList = myOlApp.CreateItem(olDistributionListItem)
   myDistList.DLName = "Test Distribution List"

   'The MailItem is required to
   'create the Recipients collection
   Set myMailItem = myOlApp.CreateItem(olMailItem)
   Set myRecipients = myMailItem.Recipients

   'A Contact with the following e-mail address
   'must exist for the AddMembers method to work
   myRecipients.Add "username@domain.com"
   myRecipients.ResolveAll
   myDistList.AddMembers myRecipients
   myDistList.Save
   myDistList.Display

End Sub



STATUS
Microsoft has confirmed this to be a problem in the Microsoft products that are listed at the beginning of this article. 



MORE INFORMATION
Microsoft provides programming examples for illustration only, without warranty either expressed or implied, including, but not limited to, the implied warranties of merchantability and/or fitness for a particular purpose. This article assumes that you are familiar with the programming language being demonstrated and the tools used to create and debug procedures. Microsoft support professionals can help explain the functionality of a particular procedure, but they will not modify these examples to provide added functionality or construct procedures to meet your specific needs. If you have limited programming experience, you may want to contact a Microsoft Certified Partner or the Microsoft fee-based consulting line at (800) 936-5200. For more information about Microsoft Certified Partners, please see the following page on the World Wide Web: 

http://www.microsoft.com/partner/referral/ 
For more information about the support options available from Microsoft, please see the following page on the World Wide Web: 
http://support.microsoft.com/directory/overview.asp 



Steps to Reproduce the Behavior 

The following code example demonstrates how to reproduce this behavior. This code creates a new Distribution List item without recipients and does not return any errors: 

Sub ReproduceDistributionListIssue()

Dim myOlApp As Application
Dim myNameSpace As NameSpace
Dim myDistList As DistListItem
Dim myMailItem As MailItem
Dim myRecipients As Recipients

   Set myOlApp = CreateObject("Outlook.Application")
   Set myNameSpace = myOlApp.GetNamespace("MAPI")

   'Create the Distribution List item
   Set myDistList = myOlApp.CreateItem(olDistributionListItem)
   myDistList.DLName = "Test Distribution List (IMO)"

   'The MailItem is required to create the Recipients collection
   Set myMailItem = myOlApp.CreateItem(olMailItem)
   Set myRecipients = myMailItem.Recipients

   'The next line works only if name matches an entry in the Contacts    folder
   myRecipients.Add "username@domain.com"
   myRecipients.ResolveAll
   myDistList.AddMembers myRecipients
   myDistList.Save
   myDistList.Display

End Sub



REFERENCES
For additional information about available resources and answers to commonly asked questions about Microsoft Outlook solutions, click the article number below to view the article in the Microsoft Knowledge Base: 

Q146636 OL2000: Questions About Custom Forms and Outlook Solutions 


c0Title:
CDO: Specify ProfileInfo when calling the Session.Logon method instead of specifying a stored profile. 

c1Code:
For example: objSession.Logon ProfileInfo:= <server name> & vbLf & <mailbox name> 
 

Creating Messages and Calendar Items Using CDO
There are three methods of sending a message using CDO: the SMTP Port, SMTP Pickup Directory, and the Exchange Server. The configuration fields of a message allow the user to specify this parameter in the SendUsingMethod. If an application is a bulk mailer or uses SMTP addresses, we highly recommend sending messages using a Port or Pickup Directory. The SendUsingExchange parameter will incur overhead on the Exchange Server because the message is saved in the Outbox, where the MTA picks it up.
 
8.10 When I read an attachment with the VB MAPI controls, I can only 
      get the 8.3 version of the filename?
 
  This is a limitation on those controls; you will have to use CDO to 
  avoid it. To read the attachment in the first place, you need to use
  the AttachmentPathName property of the message; the attachment is stored
  in a temporary directory when you open the message.
 
 
 
While it is not documented it is possible to create Outlook contacts with CDO 1.x. Actually creating the contact itself isn't that hard but populating the appropriate fields can become a nightmare. The following code creates a contact with a business address and also sets categories: 
' MAPI property tags used
Public Const CdoPR_DISPLAY_NAME = &H3001001F
Public Const CdoPR_COMPANY_NAME = &H3A16001F
Public Const CdoPR_SURNAME = &H3A11001E
Public Const CdoPR_MIDDLE_NAME = &H3A44001F
Public Const CdoPR_GIVEN_NAME = &H3A06001F
Public Const CdoPR_GENERATION = &H3A05001E
Public Const CdoPR_INITIALS = &H3A0A001E
Public Const CdoPR_DISPLAY_NAME_PREFIX = &H3A45001E
Public Const CdoPR_STREET_ADDRESS = &H3A29001E
Public Const CdoPR_LOCALITY = &H3A27001E
Public Const CdoPR_STATE_OR_PROVINCE = &H3A28001E
Public Const CdoPR_POSTAL_CODE = &H3A2A001E
Public Const CdoPR_BUSINESS_ADDRESS_COUNTRY = &H3A26001E
Public Const CdoPR_POSTAL_ADDRESS = &H3A15001E 
 
Public Const CdoPropSetID3 = "0420060000000000C000000000000046"
Public Const CdoPropSetID5 = "2903020000000000C000000000000046" 
 
Public Const CdoContact_FileUnder = "0x8005"
Public Const CdoContact_FileUnderID = "0x8006"
Public Const CdoContact_EmailOriginalDisplayName = "0x8084"
Public Const CdoContact_EmailEmailAddress = "0x8083"
Public Const CdoContact_EmailAddrType = "0x8082"
Public Const CdoContact_EmailOriginalEntryID = "0x8085"
Public Const CdoContact_SelectedAddress = "0x8022"
Public Const CdoContact_BusinessAddress = "0x801B"
Public Const CdoContact_BusinessAddressCity = "0x8046"
Public Const CdoContact_BusinessAddressStreet = "0x8045"
Public Const CdoContact_BusinessAddressState = "0x8047"
Public Const CdoContact_BusinessAddressCountry = "0x8049"
Public Const CdoContact_BusinessAddressPostalCode = "0x8048"
Public Const CdoContact_BusinessAddressPostOfficeBox = "0x804A"
Public Const CdoContact_Categories = "Keywords"
 
' Contact data
strBusinessAddressStreet = "SomeStreet"
strBusinessAddressCountry = "Germany"  ' Must be a valid country name
strBusinessAddressCity = "SomeCity"
strBusinessAddressPostalCode = "SomeZIP"
strBusinessAddressState = "SomeState"
strBusinessAddress = strBusinessAddressStreet & Chr(13) & strBusinessAddressPostalCode & " " & strBusinessAddressCity & ", " & strBusinessAddressState & Chr(13) & strBusinessAddressCountry
strFirstName = "John"
strLastName = "Doe"
strInitial = "B."
strCompanyName = "SomeCompany"
strPrefix = "Mr."
strSuffix = "Sr."
strEmailAddress = "john@doe.com"
strEmailAddressType = "SMTP"
strCategories(0) = "Business"
strCategories(1) = "Competition"
strCategories(2) = "Favorites"
strCategories(3) = "Gifts"
 
' Get the default contact folder
Set objFolder = objSession.GetDefaultFolder(CdoDefaultFolderContacts ) 
 
' Create a new message
Set objMessage = objFolder.Messages.Add
 
' Set message class and subject
objMessage.Type = "IPM.Contact"
objMessage.Subject = strFirstName & " " & strLastName
 
' Create conversation index
objMessage.ConversationIndex = objSession.CreateConversationIndex
 
' Get fields collection
Set objFields = objMessage.Fields
 
' Add fields to message
With objFields
 
  ' Create/write standard fields (e. g. the display name)
  .Add CdoPR_DISPLAY_NAME, objMessage.Subject
  .Add CdoPR_DISPLAY_NAME_PREFIX, strPrefix
  .Add CdoPR_COMPANY_NAME, strCompanyName
  .Add CdoPR_SURNAME, strLastName
  .Add CdoPR_MIDDLE_NAME, strInitial
  .Add CdoPR_GIVEN_NAME, strFirstName
  .Add CdoPR_INITIALS, Left(strFirstName, 1) & " " & strInitial & " " _
    & Left(strLastName, 1)
  .Add CdoPR_GENERATION, strSuffix
 
  ' Write Outlook "FileAs"
  .Add CdoContact_FileUnder, vbString, _
    objMessage.Subject, CdoPropSetID3
  .Add CdoContact_FileUnderID, vbLong, _
    &HFFFFFFFF, CdoPropSetID3
 
  ' Write Outlook "Business Address" fields
  .Add CdoContact_BusinessAddressStreet, vbString, _
    strBusinessAddressStreet, CdoPropSetID3
  .Add CdoContact_BusinessAddressCity, vbString, _
    strBusinessAddressCity, CdoPropSetID3
  .Add CdoContact_BusinessAddressState, vbString,_
     strBusinessAddressState, CdoPropSetID3
  .Add CdoContact_BusinessAddressPostalCode, vbString,_
     strBusinessAddressPostalCode, CdoPropSetID3
  .Add CdoContact_BusinessAddressCountry, vbString,_
     strBusinessAddressCountry, CdoPropSetID3
  .Add CdoContact_BusinessAddress, vbString,_
     strBusinessAddress, CdoPropSetID3
 
  ' Write Outlook "Mailing Address" fields with the same values as the selected address
  .Add CdoPR_STREET_ADDRESS, strBusinessAddressStreet
  .Add CdoPR_LOCALITY, strBusinessAddressCity
  .Add CdoPR_STATE_OR_PROVINCE, strBusinessAddressState
  .Add CdoPR_POSTAL_CODE, strBusinessAddressPostalCode
  .Add CdoPR_BUSINESS_ADDRESS_COUNTRY, strBusinessAddressCountry
  .Add CdoPR_POSTAL_ADDRESS, strBusinessAddress
 
  ' Write Outlook "Selected Address" field
  .Add CdoContact_SelectedAddress, vbLong, 2, CdoPropSetID3
 
  ' Write first Outlook "E-mail address"
  .Add CdoContact_EmailOriginalDisplayName, vbString, strEmailAddress, CdoPropSetID3
  .Add CdoContact_EmailEmailAddress, vbString, strEmailAddress, CdoPropSetID3
  .Add CdoContact_EmailAddrType, vbString, strEmailAddressType, CdoPropSetID3
 
  ' Add categories
  .Add CdoContact_Categories, vbString Or vbArray, strCategories, CdoPropSetID5
 
  ' Add a custom field
  .Add "Position", vbString, "CEO", CdoPropSetID5
End With
 
' Save message
objMessage.Update True, True


c0Title: CDO Distribution List Functions
c1Code:
Q178787
 
   '*******************************************************************
   ' Distribution List Functions
   '-------------------------------------------------------------------
   '
   ' Functions and Procedures in this Module
   '*******************************************************************
   ' 1. AddressBookExists: Determines if a specific AddressList Exists
   '                       - for example, PAB, GAL, and etc.
   ' 2. AddDLToPAB:        Creates a new Distribution List (DL).
   ' 3. AddUserToDL:       Used to add a new recipient to a DL.
   ' 4. AddUserToPAB:      Add a new user to the MAPI address list.
   ' 5. DeleteUserFromDL:  Removes a recipient from a DL. Also contains
   '                       logic to check if a specific recipient is on
   '                       a DL.
   ' 6. GetDLOwner:        Get the Owner of a Distribution List.
   '
   '*******************************************************************
   'REMEMBER: You still need the pertinent rights to be able to
   'manipulate MAPI AddressList objects.
   '
   '*******************************************************************
   Public objSession As MAPI.Session
   '*******************************************************************
   ' A conglomerate function that demonstrates use of several of the
   ' other functions in this module. Look through these functions for
   ' the string "TO DO:". The functions will work as is, but will not
   ' yield meaningful content until they are customized as noted on
   ' these lines.
   '*******************************************************************
   Public Sub Main()
     Dim oAddressList As AddressList
     Dim oAddressEntry As AddressEntry
     Dim oNewUserAddressEntry As AddressEntry
     If MapiLogon() = True Then
        Set oAddressList = AddressBookExists("Personal Address Book")
        If Not oAddressList Is Nothing Then
          'TO DO: You will want to customize the string values
          'in the next two lines.
           Set oNewUserAddressEntry = _
             AddUserToPAB(oAddressList, "Custom New User")
           Set oAddressEntry = AddDLToPAB(oAddressList, "My Custom DL")
 
           If Not oAddressEntry Is Nothing Then
             'TO DO: Recipient to be added on next line should be
             'customized.
             If AddUserToDL(oAddressEntry, "MyNewDLMember") = True Then
                MsgBox "Added new user and DL, and new member in the DL"
             Else
                MsgBox "Adding a user to the DL didn't work"
             End If
           Else
               MsgBox "Custom DL wasn't added to the Personal Address Book"
           End If
           Exit Sub
          Else
            MsgBox "There is no PAB Service installed on this machine"
            Exit Sub
        End If
       End If
     End Sub
 
   '*******************************************************************
   ' FUNCTION     - AddressBookExists
   '-------------------------------------------------------------------
   ' PARAMETERS   - sAddressBookName as string and can be one of two
   '                values:
   '               "Personal Address Book" or "Global AddressList".
   ' DESCRIPTION  - Determines if the Personal Address Book Service is
   '                installed on the current computer.
   ' RETURN VALUE - An AddressList object pointing to the addresslist or
   '                nothing if it does not exist.
   '*******************************************************************
   Public Function AddressBookExists(sAddressBookName As String) _
   As AddressList
      Dim oAddressList As AddressList
      For Each oAddressList In objSession.AddressLists
      If oAddressList.Name = sAddressBookName Then
      Set AddressBookExists = oAddressList
      Exit Function
      End If
      Next oAddressList
      Set AddressBookExists = Nothing
      End Function
 
   '*******************************************************************
   ' FUNCTION     - AddDLToPAB
   '-------------------------------------------------------------------
   ' PARAMETERS   - oAddressList as AddressList, sDLName As String (The
   '                name of the new Distribution List to create.)
   ' DESCRIPTION  - Add a new Distribution List to the MAPI address list
   '                specified in first parameter.
   ' RETURN VALUE - An AddressEntry object pointing to the address entry
   '                or nothing if it does not exist.
   '*******************************************************************
   Public Function AddDLToPAB(oAddressList As AddressList, _
   sDLName As String) As AddressEntry
      Dim oAddressEntries As AddressEntries
      Dim oNewAddressEntry As AddressEntry
      On Error GoTo Trp_AddDLToPAB:
      Set oAddressEntries = oAddressList.AddressEntries
      Set oNewAddressEntry = oAddressEntries.Add("MAPIPDL", sDLName)
      oNewAddressEntry.Update
      Set AddDLToPAB = oNewAddressEntry
      Exit Function
   Trp_AddDLToPAB:
      Set Trp_AddDLToPAB = Nothing
      Exit Function
   End Function
 
   '*******************************************************************
   ' FUNCTION     - AddUserToDL
   '-------------------------------------------------------------------
   ' PARAMETERS   - oDL As AddressEntry (This is the object reference to
   '                the Distribution List the user is being added to.),
   '                sUsername As String (The name of the new member to
   '                be added to the Distribution List.)
   ' DESCRIPTION  - Adds a new recipient to a Distribution List.
   ' RETURN VALUE - A Boolean value specifying whether or not adding the
   '                user was successful.
   '*******************************************************************
   Public Function AddUserToDL(oDL As AddressEntry, sUserName As String) _
   As Boolean
   Dim oNewMember As AddressEntry
   On Error GoTo Trp_AddUserToDL:
   'TO DO: Customize for your new DL member.
   Set oNewMember = oDL.Members.Add("SMTP", "MyAddressName")
 
   'You need to fill in all your own data here. The data below is
    'for sample purposes. This is not an inclusive list of potential
    'fields, and of the fields represented here, not all must be
    'populated for a viable address entry.
    With oNewMember
      'TO DO: Obviously all of these should be modified.
      .Address = "MySMTPAddress@company.com"
      'Generic Comments Field.
      .Fields(ActMsgPR_COMMENT) = "My notes here."
      'Business Generic Fields.
      .Fields(ActMsgPR_COMPANY_NAME) = "Microsoft Corporation"
      .Fields(ActMsgPR_DEPARTMENT_NAME) = "Microsoft Technical Support"
      .Fields(ActMsgPR_MANAGER_NAME) = "John Doe"
      .Fields(ActMsgPR_ASSISTANT) = "Jane Doe"
      .Fields(ActMsgPR_GIVEN_NAME) = "Bill"
      .Fields(ActMsgPR_MIDDLE_NAME) = "A."
      .Fields(ActMsgPR_SURNAME) = "Smith"
      .Fields(ActMsgPR_TITLE) = "Mr."
      .Fields(ActMsgPR_EMAIL_ADDRESS) = "mymail@Microsoft.com"
      'Business Address Fields.
      .Fields(ActMsgPR_OFFICE_LOCATION) = "Building 13"
      .Fields(ActMsgPR_BUSINESS_ADDRESS_STREET) = "1 Microsoft Way"
      .Fields(ActMsgPR_BUSINESS_ADDRESS_CITY) = "Redmond"
      .Fields(ActMsgPR_BUSINESS_ADDRESS_STATE_OR_PROVINCE) = "WA"
      .Fields(ActMsgPR_BUSINESS_ADDRESS_POSTAL_CODE) = "98052"
      .Fields(ActMsgPR_BUSINESS_ADDRESS_COUNTRY) = "USA"
      'Telephone Number Fields.
      .Fields(ActMsgPR_BUSINESS_FAX_NUMBER) = "425-555-0329"
      .Fields(ActMsgPR_BUSINESS_TELEPHONE_NUMBER) = "425-555-8080"
      .Fields(ActMsgPR_BUSINESS2_TELEPHONE_NUMBER) = "425-555-8081"
      .Fields(ActMsgPR_CALLBACK_TELEPHONE_NUMBER) = "425-555-8082"
      .Fields(ActMsgPR_CAR_TELEPHONE_NUMBER) = "206-555-0000"
      .Fields(ActMsgPR_ASSISTANT_TELEPHONE_NUMBER) = "425-555-8083"
      .Fields(ActMsgPR_COMPANY_MAIN_PHONE_NUMBER) = "425-882-8080"
      .Fields(ActMsgPR_MOBILE_TELEPHONE_NUMBER) = "425-555-8084"
      .Fields(ActMsgPR_PAGER_TELEPHONE_NUMBER) = "N/A"
      .Fields(ActMsgPR_PRIMARY_FAX_NUMBER) = "425-555-8085"
      'Home detail fields.
      .Fields(ActMsgPR_HOME_ADDRESS_STREET) = "1234 My Street"
      .Fields(ActMsgPR_HOME_ADDRESS_CITY) = "MyTown"
      .Fields(ActMsgPR_HOME_ADDRESS_STATE_OR_PROVINCE) = "WA"
      .Fields(ActMsgPR_HOME_ADDRESS_COUNTRY) = "USA"
      .Fields(ActMsgPR_HOME_FAX_NUMBER) = "425-555-0001"
      .Fields(ActMsgPR_HOME_TELEPHONE_NUMBER) = "425-555-0002"
      .Fields(ActMsgPR_HOME2_TELEPHONE_NUMBER) = "N/A"
 
      .Update
     End With
 
     AddUserToDL = True
     Exit Function
   Trp_AddUserToDL:
     AddUserToDL = False
     Exit Function
   End Function
 
   '*********************************************************************
   ' FUNCTION     - AddUserToPAB
   '---------------------------------------------------------------------
   ' PARAMETERS   - oAddressList as AddressList, sDLName As String (The
   '                name of the new Distribution List to create.)
   ' DESCRIPTION  - Add a new user to the MAPI address list specified in
   '                first parameter.
   ' RETURN VALUE - A As AddressEntry object pointing to the address entry
   '                or nothing if it does not exist.
   '*********************************************************************
   Public Function AddUserToPAB(oAddressList As AddressList, sUserName _
    As String) As AddressEntry
    Dim oAddressEntries As AddressEntries
    Dim oNewAddressEntry As AddressEntry
    On Error GoTo Trp_AddDLToPAB:
    Set oAddressEntries = oAddressList.AddressEntries
    Set oNewAddressEntry = oAddressEntries.Add("SMTP", sUserName)
    'TO DO: Change address in next line.
    oNewAddressEntry.Address = "Me@me.com"
    oNewAddressEntry.Update
    Set AddUserToPAB = oNewAddressEntry
    Exit Function
    Trp_AddDLToPAB:
    Set Trp_AddDLToPAB = Nothing
    Exit Function
    End Function
 
   '*********************************************************************
   ' PROCEDURE    - DeleteUserFromDL
   '---------------------------------------------------------------------
   ' PARAMETERS   - None
   ' DESCRIPTION  - Remove a member from a Distribution List, which the
   '                user selects from the Phonebook.
   '*********************************************************************
   Public Sub DeleteUserFromDL()
      'Procedure Level Variables.
       Dim oAddressEntries As AddressEntries
       Dim oAddressList As AddressList
       Dim oRecipients As Recipients
       Dim oRecipient As Recipient
       Dim oAddressEntry As AddressEntry
       Dim oMember As AddressEntry
       'Get the DL from the AddressBook.
       Set oRecipients = objSession.AddressBook(Title:="Select Attendees")
       If oRecipients.Count = 0 Or oRecipients.Count > 1 Then
          MsgBox "Please Select just one member of the Distribution List"
          Exit Sub
       End If
       Set oRecipient = oRecipients.Item(1)
       Set oAddressEntry = oRecipient.AddressEntry
       Set oAddressEntries = oAddressEntry.Members
       'Cycle through the DL until you find the user you seek.
       For Each oMember In oAddressEntry.Members
          If oMember.IsSameAs(oRecipient) Then
             'Or you could say If oMember.Name = "TheRecipsDisplayName"
             oMember.Delete
             Set oMember = Nothing
          End If
       Next oMember
    End Sub
 
   '*********************************************************************
   ' FUNCTION     - GetDLOwner
   '---------------------------------------------------------------------
   ' PARAMETERS   - oSubordinate As AddressEntry (The object reference to
   '                the Owner of the DL.)
   ' DESCRIPTION  - Gets an address entry's Owner. This is relevant only
   '                to the Global Address List since you are always the
   '                owner of Personal Address Book (PAB) entries.
   ' RETURN VALUE - A String value of the owners name.
   '*********************************************************************
 
    Public Function GetDLOwner(oSubordinate As AddressEntry) As String
     ' IMPORTANT: This code assumes that the Owner of the
     ' Distribution list is stored in PR_EMS_AB_EXTENSION_ATTRIBUTE_3.
     ' This is not always where the Owner is stored, if it is stored
     ' at all. You should verify where the Owner is stored on your
     ' system and change the Field value that is being retrieved by
     ' this code.
      GetDLOwner = oSubordinate.Fields(&H802F001E).Value
    End Function
 
   '*********************************************************************
   ' FUNCTION     - MapiLogon
   '---------------------------------------------------------------------
   ' PARAMETERS   - None.
   ' DESCRIPTION  - Creates and Logs onto a MAPI Session according to the
   '                parameters passed when calling the Logon method. The
   '                sample below passes no parameters and uses all default
   '                values.
   ' RETURN VALUE - Boolean indicating success.
   '*********************************************************************
   Public Function MapiLogon() As Boolean
     'Create a session and log on -- username and password in profile
      Set objSession = CreateObject("MAPI.Session")
      'Change the parameters to valid values for your configuration.
       objSession.Logon
       MapiLogon = True
    End Function 
 


c0Title:
Displays error messages for common file errors and returns the user's response (as appropriate to the error)

c1Code:
Attribute VB_Name = "ErrorHandler"
Option Explicit

Public Const gErrBadFileNameOrNumber = 52
Public Const gErrFileNotFound = 53
Public Const gErrBadFileMode = 54
Public Const gErrFileAlreadyOpen = 55
Public Const gErrDeviceIO = 57
Public Const gErrFileExists = 58
Public Const gErrDiskFull = 61
Public Const gErrInputPastEOF = 62
Public Const gErrBadFileName = 64
Public Const gErrTooManyFilesOpen = 67
Public Const gErrDeviceUnavailable = 68
Public Const gErrPermissionDenied = 70
Public Const gErrDiskNotReady = 71
Public Const gErrPathOrFileAccess = 75
Public Const gErrPathDoesNotExist = 76
Public Const gErrInvalidFileFormat = 321
Public Const gErrADOReadOnly = -2147467259
Public Const gErrADOConnectionClosed = 3709


Public Enum ErrorResultEnum
    ResumeCode = 0
    ResumeNext
    UnrecoverableError
    UnrecognizedError
End Enum

#If False Then          'Dummy variables to force auto-capitalization of Enum members
    Public ResumeCode
    Public ResumeNext
    Public UnrecoverableError
    Public UnrecognizedError
#End If


'Displays error messages for common file errors and returns the user's response (as appropriate to the error):
'Resume, Resume Next, Unrecoverable Error, Unrecognized Error
'
'Should be called from an error handler
'
Function ErrorPrompt(Optional ByRef Response As Long) As ErrorResultEnum
    Dim lngMsgType As Long
    Dim strMsg As String

    Select Case Err.Number
        
        Case gErrBadFileMode
            
            strMsg = "Can't open the file for that type of access."
            lngMsgType = vbExclamation + vbRetryCancel
        
        Case gErrBadFileName
            
            strMsg = "Invalid filename." & vbCrLf _
                    & "A filename cannot contain any of the following characters: / \ : * ? "" > < |"
            lngMsgType = vbExclamation + vbOKOnly
        
        Case gErrDeviceUnavailable
            
            strMsg = "That device appears unavailable."
            lngMsgType = vbExclamation + vbRetryCancel
        
        Case gErrDeviceIO
            
            strMsg = "Drive I/O Failure. It's probably toast."
            lngMsgType = vbExclamation + vbOKOnly
            
        Case gErrFileExists
            
            strMsg = "File already exists." & vbCrLf _
                    & "Would you like to overwrite " & Err.Description & "?"
            lngMsgType = vbExclamation + vbYesNoCancel
            
        
        Case gErrDiskFull
            
            strMsg = "Drive is full." & vbCrLf _
                    & "Delete files, empty the recycle bin, etc. to free up more space."
            lngMsgType = vbExclamation + vbRetryCancel
        
        Case gErrDiskNotReady
            
            strMsg = "Insert a disk in the drive and close the door."
            lngMsgType = vbExclamation + vbRetryCancel
        
        Case gErrFileAlreadyOpen
            
            strMsg = "This file is already open."
            lngMsgType = vbExclamation + vbRetryCancel
        
        Case gErrFileNotFound
            
            strMsg = "File not found."
            lngMsgType = vbExclamation + vbRetryCancel
        
        Case gErrInputPastEOF
            
            strMsg = "File is not large enough to contain the required data." & vbCrLf _
                    & "The wrong file may have been specified or the file may be corrupt."
            lngMsgType = vbExclamation + vbOKOnly
        
        Case gErrInvalidFileFormat
            
            strMsg = "Invalid file format in: " & Err.Description & vbCrLf _
                    & "The wrong file may have been specified or the file may be corrupt." & vbCrLf _
                    & "Check the log file for details."
            lngMsgType = vbExclamation + vbOKOnly
        
        Case gErrPathDoesNotExist
            
            strMsg = "Specified path not found."
            lngMsgType = vbExclamation + vbRetryCancel
        
        Case gErrPathOrFileAccess
            
            strMsg = "Path or file access error."
            lngMsgType = vbExclamation + vbRetryCancel
        
        Case gErrPermissionDenied
            
            strMsg = "You do not have permission to modify the specified file(s)." & vbCrLf _
                    & "Check the security settings on the drive, folder, and file(s)."
            lngMsgType = vbExclamation + vbRetryCancel
        
        Case gErrTooManyFilesOpen
            
            strMsg = "Too many files open simultaneously."
            lngMsgType = vbExclamation + vbOKOnly
        
        Case gErrADOReadOnly
            strMsg = "Could not gain write access to database." & vbCrLf _
                    & "Make sure it is not read-only or in use by another program."
            lngMsgType = vbExclamation + vbRetryCancel
            
        Case Else
            strMsg = "Error " & Err.Number & vbCrLf _
                & Err.Description
            lngMsgType = vbExclamation + vbRetryCancel
            
    End Select
    
    Response = MsgBox(strMsg, lngMsgType, "Error")
    
    Select Case Response
        
        Case vbRetry
            ErrorPrompt = ErrorResultEnum.ResumeCode
        
        Case vbCancel, vbIgnore, vbOK
            ErrorPrompt = ErrorResultEnum.ResumeNext
        
        Case vbAbort
            ErrorPrompt = ErrorResultEnum.UnrecoverableError
        
        Case Else
            ErrorPrompt = ErrorResultEnum.UnrecognizedError
    
    End Select
    
End Function


c2File: MsgBoxAll.frm
c0Title:
Displays a message box similar to MsgBox, but it contains 'Yes', 'Yes to All', 'No', and 'No to All' buttons

c1Code:
Attribute VB_Name = "FormTools"
Option Explicit


Public Enum MsgBoxAllButtonEnum
    mbYes = 0
    mbYesAll = 1
    mbNo = 2
    mbNoAll = 3
    mbCancel = 4
End Enum

#If False Then          'Dummy variables to force auto-capitalization of Enum members
    Public mbYes
    Public mbYesAll
    Public mbNo
    Public mbNoAll
    Public mbCancel
#End If

Public Enum MsgBoxAllIconEnum
    mbAsterisk = 32516&    ' like vbInformation
    mbExclamation = 32515& ' like vbExlamation
    mbHand = 32513&        ' like vbCritical
    mbQuestion = 32514&    ' like vbQuestion
End Enum

#If False Then          'Dummy variables to force auto-capitalization of Enum members
    Public mbAsterisk
    Public mbExclamation
    Public mbHand
    Public mbQuestion
#End If


'Unload all forms and end the program
Sub UnloadForms()
   
    Dim frmAny As Form
    
    For Each frmAny In Forms
        Unload frmAny
    Next
    
    Set frmAny = Nothing
    End

End Sub


Sub CenterFormWithParent(aForm As Form, aParent As Form)
    aForm.Left = aParent.Left + (aParent.Width - aForm.Width) / 2
    
    aForm.Top = aParent.Top + (aParent.Height - aForm.Height) / 2
    
    If (aForm.Left + aForm.Width) > Screen.Width Then
        aForm.Left = Screen.Width - aForm.Width
    Else
    If aForm.Left < 0 Then aForm.Left = 0
    End If
    
    If (aForm.Top + aForm.Height) > Screen.Height Then
        aForm.Top = Screen.Height - aForm.Height
    Else
        If aForm.Top < 0 Then aForm.Top = 0
    End If
End Sub


Sub CenterForm(frm As Form)
    frm.Move (Screen.Width - frm.Width) \ 2, (Screen.Height - frm.Height) \ 2
End Sub




'Displays a message box similar to MsgBox, but it contains 'Yes', 'Yes to All', 'No', and 'No to All' buttons
'Requires MsgBoxAll.frm
'
Public Function MsgBoxAll(Optional ByVal Prompt As String = vbNullString, _
                          Optional ByVal Title As String = vbNullString, _
                          Optional ByVal Icon As MsgBoxAllIconEnum = mbExclamation) As MsgBoxAllButtonEnum
    Dim frmMsgBox As frmMsgBoxAll
    
    Set frmMsgBox = New frmMsgBoxAll
    
    With frmMsgBox
        
        .Caption = Title
        .lblPrompt = Prompt
        .Show vbModal
      
        MsgBoxAll = .UserChoice
    
    End With
    
    Set frmMsgBox = Nothing

End Function




c0Title: Where to save application data
c1Code:
Lemme Tell Ya Where To Stick It

In these days of increasingly common least-privileged users, where should you store your application data?
January 19, 2009 � by Karl E. Peterson
In my last column, I provided code and encouragement to use INI files when appropriate to store your application settings. Back in the proverbial Good Olde Days, you could simply store your INI files wherever your EXE happened to find itself. What could be easier? Finding your INI file was as quick and easy as
App.Path & "\" & App.EXEName & ".ini"
Of course, you still had to guard against the occasional user who'd stick your EXE in the root folder of a drive, but that's about as difficult as it got. Now, not only do ordinary users lack write permissions to the Program Files folder, but there are more and more folks taking advantage of the roaming support offered by today's networks. Roaming users can sit down at any machine on the network, log in and expect that all their settings will be the way they left them on the last machine they logged off from. The concepts of roaming users and least privilege have made the developer's life more difficult.

Microsoft offers scads of recommendations or "Best Practices" on where to put your application data, based in part on how the user will be using it. These have been "in effect" for years, of course, but it's only recently that they've been enforced.. The key points to pull are that application data generally breaks down into three categories: that used by all users of the application, that used by a specific user, and that used by specific users when roaming about the network. Windows, conveniently, offers three predefined folder locations for storing these three distinct kinds of data.

To find the locations of these and other special system folders, you will generally want to call the SHGetFolderPath API function. However, this function is exported from shfolder.dll which wasn't introduced until Internet Explorer 5, so that presents a bit of an issue for older systems. While many Win9x systems will have IE 5 installed, you still need to be prepared to fall back to older APIs for system folders. Unfortunately, those older shells don't offer this same concept of three distinct application data classes, so you're faced with a dilemma.

You can call SHGetFolderPath, if it's available, and use the path presented for your needs. Or, on Win9x systems, you can simply punt and stick with the App.Path for application data. I honestly recommend the latter approach, after much testing, because the various scenarios raised by the potential lack of shfolder.dll are just too fraught with peril to be worth the effort. And the number of robust multi-user Win9x systems (say that without laughing!) has to be very small indeed.

That leaves us with NT-class systems, all of which (back to NT4, if IE 5 is installed) fully support the three distinct data classes. SHGetFolderPath accepts a wide array of constants to request specific folder locations. The three we're interested in are CSIDL_APPDATA, CSIDL_LOCAL_APPDATA and CSIDL_COMMON_APPDATA. Typically, based on operating system, they'll point to the following locations:

CSIDL_APPDATA
Windows NT4	C:\WINNT\Profiles\%USERNAME%\
Application Data
Windows 2000/XP	C:\Documents and Settings\%USERNAME%\Application Data
Windows Vista	C:\Users\%USERNAME%\AppData\
Roaming

CSIDL_LOCAL_APPDATA
Windows NT4	C:\WINNT\Profiles\%USERNAME%\
Local Settings\Application Data
Windows 2000/XP	C:\Documents and Settings\%USERNAME%\Local Settings\Application Data
Windows Vista	C:\Users\%USERNAME%\AppData\Local

CSIDL_COMMON_APPDATA
Windows NT4	C:\WINNT\Profiles\All Users\Application Data
Windows 2000/XP	C:\Documents and Settings\All Users\Application Data
Windows Vista	C:\ProgramData

With all three folder types, the general idea is to create subfolders below them for your data. You'd first create a folder with your company name, then a subfolder below that with the product name. If your data is version-specific, you can create a further subfolder for each subsequent version.

Let's look at each of them, in reverse order. The CSIDL_COMMON_APPDATA folder is where you'll want to store application data intended for all users to share. This is analogous to storing data in the HKEY_LOCAL_MACHINE hive of the registry. There's a good chance this will be a write-once opportunity, to be performed at install time, as that execution will almost certainly be done with administrative privileges. Ordinary users will most likely not have write access to this folder.

The CSIDL_LOCAL_APPDATA folder is used for application data that will always be local to the current machine, but is set aside on a per user basis. The data in this folder is not available on a roaming basis, so it should be data that the user will likely not miss if they log in to a different machine. The best example of this sort of application data are the temporary files stored by Internet browsers. It would consume far too much time and bandwidth to sling these back and forth to the server at every log-in and log-out.

Finally, the CSIDL_APPDATA folder is the one you will likely be most interested in. Data stored here is available to roaming users at whatever machine they log in to. This is the best place to store simple configuration data. All users have write access to this (and the last) folder. Note that none of the above folders are for user-generated data! That would properly belong under the My Documents hierarchy.

So, with those preliminaries out of the way, I'll just point you to what I think many of you read this column for (grin). I've written a drop-in ready class that you can use in any 32-bit version of Classic VB or VBA to uncover where the system is hiding all these special folders. Hit my Web site and download the SysFolders sample as soon as you're done reading here. It'll be a natural companion to the kpINI sample I wrote about last time. The CSystemFolders class offers an enumeration of all the CSIDL constants, so you can retrieve (and even force the creation of) any of the special folders. To make it complete, it also offers simple wrappers for the GetWindowsDirectory, GetSystemDirectory and GetTempPath API calls.

In cases where SHGetFolderPath isn't available, CSystemFolders reverts to doing the best it can, by calling the SHGetPathFromIDList and SHGetSpecialFolderLocation APIs instead. Of course, the list of folders these APIs know about is far shorter. Generally, you'll only run into this situation on older Windows 95 and 98 systems that haven't even been updated to include IE 5. The class offers an Enhanced property so you can immediately know whether the shell has been updated to include this functionality.

Finally, a word of caution: In testing for this column, I ran into a very puzzling situation. I found that SHGetFolderPath was working in a "clean" Windows 95 virtual machine that only had IE 3! This confounded me for a while. Finally, it hit me -- the "Virtual Machine Additions" offered by VirtualPC 2004 installed the shell update. This was, of course, the only thing I'd installed to what I thought was a "clean" system. Ouch. That's what a guy gets for trying to make the testbed as comfortable as possible, eh? 
About the Author
Karl E. Peterson wrote Q&A, Programming Techniques, and various other columns for VBPJ and VSM from 1995 onward, until Classic VB columns were dropped entirely in favor of other languages. Similarly, Karl was a Microsoft BASIC MVP from 1994 through 2005, until such community contributions were no longer deemed valuable. He is the author of VisualStudioMagazine.com's new Classic VB Corner column. You can contact him through his Web site if you'd like to suggest future topics for this column.


c0Title: SendKeys() Replacement for Vista
c2File: SendInput.zip
c1Code:
For all the complaints that Vista broke this, and Vista broke that, Vista really didn't break Classic VB all that badly. That said, one VB statement did truly get hammered. This sample provides a drop-in replacement for the standard SendKeys statement, and should work just fine in all the environments (VB5, VB6 IDE, VBA other than Office 2007) where this broke. I believe it's written to exactly emulate SendKeys, without exception <g>.

Well, all but one "feature" of SendKeys, at any rate -- the Wait parameter. Can anyone tell me what that's all about? My routine accepts, but ignores, this parameter.

As you'll see, using MySendKeys is absolutely identical to native SendKeys:


Private Sub Command1_Click()
   Text1.SetFocus
   Call MySendKeys(Text2.Text)
   DoEvents
   Command1.SetFocus
End Sub

Private Sub Command2_Click()
   Text1.SetFocus
   Call VBA.SendKeys(Text2.Text)
   DoEvents
   Command2.SetFocus
End Sub

Private Sub Form_Load()
   Text2.Text = "{home}+{end}Testing123+(123)"
End Sub
One change you may want to think about making would be to rename the MySendKeys subroutine to SendKeys. That will avoid having to change anything else in your code, as it will override the SendKeys statement in the VBA object library from that point onward. In order to use the original SendKeys, you'll then have to prefix it with "VBA." as shown above.

Note on Conditional Compilation

The MSendInput.bas module contains a conditional compilation constant that determines whether the native language implementation of Split() is compiled in or not. If this constant is defined as False, as it is in the download, the module may be used in VB5 as well as VB6 and VBA.

Published

This sample, or the one from which it originally derived, was published (or at least peripherally mentioned) in the following article(s):

VB Statement Against Vista, Classic VB Corner, VSM Online, November 2007
APIs Usage

This sample uses the following API calls:

Module	Library	Function
MSendInput.bas	user32
SendInput
VkKeyScan
Don't see what you're looking for? Here's a complete API cross-reference.

Download

	 	Please, enjoy and learn from this sample. Include its code within your own projects, if you wish. But, in order to insure only the most recent code is available to all, I ask that you don't share the sample by any form of mass distribution.
Download SendInput.zip, 15Kb, Last Updated: Tuesday, 27 November 2007


c0Title: Sink Notifications From Arrays of Objects
c1Code:
I've written some classes that raise events back to their clients. I'd like to use arrays of these classes, but VB won't allow that together with WithEvents:

Dim WithEvents MyClass() As Class1
I need to find a strategy for listening to events from many objects. Any ideas?

A. This solution revolves around a single intermediate notification object, which the parent creates at startup using WithEvents, and passes to each object in the array. The code within the notification object is drop-dead simple:

Option Explicit

Public Event Notify(Source As Object)

Public Sub CallNotify(Source As Object)
   RaiseEvent Notify(Source)
End Sub

Assume you need to create an array of many class objects and need to sink events from each. As part of each object's initialization, pass the reference to the common notification object. You'll also want a means to uniquely identify each object. I suggest adding a Tag property to your MyObject class:

Private WithEvents objNotify As CNotify
Private obj(0 To 5) As MyObject
Private Sub Form_Load()
   Dim i As Long
   ' Create array of callback objects.
   Set objNotify = New CNotify
   For i = 0 To 5
      Set obj(i) = New MyObject
      Set obj(i).Notify = objNotify
      obj(i).Tag = i
   Next i
End Sub

To notify its parent, the event-raising object needs only to fire the CallNotify method of the CNotify class. This means the parent is free to examine the properties of the event-raising object to ascertain the purpose of the call. You might need to force the notification�for example, when the class needs to let its parent know its TestCallback method has been invoked (see Listing 2). In this case, the TestCallback routine tests to make sure a notification object has been assigned, then invokes its CallNotify method. The parent object sinks this event and responds appropriately:

Private Sub objNotify_Notify(Source _ 
   As Object)

   ' Use the Tag property as you would
   ' a control array Index parameter.

   MsgBox "Object(" & Source.Tag & _
      ") calling back!"
End Sub

The scheme's advantage is that it creates no circular references, which in turn means the parent has no need to perform an explicit tear-down when it's through with the array. The overhead is slightly higher than with a strictly interface-based approach, but, for non-time-critical applications, the robustness more than makes up for that.


c0Title: Automatically Save Current Time in Records with Override
c1Code:
Add the following triggers to a table. When any record is inserted or updated, the LastUpdate field will be set to the current date/time in Julian format (VB date/time as a Double precision Float...faster and smaller than saving as text which is the default format). However, you can override the triggers if you Write a new value to the LastUpdate field during an insert or update.

CREATE TRIGGER tblItem_Insert_LastUpdate 
AFTER INSERT ON tblItem
WHEN New.LastUpdate IS NULL
BEGIN 
UPDATE tblItem SET LastUpdate = JulianDay('now') WHERE ROWID = New.ROWID; 
END;

CREATE TRIGGER tblItem_Update_LastUpdate 
AFTER UPDATE ON tblItem
WHEN (New.LastUpdate IS NULL) OR (New.LastUpdate = Old.LastUpdate)
BEGIN 
UPDATE tblItem SET LastUpdate = JulianDay('now') WHERE ROWID = New.ROWID; 
END;


c0Title: GLOB Command Documentation
c1Code:
glob - Return names of files that match patterns  
SYNOPSIS

glob ?switches? pattern ?pattern ...?

DESCRIPTION

This command performs file name ``globbing'' in a fashion similar to the csh shell. It returns a list of the files whose names match any of the pattern arguments.

If the initial arguments to glob start with - then they are treated as switches. The following switches are currently supported:

-directory directory
Search for files which match the given patterns starting in the given directory. This allows searching of directories whose name contains glob-sensitive characters without the need to quote such characters explicitly. This option may not be used in conjunction with -path.
-join
The remaining pattern arguments are treated as a single pattern obtained by joining the arguments with directory separators.
-nocomplain
Allows an empty list to be returned without error; without this switch an error is returned if the result list would be empty.
-path pathPrefix
Search for files with the given pathPrefix where the rest of the name matches the given patterns. This allows searching for files with names similar to a given file even when the names contain glob-sensitive characters. This option may not be used in conjunction with -directory.
-types typeList
Only list files or directories which match typeList, where the items in the list have two forms. The first form is like the -type option of the Unix find command: b (block special file), c (character special file), d (directory), f (plain file), l (symbolic link), p (named pipe), or s (socket), where multiple types may be specified in the list. Glob will return all files which match at least one of the types given.
The second form specifies types where all the types given must match. These are r, w, x as file permissions, and readonly, hidden as special permission cases. On the Macintosh, MacOS types and creators are also supported, where any item which is four characters long is assumed to be a MacOS type (e.g. TEXT). Items which are of the form {macintosh type XXXX} or {macintosh creator XXXX} will match types or creators respectively. Unrecognised types, or specifications of multiple MacOS types/creators will signal an error.

The two forms may be mixed, so -types {d f r w} will find all regular files OR directories that have both read AND write permissions. The following are equivalent:


glob -type d *
glob */

except that the first case doesn't return the trailing ``/'' and is more platform independent.
--
Marks the end of switches. The argument following this one will be treated as a pattern even if it starts with a -.
The pattern arguments may contain any of the following special characters:

?
Matches any single character.
*
Matches any sequence of zero or more characters.
[chars]
Matches any single character in chars. If chars contains a sequence of the form a-b then any character between a and b (inclusive) will match.
\x
Matches the character x.
{a,b,...}
Matches any of the strings a, b, etc.
As with csh, a ``.'' at the beginning of a file's name or just after a ``/'' must be matched explicitly or with a {} construct. In addition, all ``/'' characters must be matched explicitly.

If the first character in a pattern is ``~'' then it refers to the home directory for the user whose name follows the ``~''. If the ``~'' is followed immediately by ``/'' then the value of the HOME environment variable is used.

The glob command differs from csh globbing in two ways. First, it does not sort its result list (use the lsort command if you want the list sorted). Second, glob only returns the names of files that actually exist; in csh no check for existence is made unless a pattern contains a ?, *, or [] construct.

 

PORTABILITY ISSUES

Unlike other Tcl commands that will accept both network and native style names (see the filename manual entry for details on how native and network names are specified), the glob command only accepts native names.

Windows
For Windows UNC names, the servername and sharename components of the path may not contain ?, *, or [] constructs. On Windows NT, if pattern is of the form ``~username@domain'' it refers to the home directory of the user whose account information resides on the specified NT domain server. Otherwise, user account information is obtained from the local computer. On Windows 95 and 98, glob accepts patterns like ``.../'' and ``..../'' for successively higher up parent directories.
Macintosh
When using the options, -dir, -join or -path, glob assumes the directory separator for the entire pattern is the standard ``:''. When not using these options, glob examines each pattern argument and uses ``/'' unless the pattern contains a ``:''.
 
SEE ALSO

file(n)
 

KEYWORDS

exist, file, glob, pattern


c0Title: Regular Expression Support Using PCRE
c1Code:
http://article.gmane.org/gmane.comp.db.sqlite.general/23584

See also http://git.altlinux.org/people/at/packages/?p=sqlite3-pcre.git


I've just written sqlite3 loadable module which implements REGEXP
operator with Perl-Compatible Regular Expressions library.  It has
LRU cache for compiled regular expressions, so it is probably fast.

$ cflags=`pkg-config --cflags sqlite3 libpcre`
$ libs=`pkg-config --libs sqlite3 libpcre`
$ gcc -shared -o pcre.so -Wall -g -fPIC $cflags pcre.c $libs

Note that regular expression flags can be embedded within regular
expressions themselves, e.g.

sqlite> .load ./pcre.so
sqlite> SELECT "asdf" REGEXP "(?i)^A";
1
sqlite> 

This is native perl syntax, and this is what POSIX regex(7) does
not allow (which makes them pretty much useless for REGEXP syntax).

I still consider whether to release the code under the GPL or 
make it public domain.  Are there any other sqlite3 extensions
out there yet?
#include <assert.h>
#include <stdlib.h>
#include <string.h>
#include <pcre.h>
#include <sqlite3ext.h>
SQLITE_EXTENSION_INIT1

typedef struct {
    char *s;
    pcre *p;
    pcre_extra *e;
} cache_entry;

#define CACHE_SIZE 16

static
void regexp(sqlite3_context *ctx, int argc, sqlite3_value **argv)
{
    const char *re, *str;
    pcre *p;
    pcre_extra *e;

    assert(argc == 2);

    re = (const char *) sqlite3_value_text(argv[0]);
    if (!re) {
	sqlite3_result_error(ctx, "no regexp", -1);
	return;
    }

    str = (const char *) sqlite3_value_text(argv[1]);
    if (!str) {
	sqlite3_result_error(ctx, "no string", -1);
	return;
    }

    /* simple LRU cache */
    {
	int i;
	int found = 0;
	cache_entry *cache = sqlite3_user_data(ctx);

	assert(cache);

	for (i = 0; i < CACHE_SIZE && cache[i].s; i++)
	    if (strcmp(re, cache[i].s) == 0) {
		found = 1;
		break;
	    }
	if (found) {
	    if (i > 0) {
		cache_entry c = cache[i];
		memmove(cache + 1, cache, i * sizeof(cache_entry));
		cache[0] = c;
	    }
	}
	else {
	    cache_entry c;
	    const char *err;
	    int pos;
	    c.p = pcre_compile(re, 0, &err, &pos, NULL);
	    if (!c.p) {
		char *e2 = sqlite3_mprintf("%s: %s (offset %d)", re, err, pos);
		sqlite3_result_error(ctx, e2, -1);
		sqlite3_free(e2);
		return;
	    }
	    c.e = pcre_study(c.p, 0, &err);
	    c.s = strdup(re);
	    if (!c.s) {
		sqlite3_result_error(ctx, "strdup: ENOMEM", -1);
		pcre_free(c.p);
		pcre_free(c.e);
		return;
	    }
	    i = CACHE_SIZE - 1;
	    if (cache[i].s) {
		free(cache[i].s);
		assert(cache[i].p);
		pcre_free(cache[i].p);
		pcre_free(cache[i].e);
	    }
	    memmove(cache + 1, cache, i * sizeof(cache_entry));
	    cache[0] = c;
	}
	p = cache[0].p;
	e = cache[0].e;
    }

    {
	int rc;
	assert(p);
	rc = pcre_exec(p, e, str, strlen(str), 0, 0, NULL, 0);
	sqlite3_result_int(ctx, rc >= 0);
	return;
    }
}

int sqlite3_extension_init(sqlite3 *db, char **err, const sqlite3_api_routines *api)
{
	SQLITE_EXTENSION_INIT2(api)
	cache_entry *cache = calloc(CACHE_SIZE, sizeof(cache_entry));
	if (!cache) {
	    *err = "calloc: ENOMEM";
	    return 1;
	}
	sqlite3_create_function(db, "REGEXP", 2, SQLITE_UTF8, cache, regexp, NULL, NULL);
	return 0;
}


