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;
  var
   str0,str1,str2,str3,str4,str5,str6,str7,str8,str9,str10,str11,str12,
   currentdirectory:string;
   no_y,no_db,no_hd,no_tc,all_bd:TStringList;
   all_bd_array:array[0..99] of string;


   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 is_int(input:string):Boolean;
   function save_inifile(filename,readstring_first,readstring_second,setup_str:string):boolean;

   function Write_sys (falg1,falg2,falg3:string):integer;
   function SMSReplace(SMS:string):string;
   function Randomstring(AValues:array of string;max:integer): string;
//从一个字符串指定位置替换为另一个定子串。
   function replacing(S,source,target:string):string;

type
  TForm1 = class(TForm)
    SaveDialog1: TSaveDialog;
    OpenDialog1: TOpenDialog;
    StatusBar1: TStatusBar;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    Memo1: TMemo;
    Memo2: TMemo;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    Memo3: TMemo;
    N8: TMenuItem;
    N9: TMenuItem;
    q1: TMenuItem;
    N10: TMenuItem;
    Timer1: TTimer;
    N11: TMenuItem;
    N12: TMenuItem;
    Memo4: TMemo;
    N13: TMenuItem;
    Button1: TButton;
    Edit1: TEdit;
    Button2: TButton;
    N11111: TMenuItem;
    Button4: TButton;
    Button3: TButton;
    Button5: TButton;
    Memo6: TMemo;
    Memo5: TMemo;
    Button6: TButton;
    Edit2: TEdit;
    CheckBox1: TCheckBox;
    Memo7: TMemo;
    Button7: TButton;
    Edit3: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure N2Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure Memo1Change(Sender: TObject);
    procedure Memo2Change(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure N8Click(Sender: TObject);
    procedure N9Click(Sender: TObject);
    procedure q1Click(Sender: TObject);
    procedure N10Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure N12Click(Sender: TObject);
    procedure N13Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure N11111Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Memo3Change(Sender: TObject);
    procedure Memo3Click(Sender: TObject);
    procedure Memo5Change(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Memo6Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure Memo7Change(Sender: TObject);
    procedure Memo7Click(Sender: TObject);
    procedure Edit3Change(Sender: TObject);
    procedure Button7Click(Sender: TObject);
   
  private

  public

  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var
   list_inifile:TStringList;
   txt_path:string;
   i:integer;
begin
memo3.Clear;

getdir(0,currentdirectory);

try
list_inifile:=TStringList.Create;
list_inifile:=Read_inifile('sys.ini','Option','str',12);
Application.ProcessMessages;
str0:=trim(list_inifile.Strings[0]);
str1:=trim(list_inifile.Strings[1]);
str2:=trim(list_inifile.Strings[2]);
str3:=trim(list_inifile.Strings[3]);
str4:=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;
no_y:=TStringList.Create;

no_db:=TStringList.Create;
txt_path:=ExtractFilePath(Application.ExeName)+'db.txt';
 If FileExists(txt_path) then no_db:=inport_no(txt_path);
StatusBar1.Panels.Items[3].Text:='屏蔽号段数量:'+inttostr(no_db.Count);

txt_path:=ExtractFilePath(Application.ExeName)+'sy.txt';
 If FileExists(txt_path) then no_y:=inport_no(txt_path);

 if no_y.Count>0 then
 begin
 memo3.Text:=(no_y.Strings[0]);
 no_y.Delete(0);
 end;
 StatusBar1.Panels.Items[0].Text:='导入号码:'+inttostr(no_y.Count);

no_hd:=TStringList.Create;
no_tc:=TStringList.Create;
all_bd:=TStringList.Create;
all_bd.Sorted:=true;
memo5.Text:=str1;
memo6.Clear;
Edit1.Text:=str2;
memo7.Lines.DelimitedText:=str3;
Edit3.Text:=str4;
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())+'-'+'.log';
     IniFile:=TIniFile.Create(IniFileName);
     IniFile.WriteString(falg1,falg2,falg3);
   Finally
    IniFile.Free;
   end;
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;

function is_int(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  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);
        Application.ProcessMessages; //and (length(s)=length(s1))
        if (Trim(s)<>'')    then
        no_list_temp.Add(Trim(s));
      end;
    CloseFile(F);

    end;
   result:= no_list_temp;
   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 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;

function SMSReplace(SMS:string):string;
VAR STRTEMP1, STRTEMP2,STRTEMP3:wideSTRING ;
    i,stri:integer;
BEGIN
 STRTEMP1:=widestring(SMS);
 i:=0;
 while i<length(STRTEMP1)  do
 begin
   STRTEMP2:=copy(STRTEMP1,i+1,1);
   if  STRTEMP2='㏄'  then
   STRTEMP3:=STRTEMP3+Randomstring(all_bd_array,all_bd.Count)
   else
   STRTEMP3:=STRTEMP3+STRTEMP2;
   inc(i);
 end;

result:=STRTEMP3;
end;


//从一个字符串指定位置替换为另一个定子串。
function replacing(S,source,target:string):string;
var site,StrLen:integer; 
begin 
{source在S中出现的位置} 
site:=pos(source,s); 
{source的长度}
StrLen:=length(source); 
{删除source字符串} 
delete(s,site,StrLen); 
{插入target字符串到S中} 
insert(target,s,site); 
{返回新串} 
replacing:=s; 
end; 


function Randomstring(AValues:array of string;max:integer): string;
begin
result:=AValues[Random(max)];
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var str_temp:string;
begin
 if  memo4.Lines.Count>2 then
    begin
       str_temp:=memo4.Lines.DelimitedText;
       memo4.Clear;
       memo4.Lines.Add(str_temp) ;
       if SaveDialog1.Execute then
       memo4.Lines.SaveToFile(SaveDialog1.FileName);
       memo4.Clear;
   end;
 if no_y.Count>0  then
 begin
  no_y.Insert(0,Memo3.Text);
  no_y.SaveToFile(ExtractFilePath(Application.ExeName)+'sy.txt');
  no_y.Clear;
 end;

no_y.Free;
no_db.Free;
no_hd.Free;
no_tc.Free;
all_bd.Free;
end;

procedure TForm1.N2Click(Sender: TObject);
begin
no_y.Sort;
StatusBar1.Panels.Items[1].Text:='已排序，号码数量:'+inttostr(no_y.Count);
end;

procedure TForm1.N3Click(Sender: TObject);
var
    no_list_temp:TStringList;

begin

no_list_temp:=TStringList.Create;
no_list_temp.Sorted:=true;
no_list_temp.DelimitedText:=no_y.DelimitedText;
no_y.Clear;
no_y.DelimitedText:=no_list_temp.DelimitedText;
no_list_temp.Free;

StatusBar1.Panels.Items[1].Text:='已消除重号，号码数量：'+inttostr(no_y.Count);



end;

procedure TForm1.N4Click(Sender: TObject);
var i:integer;
   no:string;
begin
 i:=0;

 no_hd.Clear;
 memo1.Clear;
 memo2.Clear;
 no_y.Sort;
while i<no_y.Count do
begin
  no:= leftstr(no_y.Strings[i],7);

 if is_int(no) then
 begin
    if   no_hd.Count>0 then
    begin
     if (no_hd.Strings[no_hd.Count-1]<>no) then

     begin
      no_hd.Add(no);
      memo1.Lines.Add(no_y.Strings[i]);
     end


     end
   else
   begin  //增加第一个号码
     no_hd.Add(no);
     memo1.Lines.Add(no_y.Strings[i]);
     end;
  end ;

   Application.ProcessMessages;
   StatusBar1.Panels.Items[1].Text:='提取号段中:'+inttostr(i);
   inc(i) ;
end;
   StatusBar1.Panels.Items[1].Text:='提取到号段：'+inttostr(no_hd.Count);
  // memo2.Text:=no_hd.Text;
end;

procedure TForm1.Memo1Change(Sender: TObject);
begin
memo1.Hint:='行数：'+inttostr(memo1.Lines.Count);
end;

procedure TForm1.Memo2Change(Sender: TObject);
begin
memo2.Hint:='行数：'+inttostr(memo2.Lines.Count);
end;

procedure TForm1.N5Click(Sender: TObject);
var
  i,i2,ii:integer;
 begin

  i:=0;
  i2:=0;
  while i<no_hd.Count  do
  begin
    ii:=  no_db.IndexOf(trim(no_hd.Strings[i]));

    if ii>-1 then
      begin
        memo2.Lines.Add(no_hd.Strings[i]);
     end
     else
     begin
      memo1.Lines.Delete(i2);
      inc(i2,-1);
     end;
     inc(i);
     inc(i2);
     StatusBar1.Panels.Items[1].Text:='对比中:'+inttostr(i);
     Application.ProcessMessages;
    end;

   StatusBar1.Panels.Items[1].Text:='对比结束，其中需要屏蔽号段:'+inttostr(memo2.Lines.Count);
end;

procedure TForm1.N7Click(Sender: TObject);
var i,i1,i2:integer;
    limit_temp:string;
    no_list_temp:TStringList;
 begin

  if InputQuery('请输入导出数量', '导出的是最后X个号码     ',limit_temp) then
  begin
    if is_int(limit_temp)then
    begin
      no_list_temp:=TStringList.Create;
      i1:= no_y.Count-strtoint(limit_temp);
      if i1>0 then  i2:=strtoint(limit_temp) else   i2:=no_y.Count;
      for i:=0 to  i2-1 do
       begin
        no_list_temp.Add(no_y.Strings[no_y.Count-1]);
        no_y.Delete(no_y.Count-1);
        StatusBar1.Panels.Items[1].Text:='号码数量:'+inttostr(no_y.Count);
       end;
    if no_list_temp.Count>0 then
    begin
      if SaveDialog1.Execute then
     begin
     if  trim(Memo3.Text)<>'' then
      no_list_temp.Insert(0,Memo3.Text);
      no_list_temp.SaveToFile(SaveDialog1.FileName);
      StatusBar1.Panels.Items[2].Text:='导出:'+inttostr(no_list_temp.Count-1);
     end
     else
     begin
        for i:=0 to no_list_temp.Count-1 do
       begin
        no_y.Add(no_list_temp.Strings[0]);
        no_list_temp.Delete(0);
        StatusBar1.Panels.Items[1].Text:='号码数量:'+inttostr(no_y.Count);
        Application.ProcessMessages;
       end;

     end;
    end;
    no_list_temp.Clear;
    no_list_temp.Destroy;
    end