📄 loginunit.pas

📁 传奇3.0私服登录器源码
💻 PAS
📖 第 1 页 / 共 2 页
字号:
12 下一页
unit LoginUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, WinSkinData, WinSkinForm, ExtCtrls, se_controls,
  KsSkinForms, KsSkinEngine, KsSkinButtons, KsSkinCheckBoxs, KsSkinLabels,
  KsSkinTabs, KsSkinPanels, KsSkinComboBoxs, KsSkinSpeedButtons,
  ksskinstdcontrol, DB, ADODB, GetApplicationVer,winsock,inifiles;

type
  {------------以下用来判断IP是否存在------------}
  PIPOptionInformation = ^TIPOptionInformation;
  TIPOptionInformation = packed  record
  TTL: Byte;
  TOS: Byte;
  Flags: Byte;
  OptionsSize: Byte;
  OptionsData: PChar;
  end;

  PIcmpEchoReply = ^TIcmpEchoReply;
  TIcmpEchoReply = packed record
  Address: DWORD;
  Status: DWORD;
  RTT: DWORD;
  DataSize: Word;
  Reserved: Word;
  Data: Pointer;
  Options: TIPOptionInformation;
  phe: pHostent;
  end;
  TIcmpCreateFile = function: THandle; stdcall;
  TIcmpCloseHandle = function(IcmpHandle: THandle): Boolean; stdcall;
  TIcmpSendEcho = function(IcmpHandle:THandle;
  DestinationAddress: DWORD;
  RequestData: Pointer;
  RequestSize: Word;
  RequestOptions: PIPOptionInformation;
  ReplyBuffer: Pointer;
  ReplySize: DWord;
  Timeout: DWord
  ): DWord; stdcall;

  {----------------自带---------------}
  TFrmLogin = class(TForm)
    SeSkinEngine1: TSeSkinEngine;
    FrmLogin: TSeSkinForm;
    CmbServerName: TSeSkinComboBox;
    Memo: TSeSkinMemo;
    BtnDataMgr: TSeSkinSpeedButton;
    BtnAbout: TSeSkinSpeedButton;
    BtnExit: TSeSkinSpeedButton;
    BtnLogin: TSeSkinSpeedButton;
    ADOConnection: TADOConnection;
    ADOQuery1: TADOQuery;
    EAddr: TEdit;
    Ecount: TEdit;
    Eprogram: TEdit;
    BtnTest: TSeSkinSpeedButton;
    Eversion: TEdit;
    ec1: TEdit;
    en1: TEdit;
    ec5: TEdit;
    en5: TEdit;
    ec2: TEdit;
    en2: TEdit;
    ec6: TEdit;
    en6: TEdit;
    ec3: TEdit;
    en3: TEdit;
    ec7: TEdit;
    en7: TEdit;
    ec4: TEdit;
    en4: TEdit;
    ec8: TEdit;
    en8: TEdit;
    Ver: TApplicationVer;
    procedure BtnexitClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure CmbServerNameChange(Sender: TObject);
    procedure BtnTestClick(Sender: TObject);
    procedure clear;
    procedure writeMir2;
    procedure WriteMir3;
    procedure FormActivate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure BtnLoginClick(Sender: TObject);
    procedure BtnDataMgrClick(Sender: TObject);
    procedure BtnAboutClick(Sender: TObject);
  private
    { Private declarations }
     hICMP: THANDLE;
     IcmpCreateFile : TIcmpCreateFile;
     IcmpCloseHandle: TIcmpCloseHandle;
     IcmpSendEcho: TIcmpSendEcho;
  public
    { Public declarations }
  end;

var
  FrmLogin: TFrmLogin;
  HostName:string;
  MyIniFile:TIniFile;
implementation

uses LoginMsgUnit, LoginAboutUnit;

{$R *.dfm}

procedure TFrmLogin.BtnexitClick(Sender: TObject);
begin
  close;
end;

procedure TFrmLogin.FormCreate(Sender: TObject);
begin
  self.Caption :='  传奇私服登录程序  '+ver.FileVersion ;
  clear;
  MyIniFile.Free ;
end;

procedure TFrmLogin.FormShow(Sender: TObject);
var
  DataPath:string;
