main.~pas

精彩编程百例75～100 其中有媒体播放器 SQL语言编辑器 ADO方法连接多个数据库 用户密码验证系统 获取Man地址 信史服务 ping命令等待

unit main;

interface

uses Unit2,
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, ExtCtrls;

type
  TfrmMain = class(TForm)
    MesText: TMemo;
    btnExit: TBitBtn;
    btnSend: TBitBtn;
    Label1: TLabel;
    Bevel1: TBevel;
    Bevel2: TBevel;
    Bevel3: TBevel;
    Bevel4: TBevel;
    AddrBox: TComboBox;
    StatusLabel: TLabel;
    Bevel6: TBevel;
    procedure btnSendClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure MesTextChange(Sender: TObject);
    procedure AddrBoxChange(Sender: TObject);
    procedure btnExitClick(Sender: TObject);
  private
    UserName : string;
    MessageHeader : TStringList;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

uses about;

{$R *.DFM}


procedure TfrmMain.btnSendClick(Sender: TObject);
var
  i, res: Integer;
begin
  if AddrBox.Text <> '' then
  begin
    StatusLabel.Font.Color := clBlack;
    StatusLabel.Caption := '处理中......';
    Update;
    if AddrBox.Items.IndexOf(AddrBox.Text) = -1 then
      AddrBox.Items.Add(AddrBox.Text);
    res := SendMsg(AddrBox.Text,'',MessageHeader.Text+mesText.Text);
    if res = 0 then
      frmMain.StatusLabel.Font.Color := clBlue
    else
      frmMain.StatusLabel.Font.Color := clRed;
    case res of
      0    : frmMain.StatusLabel.Caption := '消息已成功送出';
      87   : frmMain.StatusLabel.Caption := '指定参数错误';
      2273 : frmMain.StatusLabel.Caption := '不能找到该IP '+frmMain.AddrBox.Text;
    else     frmMain.StatusLabel.Caption := '错误 '+IntToStr(res);
    end;
  end;
end;


procedure TfrmMain.FormCreate(Sender: TObject);
var
  strUser : PChar;
  strSize : DWord;
begin
  MesText.Lines.Clear;
  strUser := StrAlloc(100);
  strSize := 100;
  GetUserName(strUser,strSize);
  UserName := strUser;
  StrDispose(strUser);
  MessageHeader := TStringList.Create;
  MessageHeader.Add('×××××××××××××××××');
  MessageHeader.Add('    from '+ username);
  MessageHeader.Add('×××××××××××××××××');
end;


procedure TfrmMain.MesTextChange(Sender: TObject);
begin
  StatusLabel.Caption := ' ';
end;

procedure TfrmMain.AddrBoxChange(Sender: TObject);
begin
  StatusLabel.Caption := ' ';
end;

procedure TfrmMain.btnExitClick(Sender: TObject);
begin
   close;
end;

end.