?? sp_smg_dll.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 + -