⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 sp_smg_dll.pas

📁 SPIG1.1.rar SPIG接口协议
💻 PAS
字号:
unit SP_SMG_DLL;

interface

uses
  Windows, Forms, SysUtils, Classes, Registry, Math, Gauges, WinSock, ComCtrls,
  StdCtrls, ShellApi, ExtCtrls;

const
  AccessFial = $0001;
  ErrSvcType = $0002;

 //Report包结构
type
  ReportStr = packed Record
    SequenceNumber1: LongInt;
    SequenceNumber2: LongInt;
    SequenceNumber3: LongInt;
    UserNumber: packed array[0..21] of Char;
    State: Char;
    ErrCode: Char;
end;

//Deliver包结构
type
  DeliverStr = record
    SeqNum1: LongInt;
    SeqNum2: LongInt;
    SeqNum3: LongInt;
    SrcNo:array[0..21] of Char;
    SpNum:array[0..21] of Char;
    Tp_Pid: Char;
    Tp_Udhi: Char;
    MsgCoding: Char;
    MsgLen: Integer;
    MsgContent: array[0..159] of Char;
end;

//MT Response包结构
type
  MTRespStr = packed record
    SequenceNumber1: LongInt;
    SequenceNumber2: LongInt;
    SequenceNumber3: LongInt;
    Result: Char;
end;

//Submit错误结构,当Submit发送不成功时,在Deliver处理中返回该结构
type
  MTErrStr = packed record
    SequenceNumber1: LongInt;
    SequenceNumber2: LongInt;
    SequenceNumber3: LongInt;
    ErrorType: Integer;
end;

//RecvClient接受客户请求数据
type
 TRecvClient = record
   UserName:array[0..14] of Char;
   PassWord:array[0..14] of Char;
   SPNumber:array[0..9] of Char;
   SvcType:array[0..9] of Char;
   ChargeNumber:array[0..20] of Char;
   UserNumber:array[0..20] of Char;
   ExpireTime:array[0..13] of Char;
   ScheduleTime:array[0..13] of Char;
   TP_Pid:Char;
   TP_Udhi:Char;
   MessageLen:Integer;
   MessageContent:array[0..159] of Char;
 end;

//TranClient下发客户端的数据
type
  TTranClient = record
    Deliver : DeliverStr;
    Report  : ReportStr;
    Result : byte;
  end;

type
 PSendBuffer = ^TBuffer ;
  TBuffer = record
    SPNumber,ChargeNumber:PChar;
    UserCount: Integer;
    UserPhone,CorpID,SvcType: PChar;
    FeeType: Char;
    FeeValue,Given_Value: PChar;
    AgentFlag,MoFlag,Priority: Char;
    ExpireTime,ScheduleTime: PChar;
    ReportFlag,Tppid,Tpudhi,MsgCoding,MsgType: Char;
    MsgLen:LongInt;MsgContent,Reserve: PChar;
 end;

 type
  PSckHandles = ^TSckHandle;
   TSckHandle = record
    SPNumber:array[0..9] of Char;
    SckHandle:LongInt;
  end;

 type           //用户身份鉴权数据
  PBindSearch = ^TBindSearch;
   TBindSearch = record
   SPNumber,UserName,PassWord:string;
  end;

 type           //服务类型数据
  PSvcTypeSearch = ^TSvcTypeSearch;
   TSvcTypeSearch = record
    SPNumber,Server_Type,Fee_Type,
    Fee_Value,Priority,ReportFlag:string;
  end;

 type TDeliver = procedure(Deliver: DeliverStr);cdecl;
 type TReport  = procedure(Report: ReportStr);cdecl;

 procedure ProgressBar;
 procedure ChangStr(Msg:string;Value:Integer);
 procedure strMsg(str:TStatusBar;Falg:Integer;Msg:string);
 procedure PaintStr(Img:TImage);
 procedure CurLogMsg(TRE:TMemo;Msg:string);
 procedure DestroySckHandle(SckHandle:LongInt);
 procedure ErrorMsg(Falg:Integer;ErrMsg:PChar);
 procedure DisonnectSck(SckHandle:LongInt);
 procedure AddToSckHandle(SckHandle:LongInt;pSPNumber:string);
 procedure SendBuffer(SckHandle:LongInt;pDeliver:DeliverStr;pReport:ReportStr;pResult:byte);
 function SearchSckHandle(pSPNumber:string;var SckHandle:LongInt):Integer;
 function str_Out(str:string;x:Integer):string;
 function SearchBind(Val1,Val2,Val3:string):Boolean;
 function SearchSvcType(Val1,Val2:string):Boolean;
 function ResultSvcType(val1,val2:string;Flag:Integer):string;
 function AddBufferList(pSPNum,pChargeNum:PChar;Count:Integer;pUserPhone,pSvcType:PChar;pExpireTime,
                        pScheduleTime:PChar;pMsgCoding,pMsgType:Char;pMsgContent:PChar):Boolean;
