开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Internet/网络编程 > Email服务器 > 查看源码
PhoneBook.frm
资源名称：电子邮件收发系统.rar　[点击查看]
上传用户：bcdefg2008
上传日期：2013-02-28
资源大小：144k
文件大小：39k
源码类别：

Email服务器

开发平台：

Visual Basic

PhoneBook.frm：源码内容
  1. VERSION 5.00
  2. Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "TABCTL32.OCX"
  3. Begin VB.Form PhoneBook 
  4.    BorderStyle     =   1  'Fixed Single
  5.    Caption         =   "通讯录"
  6.    ClientHeight    =   5355
  7.    ClientLeft      =   2415
  8.    ClientTop       =   2055
  9.    ClientWidth     =   6960
  10.    ClipControls    =   0   'False
  11.    Icon            =   "PhoneBook.frx":0000
  12.    LinkTopic       =   "Form1"
  13.    MaxButton       =   0   'False
  14.    MinButton       =   0   'False
  15.    ScaleHeight     =   5355
  16.    ScaleWidth      =   6960
  17.    StartUpPosition =   1  '所有者中心
  18.    Begin VB.CommandButton cmdEdit 
  19.       Enabled         =   0   'False
  20.       BeginProperty Font 
  21.          Name            =   "MS Sans Serif"
  22.          Size            =   8.25
  23.          Charset         =   0
  24.          Weight          =   700
  25.          Underline       =   0   'False
  26.          Italic          =   0   'False
  27.          Strikethrough   =   0   'False
  28.       EndProperty
  29.       Height          =   380
  30.       Index           =   4
  31.       Left            =   4200
  32.       TabIndex        =   20
  33.       ToolTipText     =   "Press to add a new post to the database"
  34.       Top             =   3120
  35.       Visible         =   0   'False
  36.       Width           =   2640
  37.    End
  38.    Begin VB.CommandButton cmdEdit 
  39.       Caption         =   "新增"
  40.       Enabled         =   0   'False
  41.       BeginProperty Font 
  42.          Name            =   "MS Sans Serif"
  43.          Size            =   8.25
  44.          Charset         =   0
  45.          Weight          =   700
  46.          Underline       =   0   'False
  47.          Italic          =   0   'False
  48.          Strikethrough   =   0   'False
  49.       EndProperty
  50.       Height          =   380
  51.       Index           =   3
  52.       Left            =   5400
  53.       TabIndex        =   17
  54.       ToolTipText     =   "Press to add a new post to the database"
  55.       Top             =   2640
  56.       Width           =   1440
  57.    End
  58.    Begin VB.CommandButton cmdEdit 
  59.       Caption         =   "删除"
  60.       Enabled         =   0   'False
  61.       BeginProperty Font 
  62.          Name            =   "MS Sans Serif"
  63.          Size            =   8.25
  64.          Charset         =   0
  65.          Weight          =   700
  66.          Underline       =   0   'False
  67.          Italic          =   0   'False
  68.          Strikethrough   =   0   'False
  69.       EndProperty
  70.       Height          =   380
  71.       Index           =   2
  72.       Left            =   4200
  73.       TabIndex        =   16
  74.       ToolTipText     =   "Press to delete the current Post"
  75.       Top             =   2640
  76.       Width           =   1200
  77.    End
  78.    Begin VB.CommandButton cmdEdit 
  79.       Caption         =   "清空"
  80.       Enabled         =   0   'False
  81.       BeginProperty Font 
  82.          Name            =   "MS Sans Serif"
  83.          Size            =   8.25
  84.          Charset         =   0
  85.          Weight          =   700
  86.          Underline       =   0   'False
  87.          Italic          =   0   'False
  88.          Strikethrough   =   0   'False
  89.       EndProperty
  90.       Height          =   380
  91.       Index           =   1
  92.       Left            =   5400
  93.       TabIndex        =   15
  94.       ToolTipText     =   "Press to enable AddNew"
  95.       Top             =   2280
  96.       Width           =   1440
  97.    End
  98.    Begin VB.CommandButton cmdEdit 
  99.       Caption         =   "保存"
  100.       Enabled         =   0   'False
  101.       BeginProperty Font 
  102.          Name            =   "MS Sans Serif"
  103.          Size            =   8.25
  104.          Charset         =   0
  105.          Weight          =   700
  106.          Underline       =   0   'False
  107.          Italic          =   0   'False
  108.          Strikethrough   =   0   'False
  109.       EndProperty
  110.       Height          =   380
  111.       Index           =   0
  112.       Left            =   4200
  113.       TabIndex        =   14
  114.       ToolTipText     =   "Press to update the current post"
  115.       Top             =   2280
  116.       Width           =   1200
  117.    End
  118.    Begin VB.Frame frmEditMode 
  119.       Caption         =   "模式"
  120.       BeginProperty Font 
  121.          Name            =   "MS Sans Serif"
  122.          Size            =   8.25
  123.          Charset         =   0
  124.          Weight          =   700
  125.          Underline       =   0   'False
  126.          Italic          =   0   'False
  127.          Strikethrough   =   0   'False
  128.       EndProperty
  129.       Height          =   495
  130.       Left            =   4200
  131.       TabIndex        =   11
  132.       Top             =   1680
  133.       Width           =   2655
  134.       Begin VB.OptionButton optEditMode 
  135.          Caption         =   "可编辑"
  136.          Enabled         =   0   'False
  137.          Height          =   195
  138.          Index           =   1
  139.          Left            =   1200
  140.          TabIndex        =   13
  141.          Top             =   240
  142.          Value           =   -1  'True
  143.          Width           =   1215
  144.       End
  145.       Begin VB.OptionButton optEditMode 
  146.          Caption         =   "只读"
  147.          Enabled         =   0   'False
  148.          Height          =   195
  149.          Index           =   0
  150.          Left            =   120
  151.          TabIndex        =   12
  152.          Top             =   240
  153.          Width           =   1095
  154.       End
  155.    End
  156.    Begin VB.Frame frmSearch 
  157.       Caption         =   "查询"
  158.       BeginProperty Font 
  159.          Name            =   "MS Sans Serif"
  160.          Size            =   8.25
  161.          Charset         =   0
  162.          Weight          =   700
  163.          Underline       =   0   'False
  164.          Italic          =   0   'False
  165.          Strikethrough   =   0   'False
  166.       EndProperty
  167.       Height          =   1695
  168.       Left            =   4200
  169.       TabIndex        =   2
  170.       Top             =   3600
  171.       Width           =   2655
  172.       Begin VB.OptionButton optSearch 
  173.          Caption         =   "手机"
  174.          Height          =   255
  175.          Index           =   7
  176.          Left            =   1200
  177.          TabIndex        =   19
  178.          Tag             =   "cellular"
  179.          Top             =   840
  180.          Width           =   1215
  181.       End
  182.       Begin VB.OptionButton optSearch 
  183.          Caption         =   "地址"
  184.          Height          =   255
  185.          Index           =   6
  186.          Left            =   120
  187.          TabIndex        =   18
  188.          Tag             =   "address"
  189.          Top             =   1320
  190.          Width           =   975
  191.       End
  192.       Begin VB.OptionButton optSearch 
  193.          Caption         =   "国家"
  194.          Height          =   255
  195.          Index           =   5
  196.          Left            =   1200
  197.          TabIndex        =   10
  198.          Tag             =   "country"
  199.          Top             =   1320
  200.          Width           =   975
  201.       End
  202.       Begin VB.OptionButton optSearch 
  203.          Caption         =   "城市"
  204.          Height          =   255
  205.          Index           =   4
  206.          Left            =   1200
  207.          TabIndex        =   9
  208.          Tag             =   "city"
  209.          Top             =   1080
  210.          Width           =   1215
  211.       End
  212.       Begin VB.OptionButton optSearch 
  213.          Caption         =   "电话"
  214.          Height          =   255
  215.          Index           =   3
  216.          Left            =   1200
  217.          TabIndex        =   8
  218.          Tag             =   "telphone"
  219.          Top             =   600
  220.          Width           =   1335
  221.       End
  222.       Begin VB.OptionButton optSearch 
  223.          Caption         =   "公司"
  224.          Height          =   255
  225.          Index           =   2
  226.          Left            =   120
  227.          TabIndex        =   7
  228.          Tag             =   "company"
  229.          Top             =   1080
  230.          Width           =   1095
  231.       End
  232.       Begin VB.OptionButton optSearch 
  233.          Caption         =   "名"
  234.          Height          =   255
  235.          Index           =   1
  236.          Left            =   120
  237.          TabIndex        =   6
  238.          Tag             =   "firstname"
  239.          Top             =   840
  240.          Width           =   1335
  241.       End
  242.       Begin VB.OptionButton optSearch 
  243.          Caption         =   "姓"
  244.          Height          =   255
  245.          Index           =   0
  246.          Left            =   120
  247.          TabIndex        =   5
  248.          Tag             =   "lastname"
  249.          Top             =   600
  250.          Value           =   -1  'True
  251.          Width           =   1215
  252.       End
  253.       Begin VB.CommandButton cmdSearch 
  254.          Caption         =   "查"
  255.          Enabled         =   0   'False
  256.          Height          =   300
  257.          Left            =   1800
  258.          TabIndex        =   4
  259.          Top             =   240
  260.          Width           =   495
  261.       End
  262.       Begin VB.TextBox txtSearch 
  263.          Height          =   285
  264.          Left            =   120
  265.          TabIndex        =   3
  266.          ToolTipText     =   "You can use % as wildcard"
  267.          Top             =   240
  268.          Width           =   1575
  269.       End
  270.    End
  271.    Begin VB.Frame frmSelPers 
  272.       Caption         =   "客户列表"
  273.       BeginProperty Font 
  274.          Name            =   "MS Sans Serif"
  275.          Size            =   8.25
  276.          Charset         =   0
  277.          Weight          =   700
  278.          Underline       =   0   'False
  279.          Italic          =   0   'False
  280.          Strikethrough   =   0   'False
  281.       EndProperty
  282.       Height          =   1575
  283.       Left            =   4200
  284.       TabIndex        =   0
  285.       Top             =   120
  286.       Width           =   2655
  287.       Begin VB.ListBox lstSelpers 
  288.          Height          =   1140
  289.          ItemData        =   "PhoneBook.frx":0442
  290.          Left            =   120
  291.          List            =   "PhoneBook.frx":0444
  292.          TabIndex        =   1
  293.          Top             =   240
  294.          Width           =   2175
  295.       End
  296.    End
  297.    Begin TabDlg.SSTab SSTab1 
  298.       Height          =   5175
  299.       Left            =   0
  300.       TabIndex        =   21
  301.       Top             =   120
  302.       Width           =   4095
  303.       _ExtentX        =   7223
  304.       _ExtentY        =   9128
  305.       _Version        =   393216
  306.       TabHeight       =   520
  307.       TabCaption(0)   =   "个人信息"
  308.       TabPicture(0)   =   "PhoneBook.frx":0446
  309.       Tab(0).ControlEnabled=   -1  'True
  310.       Tab(0).Control(0)=   "lblPers(10)"
  311.       Tab(0).Control(0).Enabled=   0   'False
  312.       Tab(0).Control(1)=   "lblPers(0)"
  313.       Tab(0).Control(1).Enabled=   0   'False
  314.       Tab(0).Control(2)=   "lblPers(1)"
  315.       Tab(0).Control(2).Enabled=   0   'False
  316.       Tab(0).Control(3)=   "lblPers(2)"
  317.       Tab(0).Control(3).Enabled=   0   'False
  318.       Tab(0).Control(4)=   "lblPers(3)"
  319.       Tab(0).Control(4).Enabled=   0   'False
  320.       Tab(0).Control(5)=   "lblPers(4)"
  321.       Tab(0).Control(5).Enabled=   0   'False
  322.       Tab(0).Control(6)=   "lblPers(5)"
  323.       Tab(0).Control(6).Enabled=   0   'False
  324.       Tab(0).Control(7)=   "lblPers(6)"
  325.       Tab(0).Control(7).Enabled=   0   'False
  326.       Tab(0).Control(8)=   "lblPers(7)"
  327.       Tab(0).Control(8).Enabled=   0   'False
  328.       Tab(0).Control(9)=   "lblPers(8)"
  329.       Tab(0).Control(9).Enabled=   0   'False
  330.       Tab(0).Control(10)=   "lblPers(9)"
  331.       Tab(0).Control(10).Enabled=   0   'False
  332.       Tab(0).Control(11)=   "txtPers(2)"
  333.       Tab(0).Control(11).Enabled=   0   'False
  334.       Tab(0).Control(12)=   "cmdWebEmail(0)"
  335.       Tab(0).Control(12).Enabled=   0   'False
  336.       Tab(0).Control(13)=   "cmdWebEmail(1)"
  337.       Tab(0).Control(13).Enabled=   0   'False
  338.       Tab(0).Control(14)=   "cmdMove(3)"
  339.       Tab(0).Control(14).Enabled=   0   'False
  340.       Tab(0).Control(15)=   "cmdMove(2)"
  341.       Tab(0).Control(15).Enabled=   0   'False
  342.       Tab(0).Control(16)=   "cmdMove(1)"
  343.       Tab(0).Control(16).Enabled=   0   'False
  344.       Tab(0).Control(17)=   "cmdMove(0)"
  345.       Tab(0).Control(17).Enabled=   0   'False
  346.       Tab(0).Control(18)=   "txtPers(0)"
  347.       Tab(0).Control(18).Enabled=   0   'False
  348.       Tab(0).Control(19)=   "txtPers(1)"
  349.       Tab(0).Control(19).Enabled=   0   'False
  350.       Tab(0).Control(20)=   "txtPers(3)"
  351.       Tab(0).Control(20).Enabled=   0   'False
  352.       Tab(0).Control(21)=   "txtPers(4)"
  353.       Tab(0).Control(21).Enabled=   0   'False
  354.       Tab(0).Control(22)=   "txtPers(5)"
  355.       Tab(0).Control(22).Enabled=   0   'False
  356.       Tab(0).Control(23)=   "txtPers(6)"
  357.       Tab(0).Control(23).Enabled=   0   'False
  358.       Tab(0).Control(24)=   "txtPers(7)"
  359.       Tab(0).Control(24).Enabled=   0   'False
  360.       Tab(0).Control(25)=   "txtPers(8)"
  361.       Tab(0).Control(25).Enabled=   0   'False
  362.       Tab(0).Control(26)=   "txtPers(9)"
  363.       Tab(0).Control(26).Enabled=   0   'False
  364.       Tab(0).Control(27)=   "txtPers(10)"
  365.       Tab(0).Control(27).Enabled=   0   'False
  366.       Tab(0).ControlCount=   28
  367.       TabCaption(1)   =   "信息"
  368.       TabPicture(1)   =   "PhoneBook.frx":0462
  369.       Tab(1).ControlEnabled=   0   'False
  370.       Tab(1).Control(0)=   "txtPers(12)"
  371.       Tab(1).ControlCount=   1
  372.       TabCaption(2)   =   "照片"
  373.       TabPicture(2)   =   "PhoneBook.frx":047E
  374.       Tab(2).ControlEnabled=   0   'False
  375.       Tab(2).Control(0)=   "Image1"
  376.       Tab(2).Control(1)=   "txtPers(11)"
  377.       Tab(2).Control(2)=   "cmdPhotopath"
  378.       Tab(2).ControlCount=   3
  379.       Begin VB.TextBox txtPers 
  380.          Height          =   4695
  381.          Index           =   12
  382.          Left            =   -74880
  383.          Locked          =   -1  'True
  384.          MaxLength       =   250
  385.          MultiLine       =   -1  'True
  386.          TabIndex        =   41
  387.          Top             =   360
  388.          Width           =   3855
  389.       End
  390.       Begin VB.CommandButton cmdPhotopath 
  391.          Caption         =   "Browse"
  392.          Enabled         =   0   'False
  393.          Height          =   255
  394.          Left            =   -71880
  395.          TabIndex        =   40
  396.          Top             =   4320
  397.          Width           =   735
  398.       End
  399.       Begin VB.TextBox txtPers 
  400.          Height          =   285
  401.          Index           =   11
  402.          Left            =   -74760
  403.          Locked          =   -1  'True
  404.          MaxLength       =   50
  405.          TabIndex        =   39
  406.          Top             =   4320
  407.          Width           =   2655
  408.       End
  409.       Begin VB.TextBox txtPers 
  410.          Height          =   285
  411.          Index           =   10
  412.          Left            =   120
  413.          Locked          =   -1  'True
  414.          MaxLength       =   50
  415.          TabIndex        =   38
  416.          Top             =   4200
  417.          Width           =   3735
  418.       End
  419.       Begin VB.TextBox txtPers 
  420.          Height          =   285
  421.          Index           =   9
  422.          Left            =   120
  423.          Locked          =   -1  'True
  424.          MaxLength       =   50
  425.          TabIndex        =   37
  426.          Top             =   3600
  427.          Width           =   3735
  428.       End
  429.       Begin VB.TextBox txtPers 
  430.          Height          =   285
  431.          Index           =   8
  432.          Left            =   2040
  433.          Locked          =   -1  'True
  434.          MaxLength       =   50
  435.          TabIndex        =   36
  436.          Top             =   3000
  437.          Width           =   1815
  438.       End
  439.       Begin VB.TextBox txtPers 
  440.          Height          =   285
  441.          Index           =   7
  442.          Left            =   120
  443.          Locked          =   -1  'True
  444.          MaxLength       =   50
  445.          TabIndex        =   35
  446.          Top             =   3000
  447.          Width           =   1815
  448.       End
  449.       Begin VB.TextBox txtPers 
  450.          Height          =   285
  451.          Index           =   6
  452.          Left            =   2040
  453.          Locked          =   -1  'True
  454.          MaxLength       =   50
  455.          TabIndex        =   34
  456.          Top             =   2400
  457.          Width           =   1815
  458.       End
  459.       Begin VB.TextBox txtPers 
  460.          Height          =   285
  461.          Index           =   5
  462.          Left            =   120
  463.          Locked          =   -1  'True
  464.          MaxLength       =   50
  465.          TabIndex        =   33
  466.          Top             =   2400
  467.          Width           =   1815
  468.       End
  469.       Begin VB.TextBox txtPers 
  470.          Height          =   285
  471.          Index           =   4
  472.          Left            =   2040
  473.          Locked          =   -1  'True
  474.          MaxLength       =   50
  475.          TabIndex        =   32
  476.          Top             =   1800
  477.          Width           =   1815
  478.       End
  479.       Begin VB.TextBox txtPers 
  480.          Height          =   285
  481.          Index           =   3
  482.          Left            =   120
  483.          Locked          =   -1  'True
  484.          MaxLength       =   50
  485.          TabIndex        =   31
  486.          Top             =   1800
  487.          Width           =   1815
  488.       End
  489.       Begin VB.TextBox txtPers 
  490.          Height          =   285
  491.          Index           =   1
  492.          Left            =   2040
  493.          Locked          =   -1  'True
  494.          MaxLength       =   50
  495.          TabIndex        =   30
  496.          Top             =   600
  497.          Width           =   1815
  498.       End
  499.       Begin VB.TextBox txtPers 
  500.          Height          =   285
  501.          Index           =   0
  502.          Left            =   120
  503.          Locked          =   -1  'True
  504.          MaxLength       =   50
  505.          TabIndex        =   29
  506.          Top             =   600
  507.          Width           =   1815
  508.       End
  509.       Begin VB.CommandButton cmdMove 
  510.          Caption         =   "I<"
  511.          Enabled         =   0   'False
  512.          BeginProperty Font 
  513.             Name            =   "MS Sans Serif"
  514.             Size            =   12
  515.             Charset         =   0
  516.             Weight          =   700
  517.             Underline       =   0   'False
  518.             Italic          =   0   'False
  519.             Strikethrough   =   0   'False
  520.          EndProperty
  521.          Height          =   400
  522.          Index           =   0
  523.          Left            =   120
  524.          TabIndex        =   28
  525.          ToolTipText     =   "Move to the first post"
  526.          Top             =   4560
  527.          Width           =   635
  528.       End
  529.       Begin VB.CommandButton cmdMove 
  530.          Caption         =   ">"
  531.          Enabled         =   0   'False
  532.          BeginProperty Font 
  533.             Name            =   "MS Sans Serif"
  534.             Size            =   12
  535.             Charset         =   0
  536.             Weight          =   700
  537.             Underline       =   0   'False
  538.             Italic          =   0   'False
  539.             Strikethrough   =   0   'False
  540.          EndProperty
  541.          Height          =   400
  542.          Index           =   1
  543.          Left            =   720
  544.          TabIndex        =   27
  545.          ToolTipText     =   "Move to the next post"
  546.          Top             =   4560
  547.          Width           =   635
  548.       End
  549.       Begin VB.CommandButton cmdMove 
  550.          Caption         =   "<"
  551.          Enabled         =   0   'False
  552.          BeginProperty Font 
  553.             Name            =   "MS Sans Serif"
  554.             Size            =   12
  555.             Charset         =   0
  556.             Weight          =   700
  557.             Underline       =   0   'False
  558.             Italic          =   0   'False
  559.             Strikethrough   =   0   'False
  560.          EndProperty
  561.          Height          =   400
  562.          Index           =   2
  563.          Left            =   1320
  564.          TabIndex        =   26
  565.          ToolTipText     =   "Move to the previous post"
  566.          Top             =   4560
  567.          Width           =   635
  568.       End
  569.       Begin VB.CommandButton cmdMove 
  570.          Caption         =   ">I"
  571.          Enabled         =   0   'False
  572.          BeginProperty Font 
  573.             Name            =   "MS Sans Serif"
  574.             Size            =   12
  575.             Charset         =   0
  576.             Weight          =   700
  577.             Underline       =   0   'False
  578.             Italic          =   0   'False
  579.             Strikethrough   =   0   'False
  580.          EndProperty
  581.          Height          =   400
  582.          Index           =   3
  583.          Left            =   1920
  584.          TabIndex        =   25
  585.          ToolTipText     =   "Move to the last post"
  586.          Top             =   4560
  587.          Width           =   635
  588.       End
  589.       Begin VB.CommandButton cmdWebEmail 
  590.          Height          =   540
  591.          Index           =   1
  592.          Left            =   3360
  593.          Picture         =   "PhoneBook.frx":049A
  594.          Style           =   1  'Graphical
  595.          TabIndex        =   24
  596.          ToolTipText     =   "Go to the person in this post webpage"
  597.          Top             =   4560
  598.          Width           =   615
  599.       End
  600.       Begin VB.CommandButton cmdWebEmail 
  601.          Height          =   540
  602.          Index           =   0
  603.          Left            =   2640
  604.          Picture         =   "PhoneBook.frx":08DC
  605.          Style           =   1  'Graphical
  606.          TabIndex        =   23
  607.          ToolTipText     =   "Send a mail to the person in this post"
  608.          Top             =   4560
  609.          Width           =   615
  610.       End
  611.       Begin VB.TextBox txtPers 
  612.          Height          =   285
  613.          Index           =   2
  614.          Left            =   120
  615.          Locked          =   -1  'True
  616.          MaxLength       =   50
  617.          TabIndex        =   22
  618.          Top             =   1200
  619.          Width           =   3735
  620.       End
  621.       Begin VB.Image Image1 
  622.          Appearance      =   0  'Flat
  623.          BorderStyle     =   1  'Fixed Single
  624.          Height          =   3630
  625.          Left            =   -74760
  626.          Top             =   480
  627.          Width           =   3585
  628.       End
  629.       Begin VB.Label lblPers 
  630.          Caption         =   "主页"
  631.          Height          =   255
  632.          Index           =   9
  633.          Left            =   120
  634.          TabIndex        =   52
  635.          Top             =   3960
  636.          Width           =   2175
  637.       End
  638.       Begin VB.Label lblPers 
  639.          Caption         =   "电子邮件"
  640.          Height          =   255
  641.          Index           =   8
  642.          Left            =   120
  643.          TabIndex        =   51
  644.          Top             =   3360
  645.          Width           =   1335
  646.       End
  647.       Begin VB.Label lblPers 
  648.          Caption         =   "手机"
  649.          Height          =   255
  650.          Index           =   7
  651.          Left            =   2040
  652.          TabIndex        =   50
  653.          Top             =   2760
  654.          Width           =   1335
  655.       End
  656.       Begin VB.Label lblPers 
  657.          Caption         =   "电话"
  658.          Height          =   255
  659.          Index           =   6
  660.          Left            =   120
  661.          TabIndex        =   49
  662.          Top             =   2760
  663.          Width           =   1335
  664.       End
  665.       Begin VB.Label lblPers 
  666.          Caption         =   "国家"
  667.          Height          =   255
  668.          Index           =   5
  669.          Left            =   2040
  670.          TabIndex        =   48
  671.          Top             =   2160
  672.          Width           =   1335
  673.       End
  674.       Begin VB.Label lblPers 
  675.          Caption         =   "城市"
  676.          Height          =   255
  677.          Index           =   4
  678.          Left            =   120
  679.          TabIndex        =   47
  680.          Top             =   2160
  681.          Width           =   1335
  682.       End
  683.       Begin VB.Label lblPers 
  684.          Caption         =   "邮编"
  685.          Height          =   255
  686.          Index           =   3
  687.          Left            =   2040
  688.          TabIndex        =   46
  689.          Top             =   1560
  690.          Width           =   1335
  691.       End
  692.       Begin VB.Label lblPers 
  693.          Caption         =   "地址"
  694.          Height          =   255
  695.          Index           =   2
  696.          Left            =   120
  697.          TabIndex        =   45
  698.          Top             =   1560
  699.          Width           =   1335
  700.       End
  701.       Begin VB.Label lblPers 
  702.          Caption         =   "名"
  703.          Height          =   255
  704.          Index           =   1
  705.          Left            =   2040
  706.          TabIndex        =   44
  707.          Top             =   360
  708.          Width           =   1335
  709.       End
  710.       Begin VB.Label lblPers 
  711.          Caption         =   "姓"
  712.          Height          =   255
  713.          Index           =   0
  714.          Left            =   120
  715.          TabIndex        =   43
  716.          Top             =   360
  717.          Width           =   1335
  718.       End
  719.       Begin VB.Label lblPers 
  720.          Caption         =   "公司"
  721.          Height          =   255
  722.          Index           =   10
  723.          Left            =   120
  724.          TabIndex        =   42
  725.          Top             =   960
  726.          Width           =   1335
  727.       End
  728.    End
  729.    Begin VB.Line Line1 
  730.       X1              =   0
  731.       X2              =   6840
  732.       Y1              =   0
  733.       Y2              =   0
  734.    End
  735.    Begin VB.Menu mnuFile 
  736.       Caption         =   "&文件"
  737.       Begin VB.Menu mnuOpenAdressRegister 
  738.          Caption         =   "打开地址本"
  739.          Shortcut        =   ^O
  740.       End
  741.       Begin VB.Menu mnuCreateAdressRegister 
  742.          Caption         =   "创建新的地址本"
  743.          Shortcut        =   ^C
  744.       End
  745.       Begin VB.Menu mnuBackup 
  746.          Caption         =   "备份地址本"
  747.          Enabled         =   0   'False
  748.          Shortcut        =   ^B
  749.       End
  750.       Begin VB.Menu mnuRestoreBackup 
  751.          Caption         =   "恢复地址本"
  752.          Shortcut        =   ^R
  753.       End
  754.       Begin VB.Menu mnuExit 
  755.          Caption         =   "退出"
  756.          Shortcut        =   ^X
  757.       End
  758.    End
  759.    Begin VB.Menu mnuAbout 
  760.       Caption         =   "关于"
  761.       Begin VB.Menu mnuHelp 
  762.          Caption         =   "&Help"
  763.          Shortcut        =   {F1}
  764.       End
  765.       Begin VB.Menu mnuMailDeveloper 
  766.          Caption         =   "&Mail Developer"
  767.       End
  768.       Begin VB.Menu mnuWebDeveloper 
  769.          Caption         =   "&Developers Webpage"
  770.       End
  771.    End
  772. End
  773. Attribute VB_Name = "PhoneBook"
  774. Attribute VB_GlobalNameSpace = False
  775. Attribute VB_Creatable = False
  776. Attribute VB_PredeclaredId = True
  777. Attribute VB_Exposed = False
  778. Option Explicit
  779. Private objRs As ADODB.Recordset     'The recordset object
  780. Private conString As String           'The string to use in objRs.ActiveConnection (what database to open)
  781. Private bolEdit As Boolean            'Tells what kind of locktype to use in recordset
  782. Private WhereString As String         'What to get in the recordset (used in the search function)
  783. Private WhereVal As String            'What column to use in the wherestring
  784. Private bolSearch As Boolean          'Tells if you are searching or not (to be used if the db is empty)
  785. Private AdressRegisterPath As String  'Tells the path to the choosen Adressregister
  787. Private CD1 As New cmDlg
  788. Private CD12 As New cmDlg
  789. Private CDCreateOpen2 As New cmDlg
  791. '***Open Database***'
  792. Private Sub OpenDatabase()
  795.     mnuBackup.Enabled = True
  796.     optEditMode(0).Enabled = True
  797.     optEditMode(1).Enabled = True
  798.     cmdSearch.Enabled = True
  799.     cmdMove(0).Enabled = True
  800.     cmdMove(1).Enabled = True
  801.     cmdMove(2).Enabled = True
  802.     cmdMove(3).Enabled = True
  804.     conString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & AdressRegisterPath & _
  805.                 ";Persist Security Info=False"
  806.     Set objRs = New ADODB.Recordset
  807.     OpenRs
  809. End Sub
  811. '***Show the person in the current record***'
  812. Private Sub showCurrentRec()
  814.   Dim I As Integer
  816.     With objRs 'Fill the textboxes with the record
  817.         For I = 1 To .Fields.Count - 1
  818.             txtPers(I - 1).Text = .Fields(I) & ""
  819.         Next I
  820.     End With
  821.     On Error GoTo errHandler 'In case the photopath is wrong
  822.     Image1.Picture = LoadPicture(txtPers(11).Text) 'Set the picture = the photopath
  824. errHandler:
  825.     If Err.Number = 53 Then 'Wrong photopath
  826.         MsgBox "The Picture of this person" & vbCrLf & _
  827.                "Seems to not exist or the path is wrong !"
  828.     End If
  830. End Sub
  834. '***Move within the recordset***'
  835. Private Sub cmdMove_Click(index As Integer)
  837.     On Error GoTo error
  839.     Select Case index
  840.       Case 0 'move to the first record
  841.         objRs.MoveFirst
  842.       Case 1 'move to next record
  843.         objRs.MoveNext
  844.       Case 2 'move to previous record
  845.         objRs.MovePrevious
  846.       Case 3 'move to the last record
  847.         objRs.MoveLast
  848.     End Select
  849.     If objRs.BOF Then objRs.MoveFirst 'if it is the beginning of the file move to the first record
  850.     If objRs.EOF Then objRs.MoveLast 'if it is the end of the file move to the last record
  851.     showCurrentRec
  852. error:
  854. End Sub
  856. '***Get the recordset***'
  857. Private Sub OpenRs()
  859.     On Error GoTo errHandler
  860.     With objRs
  861.         If .State = adStateOpen Then .Close 'if it is open close it
  863.         .ActiveConnection = conString 'to which database to connect to
  864.         .CursorLocation = adUseClient   'Use the cursor on the client
  865.         .CursorType = adOpenKeyset 'Moveable recordset in any direction
  866.         Select Case bolEdit
  867.           Case False 'Readmode
  868.             .LockType = adLockReadOnly 'Read only recordset
  869.           Case True 'Editmode
  870.             .LockType = adLockOptimistic 'Editable recordset
  871.         End Select
  872.         .Source = "select * from tblPhonebook " & WhereString & " order by lastname" 'What to get
  873.         .Open
  874.     End With
  876.     listPers
  877.     objRs.MoveFirst
  878.     showCurrentRec
  879. errHandler:
  880.     If Err.Number = 3021 Then 'if the recordset holds no records (empty database or nothing found in the search)
  881.         If bolSearch = False Then 'Empty database
  882.             NoPostInDb
  883.           Else 'Nothing found in the search
  884.             MsgBox "No records found"
  885.             WhereString = ""
  886.             txtSearch.Text = ""
  887.             cmdEdit(4).Enabled = False
  888.             cmdEdit(4).Caption = ""
  889.             OpenRs
  890.         End If
  892.       ElseIf Err.Number = -2147467259 Then 'if the database is missing
  893.         mnuRestoreBackup_Click
  894.       ElseIf Err.Number <> 0 Then 'in any other error tell what have happen
  895.         MsgBox Err.Number & " " & Err.Description
  896.     End If
  898. End Sub
  900. '***Routine for adding a new post in an empty database
  901. Private Sub NoPostInDb()
  903.   Dim I As Integer
  905.     If MsgBox("You have no posts in your Adress Register!" & vbCrLf & _
  906.        "Do you want to add a new post ?", vbYesNo, "Add a new post") = vbYes Then
  907.         bolEdit = True
  908.         cmdPhotopath.Enabled = True
  909.         For I = 0 To 12
  910.             txtPers(I).Locked = False
  911.         Next I
  912.         For I = 0 To 3 'enable/disable editbuttons
  913.             cmdEdit(I).Enabled = bolEdit
  914.         Next I
  915.         If bolEdit = True Then cmdEdit(3).Enabled = False
  916.         cmdEdit_Click (1)
  917.         MsgBox "Add a new post in your Adress Register" & vbCrLf & _
  918.                "Press AddNew when you are done", , "Add a new post"
  919.       Else
  920.         Exit Sub
  921.     End If
  923.     With objRs
  924.         If .State = adStateOpen Then .Close 'if it is open close it
  926.         .ActiveConnection = conString 'what database to connect to
  927.         .CursorLocation = adUseClient 'Use the clients cursor
  928.         .CursorType = adOpenKeyset 'Moveable recordset in any direction
  929.         .LockType = adLockOptimistic 'Editable recordset
  930.         .Source = "select * from tblPhonebook order by lastname" 'What to get
  931.         .Open
  932.     End With
  934. End Sub
  936. '***List lastname, firstname in the listbox***'
  937. Private Sub listPers()
  939.     lstSelpers.Clear 'empty it first, no duplicates
  941.     With objRs
  942.         .MoveFirst
  943.         While Not .EOF
  944.             lstSelpers.AddItem .Fields(1) & " " & .Fields(2)
  945.             .MoveNext
  946.         Wend
  947.     End With
  949. End Sub
  951. '***Browse to the photopath to store in db***'
  952. Private Sub cmdPhotopath_Click()
  954.     CD1.InitDir = App.Path 'where it should begin to look
  955.     CD1.ShowOpen 'Open the dialog
  956.     txtPers(11).Text = CD1.FileName 'Set the pathname
  957.     Image1.Picture = LoadPicture(CD1.FileName) 'set the picture, to see if it is correct
  959. End Sub
  961. '*** Send mail to person or goto the webpage***'
  962. Private Sub cmdWebEmail_Click(index As Integer)
  964.     frmMail.txtTo = txtPers(9)
  965.     frmMail.Show
  966.     Unload Me
  968. End Sub
  970. Private Sub Form_Load()
  972.     Set objRs = Nothing
  974.     CDCreateOpen2.InitDir = App.Path
  975.     CDCreateOpen2.DialogTitle = "Open Adress Register"
  976.     CDCreateOpen2.FileName = App.Path + "adressbook.adr"
  977.     AdressRegisterPath = CDCreateOpen2.FileName
  978.     OpenDatabase
  980.     optEditMode_Click (1)
  982. End Sub
  984. Private Sub Form_Unload(Cancel As Integer)
  986.     Set CD1 = Nothing
  987.     Set CD12 = Nothing
  988.     Set CDCreateOpen2 = Nothing
  990. End Sub
  992. '***On click move to the selected record and show it***'
  993. Private Sub lstSelPers_Click()
  994. On Error Resume Next
  995.     objRs.MoveFirst
  996.     objRs.Move (lstSelpers.ListIndex)
  997.     showCurrentRec
  999. End Sub
  1001. '***Make a backup of the Adress register***'
  1002. Private Sub mnuBackup_Click()
  1004.   Dim strTemp As String
  1005.   Dim I As Integer
  1007.     On Error GoTo errHandler
  1008.     Set objRs = Nothing
  1009.     CD12.DialogTitle = "Where do you want to put your backup ?"
  1011.     For I = 1 To Len(AdressRegisterPath) - 1
  1012.         If Mid(AdressRegisterPath, I, 1) = "" Then
  1013.             strTemp = Mid(AdressRegisterPath, 1, I)
  1014.         End If
  1015.     Next I
  1016.     CD12.FileName = Mid(AdressRegisterPath, Len(strTemp) + 1)
  1017.     CD12.ShowSave
  1019.     If CD12.FileName <> "" Then FileCopy AdressRegisterPath, CD12.FileName
  1020.     CD12.FileName = ""
  1021.     OpenDatabase
  1022. errHandler:
  1023.     Set objRs = New ADODB.Recordset
  1025. End Sub
  1027. '***Create a new adress register***'
  1028. Private Sub mnuCreateAdressRegister_Click()
  1029. On Error Resume Next
  1030.     Set objRs = Nothing
  1032.     CDCreateOpen2.InitDir = App.Path
  1033.     CDCreateOpen2.DialogTitle = "Create Adress Register as"
  1034.     CDCreateOpen2.ShowSave
  1035.     If CDCreateOpen2.FileName <> "" Then
  1036.         FileCopy App.Path & "TEMPLATE.bak", CDCreateOpen2.FileName
  1037.         AdressRegisterPath = CDCreateOpen2.FileName
  1038.         OpenDatabase
  1039.     End If
  1041. End Sub
  1043. '***Select a adress register to open***'
  1044. Private Sub mnuOpenAdressRegister_Click()
  1046.     Set objRs = Nothing
  1048.     CDCreateOpen2.InitDir = App.Path
  1049.     CDCreateOpen2.DialogTitle = "Open Adress Register"
  1050.     CDCreateOpen2.ShowOpen
  1051.     AdressRegisterPath = CDCreateOpen2.FileName
  1052.     OpenDatabase
  1054. End Sub
  1056. '***Restore the AdressRegister***'
  1057. Private Sub mnuRestoreBackup_Click()
  1059.   Dim strTemp As String
  1060.   Dim I As Integer
  1062.     On Error GoTo errHandler
  1063.     Set objRs = Nothing
  1064.     CD12.DialogTitle = "Select Adress Register to restore"
  1065.     CD12.ShowOpen
  1066.     If CD12.FileName <> "" Then
  1067.         AdressRegisterPath = CD12.FileName
  1069.         For I = 1 To Len(AdressRegisterPath) - 1
  1070.             If Mid(AdressRegisterPath, I, 1) = "" Then
  1071.                 strTemp = Mid(AdressRegisterPath, 1, I)
  1072.             End If
  1073.         Next I
  1074.         strTemp = "" & Mid(AdressRegisterPath, Len(strTemp) + 1)
  1075.         FileCopy CD12.FileName, App.Path & strTemp
  1076.     End If
  1077.     OpenDatabase
  1079. errHandler:
  1080.     Set objRs = New ADODB.Recordset
  1082. End Sub
  1084. '***Exit***'
  1085. Private Sub mnuExit_Click()
  1087.     Unload Me
  1089. End Sub
  1091. '***Set what kind of recordset to get***'
  1092. Private Sub optEditMode_Click(index As Integer)
  1094.   Dim I As Integer
  1096.     Select Case index
  1097.       Case 0 'Readable recordset
  1098.         bolEdit = False
  1099.         cmdPhotopath.Enabled = False
  1100.         For I = 0 To 12
  1101.             txtPers(I).Locked = True
  1102.         Next I
  1103.       Case 1 'Editable recordset
  1104.         bolEdit = True
  1105.         cmdPhotopath.Enabled = True
  1106.         For I = 0 To 12
  1107.             txtPers(I).Locked = False
  1108.         Next I
  1109.     End Select
  1110.     For I = 0 To 3 'enable/disable editbuttons
  1111.         cmdEdit(I).Enabled = bolEdit
  1112.     Next I
  1113.     If bolEdit = True Then cmdEdit(3).Enabled = False
  1114.     WhereString = ""
  1115.     OpenRs
  1117. End Sub
  1119. '***Set what column to use in the where criteria, also work as search***'
  1120. Private Sub optSearch_Click(index As Integer)
  1122.     WhereVal = optSearch(index).Caption
  1124. End Sub
  1126. '***Create part of the string to use in the recordset source***'
  1127. Private Sub cmdSearch_Click()
  1129.     If WhereVal = "" Then WhereVal = "LastName"
  1130.     bolSearch = True
  1131.     WhereString = " Where " & WhereVal & " Like '" & txtSearch.Text & "'"
  1132.     cmdEdit(4).Enabled = True
  1133.     cmdEdit(4).Caption = "Get all posts"
  1134.     OpenRs
  1135.     bolSearch = False
  1137. End Sub
  1139. '***Update, Delete, AddNew record and clear textboxes***'
  1140. Private Sub cmdEdit_Click(index As Integer)
  1142.   Dim I As Integer
  1143.   Dim bookMark As Variant
  1145.     Select Case index
  1146.       Case 0 'Edit and update current record
  1147.         If txtPers(0).Text = "" Then
  1148.             MsgBox "you must enter a value in Lastname !"
  1149.             txtPers(0).SetFocus
  1150.           ElseIf txtPers(1).Text = "" Then
  1151.             MsgBox "you must enter a value in Firstname !"
  1152.             txtPers(1).SetFocus
  1153.           Else
  1154.             bookMark = objRs.bookMark 'Set bookMark to the current record
  1155.             For I = 0 To 12
  1156.                 If txtPers(I) = "" Then 'Dont store an empty string
  1157.                     objRs.Fields(I + 1) = Null
  1158.                   Else
  1159.                     objRs.Fields(I + 1) = Trim(txtPers(I).Text)
  1160.                 End If
  1161.             Next I
  1162.             objRs.Update
  1163.             listPers
  1164.             objRs.bookMark = bookMark
  1165.             showCurrentRec
  1166.         End If
  1167.       Case 1 'Clear the texboxes and enable AddNew
  1168.         cmdEdit(3).Enabled = True
  1169.         cmdEdit(0).Enabled = False
  1170.         cmdEdit(2).Enabled = False
  1171.         cmdEdit(4).Enabled = True
  1172.         cmdEdit(4).Caption = "Disable AddNew"
  1173.         cmdPhotopath.Enabled = True
  1174.         For I = 0 To 12
  1175.             txtPers(I).Text = ""
  1176.         Next I
  1177.       Case 2 'Delete current record
  1178.         If MsgBox("Do you want to delete the Post" & vbCrLf & _
  1179.            objRs.Fields(1) & " " & objRs.Fields(2) & " ?", vbOKCancel) = vbOK Then
  1180.             objRs.Delete adAffectCurrent
  1181.             objRs.Requery 'refresh the recordset
  1182.             If objRs.RecordCount = 0 Then 'If it was the only record
  1183.                 For I = 0 To 12
  1184.                     txtPers(I).Text = ""
  1185.                 Next I
  1186.                 lstSelpers.Clear
  1187.                 NoPostInDb 'Routine for making a new record in an empty database
  1188.               Else
  1189.                 listPers
  1190.                 objRs.MoveLast
  1191.                 showCurrentRec
  1192.             End If
  1193.         End If
  1194.       Case 3 'Addnew, Add a new record to DB
  1195.         If txtPers(0).Text = "" Then
  1196.             MsgBox "you must enter a value in Lastname !"
  1197.             txtPers(0).SetFocus
  1198.           ElseIf txtPers(1).Text = "" Then
  1199.             MsgBox "you must enter a value in Firstname !"
  1200.             txtPers(1).SetFocus
  1201.           Else
  1202.             objRs.AddNew
  1203.             For I = 0 To 12
  1204.                 If txtPers(I) = "" Then 'Dont store empty strings
  1205.                     objRs.Fields(I + 1) = Null
  1206.                   Else
  1207.                     objRs.Fields(I + 1) = Trim(txtPers(I).Text)
  1208.                 End If
  1209.             Next I
  1210.             objRs.Update
  1211.             objRs.Requery 'Refresh the recordset
  1212.             listPers
  1213.             objRs.MoveLast
  1214.             showCurrentRec
  1215.             cmdEdit(3).Enabled = False 'disable the Addnew cmdbutton
  1216.             cmdEdit(0).Enabled = True
  1217.             cmdEdit(2).Enabled = True
  1218.         End If
  1220.       Case 4 'Get Records back after search
  1221.         WhereString = ""
  1222.         txtSearch.Text = ""
  1223.         OpenRs
  1224.         If bolEdit = True Then
  1225.             cmdEdit(3).Enabled = False
  1226.             cmdEdit(0).Enabled = True
  1227.             cmdEdit(2).Enabled = True
  1228.         End If
  1229.         cmdEdit(4).Enabled = False
  1230.         cmdEdit(4).Caption = ""
  1231.     End Select
  1233. End Sub
  1235. ':) Ulli's VB Code Formatter V2.12.7 (26.06.2002 19:52:39) 12 + 451 = 463 Lines