📄 sm_sp_server.pas

📁 SPServer.rar一个基于TCP/IP监听发送代码
💻 PAS
📖 第 1 页 / 共 4 页
字号:
12 3 4 下一页
unit SM_SP_Server;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Sockets, ComCtrls, StdCtrls, ExtCtrls, Buttons, ImgList, ShellApi,
  ToolWin, Menus, TeEngine, Series, TeeProcs, Chart, Spin, Grids, Scope,
  Mask, DB, ADODB, DBGrids, DBCtrls, ScktComp, Gauges, DBTables, DateUtils;

const
 scWinClassName='SPServer';
 CM_RESTORE = WM_USER + $0001;
 MouseMsg=WM_USER+2;
 IID=100;

type
  TGrid_State = (stBrowse, stEdit, stInsert);
var
   sgr_State:TGrid_State;

//接收数据实例
type TRec_Thread = class(TThread)
  protected
    procedure Execute; override;
    procedure recbuf;
  public
    constructor Create(CreateSuspended: Boolean);
end;

//单条发送数据实例
type TSen_Thread = class(TThread)
 protected
   procedure Execute;override;
   procedure senbuf;
 public
    constructor Create(CreateSuspended: Boolean);
end;

//批量发送数据实例
type TBatch_Thread = class(TThread)
 protected
   procedure Execute;override;
   procedure Batch_Senbuf;
 public
   constructor Create(CreateSuspended: Boolean);
end;

//批量数据处理实例
type TBatch_Proc = class(TThread)
 protected
   procedure Execute;override;
   procedure BatchProc;
 public
   constructor Create(CreateSuspended: Boolean);
end;

//搜索数据发送实例
type TSearchSend = class(TThread)
  protected
    procedure Execute; override;
    procedure SearchSendData;
  public
    constructor Create(CreateSuspended: Boolean);
end;

type
 TSearchTranClient = class(TThread)
  protected
    procedure Execute; override;
    procedure SearchTranClient;
  public
    constructor Create(CreateSuspended: Boolean);
end;

