آخرين پست هاي ارسالي انجمن ايران دلفي

تماشای رایگان فیلم ایرانی ، خارجی و کودک آکادمی دلفی
نمایش نتایج: از 1 به 66 از 66

موضوع: شروع پروژه بازی آنلاین - Delphi XE5 & Intaweb 14.0.32 & TMS Intraweb Component & SQL Server - علاقمندان به ما بپیوندند

Threaded View

  1. #11
    مدیر انجمن مجید آواتار ها
    تاریخ عضویت
    January 1970
    محل سکونت
    تهران
    نوشته ها
    167
    تشکر ها
    58
    تشکر شده 201 بار در 100 ارسال.

    پاسخ : شروع پروژه بازی آنلاین - Delphi XE5 & Intaweb 14.0.32 & TMS Intraweb Component & SQL Server - علاقمندان به ما بپیوندند

    هر کلاس میتواند دو پروسیجر Create و Destroy داشته باشه . این دو پروسیجر به ترتیب در زمان ساخت و حذف از حافظه ، فراخوانی میشوند . میتوانید در Create مقادیر اولیه برای فیلد ها در نظر بگیرید .

    نکته : فیلد ها همان قسمتهایی از کلاس هستند که با Property ها هم نام هستند و با حرف F شروع میشوند مانند Property UserID = Field FUserID
    Peroperty ها مقادیر خود را در فیلد ها نگهداری میکنند و از آنها فراخوانی میکنند. به بیانی دیگر Property ها واسطه ای میان کاربر و فیلد ها هستند


    برای ساخت پروسیجر Create روی کلاس کلیک راست کرده و از منویی که ظاهر میشود Add و سپس Constructor را انتخاب کنید
    و
    برای ساخت پروسیجر Destroy روی کلاس کلیک راست کرده و از منویی که ظاهر میشود Add و سپس Destructor را انتخاب کنید

    [برای مشاهده لینک ها شما باید عضو سایت باشید برای عضویت در سایت بر روی اینجا کلیک بکنید]

    حالا در کد مربوط به پروسیجر Create فیلد های کلاس را با مقادیر پیشفرض مقدار دهی میکنیم . پروسیجر Destroy در این کلاس بدون تغییر باقی خواهد ماند

    [برای مشاهده لینک ها شما باید عضو سایت باشید برای عضویت در سایت بر روی اینجا کلیک بکنید]


    در این مرحله توابع مورد نیاز را به کلاس اضافه میکنیم
    [برای مشاهده لینک ها شما باید عضو سایت باشید برای عضویت در سایت بر روی اینجا کلیک بکنید]


    و در انتها هم یک ADOConnection به ServerController اضافه میکنیم و به دیتابیس SQL وصلش میکنیم
    نام ADOConnection را به ADOConnectionMain تغییر بدید و خصوصیاتشو هم مثل تصویر تنظیم کنید

    [برای مشاهده لینک ها شما باید عضو سایت باشید برای عضویت در سایت بر روی اینجا کلیک بکنید]


    [برای مشاهده لینک ها شما باید عضو سایت باشید برای عضویت در سایت بر روی اینجا کلیک بکنید]

    و در انتها کد کلاس به شکل زیر خواهد شد . البته با کمی تغییر که خودتون متوجه میشید

    کد:
      type
        TUser = class
          public
          private
          var
            FUserID     : Integer;
            FUsername   : string;
            FPassword   : string;
            FFullName   : string;
            FTotalPoint : Integer;
            FEMail      : string;
            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;
          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;
            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;
    
      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              := '';
        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;
                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
                  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;

    اگر عمری بود در پست های بعدی کلاس های دیگر برنامه را قرار میدم
    ویرایش توسط مجید : 27 / June / 2015 در ساعت 08:27 PM

  2. 3 کاربر مقابل از مجید عزیز به خاطر این پست مفید تشکر کرده اند .

    admin (21 / June / 2015),meyti (05 / August / 2015),moj127 (04 / September / 2017)

موضوعات مشابه

  1. دانلود آخرین نسخه های IntraWeb
    توسط admin در انجمن برنامه نویسی تحت وب در دلفی
    پاسخ: 3
    آخرين نوشته: 25 / February / 2016, 03:27 PM
  2. پاسخ: 2
    آخرين نوشته: 15 / August / 2015, 02:30 AM
  3. طراحی سایت با Intraweb دلفی XE2
    توسط mosa در انجمن Embarcadero RAD Studio تحت وب
    پاسخ: 59
    آخرين نوشته: 19 / May / 2015, 01:51 PM
  4. دانلود یک پروژه ی ساده IntraWeb در دلفی 7
    توسط admin در انجمن دلفی 7 تحت وب
    پاسخ: 3
    آخرين نوشته: 19 / June / 2014, 09:36 PM
  5. قابلیت های جدید SQL Server 2014
    توسط admin در انجمن رادیو نیک آموز
    پاسخ: 0
    آخرين نوشته: 16 / February / 1970, 11:36 AM

علاقه مندي ها (Bookmarks)

علاقه مندي ها (Bookmarks)

مجوز های ارسال و ویرایش

  • شما نمیتوانید موضوع جدیدی ارسال کنید
  • شما امکان ارسال پاسخ را ندارید
  • شما نمیتوانید فایل پیوست کنید.
  • شما نمیتوانید پست های خود را ویرایش کنید
  •