一、工作原理及流程:
1、从aweme接口取得aweme评论总数量;
2、与之前的数量比较,如果有新增评论;
3、从comment评论接口统计评论以及评论回复数量,得出新增评论数量;
4、按时间排序评论,找出新增评论;
5、如果有新增评论,通过微信公众号发送消息到手机通知。
二、技术要点:
1、采集当前数据与历史数据比较,从而得到是否有新增评论。
三、功能模块
1、采集aweme评论总量
~~~:byc6352
function TAweme.getBogusUrl(url:string):string;
var
json:TJSONObject;
data:string;
begin
result:='';
try
json:=TJSONObject.Create;
json.AddPair('url',url);
json.AddPair('user_agent',USER_AGENT);
data:=json.ToString;
log.i(data);
data:=getPostResult(data);
log.i(data);
if(data='')then exit;
json:=TJSONObject.ParseJSONValue(data) as TJSONObject;
result:=json.GetValue('param').Value;
finally
json.Free;
end;
end;
//------------------------------------------working-------------------------------------------------
//主要工作流程
procedure TAweme.working();
var
bRet:boolean;
args,js,api_url:string;
begin
try
try
bRet:=false;
api_url:=format(DOUYIN_API_URL,[Faweme_id]);
api_url:=getBogusUrl(api_url); //具有X-Bogus验证的视频接口 多了这一步骤。
Log.i('TAweme.working',api_url);
js:=getDataFromAPI(api_url,Fcookie);
if(js='')then begin log.e('TAweme working','js=失败;aweme_id='+Faweme_id);exit;end;
if(pos('aweme_detail',js)<=0)then begin log.e('aweme working','js=失败;note_id='+Faweme_id+js);exit;end;
if(not parsedata(js))then exit;
Fsuccess:=true;
sleep(2000);
except
on E: Exception do
begin
Log.e('TAweme working err失败;','note_id='+Faweme_id+#13#10+e.Message);
end;
end;
finally
if(Fsuccess)then
begin
SendMessage(Fform,wm_data,3,integer(self)); //发送成功消息
end else begin
SendMessage(Fform,wm_data,4,integer(self)); //发送失败消息
end;
end;
end;
//发送GET请求,带上cookie,refer参数;到这一步,已经能拿到"aweme_detail" json数据了。
function TAweme.getDataFromAPI(apiurl,Cookie:string):string;
var
client: TNetHTTPClient;
ss: TStringStream;
s,id:string;
AResponse:IHTTPResponse;
i:integer;
begin
try
client := TNetHTTPClient.Create(nil);
SS := TStringStream.Create('', TEncoding.UTF8);
ss.Clear;
with client do
begin
ConnectionTimeout := 10000; // 10秒
ResponseTimeout := 10000; // 10秒
AcceptCharSet := 'utf-8';
UserAgent := USER_AGENT; //1 USER_AGENT USER_AGENT_PHONE_2
client.AllowCookies:=true;
client.HandleRedirects:=true;
Accept:='application/json'; //'*/*'
client.ContentType:='application/json'; //2
client.AcceptLanguage:='zh-CN';
client.CustomHeaders['Cookie'] := cookie;
client.CustomHeaders['Referer'] := REFER_URL;
try
AResponse:=Get(apiurl, ss);
result:=ss.DataString;
except
on E: Exception do
Log.e('TAweme.getDataFromAPI',e.Message);
end;
end;
finally
ss.Free;
client.Free;
end;
end;
//解析json数据
function TAweme.parseData(data:string):boolean;
var
json,j1,j2:TJSONObject;
ja,ja1:TJSONArray;
begin
json:=nil;
result:=false;
try
try
json := TJSONObject.ParseJSONValue(data) as TJSONObject;
if json = nil then exit;
j1:=json.GetValue('aweme_detail') as TJSONObject;
if(not jsonExist(j1,'statistics'))then
begin
log.e('TAweme.parseData',data);
exit;
end;
j2:=j1.GetValue('statistics') as TJSONObject;
Fcomment_count:=strtoint(j2.GetValue('comment_count').Value);
result:=true;
except
on e:Exception do
begin
log.e('TAweme.parseData',e.Message+#13#10+data);
end;
end;
finally
if(json<>nil)then json.Free;
end;
end;
end.
2、采集评论数据
unit uComment;
interface
uses
windows,classes,System.Net.URLClient, System.Net.HttpClient, System.Net.HttpClientComponent,
System.SysUtils,strutils,uLog,System.RegularExpressions,uFuncs,system.JSON,uConfig,
NetEncoding,ComObj,ActiveX,Clipbrd;
const
wm_user=$0400;
wm_data=wm_user+100+1;
//评论接口
DY_COMMON_API:string='https://www.douyin.com/aweme/v1/web/comment/list/?device_platform=webapp&aid=6383&channel=channel_pc_web&aweme_id=%s&cursor=%s&count=20&item_type=0&insert_ids=&whale_cut_token=&cut_version=1&rcFT=&pc_client_type=1'+
'&version_code=170400&version_name=17.4.0&cookie_enabled=true&screen_width=1536&screen_height=864&browser_language=zh-CN&browser_platform=Win32&browser_name=Chrome&browser_version=118.0.0.0'+
'&browser_online=true&engine_name=Blink&engine_version=118.0.0.0&os_name=Windows&os_version=10&cpu_core_num=8&device_memory=8&platform=PC&downlink=1.45&effective_type=3g&round_trip_time=950&webid=7119735414450456103&msToken=';
//子评论接口
DY_MORE_COMMON_API:string='https://edith.xiaohongshu.com/api/sns/web/v2/comment/sub/page?note_id=%s&root_comment_id=%s&num=10&cursor=%s';
DY_COMMON_REFER:string='https://www.douyin.com/';
//1.工作流程;2.构造参数;3.请求数据;4.解析数据;
type
pCountInfo=^TCountInfo; //评论统计数据
TCountInfo=record
Faweme_id:string; //笔记ID
Fcomment_count:integer; //评论数量
Fsub_comment_count:integer; //子评论数量
end;
TCountData=class
private
Faweme_id:string;
Ftotal_count:integer;
Fcomment_count:integer;
Fsub_comment_count:integer;
procedure set_aweme_id(aweme_id:string);
procedure set_comment_count(comment_count:integer);
procedure set_sub_comment_count(sub_comment_count:integer);
//procedure set_total_count(total_count:integer);
public
property aweme_id:string read Faweme_id write set_aweme_id;
property comment_count:integer read Fcomment_count write set_comment_count;
property sub_comment_count:integer read Fsub_comment_count write set_sub_comment_count;
//property total_count:integer read Ftotal_count write set_total_count;
constructor Create(aweme_id:string;total_count,comment_count,sub_comment_count:integer);
destructor Destroy;
end;
/// <summary>取评论数据,分条保存至文本文件,返回评论总数量,评论数量,评论回复数量</summary>
TComment=class(TThread)
private
FId:cardinal;
Faweme_id,Ftitle:string;
Fhasmore,Fcursor:string; //Fhasmore是否还有评论数据,Fcursor下一篇评论指针
Fcomm:string; //
FCountInfo:TCountInfo; //评论统计数据
Fcomment_count,Fsub_comment_count,Ftotal:integer;
Fcomments:tstringlist; //评论列表
Fsuccess:boolean;
class var Fform: HWND;
class var Fcookie: string; //访问接口需要的cookie
class procedure SetForm(const hForm: HWND); static;
class procedure SetCookie(const cookie: string); static;
procedure parseData(data:string); //解析评论数据
function JsonExist(parent:TJSONObject;child:string):boolean; //json节点是否存在
function getMstoken(cookie:string):string;
function getPostResult(url,data:string):string; //post
function getBogusUrl(url:string):string; //构造x-bogus签名url
protected
procedure Execute; override;
public
constructor Create(id:cardinal;aweme_id:string);
destructor Destroy;
property id:cardinal read FId;
class property form: HWND read Fform write SetForm;
class property cookie: string read Fcookie write SetCookie;
property comment_count:integer read Fcomment_count; //评论数量
property sub_comment_count:integer read Fsub_comment_count; //子评论数量
property total:integer read Ftotal; //总评论数量
property aweme_id:string read Faweme_id;
property success:boolean read Fsuccess;
procedure working(); //工作流程
function getDataFromRequest(aweme_id,cursor:string):string; //采集数据
function GetRelativeUrl(url:string):string; //接口相对链接
function getRequestResult(api_url,Cookie:string):string; //get获取接口数据
end;
implementation
//----------------------------------------------------------------------------------
//传入线程id号,笔记id
constructor TComment.Create(id:cardinal;aweme_id:string);
var
line:string;
begin
//inherited;
//FreeOnTerminate := True;
inherited Create(True);
FId:=id;
Faweme_id:=aweme_id;
Fhasmore:='0';
Fsuccess:=false;
Fcomments:=tstringlist.Create;
//FnewComments:=tstringlist.Create;
end;
destructor TComment.Destroy;
begin
inherited Destroy;
Fcomments.Free;
//FnewComments.Free;
end;
//在子线程中运行
procedure TComment.Execute;
begin
working();
end;
//主要工作流程
procedure TComment.working();
var
js,apiurl,relativeurl:string;
i:integer;
cursor,comment_id,line:string;
count:integer;
begin
try
try
log.i('comment start');
js:=getDataFromRequest(Faweme_id,'0');
log.i(js);
if(js='')then begin log.e('comment.working.js=失败;','aweme_id='+Faweme_id);exit;end;
if(pos('comments',js)<=0)then
begin
log.e('comment.working.js失败;','aweme_id='+Faweme_id+js);
exit;
end;
parseData(js);
sleep(2000); //解析评论数据
while Fhasmore='1' do //如果还有评论,继续抓取
begin
js:=getDataFromRequest(Faweme_id,Fcursor);
if(js='')then begin log.e('comment.working.js=失败;','aweme_id='+Faweme_id);exit;end;
if(pos('comments',js)<=0)then begin log.e('comment.working.js失败;','aweme_id='+Faweme_id+js);exit;end;
//log(js);
parseData(js);
sleep(2000);
end;
Fsub_comment_count:=Ftotal-Fcomment_count; //子评论
Fcomments.Sorted:=False;
Fcomments.CustomSort(TimeCompareInt); // 根据评论时间,排序评论
Fcomments.SaveToFile(uconfig.savedir+'\'+Faweme_id+'.txt',Tencoding.UTF8);//保存至文本文件
Fsuccess:=true;
except
on E: Exception do
begin
log.e('TComment.working err失败:',e.Message);
end;
end;
finally
if(Fsuccess)then
begin
SendMessage(Fform,wm_data,1,integer(self)); //发送成功消息
end else begin
SendMessage(Fform,wm_data,2,integer(self)); //发送失败消息
end;
//self.Free;
end;
end;
//采集数据
function TComment.getDataFromRequest(aweme_id,cursor:string):string;
var
url,mstoken,res:string;
begin
url:=format(DY_COMMON_API,[aweme_id,cursor]);
mstoken:=getMstoken(Fcookie);
url:=url+mstoken;
url:=getBogusUrl(url);
result:=getRequestResult(url,Fcookie);
end;
function TComment.getPostResult(url,data:string):string;
var
client: TNetHTTPClient;
ss,args: TStringStream;
begin
result:='';
try
client := TNetHTTPClient.Create(nil);
SS := TStringStream.Create('', TEncoding.UTF8);
ss.Clear;
args := TStringStream.Create(data, TEncoding.UTF8);
with client do
begin
ConnectionTimeout := 10000; // 2秒
ResponseTimeout := 10000; // 10秒
AcceptCharSet := 'utf-8';
UserAgent := USER_AGENT; //1
client.AllowCookies:=true;
client.HandleRedirects:=true;
Accept:='*/*';
client.ContentType:='application/json'; //2
//client.CustomHeaders['Cookie'] := KUAISHOU_COOKIES;
//client.CustomHeaders['Referer'] := Furl;
//client.h
client.Post(url,args,ss);
result:=ss.DataString;
end;
finally
ss.Free;
args.Free;
client.Free;
end;
end;
//采集数据
function TComment.getRequestResult(api_url,Cookie:string):string;
var
client: TNetHTTPClient;
ss: TStringStream;
s,id:string;
AResponse:IHTTPResponse;
i:integer;
begin
result:='';
try
client := TNetHTTPClient.Create(nil);
SS := TStringStream.Create('',TEncoding.UTF8); //TEncoding.UTF8
ss.Clear;
with client do
begin
ConnectionTimeout := 30000; // 30秒
ResponseTimeout := 30000; // 30秒
AcceptCharSet := 'utf-8';
UserAgent := USER_AGENT; //1
client.AllowCookies:=true;
client.HandleRedirects:=true;
Accept:='application/json, text/plain, */*'; //'*/*'
client.ContentType:='application/json'; //2
client.AcceptLanguage:='zh-CN,zh;q=0.9';
//client.AcceptEncoding:='gzip, deflate, br';
client.CustomHeaders['Cookie'] := Fcookie;
client.CustomHeaders['Referer'] := DY_COMMON_REFER;
client.CustomHeaders['Sec-Ch-Ua'] :='"Chromium";v="118", "Google Chrome";v="118", "Not=A?Brand";v="99"';
client.CustomHeaders['Sec-Ch-Ua-Mobile'] :='?0';
client.CustomHeaders['Sec-Ch-Ua-Platform'] :='"Windows"';
client.CustomHeaders['Sec-Fetch-Dest'] :='empty';
client.CustomHeaders['Sec-Fetch-Mode'] :='cors';
client.CustomHeaders['Sec-Fetch-Site'] :='same-origin';
try
AResponse:=Get(api_url, ss);
if(AResponse.StatusCode=200)then
begin
result:=ss.DataString;
end else begin
Log.e('getRequestResult err失败:',inttostr(AResponse.StatusCode)+':'+ss.DataString);
end;
except
on E: Exception do
begin
log.e('getRequestResult err失败:',e.Message);
end;
end;
end;
finally
ss.Free;
client.Free;
end;
end;
//解析评论json数据
procedure TComment.parseData(data:string);
var
json,j1,j2,j3,j4,j5:TJSONObject;
ja,ja1,sub_comments:TJSONArray;
nickname:string;
videoType:string;
i,j,sub_comment_count_i:integer;
aweme_id:string;
sub_comment_has_more,user_id,content,line:string;
comment_id,sub_comment_cursor,sub_comment_count:string;
create_time:string;
status_code:string;
begin
try
try
json := TJSONObject.ParseJSONValue(data) as TJSONObject;
if json = nil then exit;
status_code:=json.GetValue('status_code').value;
if(status_code<>'0')then
begin
log.e('comment.parseData error',status_code+#13#10+data);
exit;
end;
Fcursor:=json.GetValue('cursor').Value;
Fhasmore:=json.GetValue('has_more').Value; //该字段表示 是否还有评论
Ftotal:=strtoint(json.getvalue('total').value);
//if(not JsonExist(j1,'cursor'))then exit; //评论指针
ja:=json.GetValue('comments') as TJSONArray; //评论列表
Fcomment_count:=Fcomment_count+ja.Size; //评论统计
for I := 0 to ja.Size-1 do
begin
j1:=ja.Get(i) as TJSONObject;
content:=j1.GetValue('text').Value; //评论内容
create_time:=j1.GetValue('create_time').Value; //评论创建时间(javascript时间)
sub_comment_count:=j1.GetValue('reply_comment_total').Value;
Fsub_comment_count:=Fsub_comment_count+strtoint(sub_comment_count);
j2:=j1.GetValue('user') as TJSONObject;
user_id:=j2.GetValue('sec_uid').Value; //评论者ID
nickname:=trim(j2.GetValue('nickname').Value); //评论者昵称
nickname:=stringreplace(nickname,'''','',[rfreplaceall]);
line:=uFuncs.getTime(uFuncs.GetTime_DateTime(create_time+'000'))+' '+user_id+' '+nickname+' '+content;
Fcomments.Add(line); //评论列表
end;
except
on e:Exception do
begin
log.e('comment.parseData error=',e.Message+#13#10+data);
end;
end;
finally
if(json<>nil)then json.Free;
end;
end;
//从cookie中获取mstoken令牌
function TComment.getMstoken(cookie:string):string;
var
m:tmatch;
begin
result:='';
m:=Tregex.Match(cookie,'msToken=(.*?);');
if(m.Success)and(m.Groups.Count>1)then
result:=m.Groups.Item[1].Value;
end;
//取相对链接
function TComment.GetRelativeUrl(url:string):string;
var
i:integer;
s:string;
begin
result:='';
if(url='')then exit;
i:=pos('//',url);
if(i<=0)then exit;
s:=rightstr(url,length(url)-i-2);
i:=pos('/',s);
if(i<=0)then exit;
s:=rightstr(s,length(s)-i+1);
result:=s;
end;
//判断节点是否存在
function TComment.JsonExist(parent:TJSONObject;child:string):boolean;
var
i:integer;
keyname:string;
begin
result:=false;
if(parent=nil)then exit;
for i:=0 to parent.count-1 do
begin
keyname:=parent.Get(i).JsonString.toString;
keyname:=midstr(keyname,2,length(keyname)-2);
if(keyname=child)then
begin
result:=true;
exit;
end;
end;
end;
//------------------------------------------属性方法-------------------------------------
class procedure TComment.SetForm(const hForm: HWND);
begin
Fform:=hForm;
end;
class procedure TComment.SetCookie(const cookie: string);
begin
Fcookie:=cookie;
end;
//-------------------------------------------------------------------------------------------------------
//评论统计构造方法
constructor TCountData.Create(aweme_id:string;total_count,comment_count,sub_comment_count:integer);
begin
inherited Create;
Faweme_id:=aweme_id;
//Ftotal_count:=total_count;
Fcomment_count:=comment_count;
Fsub_comment_count:=sub_comment_count;
end;
destructor TCountData.Destroy;
begin
inherited Destroy;
end;
procedure TCountData.set_aweme_id(aweme_id:string);
begin
Faweme_id:=aweme_id;
end;
procedure TCountData.set_comment_count(comment_count:integer);
begin
Fcomment_count:=comment_count;
end;
procedure TCountData.set_sub_comment_count(sub_comment_count:integer);
begin
Fsub_comment_count:=sub_comment_count;
end;
end.
3、业务流程
unit uMainForm;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.StdCtrls, Vcl.ExtCtrls, dateutils,
uConfig,uLog,uFuncs,uNethelper,uCommentCount,system.JSON,uAuth,Clipbrd,uFeed,shellapi,strutils,
uAweme,uComment;
type
TFMainForm = class(TForm)
Panel1: TPanel;
btnStart: TButton;
btnClose: TButton;
Page1: TPageControl;
tsAweme: TTabSheet;
tsInfo: TTabSheet;
Bar1: TStatusBar;
memoNoteId: TMemo;
memoInfo: TMemo;
Timer1: TTimer;
Label1: TLabel;
edtInterval: TEdit;
Label2: TLabel;
Button1: TButton;
procedure FormResize(Sender: TObject);
procedure btnCloseClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure btnStartClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
mSaved:boolean; //是否保存
mCommentCountList:TList; //评论列表
mHasmore:boolean; //是否还需要采集
mIndex:integer; //采集序号
procedure LoadDataFromFile(filename:string;bUpdate:boolean);
procedure SaveDataToFile(filename:string);
procedure DataMsg(var aMessage:Tmessage);message wm_data; //接收并处理线程消息
function CommentMonitor(aweme_id:string;total_count:integer):boolean;overload; //评论监测(总数量)
procedure CommentMonitor(aweme_id:string;comment_count,sub_comment_count:integer); overload; //评论监测(评论与评论回复)
procedure initCommentMonitor(aweme_id_list:tstrings); //初始化监测
procedure updateCommentMonitor(aweme_id:string;comment_count,sub_comment_count:integer);
function getNewComment(aweme_id:string;count:integer):string; //取新增评论
procedure getData(i:integer); //逐条采集数据(评论与评论回复)
procedure SendWechat(msg:string); //新增评论发送至手机
function formatComment(comment,aweme_id:string):string; //格式化评论数据
procedure getCount(i:integer); //逐条采集数据(评论总数量)
public
{ Public declarations }
end;
var
FMainForm: TFMainForm;
implementation
{$R *.dfm}
//格式化数据
function TfMainForm.formatComment(comment,aweme_id:string):string;
const
USER_URL='https://www.douyin.com/user/';
AWEMA_RUL='https://www.douyin.com/video/';
var
ss:tstringlist;
count:integer;
url,note_url,tmp:string;
i:integer;
begin
result:='';
try
try
ss:=tstringlist.create;
tmp:=trim(comment);
//tmp:=stringreplace(tmp,'"','',[rfreplaceall]);
count:=extractStrings([' '],[' '],pchar(tmp),ss);
if(count<5)then
begin
log.e(ss.text);
ss.Clear;
i:=pos(' ',tmp);
while(i>0)do
begin
ss.add(leftstr(tmp,i));
delete(tmp,1,i);
tmp:=trim(tmp);
i:=pos(' ',tmp);
end;
end;
url:=USER_URL+ss[2];
note_url:=AWEMA_RUL+aweme_id;
result:=ss[0]+' '+ss[1]+#13#10+'评论者昵称:'+ss[3]+#13#10+'评论内容:'+#13#10+ss[4]+#13#10+'主页链接:'+#13#10+url+#13#10+'视频链接:'+#13#10+note_url+#13#10;
except
on e:exception do
begin
log.e('TfMainForm.formatComment','comment='+comment+#13#10+'ss='+ss.text);
end;
end;
finally
ss.Free;
end;
end;
//发送至微信
procedure TFMainForm.SendWechat(msg:string);
begin
if(uFuncs.GetProcessID(pansichar('WeChat.exe'))=0)then exit;
//sleep(5000);
Clipboard.Clear;//清空剪贴板
Clipboard.AsText := msg;
keybd_event(VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), 0, 0);
keybd_event(Ord('V'), MapVirtualKey(Ord('V'), 0), 0, 0);
keybd_event(Ord('V'), MapVirtualKey(Ord('V'), 0), KEYEVENTF_KEYUP, 0);
keybd_event(VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), KEYEVENTF_KEYUP, 0);
keybd_event(13, MapVirtualKey(13, 0), 0, 0);
keybd_event(13, MapVirtualKey(13, 0), KEYEVENTF_KEYUP, 0);
end;
//逐条采集评论总数量
procedure TfMainForm.getCount(i:integer);
var
aweme_id:string;
countdata:Tcountdata;
commentCount:TcommentCount;
aweme:Taweme;
begin
countdata:=mCommentCountList[i];
aweme_id:=countdata.aweme_id;
aweme:=Taweme.Create(i,aweme_id);
if(uConfig.DEBUG)then aweme.working else
aweme.start;
end;
//逐条采集评论数量及评论回复数量
procedure TfMainForm.getData(i:integer);
var
aweme_id:string;
countdata:Tcountdata;
commentCount:TcommentCount;
begin
countdata:=mCommentCountList[i];
aweme_id:=countdata.aweme_id;
commentCount:=TcommentCount.Create(i,aweme_id);
if(uConfig.DEBUG)then commentCount.working else
commentCount.start;
end;
//取新增评论
function TfMainForm.getNewComment(aweme_id:string;count:integer):string;
var
filename,comment:string;
ss:tstrings;
i:integer;
begin
result:='';
filename:=uConfig.savedir+'\'+aweme_id+'.txt';
if(not fileexists(filename))then exit;
try
ss:=tstringlist.create;
ss.LoadFromFile(filename,Tencoding.UTF8);
if(ss.Text='')then exit;
for I := ss.Count-1 downto 0 do
begin
//url:=getuserurl(ss[i]);
//result:=result+ss[i]+#13#10+url+#13#10;
comment:=formatComment(ss[i],aweme_id);
if(comment='')then continue;
result:=result+comment+#13#10;
count:=count-1;
if(count=0)then exit;
end;
finally
ss.Free;
end;
end;
//更新评论表数据
procedure TfMainForm.updateCommentMonitor(aweme_id:string;comment_count,sub_comment_count:integer);
var
i:integer;
countdata:Tcountdata;
begin
if(mCommentCountList.Count=0)then exit;
for I := 0 to mCommentCountList.Count-1 do
begin
countdata:=mCommentCountList[i];
if(aweme_id=countdata.aweme_id)then
begin
countdata.comment_count:=comment_count;
countdata.sub_comment_count:=sub_comment_count;
end;
end;
end;
//初始化评论
procedure TfMainForm.initCommentMonitor(aweme_id_list:tstrings);
var
i,j:integer;
aweme_id:string;
countinfo:pCountInfo;
countdata:Tcountdata;
begin
if(aweme_id_list.Count=0)then exit;
if(mCommentCountList.Count>0)then
begin
for I := 0 to mCommentCountList.Count-1 do
begin
countdata:=mCommentCountList[i];
countdata.Free;
//freemem(mCommentCountList[i]);
end;
end;
mCommentCountList.Clear;
for I := 0 to aweme_id_list.Count-1 do
begin
aweme_id:=aweme_id_list[i];
//getmem(countinfo,sizeof(TCountInfo));
countdata:=Tcountdata.Create(aweme_id,-1,-1,-1);
//countinfo.aweme_id:=aweme_id;
//countinfo.comment_count:=-1;
//countinfo.sub_comment_count:=-1;
mCommentCountList.Add(countdata);
end;
LoadDataFromFile(uConfig.commentcountfile,true);
end;
//以JSON格式保存评论统计信息
procedure TfMainForm.SaveDataToFile(filename:string);
var
ss:tstrings;
json,j1,j2:TJSONObject;
ja:TJSONArray;
i:integer;
aweme_id,t:string;
comment_count,sub_comment_count:integer;
countdata:Tcountdata;
begin
try
ss:=tstringlist.Create;
json:=TJSONObject.Create;
t:=FormatDateTime('yyyy-mm-dd hh:nn:ss:zzz', Now);
json.AddPair('time',t);
ja:=TJSONArray.Create;
for I := 0 to mCommentCountList.Count-1 do
begin
countdata:=mCommentCountList[i];
aweme_id:=countdata.aweme_id;
j1:=TJSONObject.Create;
j1.AddPair('aweme_id',aweme_id);
j1.AddPair('comment_count',countdata.comment_count);
j1.AddPair('sub_comment_count',countdata.sub_comment_count);
ja.Add(j1);
end;
json.AddPair('commentcounts',ja);
ss.Text:=json.ToString;
ss.SaveToFile(filename,Tencoding.UTF8);
finally
ss.Free;
json.Free;
end;
end;
//加载历史数据
procedure TfMainForm.LoadDataFromFile(filename:string;bUpdate:boolean);
var
ss:tstrings;
json,j1,j2:TJSONObject;
ja:TJSONArray;
i:integer;
aweme_id,line:string;
comment_count,sub_comment_count:string;
begin
if(mCommentCountList=nil)then
mCommentCountList:=tlist.Create;
if not fileexists(filename) then exit;
try
ss:=tStringlist.create;
ss.LoadFromFile(filename,Tencoding.UTF8);
json := TJSONObject.ParseJSONValue(ss.Text) as TJSONObject;
if json = nil then exit;
ja:=json.GetValue('commentcounts') as TJSONArray;
for I := 0 to ja.Size-1 do
begin
j2:=ja.Get(i) as TJSONObject;
aweme_id:=j2.GetValue('aweme_id').Value;
comment_count:=j2.GetValue('comment_count').Value;
sub_comment_count:=j2.GetValue('sub_comment_count').Value;
if(bUpdate)then
begin
updateCommentMonitor(aweme_id,strtoint(comment_count),strtoint(sub_comment_count));
end else begin
memoNoteId.Lines.Add(aweme_id);
line:=aweme_id+'评论数量:'+comment_count+'评论回复数量:'+sub_comment_count;
memoInfo.Lines.Add(line);
mSaved:=true;
end;
end;
finally
ss.Free;
if(json<>nil)then json.Free;
end;
end;
//定时监测
procedure TFMainForm.Timer1Timer(Sender: TObject);
var
i:integer;
aweme_id:string;
countdata:Tcountdata;
commentCount:TcommentCount;
begin
page1.ActivePage:=tsInfo;
memoInfo.Lines.Add(gettime()+' 开始抓取数据...');
if(mCommentCountList.Count=0)then
begin
memoInfo.Lines.Add(gettime()+' 无aweme ID号');
exit;
end;
timer1.Enabled:=false;
mHasmore:=true;
//getData(0);
getCount(0);
end;
procedure TFMainForm.btnStartClick(Sender: TObject);
var
i:integer;
line:string;
begin
if(btnstart.Caption='关闭监测')then
begin
timer1.Enabled:=false;
SaveDataToFile(uConfig.commentcountfile);
mSaved:=true;
btnstart.Caption:='开始监测';
bar1.Panels[1].Text:='已停止监测';
memoInfo.Lines.Add(getTime()+' 停止监测');
mHasmore:=false;
mIndex:=0;
exit;
end;
if(memonoteid.Lines.Count=0)then
begin
showmessage('请输入要监控的aweme id,一行一个!');
memonoteid.SetFocus;
exit;
end;
for I := 0 to memonoteid.Lines.Count-1 do
begin
line:=memonoteid.Lines[i];
if length(line)<>19 then
begin
showmessage('aweme id输入错误!【'+line+'】');
memonoteid.SetFocus;
exit;
end;
end;
initCommentMonitor(memonoteid.Lines);
i:=strtoint(trim(edtInterval.Text))*1000;
//timer1.Interval:=2*60*1000;//2*60*1000
timer1.Interval:=i;
timer1.Enabled:=true;
btnstart.Caption:='关闭监测';
mSaved:=false;
memoInfo.Lines.Add(getTime()+' 监测开始...');
timer1.OnTimer(sender);
uAuth.addcount;
bar1.Panels[1].Text:='正在监测...';
end;
///流程:取评论总数量,
///如果无评论数据,取评论数据,
///如果总数量增加,取具体评论数据,
///具体评论数量与原有值比较,如果增加,取新评论,显示。
/// <summary>判断是否新增评论,如果是,取评论数据</summary>
/// <param name="aweme_id">笔记ID</param>
/// <param name="total_count">评论总数量</param>
/// <returns>返回是否有新增评论</returns>
/// <remarks>如果是第一次取评论总数量,接着取评论具体数据</remarks>
function TfMainForm.CommentMonitor(aweme_id:string;total_count:integer):boolean;
var
i:integer;
countdata:Tcountdata;
line,t,newcomment:string;
count,old_total_count:integer;
comment:Tcomment;
begin
result:=false;
for I := 0 to mCommentCountList.Count-1 do
begin
countdata:=mCommentCountList[i];
if(countdata.aweme_id=aweme_id)then
begin
//第一次取评论数据
old_total_count:=countdata.comment_count+countdata.sub_comment_count;
if(old_total_count=-2)then //如果没数据,取
begin
result:=true;
comment:=Tcomment.Create(0,aweme_id);
if(uConfig.DEBUG)then comment.working() else
comment.start;
exit;
end;
//有新增评论,取评论数据
if(total_count>old_total_count)then
begin
result:=true;
t:=FormatDateTime('yyyy-mm-dd hh:nn:ss:zzz', Now);
line:=t+' 监测到aweme_ID='+aweme_id+'的评论数量有变化,原评论数量:'+inttostr(old_total_count)+'现评论数量:'+inttostr(total_count);
memoInfo.Lines.Add(line);
count:=total_count-old_total_count;
if(count>0)then
begin
comment:=Tcomment.Create(0,aweme_id);
//commentCount.NewCount:=count;
if(uConfig.DEBUG)then comment.working() else
comment.start;
end;
//page1.ActivePageIndex:=1;
Winapi.Windows.beep(1000,600);
exit;
end;
end;
end;
end;
/// <summary>判断是否新增评论,如果是,取评论数据</summary>
/// <param name="aweme_id">笔记ID</param>
/// <remarks></remarks>
procedure TfMainForm.CommentMonitor(aweme_id:string;comment_count,sub_comment_count:integer);
var
i:integer;
countdata:Tcountdata;
line,t,newcomment:string;
count:integer;
begin
for I := 0 to mCommentCountList.Count-1 do
begin
countdata:=mCommentCountList[i];
if(countdata.aweme_id=aweme_id)then
begin
if(countdata.comment_count=-1)then
begin
countdata.comment_count:=comment_count;
countdata.sub_comment_count:=sub_comment_count;
t:=FormatDateTime('yyyy-mm-dd hh:nn:ss:zzz', Now);
line:=t+' aweme_ID='+aweme_id+'的评论数量:'+inttostr(comment_count)+'评论回复数量:'+inttostr(sub_comment_count);
memoInfo.Lines.Add(line);
continue;
end;
if(comment_count<>countdata.comment_count)then
begin
t:=FormatDateTime('yyyy-mm-dd hh:nn:ss:zzz', Now);
line:=t+' 监测到aweme_ID='+aweme_id+'的评论数量有变化,原评论数量:'+inttostr(countdata.comment_count)+'现评论数量:'+inttostr(comment_count);
memoInfo.Lines.Add(line);
count:=comment_count-countdata.comment_count;
if(count>0)then
begin
newcomment:=getNewcomment(aweme_id,count);
if(newcomment<>'')then
begin
memoinfo.Lines.Add('新增评论为:');
memoInfo.Lines.Add(newcomment);
//sendwechat(newcomment);
pushplus(newcomment);
end;
end;
//page1.ActivePageIndex:=1;
Winapi.Windows.beep(1000,600);
end;
if(sub_comment_count<>countdata.sub_comment_count)then
begin
t:=FormatDateTime('yyyy-mm-dd hh:nn:ss:zzz', Now);
line:=t+' 监测到aweme_ID='+aweme_id+'的评论回复数量有变化,原评论回复数量:'+inttostr(countdata.sub_comment_count)+'现评论回复数量:'+inttostr(sub_comment_count);
memoInfo.Lines.Add(line);
//page1.ActivePageIndex:=1;
Winapi.Windows.beep(1000,600);
end;
countdata.comment_count:=comment_count;
countdata.sub_comment_count:=sub_comment_count;
exit;
end;
end;
end;
//处理采集到的数据
procedure TfMainForm.DataMsg(var aMessage:Tmessage);
var
msg,line:string;
i,id:integer;
comment:Tcomment;
aweme_id:string;
comment_count,sub_comment_count,total_count,newCount:integer;
aweme:Taweme;
newcomment:string;
bRet:boolean;
begin
try
//-------------------------------------------------------------------------
if(aMessage.WParam=1)then //tcommentcount返回结果
begin
comment:=Tcomment(aMessage.LParam);
aweme_id:=comment.aweme_id;
comment_count:=comment.comment_count;
sub_comment_count:=comment.sub_comment_count;
line:=getTime()+' aweme_ID='+aweme_id+'评论统计完成:评论数量:'+inttostr(comment_count)+'子评论数量:'+inttostr(sub_comment_count);
memoInfo.Lines.Add(line);
CommentMonitor(aweme_id,comment_count,sub_comment_count);
end;
if(aMessage.WParam=2)then
begin
memoInfo.Lines.Add('(comment)抓取数据失败,请检查cookie');
end;
if(aMessage.WParam=3)then //aweme返回结果
begin
aweme:=Taweme(aMessage.LParam);
aweme_id:=aweme.aweme_id;
total_count:=aweme.comment_count;
line:=getTime()+' aweme_ID='+aweme_id+'评论统计完成:评论总数量:'+inttostr(total_count);
memoInfo.Lines.Add(line);
bRet:=CommentMonitor(aweme_id,total_count);
if(bRet)then exit; //评论数量有变化
end;
if(aMessage.WParam=4)then
begin
memoInfo.Lines.Add('(aweme)抓取数据失败,请检查cookie');
end;
if(mHasMore)then
begin
mIndex:=mIndex+1;
if(mIndex>=mCommentCountList.Count)then
begin
mIndex:=0;
mHasmore:=false;
if(btnStart.Caption='关闭监测')then
timer1.Enabled:=true;
SaveDataToFile(uConfig.commentcountfile);//及时保存数据
end;
if(mHasMore)then
begin
//getData(mIndex);
getCount(mIndex);
end;
end;
finally
end;
end;
procedure TFMainForm.btnCloseClick(Sender: TObject);
begin
if(not mSaved)then
SaveDataToFile(uConfig.commentcountfile);
close;
end;
procedure TFMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
end;
procedure TFMainForm.FormCreate(Sender: TObject);
begin
end;
procedure TFMainForm.FormResize(Sender: TObject);
begin
btnStart.Top:=8;
btnClose.Top:=8;
label1.Top:=12;
label2.Top:=12;
edtInterval.Top:=10;
btnClose.Left:=fMainform.Width-btnClose.Width;
btnStart.Left:=fMainform.Width-btnClose.Width-btnStart.Width-8;
label1.Left:=8;
edtInterval.Left:=label1.Left+label1.Width+4;
label2.Left:=edtInterval.Left+edtInterval.Width+4;
end;
procedure TFMainForm.FormShow(Sender: TObject);
var
i:integer;
begin
caption:=uConfig.APP_TITLE+uConfig.APP_VERSION; //+' 技术支持:'+uConfig.APP_CONTACT
LoadDataFromFile(uConfig.commentcountfile,false);
TCommentCount.form:=fmainForm.Handle;
Tfeed.form:=fmainForm.Handle;
Tfeed.cookie:=uConfig.cookie;
page1.ActivePageIndex:=0;
fmainform.Width:=1080;
fmainform.Height:=800;
if(uConfig.DEBUG)then button1.Visible:=true;
Taweme.form:=fmainForm.Handle;
taweme.cookie:=uconfig.cookie;
Tcomment.form:=fmainForm.Handle;
Tcomment.cookie:=uconfig.cookie;
end;
end.
4、功能函数
unit uFuncs;
interface
uses
windows,sysutils,Clipbrd,WinInet,urlmon,shlobj,classes,System.RegularExpressions,StrUtils,ComObj,
System.Net.HttpClientComponent,System.Net.httpclient,ioutils,dateutils,TLHelp32,shellapi,system.JSON;
function getClipbrdText():string;
function DownloadFile(SourceFile, DestFile: string): Boolean;
function getUnique():string;
function GetSpecialFolderDir(const folderid: integer): string;
function UrlGetFile(const URL,localFilename: string): boolean;
function getUrl(txt:string):string;
function MakeFileList(Path,FileExt:string):TStringList ;
function ExecScript(Code,Lang,Func:string):string;
function getPostResult(url,data:string):string;
function getRequestResult(url:string):string;
function formatFilename(caption:string):string;
function GetValidName(s:string):string;
function getTime():string;overload;
function getTime(dt:Tdatetime):string;overload;
function GetTime_DateTime(s: string): TDateTime;
function AscCompareInt(List: TStringList; I1, I2: Integer): Integer;
function DescCompareInt(List: TStringList; I1, I2: Integer): Integer;
function TimeCompareInt(List: TStringList; I1, I2: Integer): Integer;
function GetProcessID(Filename:pansiChar):DWORD;
function GetSpecialFolder(nFolder: Integer):string;
procedure RunFile(filename:string);
function KillTask(ExeFileName: string): Integer;
function FileSizeByName(filename:string):integer;
function JsonExist(parent:TJSONObject;child:string):boolean;
var
DateSeparator: char;
fs: TFormatSettings;
implementation
//CSIDL_DESKTOP
uses
uLog;
function JsonExist(parent:TJSONObject;child:string):boolean;
var
i:integer;
keyname:string;
begin
result:=false;
if(parent=nil)then exit;
for i:=0 to parent.count-1 do
begin
keyname:=parent.Get(i).JsonString.toString;
keyname:=midstr(keyname,2,length(keyname)-2);
if(keyname=child)then
begin
result:=true;
exit;
end;
end;
end;
function FileSizeByName(filename:string):integer;
var
FileHandle:integer;
begin
result:=-1;
try
FileHandle := FileOpen(FileName, GENERIC_READ or FILE_SHARE_READ);
result:=GetFileSize(FileHandle, nil);
FileClose(FileHandle);
finally
end;
end;
function KillTask(ExeFileName: string): Integer;
const
PROCESS_TERMINATE = $0001;
var
ContinueLoop: BOOL;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
begin
Result := 0;
FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
while Integer(ContinueLoop) <> 0 do
begin
if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =
UpperCase(ExeFileName))) then
Result := Integer(TerminateProcess(
OpenProcess(PROCESS_TERMINATE,
BOOL(0),
FProcessEntry32.th32ProcessID),
0));
ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
end;
CloseHandle(FSnapshotHandle);
end;
procedure RunFile(filename:string);
begin
if(fileexists(filename))then
begin
shellexecute(0,'open',pchar(filename),nil,pchar(extractfiledir(filename)),sw_hide);
end;
end;
function GetProcessID(Filename:pansiChar):DWORD;
var
snapshot:THandle;
processinfo:PROCESSENTRY32A; //在use中添加TLHelp32
status:bool;
begin
result:=0;
processinfo.dwSize:=sizeof(processinfo);
snapshot:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); //CreateToolhelp32Snapshot创建一个快照
status := Process32FirstA (snapshot,processinfo) ;
while (status) do
begin
if StrIcomp(processinfo.szExeFile,FileName)=0 then
begin
result:=processinfo.th32ProcessID;
exit;
end;
status := Process32NextA (snapshot, processinfo) ;
end;//while
closehandle(snapshot);
end;
//根据时间排序
function TimeCompareInt(List: TStringList; I1, I2: Integer): Integer;
var
dt1,dt2:TdateTime;
str1,str2:string;
c:integer;
begin
str1:=leftstr(List[I1],23);
str2:=leftstr(List[I2],23);
str1:=stringreplace(str1,'-',DateSeparator,[rfReplaceAll]);
str2:=stringreplace(str2,'-',DateSeparator,[rfReplaceAll]);
dt1:=strtodatetime(str1);
dt2:=strtodatetime(str2);
if(dt1-dt2>0)then c:=1 else c:=-1;
result:=c*SecondsBetween(dt1,dt2);
end;
function AscCompareInt(List: TStringList; I1, I2: Integer): Integer;
begin
I1 := StrToIntDef(List[I1], 0);
I2 := StrToIntDef(List[I2], 0);
Result := I1 - I2; //正序排序
end;
function DescCompareInt(List: TStringList; I1, I2: Integer): Integer;
begin
I1 := StrToIntDef(List[I1], 0);
I2 := StrToIntDef(List[I2], 0);
Result := I2 - I1; //倒叙排序
end;
//javascript时间转delphi时间
function GetTime_DateTime(s: string): TDateTime;
var
DateSeparator: char;
fs: TFormatSettings;
begin
GetLocaleFormatSettings(GetUserDefaultLCID, fs);
DateSeparator:=fs.DateSeparator;
Result := IncMilliSecond(StrToDateTime(Format('1970%s01%s01 08:00:00',[DateSeparator,DateSeparator])), StrToInt64(s));
end;
function getTime(dt:Tdatetime):string;
begin
result:=FormatDateTime('yyyy-mm-dd hh:nn:ss:zzz', dt);
end;
function getTime():string;
begin
result:=FormatDateTime('yyyy-mm-dd hh:nn:ss:zzz', Now);
end;
function GetValidName(s:string):string;
var
c:char;
txt:string;
begin
txt:=s;
for c in TPath.GetInvalidFileNameChars() do
begin
txt:=stringreplace(txt,c,'',[rfReplaceAll]);
end;
result:=txt;
end;
function formatFilename(caption:string):string;
var
s:string;
begin
s:=caption;
if(length(s)>72)then s:=leftstr(s,72);
result:=GetValidName(s);
end;
function getRequestResult(url:string):string;
var
client: TNetHTTPClient;
ss: TStringStream;
s,id:string;
AResponse:IHTTPResponse;
i:integer;
begin
try
result:='';
client := TNetHTTPClient.Create(nil);
SS := TStringStream.Create('', TEncoding.UTF8);
ss.Clear;
with client do
begin
ConnectionTimeout := 60000; // 30秒
ResponseTimeout := 60000; // 30秒
AcceptCharSet := 'utf-8';
//UserAgent := USER_AGENT; //1
client.AllowCookies:=true;
client.HandleRedirects:=true;
Accept:='application/json, text/plain, */*'; //'*/*'
client.ContentType:='application/json'; //2
client.AcceptLanguage:='zh-CN,zh;q=0.9';
//client.AcceptEncoding:='gzip, deflate, br';
//client.CustomHeaders['Cookie'] := cookie;
//client.CustomHeaders['Referer'] := 'https://www.xiaohongshu.com/';
//client.CustomHeaders['X-s'] := 'ZB5p16ZBOlFKsjk6s6Ok1iOB0g9iOgFWsjOksjOv0gA3';
//client.CustomHeaders['X-t'] := '1680939868543';
try
AResponse:=Get(url, ss);
if(AResponse.StatusCode=200)then
result:=ss.DataString;
except
on E: Exception do
Log.e('Funcs.getRequestResult',e.Message);
end;
end;
finally
ss.Free;
client.Free;
end;
end;
function getPostResult(url,data:string):string;
var
client: TNetHTTPClient;
ss,args: TStringStream;
begin
result:='';
try
try
client := TNetHTTPClient.Create(nil);
SS := TStringStream.Create('', TEncoding.UTF8);
ss.Clear;
args := TStringStream.Create(data, TEncoding.UTF8);
with client do
begin
ConnectionTimeout := 60000; // 30秒
ResponseTimeout := 60000; // 30秒
AcceptCharSet := 'utf-8';
//UserAgent := USER_AGENT; //1
client.AllowCookies:=true;
client.HandleRedirects:=true;
Accept:='*/*';
client.ContentType:='application/json'; //2
client.Post(url,args,ss);
result:=ss.DataString;
end;
except
on E: Exception do
begin
log.e('uFuncs.getPostResult',' err失败:'+#13#10+url+#13#10+e.Message);
end;
end;
finally
ss.Free;
args.Free;
client.Free;
end;
end;
function ExecScript(Code,Lang,Func:string):string;
var
script:OleVariant;
begin
try
result:='';
try
script:=CreateOleObject('ScriptControl');
script.Language:=Lang;
script.AddCode(Code);
Result:=script.Eval(Func);
except
//on E: Exception do
//Log(e.Message);
end;
finally
//script:=Unassigned;
end;
end;
function getUrl(txt:string):string;
var
m:TMatch;
begin
result:='';
m := TRegEx.Match(txt,'(https?|ftp|file)://[-A-Za-z0-9+&@#/%?=~_|!:,.;]+[-A-Za-z0-9+&@#/%=~_|]');
if(m.Groups.Count>0)then
begin
if(m.Groups[0].Success=true)then
begin
result:=m.Groups[0].Value;
end;
end else begin
exit;
end;
end;
/// <summary>获取系统路径</summary>
/// <param name="folderid">特殊目录</param>
/// <returns>返回特殊目录</returns>
/// <remarks></remarks>
///CSIDL_DESKTOP://桌面;
///CSIDL_DRIVERS://我的电脑
///CSIDL_FAVORITES://收藏夹;
///CSIDL_STARTUP://开始菜单;
///CSIDL_NETWORK://网上邻居;
///CSIDL_PROFILE C:\Users\username
function GetSpecialFolderDir(const folderid: integer): string;
var
pidl: pItemIDList;
buffer: array[0..255] of char;
begin
//取指定的文件夹项目表
SHGetSpecialFolderLocation(0, folderid, pidl);
SHGetPathFromIDList(pidl, buffer); //转换成文件系统的路径
Result := string(buffer);
end;
function getUnique():string;
var
st: TSystemTime;
begin
//GetLocalTime(st);
//result:=format('%4d%2d%2d%2d%2d%2d%3d',
//[st.wYear,st.wMonth,st.wDay,st.wHour,st.wMinute,st.wSecond,st.wMilliseconds]);
result:=FormatDateTime('yyyymmddhhnnsszzz', Now);
end;
function getClipbrdText():string;
var
buf: array[0..1023] of char;
BufSize: Integer;
H: THandle;
begin
result:='';
buf:='';
try
if Clipboard.HasFormat(CF_TEXT) then begin
H := ClipBoard.GetAsHandle(CF_TEXT);
BufSize := GlobalSize(H);
BufSize := Clipboard.GetTextBuf(buf, BufSize);
//Edit1.Text := cbBuf;
result:=buf;
end;
finally
end;
end;
function DownloadFile(SourceFile, DestFile: string): Boolean;
begin
try
DeleteUrlCacheEntry(pchar(SourceFile));
Result := UrlDownloadToFile(nil, PChar(SourceFile), PChar(DestFile), 0, nil) = 0;
except
Result := False;
end;
end;
function UrlGetFile(const URL,localFilename: string): boolean;
const
//Agent = 'Internet Explorer 6.0'; //Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/108.0.0.0 Safari/537.36
//Agent='Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/108.0.0.0 Safari/537.36';
Agent='ua';
var
hFile, HInet: HINTERNET;
Buffer: array[0..32767] of byte;
BufRead: Cardinal;
BufSize: Cardinal;
TempStream: TFileStream;
dwIndex: dword;
begin
result:=false;
HInet := InternetOpen(PChar(Agent), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
if Assigned(HInet) then
try
hFile := InternetOpenUrl(HInet, PChar(URL), nil, 0, 0, 0);
deletefile(pchar(localFilename));
TempStream := TFileStream.Create(localFilename,fmCreate);
dwIndex := 0;
BufSize := SizeOf(Buffer);
//HttpQueryInfo(hfile, HTTP_QUERY_RAW_HEADERS_CRLF, @Buffer, BufSize, dwIndex);
if Assigned(hFile) then
try
with TempStream do
try
while InternetReadFile(hFile, @Buffer, BufSize, BufRead) and (BufRead > 0) do
Write(Buffer, BufRead);
Result := true;
finally
Free;
end;
finally
InternetCloseHandle(hFile);
end;
finally
InternetCloseHandle(hinet);
end;
end;
{-------------------------------------------------------------------------------
过程名: MakeFileList 遍历文件夹及子文件夹
参数: Path,FileExt:string 1.需要遍历的目录 2.要遍历的文件扩展名
返回值: TStringList
其它: 排除: android , support 子目录 ;
USE StrUtils
Eg:ListBox1.Items:= MakeFileList( 'E:\极品飞车','.exe') ;
ListBox1.Items:= MakeFileList( 'E:\极品飞车','.*') ;
-------------------------------------------------------------------------------}
function MakeFileList(Path,FileExt:string):TStringList ;
var
sch:TSearchrec;
begin
Result:=TStringlist.Create;
if rightStr(trim(Path), 1) <> '\' then
Path := trim(Path) + '\'
else
Path := trim(Path);
if not DirectoryExists(Path) then
begin
Result.Clear;
exit;
end;
if FindFirst(Path + '*', faAnyfile, sch) = 0 then
begin
repeat
//Application.ProcessMessages;
if ((sch.Name = '.') or (sch.Name = '..')) then Continue;
if DirectoryExists(Path+sch.Name) then
begin
//if(lowerCase(sch.Name)='android')or(lowerCase(sch.Name)='support')then continue;
Result.AddStrings(MakeFileList(Path+sch.Name,FileExt));
end
else
begin
if (UpperCase(extractfileext(Path+sch.Name)) = UpperCase(FileExt)) or (FileExt='.*') then
Result.Add(Path+sch.Name);
end;
until FindNext(sch) <> 0;
SysUtils.FindClose(sch);
end;
end;
/// <summary>获取系统路径</summary>
/// <param name="nFolder">特殊目录</param>
/// <returns>返回特殊目录</returns>
/// <remarks></remarks>
///CSIDL_DESKTOP://桌面;
///CSIDL_DRIVERS://我的电脑
///CSIDL_FAVORITES://收藏夹;
///CSIDL_STARTUP://开始菜单;
///CSIDL_NETWORK://网上邻居;
///CSIDL_PROFILE C:\Users\username
function GetSpecialFolder(nFolder: Integer):string;
var
pitem:PITEMIDLIST;
s:string;
begin
shGetSpecialFolderLocation(0,CSIDL_DESKTOP,pitem);
setlength(s,128);
shGetPathFromIDList(pitem,pchar(s));
result:=s;
end;
{
function getClipbrdText():string;
var
CbBuf: PChar;
BufSize: Integer;
H: THandle;
begin
result:='';
CbBuf:=nil;
try
if Clipboard.HasFormat(CF_TEXT) then begin
H := ClipBoard.GetAsHandle(CF_TEXT);
BufSize := GlobalSize(H);
GetMem(CbBuf, BufSize);
BufSize := Clipboard.GetTextBuf(cbBuf, BufSize);
//Edit1.Text := cbBuf;
result:=cbBuf;
end;
finally
if cbBuf<>nil then
freemem(cbBuf);
end;
end;
}
begin
GetLocaleFormatSettings(GetUserDefaultLCID, fs);
DateSeparator:=fs.DateSeparator;
end.
5、配置文件
unit uConfig;
interface
uses
Vcl.Forms,System.SysUtils,strutils,classes,uFuncs,uNethelper,vcl.Dialogs,ioutils,
windows,shlobj,uLog;
const
APP_NAME:string='dyComment';
APP_TITLE:string='抖音评论监测';
APP_VERSION:string='1.0';
APP_ID:string='cf';
APP_VER:double=1.0;
APP_CONTACT='技术服务~~:39848872~~:byc6352或metabycf';
WORK_DIR:string='dycomment'; // 工作目录
DATA_DIR:string='data';
LOG_NAME:string='dycommentLog.txt';
CONFIG_FILE:string='dycomment.config';
COOKIE_FILE:string='cookie.txt';
COMMENT_COUNT_FILE:string='comment_count.json';
USER_AGENT:string='Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/118.0.0.0 Safari/537.36';
DEBUG:boolean=false;
var
workdir,saveDir,cookie:string;// 工作目录
configfile,logfile,cookiefile,commentcountfile:string;
commentcount:string;
isInit:boolean=false;
procedure init();
procedure readConfig(filename:string);
procedure writeSaveDir();
function readCookie(filename:string):string;
function getA1(cookie:string):string;
function loadString(filename:string):string;
function SetCookieFromChrome():boolean;
implementation
function loadString(filename:string):string;
var
ss:tstrings;
begin
result:='';
if(not fileexists(filename))then exit;
try
ss:=tstringlist.Create;
ss.LoadFromFile(filename,Tencoding.UTF8);
result:=ss.Text;
finally
ss.Free;
end;
end;
procedure writeSaveDir();
var
ss:tstrings;
begin
try
ss:=tstringlist.Create;
if(fileexists(configfile))then
begin
ss.LoadFromFile(configfile);
ss[0]:=savedir;
end else begin
ss.Add(savedir);
//ss.Add(DIRECT_DOWN);
end;
ss.SaveToFile(configfile);
finally
ss.Free;
end;
end;
function readCookie(filename:string):string;
var
ss:tstrings;
begin
result:='';
try
ss:=tstringlist.Create;
if(fileexists(filename))then
begin
ss.LoadFromFile(filename);
result:=ss.Text;
end else begin
end;
finally
ss.Free;
end;
end;
function getA1(cookie:string):string;
var
tmp:string;
i:integer;
begin
result:='';
if(length(cookie)=0)then exit;
tmp:=cookie;
i:=pos('a1=',tmp);
if(i=-1)then exit;
tmp:=rightstr(tmp,length(tmp)-i-2);
i:=pos(';',tmp);
if(i=-1)then begin result:=tmp;exit;end;
result:=leftstr(tmp,i-1);
end;
procedure readConfig(filename:string);
var
tf:TextFile;
s:string;
begin
try
AssignFile(tf,filename);
if not fileexists(filename) then
begin
saveDir:=workdir+'\comments';
if(not DirectoryExists(saveDir))then ForceDirectories(saveDir);
Rewrite(tF);
WriteLn(tf,saveDir);
flush(tf);
end else begin
Reset(tF); //读打开文件,文件指针移到首
readln(tf,saveDir);
end;
finally
closefile(tf);
end;
end;
procedure init();
var
me:String;
begin
if(isInit=true)then exit;
isInit:=true;
me:=application.ExeName;
workdir:=extractfiledir(me)+'\'+WORK_DIR;
if(not DirectoryExists(workdir))then ForceDirectories(workdir);
savedir:=workdir+'\'+DATA_DIR;
if(not DirectoryExists(savedir))then ForceDirectories(savedir);
//configfile:=workdir+'\'+CONFIG_FILE;
//readConfig(configfile);
logfile:=workdir+'\'+LOG_NAME;
log:=Tlog.Create(logfile);
//SetCookieFromChrome();
cookiefile:=workdir+'\'+COOKIE_FILE;
cookie:=readCookie(cookiefile);
cookie:=stringreplace(cookie,#13#10,'',[rfReplaceAll]);
commentcountfile:=workdir+'\'+COMMENT_COUNT_FILE;
if(fileexists(commentcountfile))then
commentcount:=loadstring(commentcountfile);
end;
begin
init();
end.