unit1.~pas

可以自定义生成短信发送记录的小程序.能够设置某些号段,发送成功率和发送时间.(注,不是群发短信,是生成一个假的群发记录.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Menus, ComCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Edit1: TEdit;
    Memo2: TMemo;
    Button1: TButton;
    PopupMenu1: TPopupMenu;
    load1: TMenuItem;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Edit2: TEdit;
    Edit3: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Edit4: TEdit;
    Edit5: TEdit;
    Label5: TLabel;
    Button3: TButton;
    Edit6: TEdit;
    Label6: TLabel;
    CheckBox1: TCheckBox;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    Label7: TLabel;
    Label8: TLabel;
    DateTimePicker1: TDateTimePicker;
    DateTimePicker2: TDateTimePicker;
    CheckBox2: TCheckBox;
    procedure load1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Memo1Change(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.load1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
    Memo1.Lines.LoadFromFile(OpenDialog1.FileName ); 
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i,j,k,l,m,n,o,p:integer;
  Tdate:Tdatetime;
  datetime,str,datetemp:string;
  filestr:TStringList;
begin
  datetemp:=formatdatetime('yyyy-MM-dd',DateTimePicker1.Date)+' '+formatdatetime('hh:mm:ss',DateTimePicker2.time);
  Tdate:=strtodatetime(datetemp); 
  m:=strtoint(trim(edit3.Text));
  //Tdate:=Tdate+0.00001;
  n:=0;
  o:=0;
  p:=0;
  str:=trim(memo2.Text);
  str:=StringReplace(str,#13,'',[rfReplaceAll]);
  str:=StringReplace(str,#10,'',[rfReplaceAll]);
  if SaveDialog1.Execute then begin
  j:=strtoint(edit1.Text);
  filestr:=TStringList.Create;
  for i:=0 to Memo1.Lines.Count -1 do begin
    if trim(memo1.Lines[i])<>'' then begin
      Randomize;
      k:=Random(strtoint(edit2.Text));
      datetime:=formatdatetime('yyyy-mm-dd hh:mm:ss',Tdate);
      if k<=0 then begin
        filestr.Add('失败  '+datetime+'  '+memo1.Lines[i]+'  '+str);
        l:=l+1;
      end else
        filestr.Add('成功  '+datetime+'  '+memo1.Lines[i]+'  '+str);
      //j:=j+1;
      n:=n+1;
      if n>=m then begin
         n:=0;
         p:=p+1;
         Tdate:=Tdate+1 / (24*3600);
      end;
      o:=o+1; 
    end;  
  end;
  if checkbox1.Checked then begin
     filestr.Add('共发送:'+inttostr(o)+'条   错误'+inttostr(l)+'条  耗时'+inttostr(p)+'秒');
  end;
  filestr.SaveToFile(SaveDialog1.FileName);
  filestr.Free;
  showmessage('保存完毕.共'+inttostr(o)+'条 错误'+inttostr(l)+'条');
  end;
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  i,j,k:integer;
  tel:string;
begin
  i:=strtoint(trim(edit4.Text));
  j:=strtoint(trim(edit5.Text));
  for k:=i to j do begin
    tel:='000'+inttostr(k);
    tel:=copy(tel,length(tel)-3,4);
    memo1.Lines.Add(trim(edit6.Text)+tel);
  end;
end;

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

procedure TForm1.N1Click(Sender: TObject);
begin
  memo1.Lines.Clear;
end;

procedure TForm1.N2Click(Sender: TObject);
begin
  if SaveDialog1.Execute then
    memo1.Lines.SaveToFile(SaveDialog1.FileName);
end;

end.