短信猫 TIdTCPServer TIdTCPClient

短信猫 服务端：

IdTCPServer1: TIdTCPServer;
IdAntiFreeze1: TIdAntiFreeze;

unit UnitSever;

interface

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, IdBaseComponent, IdComponent, IdTCPServer, IdAntiFreezeBase,

  IdAntiFreeze, StdCtrls, ExtCtrls, Sockets, IdUDPBase, IdUDPServer,UGBBig5Convert,Comobj, WordXP,

  DB, DBTables, Buttons,OleServer,ExcelXP,ADODB, IdCustomTCPServer;

type

  TRevData=record

    Data:string;

    Flag:Boolean;

  end;

  TDataThread=class(TThread)

     private

       { Private declarations }

     protected

       procedure Execute; override;

     public

       constructor Create(data:string);

  end;

  TSeverFrm = class(TForm)

    IdTCPServer1: TIdTCPServer;

    IdAntiFreeze1: TIdAntiFreeze;

    ButtonStart: TButton;

    ButtonClose: TButton;

    Memo1: TMemo;

    Panel1: TPanel;

    GroupBox2: TGroupBox;

    Label1: TLabel;

    Edit_COM: TEdit;

    Label2: TLabel;

    Edit_Tel: TEdit;

    Label3: TLabel;

    Button_Send: TButton;

    Button1: TButton;

    label_conn: TLabel;

    memo_sms_txt: TMemo;

    label_sms_stact: TLabel;

    ListBox1: TListBox;

    Button2: TButton;

    procedure ButtonStartClick(Sender: TObject);

    procedure ButtonCloseClick(Sender: TObject);

    procedure IdTCPServer1Connect(AThread: TIdPeerThread);

    procedure IdTCPServer1Execute(AThread: TIdPeerThread);

    procedure IdTCPServer1Disconnect(AThread: TIdPeerThread);

    procedure Button1Click(Sender: TObject);

    procedure Button_SendClick(Sender: TObject);

    procedure Button2Click(Sender: TObject);

    //procedure Button2Click(Sender: TObject);

//    procedure SpeedButton1Click(Sender: TObject);

//    procedure ListBox1Click(Sender: TObject);

//    procedure ListBox2Click(Sender: TObject);

  private

    { Private declarations }

    procedure WhileGetMSGdo;

    function ServerReadBuffer(AThread: TIdPeerThread):string;

    procedure ServerWtiteBuffer(AThread: TIdPeerThread;strMSG:string);

  public

    { Public declarations }

    sRevData:string;

  end;

  function Sms_Connection(CopyRight:pchar;Com_Port,Com_BaudRate:integer;var Mobile_Type,CopyRightToCOM:PChar):integer;stdcall;external 'sms.dll';

  function Sms_Send(Sms_TelNum:string;Sms_Text:string):integer;stdcall;external 'sms.dll';

  Function Sms_Receive(Sms_Type:string;var Sms_Text:PChar):integer;stdcall;external 'sms.dll';

  function Sms_Delete(Sms_Index:string):integer;stdcall;external 'sms.dll';

  function Sms_AutoFlag :integer;stdcall;external 'sms.dll';

  function Sms_NewFlag :integer;stdcall;external 'sms.dll';

  function Sms_Disconnection :integer;stdcall;external 'sms.dll';

var

  SeverFrm: TSeverFrm;

implementation

{$R *.dfm}

function AppPath: string;

begin

  Result := ExtractFilePath(Application.ExeName);

end;

procedure WriteLog(s,Path:string);

var

  TXT: TextFile;

begin

  //  FileStr := 'ERROR: '+FormatDateTime('YYYY-MM-DD HH:MM:SS',Now)+' | '+s;

  try

    AssignFile(TXT,Path + 'log.txt');

    if FileExists(Path + 'log.txt') then

       Append(TXT)

    else

       Rewrite(TXT);

    Writeln(TXT,s);

    Flush(TXT);

  finally

    CloseFile(TXT);

  end;

end;

procedure TDataThread.Execute();

begin

  repeat

  until terminated ;

end;

constructor TDataThread.Create(data:string);

begin

end;

function TSeverFrm.ServerReadBuffer(AThread: TIdPeerThread):string;

var

  ts:TStrings;

  stream:TStream;

begin

    try

     stream := TStringStream.Create('');   //ノㄤ摸Stream钡Μぃ摸计沮

     AThread.Connection.ReadStream(stream);

     stream.Position :=;

     ts.LoadFromStream(stream);

     Result := ts.Text;

    finally

      stream.Free;

    end;

end;

procedure TSeverFrm.ServerWtiteBuffer(AThread: TIdPeerThread;strMSG:string);

