delphi实现：微信标签文章内容获取

homejun

参考文章：https://www.52pojie.cn/thread-1879994-1-1.html

实现了基本的功能：
1、取公众号标签文章列表
2、取第一个文章的url地址
3、取文章输出的文本内容

代码在Delphi12下编译运行成功，支持win、andriod平台（安卓需要改AndroidManifest.template.xml文件，增加一个属性：android:usesCleartextTraffic="true"）。

缺憾：公众号无标签的话还是没办法取到文章列表

[Delphi] 纯文本查看 复制代码

unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
  System.Net.URLClient, System.Net.HttpClient, System.Net.HttpClientComponent,
  FMX.Controls.Presentation, FMX.StdCtrls, FMX.Memo.Types, FMX.ScrollBox, System.JSON,
  FMX.Memo, FMX.WebBrowser, FMX.Clipboard, FMX.Platform, FMX.Edit;

const
  USER_AGENT: string = 'Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/111.0.0.0 Safari/537.36';

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Button2: TButton;
    WebBrowser1: TWebBrowser;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}
{$R *.LgXhdpiPh.fmx ANDROID}

procedure TForm1.Button1Click(Sender: TObject);

var
  client: TNetHTTPClient;
  ss: TStringStream;
  s, One_Url, Referer_url, goal_url: string;
  Result: TJSONValue;
  jsonarray: TJSONARRAY;
  jsonobj: TJSONObject;
begin
  goal_url :=
    'https://mp.weixin.qq.com/mp/appmsgalbum?action=getalbum&__biz=MzI2MzEwNTY3OQ==&album_id=1318368205836189696&count=10&is_reverse=0&uin=MzYyNzI3OTg0MQ%253D%253D&key=653dcd9c12ba7d01be6ea90a540c1bd6b90d5098ca5a6e518b53f1cda25b8d1d6d77f6338ab00e06f4b7a777d4d24acbb0bbfc3e58295b9e12e05d9ac805bc17975d855be3ae8cd3d42e4165cad3e49f8ec3a07139468ea95f7e1720fde6a57c0366c00392c71f3105d2e309e93d7ffa6bdba1b9b22d8bb1f52bf87654354cdb&pass_ticket=ObfzXy79mWLCeXlAn3c%25252FApCyLGNsT5MmKmP6J0c%25252BlhElFSAPRtL7lWmIDUyYfTQIWGI5PlrWv714tNhAk7ppnQ%25253D%25253D&wxtoken=&devicetype=Windows%26nbsp%3B11%26nbsp%3Bx64&clientversion=63090819&__biz=MzI2MzEwNTY3OQ%3D%3D&appmsg_token=1252_xjjrK1oeBvMPUgfMx8_72IKuC-YrdzwVxutspw~~&x5=0&f=json';
  Referer_url :=
    'https://mp.weixin.qq.com/mp/appmsgalbum?__biz=MzI2MzEwNTY3OQ==&action=getalbum&album_id=1318368205836189696&scene=126&sessionid=-152244737&uin=MzYyNzI3OTg0MQ%3D%3D&key=56b2971ad55998e1a33b57418e1fb11b350080f9144ef51cb0c98d85b71d6320dbabe6367bc5f8a6b96c1187503b503549dd14e60bda928959fa0fe755243c95352877b703df43682e300f12a91f11e4fb5c4da5b77a6a91938669ecc8442f8e3e5f2afb1bc772505f1e816fdd5db06b580583bd5d597be22db4bad6b5283272&devicetype=Windows+11+x64&version=63090819&lang=zh_CN&ascene=0&acctmode=0&pass_ticket=JO955kab1Ex5PicEYsNqmzIH2EwQsLCq1%2BNw18AAD4DSGlyZcEhf1ulzP1OHV8KipMBRCHEfb9%2BeBmYLJVFjeg%3D%3D&wx_header=1';

  try
    client := TNetHTTPClient.Create(nil);
    ss := TStringStream.Create('', TEncoding.UTF8);
    ss.Clear;
    with client do
    begin
      Accept := '*/*';
      AcceptLanguage := '*';
      AcceptEncoding := 'gzip, deflate, br';
      AcceptCharSet := 'utf-8';
      CustomHeaders['X-Requested-With'] := 'XMLHttpRequest';
      CustomHeaders['Host'] := 'mp.weixin.qq.com';
      CustomHeaders['Connection'] := 'keep-alive';
      ContentType := 'application/json';
      CustomHeaders['Referer'] := Referer_url;
      UserAgent := USER_AGENT;
      try
        s := Get(goal_url, ss).ContentAsString(TEncoding.UTF8);
        Result := TJSONObject.ParseJSONValue(s);
        Result := Result.GetValue<TJSONObject>('getalbum_resp');
        jsonarray := Result.GetValue<TJSONARRAY>('article_list');
        jsonobj := jsonarray.Get(0) as TJSONObject;
        One_Url := jsonobj.GetValue<string>('url');
        Edit1.Text := One_Url;
        Memo1.Text := Get(One_Url, ss).ContentAsString(TEncoding.UTF8);
        WebBrowser1.URL := One_Url;
      except
        on E: Exception do
          ShowMessage(E.Message);
      end;
    end;
  finally
    ss.Free;
    client.Free;
  end;

end;

procedure TForm1.Button2Click(Sender: TObject);
var
  Clipboard: IFMXExtendedClipboardService;
begin
  WebBrowser1.EvaluateJavaScript('var e = document.getElementById("js_content");const input = document.createElement("input");document.body.append(input);input.value =e.innerText;input.select();document.execCommand("copy",false,null);');
  Sleep(1000);
  if not TPlatformServices.Current.SupportsPlatformService(IFMXExtendedClipboardService, Clipboard) then
    Exit;
  if Clipboard.HasText then
    Memo1.Text := Clipboard.GetText;

end;

end.

编译的exe\apk下载链接：  https://pan.baidu.com/s/1TkGWmz-E4IViwLEQrWQpZg?pwd=sx9g 提取码：sx9g

LQZRen39

感谢分享

lhlking

现在玩delphi的很少了吧，delphi12好用吗

homejun

lhlking 发表于 2024-1-19 22:24
现在玩delphi的很少了吧，delphi12好用吗

好用，玩玩吧！

asong

感谢分享，难得的delphi资料。

Redy

能打包成品嘛大佬

homejun

Redy 发表于 2024-1-20 22:53
能打包成品嘛大佬

源码都给了，自己还弄不了吗？

dongwang_fl

感谢分享

Redy

homejun 发表于 2024-1-21 07:59
源码都给了，自己还弄不了吗？

当菜鸡问出这句话的时候，肯定就是弄不成了哈哈哈哈