Пример:
открывается форма..на ней 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:не забываем использовать тэги