?? unit1.~pas
字號:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, inifiles,ImgList, ComCtrls, Buttons,
IdBaseComponent, IdComponent, IdRawBase, IdRawClient, IdIcmpClient,Winsock,
Menus,Registry, Sockets, CoolTrayIcon, ScktComp, IdMessage,
IdTCPConnection, IdTCPClient, IdMessageClient, IdSMTP, Psock, NMHttp;
type
TForm1 = class(TForm)
ICMP: TIdIcmpClient;
PopupMenu1: TPopupMenu;
N1: TMenuItem;
CoolTrayIcon1: TCoolTrayIcon;
ServerSocket1: TServerSocket;
ListBox1: TListBox;
Timer1: TTimer;
NMHTTP1: TNMHTTP;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure FormActivate(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
procedure ping(ip:string);
function getIPs: TStrings;
procedure ICMPReply(ASender: TComponent; const ReplyStatus: TReplyStatus);
function ActionSend(tmpstr:Tstrings):string;
procedure ReplyClient(clientip:string;myvalue:string);
function GetMsg(s:string):Tstrings;
function SendMsg(Msg:Tstrings):integer;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
var
servicestatus:integer;
servercount:integer;
serverip: array[1..10] of string;
serverport:array[1..10] of integer;
serialno:integer;
serviceip:string;
serviceport:integer;
pingstatus:integer;
fields:integer = 10;
{$R *.dfm}
function Tform1.SendMsg(Msg:Tstrings):integer;
var tmpstr,loginstr,sendstr:string;
retrycount,i:integer;
begin
Result:=0;
retrycount:=5;
i:=0;
loginstr:='www.gmcc.net/wrus/wrus002?';
sendstr:='www.gmcc.net/wsms/wsms101a?_id=1234&';
if Msg.Count<fields then
Result:=1
else
begin
//////////////////////login////////////////////////////////////
NMHTTP1.InputFileMode := FALSE;
NMHTTP1.OutputFileMode := FALSE;
NMHTTP1.ReportLevel := Status_Basic;
If Msg.strings[4]='1' then
Begin
NMHTTP1.Proxy := Msg.strings[5];
NMHTTP1.ProxyPort := strtoint(Msg.strings[6]);
End;
loginstr:=loginstr+'_logonName='+Msg.strings[2]+'&_password='+Msg.strings[3];
tmpstr:='';
while (length(tmpstr)=0) and (i<retrycount) do
begin
NMHTTP1.Get(loginstr);
tmpstr:=NMHTTP1.CookieIn;
i:=i+1;
end;
//////////////////////send////////////////////////////////////
if length(tmpstr)>0 then
begin
With NMHTTP1.HeaderInfo do
Begin
Cookie := tmpstr;
End;
sendstr:=sendstr+'sourceAddr='+Msg.strings[8]+'&message='+Msg.strings[9]+'&destinationAddr='+Msg.strings[7]+',&delay=no&smsSave=smsSave&recCount=0&recMax=2';
NMHTTP1.Get(sendstr);
Result:=0;
end
else
Result:=1;
////////////////////////////////////////////////
end;
end;
function TForm1.getIPs: TStrings;
type
TaPInAddr = Array[0..10] of PInAddr;
PaPInAddr = ^TaPInAddr;
var
phe: PHostEnt;
pptr: PaPInAddr;
Buffer: Array[0..63] of Char;
I: Integer;
GInitData: TWSAData;
begin
WSAStartup($101, GInitData);
Result:=TStringList.Create;
Result.Clear;
GetHostName(Buffer, SizeOf(Buffer));
phe := GetHostByName(buffer);
if phe = nil then
begin
Exit;
end;
pPtr := PaPInAddr(phe^.h_addr_list);
I := 0;
while pPtr^[I] <> nil do
begin
Result.Add(inet_ntoa(pptr^[I]^));
Inc(I);
end;
WSACleanup;
end;
procedure TForm1.ping(ip:string);
begin
try
ICMP.OnReply := ICMPReply;
ICMP.Host := ip ; //宿主計算機的名稱或IP地址
ICMP.ReceiveTimeout := 1000; //最大等待時間
ICMP.Ping ;
Application.ProcessMessages ;
except end;
end;
procedure TForm1.FormActivate(Sender: TObject);
var
filename:string;
myinifile:TInifile;
hostiplist:Tstrings;
i:integer;
RegF:TRegistry;
begin
RegF:=TRegistry.Create;
RegF.RootKey:=HKEY_LOCAL_MACHINE;
try
if not RegF.KeyExists('SOFTWARE\gznj\gmcchttpgateway') then
begin
RegF.CreateKey ('SOFTWARE\gznj\gmcchttpgateway');
RegF.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run',True);
RegF.WriteString('gmcchttpgateway', ExtractFilePath(paramstr(0))+'gmcc_http.exe');
end;
except
End; {try}
RegF.CloseKey;
RegF.Free;
filename:=ExtractFilePath(paramstr(0))+'server.cfg';
myinifile:=TInifile.Create(filename);
serviceip:= myinifile.readstring('service','ip','127.0.0.1');
serviceport:= myinifile.readinteger('service','port',9003);
serverip[1]:= myinifile.readstring('directory','ip','');
serverport[1]:= myinifile.readinteger('directory','port',9000);
myinifile.Destroy;
servicestatus:=1;
if length(serverip[1])=0 then
begin
servercount:=0;
end
else
begin
servercount:=1;
end;
for i:=2 to 10 do
begin
serverip[i]:='';
serverport[i]:=9000;
end;
serialno:=0;
if servercount=0 then
begin
showmessage('錯誤的配置文件server.cfg!(無法取得主目錄服務器地址)');
close;
end
else
begin
hostiplist:=getIPs;
if hostiplist.Count=0 then
begin
showmessage('本機沒有有效的網卡!');
close;
end;
for i:=0 to (hostiplist.Count - 1) do
begin
if serviceip=hostiplist.strings[i] then
begin
pingstatus:=1;
break;
end;
end;
if pingstatus=0 then
begin
showmessage('配置服務的網卡被禁用了!');
close;
end
else
begin
pingstatus:=0;
ping(serverip[1]);
if pingstatus=0 then
begin
showmessage('主目錄服務器'+serverip[1]+'沒有響應!');
close;
end
else
begin
try
ServerSocket1.Port:=serviceport;
ServerSocket1.Active:=True;
except
showmessage('無法監聽:'+serviceip+':'+inttostr(serviceport)+'!');
close;
end;
CoolTrayIcon1.Hint:='移動短信網關HTTP:正常('+inttostr(serviceport)+')';
servicestatus:=0;
//application.Minimize;
end;
end;
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action:=caFree;
if ServerSocket1.active=true then ServerSocket1.close;
end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose:=True;
end;
procedure TForm1.ICMPReply(ASender: TComponent; const ReplyStatus: TReplyStatus);
begin
if (ReplyStatus.ReplyStatusType = rsEcho) then
pingstatus:=1
else
pingstatus:=0;
end;
procedure TForm1.N1Click(Sender: TObject);
begin
close;
end;
procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
s,s1: string;
begin
s1:=trim(Socket.ReceiveText);
s:=trim(Socket.RemoteAddress)+' '+s1;
if servicestatus<>0 then
begin
if length(s1)>4 then
begin
if s1[1]+s1[2]+s1[3]+s1[4]='CMD:' then ListBox1.Items.Add(s);
end;
end
else
begin
ListBox1.Items.Add(s);
end;
end;
procedure TForm1.ReplyClient(clientip:string;myvalue:string);
var
i:integer;
begin
for i:=0 to ServerSocket1.Socket.ActiveConnections - 1 do
begin
if ServerSocket1.Socket.Connections[i].RemoteAddress=clientip then
begin
ServerSocket1.Socket.Connections[i].SendText(myvalue);
break;
end;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var i:integer;
tmpstr:Tstrings;
j:string;
begin
Timer1.Enabled:=False;
tmpstr:=TStringList.Create;
tmpstr.Clear;
ListBox1.ClearSelection;
for i:=0 to ListBox1.Items.Count-1 do
begin
if length(ListBox1.Items.Strings[i])>3 then
begin
tmpstr:=GetMsg(ListBox1.Items.Strings[i]);
j:=ActionSend(tmpstr);
ReplyClient(tmpstr.Strings[0],j);
end;
ListBox1.Selected[i]:=True;
end;
ListBox1.DeleteSelected;
Timer1.Enabled:=True;
end;
function TForm1.GetMsg(s:string):Tstrings;
var
tmpstr: string;
i,j,fields1:integer;
begin
tmpstr:='';
fields1:=fields;
i:=1;
j:=1;
Result:=TStringList.Create;
Result.Clear;
while i<=length(s) do
begin
if (Result.Count=2) and (Result.Strings[1]='CMD:') then fields1:=3;
if j<fields1 then
begin
if s[i]=' ' then
begin
Result.Add(trim(tmpstr));
tmpstr:='';
j:=j+1;
end
else
begin
tmpstr:=tmpstr+s[i];
end;
i:=i+1;
end
else
begin
tmpstr:='';
for j:=i to length(s) do tmpstr:=tmpstr+s[j];
if length(trim(tmpstr))>0 then
Result.Add(trim(tmpstr));
i:=length(s)+1;
tmpstr:='';
end;
end;
if length(tmpstr)>0 then Result.Add(tmpstr);
end;
function TForm1.ActionSend(tmpstr:Tstrings):string;
begin
Result:='1';
if tmpstr.Count>2 then
begin
if (tmpstr.Strings[1]='CMD:') and (tmpstr.count=3) then
begin
if tmpstr.Strings[2]='BUSY' then
begin
Result:=inttostr(servicestatus); //Busy
end;
if tmpstr.Strings[2]='HELO' then
begin
Result:='0';//Hello
end;
if tmpstr.Strings[2]='STOP' then
begin
servicestatus:=1;//STOP
Result:=inttostr(servicestatus);
end;
if tmpstr.Strings[2]='INFO' then
begin
Result:='INFO';//INFO
end;
if tmpstr.Strings[2]='RSRT' then
begin
servicestatus:=0;//Restart
Result:=inttostr(servicestatus);
end;
if servicestatus=1 then
CoolTrayIcon1.Hint:='移動短信網關HTTP:暫停('+inttostr(serviceport)+')';
if servicestatus=0 then
CoolTrayIcon1.Hint:='移動短信網關HTTP:正常('+inttostr(serviceport)+')';
end;
if (tmpstr.Strings[1]='MSG:') and (tmpstr.Count=fields) then
begin
if length(tmpstr.strings[7])>0 then
begin
Result:=inttostr(SendMsg(tmpstr));
end;
end;
end;
end;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -