Ağaç Yapısına Uygun Klasör Oluşturma

Yazdığınız makaleleri ve üyelerimizin işine yarayacağını düşündüğünüz kodlarınızı gönderebilirsiniz. Bu foruma soru sormayın!
Cevapla
Kullanıcı avatarı
vkamadan
Kıdemli Üye
Mesajlar: 1935
Kayıt: 17 Mar 2004 03:52
Konum: Adapazarı
İletişim:

Ağaç Yapısına Uygun Klasör Oluşturma

Mesaj gönderen vkamadan »

Merhabalar ,
Bu gün bir iş için var olmayan içe içe klasörleri oluşturma ihtiyacı doğdu (örn: C:\test\deneme\ali\veli\.......) Delphi7 ve üzeri sürümlerde ForceDirectorys fonksiyonu bu iş için fakat delphi 5 içinde bu fonksiyon gelmiyor ufak bir araştırmayla Delphi 3000 sitesinde aşağıdaki metodu buldum kullandım gayet başarılı paylaşmak istedim.

Kod: Tümünü seç

procedure MakeDir(Dir: String);
  function Last(What: String; Where: String): Integer;
  var
    Ind : Integer;

  begin
    Result := 0;

    for Ind := (Length(Where)-Length(What)+1) downto 1 do
        if Copy(Where, Ind, Length(What)) = What then begin
           Result := Ind;
           Break;
        end;
  end;

var
  PrevDir : String;
  Ind     : Integer;

begin
  if Copy(Dir,2,1) <> ':' then
     if Copy(Dir,3,1) <> '\' then
        if Copy(Dir,1,1) = '\' then
           Dir := 'C:'+Dir
        else
           Dir := 'C:\'+Dir
     else
        Dir := 'C:'+Dir;

  if not DirectoryExists(Dir) then begin
     // if directory don't exist, get name of the previous directory

     Ind     := Last('\', Dir);         //  Position of the last '\'
     PrevDir := Copy(Dir, 1, Ind-1);    //  Previous directory

     // if previous directoy don't exist,
     // it's passed to this procedure - this is recursively...
     if not DirectoryExists(PrevDir) then
        MakeDir(PrevDir);

     // In thats point, the previous directory must be exist.
     // So, the actual directory (in "Dir" variable) will be created.
     CreateDir(Dir);
  end;
end; 
Kullanımı ;

Kod: Tümünü seç

Usage:
MakeDir('\data\year\2000');

or

MakeDir('D:\TEST\PROGRAMS\NOVEMBER\'); 
Kaynak Adresi : http://www.delphi3000.com/articles/article_1543.asp?SK=

İyi çalışmalar.
Volkan KAMADAN
www.polisoft.com.tr
Cevapla