如何共享联盟cookie

接上一篇 阿里妈妈账号登录状态如何长时间保存

既然我们获取到了cookie, 如果有多个程序都要使用到联盟帐号的时候, 如果不共享cookie, 那么每个程序都需要登录一次, 真的很浪费资源.

如何共享呢, 那就是建立一个http的服务, 提供http的接口.

如代码所示:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,  diocp.ex.httpServer, ExtCtrls, ShellAPI;

type
  TFrmMain = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    mmo1: TMemo;
    pnl1: TPanel;
    btn1: TButton;
    tmr1: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btn1Click(Sender: TObject);
    procedure tmr1Timer(Sender: TObject);
  private
    { Private declarations }
    FTcpServer: TDiocpHttpServer;
    procedure OnHttpSvrRequest(pvRequest:TDiocpHttpRequest);
    procedure StartLogin();
    function  AtractProcess(sExe: string): Boolean;
  public
    { Public declarations }
  end;

var
  FrmMain: TFrmMain;

implementation
   uses  uFMMonitor, diocp.core.engine;

{$R *.dfm}procedure TFrmMain.Button1Click(Sender: TObject);
var
  MOduleHandle:THandle;
  TmpWndHandle:THandle;
  aa:PChar;
begin
  TmpWndHandle:=0;
  aa:=PChar(Edit1.Text);
  TmpWndHandle:=FindWindowA(nil,aa);
  if not IsWindow(TmpWndHandle) then
  begin
    mmo1.Lines.Add('没有找到窗口');
    Exit;
  end;
  if InstallHook(FindWindowA(nil,aa)) then
    mmo1.Lines.Add('挂载成功')
end;

procedure TFrmMain.FormDestroy(Sender: TObject);
begin
  UnHook;
end;

procedure TFrmMain.OnHttpSvrRequest(pvRequest: TDiocpHttpRequest);
var
  FLoad: TStringList;
begin
  try
    pvRequest.Response.ContentType := 'text/html; charset=utf-8';
    pvRequest.DecodePostDataParam(false);
    pvRequest.DecodeURLParam(false);
    if pvRequest.RequestURI = '/GetCookie' then
    begin
      FLoad := TStringList.Create;
      if FileExists(ExtractFilePath(ParamStr(0))+'cook.txt') then
         FLoad.LoadFromFile(ExtractFilePath(ParamStr(0))+'cook.txt');
      pvRequest.Response.WriteString(FLoad.Text);
      FreeAndNil(FLoad);
    end else
      pvRequest.Response.WriteString('未知命令');
  finally
    pvRequest.ResponseEnd;
    pvRequest.CloseContext;
  end;
end;

procedure TFrmMain.FormCreate(Sender: TObject);
begin
  FTcpServer := TDiocpHttpServer.Create(Self);
  FTcpServer.Name := 'HttpSVR';
  FTcpServer.SetMaxSendingQueueSize(10000);
  FTcpServer.createDataMonitor;
  FTcpServer.OnDiocpHttpRequest := OnHttpSvrRequest;
  TFMMonitor.createAsChild(pnl1, FTcpServer);
  FTcpServer.Port := 9093;
  FTcpServer.Active := True;
end;

procedure TFrmMain.StartLogin;
var
  scmd, sPath: string;
begin
  sCmd := '-lt 1 -ac -ap -dc -dp -pn AL6362845535841316741047753041';
  sPath := ExtractFilePath(ParamStr(0));
  ShellExecute(0, 'open', PChar(sPath+'AliLogin.exe'), PChar(sCmd), nil, SW_SHOWNORMAL);

  tmr1.Enabled := True;
end;

procedure TFrmMain.btn1Click(Sender: TObject);
begin
  StartLogin();
end;

function TFrmMain.AtractProcess(sExe: string): Boolean;
var
  MOduleHandle:THandle;
  TmpWndHandle:THandle;
  aa:PChar;
begin
  Result := False;
  TmpWndHandle:=0;
  aa:=PChar(sExe);
  TmpWndHandle:=FindWindowA(nil,aa);
  if not IsWindow(TmpWndHandle) then
  begin
    mmo1.Lines.Add('没有找到窗口');
    Exit;
  end;
  if InstallHook(FindWindowA(nil,aa)) then
  begin
    mmo1.Lines.Add('挂载成功');
    Result := True;
  end;
end;

procedure TFrmMain.tmr1Timer(Sender: TObject);
begin
  if AtractProcess('阿里妈妈登录窗体') then
    tmr1.Enabled := False;
end;

end.

我们把注入获取的cookie保存在cook.txt文件中, 当服务器开启后, 调用接口 http://服务器IP:9091/GetCookie?

在这个http服务中, 使用的是开源的diocp, 使用起来很简单.

下节预告  如何获取单品优惠券