6 Star 10 Fork 6

itlabers/delphi4wechat

加入 Gitee
与超过 1200万 开发者一起发现、参与优秀开源项目,私有仓库也完全免费 :)
免费加入
文件
该仓库未声明开源许可证文件(LICENSE),使用请关注具体项目描述及其代码上游依赖。
克隆/下载
webapp.pas 18.44 KB
一键复制 编辑 原始数据 按行查看 历史
itlabers 提交于 2016-06-06 20:45 . first commit
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627
unit webapp;
interface
uses SysUtils, Variants,Classes,idhttp,StdCtrls,DateUtils,Controls, IdIOHandler,IdIOHandlerSocket, IdIOHandlerStack, IdSSL, IdSSLOpenSSL,IDCookieManager,superObject,Hashtable,log4me;
const webpush_url :string = 'https://webpush.weixin.qq.com' ;
type Pcookie = ^Tcookie;
Tcookie = record // cookies key
wxuin:string; // wxuin
skey:string; // skey
wxsid:string; // sid
pass_ticket:string; // pass_ticket
end;
type TBaseRequest =record
Uin:string;
Sid:string;
Skey:String;
DeviceID:string;
end;
type PwxMessage = ^ TwxMessage;
TwxMessage =record
fromUser:string;
toUser:string;
MsgType:String;
Content:string;
Status: string;
ImgStatus: string;
end;
type TWxWeb = class (TObject)
private
uuid:string; // UUID
tip:string; // tip
baseUri :string; //取得域名
redirectUri:string; //跳转URL
returnMessage:string; // 返回消息
keyCookie: Tcookie; // 关键cookies
syncKeyObj: ISuperObject; //syncKey json 结构体
baseReqeust:TBaseRequest;
cookies:string; // cookies 字符串
syncKey:string; // 消息轮询 的syncKey
idHttp: TIdHttp;
sslHandler:TIdSSLIOHandlerSocketOpenSSL;
function getCookies():boolean;
public
imagestream:TMemoryStream; //二维码图片流
userName:string; // 当前用户名称 序列 每次登录都会变化
userNikeName:string ;
retcode :string; // 同步返回码
selector :string; // 事件代码
MemberCount:integer; // 联系人数量
wxAddMessageList:Tlist;
wxMessageList:Tlist;
wxActiveContactList:THashTable; //存储最近活动的联系人 (自行实现)
wxContactList:THashTable; //存储所有联系人 (自行实现)
wxGroupList:THashTable; //微信群 联系人 (自行实现)
wxAllContactList:THashTable ; // 所有联系人 (认证联系人+ 群组联系人)
constructor Create;
function getUUID:boolean;
function showQRImage():boolean;
function waitForLogin():boolean;
function login():boolean;
function wxInit():boolean;
function wxStatusNotify():boolean;
function wxgetContact() :boolean;
function syncMessageCheck():boolean;
function syncMessageGet():boolean;
end;
function GetRandomName(num:integer):string;
function GetTimeString():string;
implementation
uses main,RegExpr,StrUtils;
constructor TWxWeb.Create;
begin
idHttp:=TIdHttp.Create(nil);
sslHandler:=TIdSSLIOHandlerSocketOpenSSL.Create(nil);
idhttp.AllowCookies:=false;
idhttp.IOHandler:= sslHandler;
idhttp.Request.Accept := 'image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/x-shockwave-flash, */*';
idhttp.Request.AcceptLanguage := 'zh-cn';
idhttp.Request.ContentType := 'application/x-www-form-urlencoded';
idhttp.Request.UserAgent := 'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; Maxthon; .NET CLR 1.1.4322)';
{ 存储联系人
wxActiveContactList:= THashTable.create(1000);
wxContactList:=THashTable.create(1000);
wxGroupList:=THashTable.create(1000);
wxAllContactList:=THashTable.create(1000);
}
end;
function TWxWeb.getUUID():boolean;
var url :String;
t:Longword ;
s:string;
reg: TRegExpr;
begin
t:=DateTimeToUnix(now());
url:='https://login.weixin.qq.com/jslogin?appid=%s&fun=%s&lang=%s&_=%s';
url:=format(url,['wx782c26e4c19acffb','new','zh_CN',inttoStr(DateTimeToUnix(t))]);
try
if idhttp.Connected = false then
s:= idhttp.get(url);
except
result:=false;
end;
//s:='window.QRLogin.code = 200; window.QRLogin.uuid = "QfzdEMz5uA=="';
reg := TRegExpr.Create; //建立
reg.Expression:='(\d+)';
reg.Exec(s);
if reg.SubExprMatchCount = 1 then
begin
if reg.Match[1] = '200' then
begin
reg.Expression:='"(\S+?)"';
reg.Exec(s);
if reg.SubExprMatchCount = 1 then
begin
uuid:=reg.Match[1];
result:=true;
end;
end
else
begin
result:=false;
exit;
end;
FreeAndNil(reg);
end
else
begin
result:=false;
exit;
end;
end;
function TWxWeb.showQRImage():boolean;
var url:string;
begin
imagestream := TMemoryStream.Create();
url := 'https://login.weixin.qq.com/qrcode/' + uuid+'?t=webwx';
try
idhttp.get(url,imagestream) ;
tip:='1';
result:=true;
except
result:=false;
end;
end;
function TWxWeb.waitForLogin():boolean;
var url:string;
s:string;
reg:TRegExpr;
recode:string;
begin
url:='https://login.weixin.qq.com/cgi-bin/mmwebwx-bin/login?tip=%s&uuid=%s&_=%s';
url:=Format(url,[tip,uuid,gettimestring()]);
try
s:= idhttp.get(url) ;
except
result:=false;
end;
if s = '' then
result:=false;
reg:= TRegExpr.Create; //建立
reg.Expression:='(\d+)';
reg.Exec(s);
if reg.SubExprMatchCount = 1 then
begin
recode:=reg.Match[1];
if recode = '201' then
begin
returnMessage:='成功扫描,请在手机上点击确认以登录';
tip :='0' ;
result:=false;
exit;
end
else if recode = '408' then
begin
returnMessage:='登录超时 ,请重试';
tip :='0' ;
result:=false;
exit;
end
else if recode = '200' then
begin
returnMessage:='正在登录,稍等.....';
reg.Expression:='"(\S+?)"' ;
reg.Exec(s);
if reg.SubExprMatchCount = 1 then
begin
redirectUri:= reg.Match[1] + '&fun=new' ;
reg.Expression:='//(\S+?)/' ;
reg.Exec(redirectUri);
if reg.SubExprMatchCount = 1 then
begin
baseUri:='http://'+reg.Match[1];
end;
FreeAndNil(reg);
result:=true;
end;
end;
end
else
begin
result:=false;
exit;
end;
end;
function TWxWeb.login():boolean;
var
resString:string;
reg: TRegExpr;
begin
try
resString:= idhttp.get(redirectUri);
getCookies();
except
result:=false;
exit;
end;
if resString <>'' then
begin
reg:= TRegExpr.Create;
reg.Expression:='<ret>(\d+)</ret>';
reg.Exec(resString);
if reg.SubExprMatchCount = 1 then
begin
if reg.Match[1] = '0' then
begin
reg.Expression:='<skey>(\S+?)</skey><wxsid>(\S+?)</wxsid><wxuin>(\S+?)</wxuin><pass_ticket>(\S+?)</pass_ticket>';
reg.Exec(resString);
keyCookie.skey:=reg.Match[1];
keyCookie.wxsid:=reg.Match[2];
keyCookie.wxuin:= reg.Match[3];
keyCookie.pass_ticket:= reg.Match[4];
baseReqeust.Uin:= keyCookie.wxuin;
baseReqeust.Sid:= keyCookie.wxsid;
baseReqeust.Skey:=keyCookie.skey;
baseReqeust.DeviceID:='e'+GetRandomName(16);
FreeAndNil(reg);
result:=true;
end
end;
end
else
begin
result:=false;
exit;
end;
end;
function TWxWeb.wxInit():boolean;
var url:string;
parmas:TstringList;
root, superObject:ISuperObject;
requestJson:string;
responseJson:string;
resObject,syncKeyList,contactList: ISuperObject;
item: ISuperObject;
reCode:string;
syncKeyString:string;
ResponseStream: TStringstream;
begin
ResponseStream:=TStringstream.Create('',TEncoding.UTF8);
superObject:= SO([]);
root:= SO([]);
parmas:=TstringList.Create;
url := baseURI + '/cgi-bin/mmwebwx-bin/webwxinit?r=%s&pass_ticket=%s&skey=%s' ;
url:=Format(url,[gettimeString(),keyCookie.pass_ticket,keyCookie.skey]);
superObject.s['Uin']:= baseReqeust.Uin;
superObject.s['Sid']:= baseReqeust.Sid;
superObject.S['Skey']:= baseReqeust.Skey;
superObject.S['DeviceID']:= baseReqeust.DeviceID;
root.O['BaseRequest']:= superObject;
requestJson:=root.AsJSon();
parmas.Add(requestJson);
try
idhttp.Request.CustomHeaders.Values['Cookie']:=Cookies;
idhttp.Post(url,parmas,ResponseStream);
except
result:=false;
exit;
end;
responseJson:= ResponseStream.DataString;
if responseJson = '' then
begin
result:=false;
exit;
end;
ResponseStream.Free;
parmas.Free;
resObject:= so(responseJson);
reCode:= resObject['BaseResponse.Ret'].AsString();
if reCode = '0' then
begin
syncKeyObj := resObject['SyncKey'];
syncKeyList:= resObject['SyncKey.List'];
syncKeyString:='';
for item in syncKeyList do
begin
syncKeyString:= syncKeyString+'|'+item.S['Key']+ '_'+item.s['Val'];
end;
syncKey:=midstr(syncKeyString,2,length(syncKey)-1);
userName:= resObject['User.UserName'].AsString();
contactList := resObject['ContactList'];
for item in contactList do
begin
if pos(item.S['UserName'] , '@@') <> -1 then
begin
log4info(item.S['NickName']+':'+item.S['UserName']);
wxActiveContactList.put(item.S['NickName'],item.S['UserName']);
end;
end;
result:=true;
end
else
begin
result:=false;
end;
end;
function TWxWeb.wxStatusNotify():boolean;
var url:string;
parmas:TstringList;
root, superObject,resObject:ISuperObject;
requestJson,responseJson:string ;
reCode:string;
begin
//headers:=Tstringlist.Create;
parmas:=TstringList.Create;
url := baseURI + '/cgi-bin/mmwebwx-bin/webwxstatusnotify?lang=%s&pass_ticket=%s' ;
url:=Format(url,['zh_CN',keyCookie.pass_ticket]);
idhttp.Request.RawHeaders.AddValue('Content-type','application/json; charset=UTF-8');
idhttp.Request.CustomHeaders.Values['Cookie']:=Cookies;
superObject:= SO([]);
superObject.s['Uin']:= baseReqeust.Uin;
superObject.s['Sid']:= baseReqeust.Sid;
superObject.S['Skey']:= baseReqeust.Skey;
superObject.S['DeviceID']:= baseReqeust.DeviceID;
root:= SO([]);
root.O['BaseRequest']:= superObject;
root.s['Code']:='3';
root.s['FromUserName']:=userName;
root.s['ToUserName']:=userName;
root.s['ClientMsgId']:=GetRandomName(14);
requestJson:=root.AsJSon();
parmas.Add(requestJson);
try
responseJson:=idhttp.post(url,parmas);
except
result:=false;
end;
parmas.Free;
if responseJson = '' then
begin
result:=false;
exit;
end;
resObject:=SO(responseJson);
reCode:= resObject['BaseResponse.Ret'].AsString();
if reCode ='0' then
result:=true
else
result:=false;
end;
function TWxWeb.wxgetContact() :boolean;
var url:string;
responseJson:string;
resObject:ISuperObject;
reCode:string;
begin
url := baseURI + '/cgi-bin/mmwebwx-bin/webwxgetcontact?pass_ticket=%s&skey=%s&t=%s' ;
url:= format(url,[keyCookie.pass_ticket,keyCookie.skey,Gettimestring()]) ;
try
idhttp.Request.CustomHeaders.Values['Cookie']:=Cookies;
responseJson:=idhttp.get(url);
except
result:=false;
exit;
end;
if responseJson = '' then
begin
result:=false;
exit;
end;
begin
resObject:=SO(responseJson);
reCode:= resObject['BaseResponse.Ret'].AsString();
if reCode ='0' then
begin
MemberCount:=resObject['MemberCount'].AsInteger();
result:=true
end
else
result:=false;
exit;
end;
end;
{ function TWxWeb.wxgetContact() :boolean;
var url:string;
headers:TstringList;
parmas:TstringList;
responseJson:string;
resObject:ISuperObject;
reCode:string;
begin
headers:=TstringList.Create;
parmas:=TstringList.Create;
url := baseURI + '/cgi-bin/mmwebwx-bin/webwxgetcontact' ;
parmas.Add('pass_ticket='+keyCookie.pass_ticket);
parmas.Add('skey='+keyCookie.skey);
parmas.Add('r='+Gettimestring());
try
// idhttp.Request.ContentType; //最重要的初始化。
idhttp.Request.CustomHeaders.Values['Cookie']:=Cookies;
responseJson:=idhttp.post(url,parmas);
if responseJson <> '' then
begin
resObject:=SO(responseJson);
reCode:= resObject['BaseResponse.Ret'].AsString();
if reCode ='0' then
begin
MemberCount:=resObject['MemberCount'].AsInteger();
result:=true
end
else
result:=false;
end;
except
result:=false;
end;
end;
}
function TWxWeb.syncMessageCheck():boolean;
var url:string;
resStr:string ;
reg:TRegExpr;
begin
url := webpush_url + '/cgi-bin/mmwebwx-bin/synccheck?skey=%s&sid=%s&uin=%s&deviceid=%s&synckey=%s&r=%s&_=%s' ;
url:=Format(url,[keyCookie.skey,keyCookie.wxsid,baseReqeust.Uin,baseReqeust.DeviceID,Utf8Encode(synckey),GetTimeString()+leftstr('00000',5),GetTimeString()]);
try
idhttp.request.customheaders.text:='cookie:' + Cookies;
resStr:=idhttp.get(url);
if resStr <> '' then
begin
reg := TRegExpr.Create; //建立
reg.Expression:='retcode:"(\d+)",selector:"(\d+)"';
reg.Exec(resStr);
if reg.SubExprMatchCount > 1 then
begin
retcode:=reg.Match[1];
selector:=reg.Match[2];
end;
freeandnil(reg);
if retcode ='0' then
result:=true
else
result:=false;
end;
except
result:=false;
end;
end;
function TWxWeb.syncMessageGet():boolean;
var url:string;
parmas:TstringList;
root, superObject,resObject,syncKeys,item:ISuperObject;
addMsgList :ISuperObject;
requestJson,responseJson:string ;
reCode:string;
syncKeyString:string;
t:string;
ResponseStream: TStringstream;
begin
ResponseStream:=TStringstream.Create('',TEncoding.UTF8);
t:=GetTimeString();
parmas:=TstringList.Create;
url := baseURI + '/cgi-bin/mmwebwx-bin/webwxsync?lang=%s&pass_ticket=%s&skey=%s&sid=%s&r=%s&_=%s' ;
url:=Format(url,['zh_CN',keyCookie.pass_ticket,keyCookie.skey,keyCookie.wxsid,t,t]);
idhttp.Request.ContentType:= 'application/json;charset=utf-8';
idhttp.request.customheaders.text:='Cookie:' + Cookies;
superObject:= SO([]);
superObject.s['Uin']:= baseReqeust.Uin;
superObject.s['Sid']:= baseReqeust.Sid;
superObject.S['Skey']:= baseReqeust.Skey;
superObject.S['DeviceID']:= baseReqeust.DeviceID;
root:= SO([]);
root.O['BaseRequest']:= superObject;
root.o['SyncKey']:=syncKeyObj;
root.s['rr']:=t;
requestJson:=root.AsJSon();
parmas.Add(requestJson);
try
idhttp.post(url,parmas,ResponseStream);
except
result:=false;
end;
responseJson:=ResponseStream.DataString;
if responseJson = '' then
begin
result:=false;
end;
resObject:=SO(responseJson);
reCode:= resObject['BaseResponse.Ret'].AsString();
if reCode ='0' then
begin
syncKeys:= resObject['SyncKey.List'];
syncKeyString:='';
for item in syncKeys do
begin
syncKeyString:= syncKeyString+'|'+item.S['Key']+ '_'+item.s['Val'];
end;
syncKey:=midstr( syncKeyString,2,length(syncKeyString)-1);
addMsgList:=resObject['AddMsgList'];
wxAddMessageList:=Tlist.Create;
for item in addMsgList do
begin
if item.S['FromUserName'] = userName then
begin
continue;
end;
{
获取消息信息
wxMessage.fromUser:=item.S['FromUserName'];
wxMessage.toUser:=item.S['toUserName'];
wxMessage.MsgType:=item.S['MsgType'];
wxMessage.Content:=item.S['Content'];
wxMessage.Status:=item.S['Status'];
wxMessage.ImgStatus:=item.S['ImgStatus'];
wxAddMessageList.Add(@wxMessage);
}
end;
result:=true ;
end
else
result:=false;
end;
function TWxWeb.getCookies():boolean;
var tmp,cookie:string;
i:integer;
begin
for i := 0 to idhttp.Response.RawHeaders.Count - 1 do
begin
tmp := idhttp.Response.RawHeaders[i];
if pos('set-cookie: ', LowerCase(tmp)) = 0 then Continue;
tmp := Trim(Copy(tmp, Pos('Set-cookie: ', tmp) + Length('Set-cookie: '), Length(tmp)));
tmp := Trim(Copy(tmp, 0, Pos(';', tmp) - 1));
if cookie = '' then
cookie := tmp else cookie := cookie + '; ' + tmp;
end;
cookies:=cookie;
result :=true;
end;
function GetRandomName(num:integer):string;
var SourceStr,str:string;
i:integer;
begin
SourceStr:='1234567890';
for i:=1 to num do
str:=str+sourcestr[Random(10)+1];
Result:=str;
end;
function GetTimeString( ):string;
begin
Result:=inttostr(DateTimeToUnix(now()));
end;
end.
马建仓 AI 助手
尝试更多
代码解读
代码找茬
代码优化
Delphi
1
https://gitee.com/spirit_demon/delphi4wechat.git
git@gitee.com:spirit_demon/delphi4wechat.git
spirit_demon
delphi4wechat
delphi4wechat
master

搜索帮助

0d507c66 1850385 C8b1a773 1850385