کد:
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 := '0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ';
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;
اگه امکان داره ابتدا خودتون پروژه رو استارت بزنید تا بقیه هم راغب بشوند ...
نوشته اصلی توسط meyti
[برای مشاهده لینک ها شما باید عضو سایت باشید 
علاقه مندي ها (Bookmarks)