untlogin.pas

实现了：自动锁屏

unit untLogin;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, untXml, untHttp, untGlobal, shellapi, WinSkinData,
  ExtCtrls, jpeg, ComCtrls, IniFiles, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, IdHTTP;

type
  TfrmLogin = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    edtUser: TEdit;
    edtPwd: TEdit;
    labRegister: TLabel;
    Label3: TLabel;
    cbServer: TComboBox;
    btnCancel: TButton;
    btnOK: TButton;
    labTips: TLabel;
    SkinData1: TSkinData;
    rbUser: TRadioButton;
    rbExpert: TRadioButton;
    rbHospital: TRadioButton;
    idHttp: TIdHTTP;
    procedure btnOKClick(Sender: TObject);
    procedure labRegisterClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    procedure LoadParameter();
    procedure SaveParameter();
  public
    { Public declarations }

  end;

  function Login(): boolean;

implementation

{$R *.dfm}

function Login(): boolean;
begin
  with TfrmLogin.create(application) do   //创建并显示登陆界面
  begin
    if ShowModal = mrok then result := true else result := false;
    free;
  end;
end;

procedure TfrmLogin.btnOKClick(Sender: TObject);
var
  LoginXml: string;
  Server: string;
begin

  Server := cbServer.Text;
  mUrl.Server := Copy(Server, 1, Pos(':', Server) - 1);
  Delete(Server, 1, Pos(':', Server));
  mUrl.Port := strtoint(Server);
  mUrl.Url := Format('http://%s:%d/edu/hospital.ejf?', [mUrl.Server, mUrl.Port]);

  LoginXml := GetXml('login', Trim(edtUser.Text), Trim(edtPwd.Text));
  mUser := LoginParze(LoginXml);

  if mUser.Uid = 0 then
  begin
    labTips.Caption := mUser.UserName;
    edtUser.SetFocus;
    self.ModalResult := mrNone;
  end
  else
  begin
    mUrl.Url := Format('%s&uid=%d&pwd=%s', [mUrl.Url, mUser.Uid, mUser.Password]);
    self.ModalResult := mrOK;
  end;
end;

procedure TfrmLogin.labRegisterClick(Sender: TObject);
var
  Server: string;
begin
  Server := cbServer.Text;
  mUrl.Server := Copy(Server, 1, Pos(':', Server) - 1);
  Delete(Server, 1, Pos(':', Server));
  mUrl.Port := strtoint(Server);
  mUrl.Url := Format('http://%s:%d/edu/hospital.ejf?', [mUrl.Server, mUrl.Port]);
  ShellExecute(Handle, 'OPEN', PChar(mUrl.Url + 'action=register'), nil, nil, SW_SHOWNORMAL);
end;

procedure TfrmLogin.FormCreate(Sender: TObject);
begin
  LoadParameter();
end;

procedure TfrmLogin.LoadParameter();
var
  Ini: TIniFile;
  i, Server, iType: integer;
begin
  Ini := TIniFile.Create(ChangeFileExt(Application.ExeName, '.INI'));
  try
    edtUser.Text := Ini.ReadString('Server', 'User', '');
    edtPwd.Text := DecodePwd(Ini.ReadString( 'Server', 'Pwd', ''));
    Server := Ini.ReadInteger('Server', 'Count', 1);
    iType := Ini.ReadInteger('Server', 'Type', 1);

    case iType of
      1: rbUser.Checked := True;
      2: rbExpert.Checked := True;
      3: rbHospital.Checked := True;
    end;

    for i := 1 to Server do
    begin
      cbServer.AddItem(Format('%s:%d', [Ini.ReadString('Server' + inttostr(i), 'Host', ''),
                       Ini.ReadInteger('Server' + inttostr(i), 'Port', 80)]), cbServer);
    end;

    cbServer.ItemIndex := Ini.ReadInteger( 'Server', 'Default', 1 ) - 1;
  finally
    Ini.Free;
  end;
end;

procedure TfrmLogin.SaveParameter();
var
  Ini: TIniFile;
  iType: integer;
begin
  Ini := TIniFile.Create(ChangeFileExt(Application.ExeName, '.INI'));
  try
    Ini.WriteString('Server', 'User', edtUser.Text );
    Ini.WriteString('Server', 'Pwd', EncodePwd(edtPwd.Text));
    Ini.WriteInteger('Server', 'Default', cbServer.ItemIndex + 1);

    if rbUser.Checked then
      iType := 1
    else
    if rbExpert.Checked then
      iType := 2
    else
    if rbHospital.Checked then
      iType := 3;

    Ini.WriteInteger('Server', 'Type', iType);

  finally
    Ini.Free;
  end;
end;

procedure TfrmLogin.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  SaveParameter();
end;

end.