?? unit1.pas
字號:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls, ComCtrls;
type
TForm1 = class(TForm)
Label1: TLabel;
IP: TComboBox;
Label2: TLabel;
Msg: TMemo;
Label3: TLabel;
AddMsg: TLabeledEdit;
ManMsg: TListBox;
BitBtn1: TBitBtn;
MSend: TBitBtn;
TS: TLabeledEdit;
FromName: TLabeledEdit;
GroupBox1: TGroupBox;
Ran: TCheckBox;
UpDown1: TUpDown;
Edit1: TEdit;
Label4: TLabel;
MCancel: TBitBtn;
ShowCS: TLabel;
procedure FormCreate(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure MSendClick(Sender: TObject);
procedure ManMsgClick(Sender: TObject);
procedure MCancelClick(Sender: TObject);
procedure AddMsgChange(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses Unit2,Unit3;
var
Cancel:boolean; //標志是否按了取消
CSNum:integer; //發送的消息條數
//循環發送
procedure RandomSend();
begin
with Form1 do
begin
if Ran.Checked then
begin
Randomize();
ManMsg.ItemIndex:=Random(ManMsg.Count);
ManMsg.OnClick(Form1);
Application.ProcessMessages;
end;
end;
end;
//加載消息內容
procedure LoadMsgFile();
var
TempNum:integer;
begin
For TempNum:=0 to 28 do
begin
with Form1 do
begin
ManMsg.Items.Add(MsgText[TempNum]);
end;
end;
end;
//顯示提示信息
procedure ShowMsg(gres:integer);
begin
with Form1 do
begin
MSend.Enabled:=True;
MCancel.Enabled:=False;
ShowCS.Caption:='';
if gres=0 then
TS.text:=inttostr(CSNum)+'條消息成功發送至對方!'
else if gres=87 then
TS.Text:='參數錯誤,發送失敗!'
else if gres=2273 then
TS.Text:='無法連接對方,可能對方不在線!'
else
TS.text :='消息發送失敗,未知錯誤!';
Beep();
end;
end;
//格式化發送內容
Function FormatText(Temp:string):string;
var
TextLen:integer;
TempNum,TempLine:integer;
TempStr,TempHead,TempGet:string;
begin
TextLen:=50;
TempLine:=(length(Temp) div TextLen)+1;
For TempNum:=1 to TempLine do
begin
if (TempStr='') then
begin
// TempGet:=copy(Temp,1,TextLen);
//判斷取得的字符是否是半個(如半個漢字)
// if Windows.IsDBCSLeadByte(byte(TempGet[TextLen+1])) then
//如果是半個字符,則少取一個字符
// TempStr:=copy(Temp,1,TextLen-1)+#13+#10+#13+#10
// else
TempStr:=copy(Temp,1,TextLen)+#13+#10+#13+#10;
end
else
begin
// TempGet:=copy(Temp,1,TextLen);
//判斷取得的字符是否是半個(如半個漢字)
// if Windows.IsDBCSLeadByte(byte(TempGet[TextLen+1])) then
//如果是半個字符,則少取一個字符
// TempStr:=TempStr+copy(Temp,(TextLen*(TempNum-1))+1,TextLen-1)+#13+#10+#13+#10
// else
TempStr:=TempStr+copy(Temp,(TextLen*(TempNum-1))+1,TextLen)+#13+#10+#13+#10;
end;
end;
TempHead:='---------------------------------------------------------------------------'+#13+#10+
'以下是發給你的消息,如沒看三遍,是要打屁屁的哦!'+#13+#10+
'---------------------------------------------------------------------------'+#13+#10+#13+#10;
TempStr:=TempHead+TempStr;
Result:=TempStr;
end;
//發送消息
procedure USendMsg();
var
res:integer;
begin
with Form1 do
begin
MSend.Enabled:=False;
MCancel.Enabled:=True;
TS.text :='正在發送消息給對方,請稍候......';
Application.ProcessMessages;
if Trim(FromName.Text)='' then
FromName.Text:='火星';
if Trim(Msg.Text)='' then
Msg.Text:='你好嗎?我好想你。';
if (IP.Items.IndexOf(IP.Text)=-1) and (length(trim(IP.Text))<>0) then
IP.Items.Add(IP.Text);
res:=SendMsg(IP.Text,Trim(FromName.Text+'發送'),FormatText(Msg.Text));
Application.ProcessMessages;
ShowMsg(res);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
struser:pchar;
begin
IP.Text:='';
Msg.Clear;
ShowCS.Caption:='';
TS.text :='準備就緒,等待操作......';
struser:=stralloc(100);
strdispose(struser);
LoadMsgText();
LoadMsgFile();
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
if (Trim(AddMsg.Text)<>'') then
ManMsg.Items.Add(trim(AddMsg.Text));
end;
procedure TForm1.MSendClick(Sender: TObject);
begin
Cancel:=False;
For CSNum:=1 to strtoint(Edit1.text) do
begin
if not Cancel then //沒有按取消,則發送
begin
ShowCS.Caption:=inttostr(CSNum);
RandomSend(); //循環發送過程
USendMsg(); //發送過程
Application.ProcessMessages;
end;
end;
end;
procedure TForm1.ManMsgClick(Sender: TObject);
begin
Msg.Lines.Clear;
Msg.Lines.Add(ManMsg.Items.Strings[ManMsg.ItemIndex]);
end;
procedure TForm1.MCancelClick(Sender: TObject);
begin
Cancel:=True;
end;
procedure TForm1.AddMsgChange(Sender: TObject);
begin
if (Length(Trim(AddMsg.Text))<>0) then
BitBtn1.Enabled:=True
else
BitBtn1.Enabled:=False;
end;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -