sm_sp_server.pas

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

procedure Tfrm_smServer.ServerReceiveSendClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
SockAddressLink(Socket.Handle,0,'','',0);
str_Out('连接成功!',3);
end;

procedure Tfrm_smServer.ServerReceiveSendClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
str_Out('网络错误!',3);
SockAddressLink(Socket.Handle,0,'','',2);
SockAddressLink(0,0,'','',4);
ErrorCode:=0;
end;

procedure Tfrm_smServer.ServerReceiveSendClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
str_Out('网络断开!',3);
SockAddressLink(Socket.Handle,0,'','',2);
SockAddressLink(0,0,'','',4);
end;

procedure Tfrm_smServer.N8Click(Sender: TObject);
var
 frm_Set: Tfrm_Set;
begin
 frm_Set := Tfrm_Set.Create(self);
 frm_Set.ShowModal;
end;

procedure Tfrm_smServer.N3Click(Sender: TObject);
var
 frm_DBT: Tfrm_DBT;
begin
  frm_DBT := Tfrm_DBT.Create(self);
  frm_DBT.ShowModal;
end;

procedure TBatch_Proc.BatchProc;
var
 sSvcContent, sChargeNo, sSvcType, sDestNo, p_sDestNo, NowTime, pSPNumber:string;
 i,n,pTranType:Integer;
 pCurRecNo:LongInt;
 x,z:Real;
begin
 NowTime:=FormatDateTime('hh:mm',Now);;
//============================搜索指定的数据发送=========================//
 if (NowTime=SendTime) and
    (SendTime<>'0:00') and
    (SendTime<>'00:00')
   then begin
     SetTime('0:00');
     SendTime:=Get_Time;
     str_Out('数据打包发送',1);
     ProgressBar;
     Progress.Progress:=0;
     //'0'表示SP付费，#0空串表示被叫号码付费
     sChargeNo:=#0;
     frmServerDB.aUpdateTryAll.Close;
     frmServerDB.aUpdateTryAll.ExecSQL;
     with frmServerDB.aqrRegister1 do
      begin
       Close;
       Parameters.ParamByName('p_SvcType').Value:=SvcTypeTran;
       Open;
      end;
     if frmServerDB.aqrRegister1.RecordCount>0 then
      begin
       n:=frmServerDB.aqrRegister1.RecordCount;
       with frmServerDB.aSvcContent do
        begin
         Close;
          //被触发的服务类型
         Parameters.ParamByName('p_SvcTypeName').Value:=SvcTypeTran;
         Open;
        end;
      if frmServerDB.aSvcContent.RecordCount>0
        then begin
         sSvcContent := Trim(frmServerDB.aSvcContent.Fields[2].Value);
         sSvcType := Trim(frmServerDB.aSvcContent.Fields[1].Value);
        end;
        z:=0.00;
        x:=0.00;
        frmServerDB.aqrRegister1.First;
        while not frmServerDB.aqrRegister1.Eof do
         begin
          i:=0;
          p_sDestNo:='';
          while (not frmServerDB.aqrRegister1.Eof) and (i<SND_UPT) do
           begin
            sDestNo:=Trim(frmServerDB.aqrRegister1.Fields[0].Value);
            p_sDestNo:=p_sDestNO+sDestNo+',';
            frmServerDB.aqrRegister1.Next;
            Inc(i);
            Inc(vRun);
           if x<1.005 then x:=x+GetProgBar(n) else
            begin
             Progress.Progress := Progress.Progress+Round(x);
             x:=0.00;
            end;
            frm_smServer.lCurRecord.Caption:=IntToStr(frmServerDB.aqrRegister1.RecNo);
           end;
           if Copy(p_sDestNo,Length(p_sDestNo),1)=',' then
           p_sDestNo := Copy(p_sDestNo,1,Length(p_sDestNo)-1);
           CurLogMsg(1,'==========信息批量发送==========');
           CurLogMsg(1,'被叫号码:'+p_sDestNo);
           CurLogMsg(1,'当前时间:'+DateTimeToStr(Now));
           batchSendList.Add(ResultDataLayout(p_sDestNo,sChargeNo,sSvcType,sSvcContent,SPNumber));
           batchSend:=True;
          end;
        end;
      CurLogMsg(1,'信息内容:'+sSvcContent);
      Progress.Progress := 100;
      ProgressAction :=True;
      frmServerDB.aqrRegister1.Close;
      frmServerDB.aSvcContent.Close;
   end;
