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

📄 spserver.pas

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

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, ExtCtrls, Buttons, ToolWin, Menus, ShellApi,
  Scope, Grids, ImgList, ScktComp, Sockets;

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

type
  TfrmSGIP = class(TForm)
    str: TStatusBar;
    CoolBar1: TCoolBar;
    ToolBar2: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolBar1: TToolBar;
    Bevel1: TBevel;
    bStarServer: TSpeedButton;
    Mem: TMainMenu;
    N1: TMenuItem;
    N14: TMenuItem;
    N10: TMenuItem;
    N9: TMenuItem;
    N8: TMenuItem;
    N4: TMenuItem;
    N2: TMenuItem;
    N22: TMenuItem;
    PupMem: TPopupMenu;
    N20: TMenuItem;
    N21: TMenuItem;
    N19: TMenuItem;
    N11: TMenuItem;
    N7: TMenuItem;
    N6: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    N5: TMenuItem;
    bitMinForm: TSpeedButton;
    TimeIcon: TTimer;
    Panel6: TPanel;
    Panel10: TPanel;
    img3: TImage;
    img2: TImage;
    img1: TImage;
    img0: TImage;
    img4: TImage;
    Panel1: TPanel;
    Panel5: TPanel;
    TreeView: TTreeView;
    Splitter1: TSplitter;
    Panel2: TPanel;
    Notebook: TNotebook;
    Panel4: TPanel;
    Panel11: TPanel;
    ImageList1: TImageList;
    CheckBox1: TCheckBox;
    ImageList2: TImageList;
    bitStopServer: TSpeedButton;
    N3: TMenuItem;
    Panel8: TPanel;
    Panel9: TPanel;
    Panel12: TPanel;
    Panel13: TPanel;
    GroupBox1: TGroupBox;
    Panel3: TPanel;
    ServerLoad: TIndicator;
    LoadPercent: TLabel;
    GroupBox2: TGroupBox;
    Panel7: TPanel;
    ServerRunStatus: TScope;
    sgr1: TStringGrid;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    SpeedButton5: TSpeedButton;
    Timer1: TTimer;
    ImageList3: TImageList;
    Panel14: TPanel;
    sgr2: TStringGrid;
    Panel15: TPanel;
    sgr3: TStringGrid;
    GroupBox3: TGroupBox;
    Label1: TLabel;
    lTranBuffer: TLabel;
    lRecvBuffer: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label2: TLabel;
    lTharead: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label5: TLabel;
    Label9: TLabel;
    lCommand: TLabel;
    ServerSocket: TServerSocket;
    TRE: TMemo;
    Button1: TButton;
    procedure N5Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure N8Click(Sender: TObject);
    procedure TimeIconTimer(Sender: TObject);
    procedure bStarServerClick(Sender: TObject);
    procedure TreeViewChange(Sender: TObject; Node: TTreeNode);
    procedure strDrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel;
      const Rect: TRect);
    procedure bitStopServerClick(Sender: TObject);
    procedure bitMinFormClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure ServerSocketClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocketClientError(Sender: TObject;
      Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
      var ErrorCode: Integer);
    procedure ServerSocketClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure TREContextPopup(Sender: TObject; MousePos: TPoint;
      var Handled: Boolean);
    procedure Button1Click(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
    { Private declarations }
    function StartAPI: Integer;
  public
    { Public declarations }
  end;

var
  frmSGIP : TfrmSGIP;
  FNode   : Integer;
  NotifyIcon: TNotifyIconData;

implementation

uses
 SMG_DB,
 SP_SMG_Set,
 SP_SMG_DLL,
 DLL_Exports,
 SMG_RecvThread,
 SMG_SendThread,
 SMG_ReportThread,
 SMG_ClientReadThread;

{$R *.dfm}

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

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

procedure TfrmSGIP.MouseMessage(var message:TMessage);
var
 Mousept:TPoint;
begin
inherited;
if message.LParam=wm_rbuttonup then begin
GetCursorPos(Mousept);
PupMem.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;

procedure Report(Report: ReportStr);cdecl;
var
 Report_Buffer:ReportStr;
begin
Inc(RI);
curlogmsg(frmSGIP.TRE,'asdfasf');
Report_Buffer := Report;
TReport_Thread.Create(Report_Buffer, False);
end;

procedure Deliver(FDeliver: DeliverStr);cdecl;
var
 Recv_Deliver:DeliverStr;
begin
Inc(RI);
strMsg(frmSGIP.str,1,'接收到新信息!');
PaintStr(frmSGIP.img2);
Recv_Deliver := FDeliver;
Recv_Thread.Create(Recv_Deliver,False);
end;

function TfrmSGIP.StartAPI: Integer;
begin
 Result := StartUp(PChar(LocatIPAddr), LocatPort, PChar(RemoteIPAddr),RemotePort, PChar(UserName),PChar(PassWord),
           SocketTimeOut, MTTimeOut, StrToInt(SrcNode), 10, 5000, SendTry, 10,Deliver, Report, nil, nil);
end;

procedure TfrmSGIP.N5Click(Sender: TObject);
begin
 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);
 //=======================================//
 BufferList.Free;
 SckHandleList.Free;
 BindList.Free;
 SvcTypeList.Free;
 Application.Terminate;
