{******************************************************************************* 单元名称： 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: ') ; SL.Add('正在打开网页请稍候...'); SL.Add(''); 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.