📄 web_main.~pas
字号:
unit web_main;
interface
uses
Windows, Messages,StrUtils, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdHTTP, OleCtrls, SHDocVw,inifiles, DB, ADODB, ExtCtrls,
ComCtrls, Menus, ToolWin, XPMan,encddecd;
var
str0,str1,str2,str6,str3,str7, currentdirectory,mz,
str4,str8,str5,str10,str9,str11,str12:string;
no_list:TStringList;
dd,i:integer;
outnum:string;
zce:boolean;
function fun_search (search_falg,outhtml:string):integer;
function Read_inifile(filename,readstring_first,readstring_second:string;scount:integer):TStringList;
function Write_log (falg1,falg2,falg3:string):integer;
function inport_no(txt_path:string):TStringList;
function save_inifile(filename,readstring_first,readstring_second,setup_str:string):boolean;
function is_intt(input:string):Boolean;
function Write_sys (falg1,falg2,falg3:string):integer;
function to_int(input:string):string;
type
TForm1 = class(TForm)
WebBrowser1: TWebBrowser;
StatusBar1: TStatusBar;
MainMenu1: TMainMenu;
N1: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
SaveDialog1: TSaveDialog;
OpenDialog1: TOpenDialog;
N8: TMenuItem;
N9: TMenuItem;
CoolBar1: TCoolBar;
Edit1: TEdit;
N2: TMenuItem;
Edit2: TEdit;
XPManifest1: TXPManifest;
IdHTTP1: TIdHTTP;
N7: TMenuItem;
N10: TMenuItem;
N6: TMenuItem;
N11: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
procedure N4Click(Sender: TObject);
procedure N5Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormActivate(Sender: TObject);
procedure N8Click(Sender: TObject);
procedure Edit1Change(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N7Click(Sender: TObject);
procedure N10Click(Sender: TObject);
procedure N6Click(Sender: TObject);
procedure N11Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses MSHTML, u_web2,getidesn,SHELLAPI;
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var
list_inifile:TStringList;
begin
no_list:=TStringList.Create;
Application.ProcessMessages;
zce:=false;
Application.ProcessMessages;
getdir(0,currentdirectory);
no_list:=inport_no(currentdirectory+'\sy.txt') ;
StatusBar1.Panels.Items[2].Text:='信息数量:'+inttostr(no_list.Count);
try
list_inifile:=TStringList.Create;
list_inifile:=Read_inifile('sys.ini','Option','str',12);
Application.ProcessMessages;
str0:=currentdirectory+'\'+trim(list_inifile.Strings[0]);
str1:=trim(list_inifile.Strings[1]);
str2:=trim(list_inifile.Strings[2]);
str3:=trim(list_inifile.Strings[3]);
str4:=currentdirectory+'\'+trim(list_inifile.Strings[4]);
str5:=trim(list_inifile.Strings[5]);
str6:=trim(list_inifile.Strings[6]);
str7:=trim(list_inifile.Strings[7]);
str8:=trim(list_inifile.Strings[8]);
str9:=trim(list_inifile.Strings[9]);
str10:=trim(list_inifile.Strings[10]);
str11:=trim(list_inifile.Strings[11]);
str12:=trim(list_inifile.Strings[12]);
finally
list_inifile.Free;
end;
i:=0;
end;
function Write_log (falg1,falg2,falg3:string):integer;
var IniFile:TIniFile;
IniFileName:String;
begin
result:=0;
Try
IniFileName:=ExtractFilePath(Application.ExeName)+formatdatetime('yyyymmdd',now())+'.txt';
IniFile:=TIniFile.Create(IniFileName);
IniFile.WriteString(falg1,falg2,falg3);
Finally
IniFile.Free;
end;
end;
function fun_search (search_falg,outhtml:string):integer;
begin
result:=POS(search_falg,outhtml);
end;
function Read_inifile(filename,readstring_first,readstring_second:string;scount:integer):TStringList;
var
SysIni:TInifile;
sPath:String;
all_list:TStringList ;
i:integer;
begin
sPath := ExtractFilePath(Application.ExeName)+filename;
If not FileExists(sPath) then
begin
showmessage('false');
Application.Terminate;
end;
all_list:=TStringList.Create;
SysIni := TIniFile.Create(sPath);
for i:=0 to scount do
begin
all_list.Add(SysIni.ReadString(readstring_first,readstring_second+inttostr(i),''));
end;
SysIni.Free;
result:= all_list;
end;
procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
var
i:integer;
v_web : Olevariant;
outthtml:string;
HTMLWindow: IHTMLWindow2; // parent window of current HTML document
// oElement: Olevariant;
oDoc: HTMLDocument;
begin
if zce then
begin
oDoc := WebBrowser1.Document as HTMLDocument;
outthtml:=trim(Form1.WebBrowser1.OleObject.document.Body.OuterHtml);
edit1.Text:=trim(WebBrowser1.LocationURL);
/////////////////////////////////////////////////////////////////// [忘记密码]
if rightstr(trim(WebBrowser1.LocationURL),9)=rightstr(str0,9) then // 登陆
begin
if no_list.Count>0 then
begin
v_web := WebBrowser1.OleObject.document.all.item('userName',0); //找到登录用户名的输入框
v_web.value := leftstr(trim(no_list.Strings[0]),11);
v_web := WebBrowser1.OleObject.document.all.item('passWord',0); //找到登录密码的输入框
v_web.value := rightstr(trim(no_list.Strings[0]),6);
v_web := WebBrowser1.OleObject.document.all.item('submit',0); //找到登录密码的输入框
edit2.Text:=trim(no_list.Strings[0]);
v_web.click;
end;
end
else if fun_search (str1,WebBrowser1.LocationURL)>0 then
begin
if no_list.Count>0 then
begin
Write_log ('my',leftstr(trim(no_list.Strings[0]),11),'密码错误');
if no_list.IndexOf(edit2.Text)>-1 then no_list.Delete(no_list.IndexOf(trim(edit2.Text)));
no_list.SaveToFile(currentdirectory+'\sy.txt');
WebBrowser1.Navigate(str0);
end;
end
else if trim(WebBrowser1.LocationURL)=str2 then
begin
N4.Checked:=true;
N4.Caption:='停止受理';
WebBrowser1.Navigate(str3);
end
else if trim(WebBrowser1.LocationURL)=str3 then //协议页面
begin
v_web := WebBrowser1.OleObject.document.all.item('agree',0);
v_web.value := 'ok';
WebBrowser1.OleObject.document.all.item('thisform1',0).submit;
end
else if trim(WebBrowser1.LocationURL)=str7 then
begin
if (fun_search ('目前状态：关闭',outthtml)>0) then
begin
WebBrowser1.OleObject.document.all.item('thisform',0).submit;
end;
end
else if rightstr(trim(WebBrowser1.LocationURL),9)=rightstr(str8,9) then
begin
Write_log ('my',leftstr(trim(no_list.Strings[0]),11),'开通成功');
if no_list.IndexOf(trim(edit2.Text))>-1 then
no_list.Delete(no_list.IndexOf(trim(edit2.Text)));
no_list.SaveToFile(currentdirectory+'\sy.txt');
WebBrowser1.Navigate(str0);
end
else if fun_search (str9,WebBrowser1.LocationURL)>0 then
begin
Write_log ('my',leftstr(trim(no_list.Strings[0]),11),'已经开通');
if no_list.IndexOf(trim(edit2.Text))>-1 then
no_list.Delete(no_list.IndexOf(trim(edit2.Text)));
no_list.SaveToFile(currentdirectory+'\sy.txt');
WebBrowser1.Navigate(str0);
end
else
begin
Write_log ('my',leftstr(trim(no_list.Strings[0]),11),'受理失败');
if no_list.IndexOf(trim(edit2.Text))>-1 then
begin
no_list.Delete(no_list.IndexOf(trim(edit2.Text)));
no_list.Add(trim(edit2.Text));
end;
no_list.SaveToFile(currentdirectory+'\sy.txt');
WebBrowser1.Navigate(str0);
end;
end;
////////////////////////////////////////////////////////
StatusBar1.Panels.Items[1].Text:='时间:'+formatdatetime('yyyy-MM-DD HH:MM:SS',now);
StatusBar1.Panels.Items[2].Text:='信息数量:'+inttostr(no_list.Count);
end;
function to_int(input:string):string;
var i:integer;
str_temp:string;
str_result:string;
begin
str_temp:=trim(input);
str_result:='';
if str_temp<>'' then
begin
for i:=1 to length(str_temp) do
begin
if ( (str_temp[i]<='9') and (str_temp[i]>='0'))or(str_temp[i]='-')or(str_temp[i]='.')then
begin
str_result:=str_result+str_temp[i];
end
end;
end;
result:=str_result ;
end;
function inport_no(txt_path:string):TStringList;
var no_list_temp:TStringList;
F:TextFile;
s:string;
s1:widestring;
begin
If FileExists(txt_path) then
begin
no_list_temp:= TStringList.Create;
AssignFile(F,txt_path);
Reset(F);
while not Eof(F) do
begin
Readln(F,s);
s:=trim(s);
s1:=trim(s);
if (Trim(s)<>'') then
no_list_temp.Add(Trim(s));
end;
CloseFile(F);
end;
result:= no_list_temp;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
no_list.SaveToFile(currentdirectory+'\sy.txt');
no_list.Destroy;
end;
procedure TForm1.N4Click(Sender: TObject);
begin
if zce then
begin
if not N4.Checked then
begin
if (no_list.Count>0) then
begin
N4.Checked:=true;
N4.Caption:='停止受理';
WebBrowser1.Navigate(str0);
StatusBar1.Panels.Items[1].Text:='开始开机时间:'+formatdatetime('yyyy-MM-DD HH:MM:SS',now);
end
else
showmessage('请先导入信息！！');
end
else
begin
N4.Caption:='开始受理';
N4.Checked:=false;
end;
end ;
end;
procedure TForm1.N5Click(Sender: TObject);
var path_str:string;
begin
if zce then
begin
if (OpenDialog1.Execute) then
begin
path_str:=OpenDialog1.FileName;
if FileExists(path_str) then
begin
no_list:=inport_no(path_str);
dd:=0;
end
else
Messagebox(Handle,pchar(path_str+'文件不存在！'),'提示',MB_OK+MB_ICONQUESTION );
end;
StatusBar1.Panels.Items[2].Text:='信息数量:'+inttostr(no_list.Count);
StatusBar1.Panels.Items[3].Text:='';
end
else
Messagebox(Handle,pchar('未注册，请联系QQ:41874592，注册软件！'),'提示',MB_OK);
end;
procedure TForm1.FormActivate(Sender: TObject);
var gerreult,idesn:string;
gerreultint:integer;
begin
idesn:=EncodeString(trim(GetIdeSerialNumber));
try
//gerreult:=trim(IdHTTP1.Get('http://www.zntel.com.cn/sms/soft_reg_check.asp?idesn='+idesn+'&softwhich=13'));
gerreult:='1';
except
on E: Exception do showmessage(E.Message);
end;
if trystrtoint(gerreult,gerreultint) then
begin
if gerreultint=1 then
begin
zce:=true;
WebBrowser1.Navigate(str0);
end
else
begin
InputQuery('注册序列号','请复制下面的 序列号 到 帮助->网站 注册软件', idesn);
WebBrowser1.Navigate('http://www.zntel.com.cn/default.asp?do=noreg');
end;
end;
top:=0;
end;
procedure TForm1.N8Click(Sender: TObject);
begin
no_list.Clear;
StatusBar1.Panels.Items[2].Text:='信息数量:'+inttostr(no_list.Count);
end;
function save_inifile(filename,readstring_first,readstring_second,setup_str:string):boolean;
var
SysIni:TInifile;
sPath:String;
begin
sPath := ExtractFilePath(Application.ExeName)+filename;
If not FileExists(sPath) then
begin
result:=false;
end
else
begin
SysIni:=TIniFile.Create(sPath);
try
SysIni.WriteString(readstring_first,readstring_second,setup_str);
except
on E: Exception do showmessage(e.message);
end;
SysIni.Free;
result:=true;
end;
end;
function is_intt(input:string):Boolean;
var i:integer;
str_temp:string;
begin
result:=true ;
str_temp:=trim(input);
if str_temp<>'' then
begin
for i:=1 to length(str_temp) do
begin
if (str_temp[i]>'9') or (str_temp[i]<'0')then
begin
//showmessage(str_temp[i]);
result:=false ;
break;
end;
end;
end
else
result:=false ;
end;
function Write_sys (falg1,falg2,falg3:string):integer;
var IniFile:TIniFile;
IniFileName:String;
begin
result:=0;
Try
IniFileName:=ExtractFilePath(Application.ExeName)+'sys.ini';
IniFile:=TIniFile.Create(IniFileName);
IniFile.WriteString(falg1,falg2,falg3);
Finally
IniFile.Free;
end;
end;
procedure TForm1.Edit1Change(Sender: TObject);
begin
edit1.Hint:=inttostr(length(trim(edit1.Text)));
end;
procedure TForm1.N2Click(Sender: TObject);
begin
if no_list.Count>0 then
no_list.Delete(0);
StatusBar1.Panels.Items[2].Text:='信息数量:'+inttostr(no_list.Count);
end;
procedure TForm1.N7Click(Sender: TObject);
begin
ShellExecute(handle,'open',pchar('tencent://message/?uin=41874592'),nil,nil,SW_ShowNormal);
end;
procedure TForm1.N10Click(Sender: TObject);
begin
ShellExecute(handle,'open',pchar('http://www.zntel.com.cn/'),nil,nil,SW_ShowNormal);
end;
procedure TForm1.N6Click(Sender: TObject);
var path_str:string;
begin
path_str:=currentdirectory+'\'+formatdatetime('yyyyMMDD',now)+'.txt' ;
if FileExists(path_str) then
ShellExecute(handle,'open',pchar(path_str),nil,nil,SW_ShowNormal);
end;
procedure TForm1.N11Click(Sender: TObject);
var limit_temp:string;
begin
limit_temp:=str11;
if InputQuery('请输入验证地址', '验证地址 ',limit_temp) then
begin
str11:=trim(limit_temp);
save_inifile('sys.ini','Option','str11',str11);
end;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -