unit1.pas

delphi 外挂管理器 原代码 包含delphi控件

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, OleCtrls, MSHTML_TLB, ImgList,MySqlClass,
  IdAntiFreezeBase, IdAntiFreeze, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, IdFTP,IdFTPCommon, ztvregister, ztvBase,ztvGbls,
  ztvUnRar,Shellapi, Menus,DES, WinSkinData;

const
//unRArPassword='kellen'; //解压密码
  wm_traynotify=wm_user+1000;//自定义消息
  msg1='配置文件出错,请将新的配置提交给[e-mail] ！';
  msg2='未能连接MySQL服务器,请检查服务器是否启动或本机网络故障 ！';
  msg3='缺少libMySQL.dll支持库,请与[e-mail]联系 ！';
  msg4='对不起，你还未添加任何游戏外挂类别 ！';
  msg5='对不起，没有查询到该外挂 ！';
  msg6='未能连接FTP服务器,请检查服务器是否启动或本机网络故障 ！';
  msg7='对不起，在FTP服务器没有发现该外挂 ！';

type
  TForm1 = class(TForm)
    TreeView1: TTreeView;
    StatusBar1: TStatusBar;
    Scriptlet2: TScriptlet;
    ImageList1: TImageList;
    Scriptlet1: TScriptlet;
    ProgressBar1: TProgressBar;
    IdFTP1: TIdFTP;
    IdAntiFreeze1: TIdAntiFreeze;
    UnRar1: TUnRar;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    SkinData1: TSkinData;
    procedure FormCreate(Sender: TObject);
    procedure TreeView1DblClick(Sender: TObject);
    procedure DownloadRarFile(FtpClient:TIdFTP;SourceFile,DestFile:string);
    procedure IdFTP1Work(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCount: Integer);
    procedure IdFTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCountMax: Integer);
    procedure IdFTP1WorkEnd(Sender: TObject; AWorkMode: TWorkMode);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    Procedure ExtractRarFile(Sourcefile,DestPath:String);
    procedure UnRar1Progress(Sender: TObject; ByFile, ByArchive: Byte);
    procedure UnRar1GetPassword(Sender: TObject; FileName: String;
      var Password: String; var TryAgain: Boolean);
    procedure N1Click(Sender: TObject);
  private
    { Private declarations }
    Tray_icon:TnotifyIconData; //托盘变量
    procedure wmmytrayiconcallback(var msg:tmessage); message wm_traynotify; //消息处理
    procedure LoadWaiGuaList();
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  dbhost,dbuser,dbpw,dbname:String;    //MySQL数据库信息
  ftphost,ftpuser,ftppw,ftpport:String;//FTP服务器信息
  BytesToTransfer: LongWord; //下载文件大小
implementation

{$R *.dfm}
function GetSysDir:String; //获取系统目录 C:\windows\system32
var p:Pchar;
begin
GetMem(P,255);
GetSystemDirectory(p,254);
Result := p;
Freemem(p); 
end;
function TheFile(DownFile:string):string;
var
  FileVal:string;
begin
  FileVal:=DownFile;
  repeat
    FileVal:=Copy(FileVal,Pos('/',FileVal)+1,length(FileVal));
  until Pos('/',FileVal)=0;
 TheFile:=FileVal;
end;
procedure ShowMsg(Msg:string);
begin
 showmessage(Msg);
  if Form1.IdFTP1.Connected then
   begin
      Form1.IdFTP1.Abort;
      Form1.IdFTP1.Quit;
   end;
Application.Terminate;
end;
procedure CheckStatus(); //检查启动程序的环境
begin
 //判断WaiGua目录是否存在
 if Not DirectoryExists('WaiGua') then Mkdir('WaiGua');
 //检查MySQL支持库
 if (Not FileExists(GetSysDir+'\libMySQL.dll')) then ShowMsg(msg3);
