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

📄 unit2.pas

📁 这是传奇的源代码
💻 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.

⌨️ 快捷键说明

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