begin
  try
  DataPath:=ExtractFilePath(Application.ExeName)+'ServerData\ServerData.mdb';
  {登录加密的数据库}
  ADOConnection.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+DataPath+';Persist Security Info=False;;Jet OLEDB:Database Password=◇入侵◇;';
  ADOConnection.Open();
  except
    frmloginmsg.Caption :='错误提示';
    frmloginmsg.LblMsg.Caption :='    数据库连接错误，请确认数据库'+#13+datapath+#13+'是否存在！';
    frmloginmsg.ShowModal ;
    close;
  end;
  ADOQuery1.SQL.Clear ;
  ADOQuery1.Close ;
  ADOQuery1.SQL.Text :='select * from MirServer';
  ADOQuery1.Open;
  CmbServerName.Clear ;
  ADOQuery1.First;
  while not ADOQuery1.Eof do
    begin
      CmbServerName.Items.Add(ADOQuery1.FieldValues['name']);
      CmbServerName.Refresh ;
      ADOQuery1.Next;
    end;
  ADOQuery1.Close ;
end;

procedure TFrmLogin.CmbServerNameChange(Sender: TObject);
var i:integer;
begin
  ADOQuery1.SQL.Clear ;
  ADOQuery1.Close ;
  ADOQuery1.SQL.Text :='select * from MirServer where name='+'"'+CmbServerName.text+'"';
  ADOQuery1.Open;
  ADOQuery1.First;
  if CmbServerName.Text ='' then exit;
  Clear ;
  try
  memo.Lines.Add('该服务器的游戏版本：'+ADOQuery1.FieldValues['version']);
  Memo.Lines.Add(ADOQuery1.FieldValues['memo']);
  Ecount.Text :=ADOQuery1.FieldValues['Serverconut'];
  EAddr.Text :=ADOQuery1.FieldValues['Serveraddr'];
  eprogram.Text :=ADOQuery1.FieldValues['program'];
  eversion.Text :=ADOQuery1.FieldValues['version'];
  ec1.Text :=ADOQuery1.FieldValues['Server1caption'];
  en1.Text :=ADOQuery1.FieldValues['Server1name'];
  ec2.Text :=ADOQuery1.FieldValues['Server2caption'];
  en2.Text :=ADOQuery1.FieldValues['Server2name'];
  ec3.Text :=ADOQuery1.FieldValues['Server3caption'];
  en3.Text :=ADOQuery1.FieldValues['Server3name'];
  ec4.Text :=ADOQuery1.FieldValues['Server4caption'];
  en4.Text :=ADOQuery1.FieldValues['Server4name'];
  ec5.Text :=ADOQuery1.FieldValues['Server5caption'];
  en5.Text :=ADOQuery1.FieldValues['Server5name'];
  ec6.Text :=ADOQuery1.FieldValues['Server6caption'];
  en6.Text :=ADOQuery1.FieldValues['Server6name'];
  ec7.Text :=ADOQuery1.FieldValues['Server7caption'];
  en7.Text :=ADOQuery1.FieldValues['Server7name'];
  ec8.Text :=ADOQuery1.FieldValues['Server8caption'];
  en8.Text :=ADOQuery1.FieldValues['Server8name'];
  except
  end;
  ADOQuery1.Next;
  ADOQuery1.Close ;
  if Eversion.Text ='2' then writeMir2 else WriteMir3;
end;

procedure TFrmLogin.clear;
begin
  memo.Clear ;
  ecount.Clear ;
  eaddr.Clear ;
  eprogram.Clear ;
  eversion.Clear ;
  ec1.Clear;
  en1.Clear ;
  ec2.Clear;
  en2.Clear ;
  ec3.Clear;
  en3.Clear ;
  ec4.Clear;
  en4.Clear ;
  ec5.Clear;
  en5.Clear ;
  ec6.Clear;
  en6.Clear ;
  ec7.Clear;
  en7.Clear ;
  ec8.Clear;
  en8.Clear ;
end;

function testip(IP:string):string;
begin

end;

procedure TFrmLogin.BtnTestClick(Sender: TObject);
var
   IPOpt:TIPOptionInformation;  // IP Options for packet to send
   FIPAddress:DWORD;
   pReqData,pRevData:PChar;
   pIPE:PIcmpEchoReply;  // ICMP Echo reply buffer   
   FSize: DWORD;
   MyString:string;
   FTimeOut:DWORD;
   BufferSize:DWORD;

   WSAData: TWSAData;
  hICMPdll: HMODULE;

