刪除自己程序

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;

cxgrid要能取消選擇的作法

cxgrid 的optionSelection屬性MultiSelect設為True

cxGDBTV1MouseDown事件設定

procedure TfrmDataSwSelect.cxGDBTV1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  i : integer;
begin

  i := cxGDBTV1.DataController.FocusedRowIndex;
  cxGDBTV1.DataController.ClearSelection; //清除
  cxGDBTV1.DataController.SelectRows(i,i);
end;

cxGDBTV1KeyDown事件設定

procedure TfrmDataSwSelect.cxGDBTV1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (ssShift in Shift) then //shift要失效
    Key :=0;
end;

清楚選取用

  cxGDBTV1.DataController.ClearSelection;

初始時將cxgrid移到特定的選擇可用

    ADOQuery1.First;
    if ADOQuery1.Locate('swid', swid, []) then
      iIndex := ADOQuery1.RecNo-1
    else
      iIndex:=-1;
    if iIndex>=0 then
      cxGDBTV1.DataController.SelectRows(iIndex,iIndex);

檢查MDAC2.8是否有安裝

dpr下寫

if not CheckMDACVersionOK( _MDAC_V26 ) then
  begin
    OneBtnMsgBox(LoginLangInfo.g_saMsg[160], MB_ICONINFORMATION);// 資料庫存取發生錯誤!//請先安裝 MDAC 2.8 或以上版本。
    exit;
end;

呼叫到的funcion

uses registry;

const
  _MDAC_V26                   = '2.6';             //MDAC 2.6 SQL Server 所需

//----------------------------------------------------------------------------//
// CheckMDACVersionOK  檢查MDAC版本是否夠新                                   //
//                  支援postgreSql後改為外部傳參數決定版本  by FBI 2005-1108  //
//                     參數:                                                  //
//                          (1) sVer : 檢查版號                               //
//----------------------------------------------------------------------------//
function  CheckMDACVersionOK(sVer : String):boolean;
var
  Reg     :TRegistry;
  sVersion:string;

begin
  Result:=false;
  Reg:=TRegistry.Create;
  try
    Reg.RootKey:=HKEY_LOCAL_MACHINE;
    if not Reg.OpenKeyReadOnly('\SOFTWARE\Microsoft\DataAccess') then exit;
    sVersion:=Reg.ReadString('FullInstallVer');
    if sVersion='' then exit; //讀不到 Key，代表沒安裝MDAC
  finally
    Reg.Free;
  end;
  //檢查版本: MS 官方文件限制在 MDAC 2.6 以上。
  try
    //sVersion:=Copy(sVersion,1,3);
    if sVersion < sVer then exit;
  except
    exit;
  end;
  Result:=true;
end;

cxgrid的header加入右鍵選單

把元件TcxGridPopupMenu拉進來，grid屬性設定好要的cxgrid,onpopup事件加入下面程式碼

uses cxGridStdPopupMenu;

type
  TMenuStringForCxGrid = class(TObject)
  class procedure HeaderMenuProc(Sender:TObject);
  end;

class procedure TMenuStringForCxGrid.HeaderMenuProc(Sender: TObject);
var
  HM:TcxGridStdHeaderMenu;
begin
  HM:=TcxGridStdHeaderMenu(Sender);
  if HM.Items.Count<>17 then exit;
  HM.Items[0].Caption:='&遞增排序';//遞增排序
  HM.Items[1].Caption:='&遞減排序';//遞減排序
  HM.Items[2].Caption:='&取消排序';//取消排序

  HM.Items[4].Caption:='&以此欄位分組';//以此欄位分組
  HM.Items[5].Caption:='&分組視窗';//分組視窗
  HM.Items[6].Visible:=false;
  HM.Items[7].Visible:=false;
  HM.Items[8].Visible:=false;

  HM.Items[10].Caption:='&隱藏此欄位';//隱藏此欄位
  HM.Items[11].Caption:='&欄位選擇視窗';//欄位選擇視窗

  HM.Items[13].Visible:=false;
  HM.Items[14].Caption:='&最適欄寬';//最適欄寬
  HM.Items[15].Visible:=false;
  HM.Items[16].Caption:='&最適欄寬(所有欄位)';//最適欄寬(所有欄位)