var
 Progress     : TGauge;
 SendTime     : string;
 TranSvcType  : string;
 SNDUPT       : Integer; 
 //=======================//
 CurLogFile   : string;
 RemoteIPAddr : string;
 LocatIPAddr  : string;
 UserName     : string;
 PassWord     : string;
 SrcNode      : string;
 SPCode       : string;
 SP_Num       : string;
 BufferList   : TList;
 SckHandleList: TList;
 BindList     : TList;
 SvcTypeList  : TList;
 RemotePort   : Integer;
 LocatPort    : Integer;
 RecvHostPort : Integer;
 SocketTimeOut: Integer;
 RunCount     : Integer;
 MTTimeOut    : Integer;
 SendTry      : Integer;
 CurLog       : Boolean;
 AutoRun      : Boolean;
 ProgressAction:Boolean;
 pRect        : TRect;
 RI           : Integer=0;

implementation

uses SPServer, SMG_ReportThread, SMG_DB;

function AddBufferList(pSPNum,pChargeNum:PChar;Count:Integer;pUserPhone,pSvcType:PChar;pExpireTime,
                       pScheduleTime:PChar;pMsgCoding,pMsgType:Char;pMsgContent:PChar):Boolean;
var
 SendBuffer:PSendBuffer;
 pFeeType,pFeeValue,pPriority,pReportFlag:PChar;
 a,b:string;
 i:integer;
begin
Result := False;
with frmSMGDB.qryServerType do
 begin
   Close;
   Parameters.ParamByName('pSPNumber').Value:=string(pSPNum);
   Parameters.ParamByName('pSvcType').Value:=string(pSvcType);
   Open;
   if RecordCount > 0 then
    begin
      pFeeType:=PChar(Trim(Fields[2].Text));
      pFeeValue:=PChar(Trim(Fields[3].Text));
      pPriority:=PChar(Trim(Fields[4].Text));
      pReportFlag:=PChar(Trim(Fields[5].Text));
    end else Exit;
 end;
 New(SendBuffer);
 with SendBuffer^ do
  begin
   SPNumber:=PChar(pSPNum);
   ChargeNumber:=PChar(pChargeNum);
   UserCount:=Count;
   UserPhone:=PChar(pUserPhone);
   CorpID:=PChar(SPCode);
   SvcType:=PChar(pSvcType);
   FeeType:=Char(PChar(pFeeType));
   FeeValue:=PChar(pFeeValue);
   Given_Value:=PChar('');
   AgentFlag:=#0;
   MoFlag:=#0;
   Priority:=Char(pPriority);
   ExpireTime:='';
   ScheduleTime:='';
   ReportFlag:=#1;
   Tppid:='0';
   Tpudhi:='0';
   MsgCoding:=#15;
   MsgType:=#0;
   MsgLen:=Length(pMsgContent);
   MsgContent:=PChar(pMsgContent);
  end;
end;

procedure ProgressBar;
var
 staPanleWidth:Integer;
begin
Progress:=TGauge.Create(nil);
staPanleWidth:=frmSGIP.str.Panels[1].Width;
with Progress do
 begin
  Top:=3;
  Left:=60;
  Width:=frmSGIP.str.Panels[1].Width-4;
  Height:=19;
  Visible:=True;
  ForeColor:=$000080FF;
  Parent:=frmSGIP.str;
  MinValue:=0;
  MaxValue:=100;
 end;
end;

function ResultSvcType(val1,val2:string;Flag:Integer):string;
var
 SvcTypeSearch:PSvcTypeSearch;
 tmp1,tmp2:string;
 I:Integer;
begin
 for I:=0 to SvcTypeList.Count-1 do
  begin
    New(SvcTypeSearch);
    SvcTypeSearch:=SvcTypeList[I];
    with SvcTypeSearch^ do
     begin
      tmp1:=SPNumber;
      tmp2:=Server_Type;
      if (val1=tmp1)and(val2=tmp2) then
       begin
        case Flag of
          1:Result:=Server_Type;
          2:Result:=Fee_Type;
          3:Result:=Fee_Value;
          4:Result:=Priority;
          5:Result:=ReportFlag;
        end;
       end;
     end;
  end;
end;

function SearchSvcType(Val1,Val2:string):Boolean;
var
 SvcTypeSearch:PSvcTypeSearch;
 tmp1,tmp2:string;
 I:Integer;
begin
 Result:=False;
 for I:=0 to SvcTypeList.Count-1 do
  begin
    New(SvcTypeSearch);
    SvcTypeSearch:=SvcTypeList[I];
    with SvcTypeSearch^ do
     begin
       tmp1:=SPNumber;
       tmp2:=Server_Type;
     end;
     if (tmp1=Val1)and(tmp2=Val2) then
       begin
         Result:=True;
         Exit;
       end;
    end;
end;

function SearchBind(Val1,Val2,Val3:string):Boolean;
var
 BindSearch:PBindSearch;
 tmp1,tmp2,tmp3:string;
 I:Integer;
begin
 Result :=False;
 for I:=0 to BindList.Count-1 do
  begin
    BindSearch:=BindList[I];
    with BindSearch^ do
     begin
       tmp1:=SPNumber;
       tmp2:=UserName;
       tmp3:=PassWord;
     end;
    if (Val1=tmp1)and(Val2=tmp2)and(Val3=tmp3) then
     begin
      Result:=True;
      Exit;
     end;
  end;
