网上下载的WEB微信登录的一个demo,值得借鉴

网上下载的WEB微信登录的一个demo,值得借鉴

下面是下载的demo主要代码：

unit WebWeiXin;

interface
uses SysUtils,
  Classes,
  IdHTTP,
  IdSSLOpenSSL,
  IdCookieManager,
  jpeg,
  uLkJSON;
const
  WebWeiXinHost = 'wx.qq.com';
type
  TWebWeiXinLoginThread = class;
  TWebWeiXinUser = class;
  TWebWeiXinUsers = class;
  TWebWeiXinSyncThread = class;
  TWebWeiXinMessage = class;
  TWebWeiXin = class;
  //  TWebWeiXinLoginedEvent = TNotifyEvent;

  TWebWeiXinOnMessageEvent = procedure(Sender: TWebWeiXin; aMessage: TWebWeiXinMessage) of object;
  TWebWeiXinOnDebugEvent = procedure(Sender: TObject; aMessage: string) of object;
  TWebWeiXinLoginThreadEvent = procedure(URI: string) of object;
  TWebWeiXinSyncThreadEvent = procedure(RetCode, Selector: integer) of object;
  TWebWeiXinException = procedure(Sender: TWebWeiXin; ErrorCode: integer; ErrorText: string) of object;

  TWebWeiXinSyncKey = record
    Key: integer;
    Val: Int64;
  end;
  TWebWeiXinSyncKeys = array of TWebWeiXinSyncKey;
  { TWebWeiXin }

  TWebWeiXin = class(TObject)
  private
    oHttp: TIdHTTP;
    oSSL: TIdSSLIOHandlerSocketOpenSSL;
    oCookies: TIdCookieManager;

    oUsers: TWebWeiXinUsers;

    oLoginThread: TWebWeiXinLoginThread;
    oSyncThread: TWebWeiXinSyncThread;

    procedure OnThreadLogined(URI: string);
    procedure OnDebug(Sender: TObject; aMessage: string);
    procedure OnSync(RetCode, Selector: integer);
    procedure OnSyncTerminate(Sender: TObject);
    procedure fException(ErrorCode: integer; ErrorText: string);

  protected
    sLoginUUID: string;
    //    sTicket: string;
    sSID: string;
    sKey: string;
    sClientVersion: Int64;
    sPushURL: string;
    sDeviceId: string;
    sSyncKey: TWebWeiXinSyncKeys;
  public
    Me: TWebWeiXinUser;
    OnLogined: TNotifyEvent;
    OnLogout: TNotifyEvent;
    OnMessage: TWebWeiXinOnMessageEvent;
    OnException: TWebWeiXinException;
    constructor Create;
    destructor Destroy; override;
    function LoginQRCode: TJPEGImage;
    procedure CancelLogin;
    procedure Logout;
    property ClientVersion: Int64 read sClientVersion;
    property Users: TWebWeiXinUsers read oUsers;
    procedure SendTextMsg(ToUserName: string; Content: string);
    procedure AddUser(aUserName: string; VerifyContent: string);
  published

  end;

  { TWebWeiXinLoginThread }

  TWebWeiXinLoginThread = class(TThread)
  private
    WindowCode: string;
    aDebug: string;
    procedure SyncLogined;
    procedure SyncDebug;
  protected
    aWebWeiXin: TWebWeiXin;
  public
    OnLogin: TWebWeiXinLoginThreadEvent;
    OnDebug: TWebWeiXinOnDebugEvent;
    BreakLogin: boolean;
    procedure Execute; override;
  published

  end;

  { TWebWeiXinSyncThread }

  TWebWeiXinSyncThread = class(TThread)
  private
    aMessage: TWebWeiXinMessage;
    aDebugText: string;
    RetCode, Selector: integer;
    procedure Sync;
    procedure SyncDebug;
    procedure SyncTerminate;
  protected
    aWebWeiXin: TWebWeiXin;
    isBreak: boolean;
  public
    OnSync: TWebWeiXinSyncThreadEvent;
    OnDebug: TWebWeiXinOnDebugEvent;
    procedure Execute; override;
  published

  end;

  { TWebWeiXinMessage }

  TWebWeiXinMessage = class(TObject)
  private

  protected
    iId: Int64;
    sFromUserName: string;
    sToUserName: string;
    iType: integer; // 1文字 3图片 34语音 37陌生人聊天 42名片  49图文混排  51阅读通知
    sContent: string;
    iStatus: integer;
    iImgStatus: integer;
    dCreateTime: TDateTime;
    iVoiceLength: integer;
    iPlayLength: integer;
    sFileName: string;
    sFileSize: string;
    sMediaId: string;
    sUrl: string;
    iAppMsgType: integer;
    iStatusNotifyCode: integer;
    sStatusNotifyUserName: string;
    //RecommendInfo
    iForwardFlag: integer;
    // AppInfo
    iHasProductId: integer;
    sTicket: string;

    procedure ParseJSON(aMessageJson: TlkJSONbase);
  public
    constructor Create;
    destructor Destroy; override;
    property Id: Int64 read iId;
    property ToUserName: string read sToUserName;
    property FromUserName: string read sFromUserName;
    property Content: string read sContent;
    property MsgType: integer read iType;

  published

  end;

  { TWebWeiXinUser }

  TWebWeiXinUser = class(TObject)
  private
    oHeadImg: TJPEGImage;
    pWebWeiXin: TWebWeiXin;
  protected
    iUin: Int64; // 用户编号
    sUserName: string; // 用户名
    sNickName: string; // 昵称
    sHeadImgUrl: string; // 头像地址
    iContactFlag: integer;
    iMemberCount: integer; // 成员数，微信群有效
    //  oMemberList: const; // 成员列表
    sRemarkName: string; // 备注名
    bHideInputBarFlag: boolean;
    iSex: integer; // 性别 0未知 1男 2女
    sSignature: string; // 签名
    bVerifyFlag: integer; // 实名验证 0个人 8未验证公众账号 24已验证公众账号  29公众账号（CCTV315）  56特殊（微信小蜜蜂论坛发帖机团队）
    iOwnerUin: Int64;
    sPYInitial: string; // 拼音首字母
    sPYQuanPin: string; // 拼音
    sRemarkPYInitial: string; // 备注名拼音首字母，貌似未使用
    sRemarkPYQuanPin: string; // 备注名拼音，貌似未使用
    bStarFriend: boolean; // 星标成员
    bAppAccountFlag: boolean;
    iStatues: integer; // 状态
    iAttrStatus: integer;
    sProvince: string; // 省
    sCity: string; // 城市
    sAlias: string; // 别名
    iSnsFlag: integer;
    bUniFriend: boolean;
    function fGetHeadImg: TJPEGImage;
    procedure ParseJSON(aUserJson: TlkJSONbase);
  public
    constructor Create(aWebWeiXin: TWebWeiXin);
    destructor Destroy; override;
    property UIN: Int64 read iUin;
    property UserName: string read sUserName;
    property Nick: string read sNickName;
    property HeadImg: TJPEGImage read fGetHeadImg;
    property RemarkName: string read sRemarkName;
  published
  end;

  { TWebWeiXinUsers }

  TWebWeiXinUsers = class(TStringList)
  private
    pWebWeiXin: TWebWeiXin;
    function fGetUserByIndex(Idx: integer): TWebWeiXinUser;
    function fGetUserByName(Name: string): TWebWeiXinUser;
  protected
  public
    constructor Create(aWebWeiXin: TWebWeiXin);
    property Item[Idx: integer]: TWebWeiXinUser read fGetUserByIndex;
    property User[Name: string]: TWebWeiXinUser read fGetUserByName; default;
    function AddByJson(aJson: TlkJSONbase): integer;
    function Delete(UserName: string): boolean; overload;
  published
  end;
