2015-04-15

[Delphi] 檔案處理相關

公司開發的ERP中有一個功能是品項主檔查詢時可以順便顯示該品項的照片,
但是圖檔可能在轉換的過程中編碼方式不一樣,Win7用內建瀏覽器看是正常的,
但Delphi在瀏覽時有些圖檔會出現格式錯誤的訊息( JPEG errpr #53 )

一開始很消極對使用者提示"檔案格式錯誤,請負責人員重新轉檔"的訊息,
但想想也不是辦法,所以花了點時間寫一個小程式,
讓我自己可批次列出讀取會發生錯誤的圖檔,自己重新加工過在放回系統中!

Delphi寫這麼久了,其實很少用到檔案處理這一塊,所以用這篇順便記錄一下用到的部分!


//**  抓取指定路徑檔案名稱
procedure _GetAllFiles(mask :String; isRecursiveSearch_ :Boolean; lst :TStrings);
var sr :TSearchRec;
    tExt :String;
    tDir :String;
begin
  tExt := ExtractFileName(mask);
  tDir := ExtractFilePath(mask);

  if tDir[Length(tDir)] <> '\' then
    tDir := tDir+'\';

  if FindFirst(mask, faAnyFile, sr) = 0 then
  begin
    repeat
      lst.Add(AnsiReplaceStr(Format('%s%s', [tDir, LOWERCASE(sr.Name)]),xFilePath,''));
    until FindNext(sr) <> 0;

    SysUtils.FindClose(sr);
  end;

  if isRecursiveSearch_ then
  begin
    if FindFirst(tDir + '*.*', faDirectory, sr) = 0 then
    repeat
     if ((sr.Attr and faDirectory) = faDirectory) and (sr.name[1] <> '.') then
       _GetAllFiles(Format('%s%s\%s', [tDir, LOWERCASE(sr.Name), tExt]), true, lst);
    until FindNext(sr)<>0;

    SysUtils.FindClose(sr);
  end;
end;

//**開窗讓使用者指定資料夾路徑
procedure SB_BroswerClick(Sender: TObject);
var xDir: WideString;
begin

  if SelectDirectory('請選擇目錄', '', xDir) then
  begin
    xFilePath := '';
    //ShowMessage(xDir);
    xFilePath :=  xDir+'\';
    _GetAllFiles(xFilePath+'*.jpg',TRUE,LB_ALLFile.Items);
  end;
end;

//** 在TImage載入圖片,讀取發生錯誤時將錯誤檔名放入TListBox
//**uses jpeg
Procedure _LoadProductPic(xFileNa:String);
begin
  //showmessage(xFilePath+xFileNa);
  if FileExists(xFilePath+xFileNa) then
  begin
    try
      Image_Disp.Picture.LoadFromFile(xFilePath+xFileNa);
    except
      LB_Error.Items.Add(xFileNa);
    end;
  end;
end;

//**複製讀檔錯誤檔案至子資料夾中
procedure SB_CopyClick(Sender: TObject);
var i:Integer;
    xCNT : Integer;
begin
  //**建立資料夾
  if not DirectoryExists(xFilePath+'ERROR') then
  begin
   if not CreateDir(xFilePath+'ERROR') then
     raise Exception.Create('無法建立資料夾');
  end;

  xCNT := 0;
  //**複製檔案
  for i:=0 to LB_Error.Items.Count-1 do
  begin
    try
      CopyFile(PChar(xFilePath+LB_Error.Items.Strings[i]),
               PChar(xFilePath+'ERROR\'+LB_Error.Items.Strings[i]),
               False);

      INC(xCNT);
    except
    end;
  end;

  showmessage('複製成功-'+IntToStr(xCNT));
end;

參考
Delphi K.Top-建立資料夾
Delphi K.Top-複製整個 Directory 及刪除整個 Directory 兩個函式! 
Delphi K.Top-copy正在使用中的檔案
【-Ma の 筆記本-】-[Delphi] 抓取使用者指定資料夾路徑
張貼留言