论坛风格切换切换到宽版
  • 10066阅读
  • 36回复

请教老虎版主通过附加任务屏蔽hosts问题 [复制链接]

上一主题 下一主题
离线gnatix

发帖
7696
金钱
-8279
威望
-828
只看该作者 20 发表于: 2015-08-23
关于写入 hosts 的问题,我理解你的意思。比较简单的办法是在每个项目后面的注释里面增加一个计数。

用 ANSI 版本制作的中英双语安装程序,在中英两种语言之外的语言下运行,比如德语,应该是不会有乱码的,如果默认界面语言是英语的话。这里就要求你严格遵守多语言安装程序的一般规则,把所有文本信息定义在 [CustomMessages] 段,不要在 Code 段直接写中文文字信息。这个我之前已经多次提醒你了。
离线546242502

发帖
332
金钱
-3060
威望
-306
只看该作者 21 发表于: 2015-08-23
回 20楼(gnatix) 的帖子
gnatix:关于写入 hosts 的问题,我理解你的意思。比较简单的办法是在每个项目后面的注释里面增加一个计数。用 ANSI 版本制作的中英双语安装程序,在中英两种语言之外的语言下运行,比如德语,应该 .. (2015-08-23 00:09) 

老虎版主顺便可以更新一下屏蔽 hosts 的代码么?

先前想用 Unicode 版本做中英文安装程序,主要是看到论坛里一些解答说 Unicode 版本制作的安装程序不会造成在其它语言的系统乱码.;
离线gnatix

发帖
7696
金钱
-8279
威望
-828
只看该作者 22 发表于: 2015-08-23
对于一个不懂中文的人来说,正确显示的汉字在他眼里和乱码可能没有区别。不过现在用 Win 9x 系统的应该没有了,所以用 Unicode 版本是正确的选择。
离线546242502

发帖
332
金钱
-3060
威望
-306
只看该作者 23 发表于: 2015-08-23
回 22楼(gnatix) 的帖子
对于一个不懂中文的人来说,正确显示的汉字在他眼里和乱码可能没有区别。

恩,确实
离线gnatix

发帖
7696
金钱
-8279
威望
-828
只看该作者 24 发表于: 2015-08-24
下面的代码进行了改进,增加了计数功能,也能正确处理别人已经添加了的同样项目。

#define AppID "FDBDCE28-5522-494B-B75A-E515082A312D"

#ifdef UNICODE
  #define A "W"
#else
  #define A "A"
#endif

