Develop and Download Open Source Software

zencart-clone

Browse Subversion Repository

/[zencart-clone]/UserSessionUnit.pas

Diff of /UserSessionUnit.pas

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 11 by yamat0jp, Fri Jul 22 23:40:03 2016 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, Unit3;    IWUserSessionBase, SysUtils, Classes, Unit3, graphics, Data.DB, jpeg;
12    
13  type  type
14    TIWUserSession = class(TIWUserSessionBase)    TIWUserSession = class(TIWUserSessionBase)
# Line 25  type Line 25  type
25      FThumbnail: Boolean;      FThumbnail: Boolean;
26      Serial: integer;      Serial: integer;
27      function hash(const pass: string): string;      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;      property DM: TDataModule3 read GetDM;
31    end;    end;
32    
# Line 33  implementation Line 35  implementation
35  {$R *.dfm}  {$R *.dfm}
36  { TIWUserSession }  { TIWUserSession }
37    
38    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;  function TIWUserSession.GetDM: TDataModule3;
60  begin  begin
61    if Assigned(FDM) = false then    if Assigned(FDM) = false then
# Line 53  begin Line 76  begin
76    end;    end;
77  end;  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);  procedure TIWUserSession.IWUserSessionBaseCreate(Sender: TObject);
100  var  var
101    s: string;    s: string;
# Line 61  begin Line 104  begin
104    s := WebApplication.Request.CookieFields.Values['user_cookie'];    s := WebApplication.Request.CookieFields.Values['user_cookie'];
105    if (s <> '') and (DM.FDTable1.Locate('NUMBER', s, []) = true) then    if (s <> '') and (DM.FDTable1.Locate('NUMBER', s, []) = true) then
106    begin    begin
107      user_number:=s.ToInteger;      user_number := s.ToInteger;
108      if DM.FDTable1.FieldByName('EMAIL').AsString = '' then      if DM.FDTable1.FieldByName('EMAIL').AsString = '' then
109        FPage:=true        FPage := true
110      else      else
111        FPage:=false;        FPage := false;
112    end    end
113    else    else
114      FPage:=true;      FPage := true;
115  end;  end;
116    
117  procedure TIWUserSession.IWUserSessionBaseDestroy(Sender: TObject);  procedure TIWUserSession.IWUserSessionBaseDestroy(Sender: TObject);
Legend:
Removed from v.11  
changed lines
  Added in v.16
Back to OSDN">Back to OSDN
 ViewVC Help
Powered by ViewVC 1.1.26  
About OSDN
Find Software
Develop Software
Help