u_web_xtdl.pas

以前写的一个利用P2P 技术的一个通讯的例子。里面用到了 DBISAM 、INDY 控件。

unit U_WEB_XTDL;

interface

uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   StdCtrls, Buttons, ExtCtrls, jpeg, teForm, TFlatEditUnit,
   TFlatButtonUnit, TFlatComboBoxUnit;

const
   CM_RESTORE = WM_USER + $1000;

   //function get_pass(htlname: string; serialno: string): boolean; stdcall; external 'testpass.dll';
   //function get_hdser(serpath: string; serialno: string): boolean; stdcall; external 'testpass.dll';
type
   TF_WEB_XTDL = class(TForm)
      FormTransitions1: TFormTransitions;
      Image1: TImage;
      LB_PWD: TLabel;
      LB_USER: TLabel;
      ED_PWD: TFlatEdit;
      BTN_QX: TFlatButton;
      BTN_QR: TFlatButton;
      ED_USER: TFlatEdit;
      procedure BTN_QXClick(Sender: TObject);
      procedure BTN_QRClick(Sender: TObject);
      procedure ShowMain;
      procedure FormKeyDown(Sender: TObject; var Key: Word;
         Shift: TShiftState);
      procedure FormClose(Sender: TObject; var Action: TCloseAction);
      procedure FormCreate(Sender: TObject);
      procedure ED_PWDKeyDown(Sender: TObject; var Key: Word;
         Shift: TShiftState);
      procedure FormActivate(Sender: TObject);
      procedure ED_USERKeyPress(Sender: TObject; var Key: Char);
   private
      { Private declarations }
   public
      { Public declarations }
      procedure CreateParams(var Params: TCreateParams); override;
      procedure RestoreRequest(var message: TMessage); message CM_RESTORE;

   end;

var
   F_WEB_XTDL: TF_WEB_XTDL;

implementation
uses p2p_public, pub_program, u_web_dm, u_web_main, GetCompu_Name, teblend, u_encrypt;
{$R *.DFM}

// =========================================
// Override Default RegisterClass Parameters
// =========================================

procedure TF_WEB_XTDL.CreateParams(var Params: TCreateParams);
begin
   inherited CreateParams(Params);
   Params.WinClassName := 'xtgl of hotel!';
end;

// ===============================================
// Handle CM_RESTORE Message (Restore Application)
// ===============================================

procedure TF_WEB_XTDL.RestoreRequest(var message: TMessage);
begin
   if IsIconic(Application.Handle) = TRUE then
      Application.Restore
   else
      Application.BringToFront;
end;

procedure TF_WEB_XTDL.BTN_QXClick(Sender: TObject);
begin
   application.terminate;
end;

procedure TF_WEB_XTDL.ShowMain;
var
   i: integer;
   s: string;
begin
   i := strtoint(getstr(analy_str('result', tran_str), '-1'));
   case i of
      0:
         begin
            f_web_xtdl.close;
            Application.CreateForm(Tf_web_main, f_web_main);
         end;
      1:
         begin
            s := iif(m_lang = 1, '该帐号不存在!', 'THIS ACCOUNT NO DOES NOT EXISTS!');
            MessageDlg(s, mtinformation, [mbok], 0);
            ed_user.SetFocus;
            abort;
         end;
      2:
         begin
            s := iif(i = 1, '密码错误!', 'WRONG PASSWORD!');
            MessageDlg(s, mtinformation, [mbok], 0);
            ed_pwd.SetFocus;
            abort;
         end;
   end;
   f_web_main.RZ_WEB1.Caption := 'OPERATOR: ' + Gstr_myacc;
   {
   f_web_main.MD_XTDL_ZX.Visible := true;
   f_hotel_main.MD_XTDL_TCXT.Visible := true;
   f_hotel_main.sb_ztt.panels[0].Text := 'OPERATOR: ' + Gstr_czyxm;
   f_hotel_main.sb_ztt.panels[2].Text := iif(m_lang = 1, '威达酒店管理系统', 'WEDA HOTEL MANAGMENT SYSTEM');
   f_hotel_main.sb_ztt.panels[3].Text := 'SYS-DATE: ' + Gstr_pubdate + ' ' + formatdatetime('hh:mm:ss', now);
   }
end;

procedure TF_WEB_XTDL.BTN_QRClick(Sender: TObject);
var
   re: string;
   currs: tsystemtime;
   WinArray: array[0..144] of char;
   WINBUF: dword;
   LogonDataPackage: TLogonDataPackage;
   _ServerIP, _Account, _Pwd: string;
   _ServerPORT: Integer;
