maixinrong
/
Measure


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

type
  TLoginFrm = class(TForm)
    edtUser: TEdit;
    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;
    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);
  private
    { Private declarations }
  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;
    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
  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_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;
  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;

  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;
end;

procedure TLoginFrm.btnLoginClick(Sender: TObject);
var sInfo, sURL, sCheckCode, sMD5PW: string;
begin
  case PHPWeb.Login(edtUser.Text, edtPW.Text, sInfo, sCheckCode) of
    ltCon:
    begin
      if Trim(sInfo) <> '' then
        Application.MessageBox(PChar(sInfo), '新版本提示', MB_OK + MB_ICONINFORMATION);

      ModalResult := mrOk;
    end;

    ltLoginFail:
    begin
      Application.MessageBox(PChar(sInfo), '操作提醒', MB_OK + MB_ICONWARNING);
      edtPW.SetFocus;
      edtPW.SelectAll;
      ModalResult := mrNone;
    end;

    ltUpdate:
    begin
      // 无法对PHP返回的字符串进行排版。这里使用Delphi自身的字符串。
      sInfo := '尊敬的用户：' + #13#13 +
               '系统检测出您是通过SmartCost旧版本程序注册了本帐户(' + Trim(edtUser.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,
          edtUser.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.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;
end;

procedure TLoginFrm.shpAccountMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  edtUser.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.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') // 测试服务器
  );

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] = 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;
    end;
  end;
end;

end.