云版登录窗口增加账号保存功能.

Forms/LoginFrm.dfm

@@ -1,6 +1,7 @@
 object LoginFrm: TLoginFrm
   Left = 241
   Top = 165
+  ActiveControl = cbUser
   AutoSize = True
   BorderIcons = [biSystemMenu]
   BorderStyle = bsNone
@@ -16,6 +17,7 @@ object LoginFrm: TLoginFrm
   OldCreateOrder = False
   Position = poScreenCenter
   OnCreate = FormCreate
+  OnDestroy = FormDestroy
   PixelsPerInch = 96
   TextHeight = 12
   object imgBG: TImage
@@ -31310,25 +31312,6 @@ object LoginFrm: TLoginFrm
     ShowHint = True
     OnMouseDown = shpPWMouseDown
   end
-  object edtUser: TEdit
-    Left = 705
-    Top = 87
-    Width = 248
-    Height = 24
-    BorderStyle = bsNone
-    Ctl3D = True
-    Font.Charset = DEFAULT_CHARSET
-    Font.Color = 6710886
-    Font.Height = -16
-    Font.Name = #24494#36719#38597#40657
-    Font.Style = []
-    ImeName = #20013#25991' ('#31616#20307') - '#25628#29399#25340#38899#36755#20837#27861
-    ParentCtl3D = False
-    ParentFont = False
-    TabOrder = 0
-    OnClick = edtUserClick
-    OnKeyDown = edtUserKeyDown
-  end
   object edtPW: TEdit
     Left = 705
     Top = 137
@@ -31345,7 +31328,7 @@ object LoginFrm: TLoginFrm
     ParentCtl3D = False
     ParentFont = False
     PasswordChar = '*'
-    TabOrder = 1
+    TabOrder = 0
     OnKeyDown = edtPWKeyDown
   end
   object btnLogin: TCslButton
@@ -35747,7 +35730,7 @@ object LoginFrm: TLoginFrm
     Top = 0
     Width = 614
     Height = 334
