顯示具有 程式設計 標籤的文章。 顯示所有文章
顯示具有 程式設計 標籤的文章。 顯示所有文章

2010年2月28日 星期日

程式設計(Windows API) - 磁碟I/O的效能測試

今天花了不少時間, 把 Q9400 那台機器的 Host 及 Guest 建立起來, 也留下了部份安裝過程式的圖片, 等有空的時候再整理成安裝教學.

在這邊要談的是, 效能測試 的部份. 現在已經有不少應用軟體, 會用種種方式幫系統效能評分, 可是我們身為資訊人, 當然也要多了解一點實作的方法, 不能只看軟體跑出來的數字.

對磁碟效能, 最直覺的想法, 就是實際產生一個檔案, 然後讀取內容, 計算花費的時間就可以得到寫入的效能, 讀出的效能. 不過在 Windows 系統中, 為了加強效能, 所以大量的運用 Cache 和 Prefetch 的技巧, 所以在寫檔時, 可能檔案還在記憶體的 Cache 中, Windows 就已經回傳寫入完成給程式了, 讀取時更有可能因為剛才寫入的東西還留在 Cache 中, 跟本就沒有到檔案系統中讀取檔案, 而是直接從 Cache中傳回檔案內容. 這樣會造成檔案系統效能很好的錯覺, 或是運氣不好, 讀寫的過程中正好碰到 Cache 要將大量的資料寫回檔案系統, 造成系統效能降低的錯覺.

那麼要如何避免 Cache 的干擾, 而確實測試檔案系統的讀寫效能呢? 查了一下資料, 發現在 Windows API 中, 就有提供這樣的參數可用. 但要注意必需要能直接調用 Windows API 才能使用這些參數, 若使用程式語言內, 包裝過的 函數 去開啟檔案, 那就會用 Windows 的預設方式, 即透過 Cache 進行讀寫.

使用上其實很簡單, 只在要 Windows API 的 CreateFile 中, 設定參數值即可, CreateFile 的語法格式如下

Syntax (C++)

HANDLE WINAPI CreateFile(
  __in LPCTSTR lpFileName,
  __in DWORD dwDesiredAccess,
  __in DWORD dwShareMode,
  __in_opt LPSECURITY_ATTRIBUTES lpSecurityAttributes,
  __in DWORD dwCreationDisposition,
  __in DWORD dwFlagsAndAttributes,
  __in_opt HANDLE hTemplateFile
  );


詳細的參數請參考 MSDN 中的說明, 我要說重點是在參數 dwFlagsAndAttributes.

dwFlagsAndAttributes是 DWORD 類型參數, 每一個 Bit 代表不同的旗標(選項). 這邊主要針對 CACHE 相關的 2 個參數介紹

FILE_FLAG_WRITE_THROUGH (0x80000000) 此旗標會使任何對該控制代碼所做直接寫入檔案而不被緩衝的寫入,  但仍會寫入 Cache 中. 在設計上一般是運用在網路或外接裝置的寫出, 例如隨身碟的檔案寫入, 若未加入此參數, 在寫一個檔案到隨身碟, 不要退出硬體就直接拔出隨身碟, 你會發現剛才寫入的檔案居然不見了. 因為系統在傳回寫入成功後, 只是寫到 Cache 中, 還沒真的寫到外接裝置上.


FILE_FLAG_NO_BUFFERING (0x20000000) 此旗標是代表系統會排除所有緩衝先期讀取檔案和磁碟快取, 同時也使所有讀取都保證從 "檔案" 中取得, 不能從任何系統緩衝區或磁碟快取之中讀取. 不過有些特例, 像透過網路芳鄰讀取遠端的檔案, 系統會忽略此參數, 會先試著從 Cache 中讀取檔案內容.

這 2 個 Flag 可以分開設定, 也可以合併使用, 在設計檔案系統的讀寫效能測試時, 就可以下這 2個Flag, 先將檔案寫入到檔案系統中後, 再讀取該檔案的內容即可. 很簡單, 不是嗎?

2010年2月23日 星期二

程式設計(Delphi) - 移除超過日期的舊檔案

因為之前家裏車停放在門口時, 曾經被小偷敲破玻璃偷走音響/行車電腦. 在家門口裝了台攝影機, 接到電腦上錄影. 因為每天這樣錄下的容量還挺大的, 系統本身又沒有定期刪除舊資料的功能, 所以只好自己寫一個, 免得因為 硬碟空間不足, 而停止錄影.

這個程式適合中放在 Windows 排程中, 可設定每週執行一次, 只保留最近3天的檔案, 這樣就可避免硬碟容量被佔用問題. (會有人需要編好的執行檔嗎? 有需要的留個言吧!)




program rmFolder;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  windows,
  DateUtils,
  shellapi,
  classes;

