Показать сообщение отдельно
  #3  
Старый 28.03.2008, 22:46
Кодер Кодер вне форума
Активный
 
Регистрация: 25.02.2008
Сообщения: 395
Репутация: -599
По умолчанию

Пример:
открывается форма..на ней 2 поля edit
1-имя пользователя
2-пароль

2 кнопки -вход и выход
чекбокс-регистрировать или нет

если галочка на cb_regmark поставил пользователь то регистрировать нового пользователя , если не поставил то входить, но проверять на наличие уже такого пользователя..
Пароли пока что не шыфровал, еще рано, надо основу построить.
Не буду мелочиться ловите код, но почему то он у меня пашет..старый случайно удалил..
Код:
unit unit_userstart;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, XPMan, StdCtrls;

type
  Tfrm_userstart = class(TForm)
    Image1: TImage;
    Label1: TLabel;
    box_username: TEdit;
    Label2: TLabel;
    box_userpassword: TEdit;
    btn_userstart_ok: TButton;
    btn_userstart_cancel: TButton;
    cb_regmark: TCheckBox;
    XPManifest1: TXPManifest;
    message: TLabel;
    procedure btn_userstart_cancelClick(Sender: TObject);
    procedure btn_userstart_okClick(Sender: TObject);
    procedure cb_regmarkClick(Sender: TObject);
    procedure Image1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frm_userstart: Tfrm_userstart;

implementation

uses unit_main;

{$R *.dfm}

procedure Tfrm_userstart.btn_userstart_cancelClick(Sender: TObject);
begin
close;
end;

procedure Tfrm_userstart.btn_userstart_okClick(Sender: TObject);
var
f:textfile;
fs:tstringlist;
s:string;
begin
{ПРОВЕРКА НА РЕГИСТРАЦИЮ}
if cb_regmark.Checked=true then
begin
  {ПРИ РЕГИСТРАЦИИ ПРОВЕРЯЕМ НА НАЛИЧИЕ ТАКОГО ЖЕ ПОЛЬЗОВАТЕЛЯ}
  {$I-}mkdir('users\'+box_username.Text);{$I+}
  if ioresult=0 then
    begin
  {СОЗДАЕМ ДИРЕКТОРИЮ И ФАЙЛЫ ДЛЯ ТЕКУЩЕГО ПОЛЬЗОВАТЕЛЯ}
    assignfile(f,'users\'+box_username.Text+'\data.ejd');
    rewrite(f);
    closefile(f);
  {ЗАБИВАЕМ ПАРОЛЬ ПОЛЬЗОВАТЕЛЯ}
    fs:=tstringlist.Create;
    fs.LoadFromFile('users\'+box_username.Text+'\data.ejd');
    fs.Strings[fs.Count-1]:=box_userpassword.text;
    assignfile(f,'users\'+box_username.Text+'\worklist.ejd');
    rewrite(f);
    closefile(f);
    frm_userstart.Visible:=false;
    frm_main.visible:=true;
    end
  else
    begin
  {ВЫДАЕМ СООБЩЕНИЕ О НАЛИЧИЕ В ПАПКАХ ПРОГРАММЫ ТАКОГО ПОЛЬЗОВАТЕЛЯ}
    message.Caption:='=Ошибка==========='+#13+'Такой пользователь уже '+#13+'существует';
    box_username.Text:='';
    box_userpassword.Text:='';
    end;
end
else
  begin
  {АВТОРИЗУЕМ ПОЛЬЗОВАТЕЛЯ}
if (box_username.text='') or (box_userpassword.text='') then
    message.Caption:='=Ошибка============='+#13+'Имя пользователя или пароль '+#13+'не действительны'
else
  begin
      {$I-}mkdir('users\'+box_username.Text);{$I+}
      if ioresult<>0 then
          message.Caption:='=Ошибка============='+#13+'Имя пользователя или пароль '+#13+'не действительны'
      else
        begin
          fs:=TstringList.Create;
          fs.LoadFromFile('users\'+box_username.Text+'\data.ejd');
          if fs.Strings[1]=box_userpassword.Text then
            begin
              frm_userstart.Visible:=false;
              frm_main.visible:=true;
            end
          else
            begin
              message.Caption:='=Ошибка============='+#13+'Имя пользователя или пароль '+#13+'не действительны';
            end;
        end;
  end;
  end;
end;
procedure Tfrm_userstart.cb_regmarkClick(Sender: TObject);
begin
if btn_userstart_ok.Caption<>'Регистрация' then
btn_userstart_ok.Caption:='Регистрация'
else
btn_userstart_ok.Caption:='Войти';
end;
procedure Tfrm_userstart.Image1Click(Sender: TObject);
begin

end;

end.

Aristarh Dark:не забываем использовать тэги
Ответить с цитированием