end;

procedure Tfrm_smServer.Timer0(Sender: TObject);
begin
   if RI=1 then strChanging('正在连机工作...',1);
   lRec.Caption   := IntToStr(MsgReceive);
   lRight.Caption := IntToStr(MsgRightNum);
   lFailRecord.Caption := IntToStr(FailRecord);
   lBuffer.Caption:=IntToStr(BufferRecord);
   lRun.Caption := IntToStr(vRun);
   ibuffer.Position:=BufferRecord*10;
   if (MsgRightNum>0)and(BufferRecord>0) then
   sp_Prec.Position:=(FailRecord div MsgRightNum)*100;
   WaitRun.Position := vRUN; 
end;

procedure Tfrm_smServer.ServerReceiveSendClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
 xReceiveClient:TReceiveClient;
 buffer:array[0..1023] of Char;
 tmpbuf:array[0..255] of Char;
 pHand:byte;
 pUser, pPassWord, pCommandID, pDestNo, pSPNumber,
 pChargeNo, pSvcType, pIPAddress, pContent:string;
 I:Integer;
 sHandle:DWord;
begin
 for i := 0 to  ServerReceiveSend.Socket.ActiveConnections -1 do
    begin
      if ServerReceiveSend.Socket.Connections[i].Handle=Socket.Handle
      then begin
         sHandle:=Socket.Handle;
      end;
    end;
 fillchar(buffer,SizeOf(buffer),' ');
 fillchar(xReceiveClient,SizeOf(xReceiveClient),' ');
 fillchar(tmpbuf,sizeof(tmpbuf),' ');
 Socket.ReceiveBuf(buffer,SizeOf(buffer));
 Move(buffer,xReceiveClient,SizeOf(xReceiveClient));
 CurLogMsg(2,'==========接收客户机数据==========');
 CurLogMsg(2,'网络句柄:'+IntToStr(sHandle));
 CurLogMsg(2,'信息头:'+IntToStr(xReceiveClient.Hand));
 pHand:=xReceiveClient.Hand;
 Move(xReceiveClient.IPAddress,tmpbuf,SizeOf(xReceiveClient.IPAddress));
 CurLogMsg(2,'IP地址:'+tmpbuf);
 pIPAddress:=tmpbuf;
 Move(xReceiveClient.User,tmpbuf,SizeOf(xReceiveClient.User));
 CurLogMsg(2,'用户名:'+tmpbuf);
 pUser:=tmpbuf;
 Move(xReceiveClient.PassWord,tmpbuf,SizeOf(xReceiveClient.PassWord));
 pPassWord:=tmpbuf;
 fillchar(tmpbuf,Length(pPassWord),'*');
 CurLogMsg(2,'认证码:'+tmpbuf);
 fillchar(tmpbuf,SizeOf(tmpbuf),' ');
 Move(xReceiveClient.CommandID,tmpbuf,SizeOf(xReceiveClient.CommandID));
 CurLogMsg(2,'命令字:'+tmpbuf);
 pCommandID:=Trim(tmpbuf);
 Move(xReceiveClient.DestNo,tmpbuf,SizeOf(xReceiveClient.DestNo));
 CurLogMsg(2,'被叫号码:'+tmpbuf);
 pDestNo:=Trim(tmpbuf);
 Move(xReceiveClient.ChargeNo,tmpbuf,SizeOf(xReceiveClient.ChargeNo));
 CurLogMsg(2,'付费号码:'+tmpbuf);
 if tmpbuf='' then pChargeNo:=#0 else
 pChargeNo:=Trim(tmpbuf);
 Move(xReceiveClient.SvcType,tmpbuf,SizeOf(xReceiveClient.SvcType));
 CurLogMsg(2,'服务类型:'+tmpbuf);
 pSvcType:=Trim(tmpbuf);
 Move(xReceiveClient.Content,tmpbuf,SizeOf(xReceiveClient.Content));
 CurLogMsg(2,'信息内容:'+tmpbuf);
 pContent:=Trim(tmpbuf);
 Move(xReceiveClient.SPNumber,tmpbuf,SizeOf(xReceiveClient.SPNumber));
 CurLogMsg(2,'SP子号码:'+tmpbuf);
 pSPNumber:=tmpbuf;
 DataAssay(sHandle,pHand,pIPAddress,pUser,pPassWord,pCommandID,pDestNo,pChargeNo,pSvcType,pContent,pSPNumber);
 WriteMessageLog(sHandle,pHand,pIPAddress,pUser,pCommandID,pDestNo,pChargeNo,pSvcType,pContent,pSPNumber);
