user_reg.pas

一个QQ的界面源码

unit user_reg;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Buttons, dximctrl, RXCtrls, DB, TinyDB;

type
  TFrmReg = class(TForm)
    Panel1: TPanel;
    Image1: TImage;
    GroupBox1: TGroupBox;
    EdtUsername: TLabeledEdit;
    EdtPassword: TLabeledEdit;
    EdtRepassword: TLabeledEdit;
    Panel2: TPanel;
    Label1: TLabel;
    ImgLstBox: TdxImageListBox;
    Label2: TLabel;
    Panel3: TPanel;
    ImgFace: TImage;
    RxLabel1: TRxLabel;
    BtnOK: TBitBtn;
    BtnCancle: TBitBtn;
    procedure FormCreate(Sender: TObject);
    procedure ImgLstBoxClick(Sender: TObject);
    procedure BtnCancleClick(Sender: TObject);
    procedure BtnOKClick(Sender: TObject);
    procedure EdtUsernameKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure EdtUsernameKeyPress(Sender: TObject; var Key: Char);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FrmReg: TFrmReg;

implementation

uses dm_share, Var_Share, main, by_user;

{$R *.dfm}

//创建好友信息数据库
function CreateDBFriend(QQNumber:string):boolean;
var
   sDBFileName:string;
   DBFriend:TTinyDatabase;
begin
   Result:=True;
   sDBFileName:=ExtractFilePath(Application.ExeName)+QQNumber+'\friends.dat';

   try
      DBFriend:=TTinyDatabase.Create(DMShare);
      DBFriend.CreateDatabase(sDBFileName,True,clNormal,'ZIP',True,'Blowfish','icando',True);
      DBFriend.DatabaseName:=SDBFileName;
      DBFriend.Password:='icando';

      DBFriend.CreateTable('Friends',[
         FieldItem('QQNumber',ftString,20),
         FieldItem('UserName',ftString,20),
         FieldItem('FaceID',ftInteger),
         FieldItem('IP',ftString,15),
         FieldItem('IsBaddy',ftBoolean),
         FieldItem('Memo',ftMemo)
         ]);
      DBFriend.CreateIndex('Friends','ByQQNumber',[],['QQNumber']);
      DBFriend.CreateIndex('Friends','byUserName',[],['UserName']);

      DBFriend.CreateTable('ChatLog',[
         FieldItem('QQNumber',ftString,20),
         FieldItem('UserName',ftString,20),
         FieldItem('IsSender',ftBoolean),
         FieldItem('Time',ftDateTime),
         FieldItem('Message',ftMemo),
         FieldItem('Memo',ftMemo)
         ]);
      DBFriend.CreateIndex('ChatLog','ByQQNumber',[],['QQNumber']);
      DBFriend.CreateIndex('ChatLog','byUserName',[],['UserName']);

      DBFriend.CreateTable('SystemMsg',[
         FieldItem('ID',ftAutoInc,10),
         FieldItem('Time',ftDateTime),
         FieldItem('Message',ftMemo),
         FieldItem('Memo',ftMemo)
         ]);
      DBFriend.CreateIndex('SystemMsg','byID',[],['ID']);

   except
      DeleteFile(sDBFileName);
      Result:=False;
   end;
end;


procedure TFrmReg.FormCreate(Sender: TObject);
var
   i:integer;
   MyBmp:TBitMap;
begin
   ImgLstBox.ImageList:=DMShare.ImgLarge;
   for i := 0 to 84 do
   begin
      ImgLstBox.AddItem('',i);
   end;

   MyBmp:=TBitMap.Create;
   ImgLstBox.ImageList.GetBitmap(0,MyBmp);
   ImgFace.Picture.Bitmap:=MyBmp;

   ImgLstBox.ItemIndex:=0;
end;

procedure TFrmReg.ImgLstBoxClick(Sender: TObject);
var
   i:integer;
   MyBmp:TBitMap;
begin
   i:=ImgLstBox.ItemIndex;
   MyBmp:=TBitMap.Create;
   ImgLstBox.ImageList.GetBitmap(i,MyBmp);
   ImgFace.Picture.Bitmap:=MyBmp;
end;

procedure TFrmReg.BtnCancleClick(Sender: TObject);
begin
   Close;
end;

procedure TFrmReg.BtnOKClick(Sender: TObject);
var
   sQQNum:string;
begin
//检查资料是否完整
   if (EdtUsername.Text='') or (EdtPassword.Text='') or (EdtRepassword.Text='') then
   begin
      MessageBox(GetActiveWindow(),'资料填写不完整!','错误',MB_OK+MB_ICONERROR);
      Abort;
   end;
//检查密码是否正确
   if EdtPassword.Text<>EdtRepassword.Text then
   begin
      MessageBox(GetActiveWindow(),'两次密码不吻合，请重新输入!','错误',MB_OK+MB_ICONERROR);
      EdtPassword.Clear;
      EdtRepassword.Clear;
      EdtPassword.SetFocus;
      Abort;
   end;
//检测用户名是否已经被申请
   if not DMShare.TblUsers.Active then DMShare.TblUsers.Open;
   DMShare.TblUsers.First;
   while not DMShare.TblUsers.Eof do
   begin
      if LowerCase(DMShare.TblUsers.FieldValues['UserName'])=LowerCase(EdtUsername.Text) then
      begin
         MessageBox(GetActiveWindow(),'此用户名已被申请，请另行选择用户名!',
               '错误',MB_OK+MB_ICONERROR);
         EdtUsername.Clear;
         EdtUsername.SetFocus;
         Abort;
      end;
      DMShare.TblUsers.Next;
   end;
//将用户信息写入数据库
   sQQNum:=FormatDateTime('mdhms',Now);
   iFaceID:=ImgLstBox.ItemIndex;
   g_sIP:=GetLocalIP;
   DMShare.TblUsers.Append;
   with DMShare.TblUsers do
   begin
      FieldValues['QQNumber']:=sQQNum;
      FieldValues['UserName']:=EdtUserName.Text;
      FieldValues['Password']:=EdtPassword.Text;
      FieldValues['FaceID']:=iFaceID;
      FieldValues['IP']:=g_sIP;
      FieldValues['IsSavePwd']:=False;
      FieldValues['IsHideSelf']:=False;
      Post;
   end;
   sQQNumber:=sQQNum;
   sUserName:=EdtUserName.Text;
   sPassword:=EdtPassword.Text;
   iFaceID:=ImgLstBox.ItemIndex;
   bIsReg:=True;
//创建用户目录及好友数据库
   MkDir(ExtractFilePath(Application.ExeName)+sQQNum);
   CreateDBFriend(sQQNumber);
   Close;
end;

procedure TFrmReg.EdtUsernameKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
   if Key=Vk_Return then
   begin
      BtnOK.Click;
   end;
end;

procedure TFrmReg.EdtUsernameKeyPress(Sender: TObject; var Key: Char);
begin
   if Key='*' then
   begin
      Key:=#0;
      windows.Beep(999,88);
   end;
   if (Length(EdtUserName.Text)>=20) and (Key<>#8) then
   begin
      Key:=#0;
      windows.Beep(999,88);
   end;
end;

end.