[Setup]
AppId={#AppID}
AppName=My Program
AppVerName=My Program version 1.5
DefaultDirName={pf}\My Program
DefaultGroupName=My Program

[Tasks]
Name: noad; Description: "通过 hosts 屏蔽广告(&D)"

[code]
const
  myMark = 'XYZ123';   // 你的标识,用于标识你修改的内容

var
  AddHostsItemList, AddHostsCommentList, RemoveHostsList: TStringList;

function GetFileAttributes(lpFileName: String): Cardinal;
  external 'GetFileAttributes{#A}@kernel32.dll stdcall';

function SetFileAttributes(lpFileName: String; dwFileAttributes: Cardinal): Boolean;
  external 'SetFileAttributes{#A}@kernel32.dll stdcall';

function IsLineInFile(sItem: string; sl: TStringList; var LineNo, Cnt: LongInt): Boolean;
var
  s: String;
  n: Integer;
begin
  Result := false;
  LineNo := 0;          // 行号
  Cnt := 0;             // 计数器
  for n:= 0 to sl.Count-1 do
    if Pos(sItem, Trim(sl.Strings[n])) = 1 then
      begin
        Result := true;
        LineNo := n + 1;
        s := Trim(sl.Strings[n]);
        if Pos('##', s) > 0 then
          begin
            Delete(s, 1, Pos('##', s)+1);
            if Pos(' ', s) > 0 then
              s := Copy(s, 1, Pos(' ', s)-1);
            Cnt := StrToIntDef(s, 0);
          end;
        exit;
      end;
end;

procedure StartAddHosts();
begin
  AddHostsItemList := TStringList.Create;
  AddHostsCommentList := TStringList.Create;
end;

procedure AddHosts(newItem, comments: string);
begin
  AddHostsItemList.Add(newItem);
  AddHostsCommentList.Add(comments);
end;

procedure EndAddHosts();
var
  stl: TStringList;
  fs: TFileStream;
  OldFileAttribute: Cardinal;
  hfPath, newItem, comments, s: string;
  LineNo, Cnt, n: LongInt;
begin
  hfPath := ExpandConstant('{sys}\drivers\etc\hosts');
  OldFileAttribute := GetFileAttributes(hfPath);
  SetFileAttributes(hfPath, FILE_ATTRIBUTE_NORMAL);
  stl := TStringList.Create;
  stl.LoadFromFile(hfPath);
  try
    for n:= 0 to AddHostsItemList.Count-1 do
      begin
        newItem := AddHostsItemList.Strings[n];
        comments := AddHostsCommentList.Strings[n];
        if IsLineInFile(newItem, stl, LineNo, Cnt) then          // 检查 Hosts 中是否有该项
          begin
            s := stl.Strings[LineNo-1];
            if Cnt = 0 then
              StringChangeEx(s, newItem, newItem + ' ##2', true)   // 如果有项目,但是没有计数,说明是别人已经添加的项目,计数从 2 开始
            else
              StringChangeEx(s, newItem + ' ##' + IntToStr(Cnt), newItem + ' ##' + IntToStr(Cnt+1), true);  // 计数加 1
            stl.Strings[LineNo-1] := s;
          end
        else
          begin                                          // Hosts 中还没有该项
            s := newItem + ' ##1 ID' + myMark;           // 计数从 1 开始,ID标识     计数形式: ##x
            if Trim(comments) > '' then                  // 检查注释是否为空白
              s := s + ' / ' + Trim(comments);
            stl.Add(s);
          end;
        end;
    finally
      AddHostsItemList.Free;
      AddHostsCommentList.Free;
    end;
  fs := TFileStream.Create(hfPath, fmCreate);
  try
    stl.SaveToStream(fs);
    fs.Size := fs.Size - Length(#13#10);         // 删除最后的换行符
  finally
    stl.Free;
    fs.Free;
  end;
  SetFileAttributes(hfPath, OldFileAttribute);
end;

procedure StartRemoveHosts();
begin
  RemoveHostsList := TStringList.Create;
end;

procedure RemoveHosts(sItem: string);
begin
  RemoveHostsList.Add(sItem);
end;

procedure EndRemoveHosts();
var
  OldFileAttribute: Cardinal;
  hfPath, sItem, s: string;
  stl: TStringList;
  fs: TFileStream;
  LineNo, Cnt, n: LongInt;
begin
  hfPath := ExpandConstant('{sys}\drivers\etc\hosts');
  OldFileAttribute := GetFileAttributes(hfPath);
  SetFileAttributes(hfPath, FILE_ATTRIBUTE_NORMAL);
  stl := TStringList.Create;
  stl.LoadFromFile(hfPath);
  try
    for n:= 0 to RemoveHostsList.Count-1 do
      begin
        sItem := RemoveHostsList.Strings[n];
        if IsLineInFile(sItem, stl, LineNo, Cnt) then     // 检查 Hosts 中是否有该项
          if Cnt > 0 then
            begin
              if Cnt = 1 then
                stl.Delete(LineNo-1)                      // 计数是 1 的项将被删除
              else
                begin
                  s := stl.Strings[LineNo-1];
                  if (Cnt = 2) and (Pos('ID'+myMark, s) = 0) then     // 如果计数是 2,但是没有标识,说明是别人添加的项,将恢复原状
                    StringChangeEx(s, sItem + ' ##2', sItem, true)
                  else
                    StringChangeEx(s, sItem + ' ##' + IntToStr(Cnt), sItem + ' ##' + IntToStr(Cnt-1), true);   // 计数减 1
                  stl.Strings[LineNo-1] := s;
                end;
            end;
        end;
  finally
    RemoveHostsList.Free;
  end;
  fs := TFileStream.Create(hfPath, fmCreate);
  try
    stl.SaveToStream(fs);
    fs.Size := fs.Size - Length(#13#10);    // 删除最后的换行符
  finally
    stl.Free;
    fs.Free;
  end;
  SetFileAttributes(hfPath, OldFileAttribute);
end;

function GetHKLM: Integer;
begin
  if IsWin64 then
    Result := HKLM32
  else
    Result := HKLM;
end;

function WasTaskSelected(aTask, AppID: String): boolean;
var
  sSelectedTasks, sTask: String;
begin
  Result := false;
  sSelectedTasks := '';
  if RegQueryStringValue(getHKLM, 'Software\Microsoft\Windows\CurrentVersion\Uninstall\'+AppID+'_is1',
        'Inno Setup: Selected Tasks', sSelectedTasks) then
    begin
      sSelectedTasks := Uppercase(sSelectedTasks);
      sTask := Uppercase(aTask);
      if Pos(',', sSelectedTasks) = 0 then
        Result := sSelectedTasks = sTask
      else
        begin
          if Pos(sTask+',', sSelectedTasks) = 1 then
            Result := true;
          if Pos(','+sTask+',', sSelectedTasks) > 0 then
            Result := true;
          if Pos(','+sTask, sSelectedTasks) = Length(sSelectedTasks) - Length(sTask) then
            Result := true;
        end;
    end;
end;

procedure CurStepChanged(CurStep: TSetupStep );
begin
  if CurStep = ssPostInstall then         // 安装文件前检查
    if IsTaskSelected('noad') then        // 是否选择了相应的任务
      begin
        WizardForm.StatusLabel.Caption := '正在添加 Hosts ...';
        StartAddHosts;                                        // 开始添加项目(必需)
        AddHosts('127.0.0.1 www.abcd.com', '你的注释');       // 添加要增加的项目,带注释
        AddHosts('127.0.0.1 www.abcd.net', '');               // 添加要增加的项目,不带注释
        EndAddHosts;                                          // 结束添加项目(必需)
      end;
end;

procedure CurUninstallStepChanged(CurUninstallStep: TUninstallStep );
begin          
  if CurUninstallStep = usUninstall then           // 卸载文件前检查
    if WasTaskSelected('noad', '{#AppID}') then    // 安装时是否选择了相应的任务
      begin
        StartRemoveHosts;                             // 开始删除项目(必需)
        RemoveHosts('127.0.0.1 www.abcd.com');        // 添加要删除的项目
        RemoveHosts('127.0.0.1 www.abcd.net');        // 添加要删除的项目
        EndRemoveHosts;                               // 结束删除项目(必需)
      end;
end;
离线546242502

发帖
332
金钱
-3060
威望
-306
只看该作者 25 发表于: 2015-08-24
回 24楼(gnatix) 的帖子
gnatix:下面的代码进行了改进,增加了计数功能,也能正确处理别人已经添加了的同样项目。#define AppID "FDBDCE28-5522-494B-B75A-E515082A312D"#ifdef UNICODE....... (2015-08-24 03:41) 

谢谢老虎版主修改,又进一步完善了
离线gnatix

发帖
7696
金钱
-8279
威望
-828
只看该作者 26 发表于: 2015-08-24
代码刚才又优化了一下,解决了每次在 hosts 文件后面新增空行的问题。
离线546242502

发帖
332
金钱
-3060
威望
-306
只看该作者 27 发表于: 2015-08-24
回 26楼(gnatix) 的帖子
gnatix:代码刚才又优化了一下,解决了每次在 hosts 文件后面新增空行的问题。 (2015-08-24 15:57) 

谢谢老虎版主更新,我是说为啥安装几次产生那么多空行
离线gnatix

发帖
7696
金钱
-8279
威望
-828
只看该作者 28 发表于: 2015-08-24
这是 INNO 的一个 Bug,将 TArrayOfString 或者 TStringList 直接写入到文件时,会在文件的结尾添加换行符 (0D0A)。建议的解决方法是把 TStringList  的文本转存到一个 AnsiString 变量里面,并删除变量最后的两个字符,然后再写入到文件。

关于这个问题,可以参看:
http://delphi.about.com/od/objectpascalide/a/remove-empty-line-tstringlist-savetofile.htm
离线gnatix

发帖
7696
金钱
-8279
威望
-828
只看该作者 29 发表于: 2015-08-25
24 楼的代码再次优化了一下,现在即使是非常非常大的 hosts 文件应该也可以处理。虽然实际中这种可能性可能根本没有。