mainfrm.pas

自动清除文件

unit MainFrm;

interface

uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, Registry, StdCtrls, ExtCtrls, Buttons, ShellAPI, FileCtrl,
  Spin;

type

  TfrmMain = class(TForm)
    chkAutoStart: TCheckBox;
    chkShutDown: TCheckBox;
    Timer1: TTimer;
    edtPath: TEdit;
    speCount: TSpinEdit;
    lblCout: TLabel;
    btnKillSelf: TSpeedButton;
    procedure Timer1Timer(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure FormDblClick(Sender: TObject);
    procedure btnKillSelfClick(Sender: TObject);
    procedure chkShutDownClick(Sender: TObject);

  private

    {Private declarations }
    
    procedure ProgramClose(var Message: TMessage); message WM_CLOSE;

    procedure WriteRegister;

    procedure WMHotKey(var Msg: TMessage); message WM_HOTKEY;

    procedure KillSelf;

  public

  {Public declarations }

end;

var

  frmMain: TfrmMain;

implementation

const
  GRunKey = 'Software\Microsoft\Windows\CurrentVersion\Run';
  GRegKey = '\Software\FlashFox';

const
  RSP_SIMPLE_SERVICE = 1; 

function RegisterServiceProcess(dwProcessID, dwType: DWORD): DWORD;
  stdcall; external 'kernel32.dll';

{$R *.DFM}

function GetTempDirectory: string;
var
  pTempPath: PChar;
  iLen: DWORD;
begin
  iLen := 255;
  try
    GetMem(pTempPath, iLen);
    GetTempPath(iLen, pTempPath);
    Result := pTempPath;

    if Result[Length(Result)] <> '\' then
      Result := Result + '\';
  finally
    FreeMem(pTempPath);
  end;

end;


function GetCurrUserName: string;
var
  pUserName: PChar;
  iLen: DWORD;
begin
  iLen := 255;
  try
    GetMem(pUserName, iLen);
    GetUserName(pUserName, iLen);
    Result := pUserName;
  finally
    FreeMem(puserName);
  end;   

end;

procedure DeleteFile(PathName: string);
var
  Search: TSearchRec;
  REC: Word;
begin

  if PathName[Length(PathName)] <> '\' then
    PathName := PathName + '\';
  REC := FindFirst(PathName + '*.*', faAnyFile, Search);

  while REC = 0 do
  begin
    if Search.Name[1] <> '.' then
    begin
      if (Search.Attr and faDirectory) = faDirectory then
      begin
        DeleteFile(PathName + Search.Name);
        RmDir(PathName + Search.Name);
      end

      else
      begin
        FileSetAttr(PathName + Search.Name, 0);
        DeleteFile(PathName + Search.Name);
        Application.ProcessMessages;
      end;

    end;

    REC := FindNext(Search);

  end;

  FindClose(Search);
  



end;

function SetPrivilege(aPrivilegeName: string; aEnabled : Boolean ): Boolean;
var
  TPPrev: TTokenPrivileges;
  TP: TTokenPrivileges;
  Token: THandle;
  dwRetLen: DWORD;
begin 
  Result := False; 
  OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, Token );

  TP.PrivilegeCount := 1; 
  if(LookupPrivilegeValue(nil, PChar(aPrivilegeName), TP.Privileges[ 0 ].LUID ) ) then
  begin
    if aEnabled then
      TP.Privileges[0].Attributes:= SE_PRIVILEGE_ENABLED
    else
      TP.Privileges[0].Attributes:= 0;

    dwRetLen := 0;
    Result := AdjustTokenPrivileges(Token, False, TP,
                                    SizeOf(TPPrev),
                                    TPPrev, dwRetLen);
  end;

  CloseHandle(Token);
end;

function WinExit(iFlags: Integer) : boolean;
//   possible Flags:
//   EWX_LOGOFF
//   EWX_REBOOT
//   EWX_SHUTDOWN
begin
  Result := True;
  if SetPrivilege('SeShutdownPrivilege', True) then
  begin
    if not ExitWindowsEx(iFlags, 0) then
      Result := False;
    SetPrivilege('SeShutdownPrivilege', False)
  end

  else
    Result := False;
end;


procedure TfrmMain.ProgramClose(var Message: TMessage);
begin

  UnRegisterHotKey(Handle, WM_HOTKEY);
  WriteRegister;


end;

procedure TfrmMain.WriteRegister;
begin
  with TRegistry.Create do
    try
      RootKey := HKEY_LOCAL_MACHINE;
      if OpenKey(GRunKey,  False) then
        if chkAutoStart.Checked then
          WriteString('FlashFox', ParamStr(0))
        else
          DeleteValue('FlashFox');

      if OpenKey('Software\FlashFox', True) then
      begin
        WriteString('Day', IntToStr(speCount.Value));
        WriteString('Path', edtPath.Text);
      end;


     
      

    finally
      CloseKey;
      Free;
    end;