begin
   getlocaltime(currs);
   winbuf := 144;
   Getcomputername(WinArray, winbuf);
   Gstr_compu := StrPas(WinArray);
   Gstr_compu := DoGetComputerName;
   DateSeparator := '-';
   ShortDateFormat := 'yyyy-mm-dd';
   TimeSeparator := ':';
   ShortTimeFormat := 'HH:mm:ss';
   m_lang := 1;
   init_string;
   if trim(ed_user.Text) = '' then
      begin
         MessageDlg(lb_user.Caption + null_msg, mtinformation, [mbok], 0);
         ed_user.SetFocus;
         abort;
      end;
   if trim(ed_pwd.Text) = '' then
      begin
         MessageDlg(lb_pwd.Caption + null_msg, mtinformation, [mbok], 0);
         ed_pwd.SetFocus;
         abort;
      end;
   with f_web_dm.qy_wangy do
      begin
         close;
         sql.Clear;
         sql.Add('select * from servip order by c_sort');
         open;
         _ServerIP := fieldbyname('ipaddr').asstring;
         _ServerPORT := fieldbyname('port').asinteger;
         close;
      end;
   //_ServerIP := '127.0.0.1';//'218.0.194.72'; //'10.140.49.165';//'10.140.223.9';
   _ServerIP := '10.140.61.246';//'127.0.0.1'; //'62.145.222.165';//'218.0.194.72'; //'10.140.49.165';//'10.140.223.9';
   //_ServerPORT := 9001;
   _Account := trim(ed_User.Text);
   _Pwd := trim(ed_pwd.Text);
   with LogonDataPackage do
      begin
         Head.MsgType := IntToStr(LogonSign);
         StrPCopy(Body.Account, _Account);
         StrPCopy(Body.Pwd, _Pwd);
         StrPCopy(Body.MyPublicIP, '');
         StrPCopy(Body.MyPublicPORT, '');
         StrPCopy(Body.lResult, '');
         //
      end;
   f_web_dm.id_udp.SendBuffer(_ServerIP, _ServerPORT, LogonDataPackage, SizeOf(LogonDataPackage));
end;

procedure TF_WEB_XTDL.FormKeyDown(Sender: TObject; var Key: Word;
   Shift: TShiftState);
begin
   case Key of
      VK_ESCAPE: btn_qxclick(sender);
      VK_RETURN: Perform(WM_NEXTDLGCTL, 0, 0);
      VK_UP: Perform(WM_NEXTDLGCTL, 1, 0);
      VK_DOWN: Perform(WM_NEXTDLGCTL, 0, 0);
   end;
end;

procedure TF_WEB_XTDL.FormClose(Sender: TObject;
   var Action: TCloseAction);
begin
   action := cafree;
end;

procedure TF_WEB_XTDL.FormCreate(Sender: TObject);
var
   htlname, serialno, hdserialno, serpath, datelock, s: string;
   lTBlendT: TBlendTransition;
begin
   {with f_web_dm.qy_wangy do
      begin
         close;
         sql.Clear;
         sql.Add('select * from config_gd');
         open;
         htlname := fieldbyname('htlname').asstring;
         serialno := fieldbyname('serialno').asstring;
         hdserialno := fieldbyname('hdserialno').asstring;
         close;
         sql.Clear;
         sql.Add('select apppath from vipcfg');
         open;
         serpath := fieldbyname('apppath').asstring;
         close;
         sql.Clear;
         sql.Add('select adcard from config_prn');
         open;
         datelock := trim(fieldbyname('adcard').asstring);
         close;
      end;

   {if not get_pass(htlname, serialno) then
      begin
         MessageDlg(iif(m_lang = 1, '酒店系统资料被改动,系统停止运行!', 'HOTEL SYSTEM INFO HAS BEEN CHANGED, SYSTEM TERMINATED!'), mtinformation, [mbok], 0);
         application.terminate;
         exit;
      end;

   {//
   if not get_hdser(serpath, hdserialno) then
      begin
         MessageDlg(iif(m_lang = 1, '网络连接失败, 请检查!', 'THE NETWORK CONNECTTION FAILED, PLEASE CHECK IT!'), mtinformation, [mbok], 0);
         application.terminate;
         exit;
      end;
   //}

   {//
   if datelock = '' then
      begin
         MessageDlg('网络连接失败,请检查!', mtinformation, [mbok], 0);
         application.terminate;
         exit;
      end;
   s := encrypt_str_wy(datelock, '', false);
   datelock := getpartstr(s, '&', datetostr(date - 1), false);
   s := getpartstr(s, '#', '');
   if (s <> htlname) or (strtodate(datelock) < date) then
      begin
         MessageDlg('网络连接失败,请检查!', mtinformation, [mbok], 0);
         application.terminate;
         exit;
      end;
   //}

   lTBlendT := TBlendTransition.Create;
   FormTransitions1.ShowTransition := lTBlendT;
   with lTBlendT do
      Milliseconds := 1500;
end;

procedure TF_WEB_XTDL.ED_PWDKeyDown(Sender: TObject; var Key: Word;
   Shift: TShiftState);
begin
   if key = vk_return then
      BTN_QRClick(Self);
end;

procedure TF_WEB_XTDL.FormActivate(Sender: TObject);
begin
   flat_repaint(sender);
end;

procedure TF_WEB_XTDL.ED_USERKeyPress(Sender: TObject; var Key: Char);
begin
   key := only_num(key);
end;

end.