登陆器

最新推荐文章于 2023-02-06 16:04:46 发布

转载最新推荐文章于 2023-02-06 16:04:46 发布 · 129 阅读

0 ·

CC 4.0 BY-SA版权

原文链接：http://www.cnblogs.com/xe2011/p/3641525.html

说明

1 将登陆器放在 D:\完美国际版本目录下

2 程序会自动创建一个快捷方式到桌面上

3 要修改 D:\完美国际版本\patcher\skin\mainuni.xml 相关链接成自己的才会有效

program 登陆器;

uses
  Windows, Forms, ShlObj, ActiveX, ComObj, SysUtils, Dialogs, Controls,
    ShellApi;

//{$APPTYPE CONSOLE}

{$R 'Console.res' 'Console.RES'}

//获得桌面路径

function GetDesktopFolder(): string;
var
  pItem: PItemIDList;
  temp: array[0..MAX_PATH] of Char;
begin
  SHGetSpecialFolderLocation(0, CSIDL_DESKTOP, pItem); //CSIDL_DESKTOP：桌面；
  FillChar(temp, MAX_PATH, #0);
  SHGetPathFromIDList(pItem, PChar(@temp));
  Result := PChar(@temp);
end;

//创建快捷方式

procedure CreateLink(Target, Args, WorkDir, ShortCutName: string);
var
  IObj: IUnknown;
  Link: IShellLink;
  IPFile: IPersistFile;
  TargetW: WideString;
begin
  IObj := CreateComObject(CLSID_ShellLink);
  Link := IObj as IShellLink;
  IPFile := IObj as IPersistFile;

  with Link do
  begin
    SetPath(PChar(Target));
    SetArguments(PChar(Args));
    SetShowCmd(SW_SHOWMINIMIZED);
    SetWorkingDirectory(PChar(WorkDir));
  end;
  TargetW := ShortCutName;
  IPFile.Save(PWChar(TargetW), False);
end;

var
  a, b,c: string;
begin
  a := ParamStr(0);

  //D:\Administrator\Desktop\Lancher\完美世界国际版.LNK
  b := GetDesktopFolder() + '\' + changeFileExt(extractFileName(a), '') + '.lnk';

  c:=ExtractFilePath(Application.ExeName) + 'patcher\patcher.exe';

  if not FileExists(c) then
  begin
      Application.MessageBox('请将登陆器放在 完美世界国际版 的目录下!','提示',MB_ICONINFORMATION);
      Application.Terminate;
  end
  else
  begin
   if not FileExists(B) then
    CreateLink(a, '', '', b);

     //调用 patcher.exe
    ShellExecute(0, 'open', PChar(c), nil, nil, SW_SHOWNORMAL);
  end;
end.