begin
  wsastartup($101,wsadata);
  hICMPdll := LoadLibrary('icmp.dll');
  @ICMPCreateFile := GetProcAddress(hICMPdll, 'IcmpCreateFile');
  @IcmpCloseHandle := GetProcAddress(hICMPdll, 'IcmpCloseHandle');
  @IcmpSendEcho := GetProcAddress(hICMPdll, 'IcmpSendEcho');
  hICMP := IcmpCreateFile;

  if Eaddr.Text <> '' then
   begin
     FIPAddress := inet_addr(PChar(Eaddr.Text));
     FSize := 40;
     BufferSize := SizeOf(TICMPEchoReply) + FSize;
     GetMem(pRevData,FSize);
     GetMem(pIPE,BufferSize);
     FillChar(pIPE^, SizeOf(pIPE^), 0);
     pIPE^.Data := pRevData;
     MyString := 'Hello,World';
     pReqData := PChar(MyString);
     FillChar(IPOpt, Sizeof(IPOpt), 0);
     IPOpt.TTL := 64;
     FTimeOut := 4000;
     IcmpSendEcho(hICMP, FIPAddress, pReqData, Length(MyString), @IPOpt, pIPE, BufferSize, FTimeOut);
      try
       if pReqData^ = pIPE^.Options.OptionsData^ then
           begin
             frmloginmsg.Caption:='IP测试结果';
             frmloginmsg.LblMsg.Caption :='    服务器: '+eaddr.Text  +' 提供正常服务!';
             frmloginmsg.ShowModal;
           end;
        except
             frmloginmsg.Caption:='IP测试结果';
             frmloginmsg.LblMsg.Caption :='    服务器: '+eaddr.Text  +' 己经关闭或你的计算机没有处于联网状态！';
             frmloginmsg.ShowModal;
        end;
{     pIPE^.Phe := GetHostByAddr(@FIPAddress, 4, AF_INET);
     if pIPE^.Phe <> Nil   then HostName:=pIPE^.Phe^.h_name;      }
     FreeMem(pRevData);
     FreeMem(pIPE);
    end;

end;

procedure TFrmLogin.FormActivate(Sender: TObject);
var
  FileName:string;
begin
  FileName:=extractfilepath(Paramstr(0))+'Login.ini';
  MyIniFile:=TInifile.Create(FileName);
  CmbServerName.ItemIndex :=MyIniFile.ReadInteger('setup','LastGroup',0);
end;

procedure TFrmLogin.FormClose(Sender: TObject; var Action: TCloseAction);
var
  FileName:string;
begin
  FileName:=extractfilepath(Paramstr(0))+'Login.ini';
  MyIniFile:=TInifile.Create(FileName);
  MyIniFile.WriteInteger ('setup','LastGroup',CmbServerName.ItemIndex);
  MyiniFile.Free ;
  deletefile('mir.ini');
  deletefile('ftp.ini');
  deletefile('mirsetup.ini');
end;

procedure TFrmLogin.BtnLoginClick(Sender: TObject);
var
  MirExeFile:string;
begin
    {--------执行游戏的启动程序--------}
  MirExeFile:=EProgram.Text ;
    if FileExists(MirExeFile) then
    begin
      winexec(PChar(MirExeFile),SW_SHOW);
//      ShellExecute(handle,'open',PChar(MirExeFile),'-s','',SW_SHOWNORMAL);
      exit;
    end;
    frmloginmsg.Caption :='错误提示';
    frmloginmsg.LblMsg.Caption :='    没有找到 '+ MirExeFile +' 文件，请确认该文件是否存在或是否与本程序在一个目录中！如果不是，请将本程序（及相关文件）复制到游戏安装目录中！';
    FrmLoginMsg.ShowModal;
end;

procedure TFrmLogin.writeMir2;
{此过程是与 the legend of mir2 的相关的 ini 文件}
Var
  FtpFile,MirFile,MirSetupFile,MirExeFile:string;
  AFtpFile,AMirFile,AMirSetupFile:TIniFile;
begin
  FtpFile:=ExtractFilePath(Paramstr(0))+'ftp.ini';
  AFtpFile:=Tinifile.Create(FtpFile);

  MirFile:=ExtractFilePath(Paramstr(0))+'Mir.ini';
  AMirFile:=Tinifile.Create(MirFile);
  
  MirSetupFile:=ExtractFilePath(Paramstr(0))+'mirsetup.ini';
  AMirSetupFile:=Tinifile.Create(MirSetupFile);

  {-------向 ftp.ini 中写入信息-------}
  AFtpFile.WriteString('Setup','Site',EAddr.Text);
  AFtpFile.WriteString('Setup','port','21');    //固定数据
  AFtpFile.WriteString('Setup','userid','');    //固定数据
  AFtpFile.WriteString('Setup','passwd','');    //固定数据
  AFtpFile.WriteString('Setup','basedir','mir2path');    //固定数据
  AFtpFile.WriteString('Setup','listfile','!plist.txt');  //固定数据
12 下一页
💿 文件大小 667 K
👤 上传用户 zh64077118
📂 所属分类 Delphi控件源码
🏷️ 相关标签

#3.0 #源码
⌨️ 快捷键说明

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