var

  ts:TStrings;

  stream:TStream;

begin

  try

   stream := TStringStream.Create(strMSG);

   AThread.Connection.WriteStream(stream);

  finally

    stream.Free;

  end;

end;

procedure TSeverFrm.ButtonStartClick(Sender: TObject);

begin

  IdTCPServer1.Active := True;

  ButtonStart.Enabled := False;

  ButtonClose.Enabled := True;

  Memo1.Lines.Add('MSG: Successful Server Startup...');

end;

procedure TSeverFrm.ButtonCloseClick(Sender: TObject);

begin

IdTCPServer1.Active := False;

ButtonStart.Enabled := True;

ButtonClose.Enabled := False;

Memo1.Lines.Add('MSG: Server is Down...');

end;

procedure TSeverFrm.IdTCPServer1Connect(AThread: TIdPeerThread);

begin

  try

    Memo1.Lines.Add('MSG: Host'+AThread.Connection.Socket.Binding.PeerIP+'Connect Server OK');

    AThread.Connection.WriteLn('Connect To Server Success...');      //临琌BufferH摆fuck

    //ServerWtiteBuffer(AThread,'硈钡Θ');

  finally

  end;

end;

procedure TSeverFrm.IdTCPServer1Execute(AThread: TIdPeerThread);

begin

  if AThread=nil then Exit;

  if not AThread.Connection.Connected then Exit;

  if AThread.Terminated then Exit;

  try

    sRevData := AThread.Connection.ReadLn();

    if Pos('SENDMSG',sRevData)> then

    begin

      memo1.Lines.Add(sRevData) ;

       memo_sms_txt.Text:=sRevData;

       AThread.Synchronize(WhileGetMSGdo);

       AThread.Connection.WriteLn('Send Success');

    end;

  except

    WriteLog('ERROR: '+DateTimeToStr(Now)+' | '+AThread.Connection.Socket.Binding.PeerIP+' Receive Data Eexception',AppPath);

  end;

end;

procedure TSeverFrm.WhileGetMSGdo;    //め狠祇癳㏑ㄓ才兵ン秈︽矪瞶

begin

   sRevData:=memo_sms_txt.Text;

   Button_Send.Click;

    {if Sms_Send(Trim(Edit_Tel.Text),memo_sms_txt.Text)=1 then

       label_sms_stact.Caption := 'Send Success+'

    else

       label_sms_stact.Caption := 'Send Failed'; }

end;

procedure TSeverFrm.IdTCPServer1Disconnect(AThread: TIdPeerThread);

begin

   AThread.Connection.WriteLn('Server Is Down...');

end;

procedure TSeverFrm.Button1Click(Sender: TObject);

var

Mobile_Type:pchar;

CopyRight:pchar;

CopyRightToCOM:pchar;

begin

CopyRight:=PChar('//上海迅赛信息技术有限公司,网址www.xunsai.com//');         //硂琿絏璶叫ぃ璶э

if Sms_Connection(CopyRight,StrToInt(Edit_COM.text),,Mobile_Type,CopyRightToCOM)<> then

   begin

     Label_conn.Caption:='OK:'+Mobile_Type+'!';

   end

 else

   Label_conn.Caption:='NOT OK!'

end;

procedure TSeverFrm.Button_SendClick(Sender: TObject);

var

  i:Integer;

begin

 {if Sms_Send(Trim(Edit_Tel.Text),memo_sms_txt.Text)=1 then

    label_sms_stact.Caption := 'Send Success+'

 else

    label_sms_stact.Caption := 'Send Failed';  }

  for i:= to ListBox1.Items.Count- do

  begin

    if Sms_Send(Trim(ListBox1.Items.Strings[i]),memo_sms_txt.Text)= then

    label_sms_stact.Caption := 'Send Success+'

    else

    label_sms_stact.Caption := 'Send Failed';

  end;

end;

//------------------------------------------------------------------------------

procedure TSeverFrm.Button2Click(Sender: TObject);

Var

  Filename:String;

  MyFile:Textfile;

  i:Integer;

  S:string;

begin

  Filename:='D:/a.txt';

  AssignFile(Myfile,filename);

  try

    reset(Myfile);

  Except

    rewrite(Myfile);

  end;

  i:=;

  while not seekEof(Myfile) do

  begin

    readln(Myfile,s);

    ListBox1.Items.Add(S);

    inc(i);

  end;

  CloseFile(Myfile);

end;

end.

服务端

客户端

IdTCPClient1: TIdTCPClient;
IdAntiFreeze1: TIdAntiFreeze;

IdIPWatch1: TIdIPWatch;

unit UnitClient;

