Diff of /UserSessionUnit.pas

OSDN > Find Software > zencart-clone

 Browse Subversion Repository



/[zencart-clone]/UserSessionUnit.pas




Diff of /UserSessionUnit.pas



 Parent Directory

|  Revision Log



|  Patch














revision 1 by yamat0jp,
Sun Nov 22 11:18:44 2015 UTC




revision 16 by yamat0jp,
Sat Aug  6 08:27:34 2016 UTC






#

Line 8 
 unit UserSessionUnit;


Line 8 
 unit UserSessionUnit;












8
 interface
 interface

















9
 
 

















10
 uses
 uses















11


   IWUserSessionBase, SysUtils, Classes, FireDAC.Stan.Intf, FireDAC.Stan.Option,


   IWUserSessionBase, SysUtils, Classes, Unit3, graphics, Data.DB, jpeg;
















   FireDAC.Stan.Param, FireDAC.Stan.Error, FireDAC.DatS, FireDAC.Phys.Intf,


 
















   FireDAC.DApt.Intf, FireDAC.Stan.Async, FireDAC.DApt, FireDAC.UI.Intf,


 
















   FireDAC.Stan.Def, FireDAC.Stan.Pool, FireDAC.Phys, FireDAC.Phys.IB,


 
















   FireDAC.Phys.IBDef, Data.DB, FireDAC.Comp.Client, FireDAC.Comp.DataSet, Unit4;


 















12
 
 

















13
 type
 type














   TPage = (Main,Info);
 










 
 













14
   TIWUserSession = class(TIWUserSessionBase)
   TIWUserSession = class(TIWUserSessionBase)

















15
     procedure IWUserSessionBaseDestroy(Sender: TObject);
     procedure IWUserSessionBaseDestroy(Sender: TObject);












16
 
     procedure IWUserSessionBaseCreate(Sender: TObject);












17
   private
   private















18


     FDM: TDataModule1;


     FDM: TDataModule3;













19


     function GetDM: TDataModule1;


     function GetDM: TDataModule3;















20
     { Private declarations }
     { Private declarations }

















21
   public
   public

















22
     { Public declarations }
     { Public declarations }












23
 
     FPage: Boolean;












24
     user_number: integer;
     user_number: integer;















25


     FPage: TPage;


     FThumbnail: Boolean;













26


     property DM: TDataModule1 read GetDM;


     Serial: integer;













27


 


     function hash(const pass: string): string;













28


 


     procedure ImgToField(img: TPicture; field: TField);













29


 


     procedure FieldToImg(img: TPicture; field: TField);













30


 


     property DM: TDataModule3 read GetDM;















31
   end;
   end;

















32
 
 

















33
 implementation
 implementation

















34
 
 

















35
 {$R *.dfm}
 {$R *.dfm}














 
 













36
 { TIWUserSession }
 { TIWUserSession }

















37
 
 















38


 function TIWUserSession.GetDM: TDataModule1;


 procedure TIWUserSession.FieldToImg(img: TPicture; field: TField);













39


 


 var













40


 


   s: TStream;













41


 


   jpg: TJpegImage;













42


 


 begin













43


 


   if field.IsNull = false then













44


 


   begin













45


 


     s := field.DataSet.CreateBlobStream(field, bmRead);













46


 


     jpg := TJpegImage.Create;













47


 


     try













48


 


       jpg.LoadFromStream(s);













49


 


       img.Assign(jpg);













50


 


     finally













51


 


       s.Free;













52


 


       jpg.Free;













53


 


     end;













54


 


   end













55


 


   else













56


 


     img.Assign(nil);













57


 


 end;













58


 


 













59


 


 function TIWUserSession.GetDM: TDataModule3;















60
 begin
 begin

















61
   if Assigned(FDM) = false then
   if Assigned(FDM) = false then















62


     FDM:=TDataModule1.Create(nil);


     FDM := TDataModule3.Create(nil);













63


   result:=FDM;


   result := FDM;













64


 


 end;













65


 


 













66


 


 function TIWUserSession.hash(const pass: string): string;













67


 


 var













68


 


   i: integer;













69


 


   k: integer;













70


 


 begin













71


 


   result := '';













72


 


   for i := Length(pass) downto 1 do













73


 


   begin













74


 


     k := Ord(pass[i]) * i;













75


 


     result := result + k.ToString;













76


 


   end;













77


 


 end;













78


 


 













79


 


 procedure TIWUserSession.ImgToField(img: TPicture; field: TField);













80


 


 var













81


 


   s: TStream;













82


 


   jpg: TJpegImage;













83


 


   bmp: TBitmap;













84


 


 begin













85


 


   s := field.DataSet.CreateBlobStream(field, bmWrite);













86


 


   jpg := TJpegImage.Create;













87


 


   bmp:=TBitmap.Create;













88


 


   try













89


 


     bmp.Assign(img.Graphic);













90


 


     jpg.Assign(bmp);













91


 


     jpg.SaveToStream(s);













92


 


   finally













93


 


     s.Free;













94


 


     bmp.Free;













95


 


     jpg.Free;













96


 


   end;













97


 


 end;













98


 


 













99


 


 procedure TIWUserSession.IWUserSessionBaseCreate(Sender: TObject);













100


 


 var













101


 


   s: string;













102


 


 begin













103


 


   FThumbnail := true;













104


 


   s := WebApplication.Request.CookieFields.Values['user_cookie'];













105


 


   if (s <> '') and (DM.FDTable1.Locate('NUMBER', s, []) = true) then













106


 


   begin













107


 


     user_number := s.ToInteger;













