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.