Delphi - Verzeichnisse ersetellen

[b0bby]

Hallo!
Ich versuche gerade ein Programm zu schreiben, mit dem Ich Verzeichnisse erstelenn kann.
Also Jahreszahl eingeben und dann wird ein Ordner mit der Jahreszahl ersetllt und in dem Ordner die Unterordner der Monate. Allerdings finde ich den Code etwas aufgebläht Könnte da mal jemand drüber schauen? Thx.
Und dann noch eine Frage:
Ich hätte gerne noch so einen Dialog, wo man dann einen Pfad auswählen kann und dort sollen die Ordner erstellt werden. Wie geht das? Habe noch nichts dazu gefunden.

procedure TForm1.Button1Click(Sender: TObject);
var
  Dir1, Dir2, Dir3, Dir4, Dir5, Dir6, Dir7, Dir8, Dir9, Dir10, Dir11, Dir12, k: string;
  i : integer;
begin
  Dir1 := 'D:\'+EJahr.text+'\01_Januar';
  Dir2 := 'D:\'+EJahr.text+'\02_Februar';
  Dir3 := 'D:\'+EJahr.text+'\03_März';
  Dir4 := 'D:\'+EJahr.text+'\04_April';
  Dir5 := 'D:\'+EJahr.text+'\05_Mai';
  Dir6 := 'D:\'+EJahr.text+'\06_Juni';
  Dir7 := 'D:\'+EJahr.text+'\07_Juli';
  Dir8 := 'D:\'+EJahr.text+'\08_August';
  Dir9 := 'D:\'+EJahr.text+'\09_September';
  Dir10 := 'D:\'+EJahr.text+'\10_Oktober';
  Dir11 := 'D:\'+EJahr.text+'\11_November';
  Dir12 := 'D:\'+EJahr.text+'\12_Dezember';

  begin
  if ForceDirectories(Dir1)
  AND ForceDirectories(Dir2)
  AND ForceDirectories(Dir3)
  AND ForceDirectories(Dir4)
  AND ForceDirectories(Dir5)
  AND ForceDirectories(Dir6)
  AND ForceDirectories(Dir7)
  AND ForceDirectories(Dir8)
  AND ForceDirectories(Dir9)
  AND ForceDirectories(Dir10)
  AND ForceDirectories(Dir11)
  AND ForceDirectories(Dir12) then
    Label1.Caption :='Alle Verzeichnisse wurden erfolgreich erstellt.'
   end;
end;

 

[xelix]

Folgender Code stammt von Michael Puff:

function OpenFolder(root: Integer; Caption: string): string;
//Verzeichnis-Öffnen-Dialog-Funktion
var
  bi: TBrowseInfo;
  lpBuffer: PChar;
  pidlPrograms, pidlBrowse: PItemIDList;
begin
  if (not SUCCEEDED(SHGetSpecialFolderLocation(GetActiveWindow, root,
    pidlPrograms))) then
    exit;
  lpBuffer := StrAlloc(MAX_PATH);
  bi.hwndOwner := GetActiveWindow;
  bi.pidlRoot := pidlPrograms;
  bi.pszDisplayName := lpBuffer;
  bi.lpszTitle := PChar(Caption);
  bi.ulFlags := BIF_RETURNONLYFSDIRS;
  bi.lpfn := nil;
  bi.lParam := 0;

  pidlBrowse := SHBrowseForFolder(bi);
  if (pidlBrowse <> nil) then
    if SHGetPathFromIDList(pidlBrowse, lpBuffer) then
      Result := lpBuffer;
  StrDispose(lpBuffer);
end;

Aufruf mit:

OpenFolder(CSIDL_DRIVES, 'Choose directory');

Achso, statt die Variablen von Dir1 bis Dir12 zu benutzen, würde ich das in ein Array packen.

var DirArray:array[1..12] of string;

Um die Werte zuzuweisen machst du dann einfach:

var i:integer;
For i := 1 to 12 do begin

DirArray[i] := 'D:\'+EJahr.text+'\' + IntToStr(i);

 

[MArc]

Hallo B0bby,

um so etwas zu machen, würde ich dir Schleifen empfehlen.
Siehe hier mal mein Beispiel.

procedure TForm1.Button1Click(Sender: TObject);
var
  MyMonth: array[0..11] of string;
  MyYear: string;
  MyI: Integer;
  MyStatus : boolean;
begin
  MyYear := EntryFeldVomJahr.Text;
  MyMonth[0] := 'Januar';
  MyMonth[1] := 'Februar';
  MyMonth[2] := 'März';
  MyMonth[3] := 'april';
  MyMonth[4] := 'mai';
  MyMonth[5] := 'juni';
  MyMonth[6] := 'juli';
  MyMonth[7] := 'Agust';
  MyMonth[8] := 'September';
  MyMonth[9] := 'oktoboer';
  MyMonth[10] := 'november';
  MyMonth[11] := 'dezember';

  //Ordner erstellen
  for MyI := 0 to 11 do
  begin
    if not (ForceDirectories('F:\'+MyYear+'\'+IntToStr(MyI)+'_'+MyMonth[MyI])) then
       MyStatus := false;
  end;
  //Prüfen ob Fehler vorhanden ist
  if (MyStatus) then
    ShowMessage('Alle Ordner erfolgreich erstellt')
  else
    ShowMessage('Fehler beim Ordner erstellen');

end;

Um ein Pfad auszuwählen benötigst du folgenden Befehl:

SelectDirectory('Ordner auswählen', '' ,MyPfad);

Dieser benötigt die Unit: FileCtrl. Also einfach via "uses FileCtrl;" einbinden.

Wenn du SelectDirectory benutzt, wird der Pfad in MyPfad abgespeichert.
Das anpassen wirst du, denk ich, Schaffen.

Gruss,
MArc