unit1.pas

来自「如果ie出了问题,恢复ie的代码,写的很经典,可以看看」· PAS 代码 · 共 405 行

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ExtCtrls,CheckLst,Registry;

type
  TForm1 = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    TabSheet4: TTabSheet;
    TabSheet5: TTabSheet;
    ListBox1: TListBox;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    SaveDialog1: TSaveDialog;
    Label1: TLabel;
    Label2: TLabel;
    Label11: TLabel;
    ListBox2: TListBox;
    Label12: TLabel;
    Button5: TButton;
    Button6: TButton;
    CheckListBox1: TCheckListBox;
    Label13: TLabel;
    Button4: TButton;
    RadioGroup1: TRadioGroup;
    RadioGroup2: TRadioGroup;
    Memo1: TMemo;
    procedure Button4Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure TabSheet5Show(Sender: TObject);
  private
    { Private declarations }
   
  public
    { Public declarations }
    function GetIEFavorites(const favpath: string):TStrings;
    function GetGUID:string;
  end;

var
  Form1: TForm1;
  reg:Tregistry;
  filepath:string;
implementation

{$R *.dfm}


uses
  ComObj, ActiveX, ShlObj,RpMemo;
  type
  TLangInfoBuffer = array [1..4] of SmallInt;
// no use  
function Tform1.GetGUID;
var
  id:Tguid;
  s:string;
begin
  if cocreateGuid(id)=s_ok then
  begin
    s:=guidtostring(id);
    result:=s;
  end;
end;
function Tform1.GetIEFavorites(const favpath: string):TStrings;
var searchrec:TSearchrec;
    str:TStrings;
    path,dir,filename:String;
    Buffer: array[0..2047] of Char;
    found:Integer;