end;

PopCxGridMenuProc(ASenderMenu);  //右鍵選單中文化

//這個是呼叫到的funcion
function  PopCxGridMenuProc(ASenderMenu: TComponent):boolean;
begin
  if ASenderMenu is TcxGridStdHeaderMenu then
    TcxGridStdHeaderMenu(ASenderMenu).OnPopup := TMenuStringForCxGrid.HeaderMenuProc;
  result:=true;
end;

使用stuff將多筆記錄合併成一筆並用逗號分隔

select stuff((select ','+user_name From im_chat_log where id in (1, 2) FOR XML PATH('')),1,1,'' ) as xylist

DCC32 參數說明

它的編譯器參數如下：

選項　　　　描述

Aunit=alias 設置單元別名

B　　　　　 編譯所有單元

CC　　　　　編譯控制台程序

CG　　　　　編譯圖形界面程序

Ddefines　　編譯條件符號定義

Epath　　　 可執行文件輸出路徑

Foffset　　 查找運行期間錯誤

GD　　　　　生成完整.Map文件

GP　　　　　生成.Map文件Public段

GS　　　　　生成.Map文件Segment段

H　　　　　 輸出提示信息

Ipaths　　　文件包含路徑

J　　　　　 生成.Obj目標文件

JP　　　　　生成C++類型.Obj目標文件

Kaddress　　Set image base address

LEpath　　　包.BPL文件輸出路徑

LNpath　　　.dcp文件輸出路徑

LUpackage　 使用運行期間包列表

M　　　　　 編譯有改動的源文件

Npath　　　 dcu/dpu文件輸出目錄

Opaths　　　.Obj文件(彙編目標代碼文件)路徑

P　　　　　 按8.3格式文件名查找

Q　　　　　 安靜模式

Rpaths　　　資源文件(.RES)路徑

TXext　　　 目標文件擴展名

Upaths　　　單元文件路徑

V　　　　　 為Turbo Debugger生成調試信息文件

VN　　　　　以.Giant格式生成包含命名空間的調試信息文件(將用於C++Builder)

VR　　　　　生成調試信息文件.rsm

W　　　　　 輸出警告信息

Z　　　　　 Disable implicit compilation

$directive　Compiler directives

--Help　　　顯示編譯選項的幫助。同樣的，如果你在命令行單獨輸入dcc32，也會顯示編譯選項的幫助。

--version　 顯示產品名稱和版本

基本 DOS 批次處理詳細解說

一、echo、@、call、pause、rem　是批次檔案最常用的幾個命令，我們就從他們開始學起
echo 表示顯示此命令後的字元
echo off 表示在此語句後所有運行的命令都不顯示命令行本身
@ 與echo off相象，但它是加在其他命令行的最前面，表示運行時
不顯示命令行本身。
call 調用另一條批次檔案（如果直接調用別的批次檔案 ，執行完
那條檔後將無法執行當前檔後續命令）
pause 運行此句會暫停，顯示 Press any key to continue... 等待用戶
按任意鍵後繼續
rem 表示此命令後的字元為解釋行，不執行，只是給自己今後查找用的