type
  Tfrm_smServer = class(TForm)
    str: TStatusBar;
    Timer_Rec: TTimer;
    ImageList1: TImageList;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    CoolBar1: TCoolBar;
    TPage: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    GroupBox3: TGroupBox;
    Shape: TShape;
    Shape1: TShape;
    Label1: TLabel;
    Label9: TLabel;
    GroupBox2: TGroupBox;
    GroupBox4: TGroupBox;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    lRec: TLabel;
    lRight: TLabel;
    lFailRecord: TLabel;
    LabelReady: TLabel;
    lBuffer: TLabel;
    lRun: TLabel;
    Panel1: TPanel;
    Panel2: TPanel;
    Label2: TLabel;
    m_Rec_Win: TMemo;
    N2: TMenuItem;
    N4: TMenuItem;
    Timer_Send: TTimer;
    ToolBar2: TToolBar;
    ToolBar1: TToolBar;
    bStarServer: TSpeedButton;
    Bevel1: TBevel;
    bStopServer: TSpeedButton;
    ToolButton1: TToolButton;
    waitRun: TIndicator;
    sp_Prec: TSimplePie;
    PopupMenu1: TPopupMenu;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    mTransmit: TMemo;
    Label10: TLabel;
    GroupBox1: TGroupBox;
    Panel3: TPanel;
    Label14: TLabel;
    Label15: TLabel;
    b_SendSMS: TSpeedButton;
    b_sendBachSMS: TSpeedButton;
    stopsend: TSpeedButton;
    Panel4: TPanel;
    lDestNo: TLabel;
    Label12: TLabel;
    sgrList: TStringGrid;
    lSvcType: TLabeledEdit;
    sta_DestNo: TEdit;
    end_DestNo: TEdit;
    rgCell: TRadioGroup;
    m_Sen_Content: TMemo;
    ServerReceiveSend: TServerSocket;
    ibuffer: TIndicator;
    sgSvcType: TStringGrid;
    Label11: TLabel;
    N3: TMenuItem;
    N10: TMenuItem;
    Panel5: TPanel;
    Panel6: TPanel;
    Label13: TLabel;
    Label16: TLabel;
    lRegCount: TLabel;
    lCXCount: TLabel;
    Label17: TLabel;
    lCurRecord: TLabel;
    Timer3: TTimer;
    TabSheet3: TTabSheet;
    Panel7: TPanel;
    Panel8: TPanel;
    Label18: TLabel;
    Label19: TLabel;
    mRecData: TMemo;
    mRecCommand: TMemo;
    ListBox1: TListBox;
    TabSheet4: TTabSheet;
    Panel10: TPanel;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    Panel9: TPanel;
    sgr3: TStringGrid;
    Panel11: TPanel;
    sgr2: TStringGrid;
    Shape2: TShape;
    Label21: TLabel;
    Shape3: TShape;
    Label20: TLabel;
    BitBtn1: TBitBtn;
    N11: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    N14: TMenuItem;
    Image1: TImage;
    ImageList2: TImageList;
    Image2: TImage;
    PopupMenu2: TPopupMenu;
    N15: TMenuItem;
    N16: TMenuItem;
    N17: TMenuItem;
    N18: TMenuItem;
    tTimeCycle: TTimer;
    Image3: TImage;
    Image4: TImage;
    Image5: TImage;
    TimeICO: TTimer;
    N19: TMenuItem;
    N20: TMenuItem;
    N21: TMenuItem;
    N22: TMenuItem;
    ToolButton2: TToolButton;
    procedure strDrawPanel(StatusBar: TStatusBar;
      Panel: TStatusPanel; const Rect: TRect);
    procedure b_ReceiveClick(Sender: TObject);
    procedure Timer0_Rec(Sender: TObject);
    procedure bStopServerClick(Sender: TObject);
    procedure b_SendSMSClick(Sender: TObject);
    procedure sgrListSelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
    procedure sgrListSetEditText(Sender: TObject; ACol,
      ARow: Integer; const Value: String);
    procedure sgrListKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure sgrListGetEditText(Sender: TObject; ACol,
      ARow: Integer; var Value: String);
    procedure sgrListDrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure FormShow(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Time_Send(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure b_sendBachSMSClick(Sender: TObject);
    procedure stopsendClick(Sender: TObject);
    procedure ServerReceiveSendClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerReceiveSendClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerReceiveSendClientError(Sender: TObject;
      Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
      var ErrorCode: Integer);
    procedure N8Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure Timer0(Sender: TObject);
    procedure ServerReceiveSendClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure sgr3DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure BitBtn3Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure N15Click(Sender: TObject);
    procedure N16Click(Sender: TObject);
    procedure N17Click(Sender: TObject);
    procedure tTimeCycleTimer(Sender: TObject);
    procedure TimeICOTimer(Sender: TObject);
  protected
    procedure mousemessage(var message:TMessage);message mousemsg;
    procedure CreateParams(var Params: TCreateParams); override;
    Procedure RestoreRequest(var message: TMessage); message CM_RESTORE;
  private
    F_OldMobilePhone:string;
   procedure AddbatchList(sta_Num, end_Num:string);
   procedure LoadSvcTypeCode;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frm_smServer: Tfrm_smServer;
  NotifyIcon  : TNotifyIconData;

implementation

{$R *.dfm}

uses SP_DLLs,
     SP_SverSet,
     ServerDBT,
     ServerDB,
     SP_DLL,
     SearchEventsLog,
     DataBaseOperat;

// ===============================================
// Handle Create Message (Create Params Application)
// ===============================================
procedure Tfrm_smServer.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.WinClassName :=scWinClassName;
end;

// ===============================================
// Handle CM_RESTORE Message (Restore Application)
// ===============================================
procedure Tfrm_smServer.RestoreRequest(var message: TMessage);
begin
  OpenIcon(Application.Handle);
end;

procedure Tfrm_smServer.MouseMessage(var message:TMessage);
var
 Mousept:TPoint;
begin
inherited;
if message.LParam=wm_rbuttonup then begin
GetCursorPos(Mousept);
PopupMenu1.popup(mousept.x+10,mousept.y+10);
end;
if message.LParam=wm_lbuttonup then begin
ShowWindow(handle,sw_show);
ShowWindow(Application.Handle,SW_show);
SetWindowlong(Application.handle,gwl_exstyle,
not (GetWindowLong(Application.handle,gwl_exstyle)
or ws_ex_toolwindow and not ws_ex_appwindow));
end;
message.Result:=0;
end;

{当线程开始时，Execute方法将被调用。数据接收}
procedure TRec_Thread.Execute;
begin
  FreeOnTerminate := True;
  recbuf;
end;

{当线程开始时，Execute方法将被调用。发送数据}
procedure TSen_Thread.Execute;
begin
  FreeOnTerminate := True;
  senbuf;
end;

{当线程开始时，Execute方法将被调用。批量发送数据}
procedure TBatch_Thread.Execute;
begin
  FreeOnTerminate := True;
  Batch_SenBuf;
end;

{当线程开始时，Execute方法将被调用。数据批量处理}
procedure TBatch_Proc.Execute;
begin
  FreeOnTerminate := True;
  BatchProc;
end;

{当线程开始时，Execute方法将被调用。搜索数据}
procedure TSearchSend.Execute;
begin
  FreeOnTerminate := True;
  SearchSendData;
end;

 {当线程开始时，Execute方法将被调用。搜索数据}
procedure TSearchTranClient.Execute;
begin
  FreeOnTerminate := True;
  SearchTranClient;
end;

constructor TRec_Thread.Create(CreateSuspended: Boolean);
begin
  FreeOnTerminate := True;
  inherited Create(CreateSuspended);
end;

constructor TSen_Thread.Create(CreateSuspended: Boolean);
begin
 FreeOnTerminate := True;
 inherited Create(CreateSuspended);
end;

constructor TBatch_Thread.Create(CreateSuspended: Boolean);
begin
  FreeOnTerminate := True;
  inherited Create(CreateSuspended);
end;

constructor TBatch_Proc.Create(CreateSuspended: Boolean);
begin
  FreeOnTerminate := True;
  inherited Create(CreateSuspended);
end;

constructor TSearchSend.Create(CreateSuspended: Boolean);
begin
  FreeOnTerminate := True;
  inherited Create(CreateSuspended);
end;

constructor TSearchTranClient.Create(CreateSuspended: Boolean);
begin
  FreeOnTerminate := True;
  inherited Create(CreateSuspended);
end;

procedure Tfrm_smServer.LoadSvcTypeCode;
var
 sSvcType : TStringList;
 i:integer;
begin
{sSvcType := TStringList.Create;
try
 sSvcType.LoadFromFile(ExtractFilePath(Application.ExeName)+'SvcType.ini');
 SvcTypeCode.LoadFromFile(ExtractFilePath(Application.ExeName)+'SvcType.ini');
 except
on Exception do
 raise exception.Create('装载服务代码文件错误!');
end;
sgSvcType.RowCount := sSvcType.Count+1;
sgSvcType.Cells[0,0] := '服务代码';
sgSvcType.Cells[1,0] := '代码说明';
for i:=0 to sSvcType.Count-1 do
 begin
  sgSvcType.Cells[0,i+1] := Copy(sSvcType.Strings[i],1,Pos(':',sSvcType.Strings[i]));
  sgSvcType.Cells[1,i+1] := Copy(sSvcType.Strings[i],Pos(':',sSvcType.Strings[i])+1,
                            Length(sSvcType.Strings[i]));
 end;}
end;


procedure Tfrm_smServer.AddbatchList(sta_Num, end_Num:string);    //数据群发
var
 b,i:integer;
 cn:LongWord;
 sbatchList:TStringList;
 sDestNo, sSvcType, sChargeNo, sContent:string;
 staNo,endNo:Int64;
begin
 b_sendBachSMS.Enabled:=False;
 i:=0;cn:=0;
 staNo:=StrToInt64(sta_Num);
 endNo:=StrToInt64(end_Num);
 sbatchList:=TStringList.Create;
 if rgCell.ItemIndex=1 then sChargeNo := '#0'; //#0被叫号码付费
 if rgCell.ItemIndex=1 then sChargeNo := '0';  //'0'SP付费
  sSvcType  := lSvcType.Text;             //服务类型
  sContent  := m_Sen_Content.Text;        //信息内容
   if SearchSvcType(sSvcType,1)<>1
   then begin
    lSvcType.SetFocus;
    ErrorMsg(1,'错误的服务类型!');
    Exit;
   end;
  cn:=endNo-staNo;
while i<cn+1 do
 begin
  b:=0;
  sDestNo:='';
12 3 4 下一页
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -