Measure/Forms/LoginFrm.pas

{*******************************************************************************
    单元名称： ScLoginFrm.pas

    单元说明： 网络版PHP Web页面登录方式。

    作者时间： Chenshilong, 2012-5-13
*******************************************************************************}


unit LoginFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, JimCombos, ExtCtrls, StdCtrls, cxLookAndFeelPainters,
  cxTextEdit, cxButtons, cxControls, cxEdit,
  cxMaskEdit, cxDropDownEdit, HookEdit, cxContainer, XPMenu, cslLabel,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP,
  CslButton, OleCtrls, SHDocVw, DB, ADODB, Menus;
  

type
  TLoginFrm = class(TForm)
    edtPW: TEdit;
    lblForgetPW: TcslLabel;
    lblVer: TLabel;
    shpAccount: TShape;
    imgBG: TImage;
    btnLogin: TCslButton;
    lblReg: TCslLabel;
    btnClose: TCslButton;
    lblProductName: TLabel;
    shpPW: TShape;
    wbLogin: TWebBrowser;
    pnlLocalServer: TPanel;
    btnLocalLogin: TCslButton;
    lblLocalHelp: TCslLabel;
    lblLocalServer: TCslLabel;
    cbUser: TcxComboBox;
    pmLogin: TPopupMenu;
    nClearAccount: TMenuItem;
    lblHint: TLabel;
    procedure edtPWKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormCreate(Sender: TObject);
    procedure btnLoginClick(Sender: TObject);
    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 FormDestroy(Sender: TObject);
    procedure cbUserKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure nClearAccountClick(Sender: TObject);
    procedure cbUserKeyPress(Sender: TObject; var Key: Char);
  private
    { Private declarations }
    FUsersCon: TADOConnection;
    FUsersQry: TADOQuery;
    procedure ReadCloudUser;
    procedure WriteCloudUser;
  public
    { Public declarations }
  end;

  function LoginForm: Boolean;

implementation

uses
  ScUtils, ShellAPI, IniFiles, ScConfig, Md5, PHPWebDm, ConstUnit, DebugUsers,
  FileDownLoadFrm;

{$R *.dfm}

function LoginForm: Boolean;
var
  Form: TLoginFrm;
begin
  Result := False;
  Form := TLoginFrm.Create(nil);
  try
    if Form.ShowModal = mrOK then
    begin
      Result := True;
      Form.WriteCloudUser;
    end;
  finally
    Form.Free;
  end;
end;

{ TLoginFrm }


procedure TLoginFrm.edtPWKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_Return then
    btnLoginClick(Sender);
end;

procedure TLoginFrm.FormCreate(Sender: TObject);
var SL: TStringList;
  ini: TIniFile;
begin
  lblHint.Caption := '';

  SetClassLong(Handle, GCL_STYLE, GetClassLong(Handle, GCL_STYLE) or CS_DROPSHADOW);

  Set8087CW(Default8087CW or $0004);
  Set8087CW(Longword($133f));

  ini := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'Cloud.ini');
  try
    G_Server := ini.ReadString('URL', 'Server', '');
    G_ServerType := ini.ReadString('URL', 'ServerType', '');
    G_CompanyName := ini.ReadString('URL', 'CompanyName', '');
    G_GuideURL := ini.ReadString('URL', 'GuideURL', '');
    G_MeasureURL := 'http://' + G_Server + ini.ReadString('URL', 'MeasureURL', '');
  finally
    ini.Free;
  end;

  if Trim(G_CompanyName) <> '' then
    lblProductName.Caption := G_CompanyName
  else
    lblProductName.Caption := G_ProductName;  

  // 服务器：1公有 2私有
  if G_ServerType = '2' then
  begin
    pnlLocalServer.Visible := True;
    lblLocalServer.URL := G_Server;
    lblLocalServer.Hint := G_Server;
    lblLocalHelp.URL := G_GuideURL;
    lblLocalHelp.Hint := G_GuideURL;
  end
  else if G_ServerType = '1' then
  begin
    pnlLocalServer.Visible := False;
  end;

  lblReg.URL := PHPWeb.RegURL;
  lblForgetPW.URL := PHPWeb.PwdURL;
  lblVer.Caption := G_ProductName + ' ' + ScGetVersion;
