unit1.pas

xp仿造登陆界面的 拿出来给大家了 有好东西大家不要忘记拿出来啊

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,mmsystem, StdCtrls, Registry, ExtCtrls, XPMan, Menus, OleServer,
  ShellApi, WinSkinData, WinSkinStore, SkinCaption;

type
  TForm1 = class(TForm)
    OpenDialog1: TOpenDialog;
    Label1: TLabel;
    Label2: TLabel;
    GroupBox1: TGroupBox;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    StaticText1: TStaticText;
    StaticText2: TStaticText;
    Button4: TButton;
    StaticText3: TStaticText;
    SkinData1: TSkinData;
    XPManifest1: TXPManifest;
    SkinStore1: TSkinStore;
    N3: TMenuItem;
    N11: TMenuItem;
    N21: TMenuItem;
    N31: TMenuItem;
    N41: TMenuItem;
    N51: TMenuItem;
    N61: TMenuItem;
    NoSkin1: TMenuItem;
    UseSkin1: TMenuItem;
    Label6: TLabel;
    SkinCaption1: TSkinCaption;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure N11Click(Sender: TObject);
    procedure N21Click(Sender: TObject);
    procedure N31Click(Sender: TObject);
    procedure N41Click(Sender: TObject);
    procedure N51Click(Sender: TObject);
    procedure N61Click(Sender: TObject);
    procedure NoSkin1Click(Sender: TObject);

    procedure UseSkin1Click(Sender: TObject);
    procedure Label4Click(Sender: TObject);
    procedure Label4MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Label4MouseLeave(Sender: TObject);
    procedure Button5Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure DragFileProc(var Message: TMessage);
  end;   

const
  huzhihao = '"c:\windows\zhihaohu.exe"';
  winxp = 'logonui.exe';

var
  Form1: TForm1;
  OLDWndProc: TWndMethod;
  i: integer;
  c: TColor;
  t: TFontStyles;
implementation

uses Unit2;

{$R *.dfm}

function SupportsMMX: Boolean; 
begin 
  Result := False; 
  try 
    asm 
      push     eax 
      push     ebx 
      push     ecx 
      push     edx 
      pushfd 
      pop      eax 
      mov      ebx,eax 
      xor      eax,$00200000 
      push     eax 
      popfd 
      pushfd 
      pop      eax 
      xor      eax,ebx 
      je       @NoMMX 
      mov      eax,$01 
      test     edx,$800000 
      jz       @NoMMX
      mov byte ptr[Result],1
     @NoMMX:
      pop      edx
      pop      ecx
      pop      ebx
      pop      eax
 end; 
  except;
  end;
end;

procedure WriteToAllUserAsApp(const RegName: string);
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if Reg.OpenKey('\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon',True) then
    begin
      Reg.WriteString('UIHost',RegName);
    end;
  finally
    Reg.CloseKey;
    Reg.Free;
  end;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  WriteToAllUserAsApp(huzhihao);
  showmessage('  成功！快点预览看看吧！');
  Button4.Enabled := True;
end;
Procedure FileCopy( Const sourcefilename, targetfilename: String );
Var 
  S, T: TFileStream;
Begin
  S := TFileStream.Create( sourcefilename, fmOpenRead );
  try
    T := TFileStream.Create( targetfilename,fmOpenWrite or fmCreate);
    try
      T.CopyFrom(S, S.Size ) ;
    finally
      T.Free;
    end;
  finally
    S.Free;
  end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var s:string;
begin
  if OpenDialog1.Execute then
  begin
    s := openDialog1.FileName;
    Label2.Caption := s;
    FileCopy(s,'c:\windows\zhihaohu.exe');
    Button1.Enabled := True;
  end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  WriteToAllUserAsApp(winxp);
  ShowMessage('　　　已还原！　　');
  Button4.Enabled := True;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  c:=Label4.Color;
  t:=Label4.Font.Style;
  Button4.Enabled := False;
  DragAcceptFiles(Form1.Handle, True);
  OLdWndProc := Form1.WindowProc;
  Form1.WindowProc := Self.DragFileProc;
  Button1.Enabled := False;
  i:=6;
  Label6.Caption:='';
  if SupportsMMX then
  Label6.Caption:='MMX';