procedure ShowSyntax() ;
begin
  writeln('移除超過指定天數前建立的目錄及子目錄') ;
  writeln('Syntax:') ;
  writeln(extractFilename(paramstr(0)),' [/D:天數] 路徑') ;
end ;

(*========================================
  取得超過指定期限的目錄(只找第一層), 存放在 slFolder 傳回.

  傳回值:
    符合條件的個數
*)
function GetFolderPath(sPath:string;iOld:integer;slFolder:TStringList):integer ;
var
  h : THandle ;
  dtSpecDate : TDateTime ;
  wfd : TWIN32FindData ;
  LocalFileTime : TFiletime ;
  systime : TSystemTime ;
  dt : TDateTime ;
begin
  result:=0 ;
  slFolder.Clear ;

  dtSpecDate:=today-iOld ;
  h:=findFirstFile(pchar(sPath+'*'),wfd) ;
  if h=INVALID_HANDLE_value then
    exit ;

  repeat
    if ((wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY)<>0) and
      (wfd.cFileName[0]<>'.') then
      begin
      FileTimeToLocalFileTime(wfd.ftCreationTime, LocalFileTime);
      if not FileTimeTosystemtime(localfiletime,systime) then
        exit ;
      dt:=systemtimetodatetime(systime) ;
      if dt<dtSpecDate then
        slFolder.Add(sPath+strpas(wfd.cFileName)) ;
      end ;
    until not FindNextFile(h,wfd) ;

  findClose(h) ;
  result:=slFolder.Count ;
end ;

Function DelTree(DirName : string): Boolean;
var
 SHFileOpStruct : TSHFileOpStruct;
 DirBuf : array [0..MAX_PATH] of char;
begin
 try
   Fillchar(SHFileOpStruct,Sizeof(SHFileOpStruct),0);
   FillChar(DirBuf, Sizeof(DirBuf), 0 );
   StrPCopy(DirBuf, DirName);
   with SHFileOpStruct do
     begin
     Wnd    := 0;
     pFrom  := @DirBuf;
     wFunc  := FO_DELETE;
     fFlags := FOF_SILENT or FOF_NOCONFIRMATION;
     end;
  Result := (SHFileOperation(SHFileOpStruct) = 0);
  except
    Result := False;
 end;
end;

var
  i, iCode : integer ;
  sPath : string ;
  slFolder : TStringList ;
  iDayOld : integer ;
begin

  if paramcount=0 then
    begin
    ShowSyntax() ;
    exit ;
    end ;

  sPath:='' ;
  iDayOld:=0 ;
  for i:=1 to paramcount do
    begin
    if copy(ParamStr(i),1,3)='/D:' then
      begin
      val(Copy(ParamStr(i),4,6),iDayOld,iCode) ;
      if iCode<>0 then
        begin
        Showsyntax() ;
        exit ;
        end ;
      end ;

    if DirectoryExists(ParamStr(i)) then
      begin
      sPath:=ParamStr(i) ;
      end ;
    end ;

  if AnsiLastChar(sPath)^<>'\' then
    sPath:=sPath+'\' ;

  slFolder:=TStringList.Create ;
  iCode:=GetFolderPath(sPath,iDayOld,slFolder) ;
  for i:=0 to iCode-1 do
    begin
    DelTree(slFolder[i]) ;
    end ;
end.

2010年2月20日 星期六

程式設計(Delphi) - 英文單字重新排列 (Mix-up Vocabulary)

因為兒子的寒假作業, 有一大題是英文單字的重組, 範圍是他上一學期的英文課本內的單字, 有點簡單的單字很容易就猜出來, 但是一些比較少用到的單字, 真的是想破頭也不知道, 課本又有上百頁的內容, 翻到呆掉. 所以寫了一個小程式, 可以重新列單字的字母順序, 這樣看到眼熟的拼法就可以比較快的找的答案. 未來要改善的話, 應再搭配英文字期進行查表, 可以更有效率. 不過這是應急用的程式, 先將就一下吧.

程式碼如下:





unit UMain;

interface

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

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

var
  sl : TStringList ;  // 存放可能的排列方式
  iTotal : integer ;  // 排列方式的計數器

// 使用 rescursive 進行排列, 不要輸入長度超過 8 的字串, 8!=40320種排列已經看呆了
// 傳入值: p: 尚未使用的字串, q:準備輸出的已排列字串
procedure remap(p, q : string) ;
var
  i, iLen : integer ;
begin
  if p='' then
    begin
    sl.Add(q) ;
    inc(iTotal) ;
    end ;

  iLen:=length(p) ;
  for i:= 1 to iLen do
    remap(copy(p,1,i-1)+copy(p,i+1,iLen-i), q+copy(p,i,1)) ;
end ;

procedure TForm1.Button1Click(Sender: TObject);
begin
  // 初始化
  sl:=TStringList.Create ;
  iTotal:=0 ;
  memoResult.Lines.Clear ;
  
  // 要重組的字串放在 edit1.text 中傳入
  remap(Edit1.Text,'') ;
  
  // 顯示可能的排列方式個數
  caption:=inttostr(iTotal) ;
  
  // 列出所有的排列方式
  memoResult.Lines.AddStrings(sl);
  
  // free memory
  sl.free ;
end;

end.





2010年2月18日 星期四

程式技巧(Delphi) - 包含子目錄的檔案複製 ( 有 檔案個數 及 檔案大小 2個進度列)

這個程式是拿來當範例用的, 還有許多地方可以加強, 例如對目的檔案的日期、屬性等訊息並未複製, 只有檔案內容的複製. 未處理 unicode 檔案, 未檢查空間是否足夠, 未用多執行緒加速...等. 不過已可達到 複製包含子目錄下的檔案, 並顯示進度列這 2 個基本需求





unit Utest;

interface

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

const
  _i32MB=32*1024*1024 ;

type
  TForm1 = class(TForm)
    LabelSrc: TLabel;
    EditSrc: TEdit;
    LabelTar: TLabel;
    EditTar: TEdit;
    btnCopy: TButton;
    ProgressBarByNum: TProgressBar;
    ProgressBarBySize: TProgressBar;
    procedure btnCopyClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    iNumofFiles : integer ;   // 記錄目錄下檔案總數
    i64SizeofFiles : int64 ;  // 記錄目錄下檔案大小總和
    pBuf : pointer ;
    function DoCopyFile(sSrcFile,sTarFile:string;iLeftNum:integer;var i64LeftSize:int64):boolean ;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
var
  slSrcFiles : TStringList ;

// 輸入: 要查詢的路徑(要含 *.*) , 要存放檔案大小總和的變數(用 int64避免4GB問題)
// 傳回值: 檔案總數
//         檔案列表會存放到 slSrcFiles 中, 此物件需在外部宣告
function TravelTree(sRoot:string; var i64TotalSize:int64):integer ;
var
  fd : WIN32_FIND_DATA ;
  h : Thandle ;
  sPath, sName : string ;
begin
  result:=0 ;
  h:=findfirstfile(pchar(sRoot),FD) ;
  if h=INVALID_HANDLE_VALUE then
    exit ;

  sPath:=ExtractFilePath(sRoot) ;
  repeat
    sName:=strpas(fd.cFilename) ;
    if (fd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY)=FILE_ATTRIBUTE_DIRECTORY then
      begin
      // 若是目錄則用 recursive
      if (sName<>'.') and (sName<>'..') then
        result:=result+TravelTree(sPath+sName+'\*.*',i64totalSize) ;
      end
    else
      begin
      result:=result+1 ;
      slSrcFiles.Add(sPath+sName) ;

      if fd.nFileSizeHigh=0 then
        i64TotalSize:=i64TotalSize+fd.nFileSizeLow
      else
        i64TotalSize:=i64TotalSize+(int64(fd.nFileSizeHigh)shl 32)+fd.nFileSizeLow ;
      end ;
    until FindNextFile(h,fd)=false ;
  windows.FindClose(h) ;
end ;

function TForm1.DoCopyFile(sSrcFile,sTarFile:string;iLeftNum:integer;var i64LeftSize:int64):boolean ;
var
  fsSrc, fsTar : TFileStream ;
  sPath : string ;
  iReadSize : integer ;
begin
  sPath:=extractFilePath(sTarFile) ;
  if not directoryExists(sPath) then
    forceDirectories(sPath) ;

  result:=true ;
  try
    fsSrc:=TFileStream.Create(sSrcFile,fmOpenRead);
    fsTar:=TFileStream.Create(sTarFile,fmCreate);
    try
      repeat
        iReadSize:=fsSrc.Read(pBuf^,_i32MB) ;
        fsTar.Write(pBuf^,iReadSize) ;
        i64LeftSize:=i64LeftSize-iReadSize ;

        // 更新 大小 的進度列
        progressBarBySize.Position:=round((i64SizeOfFiles-i64LeftSize)/i64SizeOfFiles*100) ;
        // 處理訊息, 例如中斷執行
        application.ProcessMessages ;
        until iReadSize<_i32MB ;
    finally
      fsSrc.Free ;
      fsTar.Free ;
      end ;
    // 更新 個數 的進度列
    progressBarByNum.Position:=round((iNumOfFiles-iLeftNum)/iNumOfFiles*100) ;
  except
    result:=false ;
    end ;
end ;

procedure TForm1.btnCopyClick(Sender: TObject);
var
  i64Size: int64 ;
  sTarPath, sTarFile, sSrcFile : string ;
  iSrcLen : integer ;
  i : integer ;
begin
  i64Size:=0 ;
  slSrcFiles:=TStringList.Create ;
  try
    // 計算目錄下的檔案總數及檔案大小總和
    iNumofFiles:=TravelTree(EditSrc.Text+'\*.*',i64Size) ;
    i64SizeOfFiles:=i64Size ;

    // 進度列用 百分比 計算
    progressbarByNum.Max:=100 ;
    progressbarBySize.Max:=100 ;
    progressbarByNum.Position:=0 ;
    progressbarBySize.Position:=0 ;

    i:=slSrcFiles.Count-1 ;
    iSrcLen:=length(editSrc.text)+1 ;
    sTarPath:=editTar.text ;
    if not directoryExists(sTarPath) then
      forceDirectories(sTarPath) ;
    while i>=0 do
      begin
      // 來源檔名
      sSrcFile:=slSrcFiles[i] ;
      // 目的檔名
      sTarFile:=sTarPath+copy(sSrcFile,iSrcLen,maxint) ;
      // 複製每一個檔案
      DoCopyFile(sSrcFile,sTarFile, i, i64Size) ;

      dec(i) ;
      end ;

  finally
    slSrcFiles.Free ;
    end ;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  getmem(pBuf,_i32MB) ;

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  freemem(pBuf,_i32MB) ;
end;

end.




2010年2月11日 星期四

程式技巧(Delphi) - Windows 內建的旋轉圖片函數 PlgBlt

Windows 系統有內建的旋轉圖片函數 PlgBlt , 但大多數寫 Windows 程式的人都不知道, 提供個範例

// 計算旋轉後的座標
function RotateXY(dbTheda:double;p1:TPoint):TPoint ;

const
  _dbLastT:double=-99999.999 ;
  _cosA:double=0.0 ;
  _sinA:double=0.0 ;
var
  dbA : double ;
begin
  if dbTheda<>_dbLastT then
    begin
    dbA:=dbTheda*Pi/180 ;
    _sinA:=sin(dbA) ;
    _cosA:=cos(dbA) ;
    _dbLastT:=dbTheda ;
    end ;

  Result.x:=round(p1.x*_cosA+p1.y*_sinA) ;
  Result.y:=round(-p1.x*_sinA+p1.y*_cosA) ;
end ;
 
// 將 image1 中的影像旋轉指定的角度
procedure TForm1.Button1Click(Sender: TObject);

var
  ptOrgCenter, ptTarCenter, ptc : TPoint ;
  pta : array[0..3] of TPoint ;
  ba : array[0..3] of integer ;
  i : integer ;
  bmp : TBitmap ;
  dbTheta : Double ;
begin
  ptOrgCenter.x:=Image1.Picture.Width div 2 ;
  ptOrgCenter.y:=Image1.Picture.Height div 2 ;

  dbTheta:=StrToFloat(Edit1.Text) ;
  pta[0]:=RotateXY(dbTheta,Point(0,0)) ;

  pta[1]:=RotateXY(dbTheta,Point(Image1.Picture.Width-1,0)) ;
  pta[2]:=RotateXY(dbTheta,Point(0,Image1.Picture.Height-1)) ;
  pta[3]:=RotateXY(dbTheta,Point(Image1.Picture.Width-1,Image1.Picture.Height-1)) ;

  bmp:=TBitmap.Create ;
  bmp.PixelFormat:=pf24bit ;
  bmp.Canvas.Brush.Color:=clBtnFace ;

  for i:=0 to 3 do
    ba[i]:=pta[i].x ;

  bmp.width:=MaxIntValue(ba)-MinIntValue(ba) ;

  for i:=0 to 3 do
    ba[i]:=pta[i].y ;

  bmp.Height:=MaxIntValue(ba)-MinIntValue(ba) ;

  ptc:=RotateXY(dbTheta,Point(Image1.Picture.Width div 2,Image1.Picture.Height div 2)) ;

  ptTarCenter.x:=bmp.Width div 2 ;
  ptTarCenter.y:=bmp.Height div 2 ;

  pta[0].x:=pta[0].x+ptTarCenter.x-ptc.x ;
  pta[0].y:=pta[0].y+ptTarCenter.y-ptc.y ;
  pta[1].x:=pta[1].x+ptTarCenter.x-ptc.x ;
  pta[1].y:=pta[1].y+ptTarCenter.y-ptc.y ;
  pta[2].x:=pta[2].x+ptTarCenter.x-ptc.x ;
  pta[2].y:=pta[2].y+ptTarCenter.y-ptc.y ;

  PlgBlt(bmp.Canvas.Handle,pta,Image1.Canvas.Handle,0,0,image1.Picture.Width-1,image1.Picture.Height-1,0,0,0) ;

  Canvas.Draw(0,0,bmp) ;

  bmp.SaveToFile(ExtractFilePath(Application.Name)+'111.bmp') ;  // 將結果存成 BMP 檔案
  bmp.free ;
end;