短信猫 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 :=0;
     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)>0 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),9600,Mobile_Type,CopyRightToCOM)<>0 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:=0 to ListBox1.Items.Count-1 do
  begin
    if Sms_Send(Trim(ListBox1.Items.Strings[i]),memo_sms_txt.Text)=1 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:=0;
  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 :=0;
     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(5000);
      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;