end;

procedure TfrmSGIP.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 TfrmSGIP.FormCreate(Sender: TObject);
begin
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);
//====================================//
BufferList:=TList.Create;
SckHandleList:=TList.Create;
BindList:=TList.Create;
SvcTypeList:=TList.Create;
end;

procedure TfrmSGIP.FormDestroy(Sender: TObject);
begin
Shell_NotifyIcon(NIM_DELETE, @NotifyIcon);
end;

procedure TfrmSGIP.FormShow(Sender: TObject);
var
 I,N:Integer;
 SvcTypeSearch:PSvcTypeSearch;
 BindSearch:PBindSearch;
begin
 with sgr1 do
  begin
   Cells[0,0] := 'SP号码';
   Cells[1,0] := '服务类型';
   Cells[2,0] := '收费类型';
   Cells[3,0] := '收费额';
   Cells[4,0] := '优先等级';
   Cells[5,0] := '报告状态';
  end;
 with frmSMGDB.tblServerType do
  begin
   Open;
   First;
   I:=1;
   with sgr1 do
     begin
       while not Eof do
         begin
            for N:=0 to ColCount-1 do
              Cells[N,I]:=Fields[N].Value;
           Next;
           Inc(I);
           RowCount := I;
           Row := RowCount -1;
         end;
         Close;
     end;
  end;
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;
 with frmSMGDB.tblServerType do
  begin
   Open;
   First;
   while not Eof do
    begin
      New(SvcTypeSearch);
      with SvcTypeSearch^ do
       begin
         SPNumber:=Trim(Fields[0].Text);
         Server_Type:=Trim(Fields[1].Text);
         Fee_Type:=Trim(Fields[2].Text);
         Fee_Value:=Trim(Fields[3].Text);
         Priority:=Trim(Fields[4].Text);
         ReportFlag:=Trim(Fields[5].Text);
       end;
       SvcTypeList.Add(SvcTypeSearch);
       Next;
    end;
    Close;
  end;
 CurLogMsg(TRE,'服务类型数据启动成功...');
 with frmSMGDB.tblBind do
  begin
   Open;
   First;
   while not Eof do
    begin
      New(BindSearch);
      with BindSearch^ do
       begin
         SPNumber:=Trim(Fields[0].Text);
         UserName:=Trim(Fields[1].Text);
         PassWord:=Trim(Fields[2].Text);
       end;
       BindList.Add(BindSearch);
       Next;
    end;
    Close;
  end;
  CurLogMsg(TRE,'网络绑定数据启动成功...');
try
 NoteBook.PageIndex:=0;
 LocatIPAddr  := GetLocatIPAddr;
 LocatPort    := GetLocatHostPort;
 RemoteIPAddr := GetRemoteIPAddr;
 RemotePort   := GetRemoteHostPort;
 UserName     := GetUserName;
 PassWord     := GetPassWord;
 SrcNode      := GetSrcNode;
 SPCode       := GetSPCode;
 SP_Num       := GetSPNumber;
 MTTimeOut    := GetSendTimeOut;
 SocketTimeOut:= GetRecvTimeOut;
 AutoRun      := GetAutoRun;
except
 on Exception do
  begin
   raise exception.Create('服务器某些参数未设定!');
   Exit;
  end;
end;
 if AutoRun then bStarServer.OnClick(nil);
end;

procedure TfrmSGIP.SpeedButton3Click(Sender: TObject);
begin
 n1.MenuIndex:=-1;
end;

procedure TfrmSGIP.N8Click(Sender: TObject);
var
 frmSP_SMG_Set: TfrmSP_SMG_Set;
begin
 frmSP_SMG_Set := TfrmSP_SMG_Set.Create(Self);
 frmSP_SMG_Set.ShowModal;
end;

procedure TfrmSGIP.TimeIconTimer(Sender: TObject);
begin
case RI of
 0:begin
    PaintStr(Img0);
    if RI = 0 then RI:=4
   end;
 1:PaintStr(img1);
 2:PaintStr(img2);
 3:PaintStr(img3);
 4:begin
     PaintStr(img4);
     RI := 0;
   end;
 end;
end;

