~bkidwell/msaccess-gpg-demo

a397f3f61b0d5c619f4dc4f69d0404a5ea5b63f6 — Brendan Kidwell 11 years ago 9313ac1
* Imported original Access 97 database from my old web site
* Added LICENSE
* Added exported source code
A LICENSE.txt => LICENSE.txt +16 -0
@@ 0,0 1,16 @@
Copyright © 2003 Brendan Kidwell

Use of msaccess-vcs-integration and documentation are subject to the following
BSD-style license:

Permission to use, copy, modify, and/or distribute this software for any purpose
with or without fee is hereby granted, provided that the above copyright notice
and this permission notice appear in all copies.

THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH
REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT,
INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER
TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
THIS SOFTWARE.

M README.md => README.md +86 -2
@@ 1,4 1,88 @@
msaccess-gpg-demo
msaccess-gpg-demo
=================

Example code to sync your Microsoft Access data to a central server by FTPing a GPG-encrypted dump file
\ No newline at end of file
GPG Usage Demo Application

Copyright © 2003 Brendan Kidwell

This Microsoft Access application demonstrates how to use the GNU Privacy Guard, available for free at http://www.gnupg.org/, to send encrypted database updates to a central FTP server. You must follow the installation instructions in this file before the program will work.

Portions of this program were copied The Access Web ( http://www.mvps.org/access/ ). In general, you may use the Visual Basic code found in this application however you wish, but be sure to read and respect any license information you may find at the top of each module.

Requirements
------------

* Microsoft Access 2000 or 2002 (XP)
* GNU Privacy Guard (Download the Windows version from the URL above.)
* access to an FTP server

Installation Overview
---------------------

Copy the two Access files, data.mdb and frontend.mdb, to a new folder ("c:\work\GPG Access Demo" for example).

Copy gpg.exe from the GPG folder into the folder where you put the database. Import someone's public key into a GPG keyring in the database's folder.

You must link the "addresses" table from data.mdb into frontend.mdb and then edit the module mdlSettings in frontend.mdb to reflect the FTP server name, the name on the GPG key, etc.

Importing the Gpg Key
---------------------

Export someone's public key to an ASCII file. (You should use your own personal key while you are experimenting.) For details on how to create a key pair and export to ASCII, see the GPG documentation.

Copy that file to the database's folder. Open a command prompt and go to that folder. Use GPG's import command:

```
c:\work\GPG Access Demo>gpg --homedir . --import KEY_FILE
```

where KEY_FILE is the name of the ASCII file you exported the public key to. GPG should respond by saying that 1 key was imported.

Next, set the trust on that key:

   c:\work\GPG Access Demo>gpg --homedir . --edit-key "YOUR_NAME"

where YOUR_NAME is the name on the key. GPG will give you its own command prompt. Type the command `trust` and select `5) I trust ultimately` and confirm with `yes`. Last, type `quit` to save your changes.

Configuring the Database
------------------------

Open frontend.mdb. From the File menu, choose Get External Data, then Link Tables. Locate and select the data file, data.mdb, and then choose to import the table `addresses`.

Verify that you have done this correctly by opening the "Browse / Edit Addresses" form from the Switchboard.

Next, go to the Modules section of the Database window and open `mdlSettings`. Fill in all the values according to your installation.

<table>
<tr><td>FTP_SERVER</td><td>the Internet name for the FTP server</td></tr>
<tr><td>FTP_PORT</td><td>FTP server's port (leave blank for default of 21)</td></tr>
<tr><td>FTP_USER</td><td>FTP user name</td></tr>
<tr><td>FTP_PASSWORD</td><td>FTP password</td></tr>
<tr><td>FTP_FOLDER</td><td>destination folder (e.g. "/home/addresses/updates"</td></tr>
<tr><td>GPG_RECIPIENT</td><td>the name on the key from the previous step</td></tr>
<tr><td>FILENAME_BASE</td><td>the beginning of the filename that is uploaded</td></tr>
</table>

If you give this database to more than one person, so they can each send updates to your FTP server, each one should have a different value for FILENAME_BASE, so you can tell who uploaded which file. The actual file name will also contain today's date.

Operation
---------

The basic operation of this system is fairly straightforward.

A remote user enters data into the database by way of forms in the front end --- Addresses is the only such form in this demo application. When the user wants to send his data to the FTP server, he uses the Upload command from the Switchboard. This command sends all of the data; there is no incremental update function in the demo.

At the other end, the owner of the key which was used in the encryption retrieves the update files from the FTP server and decrypts them. If he has many users sending him data, he can optionally collect all of the most recent updates"after decrypting them&rdquol;into a master database.

Notes
-----

The good stuff --- where the encryption and FTP uploading happens --- is in the form `Upload`. To view the Visual Basic code, go to the `Forms` section of the Database window and select `Upload` and then choose `Code` from the `View` menu.

The application makes use of the Microsoft Scripting Runtime library for filyststem access, because the built-in file handling functions in Visual Basic are somewhat limited and they have anachronistic QBasic-style syntax. You should already have this library because it should have been installed automatically with Windows. Even so, the application's reference to this library may get broken. If this happens, go into the Visual Basic editor by following the directions above and then choose References from the Tools menu. You will probably see a "Missing: Microsoft Scripting Runtime" in the list. Uncheck this and then find "Microsoft Scripting Runtime", and click OK.

It is important to note that the database is split across two files, data.mdb and frontend.mdb. The idea is to place all your data in a file by itself and all the rest of the program in another file (forms, reports, Visual Basic modules, etc.) Splitting applications this way is a common practice among Access programmers --- in fact, Access has a built-in command for splitting an existing database this way. This scheme makes it easy to work on the data as a distinct entity (compacting it, backing it up, encrypting and uploading it…) One apparent disadvantage is that the front end must be relinked to the data file when it is installed on a new machine.

If you want simply copy and paste from my sample application, here's what you need to do: Make sure your database is split the same way. Copy the form `Upload` and the modules `mdlFileStuff`, `mdlSettings`, `mdlShellWait`, and `mdlWhereAmI` to your front end. You may have to edit `Upload` to reflect the name of your data file.

The reason that I forced the application to use a copy of GPG installed in its own folder is to make it easy to distribute the finished database to a client; you wouldn't want to have to walk your client through installing GPG and your public key, and then telling the database where to find them. Simply give your client the two access files, `gpg.exe`, and the three files ending with `.gpg` and provide some mechanism or instructions for linking data.mdb into frontend.mdb.

A data.mdb => data.mdb +0 -0
A frontend.mdb => frontend.mdb +0 -0
A source/forms/About.bas => source/forms/About.bas +113 -0
@@ 0,0 1,113 @@
Version =19
VersionRequired =19
    PopUp = NotDefault
    Modal = NotDefault
    RecordSelectors = NotDefault
    AutoCenter = NotDefault
    NavigationButtons = NotDefault
    DividingLines = NotDefault
    AllowDesignChanges = NotDefault
    DefaultView =0
    ScrollBars =0
    ViewsAllowed =1
    TabularFamily =55
    BorderStyle =3
    PictureAlignment =2
    DatasheetGridlinesBehavior =3
    GridX =24
    GridY =24
    Width =4320
    DatasheetFontHeight =10
    ItemSuffix =3
    Left =8820
    Top =1830
    Right =13140
    Bottom =5955
    DatasheetGridlinesColor =12632256
        0xcc680cc2fa67e240
    End
    Caption ="About"
    DatasheetFontName ="Arial"
        0x6801000068010000680100006801000000000000201c0000e010000001000000 ,
        0x010000006801000000000000a10700000100000001000000
    End
            BackStyle =0
            FontName ="Tahoma"
        End
            FontSize =8
            FontWeight =400
            ForeColor =-2147483630
            FontName ="Tahoma"
        End
            FELineBreak = NotDefault
            SpecialEffect =2
            OldBorderStyle =0
            BorderLineStyle =0
            FontName ="Tahoma"
        End
            Height =4140
            BackColor =-2147483633
            Name ="Detail"
                    OverlapFlags =85
                    Left =120
                    Top =120
                    Width =4095
                    Height =3360
                    Name ="Label0"
                    Caption ="GPG Uage Demo Application\015\012Copyright (c) 2003 Brendan Kidwell\015\012\015\012"
                        "This Microsoft Access application demonstrates how to use the GNU Privacy Guard,"
                        " available for free at <http://www.gnupg.org/>, to send encrypted database updat"
                        "es to a central FTP server. Please see the file <readme.md> for usage notes. You"
                        " must follow the installation instructions in this file before the program will "
                        "work.\015\012\015\012Portions of this program were copied The Access Web <http:/"
                        "/www.mvps.org/access/>. In general, you may use the Visual Basic code found in t"
                        "his application however you wish, but be sure to read and respect any license in"
                        "formation you may find at the top of each module."
                End
                    Default = NotDefault
                    Cancel = NotDefault
                    OverlapFlags =85
                    Left =3720
                    Top =3660
                    Width =450
                    Height =405
                    Name ="cmdOK"
                    Caption ="OK"
                    OnClick ="[Event Procedure]"
                End
                    FontUnderline = NotDefault
                    OverlapFlags =85
                    Left =120
                    Top =3780
                    Width =1320
                    Height =255
                    ForeColor =1279872587
                    Name ="Label2"
                    Caption ="View readme.htm"
                    HyperlinkAddress ="readme.htm"
                End
            End
        End
    End
End
CodeBehindForm
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Compare Database

Private Sub cmdOK_Click()
On Error GoTo Err_cmdOK_Click


    DoCmd.Close

Exit_cmdOK_Click:
    Exit Sub

Err_cmdOK_Click:
    MsgBox Err.description
    Resume Exit_cmdOK_Click
    
End Sub

A source/forms/Addresses.bas => source/forms/Addresses.bas +348 -0
@@ 0,0 1,348 @@
Version =19
VersionRequired =19
    AutoCenter = NotDefault
    AllowDesignChanges = NotDefault
    DefaultView =0
    TabularFamily =0
    PictureAlignment =2
    DatasheetGridlinesBehavior =3
    GridX =24
    GridY =24
    Width =5700
    DatasheetFontHeight =10
    ItemSuffix =24
    Left =3675
    Top =1590
    Right =9660
    Bottom =5880
    DatasheetGridlinesColor =12632256
        0x5f6d5044fb67e240
    End
    RecordSource ="addresses"
    Caption ="Addresses"
    DatasheetFontName ="Arial"
            BackStyle =0
            BackColor =-2147483633
            ForeColor =-2147483630
        End
            SpecialEffect =3
            BackStyle =0
        End
            BackStyle =0
            OldBorderStyle =0
            PictureAlignment =2
        End
            FontSize =8
            FontWeight =400
            FontName ="MS Sans Serif"
        End
            SpecialEffect =2
            LabelX =230
            LabelY =-30
        End
            SpecialEffect =2
            LabelX =230
            LabelY =-30
        End
            SpecialEffect =3
        End
            SpecialEffect =2
            OldBorderStyle =0
            BackStyle =0
        End
            FELineBreak = NotDefault
            SpecialEffect =2
            BackColor =-2147483643
            ForeColor =-2147483640
        End
            SpecialEffect =2
            BackColor =-2147483643
            ForeColor =-2147483640
        End
            SpecialEffect =2
            BackColor =-2147483643
            ForeColor =-2147483640
        End
            SpecialEffect =2
        End
            SpecialEffect =2
            OldBorderStyle =1
        End
            FontSize =8
            FontWeight =400
            FontName ="MS Sans Serif"
        End
            BackStyle =0
        End
            Height =0
            BackColor =-2147483633
            Name ="FormHeader"
        End
            Height =4296
            BackColor =-2147483633
            Name ="Detail"
                    OverlapFlags =85
                    IMESentenceMode =3
                    Left =1500
                    Top =120
                    Width =2568
                    ColumnWidth =2568
                    Name ="LastName"
                    ControlSource ="LastName"
                            OverlapFlags =85
                            Left =60
                            Top =120
                            Width =1380
                            Height =240
                            Name ="LastName_Label"
                            Caption ="Last Name"
                        End
                    End
                End
                    OverlapFlags =85
                    IMESentenceMode =3
                    Left =1500
                    Top =480
                    Width =2568
                    ColumnWidth =2568
                    TabIndex =1
                    Name ="FirstName"
                    ControlSource ="FirstName"
                            OverlapFlags =85
                            Left =60
                            Top =480
                            Width =1380
                            Height =240
                            Name ="FirstName_Label"
                            Caption ="First Name"
                        End
                    End
                End
                    OverlapFlags =85
                    IMESentenceMode =3
                    Left =1500
                    Top =840
                    Width =2568
                    ColumnWidth =2568
                    TabIndex =2
                    Name ="Street"
                    ControlSource ="Street"
                            OverlapFlags =85
                            Left =60
                            Top =840
                            Width =1380
                            Height =240
                            Name ="Street_Label"
                            Caption ="Street"
                        End
                    End
                End
                    OverlapFlags =85
                    IMESentenceMode =3
                    Left =1500
                    Top =1200
                    Width =2568
                    ColumnWidth =2568
                    TabIndex =3
                    Name ="City"
                    ControlSource ="City"
                            OverlapFlags =85
                            Left =60
                            Top =1200
                            Width =1380
                            Height =240
                            Name ="City_Label"
                            Caption ="City"
                        End
                    End
                End
                    OverlapFlags =85
                    IMESentenceMode =3
                    Left =1500
                    Top =1560
                    Width =384
                    ColumnWidth =384
                    TabIndex =4
                    Name ="State"
                    ControlSource ="State"
                            OverlapFlags =85
                            Left =60
                            Top =1560
                            Width =1380
                            Height =240
                            Name ="State_Label"
                            Caption ="State"
                        End
                    End
                End
                    OverlapFlags =85
                    IMESentenceMode =3
                    Left =3060
                    Top =1560
                    Width =972
                    ColumnWidth =972
                    TabIndex =5
                    Name ="Zip"
                    ControlSource ="Zip"
                    InputMask ="00000C####"
                            OverlapFlags =85
                            Left =2700
                            Top =1560
                            Width =288
                            Height =228
                            Name ="Zip_Label"
                            Caption ="Zip"
                        End
                    End
                End
                    OverlapFlags =85
                    IMESentenceMode =3
                    Left =1500
                    Top =1920
                    Width =2568
                    ColumnWidth =2568
                    TabIndex =6
                    Name ="Email"
                    ControlSource ="Email"
                            OverlapFlags =85
                            Left =60
                            Top =1920
                            Width =1380
                            Height =240
                            Name ="Email_Label"
                            Caption ="Email Address"
                        End
                    End
                End
                    OverlapFlags =85
                    IMESentenceMode =3
                    Left =1500
                    Top =2280
                    Width =1728
                    ColumnWidth =1728
                    TabIndex =7
                    Name ="Phone"
                    ControlSource ="Phone"
                            OverlapFlags =85
                            Left =60
                            Top =2280
                            Width =1380
                            Height =240
                            Name ="Phone_Label"
                            Caption ="Phone Number"
                        End
                    End
                End
                    OverlapFlags =85
                    IMESentenceMode =3
                    Left =1500
                    Top =2640
                    Width =1140
                    ColumnWidth =1140
                    TabIndex =8
                    Name ="Birthday"
                    ControlSource ="Birthday"
                    Format ="Short Date"
                            OverlapFlags =85
                            Left =60
                            Top =2640
                            Width =1380
                            Height =240
                            Name ="MemberSince_Label"
                            Caption ="Birthday"
                        End
                    End
                End
                    EnterKeyBehavior = NotDefault
                    ScrollBars =2
                    OverlapFlags =85
                    IMESentenceMode =3
                    Left =1500
                    Top =3000
                    Width =4020
                    Height =816
                    ColumnWidth =3000
                    TabIndex =10
                    Name ="Comments"
                    ControlSource ="Comments"
                            OverlapFlags =85
                            Left =60
                            Top =3000
                            Width =1380
                            Height =240
                            Name ="Comments_Label"
                            Caption ="Comments"
                        End
                    End
                End
                    OverlapFlags =85
                    Left =2760
                    Top =2640
                    Width =246
                    Height =246
                    TabIndex =9
                    Name ="cmdBirthdayCal"
                    OnClick ="[Event Procedure]"
                    OnEnter ="[Event Procedure]"
                        0x2800000010000000100000000100040000000000800000000000000000000000 ,
                        0x0000000000000000000000000000800000800000008080008000000080008000 ,
                        0x8080000080808000c0c0c0000000ff00c0c0c00000ffff00ff000000c0c0c000 ,
                        0xffff0000ffffff00dadadadadadadada000000000000000d0fffffffffffff0a ,
                        0x0f7777777fffff0d0f7f7f7f7fffff0a0f77777777777f0d0f7f7f7f7f7f7f0a ,
                        0x0f77777777777f0d0f7f7f7f7f7f7f0a0f77777777777f0d0f7f7f7f7f7f7f0a ,
                        0x0f77777777777f0d0fffffffffffff0a0f777777fff77f0d0fffffffffffff0a ,
                        0x000000000000000d000000000000000000000000000000000000000000000000 ,
                        0x0000000000000000000000000000000000000000000000000000000000000000 ,
                        0x0000000000000000000000000000000000000000000000000000000000000000 ,
                        0x0000000000000000000000000000000000000000000000000000000000000000 ,
                        0x0000000000000000000000000000000000000000000000000000000000000000 ,
                        0x0000000000000000000000000000000000000000000000000000000000000000 ,
                        0x0000000000000000000000000000000000000000000000000000000000000000 ,
                        0x0000000000000000000000000000000000000000000000000000000000000000 ,
                        0x0000000000000000
                    End
                        0x0003100000000000800000000080000080800000000080008000800000808000 ,
                        0x80808000c0c0c000ff000000c0c0c000ffff00000000ff00c0c0c00000ffff00 ,
                        0xffffff0000000000
                    End
                End
                    Locked = NotDefault
                    SpecialEffect =3
                    OverlapFlags =85
                    BackStyle =0
                    IMESentenceMode =3
                    Left =1500
                    Top =3960
                    Width =1740
                    TabIndex =11
                    Name ="RecordCreated"
                    ControlSource ="RecordCreated"
                    Format ="General Date"
                            OverlapFlags =85
                            Left =60
                            Top =3960
                            Width =1248
                            Height =228
                            Name ="Label23"
                            Caption ="Record Created:"
                        End
                    End
                End
            End
        End
            Height =0
            BackColor =-2147483633
            Name ="FormFooter"
        End
    End
End
CodeBehindForm
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Compare Database

Private Sub cmdBirthdayCal_Enter()
InputDateField Birthday
End Sub

A source/forms/DatePicker.bas => source/forms/DatePicker.bas +951 -0
@@ 0,0 1,951 @@
Version =19
VersionRequired =19
    PopUp = NotDefault
    Modal = NotDefault
    RecordSelectors = NotDefault
    MaxButton = NotDefault
    MinButton = NotDefault
    AutoCenter = NotDefault
    NavigationButtons = NotDefault
    DividingLines = NotDefault
    DefaultView =0
    ScrollBars =0
    ViewsAllowed =1
    BorderStyle =3
    PictureAlignment =2
    DatasheetGridlinesBehavior =3
    GridX =24
    GridY =24
    Width =3600
    DatasheetFontHeight =10
    ItemSuffix =74
    Left =1212
    Top =2412
    Right =4128
    Bottom =5916
    DatasheetGridlinesColor =12632256
        0xf611209a7160e240
    End
    Caption ="Calendar"
    OnOpen ="[Event Procedure]"
    DatasheetFontName ="Arial"
        0xa0050000a0050000a0050000a005000000000000201c0000e010000001000000 ,
        0x010000006801000000000000a10700000100000001000000
    End
    OnActivate ="[Event Procedure]"
    OnLoad ="[Event Procedure]"
            BackStyle =0
        End
            SpecialEffect =3
            BackStyle =0
        End
            FontSize =8
            FontWeight =400
            ForeColor =-2147483630
            FontName ="MS Sans Serif"
        End
            SpecialEffect =2
            OldBorderStyle =0
        End
            SpecialEffect =2
        End
            SpecialEffect =2
        End
            Height =4380
            BackColor =-2147483633
            Name ="Detail"
                    LimitToList = NotDefault
                    RowSourceTypeInt =1
                    OverlapFlags =85
                    ColumnCount =2
                    ListRows =12
                    ListWidth =1440
                    Left =1020
                    Top =480
                    Height =300
                    TabIndex =4
                    Name ="cboMonth"
                    RowSourceType ="Value List"
                    RowSource ="1;January;2;February;3;March;4;April;5;May;6;June;7;July;8;August;9;September;10"
                        ";October;11;November;12;December"
                    ColumnWidths ="0;1440"
                    AfterUpdate ="[Event Procedure]"
                    ControlTipText ="Month"
                End
                    AutoRepeat = NotDefault
                    OverlapFlags =85
                    Left =2520
                    Top =480
                    Width =300
                    Height =300
                    TabIndex =5
                    Name ="cmdNextMonth"
                    Caption ="+"
                    OnClick ="[Event Procedure]"
                    ControlTipText ="Click or click and hold to go forward by month."
                End
                    AutoRepeat = NotDefault
                    OverlapFlags =85
                    Left =660
                    Top =480
                    Width =285
                    Height =300
                    TabIndex =3
                    Name ="cmdPrevMonth"
                    Caption ="-"
                    OnClick ="[Event Procedure]"
                    ControlTipText ="Click or click and hold to go back by month."
                End
                    AutoRepeat = NotDefault
                    OverlapFlags =85
                    Left =2520
                    Top =120
                    Width =300
                    Height =300
                    TabIndex =2
                    Name ="cmdNextYear"
                    Caption ="+"
                    OnClick ="[Event Procedure]"
                    ControlTipText ="Click or click and hold to go forward by year."
                End
                    AutoRepeat = NotDefault
                    OverlapFlags =85
                    Left =660
                    Top =120
                    Width =285
                    Height =300
                    Name ="cmdPrevYear"
                    Caption ="-"
                    OnClick ="[Event Procedure]"
                    ControlTipText ="Click or click and hold to go back by year."
                End
                    OverlapFlags =85
                    Left =1020
                    Top =120
                    Height =300
                    TabIndex =1
                    Name ="txtYear"
                    ValidationRule ="Between 1000 And 3000"
                    AfterUpdate ="[Event Procedure]"
                    ControlTipText ="Year"
                End
                    OverlapFlags =93
                    TextAlign =2
                    Left =120
                    Top =960
                    Width =479
                    Height =240
                    Name ="Label19"
                    Caption ="Sun"
                End
                    OverlapFlags =95
                    TextAlign =2
                    Left =600
                    Top =960
                    Width =479
                    Height =240
                    Name ="Label20"
                    Caption ="Mon"
                End
                    OverlapFlags =95
                    TextAlign =2
                    Left =1080
                    Top =960
                    Width =479
                    Height =240
                    Name ="Label21"
                    Caption ="Tue"
                End
                    OverlapFlags =95
                    TextAlign =2
                    Left =1560
                    Top =960
                    Width =479
                    Height =240
                    Name ="Label22"
                    Caption ="Wed"
                End
                    OverlapFlags =95
                    TextAlign =2
                    Left =2040
                    Top =960
                    Width =479
                    Height =240
                    Name ="Label23"
                    Caption ="Thu"
                End
                    OverlapFlags =95
                    TextAlign =2
                    Left =2520
                    Top =960
                    Width =479
                    Height =240
                    Name ="Label24"
                    Caption ="Fri"
                End
                    OverlapFlags =87
                    TextAlign =2
                    Left =3000
                    Top =960
                    Width =479
                    Height =240
                    Name ="Label25"
                    Caption ="Sat"
                End
                    OverlapFlags =85
                    Left =120
                    Top =1260
                    Width =479
                    Height =420
                    TabIndex =6
                    Name ="d00"
                    Caption ="1"
                    OnClick ="[Event Procedure]"
                End
                    OverlapFlags =85
                    Left =600
                    Top =1260
                    Width =479
                    Height =420
                    TabIndex =7
                    Name ="d01"
                    Caption ="1"
                    OnClick ="[Event Procedure]"
                End
                    OverlapFlags =85
                    Left =1080
                    Top =1260
                    Width =479
                    Height =420
                    TabIndex =8
                    Name ="d02"
                    Caption ="1"
                    OnClick ="[Event Procedure]"
                End
                    OverlapFlags =85
                    Left =1560
                    Top =1260
                    Width =479
                    Height =420
                    TabIndex =9
                    Name ="d03"
                    Caption ="1"
                    OnClick ="[Event Procedure]"
                End
                    OverlapFlags =85
                    Left =2040
                    Top =1260
                    Width =479
                    Height =420
                    TabIndex =10
                    Name ="d04"
                    Caption ="1"
                    OnClick ="[Event Procedure]"
                End
                    OverlapFlags =85
                    Left =2520
                    Top =1260
                    Width =479
                    Height =420
                    TabIndex =11
                    Name ="d05"
                    Caption ="1"
                    OnClick ="[Event Procedure]"
                End
                    OverlapFlags =85
                    Left =3000
                    Top =1260
                    Width =479
                    Height =420
                    TabIndex =12
                    Name ="d06"
                    Caption ="1"
                    OnClick ="[Event Procedure]"
                End
                    OverlapFlags =85
                    Left =120
                    Top =1680
                    Width =479
                    Height =420
                    TabIndex =13
                    Name ="d10"
                    Caption ="1"
                    OnClick ="[Event Procedure]"
                End
                    OverlapFlags =85
                    Left =600
                    Top =1680
                    Width =479
                    Height =420
                    TabIndex =14
                    Name ="d11"
                    Caption ="1"
                    OnClick ="[Event Procedure]"
                End
                    OverlapFlags =85
                    Left =1080
                    Top =1680
                    Width =479
                    Height =420
                    TabIndex =15
                    Name ="d12"
                    Caption ="1"
                    OnClick ="[Event Procedure]"
                End
                    OverlapFlags =85
                    Left =1560
                    Top =1680
                    Width =479
                    Height =420
                    TabIndex =16
                    Name ="d13"
                    Caption ="1"
                    OnClick ="[Event Procedure]"
                End
                    OverlapFlags =85
                    Left =2040
                    Top =1680
                    Width =479
                    Height =420
                    TabIndex =17
                    Name ="d14"
                    Caption ="1"
                    OnClick ="[Event Procedure]"
                End
                    OverlapFlags =85
                    Left =2520
                    Top =1680
                    Width =479
                    Height =420
                    TabIndex =18
                    Name ="d15"
                    Caption ="1"
                    OnClick ="[Event Procedure]"
                End
                    OverlapFlags =85
                    Left =3000
                    Top =1680
                    Width =479
                    Height =420
                    TabIndex =19
                    Name ="d16"
                    Caption ="1"
                    OnClick ="[Event Procedure]"
                End
                    OverlapFlags =85
                    Left =120
                    Top =2100
                    Width =479
                    Height =420
                    TabIndex =20
                    Name ="d20"
                    Caption ="1"
                    OnClick ="[Event Procedure]"
                End
                    OverlapFlags =85
                    Left =600
                    Top =2100
                    Width =479
                    Height =420
                    TabIndex =21
                    Name ="d21"
                    Caption ="1"
                    OnClick ="[Event Procedure]"
                End
                    OverlapFlags =85
                    Left =1080
                    Top =2100
                    Width =479
                    Height =420
                    TabIndex =22
                    Name ="d22"
                    Caption ="1"
                    OnClick ="[Event Procedure]"
                End
                    OverlapFlags =85
                    Left =1560
                    Top =2100
                    Width =479
                    Height =420
                    TabIndex =23
                    Name ="d23"
                    Caption ="1"
                    OnClick ="[Event Procedure]"
                End
                    OverlapFlags =85
                    Left =2040
                    Top =2100
                    Width =479
                    Height =420
                    TabIndex =24
                    Name ="d24"
                    Caption ="1"
                    OnClick ="[Event Procedure]"
                End
                    OverlapFlags =85
                    Left =2520
                    Top =2100
                    Width =479
                    Height =420
                    TabIndex =25
                    Name ="d25"
                    Caption ="1"
                    OnClick ="[Event Procedure]"
                End
                    OverlapFlags =85
                    Left =3000
                    Top =2100
                    Width =479
                    Height =420
                    TabIndex =26
                    Name ="d26"
                    Caption ="1"
                    OnClick ="[Event Procedure]"
                End
                    OverlapFlags =85
                    Left =120
                    Top =2520
                    Width =479
                    Height =420
                    TabIndex =27
                    Name ="d30"
                    Caption ="1"
                    OnClick ="[Event Procedure]"
                End
                    OverlapFlags =85
                    Left =600
                    Top =2520
                    Width =479
                    Height =420
                    TabIndex =28
                    Name ="d31"
                    Caption ="1"
                    OnClick ="[Event Procedure]"
                End
                    OverlapFlags =85
                    Left =1080
                    Top =2520
                    Width =479
                    Height =420
                    TabIndex =29
                    Name ="d32"
                    Caption ="1"
                    OnClick ="[Event Procedure]"
                End
                    OverlapFlags =85
                    Left =1560
                    Top =2520
                    Width =479
                    Height =420
                    TabIndex =30
                    Name ="d33"
                    Caption ="1"
                    OnClick ="[Event Procedure]"
                End
                    OverlapFlags =85
                    Left =2040
                    Top =2520
                    Width =479
                    Height =420
                    TabIndex =31
                    Name ="d34"
                    Caption ="1"
                    OnClick ="[Event Procedure]"
                End
                    OverlapFlags =85
                    Left =2520
                    Top =2520
                    Width =479
                    Height =420
                    TabIndex =32
                    Name ="d35"
                    Caption ="1"
                    OnClick ="[Event Procedure]"
                End
                    OverlapFlags =85
                    Left =3000
                    Top =2520
                    Width =479
                    Height =420
                    TabIndex =33
                    Name ="d36"
                    Caption ="1"
                    OnClick ="[Event Procedure]"
                End
                    OverlapFlags =85
                    Left =120
                    Top =2940
                    Width =479
                    Height =420
                    TabIndex =34
                    Name ="d40"
                    Caption ="1"
                    OnClick ="[Event Procedure]"
                End
                    OverlapFlags =85
                    Left =600
                    Top =2940
                    Width =479
                    Height =420
                    TabIndex =35
                    Name ="d41"
                    Caption ="1"
                    OnClick ="[Event Procedure]"
                End
                    OverlapFlags =85
                    Left =1080
                    Top =2940
                    Width =479
                    Height =420
                    TabIndex =36
                    Name ="d42"
                    Caption ="1"
                    OnClick ="[Event Procedure]"
                End
                    OverlapFlags =85
                    Left =1560
                    Top =2940
                    Width =479
                    Height =420
                    TabIndex =37
                    Name ="d43"
                    Caption ="1"
                    OnClick ="[Event Procedure]"
                End
                    OverlapFlags =85
                    Left =2040
                    Top =2940
                    Width =479
                    Height =420
                    TabIndex =38
                    Name ="d44"
                    Caption ="1"
                    OnClick ="[Event Procedure]"
                End
                    OverlapFlags =85
                    Left =2520
                    Top =2940
                    Width =479
                    Height =420
                    TabIndex =39
                    Name ="d45"
                    Caption ="1"
                    OnClick ="[Event Procedure]"
                End
                    OverlapFlags =85
                    Left =3000
                    Top =2940
                    Width =479
                    Height =420
                    TabIndex =40
                    Name ="d46"
                    Caption ="1"
                    OnClick ="[Event Procedure]"
                End
                    OverlapFlags =85
                    Left =120
                    Top =3360
                    Width =479
                    Height =420
                    TabIndex =41
                    Name ="d50"
                    Caption ="1"
                    OnClick ="[Event Procedure]"
                End
                    OverlapFlags =85
                    Left =600
                    Top =3360
                    Width =479
                    Height =420
                    TabIndex =42
                    Name ="d51"
                    Caption ="1"
                    OnClick ="[Event Procedure]"
                End
                    OverlapFlags =85
                    Left =1080
                    Top =3360
                    Width =479
                    Height =420
                    TabIndex =43
                    Name ="d52"
                    Caption ="1"
                    OnClick ="[Event Procedure]"
                End
                    OverlapFlags =85
                    Left =1560
                    Top =3360
                    Width =479
                    Height =420
                    TabIndex =44
                    Name ="d53"
                    Caption ="1"
                    OnClick ="[Event Procedure]"
                End
                    OverlapFlags =85
                    Left =2040
                    Top =3360
                    Width =479
                    Height =420
                    TabIndex =45
                    Name ="d54"
                    Caption ="1"
                    OnClick ="[Event Procedure]"
                End
                    OverlapFlags =85
                    Left =2520
                    Top =3360
                    Width =479
                    Height =420
                    TabIndex =46
                    Name ="d55"
                    Caption ="1"
                    OnClick ="[Event Procedure]"
                End
                    OverlapFlags =85
                    Left =3000
                    Top =3360
                    Width =479
                    Height =420
                    TabIndex =47
                    Name ="d56"
                    Caption ="1"
                    OnClick ="[Event Procedure]"
                End
                    Cancel = NotDefault
                    OverlapFlags =85
                    Left =2700
                    Top =3900
                    Width =735
                    TabIndex =48
                    Name ="cmdCancel"
                    Caption ="Cancel"
                    OnClick ="[Event Procedure]"
                End
            End
        End
    End
End
CodeBehindForm
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

' +-----------------------------------------------------------
' |
' |  Form_DatePicker
' |

' This modal dialog box prompts for a date. See documentation
' in mdlDatePicker.

Option Compare Database
Option Explicit

Private myDate As Date     ' current date
Private myYear As Integer  ' current year
Private myMonth As Integer ' current month
Private myDay As Integer   ' current day of month
Private cmdCurrentDay As CommandButton ' day button corresponding to myDay

' +-----------------------------------------------------------
' |
' |  methods to handle opening and closing
' |

Private Sub Form_Open(Cancel As Integer)
' initialize null return value
mdlDatePicker.ReturnValue = Null

If Not mdlDatePicker.Running Then
    MsgBox _
        "This form is not meant to be used independently. " & _
        "Please read the documentation in the module " & _
        "mdlDatePicker."
    Cancel = -1
End If

' set dialog box caption
Me.Caption = mdlDatePicker.Prompt

' if there is a valid date to initialize to, use it.
' otherwise, default to current date
If IsDate(mdlDatePicker.InitDate) Then
    myDate = mdlDatePicker.InitDate
Else
    myDate = Date
End If

' Set myYear, myMonth, and myDay according to myDate and
' draw calendar grid.
DateToElements

' If possible, set focus on the date button corresponding
' to myDay.
If Not cmdCurrentDay Is Nothing Then cmdCurrentDay.SetFocus
End Sub

' Set return value and close dialog box (allow calling
' procedure to continue.
Private Sub Done(Optional Cancel As Boolean = False)
If Not Cancel Then
    mdlDatePicker.ReturnValue = myDate
End If
Me.Visible = False
End Sub

' Cancel button quits without returning a value
Private Sub cmdCancel_Click()
Done Cancel:=True
End Sub


' +-----------------------------------------------------------
' |
' |  house-keeping methods
' |

' This method is called when myDate has been changed. It
' reflects that change in myYear, myMonth, and myDay.
Private Sub DateToElements()
myYear = Year(myDate)
myMonth = month(myDate)
myDay = Day(myDate)

txtYear = myYear
cboMonth = myMonth

DrawDateButtons
End Sub

' This method is called when myYear, myMonth, or myDay have
' been changed. It reflects that change in myDate.
Private Sub ElementsToDate()
myDate = DateSerial(myYear, myMonth, myDay)

DrawDateButtons
End Sub

' This method draws the date buttons on the 7 x 6 grid.
Private Sub DrawDateButtons()
Dim MonthDayOne As Date, MonthLength As Integer, DayOfWeek As Integer
Dim i As Integer, y As Integer, x As Integer, btn As CommandButton

' first day of this month:
MonthDayOne = DateSerial(myYear, myMonth, 1)
' day of week (Sun = 1) on which the first of the month falls:
DayOfWeek = DatePart("w", MonthDayOne, vbSunday)
' length of this month:
MonthLength = DatePart("d", DateAdd("d", -1, DateAdd("m", 1, MonthDayOne)))

' Initialize i to be what day of the month button (0, 0) will
' be on. If the first of the month is Sun, start with i = 1.
' If the first of the month is Mon or Tue, start with i = 0 or
' i = -1, respectively.

' y and x count the current row and column where we are on the
' grid.

Set cmdCurrentDay = Nothing
i = 2 - DayOfWeek
For y = 0 To 5
    For x = 0 To 6
        Set btn = Me.Controls("d" & y & x)
        ' If i falls within legal days for this month, show
        ' this button.
        If (i >= 1) And (i <= MonthLength) Then
            btn.Caption = i
            btn.Tag = i
            btn.Visible = True
        ' If i isn't a legal day, hide this button.
        Else
            btn.Visible = False
        End If
        ' If we've arrived at myDay, make a note so we can
        ' later set focus on this button.
        If i = myDay Then Set cmdCurrentDay = btn
        ' Advance to next day.
        i = i + 1
    Next
Next

End Sub


' +-----------------------------------------------------------
' |
' |  handle on on-screen year and month controls
' |

' Year control: previous button, textbox, and next button
Private Sub cmdPrevYear_Click()
myDate = DateAdd("yyyy", -1, myDate) 'go back one year
DateToElements
DoEvents
End Sub
Private Sub txtYear_AfterUpdate()
myYear = txtYear.Value
ElementsToDate
End Sub
Private Sub cmdNextYear_Click()
myDate = DateAdd("yyyy", 1, myDate) 'go forward one year
DateToElements
DoEvents
End Sub

' Month control: previous button, textbox, and next button
Private Sub cmdPrevMonth_Click()
myDate = DateAdd("m", -1, myDate) 'go back one month
DateToElements
DoEvents
End Sub
Private Sub cboMonth_AfterUpdate()
myMonth = cboMonth.Value
ElementsToDate
End Sub
Private Sub cmdNextMonth_Click()
myDate = DateAdd("m", 1, myDate) 'go forward one month
DateToElements
DoEvents
End Sub


' +-----------------------------------------------------------
' |
' |  handle the buttons on the calendar grid
' |

Private Sub DateClick(num As String)
myDay = Me.Controls("d" & num).Tag
ElementsToDate
Done ' return to the procedure that called the calendar form
End Sub

' date picker buttons
Private Sub d00_Click()
DateClick "00"
End Sub
Private Sub d01_Click()
DateClick "01"
End Sub
Private Sub d02_Click()
DateClick "02"
End Sub
Private Sub d03_Click()
DateClick "03"
End Sub
Private Sub d04_Click()
DateClick "04"
End Sub
Private Sub d05_Click()
DateClick "05"
End Sub
Private Sub d06_Click()
DateClick "06"
End Sub
Private Sub d10_Click()
DateClick "10"
End Sub
Private Sub d11_Click()
DateClick "11"
End Sub
Private Sub d12_Click()
DateClick "12"
End Sub
Private Sub d13_Click()
DateClick "13"
End Sub
Private Sub d14_Click()
DateClick "14"
End Sub
Private Sub d15_Click()
DateClick "15"
End Sub
Private Sub d16_Click()
DateClick "16"
End Sub
Private Sub d20_Click()
DateClick "20"
End Sub
Private Sub d21_Click()
DateClick "21"
End Sub
Private Sub d22_Click()
DateClick "22"
End Sub
Private Sub d23_Click()
DateClick "23"
End Sub
Private Sub d24_Click()
DateClick "24"
End Sub
Private Sub d25_Click()
DateClick "25"
End Sub
Private Sub d26_Click()
DateClick "26"
End Sub
Private Sub d30_Click()
DateClick "30"
End Sub
Private Sub d31_Click()
DateClick "31"
End Sub
Private Sub d32_Click()
DateClick "32"
End Sub
Private Sub d33_Click()
DateClick "33"
End Sub
Private Sub d34_Click()
DateClick "34"
End Sub
Private Sub d35_Click()
DateClick "35"
End Sub
Private Sub d36_Click()
DateClick "36"
End Sub
Private Sub d40_Click()
DateClick "40"
End Sub
Private Sub d41_Click()
DateClick "41"
End Sub
Private Sub d42_Click()
DateClick "42"
End Sub
Private Sub d43_Click()
DateClick "43"
End Sub
Private Sub d44_Click()
DateClick "44"
End Sub
Private Sub d45_Click()
DateClick "45"
End Sub
Private Sub d46_Click()
DateClick "46"
End Sub
Private Sub d50_Click()
DateClick "50"
End Sub
Private Sub d51_Click()
DateClick "51"
End Sub
Private Sub d52_Click()
DateClick "52"
End Sub
Private Sub d53_Click()
DateClick "53"
End Sub
Private Sub d54_Click()
DateClick "54"
End Sub
Private Sub d55_Click()
DateClick "55"
End Sub
Private Sub d56_Click()
DateClick "56"
End Sub

A source/forms/Switchboard.bas => source/forms/Switchboard.bas +502 -0
@@ 0,0 1,502 @@
Version =19
VersionRequired =19
    AllowFilters = NotDefault
    RecordSelectors = NotDefault
    ShortcutMenu = NotDefault
    AutoCenter = NotDefault
    NavigationButtons = NotDefault
    AllowDeletions = NotDefault
    AllowAdditions = NotDefault
    FilterOn = NotDefault
    AllowEdits = NotDefault
    AllowDesignChanges = NotDefault
    DefaultView =0
    ScrollBars =0
    TabularFamily =0
    PictureAlignment =2
    DatasheetGridlinesBehavior =3
    GridX =24
    GridY =24
    Width =7740
    DatasheetFontHeight =10
    ItemSuffix =22
    Left =2925
    Top =1245
    Right =10425
    Bottom =5760
    DatasheetGridlinesColor =12632256
    Filter ="[ItemNumber] = 0 AND [Argument] = 'Default' "
        0xf9fea4ddd667e240
    End
    RecordSource ="Switchboard Items"
    Caption ="Switchboard"
    OnCurrent ="[Event Procedure]"
    OnOpen ="[Event Procedure]"
    DatasheetFontName ="Arial"
        0xa0050000a0050000a0050000a005000000000000201c0000e010000001000000 ,
        0x010000006801000000000000a10700000100000001000000
    End
            BackStyle =0
            FontName ="Tahoma"
        End
            SpecialEffect =3
            BackStyle =0
        End
            BackStyle =0
            OldBorderStyle =0
            PictureAlignment =2
        End
            FontSize =8
            FontWeight =400
            ForeColor =-2147483630
            FontName ="Tahoma"
        End
            Height =4770
            BackColor =-2147483633
            Name ="Detail"
                    SpecialEffect =0
                    BackStyle =1
                    OldBorderStyle =0
                    OverlapFlags =93
                    Left =2355
                    Width =378
                    Height =4770
                    BackColor =8421504
                    Name ="VerticalShadowBox"
                End
                    OverlapFlags =93
                    TextFontFamily =18
                    Left =2997
                    Top =465
                    Width =4410
                    Height =450
                    FontSize =18
                    ForeColor =8421504
                    Name ="Label2"
                    Caption ="Address Book Database"
                    FontName ="Times New Roman"
                End
                    OverlapFlags =85
                    Left =3030
                    Top =1305
                    Width =259
                    Height =259
                    FontSize =10
                    ForeColor =0
                    Name ="Option1"
                    OnClick ="=HandleButtonClick(1)"
                    FontName ="System"
                            OverlapFlags =85
                            Left =3390
                            Top =1305
                            Width =3990
                            Height =240
                            ForeColor =-2147483630
                            Name ="OptionLabel1"
                            FontName ="MS Sans Serif"
                            OnClick ="=HandleButtonClick(1)"
                        End
                    End
                End
                    Visible = NotDefault
                    OverlapFlags =85
                    Left =3030
                    Top =1725
                    Width =259
                    Height =259
                    FontSize =10
                    TabIndex =1
                    ForeColor =0
                    Name ="Option2"
                    OnClick ="=HandleButtonClick(2)"
                    FontName ="System"
                            Visible = NotDefault
                            OverlapFlags =85
                            Left =3390
                            Top =1725
                            Width =3990
                            Height =240
                            ForeColor =-2147483630
                            Name ="OptionLabel2"
                            FontName ="MS Sans Serif"
                            OnClick ="=HandleButtonClick(2)"
                        End
                    End
                End
                    Visible = NotDefault
                    OverlapFlags =85
                    Left =3030
                    Top =2145
                    Width =259
                    Height =259
                    FontSize =10
                    TabIndex =2
                    ForeColor =0
                    Name ="Option3"
                    OnClick ="=HandleButtonClick(3)"
                    FontName ="System"
                            Visible = NotDefault
                            OverlapFlags =85
                            Left =3390
                            Top =2145
                            Width =3990
                            Height =240
                            ForeColor =-2147483630
                            Name ="OptionLabel3"
                            FontName ="MS Sans Serif"
                            OnClick ="=HandleButtonClick(3)"
                        End
                    End
                End
                    Visible = NotDefault
                    OverlapFlags =85
                    Left =3030
                    Top =2565
                    Width =259
                    Height =259
                    FontSize =10
                    TabIndex =3
                    ForeColor =0
                    Name ="Option4"
                    OnClick ="=HandleButtonClick(4)"
                    FontName ="System"
                            Visible = NotDefault
                            OverlapFlags =85
                            Left =3390
                            Top =2565
                            Width =3990
                            Height =240
                            ForeColor =-2147483630
                            Name ="OptionLabel4"
                            FontName ="MS Sans Serif"
                            OnClick ="=HandleButtonClick(4)"
                        End
                    End
                End
                    Visible = NotDefault
                    OverlapFlags =85
                    Left =3030
                    Top =2985
                    Width =259
                    Height =259
                    FontSize =10
                    TabIndex =4
                    ForeColor =0
                    Name ="Option5"
                    OnClick ="=HandleButtonClick(5)"
                    FontName ="System"
                            Visible = NotDefault
                            OverlapFlags =85
                            Left =3390
                            Top =2985
                            Width =3990
                            Height =240
                            ForeColor =-2147483630
                            Name ="OptionLabel5"
                            FontName ="MS Sans Serif"
                            OnClick ="=HandleButtonClick(5)"
                        End
                    End
                End
                    Visible = NotDefault
                    OverlapFlags =85
                    Left =3030
                    Top =3405
                    Width =259
                    Height =259
                    FontSize =10
                    TabIndex =5
                    ForeColor =0
                    Name ="Option6"
                    OnClick ="=HandleButtonClick(6)"
                    FontName ="System"
                            Visible = NotDefault
                            OverlapFlags =85
                            Left =3390
                            Top =3405
                            Width =3990
                            Height =240
                            ForeColor =-2147483630
                            Name ="OptionLabel6"
                            FontName ="MS Sans Serif"
                            OnClick ="=HandleButtonClick(6)"
                        End
                    End
                End
                    Visible = NotDefault
                    OverlapFlags =85
                    Left =3030
                    Top =3825
                    Width =259
                    Height =259
                    FontSize =10
                    TabIndex =6
                    ForeColor =0
                    Name ="Option7"
                    OnClick ="=HandleButtonClick(7)"
                    FontName ="System"
                            Visible = NotDefault
                            OverlapFlags =85
                            Left =3390
                            Top =3825
                            Width =3990
                            Height =240
                            ForeColor =-2147483630
                            Name ="OptionLabel7"
                            FontName ="MS Sans Serif"
                            OnClick ="=HandleButtonClick(7)"
                        End
                    End
                End
                    Visible = NotDefault
                    OverlapFlags =85
                    Left =3030
                    Top =4245
                    Width =259
                    Height =259
                    FontSize =10
                    TabIndex =7
                    ForeColor =0
                    Name ="Option8"
                    OnClick ="=HandleButtonClick(8)"
                    FontName ="System"
                            Visible = NotDefault
                            OverlapFlags =85
                            Left =3390
                            Top =4245
                            Width =3990
                            Height =240
                            ForeColor =-2147483630
                            Name ="OptionLabel8"
                            FontName ="MS Sans Serif"
                            OnClick ="=HandleButtonClick(8)"
                        End
                    End
                End
                    SpecialEffect =0
                    BackStyle =1
                    OverlapFlags =223
                    Width =7380
                    Height =660
                    BackColor =8421376
                    BorderColor =8421376
                    Name ="HorizontalHeaderBox"
                End
                    OverlapFlags =215
                    TextFontFamily =18
                    Left =2955
                    Top =420
                    Width =4410
                    Height =450
                    FontSize =18
                    ForeColor =16777215
                    Name ="Label1"
                    Caption ="Address Book Database"
                    FontName ="Times New Roman"
                End
                    OverlapFlags =95
                    SpecialEffect =1
                    Left =2685
                    Top =1155
                    Width =4698
                    Name ="HorizontalDividingLine"
                End
                    BackStyle =1
                    SizeMode =1
                    Width =2685
                    Height =4770
                    BackColor =8421376
                    Name ="Picture"
                End
            End
        End
    End
End
CodeBehindForm
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Compare Database

Private Sub Form_Open(Cancel As Integer)
' Minimize the database window and initialize the form.

    ' Move to the switchboard page that is marked as the default.
    Me.Filter = "[ItemNumber] = 0 AND [Argument] = 'Default' "
    Me.FilterOn = True
    
End Sub

Private Sub Form_Current()
' Update the caption and fill in the list of options.

    Me.Caption = Nz(Me![ItemText], "")
    FillOptions
    
End Sub

Private Sub FillOptions()
' Fill in the options for this switchboard page.

    ' The number of buttons on the form.
    Const conNumButtons = 8
    
    Dim con As Object
    Dim rs As Object
    Dim stSql As String
    Dim intOption As Integer
    
    ' Set the focus to the first button on the form,
    ' and then hide all of the buttons on the form
    ' but the first.  You can't hide the field with the focus.
    Me![Option1].SetFocus
    For intOption = 2 To conNumButtons
        Me("Option" & intOption).Visible = False
        Me("OptionLabel" & intOption).Visible = False
    Next intOption
    
    ' Open the table of Switchboard Items, and find
    ' the first item for this Switchboard Page.
    Set con = Application.CurrentProject.Connection
    stSql = "SELECT * FROM [Switchboard Items]"
    stSql = stSql & " WHERE [ItemNumber] > 0 AND [SwitchboardID]=" & Me![SwitchboardID]
    stSql = stSql & " ORDER BY [ItemNumber];"
    Set rs = CreateObject("ADODB.Recordset")
    rs.Open stSql, con, 1   ' 1 = adOpenKeyset
    
    ' If there are no options for this Switchboard Page,
    ' display a message.  Otherwise, fill the page with the items.
    If (rs.EOF) Then
        Me![OptionLabel1].Caption = "There are no items for this switchboard page"
    Else
        While (Not (rs.EOF))
            Me("Option" & rs![ItemNumber]).Visible = True
            Me("OptionLabel" & rs![ItemNumber]).Visible = True
            Me("OptionLabel" & rs![ItemNumber]).Caption = rs![ItemText]
            rs.MoveNext
        Wend
    End If

    ' Close the recordset and the database.
    rs.Close
    Set rs = Nothing
    Set con = Nothing

End Sub

Private Function HandleButtonClick(intBtn As Integer)
' This function is called when a button is clicked.
' intBtn indicates which button was clicked.

    ' Constants for the commands that can be executed.
    Const conCmdGotoSwitchboard = 1
    Const conCmdOpenFormAdd = 2
    Const conCmdOpenFormBrowse = 3
    Const conCmdOpenReport = 4
    Const conCmdCustomizeSwitchboard = 5
    Const conCmdExitApplication = 6
    Const conCmdRunMacro = 7
    Const conCmdRunCode = 8
    Const conCmdOpenPage = 9

    ' An error that is special cased.
    Const conErrDoCmdCancelled = 2501
    
    Dim con As Object
    Dim rs As Object
    Dim stSql As String

On Error GoTo HandleButtonClick_Err

    ' Find the item in the Switchboard Items table
    ' that corresponds to the button that was clicked.
    Set con = Application.CurrentProject.Connection
    Set rs = CreateObject("ADODB.Recordset")
    stSql = "SELECT * FROM [Switchboard Items] "
    stSql = stSql & "WHERE [SwitchboardID]=" & Me![SwitchboardID] & " AND [ItemNumber]=" & intBtn
    rs.Open stSql, con, 1    ' 1 = adOpenKeyset
    
    ' If no item matches, report the error and exit the function.
    If (rs.EOF) Then
        MsgBox "There was an error reading the Switchboard Items table."
        rs.Close
        Set rs = Nothing
        Set con = Nothing
        Exit Function
    End If
    
    Select Case rs![Command]
        
        ' Go to another switchboard.
        Case conCmdGotoSwitchboard
            Me.Filter = "[ItemNumber] = 0 AND [SwitchboardID]=" & rs![Argument]
            
        ' Open a form in Add mode.
        Case conCmdOpenFormAdd
            DoCmd.OpenForm rs![Argument], , , , acAdd

        ' Open a form.
        Case conCmdOpenFormBrowse
            DoCmd.OpenForm rs![Argument]

        ' Open a report.
        Case conCmdOpenReport
            DoCmd.OpenReport rs![Argument], acPreview

        ' Customize the Switchboard.
        Case conCmdCustomizeSwitchboard
            ' Handle the case where the Switchboard Manager
            ' is not installed (e.g. Minimal Install).
            On Error Resume Next
            Application.Run "ACWZMAIN.sbm_Entry"
            If (Err <> 0) Then MsgBox "Command not available."
            On Error GoTo 0
            ' Update the form.
            Me.Filter = "[ItemNumber] = 0 AND [Argument] = 'Default' "
            Me.Caption = Nz(Me![ItemText], "")
            FillOptions

        ' Exit the application.
        Case conCmdExitApplication
            CloseCurrentDatabase

        ' Run a macro.
        Case conCmdRunMacro
            DoCmd.RunMacro rs![Argument]

        ' Run code.
        Case conCmdRunCode
            Application.Run rs![Argument]

        ' Open a Data Access Page
        Case conCmdOpenPage
            DoCmd.OpenDataAccessPage rs![Argument]

        ' Any other command is unrecognized.
        Case Else
            MsgBox "Unknown option."
    
    End Select

    ' Close the recordset and the database.
    rs.Close
    
HandleButtonClick_Exit:
On Error Resume Next
    Set rs = Nothing
    Set con = Nothing
    Exit Function

HandleButtonClick_Err:
    ' If the action was cancelled by the user for
    ' some reason, don't display an error message.
    ' Instead, resume on the next line.
    If (Err = conErrDoCmdCancelled) Then
        Resume Next
    Else
        MsgBox "There was an error executing the command.", vbCritical
        Resume HandleButtonClick_Exit
    End If
    
End Function

A source/forms/Upload.bas => source/forms/Upload.bas +261 -0
@@ 0,0 1,261 @@
Version =19
VersionRequired =19
    PopUp = NotDefault
    Modal = NotDefault
    RecordSelectors = NotDefault
    AutoCenter = NotDefault
    NavigationButtons = NotDefault
    DividingLines = NotDefault
    AllowDesignChanges = NotDefault
    DefaultView =0
    ScrollBars =0
    ViewsAllowed =1
    TabularFamily =55
    BorderStyle =3
    PictureAlignment =2
    DatasheetGridlinesBehavior =3
    GridX =24
    GridY =24
    Width =4320
    DatasheetFontHeight =10
    ItemSuffix =6
    Left =5340
    Top =2670
    Right =9660
    Bottom =4095
    DatasheetGridlinesColor =12632256
        0xbe7bd062f767e240
    End
    Caption ="Upload Data to FTP Server"
    DatasheetFontName ="Arial"
            BackStyle =0
            FontName ="Tahoma"
        End
            FontSize =8
            FontWeight =400
            ForeColor =-2147483630
            FontName ="Tahoma"
        End
            FELineBreak = NotDefault
            SpecialEffect =2
            OldBorderStyle =0
            FontName ="Tahoma"
        End
            BackColor =-2147483633
            Name ="Detail"
                    OverlapFlags =85
                    Left =120
                    Top =120
                    Width =4020
                    Height =630
                    Name ="Label2"
                    Caption ="This function will upload the the data (contained in the file data.mdb) to the F"
                        "TP server. Please be sure you are connected to the Internet before you proceed."
                End
                    Default = NotDefault
                    OverlapFlags =85
                    AccessKey =71
                    Left =2880
                    Top =840
                    Width =435
                    Height =405
                    Name ="cmdGo"
                    Caption ="&Go"
                    OnClick ="[Event Procedure]"
                End
                    Cancel = NotDefault
                    OverlapFlags =85
                    Left =3480
                    Top =840
                    Width =630
                    Height =405
                    TabIndex =1
                    Name ="cmdClose"
                    Caption ="Close"
                    OnClick ="[Event Procedure]"
                End
            End
        End
    End
End
CodeBehindForm
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Compare Database
Option Explicit

Private OutFile As String

Private Sub cmdGo_Click()

If RunningOnUNC Then
    MsgBox _
        "In order to use this function, the database must be running from a " & _
        "folder starting with a drive letter, and not a network share " & _
        "starting with ""\\"". If you wish to run this application from " & _
        "a network share, please connect it to a drive letter first.", _
        vbCritical
    Exit Sub
End If

' initialize output file name used in Encrypt() and Upload()
' format is
'    [FILENAME_BASE]_[current date].gpg
OutFile = FILENAME_BASE & "_" & Format(Now, "yyyy-mm-dd") & ".gpg"

' compact data in data.mdb for more efficient upload
Compact

' encrypt data.mdb to outFile
Encrypt

' upload outFile
Upload

End Sub

Private Sub Compact()

' set hourglass cursor and set status bar
Screen.MousePointer = 11
SysCmd acSysCmdSetStatus, "Compacting data file..."

' compact data.mdb to data1.mdb
DBEngine.CompactDatabase CurrentDBDir & "data.mdb", CurrentDBDir & "data1.mdb"

' delete data.mdb
FileSys.DeleteFile CurrentDBDir & "data.mdb"

' rename data1.mdb to data.mdb
FileSys.MoveFile CurrentDBDir & "data1.mdb", CurrentDBDir & "data.mdb"

' reset cursor and status bar
Screen.MousePointer = 0
SysCmd acSysCmdClearStatus

End Sub

Private Sub Encrypt()

Dim cmd As String

' set hourglass cursor and set status bar
Screen.MousePointer = 11
SysCmd acSysCmdSetStatus, "Encrypting data file..."

' GPG options and commands used:
'    --homedir .                   set GPG data folder to current folder
'                                  (for keys, etc)
'    --recipient "GPG_RECIPIENT"   encrypt file using GPG_RECIPIENT's key
'    --output "outFile"            set output file
'    --yes                         anwer yes to any interactive questions
'    --encrypt data.mdb            command: encrypt data.mdb
cmd = "gpg " & _
    "--homedir . " & _
    "--recipient """ & GPG_RECIPIENT & """ " & _
    "--output """ & OutFile & """ " & _
    "--yes " & _
    "--encrypt data.mdb"

' write cmd to batch file
writeTextFile CurrentDBDir & "encrypt.bat", _
    "cd /d """ & CurrentDBDir & """" & vbCrLf & _
    cmd & vbCrLf
' execute batch file
ShellWait CurrentDBDir & "encrypt.bat", vbNormalFocus
' delete batch file
FileSys.DeleteFile CurrentDBDir & "encrypt.bat"

' reset cursor and status bar
Screen.MousePointer = 0
SysCmd acSysCmdClearStatus

End Sub

Private Sub Upload()

Dim log As String

' set hourglass cursor and set status bar
Screen.MousePointer = 11
SysCmd acSysCmdSetStatus, "Uploading to FTP server..."

' write FTP command script to ftp.script
writeTextFile CurrentDBDir & "ftp.script", _
    "open " & FTP_SERVER & " " & FTP_PORT & vbCrLf & _
    FTP_USER & vbCrLf & _
    FTP_PASSWORD & vbCrLf & _
    "cd """ & FTP_FOLDER & """" & vbCrLf & _
    "bin" & vbCrLf & _
    "put """ & OutFile & """" & vbCrLf & _
    "quit" & vbCrLf

' write batch file that uses Windows' FTP command with above script and
' saves output to ftp.log
writeTextFile CurrentDBDir & "upload.bat", _
    "cd /d """ & CurrentDBDir & """" & vbCrLf & _
    "ftp -s:ftp.script >ftp.log" & vbCrLf

Do
    ' set hourglass cursor
    Screen.MousePointer = 11
    
    ' execute FTP batch file
    ShellWait CurrentDBDir & "upload.bat", vbNormalFocus
    
    ' read log file
    log = readTextFile(CurrentDBDir & "ftp.log")
    
    ' reset cursor for the following interaction
    Screen.MousePointer = 0
    
    If InStr(log, "226 Transfer complete.") Then
        ' FTP was successful. announce and BREAK FROM LOOP
        MsgBox "The data was uploaded successfully.", vbInformation
        Exit Do
    Else
        ' FTP failed. offer retry
        If MsgBox("The data was not uploaded successfully. Try again?", _
            vbRetryCancel Or vbCritical) = vbCancel Then
            
            ' user chose Cancel. offer to show log file
            
            If MsgBox("Would you like to see the log file?", _
                vbYesNo Or vbQuestion) = vbYes Then
                
                ' user chose to show log file
                Shell "notepad """ & CurrentDBDir & "ftp.log""", vbNormalFocus
            End If

            ' BREAK FROM LOOP because user chose Cancel
            Exit Do
        End If
    End If

    ' loop back and execute FTP script again after failure
Loop

' delete batch file and FTP script
FileSys.DeleteFile CurrentDBDir & "upload.bat"
FileSys.DeleteFile CurrentDBDir & "ftp.script"

' reset status bar
SysCmd acSysCmdClearStatus

End Sub
Private Sub cmdClose_Click()
On Error GoTo Err_cmdClose_Click


    DoCmd.Close

Exit_cmdClose_Click:
    Exit Sub

Err_cmdClose_Click:
    MsgBox Err.description
    Resume Exit_cmdClose_Click
    
End Sub

A source/macros/autoexec.bas => source/macros/autoexec.bas +23 -0
@@ 0,0 1,23 @@
Version =196611
ColumnsShown =0
End
End
End
    Action ="OpenForm"
    Comment ="show About"
    Argument ="About"
    Argument ="0"
    Argument =""
    Argument =""
    Argument ="-1"
    Argument ="0"
End
    Action ="OpenForm"
    Comment ="show Switchboard"
    Argument ="Switchboard"
    Argument ="0"
    Argument =""
    Argument =""
    Argument ="-1"
    Argument ="0"
End

A source/modules/mdlDatePicker.bas => source/modules/mdlDatePicker.bas +118 -0
@@ 0,0 1,118 @@
' +-----------------------------------------------------------
' |
' |  mdlDatePicker
' |

' Copyright (c) 2003 Brendan Kidwell

' The latest version of this software can be found at
' http://www.glump.net/content/accessdatepicker/ .

' ------------------------------------------------------------
' This module and its accompanying form provides a convenient
' way to input dates into your program. It is licensed under
' the Open Software License version 1.1. Please See
' http://opensource.org/licenses/osl.php .
' ------------------------------------------------------------

' Usage
' -----
'
' From a form:
'
'    InputDateField(t[, p])
'
'       t is a TextBox on your form
'       p is an optional String with a custom prompt.
'
'    Example:
'       Private Sub cmdLogEntryDate_Click()
'          InputDateField txtLogEntryDate, _
'             "Select Log Entry Date"
'       End Sub
'
'
' From a procedure:
'
'    d = InputDate([p][, initd])
'
'       p is an optional String with a custom prompt
'       initd is an optional Variant with the initial date for
'          the dialog box
'       d is a Variant that will receive either Null or the
'          selected date
'
'    Example:
'       Dim d As Variant
'       d = InputDate
'       If IsDate(d) Then
'          MsgBox "You chose " & d & "."
'       Else
'          MsgBox "You hit the Cancel button."
'       End If

Option Compare Database
Option Explicit

Private mRunning As Boolean
Private mPrompt As String
Private mInitDate As Variant
Private mReturnValue As Variant

' +-----------------------------------------------------------
' |
' |  methods for using this module
' |

' Use this method to prompt for a date inside a procedure
Public Function InputDate(Optional Prompt As String = "Select Date", _
    Optional InitDate As Variant) As Variant

mPrompt = Prompt
mInitDate = InitDate

RunDialog

InputDate = mReturnValue
End Function

' Use this method to prompt for and set a new date on a textbox
Public Sub InputDateField(x As TextBox, Optional Prompt As String = "Select Date")
mPrompt = Prompt
mInitDate = x.Value

RunDialog

If IsDate(mReturnValue) Then
    x.Value = mReturnValue
End If
End Sub

Private Sub RunDialog()
mRunning = True
DoCmd.OpenForm "DatePicker", , , , , acDialog
DoCmd.Close acForm, "DatePicker"
mRunning = False
End Sub


' +-----------------------------------------------------------
' |
' |  properties for communicating with Form_DatePicker
' |

' DON'T MESS WITH THESE PROPERTIES. CALL InputDateField() OR
' InputDate() AS SHOWN ABOVE.

Public Property Get Running() As Boolean
Running = mRunning
End Property
Public Property Get Prompt() As String
Prompt = mPrompt
End Property
Public Property Get InitDate() As Variant
InitDate = mInitDate
End Property
Public Property Let ReturnValue(x As Variant)
mReturnValue = x
End Property
\ No newline at end of file

A source/modules/mdlFileStuff.bas => source/modules/mdlFileStuff.bas +28 -0
@@ 0,0 1,28 @@
Option Compare Database
Option Explicit

Private mFileSystem As New FileSystemObject

Public Property Get FileSys() As FileSystemObject
Set FileSys = mFileSystem
End Property

Public Sub writeTextFile(Path As String, text As String)
Dim o As TextStream

Set o = mFileSystem.OpenTextFile(Path, ForWriting, True)
o.write text
o.Close

Set o = Nothing
End Sub

Public Function readTextFile(Path As String) As String
Dim o As TextStream

Set o = mFileSystem.OpenTextFile(Path, ForReading)
readTextFile = o.ReadAll
o.Close

Set o = Nothing
End Function
\ No newline at end of file

A source/modules/mdlSettings.bas => source/modules/mdlSettings.bas +14 -0
@@ 0,0 1,14 @@
Option Compare Database
Option Explicit

Public Const FTP_SERVER = ""
Public Const FTP_PORT = "" ' leave blank for default port

Public Const FTP_USER = ""
Public Const FTP_PASSWORD = ""

' the folder where we should put the GPG file
Public Const FTP_FOLDER = ""

Public Const GPG_RECIPIENT = ""
Public Const FILENAME_BASE = "gpgdemo"
\ No newline at end of file

A source/modules/mdlShellWait.bas => source/modules/mdlShellWait.bas +74 -0
@@ 0,0 1,74 @@
Option Compare Database

'***************** Code Start ******************
'This code was originally written by Terry Kreft.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Terry Kreft
Private Const STARTF_USESHOWWINDOW& = &H1
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1&
Private Type STARTUPINFO
    cb As Long
    lpReserved As String
    lpDesktop As String
    lpTitle As String
    dwX As Long
    dwY As Long
    dwXSize As Long
    dwYSize As Long
    dwXCountChars As Long
    dwYCountChars As Long
    dwFillAttribute As Long
    dwFlags As Long
    wShowWindow As Integer
    cbReserved2 As Integer
    lpReserved2 As Long
    hStdInput As Long
    hStdOutput As Long
    hStdError As Long
End Type
Private Type PROCESS_INFORMATION
    hProcess As Long
    hThread As Long
    dwProcessID As Long
    dwThreadID As Long
End Type
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal _
    hHandle As Long, ByVal dwMilliseconds As Long) As Long
    
Private Declare Function CreateProcessA Lib "kernel32" (ByVal _
    lpApplicationName As Long, ByVal lpCommandLine As String, ByVal _
    lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _
    ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
    ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, _
    lpStartupInfo As STARTUPINFO, lpProcessInformation As _
    PROCESS_INFORMATION) As Long
    
Private Declare Function CloseHandle Lib "kernel32" (ByVal _
    hObject As Long) As Long
    
Public Sub ShellWait(Pathname As String, Optional WindowStyle As Long)
    Dim proc As PROCESS_INFORMATION
    Dim start As STARTUPINFO
    Dim Ret As Long
    ' Initialize the STARTUPINFO structure:
    With start
        .cb = Len(start)
        If Not IsMissing(WindowStyle) Then
            .dwFlags = STARTF_USESHOWWINDOW
            .wShowWindow = WindowStyle
        End If
    End With
    ' Start the shelled application:
    Ret& = CreateProcessA(0&, Pathname, 0&, 0&, 1&, _
            NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)
    ' Wait for the shelled application to finish:
    Ret& = WaitForSingleObject(proc.hProcess, INFINITE)
    Ret& = CloseHandle(proc.hProcess)
End Sub
'***************** Code End ****************
\ No newline at end of file

A source/modules/mdlWhereAmI.bas => source/modules/mdlWhereAmI.bas +42 -0
@@ 0,0 1,42 @@
Option Compare Database

Private mCurrentDBDir As String
Private mCurrentDB As Object

' The following function returns a string with a trailing "\" that
' that indicates the filesystem path where the database lives.

'Code courtesy of
'Terry Kreft & Ken Getz
' modified by Brendan Kidwell
'
Public Property Get CurrentDBDir() As String
Dim strDBPath As String
Dim strDBFile As String

If mCurrentDBDir = "" Then
    strDBPath = thisDb.Name
    strDBFile = Dir(strDBPath)
    mCurrentDBDir = Left(strDBPath, Len(strDBPath) - Len(strDBFile))
End If

CurrentDBDir = mCurrentDBDir

End Property

Public Property Get RunningOnUNC() As Boolean
RunningOnUNC = (Mid(CurrentDBDir, 2, 1) <> ":")
End Property

' The purpose of this read-only property is because I heard that every
' time you call CurrentDb, it creates yet another instance of the
' database object for the current database, in the database engine. So,
' I only want to call CurrentDb once. --Brendan
Public Property Get thisDb() As Object

If mCurrentDB Is Nothing Then
    Set mCurrentDB = CurrentDb
End If
Set thisDb = mCurrentDB

End Property
\ No newline at end of file

A source/tables/Switchboard Items.txt => source/tables/Switchboard Items.txt +5 -0
@@ 0,0 1,5 @@
SwitchboardID	ItemNumber	ItemText	Command	Argument
1	0	Main Switchboard		Default
1	1	Browse / &Edit Addresses	3	Addresses
1	2	&Upload Data to FTP Server	3	Upload
1	3	&About	3	About