#4 Практика Php+delphi,делаем Регистрацию И Авторизации Программы

[Lomanu4]

Пожалуйста Авторизируйтесь или Зарегистрируйтесь для просмотра скрытого текста.

первая форма

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Grids, Vcl.ValEdit, Vcl.Buttons,
  Vcl.StdCtrls, Vcl.ComCtrls, Vcl.Imaging.jpeg, Vcl.ExtCtrls,Unit3,unit4;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    TabSheet4: TTabSheet;
    TabSheet5: TTabSheet;
    TabSheet6: TTabSheet;
    TabSheet7: TTabSheet;
    Label5: TLabel;
    Edit5: TEdit;
    Edit6: TEdit;
    GroupBox1: TGroupBox;
    Label6: TLabel;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    ValueListEditor1: TValueListEditor;

    procedure PageControl1Change(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}






procedure TForm1.PageControl1Change(Sender: TObject);
       Var
       R:Word;

begin
  if (PageControl1.ActivePage=TabSheet2) or (PageControl1.ActivePage=TabSheet3) or
   (PageControl1.ActivePage=TabSheet4) or (PageControl1.ActivePage=TabSheet5) or (PageControl1.ActivePage=TabSheet6) or
   (PageControl1.ActivePage=TabSheet7) then
begin
r:= MessageDLG('ƒл¤ регестрации программы нажмите Yes,если вы зарегестрированы нажмите NO-дл¤ авторизации', mterror, [mbYes,mbNo,mbcancel], 0);
if R = mrYes then;
   begin
   PageControl1.ActivePage:=TabSheet1;
   form3.Show ;
   Form1.Hide;
   Form4.Hide;
   end;
if R=mrNo then
   begin
   form4.Show;
   form3.Hide  ;
     PageControl1.ActivePage:=TabSheet1;
   end;
if r=mrcancel then
   begin exit
   end;
end;
end;

Вторая форма

unit Unit3;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,System.Win.ComObj,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP;

type
  TForm3 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Button1: TButton;
    Label5: TLabel;
    IdHTTP1: TIdHTTP;
    Edit4: TEdit;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure IdHTTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
      AWorkCountMax: Int64);
    procedure IdHTTP1Work(ASender: TObject; AWorkMode: TWorkMode;
      AWorkCount: Int64);
    procedure IdHTTP1WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form3: TForm3;

implementation

uses
  Unit1, Unit4;

{$R *.dfm}

procedure TForm3.Button1Click(Sender: TObject);
var
voice:OleVariant;
logininfo:TStringList;
Response:TStringStream;
strpage,code:string;
begin
    voice:=CreateOleObject('SAPI.SPVoice')    ;
    voice.speak('Поздрравляем с регестрацией ',0);


   try
    logininfo := TStringList.Create;
     Response := TStringStream.Create('');
     logininfo.Add('username='+edit1.Text);
     logininfo.Add('login='+edit2.Text);
     logininfo.Add('password='+edit3.Text);
     logininfo.Add('r_password='+edit4.Text);
     logininfo.Add('submit=register');
     strpage:=IdHTTP1.Post('http://tutorial/connectdb.php',logininfo) ;
   // code:=IdHTTP1.Post('http://tutorial/connectdb.php',logininfo);
       Form3.Hide;
       Form1.Show;


   finally
     begin
       Response.Free;
       logininfo.Free;
     end;
   end;



end;

procedure TForm3.FormClose(Sender: TObject; var Action: TCloseAction);
begin
form1.Show
end;

procedure TForm3.IdHTTP1Work(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCount: Int64);
begin

      Form4.ProgressBar1.max:=AWorkCount;
end;

procedure TForm3.IdHTTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCountMax: Int64);
begin
   form4.ProgressBar1.Position:=0;
      Form4.ProgressBar1.max:=AWorkCountmax;
end;

procedure TForm3.IdHTTP1WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
begin
       form4.ProgressBar1.Position:=0;
end;

end.

Третья форма

unit Unit4;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.ComCtrls, Vcl.StdCtrls;

type
  TForm4 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    Label4: TLabel;
    Button2: TButton;
    ProgressBar1: TProgressBar;
    Timer1: TTimer;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form4: TForm4;

implementation

uses
  Unit1, Unit3;

{$R *.dfm}

procedure TForm4.Button1Click(Sender: TObject);
var
logininfo:TStringList;
Response:TStringStream;
strpage,code:string;
begin

try
    logininfo:=TStringList.Create;
    response:=TStringStream.Create('');
    logininfo.Add('e_login='+edit1.Text);
    logininfo.Add('e_password='+edit2.Text);
    logininfo.Add('enter=');

    strpage:=form3.IdHTTP1.Post('http://tutorial/connectdb.php',logininfo);
    code:=form3.IdHTTP1.Post('http://tutorial/connectdb.php',logininfo);
      if Pos ('OK',code) <> 0 then
begin
  form1.Show;
  form4.Hide;
end;

  if pos ('NOT OK',code)<> 0 then
         begin
           ShowMessage('Проверьте данные ');
         end;
finally
  logininfo.Free;
  Response.Free;
end;

end;

procedure TForm4.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Form1.Show;
end;

end.

 

[utmost]

Архив проекта удалили с сервера, перезалейте пожалуйста. Специально зарегался чтобы скачать, и тут такой облом.

 

[Lomanu4]

Извеняюсь за неудобства, мы дадим вам знать как перезайлем.

 

[Sergeyg378]

Здравствуйте. Файл с примером опять недоступен. Перезалейте, пожалуйста.

 

[Lomanu4]

Здравствуйте. Файл с примером опять недоступен. Перезалейте, пожалуйста.

исходник от делфи приложен, если вам нужен исходник php дайте мне знать.

 

[Sergeyg378]

По ссылке Весь проект тут пишет, что файл удален.