uUserLogin.~pas 5.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282
  1. unit uUserLogin;
  2. interface
  3. uses
  4. SysUtils, Types, Classes, Variants, QTypes, QGraphics, QControls, QForms,
  5. QDialogs, QStdCtrls, QButtons, QExtCtrls, Libc, uPublic, QMenus, SQLite3, SQLiteTable3;
  6. type
  7. TfrmUserLogin = class(TForm)
  8. MainMenu1: TMainMenu;
  9. N11: TMenuItem;
  10. N21: TMenuItem;
  11. N31: TMenuItem;
  12. Edit1: TEdit;
  13. Label3: TLabel;
  14. BitBtn1: TBitBtn;
  15. BitBtn2: TBitBtn;
  16. Label4: TLabel;
  17. Timer1: TTimer;
  18. procedure Edit1KeyDown(Sender: TObject; var Key: Word;
  19. Shift: TShiftState);
  20. procedure BitBtn1Click(Sender: TObject);
  21. procedure BitBtn2Click(Sender: TObject);
  22. procedure FormCreate(Sender: TObject);
  23. procedure CRC_CPCC(var pucData: TResultByteArray; nLen: integer;var pCRC: string);
  24. procedure CALC_CODE();
  25. procedure Timer1Timer(Sender: TObject);
  26. procedure N21Click(Sender: TObject);
  27. procedure N31Click(Sender: TObject);
  28. private
  29. { Private declarations }
  30. public
  31. { Public declarations }
  32. end;
  33. var
  34. frmUserLogin: TfrmUserLogin;
  35. ToChange : Integer;
  36. lastDate : string;
  37. fStream : TFileStream;
  38. userDB : TSQLiteDatabase;
  39. userTB : TSQLiteTable;
  40. implementation
  41. uses DESCrypt, uEnCode;
  42. {$R *.xfm}
  43. procedure TfrmUserLogin.Edit1KeyDown(Sender: TObject; var Key: Word;
  44. Shift: TShiftState);
  45. begin
  46. if (key = 4100) or (key = 4101) then
  47. BitBtn1.Click;
  48. if key = 4096 then
  49. BitBtn2.Click;
  50. end;
  51. procedure TfrmUserLogin.BitBtn1Click(Sender: TObject);
  52. var
  53. str : string;
  54. buffer : array[1..100] of char;
  55. begin
  56. //fStream := TFILESTREAM.Create('code.dat',fmcreate);
  57. {
  58. fStream := TFILESTREAM.Create('code.dat',fmOpenReadWrite);
  59. fStream.Position := 0;
  60. fStream.Read(buffer,fStream.Size);
  61. if fStream.size = 0 then
  62. begin
  63. str := '';
  64. end
  65. else
  66. begin
  67. str := StrPas(@buffer);
  68. end;
  69. FreeAndNil(fStream);
  70. }
  71. userDB := TSQLiteDatabase.Create(AnsiToUTF8(_GetDBPath + 'code.db'));
  72. userTB := userDB.GetTable('select password from user where name = 1001 ');
  73. if userTB.RowCount = 0 then
  74. begin
  75. str := '';
  76. end
  77. else
  78. begin
  79. str := userTB.FieldByName['password'];
  80. end;
  81. if (edit1.Text = str) and (str <> '') then
  82. begin
  83. //Self.Close;
  84. //FrmEnCode := TFrmEnCode.Create(nil);
  85. //FrmEnCode.ShowModal;
  86. bitbtn1.Visible := FALSE;
  87. edit1.ReadOnly := TRUE;
  88. edit1.echomode := emNormal;
  89. label3.caption := '随机密码:';
  90. label4.visible := FALSE;
  91. bitbtn2.caption := '退出';
  92. mainmenu1.items.Items[0].Visible := TRUE;
  93. ToChange := 0;
  94. CALC_CODE;
  95. timer1.Enabled := TRUE;
  96. end
  97. else
  98. begin
  99. if bitbtn1.visible = TRUE then
  100. begin
  101. _MsgError('密码错误!');
  102. edit1.setfocus;
  103. exit;
  104. end;
  105. end;
  106. end;
  107. procedure TfrmUserLogin.BitBtn2Click(Sender: TObject);
  108. begin
  109. application.Terminate;
  110. exit;
  111. end;
  112. procedure TfrmUserLogin.FormCreate(Sender: TObject);
  113. begin
  114. mainmenu1.items.Items[0].Visible := FALSE;
  115. frmUserLogin.Timer1.Enabled := FALSE;
  116. edit1.SetFocus;
  117. end;
  118. procedure TfrmUserLogin.CRC_CPCC(var pucData: TResultByteArray; nLen: integer;
  119. var pCRC: string);
  120. var
  121. CRC16Lo, CRC16Hi, CH, CL, SaveHi, SaveLo, i, j: byte;
  122. begin
  123. CRC16Lo := 0; // pCRC-(pCRC div 256)*256;
  124. CRC16Hi := 0; //(pCRC div 256);
  125. ch := $A0;
  126. cl := $01;
  127. for i := 0 to nLen - 1 do
  128. begin
  129. CRC16Lo := CRC16Lo xor (pucData[i]);
  130. for j := 0 to 7 do
  131. begin
  132. SaveHi := CRC16Hi;
  133. SaveLo := CRC16Lo;
  134. CRC16Hi := CRC16Hi shr 1;
  135. CRC16Lo := CRC16Lo shr 1;
  136. if (SaveHi and $01) = $01 then
  137. CRC16Lo := CRC16Lo or $80;
  138. if (SaveLo and $01) = $01 then
  139. begin
  140. CRC16Hi := CRC16Hi xor CH;
  141. CRC16Lo := CRC16Lo xor CL;
  142. end;
  143. end;
  144. end;
  145. pCRC := IntToHex(CRC16hi, 2) + IntToHex(CRC16Lo, 2);
  146. end;
  147. procedure TfrmUserLogin.CALC_CODE();
  148. var
  149. AR: TResultByteArray;
  150. CRC: string;
  151. nCode: INTEGER;
  152. nTmp: INTEGER;
  153. _code: string;
  154. date: string;
  155. i: integer;
  156. C: array[1..4] of INTEGER;
  157. begin
  158. SetLength(ar, 10);
  159. ar[0] := $BD;
  160. ar[1] := $6E;
  161. ar[2] := $3F;
  162. ar[3] := $91;
  163. ar[4] := $4C;
  164. ar[5] := $2A;
  165. date := formatdatetime('yyyyMMdd', now);
  166. lastDate := date;
  167. ar[6] := StrToInt('$' + copy(date, 1, 2));
  168. ar[7] := StrToInt('$' + copy(date, 3, 2));
  169. ar[8] := StrToInt('$' + copy(date, 5, 2));
  170. ar[9] := StrToInt('$' + copy(date, 7, 2));
  171. CRC_CPCC(ar, length(ar), CRC);
  172. nTmp := StrToInt(copy(date, 8, 1));
  173. nTmp := nTmp mod 2;
  174. for i := 1 to 4 do
  175. begin
  176. c[i] := StrToInt('$' + copy(CRC, i, 1));
  177. if c[i] > 9 then
  178. begin
  179. if nTmp = 0 then
  180. begin
  181. c[i] := c[i] - 6;
  182. end
  183. else
  184. begin
  185. c[i] := c[i] - 9;
  186. end;
  187. end;
  188. end;
  189. CRC := IntToStr(c[1])
  190. +IntToStr(c[2])
  191. +IntToStr(c[3])
  192. +IntToStr(c[4]);
  193. edit1.Text := CRC;
  194. ToChange := 0;
  195. end;
  196. procedure TfrmUserLogin.Timer1Timer(Sender: TObject);
  197. var
  198. date : string;
  199. begin
  200. date := formatdatetime('yyyyMMdd', now);
  201. if lastDate <> date then
  202. begin
  203. calc_code;
  204. end;
  205. {
  206. if (ToChange = 0) and
  207. (date > '235500') and (date < '235959') then
  208. begin
  209. ToChange := 1;
  210. end;
  211. if (ToChange = 1) and
  212. (date > '000000') and (date < '000500') then
  213. begin
  214. calc_code;
  215. end;
  216. }
  217. end;
  218. procedure TfrmUserLogin.N21Click(Sender: TObject);
  219. begin
  220. Application.CreateForm(TFrmEnCode, FrmEnCode);
  221. FrmEnCode.ShowModal;
  222. end;
  223. procedure TfrmUserLogin.N31Click(Sender: TObject);
  224. begin
  225. application.Terminate;
  226. exit;
  227. end;
  228. end.
  229. .
  230. .