www.pudn.com > 逍遥天下传奇4F登陆精灵源代码D6.rar > Unit2.pas

unit Unit2; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, XP_Button, StdCtrls, XP_Form, IdBaseComponent, IdComponent, 
  IdTCPConnection, IdTCPClient, OleCtrls, ShockwaveFlashObjects_TLB, 
  TFlatEditUnit, TFlatSpinEditUnit, TFlatTabControlUnit, TFlatComboBoxUnit, 
  TFlatGroupBoxUnit, XP_GroupBox, TFlatButtonUnit, inifiles, Winsock, Psock, ComCtrls, 
  ScktComp, XP_RadioBox, NMHttp; 
 
type 
  TForm1 = class(TForm) 
    XP_Form1: TXP_Form; 
    Label1: TLabel; 
    XP_Button1: TXP_Button; 
    Label3: TLabel; 
    Label4: TLabel; 
    Label2: TLabel; 
    FlatEdit1: TFlatEdit; 
    FlatSpinEditInteger1: TFlatSpinEditInteger; 
    XP_GroupBox1: TXP_GroupBox; 
    FlatComboBox1: TFlatComboBox; 
    XP_Button2: TXP_Button; 
    XP_GroupBox2: TXP_GroupBox; 
    FlatEdit2: TFlatEdit; 
    XP_Button3: TXP_Button; 
    XP_Button4: TXP_Button; 
    Label5: TLabel; 
    Memo1: TMemo; 
    Memo2: TMemo; 
    ShockwaveFlash1: TShockwaveFlash; 
    ClientSocket1: TClientSocket; 
    ServerSocket1: TServerSocket; 
    XP_RadioBox1: TXP_RadioBox; 
    XP_RadioBox2: TXP_RadioBox; 
    ClientSocket2: TClientSocket; 
    ServerSocket2: TServerSocket; 
    ClientSocket3: TClientSocket; 
    ServerSocket3: TServerSocket; 
    NMHTTP1: TNMHTTP; 
    procedure XP_Button1Click(Sender: TObject); 
    procedure FormCreate(Sender: TObject); 
    procedure XP_Button3Click(Sender: TObject); 
    procedure XP_Button4Click(Sender: TObject); 
    procedure XP_Button2Click(Sender: TObject); 
    procedure ServerSocket1ClientRead(Sender: TObject; 
      Socket: TCustomWinSocket); 
    procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket); 
    procedure ServerSocket1Accept(Sender: TObject; 
      Socket: TCustomWinSocket); 
    procedure FlatComboBox1Change(Sender: TObject); 
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); 
    procedure ServerSocket1ClientDisconnect(Sender: TObject; 
      Socket: TCustomWinSocket); 
    procedure ClientSocket2Read(Sender: TObject; Socket: TCustomWinSocket); 
    procedure ServerSocket2Accept(Sender: TObject; 
      Socket: TCustomWinSocket); 
    procedure ServerSocket2ClientRead(Sender: TObject; 
      Socket: TCustomWinSocket); 
    procedure ServerSocket2ClientDisconnect(Sender: TObject; 
      Socket: TCustomWinSocket); 
    procedure ClientSocket3Read(Sender: TObject; Socket: TCustomWinSocket); 
    procedure ServerSocket3Accept(Sender: TObject; 
      Socket: TCustomWinSocket); 
    procedure ServerSocket3ClientRead(Sender: TObject; 
      Socket: TCustomWinSocket); 
    procedure ServerSocket3ClientDisconnect(Sender: TObject; 
      Socket: TCustomWinSocket); 
  private 
    { Private declarations } 
  public 
    { Public declarations } 
  end; 
 
var 
  Form1: TForm1; 
  IP:String; 
  Err:Integer; 
  WSAData:TWSAData; 
  SearchRec: TSearchRec; 
  TempString:array[0..79] of char; 
  server:string; 
  serverport:integer; 
  port:integer; 
  PublicHost:string; 
  Host:pHostent; 
  myinifile:Tinifile; 
  filename:string; 
  cmd1:string; 
  pcmd1:pchar; 
  ret1:word; 
  Mutex:THandle; 
implementation 
{$R *.dfm} 
{$R se.res} 
{$R ld.res} 
 
procedure TForm1.XP_Button1Click(Sender: TObject); 
begin 
try 
server:=flatedit1.Text; 
port:=flatspineditinteger1.Value; 
xp_button1.Enabled:=false; 
nmhttp1.Host:=server; 
nmhttp1.port:=port; 
nmhttp1.TimeOut:=1500; 
label2.Caption:='正在检测服务器状态，请稍后...'; 
nmhttp1.Connect; 
if (nmhttp1.Connected=true) then 
begin 
nmhttp1.Disconnect; 
label2.Caption:='传奇登陆服务器正常开放'; 
xp_button1.Enabled:=true; 
end 
except 
label2.Caption:='服务器已经关闭'; 
xp_button1.Enabled:=true; 
end 
end; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
Mutex:=CreateMutex(NIL,true,'传奇私人服务器登陆器（支持域名解析）'); 
if WaitForSingleObject(Mutex, 0) <> Wait_Timeout then 
BEGIN 
xp_radiobox2.Checked:=true; 
serversocket1.Port:=6999; 
serversocket1.Open; 
serversocket2.Port:=7100; 
serversocket2.Open; 
serversocket3.Port:=7200; 
serversocket3.Open; 
Filename:=ExtractFilePath(Paramstr(0))+'serverlist.ini'; 
myinifile:=Tinifile.Create(filename); 
myinifile.readsections(flatComboBox1.Items); 
flatcombobox1.ItemIndex:=0; 
end 
else 
xp_button2.Enabled:=false; 
end; 
 