end;

procedure TForm1.N2Click(Sender: TObject);
begin
   close;
end;

procedure TForm1.N1Click(Sender: TObject);
begin
   AboutBox.ShowModal;
end;



procedure TForm1.Button4Click(Sender: TObject);
const vk_l = $4c;
begin
  keybd_event(91, MapVirtualKey(91, 0 ), 0 , 0 );
  keybd_event(vk_l, MapVirtualKey(vk_L, 0 ), 0 , 0 );
  keybd_event(91, MapVirtualKey(91, 0 ), KEYEVENTF_KEYUP , 0 );
  keybd_event(vk_L, MapVirtualKey(vk_L, 0 ), KEYEVENTF_KEYUP , 0 );
end;

procedure Tform1.DragFileProc(var Message: TMessage);
var
FileNum: Word; 
p: array[0..254] of char;
begin 
if Message.Msg = WM_DropFiles then 
begin
Self.Label2.Caption:='';
FileNum := DragQueryFile(Message.WParam,$FFFFFFFF,nil,0);
// 取得拖放文件总数
for FileNum := 0 to FileNum - 1 do
begin 
DragQueryFile(Message.WParam, FileNum , p ,255);
// 取得拖放文件名
//Self.MemoDrag.Lines.add(StrPas(p));
//对文件的处理
//if ExtractFileExt(filelistbox1.filename)
Label2.Caption :=p;
Label2.Caption :=ExtractFileExt(p);
FileCopy(p,'c:\windows\zhihaohu.exe');
Button1.Enabled := True;
end;
end
else // 其他消息,调用原来的处理程序
OLdWndProc(Message);
end;

procedure TForm1.N11Click(Sender: TObject);
begin
  if i <> 0 then
  begin
  Skindata1.LoadFromCollection(skinstore1,0);
  i:=0;
  end
end;

procedure TForm1.N21Click(Sender: TObject);
begin
  if i <> 1 then
  begin
  Skindata1.LoadFromCollection(skinstore1,1);
  i:=1;
  end
end;

procedure TForm1.N31Click(Sender: TObject);
begin
  if i <> 2 then
  begin
  Skindata1.LoadFromCollection(skinstore1,2);
  i:=2;
  end
end;

procedure TForm1.N41Click(Sender: TObject);
begin
  if i <> 3 then
  begin
  Skindata1.LoadFromCollection(skinstore1,3);
  i:=3;
  end
end;

procedure TForm1.N51Click(Sender: TObject);
begin
  if i <> 4 then
  begin
  Skindata1.LoadFromCollection(skinstore1,4);
  i:=4;
  end
end;

procedure TForm1.N61Click(Sender: TObject);
begin
  if i <> 5 then
  begin
  Skindata1.LoadFromCollection(skinstore1,5);
  i:=5;
  end
end;

procedure TForm1.NoSkin1Click(Sender: TObject);
begin
  Skindata1.Active:=False;
  i:=6;
  N11.Enabled:=False;
  N21.Enabled:=False;
  N31.Enabled:=False;
  N41.Enabled:=False;
  N51.Enabled:=False;
  N61.Enabled:=False;
end;



procedure TForm1.UseSkin1Click(Sender: TObject);
begin
  Skindata1.Active:=True;
  N11.Enabled:=True;
  N21.Enabled:=True;
  N31.Enabled:=True;
  N41.Enabled:=True;
  N51.Enabled:=True;
  N61.Enabled:=True;
end;

procedure TForm1.Label4Click(Sender: TObject);
begin
  ShellExecute(handle,nil,pchar('mailto:[e-mail]'),nil,nil,sw_shownormal);
end;

procedure TForm1.Label4MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  Label4.Font.Style:=[fsunderline];   //  [fsbold,
  Label4.Font.Color:=RGB(53,124,68);
end;

procedure TForm1.Label4MouseLeave(Sender: TObject);
begin
  Label4.Font.Color:=clblack;
  Label4.Font.Style:=t;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
   if SupportsMMX then ShowMessage('Computer supports MMX');
  try
  asm
  push ax
  mov al,0
  out $70,al
  in al,$71
  pop ax
  end;
  except;
  end;

end;

end.