uinfocard.pas

一个通讯录源码

{
#####################################################################
# 声明:本站资源由Delphi编程驿站[http://www.delphidak.com]整理收集，
#      部分资源来自于网络,转发前请注意尊重版权,如果您发现本站的资源
#      侵犯了您的版权，请来信告知，版主将立即删除。 
#                                                              
#******************** 欢迎访问Delphi编程驿站*************************
#                                                               
# Delphi编程驿站，以Delphi技术交流为宗旨的编程站点，明确的主题、一致的版面。
# 主页简介： 
# 本站的宗旨：与您共同进步、成长！
# 主栏目设置：编程技巧、源码分析、组件开发、项目合作；
# 辅栏目设置：网站简介、网站导航、站内更新、关于版主、友情链接。
# 在成长中学习，在学习中成长！我们一直在努力！！！
# ======================刀剑如梦软件创作室==============================
# ================== KingLong Software Studio ==========================  
# 站长：刀剑如梦 QQ：1917208  信箱：[e-mail],[e-mail]
# 网址：http://www.delphidak.com                              
# 论坛：http://www.delphibbs.com    [推荐：大富翁论坛]
#*************** 如你转载，请不要删除以上信息，谢谢! **************** 
#         
######################################################################
}
unit uInfoCard;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, StdCtrls, ComCtrls, ExtCtrls, ToolWin, DB, TinyDB,
  DBCtrls, ImgList,ShellAPI, XPMenu;

{在TinyDB中打开数据库的密码}
const
  DBPassWord='KingLong';