end;

procedure ChangStr(Msg:string;Value:Integer);
begin
 with frmSGIP do
  with str.Canvas do
   begin
    FillRect(Rect(pRect.Left+2,pRect.Top,pRect.Right-10,pRect.Bottom));
    ImageList2.Draw(Canvas,pRect.Left+2,pRect.Top+2,Value);
    TextOut(pRect.Left+24,6,Msg);
   end;
end;

procedure PaintStr(Img:TImage);
begin
 Shell_NotifyIcon(NIM_MODIFY, @NotifyIcon);
 NotifyIcon.hIcon := Img.Picture.Icon.Handle;
 Shell_NotifyIcon(NIM_ADD, @NotifyIcon);
end;

procedure DestroySckHandle(SckHandle:LongInt);
var
 pSckHandle:PSckHandles;
 I:Integer;
 Sck_Handle:LongInt;
begin
New(pSckHandle);
 for I:=0 to SckHandleList.Count-1 do
   begin
     Sck_Handle:=pSckHandle^.SckHandle;
    if SckHandle = Sck_Handle then
       SckHandleList.Delete(I);
   end;
end;
 
//搜索网络连接事件
function SearchSckHandle(pSPNumber:string;var SckHandle:LongInt):Integer;
var
 pSckHandle:PSckHandles;
 pSPNum:string;
 Sck_Handle:LongInt;
 I:Integer;
begin
Result := -1;
New(pSckHandle);
for I:=0 to SckHandleList.Count-1 do
 begin
  pSckHandle := SckHandleList[I];
  with pSckHandle^ do
    begin
      pSPNum:=SPNumber;
      Sck_Handle:=SckHandle;
    end;
  if pSPNum = pSPNumber then
   begin
    SckHandle := Sck_Handle;
    Result := 1;
    Exit;
   end
 end;
end;

//添加到网络对列中
procedure AddToSckHandle(SckHandle:LongInt;pSPNumber:string);
var
 pSckHandle : PSckHandles;
 I:Integer;
 Falg:Boolean;
begin
 Falg := False;
 New(pSckHandle);
 for I:=0 to SckHandleList.Count-1 do
   begin
    pSckHandle := SckHandleList[I];
    if (SckHandle = pSckHandle.SckHandle)and
       (pSPNumber = pSckHandle.SPNumber) then
     begin
       Falg := True;
       Exit;
      end;
   end;
    if not Falg then
      begin
        with pSckHandle^ do
          begin
            StrPCopy(SPNumber,pSPNumber);
            SckHandle:=SckHandle;
          end;
         SckHandleList.Add(pSckHandle);
      end;
end;

procedure DisonnectSck(SckHandle:LongInt);
begin
 frmSGIP.ServerSocket.Socket.Disconnect(SckHandle);
end;

procedure SendBuffer(SckHandle:LongInt;pDeliver:DeliverStr;pReport:ReportStr;pResult:byte);
var
 TranClient : TTranClient;
 Buffer:array[0..1023] of Char;
 I:Integer;
begin
  Inc(RI);
  FillChar(Buffer,SizeOf(Buffer),' ');
  FillChar(TranClient,SizeOf(TranClient),' ');
  Move(pDeliver,TranClient.Deliver,SizeOf(pDeliver));
  Move(pReport,TranClient.Report,SizeOf(pReport));
  TranClient.Result :=pResult;
  Move(TranClient,Buffer,SizeOf(TranClient));
  with frmSGIP.ServerSocket.Socket do
   begin
     for I := 0 to  ActiveConnections -1 do
       begin
         if Connections[I].Handle=SckHandle then
           begin
            Connections[I].SendBuf(Buffer,SizeOf(Buffer));
            Exit;
           end;
       end;
   end;
end;

procedure CurLogMsg(TRE:TMemo;Msg:string);
begin
 if TRE.Lines.Count > 100 then
   TRE.Lines.Delete(0);
   TRE.Lines.Add('');
   TRE.Lines.Add(Msg);
end;

procedure strMsg(str:TStatusBar;Falg:Integer;Msg:string);
begin
 str.Panels[Falg].Text:=Msg;
end;

function str_Out(str:string;x:Integer):string;
begin
 frmSGIP.str.Refresh;
 Result:='';
 case x of
  0..3:frmSGIP.str.Panels[x].Text:=str;
  else
   Result:=frmSGIP.str.Panels[1].Text;
 end;
end;

procedure ErrorMsg(Falg:Integer;ErrMsg:PChar);
begin
 Case Falg of
   0: Raise Exception.Create(ErrMsg);
   1:MessageBox(Application.handle,ErrMsg,PChar('注意'),MB_ICONINFORMATION);
   2:MessageBox(Application.handle,ErrMsg,PChar('错误'),MB_ICONSTOP);
   3:MessageBox(Application.handle,ErrMsg,PChar('错误'),MB_OK);
 end;
end;

end.

⌨️ 快捷键说明

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