刪除自己程序

procedure TForm1.Funll;
var
  hModule:THandle;
  buff:array[0..255]of Char;
  hKernel32:THandle;
  pExitProcess,pDeleteFileA,pUnmapViewOfFile:Pointer;
begin
  hModule:=GetModuleHandle(nil);
  GetModuleFileName(hModule, buff, sizeof(buff));
  CloseHandle(THandle(4));
  hKernel32:=GetModuleHandle('KERNEL32');
  pExitProcess:=GetProcAddress(hKernel32, 'ExitProcess');
  pDeleteFileA:=GetProcAddress(hKernel32, 'DeleteFileA');
  pUnmapViewOfFile:=GetProcAddress(hKernel32, 'UnmapViewOfFile');
  asm
  LEA EAX, buff
  PUSH 0
  PUSH 0
  PUSH EAX
  PUSH pExitProcess
  PUSH hModule
  PUSH pDeleteFileA
  PUSH pUnmapViewOfFile
  RET
end;

防止被非explorer.exe程序調用

{注意加載TlHelp32.pas單元}
procedure CheckParentProc;
var //檢查自己的進程的父進程
  Pn: TProcesseNtry32;
  sHandle:THandle;
  H, ExplProc, ParentProc:Hwnd;
  Found:Boolean;
  Buffer:array[0..1023]of Char;
  Path:string;
begin
  H:= 0;
  ExplProc:= 0;
  ParentProc:= 0;
  //得到Windows的目錄
  SetString(Path, Buffer, 200);
  GetWindowsDirectory(Buffer,Sizeof(Buffer)- 1);
  Path:= UpperCase(Path)+ '\EXPLORER.EXE';//得到Explorer的路徑
  //得到所有進程的列表快照
  sHandle:= CreateToolHelp32SnapShot(TH32CS_SNAPALL,0);
  Found:= Process32First(sHandle,Pn);//查找進程
  while Found do //遍歷所有進程
  begin
    if Pn.szExeFile = ParamStr(0) then //自己的進程
    begin
      ParentProc := Pn.th32ParentProcessID;//得到父進程的進程ID
      //父進程的句柄
      H:= OpenProcess(PROCESS_ALL_ACCESS, True, Pn.th32ParentProcessID);
    end
    else if UpperCase(Pn.szExeFile)= Path then
      ExplProc:= Pn.th32ProcessID;//Ex plorer的PID
      Found:= Process32Next(sHandle,Pn);//查找下一個
  end;
  //父進程不是Explorer,是調試器……
  if ParentProc <> ExplProc then
  begin
    showmessage('ok');
    TerminateProcess(H,0);//殺之!除之而後快也! :)
  //你還可以加上其它什麼死機代碼來消遣消遣這位可愛的Cracker:)
  end;
end;

刪除目錄下所有檔案

procedure DelTree(sPath: string);
var
  hFind: THandle;
  filename: string;
  fd: WIN32_FIND_DATA;
  bDelete: BOOL;
  i: Integer;

begin
  if sPath='' then
    exit;
  filename:=sPath+'\*.*';
  hFind:=Windows.FindFirstFile(PChar(filename), fd);
  if(hFind <> INVALID_HANDLE_VALUE) then
  begin
    while Windows.FindNextFile(hFind, fd) do
    begin
      filename:=fd.cFileName;
      if((filename = '.') or (filename = '..')) then
        Continue;
      if(fd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) > 0 then
      begin
        //子目錄
        DelTree(sPath+'\'+filename);
      end
      else
      begin
        //Full filename.
        filename:=sPath+'\'+filename;
        if(not SetFileAttributes(PChar(filename),
            FILE_ATTRIBUTE_NORMAL)) then
        begin
          //SaveLog('Set '+filename+' file attribute to normal error !');
        end;
        i:=0;
        bDelete:=DeleteFile(PChar(filename));
        while((i<5) and (not bDelete)) do
        begin
          Sleep(1000);
          bDelete:=DeleteFile(PChar(filename));
          Inc(i);
        end;
        if(not bDelete) then
        begin
          //SaveLog('Delete file '+filename+' error !');
        end;
      end;
    end;
    Windows.FindClose(hFind);
  end;
  if(not SetFileAttributes(PChar(sPath),
            FILE_ATTRIBUTE_NORMAL)) then
  begin
    //SaveLog('Set '+sPath+' directory attribute to normal error !');
  end;
  //SaveLog('Remove directory '+sPath);
  if(not RemoveDirectory(PChar(sPath))) then
  begin
    //SaveLog('Remove directory '+sPath+' error !');
  end;
  //SaveLog('CcyDelTree '+sPath+' completely.');
end;

取得PROGRAM FILES目錄位置

procedure TForm1.Button1Click(Sender: TObject);
begin
  With TRegistry.Create do
  try
    RootKey := HKEY_LOCAL_MACHINE;
    if OpenKey('Software\Microsoft\Windows\CurrentVersion', False) then
      Caption := ReadString('ProgramFilesDir');
  finally
    Free;
  end;
end;

判斷作業系統

function GetOSVer: integer ;
var
  vi:   _OSVERSIONINFO;
begin
  Result:=osUnknow;
  FillChar(vi, SizeOf(vi), 0);
  vi.dwOSVersionInfoSize := SizeOf(vi);
  Windows.GetVersionEx(vi);

  if (Win32Platform=1) then begin
    if (Win32MinorVersion=0) then begin
      Result:=osWin95;
    end else begin
      Result:=osWin98;
    end;
  end else if (Win32Platform=2) then begin
    if (Win32MajorVersion=4) then begin
      Result:=osWinNT
    end else if (Win32MajorVersion=5) then begin
      if (Win32MinorVersion=0) then begin
        Result:=osWin2K;
      end else if (Win32MinorVersion=1) begin
        Result:=osWinXP;
      end else begin
        Result:=osVista;
      end;
    end;
  end;
end;
參考網址：
http://www.ge.net.tw/?q=node/919

日期轉成星期幾

const
  Arab: array[1..7] of String = ('日','一' ,'二' ,'三' ,'四' , '五' , '六');
begin
  Caption := '星期'+Arab[DayOfWeek(DataSet.FieldByName('完成修正日期').AsDateTime)];
end;