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

homejun 发表于 2024-1-19 15:50

本帖最后由 homejun 于 2024-1-22 16:08 编辑

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

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

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

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

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 发表于 2024-1-19 16:32

感谢分享

hjsen 发表于 2024-1-19 18:52

lhlking 发表于 2024-1-19 22:24

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

homejun 发表于 2024-1-20 08:57

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

好用，玩玩吧！

asong 发表于 2024-1-20 09:16

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

Redy 发表于 2024-1-20 22:53

能打包成品嘛大佬

homejun 发表于 2024-1-21 07:59

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

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

dongwang_fl 发表于 2024-1-21 08:30

感谢分享

Redy 发表于 2024-1-21 12:52

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

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

页: [1] 2

吾爱破解 - 52pojie.cn's Archiver

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