procedure TForm1.XP_Button3Click(Sender: TObject); 
begin 
if flatedit2.text='' then 
begin 
application.messagebox('您没有输入服务器的名称!','错误',MB_ICONEXCLAMATION+MB_OK); 
exit; 
end 
else 
myinifile.writestring(flatedit2.Text,'ServerName',flatedit2.Text); 
myinifile.writestring(flatedit2.Text,'ServerAdd',flatedit1.Text); 
myinifile.writeinteger(flatedit2.Text,'ServerPort',flatspineditinteger1.Value); 
myinifile.readsections(flatComboBox1.Items); 
flatedit1.Clear; 
flatedit2.Clear; 
flatComboBox1.ItemIndex:=0; 
end; 
 
procedure TForm1.XP_Button4Click(Sender: TObject); 
begin 
if flatComboBox1.ItemIndex=-1 then 
begin 
label2.Caption:='请选择一个服务器进行删除'; 
exit; 
end 
else 
myinifile.EraseSection(flatComboBox1.Text); 
myinifile.readsections(flatComboBox1.Items); 
flatComboBox1.ItemIndex:=0; 
end; 
 
procedure TForm1.XP_Button2Click(Sender: TObject); 
var 
servername:string; 
Res : TResourceStream; 
begin 
if flatComboBox1.ItemIndex=-1 then 
begin 
label2.Caption:='请选择一个服务器登陆'; 
exit; 
end 
else 
PublicHost:=myinifile.Readstring(flatCombobox1.Text,'ServerAdd','61.139.55.69'); 
servername:=myinifile.Readstring(flatCombobox1.Text,'ServerName','逍遥天下'); 
serverport:=myinifile.Readinteger(flatCombobox1.Text,'ServerPort',7000); 
label2.caption:='正在连接'+servername+'服务器...'; 
try 
host:=GetHostByName(Pchar(PublicHost)); 
except 
err:=wsagetlasterror(); 
label1.caption:='error code:'+inttostr(err); 
exit; 
end; 
if host=NIL then 
begin 
label2.caption:='服务器地址解析失败!请稍候登陆!'; 
exit; 
end; 
label2.Caption:=servername+'信息解析成功，正在登陆...'; 
ip:=copy(host.h_addr^,0,4); 
label5.Caption:= 
format('%d.%d.%d.%d', 
[ord(ip[1]), 
ord(ip[2]), 
ord(ip[3]), 
ord(ip[4])]); 
if xp_radiobox2.Checked=true then 
begin 
try 
Res := TResourceStream.Create(Hinstance, 'CLI', Pchar('EXEFILE')); Res.SavetoFile('client.exe'); 
Res.Free; 
Memo1.Lines.Delete(2); 
Memo1.Lines.Insert(2,'server1caption='+servername); 
Memo1.Lines.Delete(3); 
Memo1.Lines.Insert(3,'server1name='+servername); 
Memo1.Lines.SaveToFile('ftp.ini'); 
Memo2.Lines.Delete(1); 
Memo2.Lines.Insert(1,'FontName='+'Microsoft Sans Serif'); 
Memo2.Lines.Delete(2); 
Memo2.Lines.Insert(2,'ServerAddr=127.0.0.1'); 
Memo2.Lines.SaveToFile('map\8.map'); 
cmd1:='client.exe'; 
getmem(pcmd1,length(cmd1)+1); 
strpcopy(pcmd1,cmd1); 
ret1:=winexec(pcmd1,SW_SHOWNORMAL); 
exit; 
Except 
application.messagebox('不能创建配置文件，请检查文件是否在使用','创建失败',MB_ICONEXCLAMATION+MB_OK); 
end; 
end 
else 
try 
Res := TResourceStream.Create(Hinstance, 'LDC', Pchar('EXEFILE')); Res.SavetoFile('ldclient.exe'); 
Res.Free; 
Memo1.Lines.Delete(2); 
Memo1.Lines.Insert(2,'server1caption='+servername); 
Memo1.Lines.Delete(3); 
Memo1.Lines.Insert(3,'server1name='+servername); 
Memo1.Lines.SaveToFile('ftp.ini'); 
Memo2.Lines.Delete(1); 
Memo2.Lines.Insert(1,'FontName='+'Microsoft Sans Serif'); 
Memo2.Lines.Delete(2); 
Memo2.Lines.Insert(2,'ServerAddr=127.0.0.1'); 
Memo2.Lines.SaveToFile('map\8.map'); 
cmd1:='ldclient.exe'; 
getmem(pcmd1,length(cmd1)+1); 
strpcopy(pcmd1,cmd1); 
ret1:=winexec(pcmd1,SW_SHOWNORMAL); 
exit; 
Except 
application.messagebox('不能创建配置文件，请检查文件是否在使用','创建失败',MB_ICONEXCLAMATION+MB_OK); 
end; 
end; 
 