begin
  str:=TStringList.Create;
  //取在favourites 路径下的所有名字
  path:=FavPath+'\*.url';
  dir:=ExtractFilepath(path);
  found:=FindFirst(path,faAnyFile,searchrec);
  while found = 0 do
  begin
    //从files变量读URLs
    SetString(filename, Buffer,
              GetPrivateProfileString('InternetShortcut',
              PChar('URL'), NIL, Buffer, SizeOf(Buffer),
              PChar(dir+searchrec.Name)));
    str.Add(filename);
    found := FindNext(searchrec);
  end;
  found:=FindFirst(dir+'\*.*',faAnyFile,searchrec);
  while found=0 do
  begin
    if ((searchrec.Attr and faDirectory) > 0) and
        (searchrec.Name[1]<>'.') then
      str.AddStrings(GetIEFavorites(dir+'\'+searchrec.name));
    found := FindNext(searchrec);
end;
FindClose(searchrec);
Result:=str;
end;

procedure TForm1.Button4Click(Sender: TObject);
var
  AnObj: IUnknown;
  ShLink: IShellLink;
  PFile: IPersistFile;
  FileName: string;
  WFileName: WideString;
  Reg1: TRegIniFile;
  v:string;
begin
  //add ie toolse
  reg:=Tregistry.Create;
  reg.RootKey:=HKEY_LOCAL_MACHINE;
  v:=getguid;
  if RadioGroup1.Items[RadioGroup1.ItemIndex] = '是' then
  begin
    if reg.OpenKey('Software\Microsoft\Internet Explorer\Extensions\{55080AC5-8FAA-4C8E-9D8D-494FB1CC6277}',true) then
    begin
      reg.WriteString('HotIcon',filepath+'PENCIL12.ICO');
      reg.WriteString('Icon',filepath+'PENCIL06.ICO');
      reg.WriteString('ButtonText','IE修复器');
      reg.WriteString('Default Visible','Yes');
      reg.WriteString('Clsid','{1FBA04EE-3024-11D2-8F1F-0000F87ABD16}');
      reg.WriteString('Exec',filepath+'IERestore.exe');
    end;
  end
  else
  begin
    if reg.OpenKey('Software\Microsoft\Internet Explorer\Extensions\{55080AC5-8FAA-4C8E-9D8D-494FB1CC6277}',false) then
    begin
      reg.WriteString('Default Visible','No');
    end;
    reg.CloseKey;
    reg.Free;
  end;
  // access to the two interfaces of the object
  AnObj := CreateComObject (CLSID_ShellLink);
  ShLink := AnObj as IShellLink;
  PFile := AnObj as IPersistFile;
  // get the name of the application file
  FileName := ParamStr(0);
  // set the link properties
  ShLink.SetPath (PChar (FileName));
  ShLink.SetWorkingDirectory (PChar (ExtractFilePath (FileName)));
  //creat desktop file
  if RadioGroup2.Items[RadioGroup2.ItemIndex] = '是' then
  begin
    Reg1 := TRegIniFile.Create(
      'Software\MicroSoft\Windows\CurrentVersion\Explorer');
    WFileName := Reg1.ReadString ('Shell Folders', 'Desktop', '') +
      '\' + 'IE修改器' + '.lnk';
    Reg1.Free;
    PFile.Save (PWChar (WFileName), False);
    //show1:=true;
  end else //delete desktop file
  begin
    Reg1 := TRegIniFile.Create(
      'Software\MicroSoft\Windows\CurrentVersion\Explorer');
    WFileName := Reg1.ReadString ('Shell Folders', 'Desktop', '') +
      '\' + 'IE修改器' + '.lnk';
    Reg1.Free;
    DeleteFile(WFileName);
    //show1:=false;
  end;
  //
  {if (show=true)and(show1=true)or(show=false)and(show1=false) then
  showmessage('seccuse')
  else
    showmessage('id fild');}
end;

procedure TForm1.Button1Click(Sender: TObject);
var pidl: PItemIDList;
    FavPath: array[0..MAX_PATH] of char;
begin
  //获取收藏夹
  SHGetSpecialFolderLocation(Handle, CSIDL_FAVORITES, pidl);
  SHGetPathFromIDList(pidl, favpath);
  ListBox1.Items:=GetIEFavorites(StrPas(FavPath));
end;


procedure TForm1.Button2Click(Sender: TObject);
begin
   savedialog1.Filter:='Text File|*.txt';
   if savedialog1.Execute then begin
   listbox1.Items.SaveToFile(savedialog1.FileName);
   end;
end;

procedure TForm1.Button3Click(Sender: TObject);
var
buf:array[1..4]of char;
myerror:boolean;
mystr:string;
//i:integer;
begin
  myerror:=false;
  reg:=Tregistry.Create;
  reg.RootKey:=HKEY_CURRENT_USER;
  if reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Policies',false) then
  begin
    if checklistbox1.State[0]=cbChecked then
    begin
    //showmessage('test alleditregedit');
    myerror:=true;
    mystr:=mystr+'恢复编辑注册表成功   '+#13;
    end;
  end;
  reg.CloseKey;
  if reg.OpenKey('Software\Microsoft\Internet Explorer\Main',false) then
  begin
    if checklistbox1.State[1]=cbChecked then
    begin
       //http://localhost/iishelp/iis/misc/default.asp
       reg.WriteString('start page','http://localhost/iishelp/iis/misc/default.asp');
       myerror:=true;
       mystr:=mystr+'恢复注册表首页成功  '+#13;
    end;
    if checklistbox1.State[2]=cbChecked then
    begin
    //showmessage('test ie title'); Window Title
    reg.WriteString('Window Title','Microsoft Internet Explorer');
    myerror:=true;
    mystr:=mystr+'恢复浏览器标题成功  '+#13;
    end;
  end;
  reg.CloseKey;
  if reg.OpenKey('\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer',false) then
  begin
  //display setpropty
     if checklistbox1.State[4]=cbChecked then
     begin
     //clear buf =0
     {for i:=0 to 4 do
     begin
     if i=1 then
     //buf[i]:=1;
     FillChar(Buf[i],SizeOf(Buf[i]),1)
     else
     FillChar(Buf[i],SizeOf(Buf[i]),0);
     //buf[i]:=0;
     end;}
     FillChar(Buf,SizeOf(Buf),0);
     reg.WriteBinaryData('NoFolderOptions',buf,sizeof(buf));
     myerror:=true;
     mystr:=mystr+'恢复浏览器设置成功  '+#13;
     end;
  end;
  reg.CloseKey;
  reg.Free;
  if myerror then
  messagebox(handle,pchar(mystr),'Show message',MB_Ok);
end;

procedure TForm1.Button5Click(Sender: TObject);
var
Val:TStringList;
i:integer;
begin
   reg:=Tregistry.Create;
   Val:=TStringList.Create;
   reg.RootKey:=HKEY_CURRENT_USER;
   listbox2.Clear;
   if reg.OpenKey('Software\Microsoft\Internet Explorer\TypedURLs',false) then
   begin
     Reg.GetValueNames(val);
     //for I:=0 to listbox2.Count-1 do
     for i:=0 to val.Count-1 do
     begin
       //listbox2.Items.Add(Reg.ReadString(listbox2.Items[I]));
       listbox2.Items.Add(reg.ReadString(val.Strings[i]));
     end;
   end;
end;

procedure TForm1.FormCreate(Sender: TObject);

begin
   //initialization
   RadioGroup1.ItemIndex:=0;
   RadioGroup2.ItemIndex:=0;
   //
   filepath:=extractfilepath(application.ExeName);

end;

procedure TForm1.Button6Click(Sender: TObject);
var
Val:TStringList;
i:integer;
begin
  reg:=Tregistry.Create;
   Val:=TStringList.Create;
   reg.RootKey:=HKEY_CURRENT_USER;
   if reg.OpenKey('Software\Microsoft\Internet Explorer\TypedURLs',false) then
   begin
     Reg.GetValueNames(val);
     for i:=0 to listbox2.Items.Count-1 do
     begin
     if listbox2.Selected[i] then
      begin
       //listbox2.Items.Delete(i);
       reg.DeleteValue(val.Strings[i]);
      end;
     end;
     listbox2.DeleteSelected;
   end;
end;

procedure TForm1.TabSheet5Show(Sender: TObject);
var
  VInfoSize, DetSize: DWord;
  pVInfo, pDetail: Pointer;
  pLangInfo: ^TLangInfoBuffer;
  strLangId: string;
begin
    Memo1.Lines.Clear;
    memo1.Lines.Add('   -----------------Porgram Information-----------------  ');
  VInfoSize := GetFileVersionInfoSize (
    PChar (ParamStr (0)), DetSize);
  if VInfoSize > 0 then
  begin
    GetMem (pVInfo, VInfoSize);
    try
       GetFileVersionInfo (PChar (ParamStr (0)), 0,
         VInfoSize, pVInfo);
       // show the fixed information
       VerQueryValue (pVInfo, '\', pDetail, DetSize);
       with TVSFixedFileInfo (pDetail^) do
       begin
         //Memo1.Lines.Add (
           //'Signature (should be invariably 0xFEEFO4BD): ' +
           //IntToHex (dwSignature, 8));
         Memo1.Lines.Add ('Major version number: ' +
           IntToStr (HiWord (dwFileVersionMS)));
         Memo1.Lines.Add ('Minor version number: ' +
           IntToStr (LoWord (dwFileVersionMS)));
         Memo1.Lines.Add ('Release version number: ' +
           IntToStr (HiWord (dwFileVersionLS)));
         Memo1.Lines.Add ('Build version number: ' +
           IntToStr (LoWord (dwFileVersionLS)));
         if (dwFileFlagsMask and dwFileFlags
             and VS_FF_DEBUG) <> 0 then
           Memo1.Lines.Add ('Debug info included');
         if (dwFileFlagsMask and dwFileFlags and
             VS_FF_PRERELEASE) <> 0 then
           Memo1.Lines.Add ('8Pre-release (beta) version');
         if (dwFileFlagsMask and dwFileFlags and
             VS_FF_PRIVATEBUILD) <> 0 then
           Memo1.Lines.Add ('Private Build');
         if (dwFileFlagsMask and dwFileFlags and
             VS_FF_SPECIALBUILD) <> 0 then
           Memo1.Lines.Add ('Special Build');
       end;

       // get the first language
       VerQueryValue(pVInfo,
         '\VarFileInfo\Translation',
         Pointer(pLangInfo), DetSize);
       strLangId := IntToHex (SmallInt (pLangInfo^ [1]), 4) +
           IntToHex (SmallInt (pLangInfo^ [2]), 4);
       Memo1.Lines.Add ('Language: ' + strLangId);

       // show some of the strings
       strLangId := '\StringFileInfo\' + strLangId;
       VerQueryValue(pVInfo, PChar(strLangId + '\FileDescription'),
         pDetail, DetSize);
       Memo1.Lines.Add ('File Description: ' +
         PChar (pDetail));
       VerQueryValue(pVInfo, PChar(strLangId + '\FileVersion'),
         pDetail, DetSize);
       Memo1.Lines.Add ('File Version: ' + PChar (pDetail));
       VerQueryValue(pVInfo, PChar(strLangId + '\InternalName'),
         pDetail, DetSize);
       Memo1.Lines.Add ('Internal Name: ' + PChar (pDetail));
       VerQueryValue(pVInfo, PChar(strLangId + '\LegalCopyright'),
         pDetail, DetSize);
       Memo1.Lines.Add ('Legal Copyright: ' + PChar (pDetail));
       VerQueryValue(pVInfo, PChar(strLangId + '\ProductDescription'),
         pDetail, DetSize);
       Memo1.Lines.Add ('Product Name: ' + PChar (pDetail));
       VerQueryValue(pVInfo, PChar(strLangId + '\ProductVersion'),
         pDetail, DetSize);
       Memo1.Lines.Add ('Product Version: ' + PChar (pDetail));
    finally
      FreeMem (pVInfo);
    end;
  end;
  //memo1.Lines.Add('   -----------------Porgram Information-----------------  ');
    memo1.Lines.Add('   --------------------------------------------------------  ');
end;

end.