sm_sp_server.pas

SPServer.rar一个基于TCP/IP监听发送代码

  while (i<cn+1)and(b<SND_UPT) do
   begin
    sDestNo:=sDestNo+ IntToStr(staNo+i)+',';
    Inc(i);
    Inc(b);
   end;
    if Copy(sDestNo,Length(sDestNo),1)=',' then
    sDestNo:=Copy(sDestNo,1,Length(sDestNo)-1);
    PostMess(2,0,sDestNo,sChargeNo,sSvcType,Now,sContent,SPNumber);
 end;
 sbatchList.Free;
end;


procedure Tfrm_smServer.strDrawPanel(StatusBar: TStatusBar;
  Panel: TStatusPanel; const Rect: TRect);
begin
pRect:=Rect;
 with str.Canvas do
   begin
     case RI of
       0:begin
          TextOut(pRect.Left+24,6,'网络已断开...');
          ImageList1.Draw(str.Canvas,pRect.Left+2,pRect.Top+2,0);
         end;
    1..3:begin
          TextOut(pRect.Left+24,6,'正在连机工作...');
          ImageList1.Draw(str.Canvas,pRect.Left+2,pRect.Top+2,1);
         end; 
      end;
  end;
end;

procedure Tfrm_smServer.b_ReceiveClick(Sender: TObject);
begin
 RI:=1;
 str_Out('正在连接网络...',1);
 Timer_Send.Enabled:=True;
 Timer_Rec.Enabled:=True;
 tTimeCycle.Enabled:=True;
end;