-    TabOrder = 4
+    TabOrder = 3
     ControlData = {
       4C000000753F0000852200000000000000000000000000000000000000000000
       000000004C000000000000000000000001000000E0D057007335CF11AE690800
@@ -35762,7 +35745,7 @@ object LoginFrm: TLoginFrm
     Height = 158
     BevelOuter = bvNone
     Color = clWhite
-    TabOrder = 5
+    TabOrder = 4
     object lblLocalHelp: TCslLabel
       Left = 104
       Top = 104
@@ -40142,4 +40125,35 @@ object LoginFrm: TLoginFrm
       OnClick = btnLoginClick
     end
   end
+  object cbUser: TcxComboBox
+    Left = 705
+    Top = 85
+    Width = 254
+    Height = 29
+    ParentFont = False
+    PopupMenu = pmLogin
+    Properties.Alignment.Vert = taVCenter
+    Style.BorderStyle = ebsNone
+    Style.Font.Charset = DEFAULT_CHARSET
+    Style.Font.Color = clWindowText
+    Style.Font.Height = -16
+    Style.Font.Name = #24494#36719#38597#40657
+    Style.Font.Style = []
+    Style.Shadow = False
+    Style.ButtonStyle = btsHotFlat
+    StyleFocused.BorderStyle = ebsNone
+    StyleHot.BorderStyle = ebsNone
+    TabOrder = 5
+    OnClick = cbUserClick
+    OnKeyDown = cbUserKeyDown
+  end
+  object pmLogin: TPopupMenu
+    AutoHotkeys = maManual
+    Left = 848
+    Top = 40
+    object nClearAccount: TMenuItem
+      Caption = #28165#31354#24080#25143#20449#24687
+      OnClick = nClearAccountClick
+    end
+  end
 end

Forms/LoginFrm.pas

@@ -17,12 +17,11 @@ uses
   cxTextEdit, cxButtons, cxControls, cxEdit,
   cxMaskEdit, cxDropDownEdit, HookEdit, cxContainer, XPMenu, cslLabel,
   IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP,
-  CslButton, OleCtrls, SHDocVw;
+  CslButton, OleCtrls, SHDocVw, DB, ADODB, Menus;
   
 
 type
   TLoginFrm = class(TForm)
-    edtUser: TEdit;
     edtPW: TEdit;
     lblForgetPW: TcslLabel;
     lblVer: TLabel;
@@ -38,21 +37,30 @@ type
     btnLocalLogin: TCslButton;
     lblLocalHelp: TCslLabel;
     lblLocalServer: TCslLabel;
+    cbUser: TcxComboBox;
+    pmLogin: TPopupMenu;
+    nClearAccount: TMenuItem;
     procedure edtPWKeyDown(Sender: TObject; var Key: Word;
       Shift: TShiftState);
     procedure FormCreate(Sender: TObject);
     procedure btnLoginClick(Sender: TObject);
-    procedure edtUserKeyDown(Sender: TObject; var Key: Word;
-      Shift: TShiftState);
     procedure img1Click(Sender: TObject);
     procedure shpAccountMouseDown(Sender: TObject; Button: TMouseButton;
       Shift: TShiftState; X, Y: Integer);
     procedure shpPWMouseDown(Sender: TObject; Button: TMouseButton;
       Shift: TShiftState; X, Y: Integer);
     procedure btnCloseClick(Sender: TObject);
-    procedure edtUserClick(Sender: TObject);
+    procedure FormDestroy(Sender: TObject);
+    procedure cbUserKeyDown(Sender: TObject; var Key: Word;
+      Shift: TShiftState);
+    procedure cbUserClick(Sender: TObject);
+    procedure nClearAccountClick(Sender: TObject);
   private
     { Private declarations }
+    FUsersCon: TADOConnection;
+    FUsersQry: TADOQuery;
+    procedure ReadCloudUser;
+    procedure WriteCloudUser;
   public
     { Public declarations }
   end;
@@ -77,6 +85,7 @@ begin
     if Form.ShowModal = mrOK then
     begin
       Result := True;
+      Form.WriteCloudUser;
     end;
   finally
     Form.Free;
@@ -134,6 +143,8 @@ begin
   lblVer.Caption := G_ProductName + ' ' + ScGetVersion;
 //  lblVer.Left := lblProductName.Left + lblProductName.Width + 7;
 
+  ReadCloudUser;
+
   SL := TStringList.Create;
   try
     SL.Clear;
@@ -150,7 +161,7 @@ end;
 procedure TLoginFrm.btnLoginClick(Sender: TObject);
 var sInfo, sURL, sCheckCode, sMD5PW: string;
 begin
-  case PHPWeb.Login(edtUser.Text, edtPW.Text, sInfo, sCheckCode) of
+  case PHPWeb.Login(cbUser.Text, edtPW.Text, sInfo, sCheckCode) of
     ltCon:
     begin
       if Trim(sInfo) <> '' then
@@ -171,7 +182,7 @@ begin
     begin
       // 无法对PHP返回的字符串进行排版。这里使用Delphi自身的字符串。
       sInfo := '尊敬的用户：' + #13#13 +
-               '系统检测出您是通过SmartCost旧版本程序注册了本帐户(' + Trim(edtUser.Text) +
+               '系统检测出您是通过SmartCost旧版本程序注册了本帐户(' + Trim(cbUser.Text) +
                ')，因系统升级，为保障您的帐户安全和更好的为您服务，' + #13#13 +
                '我们需要对您的邮箱进行有效性验证，并需要您重置该帐户的密码以保证您的帐号在新程序上能够正常使用。' + #13#13 +
                '请点击“确定”按钮打开密码重置页面。';
@@ -198,7 +209,7 @@ begin
       try
         sMD5PW := GetMD5(edtPW.Text);
         sURL := Format('%s?Account=%s&Pwd=%s', [ConfigInfo.WebLoginURL,
-          edtUser.Text, sMD5PW]);
+          cbUser.Text, sMD5PW]);
         ShellExecute(Application.Handle, 'open', PChar(sURL), nil, nil, SW_SHOWNORMAL);
       finally
         Screen.Cursor := crDefault;
@@ -213,16 +224,6 @@ begin
   end;
 end;
 
-procedure TLoginFrm.edtUserKeyDown(Sender: TObject; var Key: Word;
-  Shift: TShiftState);
-begin
-  if Key = VK_Return then
-  begin
-    edtPW.SetFocus;
-    edtPW.SelectAll;
-  end;
-end;
-
 procedure TLoginFrm.img1Click(Sender: TObject);
 begin
   Close;
@@ -231,7 +232,7 @@ end;
 procedure TLoginFrm.shpAccountMouseDown(Sender: TObject; Button: TMouseButton;
   Shift: TShiftState; X, Y: Integer);
 begin