interface

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, IdAntiFreezeBase, IdAntiFreeze, IdBaseComponent, IdComponent,

  IdTCPConnection, IdTCPClient, StdCtrls, ExtCtrls, IdIPWatch;

type

  TRevData=record

    Data:string;

    Flag:Boolean;

  end;

  TClientFrm = class(TForm)

    IdTCPClient1: TIdTCPClient;

    IdAntiFreeze1: TIdAntiFreeze;

    Panel1: TPanel;

    Edit_Host: TEdit;

    Label1: TLabel;

    Label2: TLabel;

    Edit_Port: TEdit;

    Button_Connet: TButton;

    Button_Close: TButton;

    Memo1: TMemo;

    Button_Send: TButton;

    MemoSend: TMemo;

    Label3: TLabel;

    IdIPWatch1: TIdIPWatch;

    procedure Button_ConnetClick(Sender: TObject);

    procedure Button_SendClick(Sender: TObject);

    procedure Button_CloseClick(Sender: TObject);

  private

    { Private declarations }

    SendData:string;//沮惠璶э跑祇癳摸ノ挡篶砰舱摸獺

    function ClientReadBuffer(IDTCP: TIdTCPClient):string;

    procedure ClientWtiteBuffer(IDTCP: TIdTCPClient;strMSG:string);

  public

    { Public declarations }

  end;

var

  ClientFrm: TClientFrm;

implementation

{$R *.dfm}

function TClientFrm.ClientReadBuffer(IDTCP: TIdTCPClient):string;

var

  ts:TStrings;

  stream:TStream;

begin

    try

     stream := TStringStream.Create('');   //ノㄤ摸Stream钡Μぃ摸计沮

     IDTCP.ReadStream(stream);

     stream.Position :=;

     ts.LoadFromStream(stream);

     Result := ts.Text;

    finally

      stream.Free;

    end;

end;

procedure TClientFrm.ClientWtiteBuffer(IDTCP: TIdTCPClient;strMSG:string);

var

  ts:TStrings;

  stream:TStream;

begin

  try

   stream := TStringStream.Create(strMSG);

   IDTCP.WriteStream(stream);

  finally

    stream.Free;

  end;

end;

procedure TClientFrm.Button_ConnetClick(Sender: TObject);

var

  stream:TStringStream;

begin

    IdTCPClient1.Host := Trim(Edit_Host.Text);

    IdTCPClient1.Port := StrToInt(Edit_Port.Text);

    Memo1.Lines.Add('タ硈钡狝叭竟' + Edit_Host.Text + '...');

    with IdTCPClient1 do

    begin

    try

    Connect();

      try

        Memo1.Lines.Add(ReadLn());

        //Memo1.Lines.Add(ClientReadBuffer(IdTCPClient1)+'++');

        //Memo1.Lines.LoadFromStream(stream);

        Button_Connet.Enabled := False;

        Button_Close.Enabled := True;

      except

        Memo1.Lines.Add('狝叭竟礚臫莱...');

        IdTCPClient1.Disconnect();

      end;

    except

      Memo1.Lines.Add('礚猭ミ' + Edit_Host.Text + '硈钡...');

    end;

    end;

    Button_Send.Enabled := True;

end;

procedure TClientFrm.Button_SendClick(Sender: TObject);

begin

  try

     SendData := MemoSend.Text;

     IdTCPClient1.WriteLn(SendData+'--Come From'+IdIPWatch1.LocalIP);

     Memo1.Lines.Add(IdTCPClient1.ReadLn());

  except

    IdTCPClient1.Disconnect();

    Button_Connet.Enabled := True;

  end;

end;

procedure TClientFrm.Button_CloseClick(Sender: TObject);

var

  strip:string;

begin

  try

    strip := IdIPWatch1.LocalIP; //IdTCPClient1.Socket.LocalName;;

    IdTCPClient1.WriteLn('SENDMSG诀'+strip+' 笆耞秨硈钡');

    //Memo1.Lines.Add(IdTCPClient1.ReadLn()) ;

    IdTCPClient1.Disconnect;

    Memo1.Lines.Add('狝叭竟硈钡耞秨');

    Button_Connet.Enabled := True;

    //Button_Send.Enabled := False;

  except

  end;

end;

end.

客户端

读取txt

procedure TSeverFrm.Button2Click(Sender: TObject);

Var

  Filename:String;

  MyFile:Textfile;

  i:Integer;

  S:string;

begin

  Filename:='D:/a.txt';

  AssignFile(Myfile,filename);

  try

    reset(Myfile);

  Except

    rewrite(Myfile);

  end;

  i:=0;

  while not seekEof(Myfile) do

  begin

    readln(Myfile,s);

    ListBox1.Items.Add(S);

    inc(i);

  end;

  CloseFile(Myfile);

end;