FormLogin

unit FormLogin;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls,
Vcl.ComCtrls, StdStyleActnCtrls;
type
TfrmLogin = class(TForm)
btnExit: TButton;
edtUsername: TEdit;
lblLoginT: TLabel;
shp1: TBevel;
shp2: TBevel;
lblUsername: TLabel;
edtPass: TEdit;
lblPassword: TLabel;
lblSignUp: TLabel;
lblUsernameS: TLabel; // ****** + "S" where S means
edtUsernameS: TEdit; // the component is for signing up
edtPassS: TEdit; // not for logging in.
lblPasswordS: TLabel;
edtRePassS: TEdit;
lblRePasswordS: TLabel;
btnSignUp: TButton;
btnLogin: TButton;
lblpassmatch: TLabel;
lblUserTaken: TLabel;
lblInvalidLogin: TLabel;
procedure btnExitClick(Sender: TObject);
procedure btnSignUpClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure edtUsernameSKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure edtPassSKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure edtRePassSKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure btnLoginClick(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
procedure ClearFields;
Procedure UpDir(loc: String); overload; // debug version prints location
// of call to console
procedure UpDir; overload; // Go up a directory
public
{ Public declarations }
AccountNumber: Integer;
AccountName: String;
Procedure CheckAndCreateDirectories;
end;
type
TAccountInfo = Record
AccountName: String[25];
AccountPass: String[25];
AccountNumber: Integer;
end;
// type TAccountFile = File of TAccountInfo;
var
frmLogin: TfrmLogin;
AccountFile: File of TAccountInfo;
AccountInfoRecord: TAccountInfo;
implementation
{$R *.dfm}
uses FormMain;
Procedure TfrmLogin.UpDir(loc: String);
begin
writeln(loc + ': ' + GetCurrentDir);
SetCurrentDir(ExtractFilePath(ExcludeTrailingPathDelimiter(GetCurrentDir)));
writeln(loc + ': ' + GetCurrentDir);
end;
Procedure TfrmLogin.UpDir;
begin
SetCurrentDirectory
(PChar(ExtractFilePath(ExcludeTrailingPathDelimiter(GetCurrentDir))));
end;
/// /////////////////////////////////////////////////////////////////////////////
procedure CheckForAllCompleteFields;
begin
if (frmLogin.lblpassmatch.Caption = 'Passwords Match') and
(frmLogin.edtUsernameS.Text <> '') and (frmLogin.edtPassS.Text <> '') and
(frmLogin.edtRePassS.Text <> '') and not(frmLogin.lblUserTaken.Visible) then
frmLogin.btnSignUp.Enabled := True
else
frmLogin.btnSignUp.Enabled := false;
end;
/// /////////////////////////////////////////////////////////////////////////////
Procedure CheckIfPasswordsMatch;
begin
frmLogin.lblpassmatch.Visible := True;
frmLogin.lblpassmatch.Font.Color := clred;
if (frmLogin.edtPassS.Text <> '') and (frmLogin.edtRePassS.Text <> '') then
begin // IF Start
if (frmLogin.edtPassS.Text = frmLogin.edtRePassS.Text) then
begin
frmLogin.lblpassmatch.Caption := 'Passwords Match';
frmLogin.lblpassmatch.Font.Color := clgreen;
end
else
begin
frmLogin.lblpassmatch.Caption := 'Passwords do not Match';
frmLogin.lblpassmatch.Font.Color := clred;
frmLogin.btnSignUp.Enabled := false;
end;
end; // ENDIF
end;
/// /////////////////////////////////////////////////////////////////////////////
function FindNextAccountNumber(AccountInfo: TAccountInfo): Integer;
var
CurrentAccountNum: Integer;
begin
SetCurrentDir(GetCurrentDir + '\Main Files');
AssignFile(AccountFile, 'AccountData.dat');
Reset(AccountFile);
while not Eof(AccountFile) do
begin // while
read(AccountFile, AccountInfo);
end; // while
Closefile(AccountFile);
Result := AccountInfo.AccountNumber + 1;
frmLogin.UpDir;
end;
/// /////////////////////////////////////////////////////////////////////////////
procedure ReadNewAccountToFile(AccountInfo: TAccountInfo);
begin
SetCurrentDir(GetCurrentDir + '\Main Files');
AssignFile(AccountFile, 'AccountData.dat');
Reset(AccountFile);
Seek(AccountFile, Filesize(AccountFile));
Write(AccountFile, AccountInfo);
Closefile(AccountFile);
frmLogin.UpDir;
end;
/// /////////////////////////////////////////////////////////////////////////////
procedure TfrmLogin.btnExitClick(Sender: TObject);
begin
close;
end;
/// /////////////////////////////////////////////////////////////////////////////
Function EncryptPass(Password: String): String;
var
Mod1, Count: Integer;
begin
Result := '';
Mod1 := Length(Password);
for Count := Low(Password) to (Length(Password)) do
begin
Result := Result + Chr(Ord(Password[Count]) + Mod1);
end;
end;
/// /////////////////////////////////////////////////////////////////////////////
Function DecryptPass(EncPassword: String): String;
var
Mod1, Count: Integer;
begin
Result := '';
Mod1 := Length(EncPassword);
for Count := Low(EncPassword) to (Length(EncPassword)) do
begin
Result := Result + Chr(Ord(EncPassword[Count]) - Mod1);
end;
end;
/// /////////////////////////////////////////////////////////////////////////////
Procedure AssignAccountDataS( { Username : String; Password : String; }
AccountInfo: TAccountInfo);
begin
AccountInfo.AccountName := frmLogin.edtUsernameS.Text;
AccountInfo.AccountPass := frmLogin.edtPassS.Text;
// AccountInfo.AccountNumber := AccountNum;
end;
/// /////////////////////////////////////////////////////////////////////////////
procedure TfrmLogin.btnLoginClick(Sender: TObject);
var
AccountFound: Boolean;
EncryptedPass: String;
begin
EncryptedPass := EncryptPass(edtPass.Text);
AccountFound := false;
SetCurrentDir(GetCurrentDir + '\Main Files');
AssignFile(AccountFile, 'AccountData.dat');
Reset(AccountFile);
while not Eof(AccountFile) do
begin // Start While //iterate through file until account is found
Read(AccountFile, AccountInfoRecord);
if (AccountInfoRecord.AccountName = edtUsername.Text) and
(AccountInfoRecord.AccountPass = EncryptedPass) then
begin
// login
frmLogin.AccountName := AccountInfoRecord.AccountName;
frmLogin.AccountNumber := AccountInfoRecord.AccountNumber;
frmLogin.Hide;
AccountFound := True;
break;
end;
end; // end While
frmLogin.UpDir; // go back to parent directory
if AccountFound then
begin
frmMain.Show; // Only show after finding account number;
lblInvalidLogin.Visible := false; // remove it if the user had previous
// //login attempt
end
else
begin
lblInvalidLogin.Visible := True;
end;
Closefile(AccountFile);
end;
/// /////////////////////////////////////////////////////////////////////////////
procedure CheckIfUserTaken;
begin
SetCurrentDir(GetCurrentDir + '\Main Files');
AssignFile(AccountFile, 'AccountData.dat');
Reset(AccountFile);
while not Eof(AccountFile) do
begin // while
read(AccountFile, AccountInfoRecord);
if AccountInfoRecord.AccountName = frmLogin.edtUsernameS.Text then
begin
frmLogin.lblUserTaken.Visible := True;
frmLogin.lblUserTaken.Caption := 'Username already taken';
frmLogin.lblUserTaken.Font.Color := clred;
break;
end
else
frmLogin.lblUserTaken.Visible := false;
end; // while
Closefile(AccountFile);
frmLogin.UpDir;
end;
procedure TfrmLogin.CheckAndCreateDirectories;
begin
if not DirectoryExists('Main Files') then
CreateDir('Main Files');
if not DirectoryExists('Flashcards') then
CreateDir('Flashcards');
if not DirectoryExists('Topic Tabs') then
CreateDir('Topic Tabs');
if not DirectoryExists('Notepads') then
CreateDir('Notepads');
if not DirectoryExists('Public Flashcards') then
CreateDir('Public Flashcards');
end;
procedure TfrmLogin.btnSignUpClick(Sender: TObject);
begin
AssignAccountDataS(AccountInfoRecord);
CheckIfUserTaken;
CheckForAllCompleteFields;
if btnSignUp.Enabled then
begin
AccountInfoRecord.AccountName := frmLogin.edtUsernameS.Text;
AccountInfoRecord.AccountPass := EncryptPass(frmLogin.edtPassS.Text);
AccountInfoRecord.AccountNumber := FindNextAccountNumber(AccountInfoRecord);
ReadNewAccountToFile(AccountInfoRecord);
frmLogin.AccountName := AccountInfoRecord.AccountName;
frmLogin.AccountNumber := AccountInfoRecord.AccountNumber;
frmMain.Show;
frmLogin.ClearFields;
end
end;
/// //////////Begin checks on user-entered data////////////////////
procedure TfrmLogin.edtPassSKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
CheckIfPasswordsMatch;
CheckForAllCompleteFields;
end;
procedure TfrmLogin.edtRePassSKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
CheckIfPasswordsMatch;
CheckForAllCompleteFields;
end;
procedure TfrmLogin.edtUsernameSKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
CheckForAllCompleteFields;
lblUserTaken.Visible := false;
end;
/// /////////End Checks//////////////////////////////////////////////
procedure TfrmLogin.FormCreate(Sender: TObject);
begin
frmLogin.Height := Screen.WorkAreaHeight;
frmLogin.Width := Screen.WorkAreaWidth;
frmLogin.CheckAndCreateDirectories;
/// //////////
SetCurrentDir(GetCurrentDir + '\Main Files');
{$I-}
AssignFile(AccountFile, 'AccountData.dat');
Reset(AccountFile);
Closefile(AccountFile);
{$I+}
frmLogin.UpDir; // check to see if an old file exists
if (IOResult <> 0) then // already
begin
SetCurrentDir(GetCurrentDir + '\Main Files');
Rewrite(AccountFile);
Closefile(AccountFile); // Create a new file for writing to
frmLogin.UpDir;
end;
/// ////////
// if (Screen.Width <> 1920) and (Screen.Height <> 1080) then
frmLogin.VertScrollBar.Position := frmLogin.VertScrollBar.Range.MinValue;
// this doesn't currently appear to work
lblpassmatch.Visible := false;
lblInvalidLogin.Visible := false;
lblpassmatch.Caption := 'Passwords do not match';
lblpassmatch.Font.Color := clred;
btnSignUp.Enabled := false;
lblUserTaken.Visible := false;
end;
procedure TfrmLogin.FormShow(Sender: TObject);
begin
frmLogin.ClearFields;
end;
procedure TfrmLogin.ClearFields; // Clears all edit boxes and labels
begin
frmLogin.edtPass.Clear;
frmLogin.edtPassS.Clear;
frmLogin.edtRePassS.Clear;
frmLogin.edtUsername.Clear;
frmLogin.edtUsernameS.Clear;
frmLogin.lblpassmatch.Visible := false;
frmLogin.lblUserTaken.Visible := false;
frmLogin.lblInvalidLogin.Visible := false;
end;
end.