end;

//===============选择ScheduleSendData数据库中的数据进行发送==============//
procedure TSearchSend.SearchSendData;
var
 pRecNo,pTranType,Rec:Integer;
 pDestNo,pChargeNo,pSvcType,pContent,pSPNumber,pFeeValue,pResult:string;
begin
 with frmServerDB.aqryScheduleSendData do
  begin
   Close;
   Parameters.ParamByName('pFalg').Value:=1;
   Open;
  end;
 if frmServerDB.aqryScheduleSendData.RecordCount>0
  then begin
    frmServerDB.aqryScheduleSendData.First;
     while not (frmServerDB.aqryScheduleSendData.Eof) do
      begin
       with frmServerDB.aqryScheduleSendData do
        begin
         pRecNo   :=Fields[0].Value;
         pDestNo  :=Trim(Fields[1].Text);
         pChargeNo:=Trim(Fields[2].Text);
         pSvcType :=Trim(Fields[3].Text);
         pContent :=Trim(Fields[6].Text);
         pTranType:=Fields[7].Value;
         pSPNumber:=Trim(Fields[8].Text);
        end;
       pResult:=ResultDataLayout(pDestNo,pChargeNo,pSvcType,pContent,pSPNumber);
       with frmServerDB.aUpScheduleSendData do
        begin
         Close;
         Parameters.ParamByName('pRecNo').Value:=pRecNo;
         ExecSQL;
        end;
       if pTranType=1 then
        begin
         Inc(vRun);
         SingleSendList.Add(pResult);
         SingleSend:=True;
        end;
       if pTranType=0 then
        begin
         Inc(vRun,(Length(pDestNo) div 11));
         BatchSendList.Add(pResult);
         BatchSend:=True;
        end;
      frmServerDB.aqryScheduleSendData.Next;
    end;
  end;
  frmServerDB.aqryScheduleSendData.Close;
//=======================SemdMonthFee=================================//
 if (FeeDate=DayOf(Now)) and
    (FeeTime=FormatDateTime('hh:mm',Now))    //    TimeToStr(Now)) then
  then begin
   FeeTime:='0:00';
    with frmServerDB.qrySendMonthFee do
     begin
      Close;
      Parameters.ParamByName('p_Falg').Value:=1;
      Open;
     end;
     if frmServerDB.qrySendMonthFee.RecordCount>0
       then begin
        frmServerDB.qrySendMonthFee.First;
         while not frmServerDB.qrySendMonthFee.Eof do
          begin
           with frmServerDB.qrySendMonthFee do
             begin
              pRecNo   :=Fields[0].Value;
              pDestNo  :=Trim(Fields[1].Value);
              pSvcType :=Trim(Fields[2].Value);
              pFeeValue:=IntToStr(Fields[3].Value);
             end;
            Inc(vRun);
            with frmServerDB.updSendMonthFee do
             begin
              Close;
              Parameters.ParamByName('pFeeDateTime').Value:=Now;
              Parameters.ParamByName('pRecNo').Value:=pRecNo;
              ExecSQL;
             end;
             MonthFeeList.Add(pDestNo+'@a'+pSvcType+'@b'+pFeeValue+'@c');
             MonthFee:=True;
             frmServerDB.qrySendMonthFee.Next;
           end;
         end;
   end;
 //MonthFee信息发送//
 if (MonthFeeList.Count>0)and
    (MonthFee)
      then begin
        pDestNo:=ResultDataFmt(MonthFeeList,0);
        pSvcType:=ResultDataFmt(MonthFeeList,1);
        pFeeValue:=ResultDataFmt(MonthFeeList,2);
        Rec:=SendMonthFee(pDestNo,pSvcType,StrToInt(pFeeValue));
      if Rec>0
       then
        begin
         CurLogMsg(1,'数组元素'+IntToStr(Rec));
         CurLogMsg(1,'付费号码:'+pDestNo);
         CurLogMsg(1,'包月收费信息已发出...');
         if MonthFeeList.Count>0
          then
           begin
            MonthFeeList.Delete(0);
            Dec(vRun);
           end else
            begin
             MonthFee:=False;
             FeeTime:=GetFeeTime;
            end;
         end;
      end;