-  edtUser.SetFocus;
+  cbUser.SetFocus;
 end;
 
 procedure TLoginFrm.shpPWMouseDown(Sender: TObject; Button: TMouseButton;
@@ -245,46 +246,120 @@ begin
   Close;
 end;
 
-procedure TLoginFrm.edtUserClick(Sender: TObject);
-// For Test Quickly. chenshilong, 2015-09-30
-const
-  AccArr: array[1..11, 1..3] of string = (
-    ('1', '2636698008@qq.com', 'smartcost3850887'), // 纵横销售演示服务器
-    ('2', '1971614655@qq.com', '357134933..'),
-    ('3', '1835082984@qq.com', '123456'),
-    ('4', '2417587264@qq.com', 'koukou0708'),
-    ('5', '2609827960@qq.com', 'missling'),
-    ('6', '1240621850@qq.com', '87654321'),
-    ('7', '1014149875@qq.com', 'zhbwoai'),
-    ('8', '1525739553@qq.com', '123456'),
-    ('9', '1391010261@qq.com', 'missling'),
-    ('10', '916960227@qq.com', '123456'),
-    ('11', '916960227@qq.com', '12345678') // 测试服务器
-  );
+procedure TLoginFrm.FormDestroy(Sender: TObject);
+begin
+  FUsersCon.Close;
+  FUsersCon.Free;
+  FUsersQry.Free;
+end;
 
-var
-  i: Integer;
-  bEx: Boolean;
+procedure TLoginFrm.ReadCloudUser;
+var s: string;
 begin
-  if G_IsTest then
+  FUsersCon := TADOConnection.Create(nil);
+  FUsersCon.LoginPrompt := False;
+  s := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=CloudUser.dat;Persist Security Info=False';
+  FUsersCon.ConnectionString := s;
+  FUsersQry := TADOQuery.Create(nil);
+  FUsersQry.Connection := FUsersCon;
+  FUsersQry.SQL.Text := 'Select Top 15 * From Users Order by LoginTimes Desc';
+  FUsersQry.Open;
+  cbUser.Properties.Items.Clear;
+  if FUsersQry.RecordCount > 0 then
   begin
-    bEx := False;
-    for i := Low(AccArr) to High(AccArr) do
+    FUsersQry.First;
+    while not FUsersQry.Eof do
     begin
-      if AccArr[i, 1] = edtUser.Text then
-      begin
-        edtUser.Text := AccArr[i, 2];
-        edtPW.Text := AccArr[i, 3];
-        bEx := True;
-        Break;
-      end;
-    end;
-    if not bEx then
-    begin
-      edtUser.Clear;
-      edtPW.Clear;
+      cbUser.Properties.Items.Add(FUsersQry.FieldByName('Account').AsString);
+      FUsersQry.Next;
     end;
   end;
+  FUsersQry.Close;
+end;
+
+procedure TLoginFrm.WriteCloudUser;
+begin
+  FUsersQry.Close;
+  FUsersQry.SQL.Text := Format('Select * From Users where UserID = %d', [PHPWeb.UserID]);
+  FUsersQry.Open;
+  if FUsersQry.RecordCount > 0 then
+  begin
+    FUsersQry.Close;
+    FUsersQry.SQL.Text := Format('Update Users Set LoginTimes=LoginTimes+1 where UserID = %d', [PHPWeb.UserID]);
+    FUsersQry.ExecSQL;
+  end
+  else
+  begin
+    FUsersQry.Close;
+    FUsersQry.SQL.Text := Format('Insert into Users(UserID,Account,RealName,LoginTimes) Values(%d,''%s'',''%s'',1)',
+      [PHPWeb.UserID, PHPWeb.Account, PHPWeb.RealName]);
+    FUsersQry.ExecSQL;
+  end;
+  FUsersQry.Close;
+end;
+
+procedure TLoginFrm.cbUserKeyDown(Sender: TObject; var Key: Word;
+  Shift: TShiftState);
+begin
+  if Key = VK_Return then
+  begin
+    edtPW.SetFocus;
+    edtPW.SelectAll;
+  end;
+end;
+
+procedure TLoginFrm.cbUserClick(Sender: TObject);
+// For Test Quickly. chenshilong, 2015-09-30
+//const
+//  AccArr: array[1..11, 1..3] of string = (
+//    ('1', '2636698008@qq.com', 'smartcost3850887'), // 纵横销售演示服务器
+//    ('2', '1971614655@qq.com', '357134933..'),
+//    ('3', '1835082984@qq.com', '123456'),
+//    ('4', '2417587264@qq.com', 'koukou0708'),
+//    ('5', '2609827960@qq.com', 'missling'),
+//    ('6', '1240621850@qq.com', '87654321'),
+//    ('7', '1014149875@qq.com', 'zhbwoai'),
+//    ('8', '1525739553@qq.com', '123456'),
+//    ('9', '1391010261@qq.com', 'missling'),
+//    ('10', '916960227@qq.com', '123456'),
+//    ('11', '916960227@qq.com', '12345678') // 测试服务器
+//  );
+//
+//var
+//  i: Integer;
+//  bEx: Boolean;
+begin
+//  if G_IsTest then
+//  begin
+//    bEx := False;
+//    for i := Low(AccArr) to High(AccArr) do
+//    begin
+//      if AccArr[i, 1] = cbUser.Text then
+//      begin
+//        cbUser.Text := AccArr[i, 2];
+//        edtPW.Text := AccArr[i, 3];
+//        bEx := True;
+//        Break;
+//      end;
+//    end;
+//    if not bEx then
+//    begin
+//      cbUser.Clear;
+//      edtPW.Clear;
+//    end;
+//  end;
+end;
+
+procedure TLoginFrm.nClearAccountClick(Sender: TObject);
+begin
+  if Application.MessageBox('确定要清空所有记录的帐户信息吗？', '询问', MB_YESNO + MB_ICONQUESTION) = ID_No then
+    Exit;
+
+  FUsersQry.Close;
+  FUsersQry.SQL.Text := 'Delete * From Users';
+  FUsersQry.ExecSQL;
+  FUsersQry.Close;
+  cbUser.Properties.Items.Clear;
 end;
 
 end.