maixinrong
/
Measure


			
							123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354
							{*******************************************************************************
    单元名称： 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);
  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;


{$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 := '1971614655@qq.com';
    edtPW.Text := '357134933..';
  end;
end;

procedure TLoginFrm.btnLoginClick(Sender: TObject);
var sInfo, sURL, sCheckCode, sMD5PW: string;
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(cbUser.Text, edtPW.Text, 1, sInfo, sCheckCode) of
    ltCon:
    begin
      if Trim(sInfo) <> '' then
        Application.MessageBox(PChar(sInfo), '新版本提示', MB_OK + MB_ICONINFORMATION);

      ModalResult := mrOk;
    end;

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

    ltUpdate:
    begin
      // 无法对PHP返回的字符串进行排版。这里使用Delphi自身的字符串。
      sInfo := '尊敬的用户：' + #13#13 +
               '系统检测出您是通过SmartCost旧版本程序注册了本帐户(' + Trim(cbUser.Text) +
               ')，因系统升级，为保障您的帐户安全和更好的为您服务，' + #13#13 +
               '我们需要对您的邮箱进行有效性验证，并需要您重置该帐户的密码以保证您的帐号在新程序上能够正常使用。' + #13#13 +
               '请点击“确定”按钮打开密码重置页面。';
      Application.MessageBox(PChar(sInfo), '升级提示', MB_OK + MB_ICONINFORMATION);
      edtPW.SetFocus;
      edtPW.SelectAll;
      ModalResult := mrNone;

      Screen.Cursor := crHourGlass;
      try
        sURL := ConfigInfo.OldUserResetPwdURL + '?CheckCode=' + sCheckCode;
        ShellExecute(Application.Handle, 'open', PChar(sURL), nil, nil, SW_SHOWNORMAL);
      finally
        Screen.Cursor := crDefault;
      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;

end.