procedure TForm1.ClientSocket1Read(Sender: TObject; 
  Socket: TCustomWinSocket); 
begin 
ServerSocket1.socket.connections[0].sendtext(Socket.ReceiveText); 
end; 
 
procedure TForm1.ServerSocket1ClientRead(Sender: TObject; 
  Socket: TCustomWinSocket); 
begin 
clientsocket1.Address:=label5.Caption; 
clientsocket1.Port:=serverport; 
clientsocket1.Active:=true; 
clientsocket1.Socket.SendText(socket.ReceiveText); 
end; 
 
procedure TForm1.ServerSocket1Accept(Sender: TObject; 
  Socket: TCustomWinSocket); 
begin 
clientsocket1.Address:=label5.Caption; 
clientsocket1.Port:=serverport; 
clientsocket1.Active:=true; 
clientsocket1.Socket.SendText(socket.ReceiveText); 
end; 
 
procedure TForm1.FlatComboBox1Change(Sender: TObject); 
begin 
try 
xp_button2.Enabled:=false; 
PublicHost:=myinifile.Readstring(flatCombobox1.Text,'ServerAdd','61.139.55.69'); 
serverport:=myinifile.Readinteger(flatCombobox1.Text,'ServerPort',7000); 
nmhttp1.Host:=PublicHost; 
nmhttp1.port:=serverport; 
nmhttp1.TimeOut:=1500; 
label2.Caption:='正在检测服务器状态，请稍后...'; 
nmhttp1.Connect; 
if (nmhttp1.Connected=true) then 
begin 
nmhttp1.Disconnect; 
label2.Caption:='传奇登陆服务器正常开放'; 
label2.Caption:='服务器开启，正常提供服务'; 
xp_button2.Enabled:=true; 
end 
except 
label2.Caption:='服务器已经关闭'; 
Xp_button2.Enabled:=false; 
end 
end; 
 
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean); 
begin 
DeleteFile('map\8.map'); 
DeleteFile('ftp.ini'); 
DeleteFile('client.exe'); 
DeleteFile('ldclient.exe'); 
end; 
 
procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject; 
  Socket: TCustomWinSocket); 
begin 
clientsocket1.Active:=false; 
end; 
 
 
 
 
procedure TForm1.ClientSocket2Read(Sender: TObject; 
  Socket: TCustomWinSocket); 
begin 
ServerSocket2.socket.connections[0].sendtext(Socket.ReceiveText); 
end; 
 
procedure TForm1.ServerSocket2ClientRead(Sender: TObject; 
  Socket: TCustomWinSocket); 
begin 
clientsocket2.Address:=label5.Caption; 
clientsocket2.Port:=7130; 
clientsocket2.Active:=true; 
clientsocket2.Socket.SendText(socket.ReceiveText); 
end; 
 
procedure TForm1.ServerSocket2Accept(Sender: TObject; 
  Socket: TCustomWinSocket); 
begin 
clientsocket2.Address:=label5.Caption; 
clientsocket2.Port:=7130; 
clientsocket2.Active:=true; 
clientsocket2.Socket.SendText(socket.ReceiveText); 
end; 
 
procedure TForm1.ServerSocket2ClientDisconnect(Sender: TObject; 
  Socket: TCustomWinSocket); 
begin 
clientsocket2.Active:=false; 
end; 
procedure TForm1.ClientSocket3Read(Sender: TObject; 
  Socket: TCustomWinSocket); 
begin 
ServerSocket3.socket.connections[0].sendtext(Socket.ReceiveText); 
end; 
procedure TForm1.ServerSocket3ClientRead(Sender: TObject; 
  Socket: TCustomWinSocket); 
begin 
clientsocket3.Address:=label5.Caption; 
clientsocket3.Port:=7230; 
clientsocket3.Active:=true; 
clientsocket3.Socket.SendText(socket.ReceiveText); 
end; 
 
procedure TForm1.ServerSocket3Accept(Sender: TObject; 
  Socket: TCustomWinSocket); 
begin 
clientsocket3.Address:=label5.Caption; 
clientsocket3.Port:=7230; 
clientsocket3.Active:=true; 
clientsocket3.Socket.SendText(socket.ReceiveText); 
end; 
 
procedure TForm1.ServerSocket3ClientDisconnect(Sender: TObject; 
  Socket: TCustomWinSocket); 
begin 
clientsocket3.Active:=false; 
end; 
 
end.