moze ja całośc podam
unit Main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls, ToolWin, ActiveX, ShlObj, ImgList;
type
TMainForm = class(TForm)
ListView: TListView;
tbTools: TToolBar;
tlbOpen: TToolButton;
OpenDialog: TOpenDialog;
SaveDialog: TSaveDialog;
tlbSave: TToolButton;
ImageList1: TImageList;
procedure tlbOpenClick(Sender: TObject);
procedure tlbSaveClick(Sender: TObject);
private
procedure Find(const Path : String);
function FileAttr(Attr : WIN32_FIND_DATA) : String;
end;
var
MainForm: TMainForm;
Dir : String;
implementation
{$R *.DFM}
procedure TMainForm.Find(const Path: String);
var
Found : Integer;
SR : TSearchRec;
ListItem : TListItem;
begin
{
Funkcja wyszukuje wszystkie pliki zawarte w katalogu okreslonym poprzez
parametr Path. Nastepnie znaleziony plik wraz z nazwa oraz atrybutem
dodaje do komponentu ListView.
}
Found := FindFirst(Path + '*.*', faAnyFile+faHidden+faSysFile+faReadOnly, SR);
while (Found = 0) do
begin
ListItem := ListView.Items.Add;
ListItem.Caption := LowerCase(SR.Name); * nazwa
{ Pobiera rozmiar i dzieli go przez 1024 otrzymujac ilosc kilobajtow }
ListItem.SubItems.Add(FloatToStr(SR.Size div 1024) + ' kB');
ListItem.SubItems.Add(FileAttr(SR.FindData)); * dodaj artybut poprzez wywolanie funkcji
Found := FindNext(SR); * szukaj dalej
end;
FindClose(SR); * zakoncz przeszukiwanie
end;
function TMainForm.FileAttr(Attr: WIN32_FIND_DATA): String;
begin
{
Funkcja parametr podany w nawiasie przeksztalca na
wartosc opisowa. Jezeli atrybutu nie mozna okreslic to zwraca
stosowny tekst.
}
case Attr.dwFileAttributes of
FILE_ATTRIBUTE_ARCHIVE : Result := 'Plik archiwalny';
FILE_ATTRIBUTE_COMPRESSED : Result := 'Plik skompresowany';
FILE_ATTRIBUTE_HIDDEN : Result := 'Plik ukryty';
FILE_ATTRIBUTE_READONLY : Result := 'Plik do odczytu';
FILE_ATTRIBUTE_SYSTEM : Result := 'Plik systemowy';
FILE_ATTRIBUTE_NORMAL : Result := 'Brak atrybutu';
else Result := 'Nie można określić';
end;
end;
procedure TMainForm.tlbOpenClick(Sender: TObject);
var BI:TBrowseInfo;
Dirs,Root:PItemIDList;
Alloc:IMalloc;
Buf : PChar;
begin
-
Pobieramy obiekt zarządzający pamięcią
SHGetMalloc(Alloc);
-
Przydzielamy pamięć na string
Buf:=Alloc.Alloc(Max_Path);
-
Ograniczamy wybór tylko do katalogu "Menu Start\Programs"
SHGetSpecialFolderLocation(Handle,CSIDL_DESKTOP,Root);
with BI do
begin
hwndOwner:= Handle;
pidlRoot:=Root; * Tu można podać NIL żeby można było wybrać każdy katalog
pszDisplayName:=Buf;
lpszTitle:='Wybierz katalog'; * Etykietka przed listą katalogów
ulFlags:=0;
lpfn:=nil;
end;
try
Dirs:=SHBrowseForFolder(BI);
if Dirs<>Nil then
begin
- Pobieramy pełną ścieżkę do katalogu
SHGetPathFromIDList(Dirs ,Buf);
- Przykładowe zastosowanie
Find(Buf);
Dir := Buf;
Alloc.Free(Dirs);
end;
finally
Alloc.Free(Root);
Alloc.Free(Buf);
end;
end;
procedure TMainForm.tlbSaveClick(Sender: TObject);
var
TF : TextFile;
FName, FAttr : String[20]; * na te pola przydziel max. 20 znakow
FSize : String[10]; * na te pole przydziel 10 znakow.
I : Integer;
function Add(sText : String; Index : Integer) : String;
var iLen : Integer;
begin
{
Jezeli tekst podany w parametrze sText jest krotszy niz wartosc
podana jako Index to do tej zmiennej dodawane sa spacje i zwracana
jest nowa zmienna.
}
iLen := Length(sText); * okresl dlugosc zmiennej
if iLen < Index then * Jezeli jest krotsza niz wartosc Index...
begin
repeat
Application.ProcessMessages;
iLen := Length(sText); * pobierz tekst jeszcze raz...
Insert(' ', sText, iLen + 1); * wstaw na koncu spacje
until iLen = 20; * kontynuuj dopoki zmienna nie osiagnie wartosc 20
end;
Result := sText; * zwroc nowa wartosc
end;
begin
if SaveDialog.Execute then * wywolaj okno
begin
AssignFile(TF, SaveDialog.FileName);
Rewrite(TF); * stworz okno
try
Writeln(TF, 'Plik wygenerowany automatycznie w dniu: ' + DateToStr(Date));
Writeln(TF, 'Oto zawartość katalogu: ' + Dir);
Writeln(TF, `);
Writeln(TF, ' | Nazwa pliku | Rozmiar | Atrybut pliku |');
Writeln(TF, ' |------------------------|--------------|------------------------|');
For I := 0 to ListView.Items.Count do
begin
{
Przypisz zmiennym wartosc poszczegolnych kolumn z komponentu ListView
}
FName := Add(ListView.Items.Item[i].Caption, 20);
FSize := Add(ListView.Items.Item[i].SubItems[0], 10);
FAttr := Add(ListView.Items.Item[i].SubItems[1], 20);
Writeln(TF, ' | ' + FName + ' | ' + FSize + ' | ' + FAttr + ' | ');
end;
Writeln(TF, `);
Writeln(TF, ' | W sumie plików: ' + IntToStr(ListView.Items.Count));
except
CloseFile(TF);
Exit; * w przypadku bledu - nie rob nic...
end;
CloseFile(TF); * zamknij plik
end;
end;
end.
(autor Adam Boduch )---= pozdrawiam Oskar =-