type
  TInfoCardFrm = class(TForm)
    MainMenu1: TMainMenu;
    ADBKManual: TMenuItem;
    RecAddNew: TMenuItem;
    RecModify: TMenuItem;
    RecDelete: TMenuItem;
    QuitSys: TMenuItem;
    DataManual: TMenuItem;
    DBBackup: TMenuItem;
    DBRestore: TMenuItem;
    SysHelp: TMenuItem;
    AboutHelp: TMenuItem;
    AboutSource: TMenuItem;
    AboutMe: TMenuItem;
    CoolBar1: TCoolBar;
    ToolBar1: TToolBar;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    RadioButton3: TRadioButton;
    RadioButton4: TRadioButton;
    CmdSearch: TButton;
    TreeView1: TTreeView;
    Panel1: TPanel;
    TAB1: TTinyTable;
    LabT01: TLabel;
    LabT02: TLabel;
    LabT03: TLabel;
    LabT04: TLabel;
    LabT05: TLabel;
    LabT06: TLabel;
    LabT07: TLabel;
    LabT08: TLabel;
    LabT09: TLabel;
    LabT10: TLabel;
    LabT11: TLabel;
    SysSet: TMenuItem;
    SetLogPass: TMenuItem;
    SetADBKType: TMenuItem;
    ImageList1: TImageList;
    StatusBar1: TStatusBar;
    Null11: TMenuItem;
    Null21: TMenuItem;
    Null41: TMenuItem;
    Timer1: TTimer;
    DBToTxt: TMenuItem;
    TAB2: TTinyTable;
    PopupMenu1: TPopupMenu;
    POPAddNew: TMenuItem;
    POPModify: TMenuItem;
    PopDelete: TMenuItem;
    LabS01: TLabel;
    LabS02: TLabel;
    LabS03: TLabel;
    LabS04: TLabel;
    LabS05: TLabel;
    LabS06: TLabel;
    LabS07: TLabel;
    LabS08: TLabel;
    LabS09: TLabel;
    LabS10: TLabel;
    PopRefresh: TMenuItem;
    EditSearch: TEdit;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    BackPnl: TPanel;
    XPMenu1: TXPMenu;
    Memo1: TMemo;
    function OpenDBSysInfo(var InfoCardTable: TTinyTable): Boolean;
    function OpenDBAdTypes(var InfoCardTable: TTinyTable): Boolean;
    function OpenDBInfoCard(var InfoCardTable: TTinyTable): Boolean;
    procedure CreateDB(Sender: TObject);
    procedure TVRefresh(var TV:TTreeview);
    procedure FormCreate(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure SetLogPassClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure RecAddNewClick(Sender: TObject);
    procedure SetADBKTypeClick(Sender: TObject);
    procedure AboutMeClick(Sender: TObject);
    procedure POPModifyClick(Sender: TObject);
    procedure TreeView1DblClick(Sender: TObject);
    procedure TreeView1Change(Sender: TObject; Node: TTreeNode);
    procedure POPAddNewClick(Sender: TObject);
    procedure PopDeleteClick(Sender: TObject);
    procedure RecModifyClick(Sender: TObject);
    procedure RecDeleteClick(Sender: TObject);
    procedure PopRefreshClick(Sender: TObject);
    procedure QuitSysClick(Sender: TObject);
    procedure CmdSearchClick(Sender: TObject);
    procedure EditSearchKeyPress(Sender: TObject; var Key: Char);
    procedure EditSearchDblClick(Sender: TObject);
    procedure DBBackupClick(Sender: TObject);
    procedure DBRestoreClick(Sender: TObject);
    procedure DBToTxtClick(Sender: TObject);
    procedure AboutHelpClick(Sender: TObject);
    procedure AboutSourceClick(Sender: TObject);
  private
    { Private declarations }
  public
    {数据库名称及系统登录密码，从数据库SysInfo表中读取}
    DBName, LoginPass: string;
    {系统是否已经登录}
    IsLogined: Boolean;
    { Public declarations }
  end;

var
  InfoCardFrm: TInfoCardFrm;

implementation

uses uLogin, uSetPass, uInput, uSetType, uAboutMe, uHelp;

{$R *.dfm}

function TInfoCardFrm.OpenDBSysInfo(var InfoCardTable: TTinyTable): Boolean;
{打开数据库中SysInfo表的函数}
begin
  try
    InfoCardTable.Close;
    InfoCardTable.DatabaseName := InfoCardFrm.DBName;
    InfoCardTable.TableName := 'SysInfo';
    InfoCardTable.Password := DBPassWord;
    InfoCardTable.Open;
    Result := True;
  except
    Result := False;
  end;
end;

function TInfoCardFrm.OpenDBADTypes(var InfoCardTable: TTinyTable): Boolean;
{打开数据库中AdTypes表的函数}
begin
  try
    InfoCardTable.Close;
    InfoCardTable.DatabaseName := InfoCardFrm.DBName;
    InfoCardTable.TableName := 'AdTypes';
    InfoCardTable.Password := DBPassWord;
    InfoCardTable.Open;
    Result := True;
  except
    Result := False;
  end;
end;

function TInfoCardFrm.OpenDBInfoCard(var InfoCardTable: TTinyTable): Boolean;
{打开数据库中InfoCard表的函数}
begin
  try
    InfoCardTable.Close;
    InfoCardTable.DatabaseName:=InfoCardFrm.DBName;
    InfoCardTable.TableName := 'InfoCard';
    InfoCardTable.IndexName := 'InfoCardIdx';
    InfoCardTable.Password := DBPassWord;
    InfoCardTable.Open;
    Result := True;
  except
    Result := False;
  end;
end;

procedure TInfoCardFrm.CreateDB(sender:Tobject);
{生成空白数据库}
var
  TDB: TTinyDataBase;
  TTB: TTinyTable;
begin
   Try
     TDB:=TTinyDataBase.Create(self);
     TDB.DatabaseName:=DBName;
     TDB.Password:=DBPassWord;
     TDB.CreateDatabase(DBName,True, clNormal, 'ZLIB', True, 'Twofish', DbPassWord,True);
     TDB.CreateTable('SysInfo',[FieldItem('PassWord', ftString, 10)]); //密码存储
     TDB.CreateTable('ADTypes',[FieldItem('TypeName', ftstring, 20)]);  //通信录类别
     TDB.CreateTable('InfoCard',[
          FieldItem('ADType',ftString,20),  //类别
          FieldItem('Name',ftString,10),    //姓名
          FieldItem('NetName',ftString,20), //网名
          FieldItem('QQ',ftString,10),      //QQ号码
          FieldItem('MSN',ftString,30),     //MSN号码
          FieldItem('Email',ftString,30),   //电子邮箱
          FieldItem('HomePage',ftString,40),//个人主页
          FieldItem('OffTel',ftString,11),  //办公电话
          FieldItem('Mobile',ftString,13),  //手机号码
          FieldItem('ContAdd',ftString,60), //联络地址
          FieldItem('Memo',ftString,200)     //备注
      ]);                                   //创建通信录数据库
      TDB.CreateIndex('InfoCard','InfoCardIdx',[tiPrimary],['ADType','Name']); //索引
      TDB.Free;
      TTB:=TTinyTable.Create(Self);
      with TTB do
      begin
        if OpenDBSysInfo(TTB) then AppendRecord(['']); //插入登录密码，默认为无
        if OpenDBADTypes(TTB) then
       {========加入五类基本名片通信录分类========}
        begin
          AppendRecord(['亲戚朋友']);
          AppendRecord(['班级同学']);
          AppendRecord(['Delphi高手']);
          AppendRecord(['编程交流网友']);
          AppendRecord(['软件创作室成员']);
        end;
      end;
      TTB.Free;
      MessageDlg(
      '************* Welcome *************'+#13+#13+
      '已成功新建空白数据库!'+#13+#13+
      '如果是初次使用，请先设置好[通信录分类],'+#13+#13+
      '具体的操作细节请参阅[使用帮助]。',mtInformation,[mbOK],0);
    except
      DeleteFile(DBName);
    end;
end;

procedure LABSShow(ShowName:string);
{显示某条记录内容}
begin
   with InfoCardFrm.TAB1 do
   begin
     Filtered := False;
     Locate('Name',Trim(ShowName),[]);
     InfoCardFrm.LabS01.Caption := FieldByName('AdType').AsString;
     InfoCardFrm.LabS02.Caption := FieldByName('Name').AsString;
     InfoCardFrm.LabS03.Caption := FieldValues['NetName'];
     InfoCardFrm.LabS04.Caption := FieldValues['QQ'];
     InfoCardFrm.LabS05.Caption := FieldValues['MSN'];
     InfoCardFrm.LabS06.Caption := FieldValues['Email'];
     InfoCardFrm.LabS07.Caption := FieldValues['HomePage'];
     InfoCardFrm.LabS08.Caption := FieldValues['OffTel'];
     InfoCardFrm.LabS09.Caption := FieldValues['Mobile'];
     InfoCardFrm.LabS10.Caption := FieldValues['ContAdd'];
     InfoCardFrm.Memo1.Text     := FieldValues['Memo'];
    end;
end;
{===================清除右侧显示记录的内容===================}
procedure ClearRightContent;
begin
  with InfoCardFrm do
  begin
    Labs01.Caption := '';
    Labs02.Caption := '';
    Labs03.Caption := '';
    Labs04.Caption := '';
    Labs05.Caption := '';
    Labs06.Caption := '';
    Labs07.Caption := '';
    Labs08.Caption := '';
    Labs09.Caption := '';
    Labs10.Caption := '';
    Memo1.Text     := '';
  end;
end;
{=================刷新TreeView====================}
procedure TInfoCardFrm.TVRefresh(var TV:TTreeview);
var
  RootList: TStringList;
  TmpNode: TTreeNode;
  Pstr: ^string;
  I: Integer;
begin
  RootList := TStringList.Create;
  if OpenDBADTypes(InfoCardFrm.TAB2) then
     while not InfoCardFrm.TAB2.eof do
        begin
          RootList.Append(Trim(InfoCardFrm.TAB2.FieldValues['TypeName']));