end;
Procedure CheckRarPath(Path:string); //检查并建立目录
var
dirname:string;
pos1:integer;
begin
// D:\测试文件夹\发布程序\WaiGua\传奇外挂\赤月霜枫3.0 => WaiGua\传奇外挂\赤月霜枫3.0
 dirname:= ExtractFilePath(Paramstr(0)); //取当前目录名
 Path:=StringReplace(Path,dirname,'',[rfReplaceAll]); //把当前目录名删掉
 repeat
   pos1:=pos('\',Path); // 第一个'\'字符的位置
   dirname:=Copy(Path,1,pos1-1); //取出目录名
   if DirectoryExists(dirname) then Chdir(dirname)
   else
     begin
       MkDir(dirname); //建立目录
       ChDir(dirname); //转到目录
     end;
   Path:=Copy(Path,pos1+1,length(Path)); //取下一个目录名
 until pos('\',Path)=0;
end;
//获取连接MySQL与FTP服务器的信息
procedure GetConnectInf(var dbhost,dbuser,dbpw,dbname,ftphost,ftpuser,ftppw,ftpport:String);
var
  Readcfg:Text;
  ReadVal:String;
  ReadStr: array[1..8] of String;
  i:integer;
begin
  AssignFile(Readcfg,'Config.cfg');
  Reset(Readcfg);
  Read(Readcfg,ReadVal);
  ReadVal:=DESryStrHex(ReadVal,'xushuyi');
  for i:=1 to 8 do
    begin
      ReadStr[i]:=Copy(ReadVal,1,pos(';',ReadVal)-1);
      ReadVal:=Copy(ReadVal,pos(';',ReadVal)+1,length(ReadVal));
    end;
  for i:=1 to 8 do
    if ReadStr[i]='' then ShowMsg(msg1); //显示出错信息1，退出程序 [以后加入对服务器有效的检查函数
  dbhost :=Readstr[1];
  dbuser :=ReadStr[2];
  dbpw   :=ReadStr[3];
  dbname :=ReadStr[4];
  ftphost:=ReadStr[5];
  ftpuser:=ReadStr[6];
  ftppw  :=ReadStr[7];
  ftpport:=ReadStr[8];
  CloseFile(Readcfg);
end;

procedure TForm1.LoadWaiGuaList(); //载入外挂列表
var
 MySQLCls: TMySQLClass;
 SQLString:String;
 QueryResult:integer;
 strName:string;
 myNode:TTreeNode;
 MainStr:TStringList;
 i:integer;
begin
MySQLCls:=TMySQLClass.Create(dbhost,dbuser,dbpw,dbname,3306); //连接MySQL服务器
if (Not MySQLCls.IsConnected) then ShowMsg(msg2); //显示出错信息2,退出程序
//查询主类
SQLString:='SELECT distinct MainItem FROM WaiGua';
QueryResult:=MySQLCls.Query(SQLString);
if QueryResult<=0 then ShowMsg(msg4); //未添加游戏外挂类别，退出程序

MainStr:=TStringList.Create; //保存主类列表
While not MySQLCls.IsEof do //如果上面的查询得出,记录不在数据库末端
  begin
    MainStr.Add(MySQLCls.FieldByName('MainItem'));
    MySQLCls.Next;    //移至下一条记录
  end;

for i:=0 to MainStr.Count-1 do
  begin
  //添加主类
   myNode:=TreeView1.Items.Add(Treeview1.Selected,MainStr[i]);
  //查询分类
  SQLString:='SELECT * FROM WaiGua where MainItem='+chr(39)+MainStr[i]+chr(39);
  QueryResult:=MySQLCls.Query(SQLString);
  if QueryResult<=0 then  myNode.selected:=false
  else  myNode.selected:=true;
  While not MySQLCls.IsEof do //如果上面的查询得出,记录不在数据库末端
    begin
     //添加分类
      strName:=MySQLCls.FieldByName('SubItem');
      myNode:=TreeView1.Items.AddChild(Treeview1.Selected,strName);

      myNode.ImageIndex:=2;
      myNode.StateIndex:=2;
      //选择时要判断是否存在这个外挂，否则显示其他图标
      myNode.SelectedIndex:=2;

      //移至下一条记录
     MySQLCls.Next;
    end;
  myNode.selected:=false;
  end;
 MySQLCls.Destroy; //关闭数据库连接
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
//对托盘图标进程操作
 with Tray_icon do
  begin
    cbsize:=sizeof(tnotifyicondata);
    wnd:=handle;
    uid:=1;
    uflags:=nif_message or nif_icon or nif_tip;
    ucallbackmessage:=wm_traynotify;
    //hicon:=loadicon(0,idi_winlogo);
    hicon:=Application.Icon.Handle;
    sztip:='游戏外挂管理程序 --和贵网络中心专用';
  end;
  shell_notifyicon(nim_add,@Tray_icon);
LoadWaiGuaList();  //显示外挂列表
end;
//下载压缩文件到本地
procedure TForm1.DownloadRarFile(FtpClient:TIdFTP;SourceFile,DestFile:string);
begin
  if FtpClient.Connected then
   begin
     FtpClient.Abort;
     FtpClient.Quit;
   end;
  With FtpClient do //设置好后连接FTP服务器
    Try
      Host:=ftphost;
      Port:=StrToInt(ftpport);
      Username:=ftpuser;
      Password:=ftppw;
      Connect;
      ChangeDir('/');
      TransferType:=ftASCII;
    Except
      If Not Connected then ShowMsg(msg6); //连接不上FTP，显示出错信息,退出程序
    end;
   BytesToTransfer := FtpClient.Size(SourceFile); //获取下载文件大小: /外挂程序/传奇外挂/赤月霜枫3.0.rar
   try
     FtpClient.Get(SourceFile,DestFile,true,false);
   except
     DeleteFile(DestFile); //删除出错的文件
     ShowMsg(msg7); //没有发现下载外挂，退出程序
   end;
end;
Procedure TForm1.ExtractRarFile(Sourcefile,DestPath:String); //解压函数
begin
   UnRAR1.ArchiveFile :=Sourcefile; //源文件
   UnRAR1.ArcType:=atRaR;
   UnRAR1.ConfirmOverwrites:=False;
   UnRAR1.CreateStoredDirs:=True;//自动建立目录
   UnRAR1.ExtractDir := DestPath; //目标目录
   UnRAR1.FileSpec.Clear();
   UnRAR1.FileSpec.Add('*.*');
   UnRAR1.OverwriteMode := omOverwrite;
   UnRAR1.UseStoredDirs := True;
   UnRAR1.DateAttribute := daFileDate;
   UnRAR1.RestoreFileAttr := False;
   UnRAR1.TranslateOemChar := True;
   UnRAR1.RecurseDirs := True;
   UnRAR1.VolumeName := '';
   UnRAR1.Extract(); //执行解压
   ProgressBar1.Visible:=True; //显示
   ProgressBar1.Min:=0;
   ProgressBar1.Max:=UnRAR1.FilesToExtract;
   ProgressBar1.Visible:=False;
   if FileExists(Sourcefile) then DeleteFile(Sourcefile); //解压完后删除源文件
end;
procedure TForm1.TreeView1DblClick(Sender: TObject);
var
 MySQLCls: TMySQLClass;
 SQLString:String;
 QueryResult:integer;
 SearchKey:String;
 DownFile:String;  //外挂下载路径
 UnRarFile:String;//解压文件名
 UnRArPath:String;  //解压路径
 ExeFilename:String; //执行程序名
begin
if (Treeview1.Selected.Parent.Index > -1 ) then
begin
  SearchKey:=TreeView1.Selected.Text; //将选中的文本写入查询关键值
  MySQLCls:=TMySQLClass.Create(dbhost,dbuser,dbpw,dbname,3306); //连接MySQL服务器
  if (Not MySQLCls.IsConnected) then ShowMsg(msg2); //显示出错信息2,退出程序
  //查询选中的项，在数据库中是否有此外挂
  SQLString:='SELECT DISTINCT * FROM WaiGua WHERE SubItem='+chr(39)+SearchKey+chr(39);
  QueryResult:=MySQLCls.Query(SQLString);
  if QueryResult=0 then ShowMsg(msg5); //显示出错信息没有查询到该外挂，退出程序

  While not MySQLCls.IsEof do //如果上面的查询得出结果
  begin
    if StrComp(pchar(MySQLCls.FieldByName('SubItem')),pchar(Searchkey))=0 then
       begin
        DownFile:=MySQLCls.FieldByName('DownPath');
        UnRArPath:='WaiGua\'+MySQLCls.FieldByName('MainItem')+'\'+MySQLCls.FieldByName('SubItem')+'\';
        ExeFilename:=MySQLCls.FieldByName('ExecName');
        break;
       end;
    //移至下一条记录
    MySQLCls.Next;
  end;
  MySQLCls.Destroy; //关闭数据库连接
  //显示选择的外挂
	if DownFile<>'' then
       begin
         TreeView1.Enabled:=False;
         UnRarFile:= ExtractFilePath(Paramstr(0))+TheFile(DownFile);
         UnRarPath:= ExtractFilePath(Paramstr(0))+UnRarPath;
         ExeFilename:=UnRarPath+ExeFilename;
         if (Not FileExists(ExeFilename)) then
            begin
				  DownloadRarFile(idFTP1,DownFile,ExtractFilePath(Paramstr(0))+TheFile(DownFile));  //下载所选择的外挂
              chdir(ExtractFilePath(Paramstr(0)));
              CheckRarPath(UnRarPath); //解压之前先建立目录
				  ExtractRarFile(UnRarFile,UnRarPath); //如果执行程序不存在，则解压
            end;
         if  FileExists(UnRarFile) then DeleteFile(UnRarFile); //如果解压后压缩文件仍然存在，则删除它。
        // showmessage('解压缩文件名'+UnRarFile);
         //showmessage('解压缩目录名'+UnRarPath);
         //showmessage('执行程序名'+UnRarPath+ExeFilename);
          //showmessage(TheFile(DownFile));
         //showmessage(DownFile);
         visible:=not visible;
         application.ShowMainForm:=visible;
         setforegroundwindow(application.handle);
         TreeView1.Enabled:=True;
         WinExec(pchar(ExeFilename),sw_normal); //执行程序
       end
   else ShowMsg(msg5); //显示出错信息没有查询到该外挂，退出程序
end;

end;
//当FTP下载/上传时
procedure TForm1.IdFTP1Work(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCount: Integer);
begin
ProgressBar1.Position := AWorkCount;
end;
//下载/上传开始
procedure TForm1.IdFTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCountMax: Integer);
begin
ProgressBar1.Visible:=True;
TreeView1.Selected.ImageIndex:=1;
TreeView1.Selected.StateIndex:=1;
if AWorkCountMax > 0 then ProgressBar1.Max := AWorkCountMax
else ProgressBar1.Max := BytesToTransfer;
end;
//下载/上传结束
procedure TForm1.IdFTP1WorkEnd(Sender: TObject; AWorkMode: TWorkMode);
begin
ProgressBar1.Position := 0;
ProgressBar1.Visible:=False;
//TreeView1.Enabled:=True;
TreeView1.Selected.ImageIndex:=2;
TreeView1.Selected.StateIndex:=2;
end;
procedure TForm1.UnRar1Progress(Sender: TObject; ByFile, ByArchive: Byte);
begin
ProgressBar1.Position:=UnRAR1.Count; //进度
end;

procedure TForm1.UnRar1GetPassword(Sender: TObject; FileName: String;
  var Password: String; var TryAgain: Boolean);
begin
Password:='';//解压密码
end;
//托盘消息处理
procedure TForm1.wmmytrayiconcallback(var msg:tmessage);
var
  cursorpos:tpoint;
begin
  case msg.LParam of
    wm_lbuttondown:
      begin
        visible:=not visible;
        application.ShowMainForm:=visible;
        setforegroundwindow(application.handle);
      end;
    wm_rbuttondown:
      begin
        getcursorpos(cursorpos);
        popupmenu1.Popup(cursorpos.x,cursorpos.y);
      end;
  end;
end;
procedure TForm1.N1Click(Sender: TObject);
begin
if MessageDlg('你真的要退出程序吗？', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
Close;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
//释放建立的托盘
shell_notifyicon(nim_delete,@Tray_icon);

if idFTP1.Connected then
	begin
		idFTP1.Abort;
		idFTP1.Quit;
   end;
end;

//主程序
begin
// 一系列的程序条件检查
CheckStatus();

//程序主要过程
GetConnectInf(dbhost,dbuser,dbpw,dbname,ftphost,ftpuser,ftppw,ftpport);






end.