108


 


     if DM.FDTable1.FieldByName('EMAIL').AsString = '' then













109


 


       FPage := true













110


 


     else













111


 


       FPage := false;













112


 


   end













113


 


   else













114


 


     FPage := true;















115
 end;
 end;

















116
 
 

















117
 procedure TIWUserSession.IWUserSessionBaseDestroy(Sender: TObject);
 procedure TIWUserSession.IWUserSessionBaseDestroy(Sender: TObject);











#

Line 49 
 begin


Line 120 
 begin












120
 end;
 end;

















121
 
 

















122
 end.
 end.














 
 

























Legend:



Removed from v.1
 


changed lines


 
Added in v.16













Back to OSDN">Back to OSDN
ViewVC Help


Powered by ViewVC 1.1.26
 /[zencart-clone]/UserSessionUnit.pas
-revision 1 by yamat0jp,
Sun Nov 22 11:18:44 2015 UTC
+revision 16 by yamat0jp,
Sat Aug  6 08:27:34 2016 UTC
 Line 8 
 unit UserSessionUnit;
  interface
  uses
-   IWUserSessionBase, SysUtils, Classes, FireDAC.Stan.Intf, FireDAC.Stan.Option,
+   IWUserSessionBase, SysUtils, Classes, Unit3, graphics, Data.DB, jpeg;
-   FireDAC.Stan.Param, FireDAC.Stan.Error, FireDAC.DatS, FireDAC.Phys.Intf,
-   FireDAC.DApt.Intf, FireDAC.Stan.Async, FireDAC.DApt, FireDAC.UI.Intf,
-   FireDAC.Stan.Def, FireDAC.Stan.Pool, FireDAC.Phys, FireDAC.Phys.IB,
-   FireDAC.Phys.IBDef, Data.DB, FireDAC.Comp.Client, FireDAC.Comp.DataSet, Unit4;
  type
-   TPage = (Main,Info);
    TIWUserSession = class(TIWUserSessionBase)
      procedure IWUserSessionBaseDestroy(Sender: TObject);
+     procedure IWUserSessionBaseCreate(Sender: TObject);
    private
-     FDM: TDataModule1;
+     FDM: TDataModule3;
-     function GetDM: TDataModule1;
+     function GetDM: TDataModule3;
      { Private declarations }
    public
      { Public declarations }
+     FPage: Boolean;
      user_number: integer;
-     FPage: TPage;
+     FThumbnail: Boolean;
-     property DM: TDataModule1 read GetDM;
+     Serial: integer;
+     function hash(const pass: string): string;
+     procedure ImgToField(img: TPicture; field: TField);
+     procedure FieldToImg(img: TPicture; field: TField);
+     property DM: TDataModule3 read GetDM;
    end;
  implementation
  {$R *.dfm}
  { TIWUserSession }
- function TIWUserSession.GetDM: TDataModule1;
+ procedure TIWUserSession.FieldToImg(img: TPicture; field: TField);
+ var
+   s: TStream;
+   jpg: TJpegImage;
+ begin
+   if field.IsNull = false then
+   begin
+     s := field.DataSet.CreateBlobStream(field, bmRead);
+     jpg := TJpegImage.Create;
+     try
+       jpg.LoadFromStream(s);
+       img.Assign(jpg);
+     finally
+       s.Free;
+       jpg.Free;
+     end;
+   end
+   else
+     img.Assign(nil);
+ end;
+ function TIWUserSession.GetDM: TDataModule3;
  begin
    if Assigned(FDM) = false then
-     FDM:=TDataModule1.Create(nil);
+     FDM := TDataModule3.Create(nil);
-   result:=FDM;
+   result := FDM;
+ end;
+ function TIWUserSession.hash(const pass: string): string;
+ var
+   i: integer;
+   k: integer;
+ begin
+   result := '';
+   for i := Length(pass) downto 1 do
+   begin
+     k := Ord(pass[i]) * i;
+     result := result + k.ToString;
+   end;
+ end;
+ procedure TIWUserSession.ImgToField(img: TPicture; field: TField);
+ var
+   s: TStream;
+   jpg: TJpegImage;
+   bmp: TBitmap;
+ begin
+   s := field.DataSet.CreateBlobStream(field, bmWrite);
+   jpg := TJpegImage.Create;
+   bmp:=TBitmap.Create;
+   try
+     bmp.Assign(img.Graphic);
+     jpg.Assign(bmp);
+     jpg.SaveToStream(s);
+   finally
+     s.Free;
+     bmp.Free;
+     jpg.Free;
+   end;
+ end;
+ procedure TIWUserSession.IWUserSessionBaseCreate(Sender: TObject);
+ var
+   s: string;
+ begin
+   FThumbnail := true;
+   s := WebApplication.Request.CookieFields.Values['user_cookie'];
+   if (s <> '') and (DM.FDTable1.Locate('NUMBER', s, []) = true) then
+   begin
+     user_number := s.ToInteger;
+     if DM.FDTable1.FieldByName('EMAIL').AsString = '' then
+       FPage := true
+     else
+       FPage := false;
+   end
+   else
+     FPage := true;
  end;
  procedure TIWUserSession.IWUserSessionBaseDestroy(Sender: TObject);
-Line 49 
 begin
+Line 120 
 begin
  end;
  end.
 Legend:



Removed from v.1
 


changed lines


 
Added in v.16
 Legend:



Removed from v.1
 


changed lines


 
Added in v.16
-Removed from v.1
+Added in v.16
-Back to OSDN">Back to OSDN
+ViewVC Help
 Powered by ViewVC 1.1.26

Develop and Download Open Source Software

zencart-clone

Browse Subversion Repository