procedure Tfrm_smServer.Timer0_Rec(Sender: TObject);
begin
try
 //创建TRec_Thread实例，并执行线程  接收数据
  TRec_Thread.Create(False);
 except
  on exception do
   raise EAbort.Create('''');
  end;
end;

procedure Tfrm_smServer.bStopServerClick(Sender: TObject);
begin
 RI:=0;
 str_Out('网络已断开...',1);
 Timer_Send.Enabled:=False;
 Timer_Rec.Enabled:=False;
 tTimeCycle.Enabled:=False;
end;

procedure Tfrm_smServer.b_SendSMSClick(Sender: TObject);
var
 I:Integer;
 sDestNo, sSvcType, sChargeNo, sContent:string;
 b:boolean;
begin
TPage.TabIndex:=1;
if Length(m_Sen_Content.Text)<1 then
 begin
  m_Sen_Content.SetFocus;
  ErrorMsg(1,'信息内容不能为空!');
  Exit;
 end;
 if rgCell.ItemIndex=1 then sChargeNo := '#0';  //#0被叫号码付费
 if rgCell.ItemIndex=0 then sChargeNo := '0'; //0SP付费
  sSvcType  := Trim(lSvcType.Text);           //服务类型
  sContent  := Trim(m_Sen_Content.Text);
 if SearchSvcType(sSvcType,1)<>1
   then begin
    lSvcType.SetFocus;
    ErrorMsg(1,'错误的服务类型!');
    Exit;
   end;
  for i:=1 to sgrList.RowCount-1 do
   begin
     sDestNo:=Trim(sgrList.Cells[1,I]);
      if sDestNo<>'' then
       begin
         if not CheckPhone(11,sDestNo) then
           begin
            sgrList.SetFocus;
            ErrorMsg(1,'被叫手机号码错误!');
            sgrList.Row:=I;
            Exit;
           end;
          b:=True;
        end;
    end;
  if not b then
     begin
      sgrList.SetFocus;
      ErrorMsg(1,'被叫号码不能为空!');
      sgrList.Row:=1;
      Exit;
     end;
  for i:=1 to sgrList.RowCount-1 do
   begin
     sDestNo:=Trim(sgrList.Cells[1,i]);
     if sDestNo<>'' then
     PostMess(2,1,sDestNo,sChargeNo,sSvcType,Now,sContent,SPNumber);
   end;
  b_SendSMS.Enabled:=False;
end;

procedure Tfrm_smServer.sgrListSelectCell(Sender: TObject; ACol,
  ARow: Integer; var CanSelect: Boolean);
var
 pDestNo:string;
 pRow:Integer;
begin
pDestNo :=  sgrList.Cells[1,sgrList.Row];
pRow    :=  sgrList.Row;
 try
   if (sgr_State<>stBrowse)and(ARow<>sgrList.Row)
     then
      if Trim(sgrList.Cells[1,pRow])<>''
        then if not CheckPhone(11,pDestNo)
          then begin
           ErrorMsg(1,'无效的手机号码!');
           Exit;
        end;
    if (ARow<>pRow) then  sgr_State:=stBrowse;
//if (ARow<>pRow) then
//begin

//end;
except
 on E:Exception do
  begin
   sgrList.SetFocus;
   Application.MessageBox(PChar(E.Message), '错误信息', mb_IconError+mb_Ok);
   Abort;
  end;
end;
if ACol=2 then
 begin
 CanSelect:=True;
 if Trim(sgrList.Cells[2,ARow])='' then
   sgrList.Cells[2,ARow]:='√' else
   sgrList.Cells[2,ARow]:='';
 CanSelect:=False;
 end;
if ACol=0 then CanSelect:=False;
end;

procedure Tfrm_smServer.sgrListSetEditText(Sender: TObject; ACol,
  ARow: Integer; const Value: String);
begin
  if sgrList.EditorMode then
    sgr_State:=stEdit
   else
    sgr_State:=stInsert;
end;

procedure Tfrm_smServer.sgrListKeyDown(Sender: TObject;
  var Key: Word; Shift: TShiftState);
var
 pRow, i:Integer;
begin
{if (Key=VK_Insert) then
 begin
   sgrList.RowCount:=sgrList.RowCount+1;
   pRow:=sgrList.RowCount-sgrList.Row;
    for i:=pRow to sgrList.RowCount-1 do
     begin
      sgrList.Cells[1,I]
      sgrList.Cells[]

     end;


 end;  }
  // 取消所做的修改
if (Key=VK_RETURN)and(sgr_State=stEdit) then
 begin
 end;
if (sgr_State<>stBrowse)and(Key=vk_Escape) then
 begin
  if (sgr_State=stEdit) then
     sgrList.Cells[1, sgrList.Row]:=F_OldMobilePhone;
  sgr_State:=stBrowse;
 end;

end;

procedure Tfrm_smServer.sgrListGetEditText(Sender: TObject; ACol,
  ARow: Integer; var Value: String);
begin
if sgr_State=stBrowse then
 F_OldMobilePhone:=Value;
end;

procedure Tfrm_smServer.sgrListDrawCell(Sender: TObject; ACol,
  ARow: Integer; Rect: TRect; State: TGridDrawState);
var
  OldAlign,
  OldBkMode,
  OldTextColor:Integer;
  Text_Height, X, Y:Integer;
begin
  Inherited;
  with sgrList.Canvas do
  begin
    if ((ACol=1)or(ACol=2))and(State=[]) then
      Font.Color:=clBlack;
    FillRect(Rect);
    OldBkMode:=SetBkMode(Handle, Transparent);
    OldAlign:=SetTextAlign(Handle, TA_Center);
    Text_Height:=TextHeight('Test');
    X:=(Rect.Left+Rect.Right) div 2+1;
    Y:=(Rect.Bottom+Rect.Top-Text_Height) div 2;
    if Y<0 then Y:=0;
    OldTextColor:=Font.Color;
    if (ARow=0)or(ACol=0) then
    begin
      Font.Color:=clWhite;
      TextOut(X+1, Y+1, sgrList.Cells[ACol, ARow]);
    end;
    Font.Color:=OldTextColor;
    TextOut(X, Y, sgrList.Cells[ACol, ARow]);
    SetTextAlign(Handle, OldAlign);
    SetBkMode(Handle, OldBkMode);
  end;
end;

procedure Tfrm_smServer.FormShow(Sender: TObject);
var
 i:Integer;
begin
LoadResultCode;
LoadSvcTypeCode;
WaitRun.Position:=0;
TPage.ActivePageIndex:=3;
TPage.ActivePageIndex:=2;
TPage.ActivePageIndex:=1;
TPage.ActivePageIndex:=0;
RI:=0;
try
 ServerReceiveSend.Port := GetHostPort;
 ServerReceiveSend.Active:=True;
 MangPhone := GetMangPhone;
 Timer_Rec.Interval := GetAnswerTime;
 Timer_Send.Interval := GetSenAnswTime;
 tTimeCycle.Interval:= GetTimeCycle; 
 Interval   := GetInterval;
 ExpireTime := GetExpireTime;
 REC_UPT := GetREC_UPT;
 SND_UPT := GetSND_UPT;
 CurLogChk  := GetCurLogChk;
 SendTime   := Get_Time;
 SvcTypeTran:= GetSvcTypeTran;
 SP_SvcType := GetSPSvcType;
 ReSend     := GetReSend;
 ReSendTry  := GetSendTry;
 ResultCharegNo := GetCharge;
 FeeDate        := GetFeeDate;
 FeeTime        := GetFeeTime;
 SPNumber       := GetSPNumber;
 lCXCount.Caption := IntToStr(ReadCXRecord);
except
 on Exception do
  raise exception.Create('服务器某些参数未设定！');
end;
//ClientDisconnect:=True;
for i:=0 to sgrList.RowCount do
  sgrList.Cells[0,i+1]:=IntToStr(i+1);
sgrList.Cells[0,0]:='编号';
sgrList.Cells[1,0]:='手机号码';
sgrList.Cells[2,0]:='选择';
with sgr2 do
 begin
   Cells[0,0]:='网络句柄';
   Cells[1,0]:='信息头';
   Cells[2,0]:='IP地址';
   Cells[3,0]:='SP子号码';
   Cells[4,0]:='用户名';
   Cells[5,0]:='命令号';
   Cells[6,0]:='被叫号码';
   Cells[7,0]:='付费号码';
   Cells[8,0]:='服务类型';
   Cells[9,0]:='信息内容';
   Cells[10,0]:='操作时间';
 end;
with sgr3 do
 begin
   Cells[0,0]:='网络句柄';
   Cells[1,0]:='信息头';
   Cells[2,0]:='客户端IP';
   Cells[3,0]:='客户端名称';
   Cells[4,0]:='登陆时间';
 end;
rgCell.ItemIndex:=1;
frmServerDB.aRegCount.Open;
frmServerDB.atSvcContent.Open;
frmServerDB.atLogin.Open;
lRegCount.Caption := IntToStr(frmServerDB.aRegCountCOLUMN1.Value);
frmServerDB.aRegister.Active:=True;
TPage.TabIndex := 0;
end;

procedure Tfrm_smServer.N2Click(Sender: TObject);
begin
 Timer_Rec.Enabled:=False;
 Timer_Send.Enabled:=False;
 tTimeCycle.Enabled:=False;

 SingleSendList.Free;     //释放列表
 ResultCode.Free;          //释放列表
 BatchSendList.Free;      //释放批量数据
 MonthFeeList.Free;       //释放包月收费数据
// NetList.Free;
 ClearLink;
 with NotifyIcon do
  begin
    cbSize:=SizeOf(Tnotifyicondataa);
    wnd:=Handle;
    uid:=IID;
    uFlags := NIF_ICON Or NIF_MESSAGE Or NIF_TIP;
    uCallBackMessage:=MouseMsg;
    hIcon:=Application.Icon.Handle;
    szTip:='短信应用服务器';
  end;
 Shell_Notifyicona(nim_Delete,@NotifyIcon);
 Application.Terminate;
end;

procedure Tfrm_smServer.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
Action:=caNone;
ShowWindow(Handle,sw_Hide);
ShowWindow(Application.Handle,sw_Hide);
SetWindowLong(Application.Handle,gwl_exstyle,
GetWindowLong(Application.Handle,gwl_exstyle)
or ws_ex_toolwindow and not ws_ex_appwindow);
end;

procedure Tfrm_smServer.Time_Send(Sender: TObject);
begin
try
 //创建TSen_Thread实例，并执行线程   //单条发送
if (SingleSendList.Count>0)and(SingleSend) then
 TSen_Thread.Create(False) else
if SingleSendList.Count=0 then b_SendSMS.Enabled:=True;
 //创建TBatch_Thread实例，并执行线程   //批量发送
if (BatchSendList.Count>0)and(batchSend) then
 TBatch_Thread.Create(False) else
if BatchSendList.Count=0 then  b_SendBachSMS.Enabled:=True;
 //创建TBatch_Proc实例   信息批量处理
 TBatch_Proc.Create(False);
 except
  on exception do
   //raise EAbort.Create('''');
   raise exception.Create('Timers3');
  end;
end;

procedure Tfrm_smServer.FormCreate(Sender: TObject);
begin
ResultCode:=TStringList.Create;
SingleSendList:=TStringList.Create;
BatchSendList:=TStringList.Create;
MonthFeeList:=TStringList.Create;
//NetList:=TList.Create;          //网络信息列表
CurLogFile:=ExtractFilePath(Application.ExeName)+'Log\'+
            FormatDateTime('yyyymmdd',Now)+'.txt';
with NotifyIcon do
 begin
  cbSize := SizeOf(TNotifyIconData);
  Wnd:=Handle;
  uID:=iid;
  uFlags := NIF_ICON Or NIF_MESSAGE Or NIF_TIP;
  uCallbackMessage:=MouseMsg;
  hIcon:=Application.Icon.handle;
  szTip:='短信应用服务器';
 end;
//Shell_NotifyIcon(NIM_ADD, @NotifyIcon);
end;

procedure Tfrm_smServer.b_sendBachSMSClick(Sender: TObject);
begin
if Length(m_Sen_Content.Text)<1 then
 begin
  m_Sen_Content.SetFocus;
  ErrorMsg(1,'发送信息不能为空!');
  Abort;
 end;
if sta_DestNo.Text='' then
 begin
  sta_DestNo.SetFocus;
  ErrorMsg(1,'起始号码不能为空!');
  Abort;
 end;
if end_DestNo.Text='' then
 begin
  end_DestNo.SetFocus;
  ErrorMsg(1,'起始号码不能为空!');
  Abort;
 end;
if not CheckPhone(11,sta_DestNo.Text) then
 begin
  sta_DestNo.SetFocus;
  ErrorMsg(0,'开始手机号码错误!');
  Abort;
 end;
if not CheckPhone(11,end_DestNo.Text) then
 begin
  end_DestNo.SetFocus;
  ErrorMsg(0,'结束手机号码错误!');
  Abort;
 end;
if  sta_DestNo.Text>end_DestNo.Text then
  begin
  sta_DestNo.SetFocus;
  ErrorMsg(0,'开始号码不能大于结束号码!');
  Abort;
 end;
 AddbatchList(sta_DestNo.Text,end_DestNo.Text);
end;

procedure Tfrm_smServer.stopsendClick(Sender: TObject);
begin
if SingleSendList.Count>0 then
 begin
  SingleSendList.Delete(0);
  Dec(vRun);
 end;
 b_sendsms.Enabled:=True;
 b_sendBachSMS.Enabled:=True;
 str_Out('操作被终止...',1);
end;