end;

procedure Tfrm_smServer.BitBtn1Click(Sender: TObject);
var
 n,i:Integer;
 curRow:Integer;
begin
curRow:=sgr2.Row;
 for i:=1 to sgr2.RowCount do
  sgr2.Rows[i].Clear;
sgr2.RowCount:=2;
i:=1;
with frmServerDB.tblMessageLog do
 begin
  Close;
  Open;
  First;
  while not Eof do
   begin
     for n:=0 to 10 do
       sgr2.Cells[n,i]:=Fields[n].Text;
      Inc(i);
      sgr2.RowCount:=I;
      Next;
    end;
  end;
 sgr2.Row:=curRow;
end;


procedure Tfrm_smServer.BitBtn2Click(Sender: TObject);
var
 i,n,sNetHandle,sHand:Integer;
 sUser:string;
 sDateTime:TDateTime;
begin
try
 with sgr2 do
  begin
   sNetHandle:=StrToInt(Trim(Cells[0,Row]));
   sHand:=StrToInt(Trim(Cells[1,Row]));
   sUser:=Trim(Cells[4,Row]);
   sDateTime:=StrToDateTime(Trim(Cells[10,Row]));
  end;
with frmServerDB.delMessageLog do
 begin
  Close;
  Parameters.ParamByName('pNetHandle').Value:=sNetHandle;
  Parameters.ParamByName('pHand').Value:=sHand;
  Parameters.ParamByName('pUserID').Value:=sUser;
  Parameters.ParamByName('pDateTime').Value:=sDateTime;
  ExecSQL;
 end;
 sgr2.Rows[sgr2.Row].Clear;
 for i:=0 to sgr2.RowCount do
  begin
   if sgr2.Cells[0,i+1]='' then
     with sgr2 do
        for n:=0 to 10 do
         begin
          Cells[n,i+1]:=Cells[n,i+2];
          Cells[n,i+2]:='';
         end;
      end;
    if sgr2.RowCount>2 then
     sgr2.RowCount:=sgr2.RowCount-1;
 except
  on exception do
   ErrorMsg(1,'条件值无效!');
  end;
end;

procedure Tfrm_smServer.sgr3DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  OldAlign,
  OldBkMode,
  OldTextColor:Integer;
  Text_Height, X, Y:Integer;
begin
  Inherited;
  with sgr3.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, sgr3.Cells[ACol, ARow]);
    end;
    Font.Color:=OldTextColor;
    TextOut(X, Y, sgr3.Cells[ACol, ARow]);
    SetTextAlign(Handle, OldAlign);
    SetBkMode(Handle, OldBkMode);
  end;
end;


///=================================信息发送接收=========================///
{单条信息发送}
procedure TSen_Thread.Senbuf;
var
 i, oid, p_SPCode, p_Length:Integer;
 p_ExpireTime, p_Times, p_Interval:Word;
 p_TpPid, p_TpUdhi:byte;
 p_Oid:array of Integer;
 p_DestNo: string;
 p_SvcType: string;
 p_Content: string;
 p_ScheduleTime: string;
 p_ChargeNo:string;
 p_ChildSP:string;
 sx:integer;
begin
str_Out('连接网络发送...',1);
RI:=4;
SingleSend := False;
p_ExpireTime:= ExpireTime;
p_Interval:= Interval;
Oid     := 0;
p_Times := 1;
p_Length:= 0;
p_TpPid := 0;
p_TpUdhi:= 0;
p_DestNo   := ResultDataFmt(SingleSendList,0); //被叫号