procedure TfrmSGIP.bStarServerClick(Sender: TObject);
begin
try
 CurLogMsg(TRE,'本地端口号:'+IntToStr(LocatPort));
 CurLogMsg(TRE,'本地IP地址:'+LocatIPAddr);
 CurLogMsg(TRE,'远程端口号:'+IntToStr(RemotePort));
 CurLogMsg(TRE,'远程IP地址:'+RemoteIPAddr);
 CurLogMsg(TRE,'企业接入号:'+SP_Num);
 CurLogMsg(TRE,'企业代码:'+SPCode);
 CurLogMsg(TRE,'节点号:'+SrcNode);
 ServerSocket.Port:=GetRecvHostPort;
 ServerSocket.Active:=True;
 if StartApi = -1 then
   begin
    RI := 0;
    CurLogMsg(TRE,'启动API出错!请检查参数配置是否正确!');
    str.Panels[1].Text:='启动API出错!请检查参数配置是否正确!';
    ChangStr('网络连接失败...',0);
    Exit;
   end else
   begin
    RI := 1;
    CurLogMsg(TRE,'服务器启动成功!');
    str.Panels[1].Text:='服务器启动成功!';
    ChangStr('正在连机工作...',1);
   end;
 except
  on exception do
   begin
    RI := 0;
    CurLogMsg(TRE,'启动服务器时出错!');
    ChangStr('网络连接失败...',0);
   end;
  end;
end;

procedure TfrmSGIP.TreeViewChange(Sender: TObject; Node: TTreeNode);
var
 pag:Integer;
begin
 if Node.Parent.Index > -1 then
  begin
   Pag := Node.SelectedIndex-1;
   NoteBook.PageIndex:=pag;
  end;
end;

procedure TfrmSGIP.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,'网络已断开...');
          ImageList2.Draw(str.Canvas,pRect.Left+2,pRect.Top+2,0);
         end;
    1..3:begin
          TextOut(pRect.Left+24,6,'正在连机工作...');
          ImageList2.Draw(str.Canvas,pRect.Left+2,pRect.Top+2,1);
         end;
      end;
  end;
end;

procedure TfrmSGIP.bitStopServerClick(Sender: TObject);
begin
 RI := 0;
 ServerSocket.Active:=False;
 ChangStr('服务器断开连接...',0);
end;

procedure TfrmSGIP.bitMinFormClick(Sender: TObject);
begin
 Close;
end;

procedure TfrmSGIP.Timer1Timer(Sender: TObject);
begin
if BufferList.Count>0 then
 Send_Thread.Create(False);
end;

procedure TfrmSGIP.ServerSocketClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
DestroySckHandle(Socket.Handle);
str.Panels[3].Text:='客户端断开成功!';
end;

procedure TfrmSGIP.ServerSocketClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
 ErrorCode := 0;
 DestroySckHandle(Socket.Handle);
 DisonnectSck(Socket.Handle);
 str.Panels[3].Text:='客户端网络故障!';
end;

procedure TfrmSGIP.ServerSocketClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
 Buffer:array[0..4095] of Char;
 SckHandle:LongInt;
 RecvClient : TRecvClient;
begin
 Inc(RI);
 SckHandle := Socket.Handle;
 FillChar(Buffer,SizeOf(Buffer),' ');
 FillChar(RecvClient,SizeOf(RecvClient),' ');
 Socket.ReceiveBuf(Buffer,SizeOf(Buffer));
 Move(Buffer,RecvClient,SizeOf(RecvClient));
 TClientRead_Thread.Create(RecvClient,SckHandle,False);
end;

procedure TfrmSGIP.TREContextPopup(Sender: TObject; MousePos: TPoint;
  var Handled: Boolean);
begin
 Handled := True;
end;

procedure TfrmSGIP.Button1Click(Sender: TObject);
var
 SendBuffer:PSendBuffer;
 a,b:string;
 i:integer;
begin
 New(SendBuffer);
   with SendBuffer^ do
      begin
        SPNumber:=PChar(SP_Num);
        ChargeNumber:='000000000000000000000';
        User_Count:=1;
        UserNumber:=PChar('8613035338298');
        Corp_ID:=PChar(SPCode);
        Service_Type:='';
        Fee_Type:=#2;
        Fee_Value:=PChar('10');
        Given_Value:=PChar('');
        Agent_Flag:=#0;
        Mo_Flag:=#0;
        Priority:=#0;
        Expire_Time:='';
        Schedule_Time:='';
        Report_Flag:=#1;
        Tp_pid:='0';
        Tp_udhi:='0';
        Message_Coding:=#15;
        Message_Type:=#0;
        Message_Length:=160;
        a:='人民我的是我按时的2134214asfasdf@#@#!@#!@';
        Message_Content:=PChar(a);
      end;
   BufferList.Add(SendBuffer);
end;

end.

⌨️ 快捷键说明

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