Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2002.06.06;
Скачать: [xml.tar.bz2];

Вниз

Обработка файлов   Найти похожие ветки 

 
Vadim_Kyznetsov   (2002-05-27 22:22) [0]

Помогите, пожалуйста, новичку. У меня возникло 2 вопроса:

1) как получить список всех файлов в одной папке ?
Для вызова диалога выбора папок использую следующий код (обязательно подключать
ShellAPI и ShlObj):

код:

procedure TForm1.Button1Click(Sender: TObject);
var TitleName : string;
lpItemID : PItemIDList;
BrowseInfo : TBrowseInfo;
DisplayName : array[0..MAX_PATH] of char;
TempPath : array[0..MAX_PATH] of char;

begin
FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);
BrowseInfo.hwndOwner := Form1.Handle;
BrowseInfo.pszDisplayName := @DisplayName;

TitleName := "Выберите папку"; //предложение при открытии диалога

BrowseInfo.lpszTitle := PChar(TitleName);
BrowseInfo.ulFlags := BIF_RETURNONLYFSDIRS;
lpItemID := SHBrowseForFolder(BrowseInfo);
if lpItemId <> nil then begin
SHGetPathFromIDList(lpItemID, TempPath);

showmessage(temppath); //в переменной temppath
//содержится путь к выбранной папке
GlobalFreePtr(lpItemID);
end;
end;


2) как сделать так, чтобы ProgressBar при чтении файла в буфер и записи
файла из буфера показывал РЕАЛЬНЫЙ % загрузки, а не что-нибудь
другое ?

Заранее премного благодарен !!!


 
rhf   (2002-05-27 22:36) [1]

ну для начала код выбора можно упростить или вообще вместо shBrofseForFolder использовать selectDirectory, эффект почти такой же.... но не важно.
Получить список всех файлов можно так: (они пишуться в listbox1)


var sr:tSearchRec;
......
findFirst(s+"\*.*,faAnyFile,sr);
repeat
application.processMessages;
if (sr.name<>".")and
(sr.name<>"..")and
(sr.attr<>faDirectory then
listBox1.items.add(sr.name);
until findNext(sr)<>0;
findClose(sr);


но а вообщето есть в API и оно заполняет listbox именами файлов из дериктории......сейчас поищу


 
rhf   (2002-05-27 22:42) [2]

вот так вот тоже можно заполнить listBox содержимым папки

ListBox1.Perform(LB_DIR, DDL_READWRITE or
DDL_HIDDEN or
DDL_SYSTEM or
DDL_READONLY,
Longint(pChar("c:\*.*")));


 
Vadim_Kyznetsov   (2002-05-27 22:54) [3]

Спасибо за совет, все работает !
А как же все-таки заставить ProgressBar показывать реальный % загрузки файла в буфер ? Пишу программку шифрования, так что очень хотелось бы видеть, как файл грузится в буфер.


 
rhf   (2002-05-27 22:58) [4]

выдай кусок кода где ты его считываешь


 
Vadim_Kyznetsov   (2002-05-28 06:52) [5]


var
myfile: file of byte; // файл
filebuf:array [0..1048575] of byte; // файловый буфер
filelen:integer; // размер файла

implementation

{$R *.dfm}

procedure LoadFile (FileName:string);
var
q:byte;
i:integer;

begin
assignfile(myfile,FileName);
reset(myfile);
filelen:=filesize(myfile);

for i:=0 to filelen-1 do
begin
read(myfile,q);
filebuf[i]:=q;
end;
closefile(myfile);

end;


{Манипуляции с файлом}
{Напрмер, функция XOR}

{
procedure XORFunction();

var
i:integer;
b1,b2,p1:byte;
ind:string;

begin
p1:=170;

for i:=0 to filelen-1 do
begin
b1:=buf[i];
b2:=b1 xor p1;
buf[i]:=b2;
inc (p1);
if p1>255 then begin p1:=170; end;

{ProgressBar1.Position:=(1048575 div filelen);

end;
end;
}

procedure SaveFile(FileName:String);
var
i:integer;
q:byte;

begin
assignfile(myfile,FileName);
rewrite(myfile);

for i:=0 to filelen-1 do
begin
q:=filebuf[i];
write(myfile,q);
end;
closefile(myfile);

end;



Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2002.06.06;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.46 MB
Время: 0.006 c
14-18099
dimich
2002-04-29 11:24
2002.06.06
Конфигурация компа для офиса.


14-18124
SPeller
2002-04-30 00:20
2002.06.06
К тем, кто знает Яву


1-18013
FireWorks
2002-05-24 11:28
2002.06.06
MapInfo


8-18064
windy
2002-01-19 07:05
2002.06.06
BMP -> JPEG


1-18009
Фантом
2002-05-24 13:06
2002.06.06
Запуск чужой программы в своем окне





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский