檢查CSV格式是否正確

//result: 0=正確CSV格式 1=檔案不存在 2=每列行數不一致

function isCSVFormat(sFileName: string): integer;

var

  slLine, slLineItem: TStringList;

  sLine: String;

  iLineItemCount: integer;

begin

  Result := 0;

  if not FileExists(sFileName) then

  begin

    Result := 1;  //檔案不存在

    exit;

  end;

  iLineItemCount := -1;

  slLine := TStringList.Create;

  slLineItem := TStringList.Create;

  try

    slLine.LoadFromFile(sFileName);

    for sLine in slLine do

    begin

      slLineItem.Delimiter := ',';

      slLineItem.StrictDelimiter := True;

      slLineItem.DelimitedText := sLine;

      if (iLineItemCount<>-1) and (iLineItemCount<>slLineItem.Count) then

      begin

        Result := 2;   //每列行數不一致

        break;

      end;

      iLineItemCount := slLineItem.Count;

    end;

  finally

    slLineItem.Free;

    slLine.Free;

  end;

end;

//result: 0=正確格式 1=第一列有欄位名稱重覆  2=第一列欄位不能空字串(包括空格, tab, 全形)  3=每列行數不一致

function isExactFormat(var slLine: TStringList): integer;

var

  slLineItem: TStringList;

  sLine: String;

  iLineItemCount: integer;

  i,j: integer;

begin

  Result := 0;

  iLineItemCount := -1;

  slLineItem := TStringList.Create;

  try

    for sLine in slLine do

    begin

      slLineItem.Delimiter := ',';

      slLineItem.StrictDelimiter := True;

      slLineItem.DelimitedText := sLine;

      if (iLineItemCount=-1) then

      begin

        for i := 0 to slLineItem.Count - 2 do

          for j := i+1 to slLineItem.Count - 1 do

            if CompareText(slLineItem.Strings[i], slLineItem.Strings[j])=0 then //大小寫視為相同

            begin

              Result := 1;   //第一列有欄位名稱重覆

              break;

            end;

        for i := 0 to slLineItem.Count - 1 do

          if Length(Trim(StringReplace(slLineItem.Strings[i],'　','',[rfReplaceAll])))=0 then

          begin

            Result := 2;   //第一列欄位不能空字串(包括空格, tab, 全形)

            break;

          end;

      end

      else if (iLineItemCount<>slLineItem.Count) then

      begin

        Result := 3;   //每列行數不一致

        break;

      end;

      iLineItemCount := slLineItem.Count;

    end;

  finally

    slLineItem.Free;

  end;

end;

取得檔案的修改時間

function GetFileAltertTime(FileName: string): string;
begin
  Result := FormatDateTime('yyyy-mm-dd hh:nn:ss', FileDateToDateTime(FileAge(FileName)));
end;

procedure TForm8.Button1Click(Sender: TObject);
begin
  caption := GetFileAltertTime('C:\Source\1.exe');
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.

判斷檔案是否被鎖住

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; 

設定目錄或文件的屬性

BOOL SetFileAttributes( LPCTSTR lpFileName, // file name DWORD dwFileAttributes // attributes ); dwFileAttributes : FILE_ATTRIBUTE_ARCHIVE FILE_ATTRIBUTE_HIDDEN FILE_ATTRIBUTE_NORMAL FILE_ATTRIBUTE_NOT_CONTENT_INDEXED FILE_ATTRIBUTE_OFFLINE FILE_ATTRIBUTE_READONLY FILE_ATTRIBUTE_SYSTEM FILE_ATTRIBUTE_TEMPORARY

SetFileAttributes(PChar(s),FILE_ATTRIBUTE_HIDDEN+FILE_ATTRIBUTE_READONLY);

讀取檔案版本資訊

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
{===========================================================================}
{           函式敘述:                                                       }
{               將十六進位字串轉換成整數                                    }
{           參數:                                                           }
{               十六進位字串                                                }
{           傳回值:                                                         }
{               轉換後的整數結果。若轉換失敗，會產生Exception               }
{===========================================================================}
function HexToInt(HexValue: String): DWORD;
const
  HexChar: set of Char = ['0'..'9','A'..'F'];
var
  iDegree:      DWORD;
  b:            Byte;
  ch:           Char;
begin
  Result := 0;
  if Length(Trim(HexValue))=0 then
    exit;
  iDegree := 1;
  b := Length(HexValue)+1;
  repeat
    Dec(b);
    ch := UpCase(HexValue[b]);
    // 檢查字元是否無誤
    if not (ch in HexChar) then
    begin
      raise Exception.Create('Unable Convert '+HexValue+' To Integer!');
      exit;
    end;
    if (ch<='9') then
      Result := Result+DWORD((Ord(ch)-48))*iDegree
    else
      Result := Result+DWORD((Ord(ch)-55))*iDegree;
    iDegree := iDegree * 16;
  until (b=1);
end;

//若取得錯誤則回傳''
function GetVersionNo(FilePath: string; var SpecialBuild: Boolean): string;
var VersinInfo: Pchar; //版本資訊
    VersinInfoSize: DWord; //版本資訊size (win32 使用)
    pv_info: PVSFixedFileInfo; //版本格式
    Mversion,Sversion:string; //版本No
begin
  Result := '';
  SpecialBuild := False;
  VersinInfoSize := GetFileVersionInfoSize(pchar(FilePath), VersinInfoSize);
  VersinInfo := AllocMem(VersinInfoSize);
  try
    if GetFileVersionInfo(pchar(FilePath), 0, VersinInfoSize, Pointer(VersinInfo)) then
    begin
      if VerQueryValue(pointer(VersinInfo), '\', Pointer(pv_info), VersinInfoSize) then
      begin
        //取得Special Build
        if (pv_info.dwFileFlags and VS_FF_SPECIALBUILD) = VS_FF_SPECIALBUILD then
          SpecialBuild:= True;
        //取得Product Version
        Mversion := IntToHex(pv_info.dwProductVersionMS, 0);
        Mversion := copy('00000000', 1, 8 - length(Mversion)) + Mversion;
        Sversion := IntToHex(pv_info.dwProductVersionLS, 0);
        Sversion := copy('00000000', 1, 8 - length(Sversion)) + Sversion;
        Result := FloatToStr(HexToInt(copy(MVersion, 1, 4))) + '.' +
            FloatToStr(HexToInt(copy(MVersion, 5, 4))) + '.' +
            FloatToStr(HexToInt(copy(SVersion, 1, 4))) + '.' +
            FloatToStr(HexToInt(copy(SVersion, 5, 4)));
      end;
    end;
  finally
    FreeMem(VersinInfo, VersinInfoSize);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  v: string;
  b: boolean;
begin
  v := GetVersionNo('C:/SendReport.exe', b);
  if v<>'' then
  begin
    print v,b;  
  end;
end;

end.

取得檔案大小

procedure TForm1.Button1Click(Sender: TObject);
var FileRec:TSearchrec;
begin
FindFirst('C:\blowfish11.rar',faAnyfile,FileRec);
SHOWMESSAGE(INTTOSTR(FILEREC.Size));
FindClose(FileRec);
end;

將CRC寫入檔頭程式碼

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Label1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
  DWordA  =array [0..13059] of DWord;
  WordA   =array [0..32766] of word;
  ByteA   =array [0..65534] of byte;
  DWordP  =^DWordA;
  WordP   =^WordA;
  ByteP   =^ByteA;

var
  Form1: TForm1;

implementation

{$R *.dfm}
var CRC32T:array[0..255] of DWord;
//==========================================================================
procedure MakeCRC32;
var i,j:Word;
    R:DWord;
begin
  for i:=0 to 255 do begin
    R:=i;
    for j:=8 downto 1 do
      if (R and 1)>0 then R:=(R shr 1) xor $EDB88320 else R:=R shr 1;
    CRC32T[i]:=R;
  end;
end;

//==========================================================================
function CRC32(K,D:DWord):DWord;
begin
  Result:=CRC32T[byte(K xor DWord(D))] xor (K shr 8);
end;

//==========================================================================
function CalcCRC(P:ByteP; Len:Integer; CRC:DWord):DWord;
var i:integer;
begin
  for i:=0 to Len-1 do CRC:=CRC32(CRC,P[i]);
  Result:=CRC;
end;

//==========================================================================
function FileCRC32(N:string):DWord;
const _Start=$40;
var Hd:integer;
    P:ByteP;
    L:DWord;
begin
  Result:=0;
  if FileExists(N) then begin
    Hd:=FileOpen(N,fmOpenRead+fmShareDenyNone);
    if Hd>0 then begin
      L:=FileSeek(Hd,0,2);          FileSeek(Hd,0,0);
      GetMem(P,L);
      if (L>_Start) and (DWord(FileRead(Hd,P^,L))=L) then
        Result:=CalcCRC(@P[_Start],L-_Start,$FFFFFFFF);
      FreeMem(P);
      FileClose(Hd);
    end;
  end;
end;

//==========================================================================
function UpdateCRC32(N:string; Chk:DWord):boolean;    // Write CRC to file
const _Start=$40;
var Hd,i:integer;
    D,R:array[0..7] of byte;    // $1E
begin
  Result:=False;
  DWordP(@D[2])[0]:=Chk; //20處開始由低位元塞CRC資料 若為DWordP(@D[3])[0] 則是從21處開始塞
  if FileExists(N) then begin
    Hd:=FileOpen(N,fmOpenReadWrite); //開啟N
      FileSeek(Hd,$1E,0);      FileWrite(Hd,D[0],8); //從1E開始
      FileSeek(Hd,$1E,0);      FileRead(Hd,R[0],8);

      Result:=TRUE;
      for i:=0 to SizeOf(D)-1 do if D[i]<>R[i] then Result:=False;
      FileClose(Hd);
    //end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var S:string;
    Result:integer;
    Chk,HChk:DWord;
begin
  Result:=0;       Chk:=0;
  if ParamCount>=1 then begin
    S:=ParamStr(1);  //參數1為檔名
    if FileExists(S) then begin
      Result:=1;    //傳回結果1
      MakeCRC32;            // Initialize CRC32初始化
      Chk :=FileCRC32(S);   // Calc CRC32 存於Chk中
      if ParamCount=2 then begin    //參數2為U UpdateCRC32成功傳回結果2,否則傳回3
        if (ParamStr(2)='U') and UpdateCRC32(S,Chk) then Result:=2
                                                    else Result:=3;
      end
    end;
  end;
  case Result of
    0: begin
         showmessage('CalcCRC32, Fineart Technology Co., LTD');
         showmessage('Ex: ['+ParamStr(0)+'] SourceFile [U]');
       end;
    1: showmessage(Format('%s CRC32=[%x]',[S,Chk]));
    2: showmessage(Format('%s CRC32=[%x] Update!',[S,Chk]));
    3: showmessage(Format('%s Update failure!',[S]));
  end;
end;
end.

SaveDioalog覆蓋檔案要注意到的事

檔執行開啟視窗後，有時候你用點擊的方式去想要覆蓋檔案，又或者是你想要自己打檔名而在檔名自己有加副檔名了，為了避免又多了一個副檔名，你可以用以下的方式，先將所有副檔名清除掉，然後再自己手動加上副檔名。
首先新增一個SaveDialog，並在filter設定好，及FileName可以預設一下檔案名稱
然後在按鈕事件下加入以下程式碼：

procedure TFmain.Button1Click(Sender: TObject);
var
  MsgRlt : integer;
  sFileName, sExeName : string;
begin
  if Savedialog1.Execute then
  begin
    sFileName := SaveDialog1.FileName;

    sExeName :=ExtractFileExt(sFileName);
    if (StrIComp(PChar(sExeName),'.exe' ) =0 ) then  //有的話要清掉
    begin
      sFileName := DeleteFileExt(sFileName);      // 匯出記錄程序
    end;
    sFileName := sFileName+ '.exe';               //最後再加上去


    //showmessage(sFileName);
    if (FileExists(sFileName)) then   //會自動再加exe判斷
    begin
      //showmessage(SaveDialog1.FileName);
      MsgRlt:=MessageBox(SaveDialog1.Handle,'檔案已存在，是否覆蓋？','MessageBox',MB_YESNO);

    end;
    if MsgRlt=IDNO then
    begin
      Button1.Click;
      exit;
    end;
  end;
end;

字串及陣列寫入及讀取檔案

新增4個TButton、1個TMemo、2個TEdit

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;
    Memo1: TMemo;
    Edit1: TEdit;
    Edit2: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  F : textfile;
begin
  AssignFile(F,'data.txt');
  ReWrite(F);

  //寫入數據
  WriteLn(F, Edit1.Text);
  WriteLn(F, Edit2.Text);
  CloseFile(F);
  Showmessage('寫入成功');
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  F : textfile;
  s1,s2 : string;

begin
  AssignFile(F,'data.txt');
  Reset(F);
  //讀取數據
  ReadLn(F, s1); //不能直接寫Edit1.Text
  ReadLn(F, s2); //不能直接寫Edit2.Text
  Edit1.Text := s1;
  Edit2.Text := s2;
  CloseFile(F);
  Showmessage('讀取成功');
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  n : array[1..100] of integer;
  i : integer;
  F : textfile;
begin
  AssignFile(F,'number.txt');
  Rewrite(F);
  for i := 1 to 100 do
  begin
    n[i] := i;
    Writeln(F,n[i]);
  end;
  CloseFile(F);
  Showmessage('寫入成功');
end;

procedure TForm1.Button4Click(Sender: TObject);
var
  n : array[1..100] of integer;
  i : integer;
  F : textfile;
begin
  AssignFile(F,'number.txt');
  Reset(F);
  i := 0;
  while not(EOF(F)) do begin
    i := i+1;
    Readln(F, n[i]);
    Memo1.Lines.add(inttostr(n[i]));
  end;
  closeFile(F);
  Showmessage('讀取成功');
end;

end.

開啟資料夾並搜尋檔案及得知其檔案大小

此可以做為新增MP3歌曲的功能，只要加入某個最上層目錄，就可以自動加入所有子目錄及其音樂。

新增2個TButton、1個TEdit、1個TMemo(ScrollBars屬性ssBoth)
兩個按鈕皆點兩下加入事件

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Edit1: TEdit;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    procedure GetFileSize(sPath : string);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1 : TForm1;
  Path : string;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  Dir: String;
begin
  Dir := '';
  if SelectDirectory('選擇文件夾', '', Dir) then
  begin
    if Copy(Dir,Length(Dir),1) <> '\' then
      Dir := Dir + '\';
    Edit1.text := Dir;  //Edit1顯示路徑
    Path := Dir;  //Path全域變數記錄Dir
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  GetFileSize(Edit1.text);
end;

procedure TForm1.GetFileSize(sPath : string);
var
  hFind     : THandle;
  filename, fPath  : string;
  nSize     : Int64;
  fd        : WIN32_FIND_DATA;
begin
  hFind:=Windows.FindFirstFile(PChar(sPath + '*.*'), fd); //所有檔案都找
  if(hFind <> INVALID_HANDLE_VALUE) then
  begin
    repeat
      filename:=fd.cFileName;
      fPath := sPath + filename;
      if((filename = '.') or (filename = '..')) then //不是上層 或 上上層
        Continue;
      if(fd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) > 0 then //是否為目錄
      begin
        GetFileSize(fPath + '\'); //遞迴呼叫 跑子目錄
      end else begin
        nSize:=fd.nFileSizeHigh;
        nSize:=nSize shl 32;
        nSize:=nSize or fd.nFileSizeLow;
        Memo1.lines.add(fPath+'       Size='+inttostr(nSize)=' bytes');
      end;
    until (not Windows.FindNextFile(hFind, fd));
    Windows.FindClose(hFind);
  end;
end;

end.

正確的刪除檔案步驟

procedure TForm1.Button1Click(Sender: TObject);
bDelete : boolean;
i : integer;
filename : string;
begin
  filename := 'C:\1.txt';
  if(not SetFileAttributes(PChar(filename), FILE_ATTRIBUTE_NORMAL)) then
  begin
    showmessage('file attribute to normal error !');
  end;
  i:=0;
  bDelete:=DeleteFile(filename);
  //刪5次試試
  while((i<5) and (not bDelete)) do
  begin
    Sleep(1000);
    bDelete:=DeleteFile(PChar(filename));
    Inc(i);
  end;
end;

XML自定規則的建檔及讀取方法

新增4個TButton，並點兩下加入事件。

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, XMLIntf, msxmldom, XMLDoc, XmlTool;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
//自定規則的建檔方法1
procedure TForm1.Button1Click(Sender: TObject);
var
  XD: IXMLDocument;
begin
  XD := NewXMLDocument;
  try
    XD.StandAlone := 'yes';
    XD.Encoding := 'UTF-8';
    XD.Options := [doNodeAutoIndent];
    XD.NodeIndentStr := #9;

    //在這裡用with來寫反而比較清楚
    with XD.AddChild('Family') do
    begin
      AddChild('Father').NodeValue := 'Bill Gates';  //子標籤
      AddChild('Mother').NodeValue := 'Lin Chiling';  //子標籤
      with AddChild('My') do   //子標籤
      begin
        Attributes['Name'] := 'Mouse';  //屬性
        Attributes['Age'] := 25;  //屬性
        with AddChild('Wife') do  //子子標籤
        begin
          NodeValue := 'Cat';
          Attributes['Age'] := 23;  //屬性
        end;
        with AddChild('Child') do  //子子標籤
        begin
          NodeValue := 'Mouse II';
          Attributes['Age'] := 1;  //屬性
        end;
        with AddChild('Child') do  //子子標籤
        begin
          NodeValue := 'Mickey Mouse';
          Attributes['Age'] := 15;  //屬性
        end;
        with AddChild('Child') do  //子子標籤
        begin
          NodeValue := 'Donald Duck';
          Attributes['Age'] := 14;  //屬性
        end;
      end;
      with AddChild('Uncle') do  //子標籤
      begin
        Attributes['Age'] := 35;  //屬性
        Attributes['Sex'] := 'Male';  //屬性
        AddChild('Wife').NodeValue := 'Jolin';  //子子標籤
      end;
    end;
    XD.SaveToFile('C:\Test.xml'); //存檔
    showmessage('存檔完成');
  finally
    XD := nil;  //釋放
  end;
end;

//自定規則的建檔方法2
procedure TForm1.Button2Click(Sender: TObject);
var
  XT: TXmlTool;
begin
  XT := TXmlTool.Create;
  try
    XT['/Family//Father'] := 'Bill Gates'; //目前目錄 /Family//
    XT['Mother'] := 'Lin Chiling'; //目前目錄 /Family//
    XT['My//@Name/'] := 'Mouse'; //目前目錄 /Family//MY// 其屬性
    XT['@Age'] := 25;
    XT['Wife//'] := 'Cat'; //目前目錄 /Family//MY//Wife//
    XT['@Age'] := 23;
    XT['../Child//'] := 'Mouse II'; //目前目錄 /Family//MY//Child//
    XT['@Age'] := 1;
    XT['../Child[1]//'] := 'Mickey Mouse'; //目前目錄 /Family//MY//Child// 第2個相同名字
    XT['@Age'] := 15;
    XT['../Child[2]//'] := 'Donald Duck'; //目前目錄 /Family//MY//Child// 第3個相同名字
    XT['@Age'] := 14;
    XT['../../Uncle//@Age'] := 35; //目前目錄 /Family//Uncle// 其屬性
    XT['@Sex'] := 'Male';
    XT['Wife//'] := 'Jolin'; //目前目錄 /Family//Uncle//Wife// 其屬性
    //目錄最後可以不寫//; 如XT['Wife//']->XT['Wife']; 但外加屬性的不行XT['../../Uncle//@Age'];
    XT.SaveToFile('C:\Test.xml');
    showmessage('存檔完成');
  finally
    XT.Free;
  end;
end;

//自定規則的讀取方法1
procedure TForm1.Button3Click(Sender: TObject);
var
  XD: IXMLDocument;
  i: Integer;
begin
  XD := LoadXMLDocument('C:\Test.xml');
  try
    ShowMessage(XD.ChildNodes['Family'].ChildValues['Father']); //內容
    ShowMessage(XD.ChildNodes['Family'].ChildValues['Mother']); //內容
    ShowMessage(XD.ChildNodes['Family'].ChildNodes['My'].Attributes['Name']); //屬性值
    ShowMessage(XD.ChildNodes['Family'].ChildNodes['My'].Attributes['Age']); //屬性值
    ShowMessage(XD.ChildNodes['Family'].ChildNodes['My'].ChildValues['Wife']); //內容
    ShowMessage(XD.ChildNodes['Family'].ChildNodes['My'].ChildNodes['Wife'].Attributes['Age']); //屬性值
    for i := 0 to XD.ChildNodes['Family'].ChildNodes['My'].ChildNodes.Count-1 do
      if XD.ChildNodes['Family'].ChildNodes['My'].ChildNodes[i].NodeName = 'Child' then //如果是Child
      begin
        ShowMessage(XD.ChildNodes['Family'].ChildNodes['My'].ChildNodes[i].NodeValue); //內容
        ShowMessage(XD.ChildNodes['Family'].ChildNodes['My'].ChildNodes[i].Attributes['Age']); //屬性值
      end;
    ShowMessage(XD.ChildNodes['Family'].ChildNodes['Uncle'].Attributes['Age']); //屬性值
    ShowMessage(XD.ChildNodes['Family'].ChildNodes['Uncle'].Attributes['Sex']); //屬性值
    ShowMessage(XD.ChildNodes['Family'].ChildNodes['Uncle'].ChildValues['Wife']); //內容
  finally
    XD := nil;
  end;
end;

//自定規則的讀取方法2
procedure TForm1.Button4Click(Sender: TObject);
var
  XT: TXmlTool;
begin
  XT := TXmlTool.Create('C:\Test.xml');
  try
    ShowMessage(XT['/Family//Father']); //內容
    ShowMessage(XT['Mother']); //內容
    if XT.SubNodes['My/'].First then
      repeat
        ShowMessage('1. '+XT.SubNodes['My/'].NodeXPath + '=' + XT.SubNodes['My/'].NodeValue); //My Name、Age及Wife、Child值
        if XT.SubNodes['My/'].SubNodes.First then
          repeat
            ShowMessage('2. '+XT.SubNodes['My/'].NodeXPath + '=' + XT.SubNodes['My/'].SubNodes.NodeValue); //Wife、Child的Age值
          until not XT.SubNodes['My/'].SubNodes.Next;
      until not XT.SubNodes['My/'].Next;
    ShowMessage(XT['Uncle//@Age']);   //屬性
    ShowMessage(XT['@Sex']);   //屬性
    ShowMessage(XT['Wife']);   //內容
  finally
    XT.Free;
  end;
end;

end.

XML TOOL

首先新增
3個TLabel;
3個TEdit;
1個TTreeView;
1個TRichEdit; 屬性ScrollBars=ssBoth
1個TOpenDialog; 屬性Filter=XML File (*.xml)|*.xml|Any File (*.*)|*.*; 屬性Title=Load XML File
1個TSaveDialog; 屬性Filter=XML File (*.xml)|*.xml|Any File (*.*)|*.*; 屬性Title=Save XML File
2個TBitBtn; 屬性Glyph加入自己的圖示;

程式須要 XMLTBase.pas 及 XMLTool.pas

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, XMLTool, XMLIntf, XMLDoc, Clipbrd, Buttons;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    TreeView1: TTreeView;
    RichEdit1: TRichEdit;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    procedure TreeView1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
  private
    FXmlTool: TXMLTool;
    { Private declarations }
  public
    procedure RefreshViewer;
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.RefreshViewer;
  procedure DrawTree(TreeNode: TTreeNode; XPath: string);
  var
    SubNode: TTreeNode;
  begin
    if (XPath <> '') and (XPath[Length(XPath)] <> '/') then
      XPath := XPath + '/';

    repeat
      if FXmlTool.SubNodes[XPath].NodeIsText then
      begin
        SubNode := TreeView1.Items.AddChildObject(
                TreeNode,
                FXmlTool.SubNodes[XPath].NodeName + ' = ''' + FXmlTool.SubNodes[XPath].NodeText + '''',
                Pointer(FXmlTool.SubNodes[XPath].Node)
            );
      end else begin
        SubNode := TreeView1.Items.AddChildObject(
                TreeNode,
                FXmlTool.SubNodes[XPath].NodeName,
                Pointer(FXmlTool.SubNodes[XPath].Node)
            );
      end;
      if FXmlTool.SubNodes[XPath].NodeHasChild or FXmlTool.SubNodes[XPath].NodeHasAttr then
        DrawTree(SubNode, FXmlTool.SubNodes[XPath].NodeXPath);
    until not FXmlTool.SubNodes[XPath].Next;

    if XPath = Edit2.Text + '/' then
    begin
      TreeView1.Selected := TreeNode;
      TreeNode.Expanded := True;
    end;
  end;
begin
  TreeView1.Items.Clear;
  DrawTree(TreeView1.Items.AddChildObject(nil, '/', Pointer(FXmlTool.Node['/'])), '/');
  TreeView1.Items[0].Expanded := True;  // 第一層展開的
  if (TreeView1.Selected = nil) and (TreeView1.Items.Count > 0) then
    TreeView1.Selected := TreeView1.Items[0];
  TreeView1Click(nil);
end;

procedure TForm1.TreeView1Click(Sender: TObject);
begin
  if TreeView1.Selected <> nil then
  begin
    Edit2.Text := FXMLTool.NodeToXPath(IXMLNode(TreeView1.Selected.Data));  //顯示XML PATH
    Edit3.Text := FXmlTool[Edit2.Text]; //顯示選擇標籤文字
    RichEdit1.Text := FXmlTool.NodeXML[Edit2.Text];   //顯示路徑下的所有內容
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FXmlTool := TXMLTool.Create;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
  begin
    FXmlTool.LoadFromFile(OpenDialog1.FileName);
    Edit1.Text := OpenDialog1.FileName; //Edit1文字為檔案路徑及檔名
    RefreshViewer;
  end;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
  SaveDialog1.FileName := Edit1.Text;
  if SaveDialog1.Execute then
  begin
    FXmlTool.SaveToFile(SaveDialog1.FileName);
    Edit1.Text := SaveDialog1.FileName; //算是另存新檔的感覺，所以要更名，但覆蓋並不顯示喔!
  end;
end;

end.

傳回及設定檔案的日期及時間

procedure TForm1.Button1Click(Sender: TObject);
begin
  // FileAge (傳回檔案的日期時間)
  // function FileAge(const FileName : string) : Integer;
  ShowMessage(DateTimeToStr(FileDateToDateTime(FileAge('c:\test.dat'))));
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  FileHandle : Integer;
begin
  // FileSetDate (設定檔案的日期及時間)
  // function FileSetDate(Handle : Integer; Age : Integer) : Integer;
  FileHandle := FileOpen('c:\test.dat', fmOpenReadWrite);
  if FileHandle = -1 then
    ShowMessage('開啟檔案失敗')
  else begin
    if FileSetDate(FileHandle, FileGetDate(FileHandle))=0 then
      ShowMessage('檔案日期時間設定成功')
    else
      ShowMessage('檔案日期時間設定失敗')
  end;
  FileClose(FileHandle);
end;

更改檔名及虛擬更改檔名

procedure TForm1.Button1Click(Sender: TObject);
begin
  // ChangeFileExt (改變指定檔案的副檔名，只傳回新檔名並未真正的改變)
  // function ChangeFileExt(const FileName, Extension : string) : string;
  ShowMessage(ChangeFileExt('c:\test.txt','.bak'));
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  // RenameFile (更改檔名)
  // function RenameFile(const OldName, NewName : string) : Boolean;
  if FileExists('c:\test.txt') then //判斷檔整是否存在
    if RenameFile('c:\test.txt','c:\test.dat') then
      ShowMessage('更名成功')
    else
      ShowMessage('更名失敗')
  else
    ShowMessage('指定檔案不存在');
end;

對Word文件進行操作

使用CreateOleObject方法對WORD文檔操作具有先天所具備的優勢，與delphi所提供的那些控件方式的訪問相比，CreateOleObject方法距離WORD核心的操作「更近」，因為它直接使用OFFICE所提供的VBA語言對WORD文檔的操作進行編程。

作法很簡單，在視窗Form上放置了一個TEdit和一個TButton，每按一次按鈕，就會自動把Edit中的內容添加在背景作業word文檔中，當程序關閉時文件自動儲存至當前程序目錄中。

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  //全域變數
  FWord: Variant;
  FDoc: Variant;


implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  FWord.Selection.TypeParagraph;  //換行
  FWord.Selection.TypeText(Text := form1.Edit1.Text);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  //首先創建對象，如果出現異常就作出提示
  try
    FWord := CreateOleObject('Word.Application'); //創建Word物件
    FWord.Visible := False;    //WORD程序的執行是否可見，值為False時程序在後台執行
  except
    ShowMessage('創建word對像失敗！');
    Exit;
  end;

  //先在打開的Word中創建一個新的頁面，然後在其中鍵入"Hello,"+回車＋"World！"
  try
    FDoc := FWord.Documents.Add;
    FWord.Selection.TypeText(Text := 'Hello，');
    FWord.Selection.TypeParagraph;  //換行
    FWord.Selection.TypeText(Text := 'World! ');
  except
    on e: Exception do
      ShowMessage(e.Message);
  end;
end;
//在程序關閉時把文件內容保存到當前目錄中，並以test.doc命名，同時關閉WORD程序
procedure TForm1.FormDestroy(Sender: TObject);
begin
  FDoc.SaveAs(ExtractFilePath(application.ExeName) +'test.doc'); //存檔
  FWord.Quit; //離開
  FWord := Unassigned; //取消分派
end;
end.

目錄交談視窗

新增5個TLabel
1個TEdit, Text=*.*
1個TFileListBox, FileEdit=Edit1, IntegralHeight=true(重新調整大小), 事件OnDbClick點兩下加入(以後用)
1個TFilterComboBox, FileList=FileListBox1, Filter=All files (*.*)*.*Executable files (*.exe)*.exeExecutable files (*.com)*.comDos batch files (*.bat)*.batDos Pif files (*.pif)*.pifWindows help files (*.hlp)*.hlpWindows bitmap files (*.bmp)*.bmpText files (*.txt)*.txt
1個TDirectoryListBox, DirLabel=Label4, FileList=FileListBox1(這兩個要在Events裡面才看得見)
1個TDriveComboBox1, DirList=DirectoryListBox1, 在事件OnChange點兩下加入(以後用)

程式碼

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Edit1: TEdit;
    FileListBox1: TFileListBox;
    FilterComboBox1: TFilterComboBox;
    DirectoryListBox1: TDirectoryListBox;
    DriveComboBox1: TDriveComboBox;
    Button1: TButton;
    Button2: TButton;
    procedure FileListBox1DblClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure DriveComboBox1Change(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  showmessage(Label4.Caption+'\'+Edit1.text);
end;

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

procedure TForm1.DriveComboBox1Change(Sender: TObject);
begin
  DirectoryListBox1.Drive := DriveComboBox1.Drive;
  FileListBox1.Drive := DriveComboBox1.Drive;
  FileListBox1.Directory := DirectoryListBox1.Directory;
end;

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

修改文件檔案屬性

faReadOnly ：唯讀
faHidden ：隱藏
faSysFile ：系統
faVolumeID ：卷標
faDirectory ：目錄
faArchive ：存檔
faAnyfile ：所有類型

//將文件檔案屬性設為隱藏
procedure TForm1.Button1Click(Sender: TObject);
var
  f:integer;
begin
f := fileGetAttr('test.sys');//得到文件屬性；
if f and faHidden = 0 then //是否有隱藏屬性；
  fileSetAttr('test.sys',faHidden);//設定為隱藏；
end;

{
//用以下寫法來判斷、顯示訊息也可以
case FileGetAttr('c：\command.dos') of
  faResdOnly:ShowMessage('ReadOnly');
  faHidden:ShowMessage('Hidden');
  faSysFile:ShowMessage('SystemFile');
  faVolumeID:ShowMessage('VolumeID');
  faDirectory:ShowMessge('Directory');
  faArchive:ShowMessage('Archive');
  faAnyFile:ShowMessage('AnyFile');
else
  ShowMessage('檔案不詳');

//用以下寫法來修改屬性也可以
if FileSetAttr('c：\autoexec.dos'，faReadOnly)=0 then
  ShowMessage('修改成功')
else
  ShowMessage('修改失敗');
}

OpenDialog 開啟檔案

我通常會新增一個按鈕，上面文字為".."，然後再新新一個OpenDialog元件，其中要注意是Filter屬性，加入下列文字
組態設定檔(*.ini)¦*.ini¦所有檔案(*.*)¦*.* //Filter name¦Filter
然後在button的onclick加入下列文字

procedure TFlogin.Button1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
  begin
    Edit1.Text:= OpenDialog1.FileName;
  end;
end;