function UnixTime: Int64;
implementation
uses
  DateUtils,
  unit1;
{ TWebWeiXin }
constructor TWebWeiXin.Create;
  function aDeviceId: string;
  var
    i: integer;
  begin
    result := 'e';
    for i := 0 to 15 do
      result := result + inttostr(Random(10));
  end;
begin
  inherited Create; 
  Randomize;
  oHttp := TIdHTTP.Create(nil);
  oHttp.ReadTimeout := 60000;
  oHttp.AllowCookies := true;
  oHttp.HandleRedirects := true;
  //oHttp.RedirectMaximum := 0;
  oSSL := TIdSSLIOHandlerSocketOpenSSL.Create(oHttp);
  //oSSL.SSLOptions.Method := sslvSSLv3;
  oSSL.SSLOptions.Method := sslvSSLv23;
  oSSL.SSLOptions.Mode := sslmClient;
  oSSL.SSLOptions.VerifyDepth := 2;
  oHttp.IOHandler := oSSL;

  oCookies := TIdCookieManager.Create(oHttp);
  oHttp.CookieManager := oCookies;

  sLoginUUID := '';
  sClientVersion := 0;
  sPushURL := '';
  sDeviceId := aDeviceId;
  oUsers := TWebWeiXinUsers.Create(Self);

  SetLength(sSyncKey, 0);

