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

Вниз

Нужно узнать размер файла после сжатия.   Найти похожие ветки 

 
stupid   (2002-05-27 15:23) [0]

Открыв файл, я вывожу его размер на форме. После нажатия на кнопку запускаеться внешняя программа, которая сжимает файл, открытый в моем приложении. Хотелось бы показать его размер после сжатия. Как это можно сделать на практике? Вот структура всего процесса:

1. Открытие файла в моем приложении
2. Отображения размера файла на форме до сжатия
3. Запуск внешней программы, которая сжимает файл, открытый в моем приложении
4. Отображение размера файла на форме после сжатия //Не реализовано

Конечно, можно положить на форму кнопку, по нажатию на которую будет определяться размер после сжатия, но это мне не очень подходит.

Вот функция, с помощью которой я определяю размер файла, может, кому-нибудь сгодиться.

Function GetFileSize(namefile : string) : Integer;
Var
InfoFile : TSearchRec;
AttrFile : Integer;
ErrorReturn : Integer;
Begin
AttrFile := $0000003F;
ErrorReturn := FindFirst(namefile,AttrFile,InfoFile);
if ErrorReturn <> 0 Then
Result := -1
else
Result := InfoFile.Size; {Размер файла в байтах}
FindClose(InfoFile);
End;

//Вызов функции. (выводит размер файла в байтах в Label1):
Label1.Caption:=inttostr(GetFileSize("c:\kuku.txt"))+ " байт";


 
Song   (2002-05-27 15:27) [1]

Сжимаете чем? Архиватором? Во многих архиваторах есть ключик при ктором в файл выводится различная информация о файлах в этом архиве, в том числе и размеры файла(ов) со сжатием, до сжатия, степень сжатия и т.д.


 
Romkin   (2002-05-27 15:28) [2]

FindFirstChangeNotification (FindNext) - следит за изменениями в файле/каталоге. При записи в файл другой программой возврат происходит после завершения записи. (и не забывай о FindClose...)


 
stupid   (2002-05-27 15:30) [3]

2Song © (27.05.02 15:27)

Сжимаю UPX"ом.
У него такого ключика нет.


 
stupid   (2002-05-27 15:53) [4]

2Romkin © (27.05.02 15:28)

Можешь объяснить на примере?


 
ION T   (2002-05-27 16:04) [5]

Очередной шелл для юпикса пишешь?

Зайди в кладовку (раздел с готовыми прогами) - там возьми исходники моего и переделывай как хочешь.....и посмотри в юнит MultiFrm.pas, там есть несколько функций для анализа размера файла...


 
Romkin   (2002-05-27 16:25) [6]


procedure TForm1.Button1Click(Sender: TObject);
var
ChHandle: THandle;
WaitCode: DWORD;
begin
ChHandle :=
FindFirstChangeNotification("d:\", false, FILE_NOTIFY_CHANGE_SIZE);
if ChHandle = INVALID_HANDLE_VALUE then
begin
ShowMessage("Cant create notify: " + IntToHex(GetLastError,8));
Exit;
end;
Button1.Enabled := False;
try
repeat
repeat
WaitCode :=
MsgWaitForMultipleObjects(1, ChHandle, False, INFINITE, QS_ALLINPUT);
if WaitCode = (WAIT_OBJECT_0 + 1) then
Application.ProcessMessages;
until (WaitCode = WAIT_OBJECT_0) or (WaitCode = WAIT_ABANDONED_0);
if WaitCode = WAIT_OBJECT_0 then
begin
if MessageDlg("Size of some file in d:\ changed... Continue?",
mtConfirmation, [mbYes, mbNo], 0) = mrNo
then
raise Exception.Create("OK! Exit now...");
if not FindNextChangeNotification(ChHandle) then
raise Exception.Create("Cant create next notify: " +
IntToHex(GetLastError,8));
end;
until (WaitCode = WAIT_ABANDONED_0);
finally
FindCloseChangeNotification(ChHandle);
Button1.Enabled := True;
end;
end;


 
stupid   (2002-05-27 17:03) [7]

Всем огромное спасибо!

2ION T © (27.05.02 16:04)
Отличный UPX Shell. Просто отличный!
Грузонул исходники, буду разбираться.
Я так понял на внешний вид оболочки сказался вид ASPack"a?

2Romkin © (27.05.02 16:25)
Огромное спасибо за код, на исходниках я только и учусь.
Практика, практика и еще раз практика...



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

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

Наверх





Память: 0.46 MB
Время: 0.005 c
6-18090
Зинец Виктор
2002-03-26 15:16
2002.06.06
Вопрос про Mailslot


1-17954
AL2002
2002-05-28 10:21
2002.06.06
Delphi Manual?


1-17951
PSZ
2002-05-27 17:49
2002.06.06
Есть ли какая-нибудь функции перекодировка строки


1-17900
ctapik-net
2002-05-27 13:07
2002.06.06
Создать инсталяшку


3-17787
BOOMER
2002-05-15 13:54
2002.06.06
ERROR IN MS SQL Server





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский