本帖最后由 murder2008 于 2017-1-23 16:04 编辑
之前有大神发过，不过貌似不怎么好用了，研究了一下，决定自己实现一个好多人回贴说 不知道这个是干什么用的，好吧，我神志不清，表达不明白，描述一下，
简单的说就是实现一个网络验证，将这个功能植入自己要发行的应用中，如果使用者已加入指定的QQ群，则通过验证，否则禁止继续使用
动画中开始输入了一个群号，是不存在或未加入的群，登录后提示“验证失败”，修改群号后，可以通过验证，大家可以将验证群号写进代码，
我这里为了体现效果，用了一个文本框。
不知道是否表达清楚，如果还不明白，那就请了解的朋友回贴帮助说明，谢谢
DELPHI编写
链接: https://pan.baidu.com/s/1nvyNppR 密码: ep9j
易语言版同步发布：http://www.52pojie.cn/thread-572046-1-1.html
另寻一个好用的流媒体播放组件，有的朋友麻为面提供一下
[Delphi] 纯文本查看 复制代码 unit Unit_Login;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.OleCtrls, SHDocVw, Vcl.StdCtrls,
Vcl.ExtCtrls,MSHTML,StrUtils,ActiveX;
type
TValidEvent = procedure(bAuth: Boolean) of object; //校验结束结果通知事件
type
TFrmAuthLogin = class(TForm)
browserWeb: TWebBrowser;
Panel1: TPanel;
Label1: TLabel;
edtQunID: TEdit;
Label2: TLabel;
procedure FormCreate(Sender: TObject);
procedure browserWebNavigateComplete2(ASender: TObject;
const pDisp: IDispatch; const URL: OleVariant);
procedure browserWebDocumentComplete(ASender: TObject;
const pDisp: IDispatch; const URL: OleVariant);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
m_bFirstShow:Boolean;
m_eValidEvent:TValidEvent;
private
procedure initWidget();
procedure hideWebBrowser(bHide:Boolean);
function extractUrlDomain(const Url: string): string; //解析URL中的域名信息
procedure processNotifyValid(bAuth:Boolean);
public
{ Public declarations }
end;
var
FrmAuthLogin: TFrmAuthLogin;
const
AUTH_LOGIN_URL = 'http://ui.ptlogin2.qq.com/cgi-bin/login?appid=67663233&s_url=http://qun.qzone.qq.com/group&style=12.com';
AUTH_URL_VALID = 'http://qun.qzone.qq.com/group';
implementation
{$R *.dfm}
procedure TFrmAuthLogin.browserWebDocumentComplete(ASender: TObject;
const pDisp: IDispatch; const URL: OleVariant);
var
pStreamInit: IPersistStreamInit;
iWebStream: IStream;
sWebStream: TStringStream;
sHtml:String;
sQunID:String;
begin
{根据当前URL值执行不同的判断逻辑}
//登录页面加载结果不处理
if(extractUrlDomain(String(Url)) = extractUrlDomain(AUTH_LOGIN_URL)) then
begin
exit;
end;
//QQ登录成功后，加载群信息页面
if(extractUrlDomain(String(Url)) = extractUrlDomain(AUTH_URL_VALID)) then
begin
pStreamInit := browserWeb.document as IPersistStreamInit;
sWebStream := TStringStream.Create(sHtml);
iWebStream:= TStreamAdapter.Create(sWebStream, soReference) as IStream;
pStreamInit.Save(iWebStream, Bool(true));
sQunID := trim(edtQunID.Text);
if(sQunID = '') then
begin
m_eValidEvent(False);
exit;
end;
sWebStream.SaveToFile('c:\html.txt');
if(Pos(sQunID, sWebStream.DataString) > 0) then
begin
m_eValidEvent(True);
end else begin
m_eValidEvent(False);
end;
sWebStream.Free;
end;
end;
procedure TFrmAuthLogin.browserWebNavigateComplete2(ASender: TObject;
const pDisp: IDispatch; const URL: OleVariant);
begin
if(URL = AUTH_URL_VALID) then //URL跳转至群页面时，隐藏控件
begin
hideWebBrowser(true);
end;
end;
procedure TFrmAuthLogin.FormCreate(Sender: TObject);
begin
initWidget();
end;
procedure TFrmAuthLogin.FormShow(Sender: TObject);
begin
if(m_bFirstShow) then
begin
m_bFirstShow := False;
browserWeb.Navigate(AUTH_LOGIN_URL);
end;
end;
procedure TFrmAuthLogin.initWidget();
begin
m_bFirstShow := True;
m_eValidEvent := processNotifyValid;
end;
//隐藏或显示浏览器控件
procedure TFrmAuthLogin.hideWebBrowser(bHide:Boolean);
begin
if(not bHide) then
begin
ShowWindow(browserWeb.Handle, SW_SHOW );
end else begin
ShowWindow(browserWeb.Handle, SW_HIDE );
end;
end;
procedure TFrmAuthLogin.processNotifyValid(bAuth:Boolean);
begin
if(bAuth) then
begin
MessageBox(Self.Handle, PChar('群验证成功！'), PChar('身份验证'), mb_OK + mb_IconInformation);
Self.ModalResult := mrOK;
end else begin
MessageBox(Self.Handle, PChar('群验证失败！'), PChar('身份验证'), mb_OK + mb_IconWarning);
hideWebBrowser(false);
browserWeb.Navigate(AUTH_LOGIN_URL);
end;
end;
//解析URL中的域名
function TFrmAuthLogin.extractUrlDomain(const Url: string): string;
var
strA:String;
strB:String;
iTmp:Integer;
iA:Integer;
begin
strA:=Trim(Url);
strB:=LowerCase(strA);
iA:=Length('http://');
Delete(strB,1,iA);
iTmp:=pos('/',strB);
strB:=LeftStr(strB,iTmp-1);
Result :=strB;
end;
end.
| 
发表于 2016-12-30 17:01
|
发表于 2017-1-23 14:33
