Develop and Download Open Source Software

Browse Subversion Repository

Annotation of /UserSessionUnit.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 16 - (hide annotations) (download) (as text)
Sat Aug 6 08:27:34 2016 UTC (7 years, 8 months ago) by yamat0jp
File MIME type: text/x-pascal
File size: 2783 byte(s)
ソースコードだけ更新します
pngからjpegに変更しました
データベースファイルは画像データ削除しないとエラーで動作しません
1 yamat0jp 1 unit UserSessionUnit;
2    
3     {
4 yamat0jp 11 This is a DataModule where you can add components or declare fields that are specific to
5 yamat0jp 1 ONE user. Instead of creating global variables, it is better to use this datamodule. You can then
6     access the it using UserSession.
7     }
8     interface
9    
10     uses
11 yamat0jp 16 IWUserSessionBase, SysUtils, Classes, Unit3, graphics, Data.DB, jpeg;
12 yamat0jp 1
13     type
14     TIWUserSession = class(TIWUserSessionBase)
15     procedure IWUserSessionBaseDestroy(Sender: TObject);
16 yamat0jp 2 procedure IWUserSessionBaseCreate(Sender: TObject);
17 yamat0jp 1 private
18 yamat0jp 2 FDM: TDataModule3;
19     function GetDM: TDataModule3;
20 yamat0jp 1 { Private declarations }
21     public
22     { Public declarations }
23 yamat0jp 7 FPage: Boolean;
24 yamat0jp 1 user_number: integer;
25 yamat0jp 8 FThumbnail: Boolean;
26 yamat0jp 5 Serial: integer;
27 yamat0jp 11 function hash(const pass: string): string;
28 yamat0jp 16 procedure ImgToField(img: TPicture; field: TField);
29     procedure FieldToImg(img: TPicture; field: TField);
30 yamat0jp 2 property DM: TDataModule3 read GetDM;
31 yamat0jp 1 end;
32    
33     implementation
34    
35     {$R *.dfm}
36     { TIWUserSession }
37    
38 yamat0jp 16 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 yamat0jp 2 function TIWUserSession.GetDM: TDataModule3;
60 yamat0jp 1 begin
61     if Assigned(FDM) = false then
62 yamat0jp 11 FDM := TDataModule3.Create(nil);
63     result := FDM;
64 yamat0jp 1 end;
65    
66 yamat0jp 11 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 yamat0jp 16 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 yamat0jp 2 procedure TIWUserSession.IWUserSessionBaseCreate(Sender: TObject);
100 yamat0jp 11 var
101     s: string;
102 yamat0jp 2 begin
103 yamat0jp 11 FThumbnail := true;
104     s := WebApplication.Request.CookieFields.Values['user_cookie'];
105     if (s <> '') and (DM.FDTable1.Locate('NUMBER', s, []) = true) then
106     begin
107 yamat0jp 16 user_number := s.ToInteger;
108 yamat0jp 11 if DM.FDTable1.FieldByName('EMAIL').AsString = '' then
109 yamat0jp 16 FPage := true
110 yamat0jp 11 else
111 yamat0jp 16 FPage := false;
112 yamat0jp 11 end
113     else
114 yamat0jp 16 FPage := true;
115 yamat0jp 2 end;
116    
117 yamat0jp 1 procedure TIWUserSession.IWUserSessionBaseDestroy(Sender: TObject);
118     begin
119     FreeAndNil(FDM);
120     end;
121    
122     end.

Back to OSDN">Back to OSDN
ViewVC Help
Powered by ViewVC 1.1.26