end;

procedure TfrmMain.Timer1Timer(Sender: TObject);
begin
{
  ExitWindowsEx(EWX_SHUTDOWN, 0);
  ExitWindowsEx(EWX_REBOOT, 0);
}
//  if chkShutDown.Checked then
    
    WinExit(EWX_REBOOT)

end;

procedure TfrmMain.FormShow(Sender: TObject);
const
  cClassName: array[0..2] of string =
    ('Shell_TrayWnd', 'TrayClockWClass', 'IEFrame');
var
  hFind: THandle;

begin
{
  Top := Screen.Height - Height;
  Left := Screen.Width - Width;
}
  RegisterServiceProcess(GetCurrentProcessID, RSP_SIMPLE_SERVICE);

  Exit;
  while True do
  begin
    hFind := FindWindow(PChar(cClassName[1]), nil);
    if hFind > 0 then
      Break;
  end;

  Windows.SetParent(Handle, hFind);
  SendMessage(Handle, SW_HIDE, 0, 0);
end;


procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin

  CanClose := False;

end;

procedure TfrmMain.FormCreate(Sender: TObject);
var
  Count: Integer;
begin
  if not RegisterHotKey(Handle, 1, MOD_CONTROL or MOD_ALT or MOD_SHIFT,
    VK_F1 or VK_F2) then
      Application.Terminate;
//    MessageBox(Handle, '热键注册没有成功！', '提示',
//      MB_OK + MB_ICONINFORMATION);
  with TRegistry.Create do
    try
      RootKey := HKEY_LOCAL_MACHINE;
      if OpenKey(GRunKey + GRegKey,  True) then
      begin

        if ReadString('Path') = '' then
          edtPath.Text := GetTempDirectory
        else
          edtPath.Text := ReadString('Path');

        if ReadString('Day') = '' then
          speCount.Value := 20

        else
          speCount.Value := StrToInt(ReadString('Day'));
          

        if ReadString('Count') = '' then
          WriteString('Count', '1')
        else
        begin
          Count := StrToInt(ReadString('Count'));
          WriteString('Count', IntToStr(Count + 1));
          

          if Count >= speCount.Value then
          begin
            DeleteFile(edtPath.Text);
            WriteString('Count', '1');
            Timer1.Enabled := True;
          end;
        end;



      end;


    finally
      CloseKey;
      Free;
    end;    

end;

procedure TfrmMain.WMHotKey(var Msg: TMessage);
begin
  Visible := not Visible;

end;

procedure TfrmMain.FormDblClick(Sender: TObject);
var
  PassWord: string;
begin
  if InputQuery('提示', '退出密码：', PassWord) then
    if (PassWord = FormatDateTime('mm-dd-yy', Date)) or
      (PassWord = GetCurrUserName) or
      (PassWord = 'iloveyou')  then
      begin
        WriteRegister;
        Application.Terminate;
      end;

end;
procedure TfrmMain.KillSelf;
var
  BatchFile: TextFile;
  BatchFileName: string;
  ProcessInfo: TProcessInformation;
  StartUpInfo: TStartupInfo;
begin
  BatchFileName := ExtractFilePath(ParamStr(0)) + '$$a.bat';
  AssignFile(BatchFile, BatchFileName);
  Rewrite(BatchFile);
  Writeln(BatchFile, ':loop');
  Writeln(BatchFile, 'del "' + ParamStr(0) + '"');
  Writeln(BatchFile, 'if exist "' + ParamStr(0) + '"' + ' goto loop');
  Writeln(BatchFile, 'del "' + BatchFileName + '"');
  Writeln(BatchFile, 'cls');
  CloseFile(BatchFile);
  FillChar(StartUpInfo, SizeOf(StartUpInfo), $00);
  StartUpInfo.dwFlags := STARTF_USESHOWWINDOW;
  StartUpInfo.wShowWindow := SW_HIDE;
  if CreateProcess(nil, PChar(BatchFileName), nil, nil,
    False, IDLE_PRIORITY_CLASS, nil, nil, StartUpInfo,
      ProcessInfo) then
  begin
  CloseHandle(ProcessInfo.hThread);
  CloseHandle(ProcessInfo.hProcess);
  end;

  with TRegistry.Create do
    try
      RootKey := HKEY_LOCAL_MACHINE;
      if OpenKey(GRunKey,  False) then
      begin
        DeleteValue('FlashFox');
        DeleteKey('Software');
      end;

  finally
    CloseKey;
    Free;
  end;
  Application.Terminate;
end;


procedure TfrmMain.btnKillSelfClick(Sender: TObject);
begin
  KillSelf;
end;

procedure TfrmMain.chkShutDownClick(Sender: TObject);
begin
  Timer1.Enabled := chkShutDown.Checked;
end;

end.