二、if 、goto 、choice 、for　是批次檔案中比較高級的命令，如果這幾個你用 得很熟練，你就是批次檔案的專家啦。
if 表示將判斷是否符合規定的條件，從而決定執行不同的命令。 有三種格式:
1、if "參數" == "字串" 　待執行的命令
參數如果等於指定的字串，則條件成立，運行命令，否則運行下一句。
(注意是兩個等號）
如：if "%1"=="a" format a:
2、if exist 檔案名　 待執行的命令
如果有指定的檔，則條件成立，運行命令，否則運行下一句。
如：if exist config.sys edit config.sys
3、if errorlevel 數位　 待執行的命令
如果返回碼等於指定的數字，則條件成立，運行命令，否則運行下一句。
如if errorlevel 2 goto x2 　DOS程式運行時都會返回一個數位給DOS，
稱為錯誤碼errorlevel或稱返回碼

goto 批次檔案運行到這裏將跳到goto 所指定的標號處，一般與 if 配合使用。
如:
goto end
:end
echo this is the end
: 這是標號字元(所在位是冒號),是用來執行被 goto 跳轉所用的標號字元，
標號所在行是不會被執行,如: :end 等等...

choice 使用此命令可以讓用戶輸入一個字元，從而運行不同的命令。使用時應該
加/c:參數，c:後應寫提示可輸入的字元，之間無空格。它的返回碼為1234……
如: choice /c:dme defrag,mem,end
將顯示
defrag,mem,end[D,M,E]?
例如，test.bat的內容如下:
@echo off
choice /c:dme defrag,mem,end
if errorlevel 3 goto defrag 應先判斷數值最高的錯誤碼
if errorlevel 2 goto mem
if errotlevel 1 goto end
:defrag
c:\dos\defrag
goto end
:mem
mem
goto end
:end
echo good bye
此檔運行後，將顯示 defrag,mem,end[D,M,E]? 用戶可選擇d m e ，
然後if語句將作出判斷，d表示執行標號為defrag的程式段，m表示執行
標號為mem的程式段，e表示執行標號為end的程式段，每個程式段最後都
以goto end將程式跳到end標號處，然後程式將顯示good bye，檔結束。

for 迴圈命令，只要條件符合，它將多次執行同一命令。
格式FOR [%%f] in (集合) DO [命令]
只要參數f在指定的集合內，則條件成立，執行命令
如果一條批次檔案中有一行:
for %%c in (*.bat *.txt) do type %%c
含義是如果是以bat或txt結尾的檔，則顯示檔的內容。
device和devicehigh
載入一些記憶體駐留程序，用於管理設備。比如記憶體管理程式和
光碟機驅動程式等。
如： device=c:\dos\himem.sys
device=c:\dos\emm386.exe ram
devicehigh=c:\cdrom\cdrom.sys

himem.sys和emm386.exe
DOS只能直接使用640K的記憶體，即基本記憶體，必須依靠其他記憶體管理程式來
使用更多的記憶體，這兩條命令就是最常用的記憶體管理程式。
himem.sys 負責管理擴展記憶體。
emm386.exe 負責管理高端記憶體並在擴展記憶體中類比延伸記憶體供某些軟體使用。
為了使用更多的記憶體，配置檔中應有:
device=c:\dos\himem.sys
device=c:\dos\emm386.exe ram
注意：EMM386.exe 要求先安裝 himem.sys，因而必須確保
安裝 himem.sys 的配置命令在 emm386.exe 之前。
dos=high,umb 這兩個參數也可以分開寫成兩條語句，即：
dos=high
dos=umb
應在config.sys中加入這條命令，這樣會將DOS的系統檔移入高端
記憶體，空出更多的基本記憶體給其他軟體使用。 注意，如果用戶沒有
安裝emm386.exe，umb這個參數是沒有實際意義的
lastdriver lastdriver 規定用戶可以訪問的最大驅動器符數目，也就是DOS所能
識別的最後的驅動器符(字母)。如果設定的驅動器符數目小於本機上
的實際驅動器數，則此lastdriver命令會被忽略掉。缺省的最大驅動
器符數目為本機的實際驅動器數目加一。
:: 二個冒號，它和批次檔案中的 rem 含義相同，即注釋
ramdrive.sys 虛擬磁片檔。
只要在 config.sys 中加入 device=ramdrive.sys 就可使用虛擬磁片了
比如:
　　 device=c:\dos\ramdrive.sys 1024 /e
表示在擴展記憶體中建立 1M 的虛擬磁片。如果加/a參數，則表示在擴充
記憶體中建立虛擬磁片。
%CDROM% %CDROM%是光碟機盤符的變數字串,用它可以把所在的任意光碟機盤符替為真實盤符, 需要與光碟機驅動模組一同執行,如:
LH \MSCDEX.EXE /D:mscd001 /L:%CDROM%
%RAMD% %RAMD%是隨機虛擬磁片, 此盤創建在擴展記憶體中, 建立此盤的模組就是 ramdrive.sys ,見上面的“虛擬磁片檔”說明。
另外這個虛擬內在還有更強大的虛擬記憶體管理器，可以超過64MB的記憶體管理，就是 XMSDSK.EXE 與 EMSDSK.EXE，

讓程式不能重覆開啟

//專案檔最前面加上，1.檢查Mutex，若XMonitor已存在，則離開。
if ProgramAlreadyExists() then exit;

function ProgramAlreadyExists():boolean;
var
  hRunningForm: Thandle;
begin
  //g_hMutex:=CreateMutex(nil, False, 'X-Console');
  g_hMutex:=CreateEvent(nil, False, TRUE, 'X-Monitor');
  if (g_hMutex=0) OR (GetLastError()=ERROR_ALREADY_EXISTS) then //已存在
  begin
    hRunningForm := FindWindow(_XMONITOR_CLASS_NAME,nil);
    if hRunningForm<>0 then
    begin
      SetForegroundWindow(hRunningForm);
//      PostMessage(hRunningForm,WM_SYSCOMMAND,SC_MAXIMIZE,0);
    end;

    Result:=true;
  end
  else
    Result:=false;
end;

壓縮mdb資料庫

function CompressDB(DBName: string): Boolean;
var
  DaoVar: OLEVariant;
  tmpDBName : string;
begin
  if not FileExists(DBName) then
  begin
    Result := False;
    exit;
  end;

  tmpDBName := ExtractFilePath(DBName) + 'temp.mdb';
  if dm1.ADOConnection2.Connected then dm1.ADOConnection2.Connected := false; //如果資料庫打開，則要先關閉
  try
    try
      DaoVar := CreateOleObject('DAO.DBEngine.36');
      if FileExists(tmpDBName) then DeleteFile(tmpDBName); //刪除臨時資料庫"temp.mdb"
        DaoVar.CompactDatabase(DBName, tmpDBName); //壓縮"dbName" 到"temp.mdb"
      if DeleteFile(DBName) then //刪除文件"dbName"
        RenameFile(tmpDBName, DBName); //將"temp.mdb"改名為"dbName "
      Result := true;
    except
      Result := false;
    end;
  finally
//    dm1.ADOConnection2.Connected := true; //為了其它操作能夠正常執行，還要打開資料庫連接。
  end;
end;

取得最上層的視窗名稱及程序名稱

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, psAPI, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Timer1: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
function   GetProcessPath(PID   :   Integer):   String;   
var
  hProcess:   THandle;
  hMod         :   hModule;
  cbNeeded:   DWORD;
  szProcessName:   array[0..1024]   of   Char;
begin
  hProcess := OpenProcess(PROCESS_QUERY_INFORMATION   OR   PROCESS_VM_READ,
                                                  FALSE,   PID   );
  szProcessName := 'unknown';
  if (hProcess<>0) then
  begin
    if (EnumProcessModules(hProcess,@hMod,sizeof(hMod),cbNeeded)) then
    begin
      GetModuleFileNameEx(hProcess,hMod,szProcessName,sizeof(szProcessName));
      Result := StrPas(szProcessName);
    end;
  end;
  CloseHandle(hProcess);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  wnd : THandle;
  szText: array[0..254] of char;
  ThreadId:   DWORD;
  FileName:string;
begin
  wnd:= GetForegroundWindow;
  if wnd <> 0 then
  begin
    if GetWindowText(wnd, @szText, 255)>0 then
      Label1.caption := szText;

    GetWindowThreadProcessId(wnd, ThreadId);
    FileName:=GetProcessPath(ThreadId);
    Label2.caption :=FileName;
  end;
end;


procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Button1.Click;
end;

end.

讓滑鼠游標漏辦不要再現

  {$R   *.RES}   
  begin   
      Application.Initialize;   
      Screen.Cursors[crHourGlass]   :=   Screen.Cursors[crDefault];   
      Application.CreateForm(TForm1,   Form1);   
      Application.Run;   
  end.   

建立classname，然後可以幫助判斷該classname是否關閉

註冊classname

  public
    procedure createparams(var params:tcreateparams);override;

  const
    TSFPatch729ClassName = 'abcde';

procedure TForm1.CreateParams(var Params: TCreateParams);
begin
  inherited;
  StrCopy(Params.WinClassName, _TSFPatch729ClassName);
end;

判斷classname

  const
    TSFPatch729ClassName = 'abcde';
  
  begin
    while isWindow(FindWindow(_TSFPatch729ClassName,nil)) do
    begin
      sleep(300);
    end;
  end;

檢查日期時間合不合法

procedure CheckDate(var nYear: Integer; var nMonth: Integer;
    var nDay: Integer);
begin
  //Check day
  case nMonth of
  1, 3, 5, 7, 8, 10, 12: begin
    //31 days
    if(nDay >=31) then
    begin
      //進位
      nMonth:=nMonth+1;
      nDay:=nDay-31;
      if(nMonth = 2) then
      begin
        if(nDay >= 28) then
          //還要進位
          CheckDate(nYear, nMonth, nDay);
      end
      else if(nDay >= 30) then
        //還要進位
        CheckDate(nYear, nMonth, nDay);
    end
    else if(nDay < 0) then
    begin
      //退位
      nMonth:=nMonth-1;
      //if(nMonth
    end;
    end;//break
  4, 6, 9, 11: begin
    //30 days
    end;//break
  2: begin
    if(((nYear-1900) mod 4) = 0) then
    begin
      //29 days
    end
    else
    begin
      //29 days
    end;
    end;//break
  end;
  //Check month
  if(nMonth > 12) then
  begin
    Inc(nYear);
    Dec(nMonth, 12);
  end
  else if(nMonth < 0) then
  begin
    Dec(nYear);
    nMonth:=12+nMonth;
  end;
end;
//---------------------------------------------------------------------------

procedure CheckDateTime(var nYear: Integer; var nMonth: Integer;
    var nDay: Integer; var nHour: Integer; var nMin: Integer;
    var nSec: Integer; var nMSec: Integer);
var
  a: Integer;

begin
  //Check Millisecond.
  if(nMSec >= 1000) then
  begin
    //進位
    a:=nMSec div 1000;
    nSec:=nSec+a;
    nMSec:=nMSec-a*1000;
  end
  else if(nMSec < 0) then
  begin
    //退位
    a:=nMSec div 1000;
    Inc(a);
    nSec:=nSec-a;
    nMSec:=a*1000+nMSec;
  end;
  //Check second.
  if(nSec >= 60) then
  begin
    //進位
    a:=nSec div 60;
    nMin:=nMin+a;
    nSec:=nSec-a*60;
  end
  else if(nSec < 0) then
  begin
    //退位
    a:=nSec div 60;
    Inc(a);
    nMin:=nMin-a;
    nSec:=a*60+nSec;
  end;
  //Check minute.
  if(nMin >= 60) then
  begin
    //進位
    a:=nMin div 60;
    nHour:=nHour+a;
    nMin:=nMin-a*60;
  end
  else if(nMin < 0) then
  begin
    //退位
    a:=nMin div 60;
    Inc(a);
    nHour:=nHour-a;
    nMin:=a*60+nMin;
  end;
  CheckDate(nYear, nMonth, nDay);
end;
//---------------------------------------------------------------------------

檔案的時間轉系統時間

function FileTimeToDateTime(var ft: FILETIME): TDateTime;
var
  //ft2: FILETIME;
  st: SYSTEMTIME;

begin
  Result:=0;
  if((ft.dwHighDateTime = 0) and (ft.dwLowDateTime = 0)) then
  begin
    Exit;
  end;
  //if(not FileTimeToLocalFileTime(ft, ft2)) then
  //begin
  //  Exit;
  //end;
  //if(not FileTimeToSystemTime(ft2, st)) then
  //  Exit;
  if(not FileTimeToSystemTime(ft, st)) then
    Exit;
  Result:=SystemTimeToDateTime(st);
end;

createFile鎖定且會closehandle刪除

  hfile := CreateFile('C:\TWO.TXT', // open TWO.TXT
    GENERIC_WRITE,        // open for writing 
    0,        // do not share 
    0,        // no security
    OPEN_ALWAYS,        // open or create
    FILE_FLAG_DELETE_ON_CLOSE,//FILE_ATTRIBUTE_NORMAL,        // normal file
    0);        // no attr. template




unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    procedure Button6Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
     hfile:THandle;

  public
    { Public declarations }
  end;

  FileHeader = packed record            //25 bytes
  uid                 : int64;
  mode                : array[1..5] of Char;     //模式
  begin_time          : TDateTime;      //開始錄影時間
  end_time            : TDateTime;      //結束錄影時間
  total_frame         : DWord;          //總共Frame 0~65535
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


function IsFileInUse(FileName: TFileName): Boolean;
var   
  HFileRes: HFILE;
begin   
    Result := False;
    if not FileExists(FileName) then Exit;   
    HFileRes := CreateFile(PChar(FileName),   
        GENERIC_READ or GENERIC_WRITE,   
        0,   
        nil,   
        OPEN_EXISTING,   
        FILE_ATTRIBUTE_NORMAL,   
        0);   
    Result := (HFileRes = INVALID_HANDLE_VALUE);   
    if not Result then   
        CloseHandle(HFileRes);   
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  uidHeader : int64;
  BytesRead : Cardinal;      //讀寫用參數
begin
  hfile := CreateFile('C:\TWO.TXT', // open TWO.TXT
    GENERIC_READ,        // open for READ 
    0,        // do not share 
    0,        // no security
    OPEN_ALWAYS,        // open or create
    FILE_FLAG_DELETE_ON_CLOSE,//FILE_ATTRIBUTE_NORMAL,        // normal file
    0);        // no attr. template

   ReadFile(hFile, uidHeader, SizeOf(uidHeader), BytesRead, nil);
   if uidHeader=23342542 then
    caption :='good';
   
   //ShowMessage(buf);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  caption := booltostr(IsFileInUse('C:\TWO.TXT'));
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  closehandle(hfile);
end;

procedure TForm1.Button4Click(Sender: TObject);
var
  a_fo : TSTReam;
  h : FileHeader;
begin
  a_fo:=TFileStream.Create('C:\TWO.txt',fmCreate);
  h.uid := 23342542;
  lstrcpy(@h.mode[1], pchar('abcde'));
  a_fo.Write(h, sizeof(h));
  a_fo.free;
end;

procedure TForm1.Button5Click(Sender: TObject);
var
  a_fo : TSTReam;
  h : FileHeader;
  z : int64;
begin
  a_fo:=TFileStream.Create('C:\TWO.txt',fmOpenRead);
  a_fo.Position := 0;
  a_fo.Read(h, sizeof(h));
  z:= h.uid;
  a_fo.free;

end;

procedure TForm1.Button6Click(Sender: TObject);
var
  uidHeader : int64;
  BytesRead, BytesWrite : Cardinal;      //讀寫用參數
  pBuf:array[0..1024-1]of   byte;
  nFileSize : integer;
begin
  hfile := CreateFile('C:\BT626.pdf', // open TWO.TXT
    GENERIC_WRITE,        // open for writing 
    0,        // do not share 
    0,        // no security
    OPEN_ALWAYS,        // open or create
    FILE_ATTRIBUTE_NORMAL,//FILE_ATTRIBUTE_NORMAL,        // normal file
    0);        // no attr. template
   nFileSize:=   GetFileSize(hfile,nil);

   caption := inttostr(nFileSize);
   
   ReadFile(hFile, pBuf, nFileSize, BytesRead, nil);
   SetFilePointer(hFile,0,nil,FILE_End);
   WriteFile(hFile,pBuf,nFileSize,BytesWrite,nil);
   closehandle(hfile);
end;

end.