//  lblVer.Left := lblProductName.Left + lblProductName.Width + 7;

  ReadCloudUser;

  SL := TStringList.Create;
  try
    SL.Clear;
    SL.Add('about: <body><font size=4 color=Green>') ;
    SL.Add('正在打开网页请稍候...');
    SL.Add('</font></body>');

    wbLogin.Navigate(SL.Text);
    wbLogin.Navigate(PHPWeb.LoginBannerURL);
  finally
  end;

  if G_IsTest then
  begin
    cbUser.Text := '1835082984@qq.com';
    edtPW.Text := '654321';
  end;
end;

procedure TLoginFrm.btnLoginClick(Sender: TObject);
var sInfo, sURL, sMD5PW: string;
  vFDForm: TFileDownLoadForm;
begin
  lblHint.Caption := '';
  lblHint.Update;

  if Trim(cbUser.Text) = '' then
  begin
    lblHint.Caption := '请您输入账号后再登录';
    lblHint.Update;
    cbUser.SetFocus;
    Exit;
  end;

  if Trim(edtPW.Text) = '' then
  begin
    lblHint.Caption := '请您输入密码后再登录';
    lblHint.Update;
    edtPW.SetFocus;
    Exit;
  end;

  case PHPWeb.Login(Trim(cbUser.Text), edtPW.Text, 1, sInfo, sURL) of
    ltCon:
    begin
      ModalResult := mrOk;
    end;      

    ltLoginFail:
    begin
      lblHint.Caption := sInfo;
      lblHint.Update;
      edtPW.SetFocus;
      edtPW.SelectAll;
      ModalResult := mrNone;
    end;

    ltUpdate:
    begin
      if Application.MessageBox(PChar(sInfo), '系统提示', MB_OKCANCEL + MB_ICONQUESTION) = ID_OK then
      begin
        vFDForm := TFileDownLoadForm.Create(nil);
        try
          vFDForm.URL := sURL;
          vFDForm.ShowModal;
        finally
          vFDForm.Free;
        end;
      end;
    end;

    ltIncomplete:
    begin
      Application.MessageBox(PChar(sInfo), '系统提示', MB_OK + MB_ICONINFORMATION);
      ModalResult := mrNone;

      Screen.Cursor := crHourGlass;
      try
        sMD5PW := GetMD5(edtPW.Text);
        sURL := Format('%s?Account=%s&Pwd=%s', [ConfigInfo.WebLoginURL,
          cbUser.Text, sMD5PW]);
        ShellExecute(Application.Handle, 'open', PChar(sURL), nil, nil, SW_SHOWNORMAL);
      finally
        Screen.Cursor := crDefault;
      end;
    end;

    ltDisCon:
    begin
      Application.MessageBox('网络错误，请稍后重试！', '操作提醒', MB_OK + MB_ICONWARNING);
      ModalResult := mrNone;
    end;
  end;
end;

procedure TLoginFrm.img1Click(Sender: TObject);
begin
  Close;
end;

procedure TLoginFrm.shpAccountMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  cbUser.SetFocus;
end;

procedure TLoginFrm.shpPWMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  edtPW.SetFocus;
end;

procedure TLoginFrm.btnCloseClick(Sender: TObject);
begin
  Close;
end;

procedure TLoginFrm.FormDestroy(Sender: TObject);
begin
  FUsersCon.Close;
  FUsersCon.Free;
  FUsersQry.Free;
end;

procedure TLoginFrm.ReadCloudUser;
var s: string;
begin
  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
    FUsersQry.First;
    while not FUsersQry.Eof do
    begin
      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.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;

procedure TLoginFrm.cbUserKeyPress(Sender: TObject; var Key: Char);
begin
  {$IFDEF _mDebugView}
  if Key = #13 then
    edtPW.Text := GetDebugUsers.GetPassword(cbUser.Text);
  {$ENDIF}
end;

end.