Delphi控件源码

开发平台：
Delphi

Unit1.~pas：源码内容
							unit Unit1;
//**********************************************************
//深圳市东方数码技术有限公司
//曾伟才
//2004年11月9日
//**********************************************************
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OleCtrls, EdSockServerApi, StdCtrls, Types, SysConst, VarUtils,
  ExtCtrls;
type
    TForm1 = class(TForm)
    edtPeerIP: TEdit;
    edtPeerPort: TEdit;
    btnConnect: TButton;
    lblStatus: TLabel;
    btnCloseConnect: TButton;
    Lable3: TLabel;
    lblMAC: TLabel;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    GroupBox2: TGroupBox;
    Label3: TLabel;
    edtLocalPort: TEdit;
    btnListen: TButton;
    Label4: TLabel;
    memSend: TMemo;
    Label5: TLabel;
    memRecv: TMemo;
    btnSend: TButton;
    btnClear: TButton;
    Label6: TLabel;
    lblConnectID: TLabel;
    btnTest: TButton;
    Timer1: TTimer;
    procedure btnConnectClick(Sender: TObject);
    procedure btnCloseConnectClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btnListenClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnSendClick(Sender: TObject);
    procedure btnClearClick(Sender: TObject);
    procedure btnTestClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  Form1: TForm1;
implementation
{$R *.dfm}
var g_ConnectID : Integer =0;
var times :Integer =0;
procedure TForm1.btnConnectClick(Sender: TObject);
var
  len : Integer;
  var ip: string;
  port: Integer;
begin
    StopListen();
    len := edtPeerIP.GetTextLen();
    if len=0 then Exit;
    if edtPeerPort.GetTextLen()=0 then Exit;
    ip := edtPeerIP.Text;
    if not TryStrToInt(edtPeerPort.Text ,port) then Exit;
    OpenConnect(PAnsiChar(ip), port, nil , 0);
end;
procedure EdSockAccept(ConnectID: Longint); stdcall
var
  mac: array[0..6] of Byte;
  strmac: array[0..30] of Byte;
  len : Integer;
begin
    if (g_ConnectID<>0) then CloseConnect(g_ConnectID);
    g_ConnectID :=ConnectID;
    Form1.lblStatus.Caption :='已连接';
    GetMAC(g_ConnectID, PByte(@mac[0]), 6);
    len := mac_ntoa(PByte(@mac[0]),6,PByte(@strmac[0]),30);
    strmac[len] := 0;
    Form1.lblMAC.Caption := PChar(PByte(@strmac[0]));
    Form1.lblConnectID.Caption := IntToStr(g_ConnectID);
end;
procedure EdSockConnectClose(ConnectID: Longint); stdcall;
begin
    try
    g_ConnectID := 0 ;
    Form1.lblStatus.Caption :='未连接';
    Form1.lblMAC.Caption :='';
    Form1.lblConnectID.Caption := '';
    finally
    end;
end;
procedure EdSockReceFromCOM(ConnectID: Longint;
  COMNum: Longint; pDataBuf: PByte; DataLength: Longint); stdcall
var
    recvdata :array of byte ;
    str : String;
    i : Integer;
begin
    if (ConnectID<>g_ConnectID) then Exit;
    setlength(recvdata,DataLength+1);
    for i := 0 to DataLength-1 do
    begin
      recvdata[i] := pDataBuf^;
      pDataBuf := PByte(PChar(pDataBuf) + 1);
    end;
//    move(pDataBuf,recvdata,DataLength);
    str := String(recvdata);
    if length(Form1.memRecv.Lines.Text)>1000 then
        Form1.memRecv.Lines.Text :=''
    else
        Form1.memRecv.Lines.Text := Form1.memRecv.Lines.Text+str;
end;
//procedure OnError(SocketID: Longint; ErrorCode: Longint); stdcall;
//procedure OnReceConfigData(ConnectID: Longint; pDataBuf: PByte; DataLength: Longint); stdcall;
//procedure OnSwitchChange(ConnectID: Longint; PortNum: Longint; Value: Longint); stdcall;
procedure TForm1.btnCloseConnectClick(Sender: TObject);
begin
    if (g_ConnectID <> 0) then
    begin
        CloseConnect(g_ConnectID);
        g_ConnectID :=0;
        lblStatus.Caption :='未连接';
        lblMAC.Caption :='';
        lblConnectID.Caption := '';
    end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    if (g_ConnectID<>0) then CloseConnect(g_ConnectID);
end;
procedure TForm1.btnListenClick(Sender: TObject);
var
  LocalPort: Integer;
  LocalIP: PAnsiChar;
begin
    if (g_ConnectID<>0) then CloseConnect(g_ConnectID);
    LocalIP := '0.0.0.0';
    LocalPort := StrToInt(edtLocalPort.Text);
    StartListen(LocalIP, LocalPort);
end;
procedure TForm1.FormCreate(Sender: TObject);
var
  OnAccept : TOnAccept;
  OnConnectClose : TOnConnectClose;
  OnReceFromCOM : TOnReceFromCOM;
begin
    memSend.Text := '';
    memRecv.Text := '';
    OnAccept := TOnAccept(@EdSockAccept);
    OnConnectClose := TOnConnectClose(@EdSockConnectClose);
    OnReceFromCOM := TOnReceFromCOM(@EdSockReceFromCOM);
    SetCallback(OnAccept,OnConnectClose,nil,nil,OnReceFromCOM,nil);
end;
procedure TForm1.btnSendClick(Sender: TObject);
var
    DataSend : array of byte ;
    len : Longint;
    com : Integer;
    p : PChar;
begin
    if g_ConnectID = 0 then Exit;
    len := StrLen(memSend.Lines.GetText());
    setlength(DataSend,len);
    p := memSend.Lines.GetText();
    move(p[0],DataSend[0],len);
    com := GetCOM(g_ConnectID);
    SendToCOM(g_ConnectID,com,@DataSend[0],len);
end;
procedure TForm1.btnClearClick(Sender: TObject);
begin
    memRecv.Text := '';
end;
procedure TForm1.btnTestClick(Sender: TObject);
begin
  timer1.Enabled :=true;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
    strmsg :string;
begin
    times := times+1;
    if (times > 5000) then
    begin
        timer1.Enabled :=false;
        times :=0;
        strmsg := '完成';
        MessageDlg(strmsg,mtInformation,[mbOK],0);
        EXIT;
    end;
    if (g_ConnectID = 0) then
    begin
        timer1.Enabled :=false;
        strmsg :=IntToStr(times);
        MessageDlg(strmsg,mtInformation,[mbOK],0);
        times :=0;
        exit;
    end;
    btnSendClick(btnTest);
end;
end.

						