سلام
امروز کلاس TUserProfile را میسازیم
روی قسمت خالی محیط دیاگرام کلیک راست کرده و از منویی که ظاهر میشود Add و سپس Structure را انتخاب کنید .
236
یک Structure ایجاد میشود
237
نام Structure1 را به TUserProfile تغییر بدید
238
مانند کلاس TUser خصوصیات (Peroperty ها) را به کلاس اضافه میکنیم
Point3 و Count3 برای امتیاز بازی و تعداد رمز های پیدا شده در سطح ساده
Point4 و Count4 برای امتیاز بازی و تعداد رمز های پیدا شده در سطح متوسط
Point5 و Count5 برای امتیاز بازی و تعداد رمز های پیدا شده در سطح سخت
239
به کلاس TUser یک Property با نام UserProfile از نوع TUserProfile اضافه میکنیم
240
به ارتباطی که بین دوکلاس برقرار شده است توجه کنید
241
یک Procedure به کلاس TUserProfile اضافه کنید و نام آن را Initial بگذارید
242
243
و بدنه Procedure را به شکل زیر کد نویسی کنید
244
مانند شکل زیر کلاس TUser را ویرایش کنید
246
کلاس TUserProfile اطلاعات مربوط به امتیازات و تعداد رمز های پیدا شده توسط کاربر را در اختیار شما میگذارد
unit WordGame_Namespace;
interface
uses
IdComponent,
IdTCPConnection,
IdTCPClient,
IdSSLOpenSSL,
IdIOHandler,
IdIOHandlerSocket,
IdIOHandlerStack,
IdSSL,
IdMessageClient,
IdSMTP,
IdBaseComponent,
IdMessage,
IdExplicitTLSClientServerBase,
IdSMTPBase,
Forms,
System.Classes,
ServerController,
StrUtils,
Data.DB,
Data.Win.ADODB,
SysUtils;
type
TUserProfile = record
private
FPoint3: Integer;
FPoint4: Integer;
FPoint5: Integer;
FCount3: Integer;
FCount4: Integer;
FCount5: Integer;
procedure SetPoint3(val: Integer);
procedure SetPoint4(val: Integer);
procedure SetPoint5(val: Integer);
procedure SetCount3(val: Integer);
procedure SetCount4(val: Integer);
procedure SetCount5(val: Integer);
procedure Initial(aUserID: Integer);
public
property Point3: Integer read FPoint3 write SetPoint3;
property Point4: Integer read FPoint4 write SetPoint4;
property Point5: Integer read FPoint5 write SetPoint5;
property Count3: Integer read FCount3 write SetCount3;
property Count4: Integer read FCount4 write SetCount4;
property Count5: Integer read FCount5 write SetCount5;
end;
TUser = class
public
private
var
FUserID : Integer;
FUsername : string;
FPassword : string;
FFullName : string;
FTotalPoint : Integer;
FEMail : string;
FUserProfile: TUserProfile;
procedure SetUserID(val: Integer);
procedure SetUsername(val: string);
procedure SetPassword(val: string);
procedure SetFulName(val: string);
procedure SetTotalPoint(val: Integer);
procedure SetEMail(val: string);
function SendMail(aSMTP: TIdSMTP; aMailMessage: TIdMessage; aSubject, aBody: WideString): string;
procedure SetUserProfile(val: TUserProfile);
public
property UserID : Integer read FUserID write SetUserID;
property Username : string read FUsername write SetUsername;
property Password : string read FPassword write SetPassword;
property FullName : string read FFullName write SetFulName;
property TotalPoint : Integer read FTotalPoint write SetTotalPoint;
property EMail : string read FEMail write SetEMail;
property UserProfile: TUserProfile read FUserProfile write SetUserProfile;
constructor Create;
destructor Destroy; override;
function Login: TUser;
function GetUserInfo(aUsername: string; aUserID: Integer = 0; aEMail: string = ''): TUser;
function RegisterUser: TUser;
function UpdateUser: boolean;
function ChangePassword(NewPassword: string): boolean;
procedure SendNewPasswordEmail(aSMTP: TIdSMTP; aMailMessage: TIdMessage);
end;
function RandomPassword(PLen: Integer): string;
function fOpen(aQry: WideString): TADOQuery;
function fOpenReturnInt(aQry: WideString): Integer;
function fOpenReturnStr(aQry: WideString): String;
function fRun(aQry: WideString): Integer;
implementation
function RandomPassword(PLen: Integer): string;
var
str: string;
begin
Randomize;
str := '0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLM NOPQRSTUVWXYZ';
Result := '';
repeat
Result := Result + str[Random(Length(str)) + 1];
until (Length(Result) = PLen);
end;
function fOpen(aQry: WideString): TADOQuery;
var
A: TADOQuery;
begin
try
A := TADOQuery.Create(Application);
A.Connection := IWServerController.ADOConnectionMain;
A.Close;
A.SQL.Text := aQry;
A.Open;
Result := A;
except
on E: Exception do
begin
// Error Handling
end;
end;
end;
function fOpenReturnInt(aQry: WideString): Integer;
var
A: TADOQuery;
begin
try
try
A := TADOQuery.Create(Application);
A.Connection := IWServerController.ADOConnectionMain;
A.Close;
A.SQL.Text := aQry;
A.Open;
Result := A.Fields[0].AsInteger;
except
on E: Exception do
begin
// Error Handling
end;
end;
finally
FreeAndNil(A);
end;
end;
function fOpenReturnStr(aQry: WideString): String;
var
A: TADOQuery;
begin
try
try
A := TADOQuery.Create(Application);
A.Connection := IWServerController.ADOConnectionMain;
A.Close;
A.SQL.Text := aQry;
A.Open;
Result := A.Fields[0].AsString;
except
on E: Exception do
begin
// Error Handling
end;
end;
finally
FreeAndNil(A);
end;
end;
function fRun(aQry: WideString): Integer;
var
A: TADOQuery;
begin
try
try
A := TADOQuery.Create(Application);
A.Connection := IWServerController.ADOConnectionMain;
A.Close;
A.SQL.Text := aQry;
Result := A.ExecSQL;
except
on E: Exception do
begin
// Error Handling
end;
end;
finally
FreeAndNil(A);
end;
end;
procedure TUserProfile.SetPoint3(val: Integer);
begin
FPoint3 := val;
end;
procedure TUserProfile.SetPoint4(val: Integer);
begin
FPoint4 := val;
end;
procedure TUserProfile.SetPoint5(val: Integer);
begin
FPoint5 := val;
end;
procedure TUserProfile.SetCount3(val: Integer);
begin
FCount3 := val;
end;
procedure TUserProfile.SetCount4(val: Integer);
begin
FCount4 := val;
end;
procedure TUserProfile.SetCount5(val: Integer);
begin
FCount5 := val;
end;
procedure TUserProfile.Initial(aUserID: Integer);
var
V: TADOQuery;
I: Integer;
begin
if aUserID <> 0 then
begin
V := fOpen('Exec sp_UserProfile ' + IntToStr(aUserID));
if V.RecordCount > 0 then
begin
Point3 := V.FieldByName('Point3').AsInteger;
Point4 := V.FieldByName('Point4').AsInteger;
Point5 := V.FieldByName('Point5').AsInteger;
Count3 := V.FieldByName('Count3').AsInteger;
Count4 := V.FieldByName('Count4').AsInteger;
Count5 := V.FieldByName('Count5').AsInteger;
end;
FreeAndNil(V);
end;
end;
procedure TUser.SetUserID(val: Integer);
begin
FUserID := val;
end;
procedure TUser.SetUsername(val: string);
begin
FUsername := val;
end;
procedure TUser.SetPassword(val: string);
begin
FPassword := val;
end;
procedure TUser.SetFulName(val: string);
begin
FFullName := val;
end;
procedure TUser.SetTotalPoint(val: Integer);
begin
FTotalPoint := val;
end;
procedure TUser.SetEMail(val: string);
begin
FEMail := val;
end;
constructor TUser.Create;
begin
inherited Create;
FUserID := 0;
FUsername := '';
FPassword := '';
FFullName := '';
FTotalPoint := 0;
FEMail := '';
FUserProfile.Point3 := 0;
FUserProfile.Point4 := 0;
FUserProfile.Point5 := 0;
FUserProfile.Count3 := 0;
FUserProfile.Count4 := 0;
FUserProfile.Count5 := 0;
end;
destructor TUser.Destroy;
begin
inherited Destroy;
end;
function TUser.Login: TUser;
var
V: Integer;
begin
Result := nil;
V := fOpenReturnInt('Select Count(*) from Users where Username = ' + QuotedStr(Username) + ' and Password = ' +
QuotedStr(Password));
if V > 0 then
Result := GetUserInfo(Username);
end;
function TUser.GetUserInfo(aUsername: string; aUserID: Integer = 0; aEMail: string = ''): TUser;
var
WHR_Clause: String;
V : TADOQuery;
I : Integer;
begin
Result := nil;
if aUserID <> 0 then
WHR_Clause := ' UserID = ' + IntToStr(aUserID)
else if aUsername <> '' then
WHR_Clause := ' Username = ' + QuotedStr(aUsername)
else if aEMail <> '' then
WHR_Clause := ' EMail = ' + QuotedStr(aEMail);
V := fOpen('Select * from Users where ' + WHR_Clause);
if V.RecordCount > 0 then
begin
Result := TUser.Create;
with Result do
begin
UserID := V.FieldByName('UserID').AsInteger;
FullName := V.FieldByName('FullName').AsString;
Username := V.FieldByName('Username').AsString;
Password := V.FieldByName('Password').AsString;
TotalPoint := V.FieldByName('TotalPoint').AsInteger;
EMail := V.FieldByName('EMail').AsString;
UserProfile.Initial(UserID);
end;
end;
FreeAndNil(V);
end;
function TUser.RegisterUser: TUser;
var
V: Integer;
begin
Result := nil;
V := fOpenReturnInt('Select Count(*) from Users where Username = ' + QuotedStr(Username));
if V = 0 then
begin
V := fOpenReturnInt('INSERT INTO Users (Username, Password, FullName, TotalPoint, EMail) VALUES (' +
QuotedStr(Username) + ',' + QuotedStr(Password) + ', N' + QuotedStr(FullName) + ',0,' +
QuotedStr(EMail) + '); Select Scope_Identity();');
if V > 0 then
begin
fRun('INSERT INTO UserProfile (UserID, DifficultyLevel, Point, PasswordCount) VALUES (' + IntToStr(V) +
', 3, 0, 0)');
fRun('INSERT INTO UserProfile (UserID, DifficultyLevel, Point, PasswordCount) VALUES (' + IntToStr(V) +
', 4, 0, 0)');
fRun('INSERT INTO UserProfile (UserID, DifficultyLevel, Point, PasswordCount) VALUES (' + IntToStr(V) +
', 5, 0, 0)');
Result := Self.GetUserInfo(Self.Username);
Self := Result;
end;
end;
end;
function TUser.UpdateUser: boolean;
var
V: Integer;
begin
Result := False;
V := fRun('Update Users SET FullName = N' + QuotedStr(FullName) + ' where UserID = ' + IntToStr(UserID));
if V > 0 then
Result := True;
end;
function TUser.ChangePassword(NewPassword: string): boolean;
var
V: Integer;
begin
Result := False;
V := fRun('Update Users set Password = ' + QuotedStr(NewPassword) + ' where UserID = ' + IntToStr(UserID));
if V > 0 then
Result := True;
end;
procedure TUser.SendNewPasswordEmail(aSMTP: TIdSMTP; aMailMessage: TIdMessage);
var
Subject, Body: WideString;
NewPass : String;
begin
NewPass := RandomPassword(10);
Subject := ':: ' + IWServerController.AppName + ' :: تغییر رمز عبور ::';
Body := 'کاربر گرامی ، ' + FullName + 'اقدام به درخواست رمز عبور جدید کرده اید . ' + IWServerController.AppName +
' شما از طریق کنترل پنل خود در سایت <br>' +
'رمز عبور جدید شما : ' + NewPass;
Self.ChangePassword(NewPass);
SendMail(aSMTP, aMailMessage, Subject, Body);
end;
function TUser.SendMail(aSMTP: TIdSMTP; aMailMessage: TIdMessage; aSubject, aBody: WideString): string;
var
S: String;
begin
// setup SMTP
aSMTP.Host := 'smtp.gmail.com';
aSMTP.Port := 25; // for smtp.gmail.com
// setup mail message
aMailMessage.From.Address := 'Email@gmail.com';
aMailMessage.Recipients.EMailAddresses := EMail;
aMailMessage.ContentType := 'text/html';
aMailMessage.Subject := 'Subject Email';
S := '<table style="FONT-SIZE: 12px; font-name: Tahoma" dir="rtl" border="1" cellspacing="1" cellpadding="1" width="100%">';
S := S + '<tr><td>' + aBody + '</td></tr>';
S := S + '</table>';
aMailMessage.CharSet := 'UTF-8';
aMailMessage.Body.Text := S;
// send mail
try
try
aSMTP.Connect;
aSMTP.Send(aMailMessage);
except
on E: Exception do
// Error Handling
end;
finally
if aSMTP.Connected then
aSMTP.Disconnect;
end;
end;
procedure TUser.SetUserProfile(val: TUserProfile);
begin
FUserProfile := val;
end;
در پست بعدی یک فایل Backup از دیتابیس بازی را قرار میدم تا بتونید نگاه دقیقتری به جزئیات داشته باشید