end;

destructor TWebWeiXin.Destroy;
begin
  Logout;
  FreeAndNil(oSSL);
  FreeAndNil(oCookies);
  FreeAndNil(oHttp);
  FreeAndNil(oUsers);
  inherited Destroy;
end;

function UnixTime: Int64;
begin
  result := DateTimeToUnix(Now) - 8 * 60 * 60;
end;

function TWebWeiXin.LoginQRCode: TJPEGImage;
var
  QRCodeStream: TMemoryStream;
begin
  Logout;
  if oHttp.Connected then oHttp.Disconnect;
  sLoginUUID := '';
  sLoginUUID := oHttp.Get(Format('https://login.weixin.qq.com/jslogin?appid=wx782c26e4c19acffb&redirect_uri=https://wx.qq.com/cgi-bin/mmwebwx-bin/webwxnewloginpage&fun=new&lang=zh_CN&_=%d', [UnixTime]));
  Delete(sLoginUUID, 1, Pos('"', sLoginUUID));
  sLoginUUID := Copy(sLoginUUID, 1, Pos('"', sLoginUUID) - 1);
  QRCodeStream := TMemoryStream.Create;
  oHttp.Get(Format('https://login.weixin.qq.com/qrcode/%s?t=webwx', [sLoginUUID]), QRCodeStream);
  QRCodeStream.Position := soFromBeginning;
  result := TJPEGImage.Create;
  result.LoadFromStream(QRCodeStream);
  QRCodeStream.Free;
  oHttp.Disconnect;
  oLoginThread := TWebWeiXinLoginThread.Create(true);
  oLoginThread.aWebWeiXin := Self;
  oLoginThread.OnDebug := OnDebug;
  oLoginThread.OnLogin := OnThreadLogined;
  oLoginThread.Resume;
end;
procedure TWebWeiXin.CancelLogin;
begin
  if not Assigned(oLoginThread) then exit;
  if oLoginThread = nil then exit;
  if oLoginThread.Suspended then exit;
  oLoginThread.BreakLogin := true;
end;

procedure TWebWeiXin.OnThreadLogined(URI: string);
var
  s: string;
  aJson: TlkJSONbase;
  i: integer;
  URL: string;
  PostStream: TStringStream;
begin
  oHttp.Disconnect;

  URL := URI;
  repeat
    s := oHttp.Get(URL);
    if Pos('window.location.href="', s) > 0 then begin
      URL := Copy(s, Pos('href="', s) + 6, Length(s) - Pos('href="', s) - 6 - 9); // Pos('";', s) - 1);
      s := '';
    end;
  until s <> '';
  // 获得skey
  //sKey := Copy(s, Pos('<skey>', s) + 6, 39);
  // 获得sid和uin
  sSID := oCookies.CookieCollection.Cookie['wxsid', '.qq.com'].Value;//此处出错提示raised exception class eaccessviolation with message ‘access violation at address 004ca13d  in module’

  //trystrtoint64(oCookies.CookieCollection.Cookie['wxuin', '.qq.com'].Value, sUIN);
  sPushURL := Copy(s, Pos('url_push : "', s) + 12, Length(s));
  sPushURL := Copy(sPushURL, 1, Pos('"', sPushURL) - 1);
end;