| View previous topic :: View next topic |
| Author |
Message |
wOxxOm
Joined: 12 Feb 2006
Posts: 30
|
 (Separately) Posted: Sun Feb 12, 2006 23:30 Post subject: "умный" компрессор NTFS файлов для total |
 |
|
Написал свою первую прогу на winApi в delphi - 50 кило. Ногами не бить. Вешается на горячую клавишу в меню запуска тотала или на кнопку. Параметр запуска: "%L" - это файл-список выделенного в панели тотала. Сжимает на ntfs диске то, что ужмется больше, чем в 1.2 раза. То есть сжимается все подряд (те что уже сжатые, те не трогаются), а потом прога смотрит на разницу в размерах и разжимает, если плохо сжалось. Неэффективно, но вписать в прогу анализатор сжимаемости наподобие winrar'а не умею. Настроек ini нету, потом напишу. А лучше если интересно и лучше меня знаете winApi/Delphi то допишите до ума. Интерфейс кодировать еще не умею  поэтому что получилось, то и ловите.
Предистория
1. У меня давно все диски NTFS
2. на NTFS можно прозрачно сжимать файлы на уровне системы
3. Сейчас процы гораздо быстрее веников и сжатый файл грузится быстрее, чем несжатый
4. Софт жмется в полтора разы, некоторый - в три(!!) - это gta san andreas - с 4.5 гигов до 1.5 гигов
5. Пользоваться стандартным способом сжатия через свойства файла/папки долго, нудно, неудобно
6. Пользоваться горячей клавишей для запуска compact /c /s:"%p" * можно, но в любом случае : нельзя этой тупой проге передать список файлов, да и главное - если она сжимает, то подряд, а часто бывает, что файл в 1 гиг ужимается до 900 мег - кому надо такая экономия?
| Code: |
program CompressFile;
uses
windows, messages, sysUtils, strUtils;
{$R *.res}
{$V-,B-,X+,H+,J+}
const
prcOK = 1.2;
WndTitle='Compress File on NTFS';
WndClass='ntfsCompress';
wndW:word=200;
wndH:word=50;
var
Wnd:HWND; Msg:TMSG; Wc:TWndClassEx; log, font: HWND; DC: HDC;
h:dword; BytesReturned,fattr:DWORD; Buffer:Short;
fsize,fsize2,totalS,totalS2: longword; i,j:integer;
dirsToDo: boolean;
t:text; fname,ss:string; logS: string; tWH:TSize;
ScreenH, ScreenW: word; offsH, ttlH: word; wndR,clR: TRECT;
function _str(const v:double; field,digits:word):string;
begin str(v:field:digits,result); end;
function WindowProc( Wnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM ): LRESULT; stdcall;
begin Result:=0;
case Msg of
WM_DESTROY: begin PostQuitMessage(0); Exit; end;
end;
Result:=DefWindowProc( Wnd, Msg, wParam, lParam );
end;
procedure adjustWindowSize(const s:string; logAdded:boolean);
var reposition:boolean; newH:word;
begin
if GetTextExtentPoint32(dc, pchar(s), length(s), tWH) then begin
reposition:=false; newH:=ttlH+offsH+20+tWH.cy*word(logAdded);
if (tWH.cx>wndW-20) and (tWH.cx<ScreenW/1.3) then
begin wndW:=tWH.cx+20; reposition:=true; end;
if logAdded and (newH>wndH) and (newH<ScreenH div 2) then
begin wndH:=newH; reposition:=true; end;
while tWH.cy*word(logAdded)+offsH>wndH-20-ttlH do begin //scroll
ss:=copy(logS,1,pos(#13#10,logS)-1);
logS:=copy(logS,length(ss)+3,$7FFF);
GetTextExtentPoint32(dc, pchar(ss), length(ss), tWH);
dec(offsH, tWH.cy);
end;
if logAdded then begin
inc(offsH,tWH.cy);
if not reposition and (tWH.cx>wndW-20) then
inc(offsH,tWH.cy*(tWH.cx div (wndW-20)));
end;
if reposition then begin
SetWindowPos(log,0,10,10,wndW-20,wndH-ttlH-20,SWP_NOZORDER or SWP_NOREDRAW);
SetWindowPos(wnd,0,(ScreenW-wndW)div 2,(ScreenH-wndH)div 2,wndW,wndH,SWP_NOZORDER);
end;
end;
end;
function formatSize(S:longword):string;
begin
if S>$40000000 then result:=_str(S/$40000000,7,2)+'GB' else
if S>$100000 then result:=_str(S/$100000,7,2)+'MB' else
if S>$400 then result:=_str(S/$400,7,2)+' kB'
else begin result:=_str(S,7,0)+' B '; exit; end;
S:=length(result)-3;
while result[S]='0' do begin result[S]:=' '; dec(S); end;
end;
function fileSize(fH:DWORD; var S:longword; const cFN:string):string;
var L:cardinal;
begin result:='';
if cFN<>'' then L:=GetCompressedFileSize(pchar(cFN),@S)
else L:=GetFileSize(fH,@S);
if L=$FFFFFFFF then exit;
S:=S shl 32 or L;
result:=formatSize(S);
end;
procedure processMsg;
begin
if PeekMessage(Msg, wnd, 0, 0, 0) then
begin TranslateMessage(Msg); DispatchMessage(Msg); end;
if getAsyncKeyState(VK_ESCAPE)<>0 then
begin postquitmessage(0); halt; end;
end;
procedure processFile(const fname:pchar; fattr:dword);
var fd:_WIN32_FIND_DATA; fh:dword; s:string; fa:dword;
begin
processMsg;
if fattr and FILE_ATTRIBUTE_DIRECTORY <> 0 then begin
fh:=FindFirstFile(pchar(fname+'*'),fd);
if fh=INVALID_HANDLE_VALUE then exit;
repeat
if (pchar(@fd.cFileName)<>'.') and (pchar(@fd.cFileName)<>'..') then begin
s:=string(fname)+pchar(@fd.cFileName);
fa:=GetFileAttributes(pchar(s));
if fa and FILE_ATTRIBUTE_DIRECTORY<>0 then s:=s+'\';
processFile(pchar(s),fa);
end;
until not findNextFile(fh,fd);
windows.findClose(fh);
end;
if (fattr and FILE_ATTRIBUTE_DIRECTORY=0)
and (fattr and FILE_ATTRIBUTE_COMPRESSED <> 0) then exit;
H:=CreateFile(PChar(fname), GENERIC_READ or GENERIC_WRITE,
FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0);
ss:='Size: '+fileSize(H,fsize,'')+#9': ';
logS:=logS+ss+fname+#13#10;
setWindowText(log, pchar(logS));
adjustWindowSize(ss+fname,true);
GetClientRect(wnd,wndR); InvalidateRect(wnd,@wndR,false); updateWindow(wnd);
if H<>INVALID_HANDLE_VALUE then
try Buffer:=1;
DeviceIoControl(h, $9C040, @Buffer, 2, nil, 0, BytesReturned, nil);
processMsg;
ss:=fileSize(0,fsize2,fname);
inc(totalS,fsize); inc(totalS2,fsize2);
if totalS2=0 then s:='' else s:=_str(totalS/totalS2,6,3);
setWindowText(wnd,pchar('NTFS Compress files. '+formatSize(totalS)+' --> '+
formatSize(totalS2)+'. ratio is '+s));
if ss<>'' then begin if fsize2=0 then fsize2:=1;
ss:='-->'+ss+#9': '+_str(fsize/fsize2,5,2)+#9;
i:=length(logS)-4; while (i>0) and (logS[i]<>#13) do dec(i);
if (logS[i]=#13) and (i>0) then inc(i,2) else inc(i);
j:=posEx(#9': ',logS,i);
if j=0 then j:=i+2;
ss:=ss+copy(logS,j+1,$7FFF);
logS:=copy(logS,1,j-3)+ss;
ss:=copy(logS,i,$7FFF);
setWindowText(log, pchar(logS));
adjustWindowSize(ss,false);
if fsize/fsize2<prcOK then begin
logS:=copy(logS,1,length(logS)-2)+' [no gain: DECOMPRESS]'#13#10;
adjustWindowSize(ss+' [no gain: DECOMPRESS]',false);
buffer:=0;
DeviceIoControl(h, $9C040, @Buffer, 2, nil, 0, BytesReturned, nil);
inc(totalS2,fsize-fsize2);
setWindowText(wnd,pchar('NTFS Compress files. '+formatSize(totalS)+' --> '+
formatSize(totalS2)+'. ratio is '+_str(totalS/totalS2,6,3)));
end;
end;
finally
CloseHandle(h);
end;
end;
begin
with wc do begin
cbSize:=SizeOf(wc); style:=CS_HREDRAW or CS_VREDRAW;
lpfnWndProc:=@WindowProc;
cbClsExtra:=0; cbWndExtra:=0; hInstance:=hInstance;
hIcon:=LoadIcon( 0, IDI_APPLICATION );
hCursor:=LoadCursor( 0, IDC_ARROW );
hbrBackground:=COLOR_WINDOW;
lpszMenuName:=nil; lpszClassName:=WndClass;
end;
RegisterClassEx(Wc);
ScreenW:=GetSystemMetrics(SM_CXSCREEN); ScreenH:=GetSystemMetrics(SM_CYSCREEN);
Wnd:=CreateWindowEx(0, WndClass, WndTitle, WS_OVERLAPPEDWINDOW,
(ScreenW-wndW)div 2, (ScreenH-wndH)div 2, wndW, wndH, 0, 0, hInstance, nil);
getClientRect(wnd,clR); ttlH:=wndH-clR.Bottom;
log:=CreateWindowEx(0, 'Static', '', WS_CHILD or WS_VISIBLE
or WS_EX_LEFT or SS_LEFTNOWORDWRAP,
10, 10, wndW-20, wndH-20-ttlH, Wnd, 1, hInstance, nil );
font:=CreateFont(16,0,0,0,0,0,0,0,ANSI_CHARSET,0,0,0,0,'Arial');
if font=INVALID_HANDLE_VALUE then font:=CreateFont(16,0,0,0,0,0,0,0,ANSI_CHARSET,0,0,0,0,'MS Sans Serif');
if font=INVALID_HANDLE_VALUE then font:=getStockObject(ANSI_VAR_FONT);
SendMessage(log, WM_SETFONT, font, 1);
DC:=getDC(0); logS:=''; offsH:=0;
ShowWindow(Wnd, SW_SHOWNORMAL);
fname:=paramStr(1); if fname[1]='"' then fname:=copy(fname,2,length(fname)-2);
assign(t,fname); try reset(t) except exit end;
dirsToDo:=false; totalS:=0;totalS2:=0;
repeat
readln(t,fname); fattr:=GetFileAttributes(pchar(fname));
if fattr and FILE_ATTRIBUTE_DIRECTORY <> 0 then
begin DirsToDo:=true; continue; end;
if fattr and FILE_ATTRIBUTE_COMPRESSED <> 0 then continue;
processFile(pchar(fname),fattr);
until eof(t);
if DirsToDo then begin reset(t);
while not eof(t) do begin readln(t,fname);
fattr:=GetFileAttributes(pchar(fname));
if fattr and FILE_ATTRIBUTE_DIRECTORY <> 0 then
processFile(pchar(fname),fattr);
end;
end;
Halt(Msg.wParam);
end.
|
если нужна иконка для файла, то в CompressFile.rc пишем:
IDR_MAINFRAME ICON DISCARDABLE "CompressFile.ico"
и копируем любую иконку с именем CompressFile.ico, затем компилируем .rc файл: "brcc32.exe CompressFile.rc"
затем билдим в дельфи, все.
P.S. Ясное дело когда в delphi делаешь новый проект он создает форму и юнит, их надо закрыть, не сохраняя, потом в Project->View source и вставить туда код. |
|
| Back to top |
|
 |
fa1con
Joined: 19 Aug 2006
Posts: 162
|
| (Separately) Posted: Fri Apr 13, 2007 20:46 Post subject: |
|
|
| Кто-то пользовался этим? Выложите кто-то бинарник плз. Если ли в природе аналогичные проги? |
|
| Back to top |
|
|
wOxxOm
Joined: 12 Feb 2006
Posts: 30
|
|
| Back to top |
|
|
DrShark
Joined: 21 Oct 2006
Posts: 911
Location: Kyiv, Ukraine
|
| (Separately) Posted: Sat May 03, 2008 09:32 Post subject: |
|
|
C тех пор, как я обзавёлся несколькими разделами с NTFS, я заинтересован в этой проге.
У кого-то остался бинарник? |
|
| Back to top |
|
|
wOxxOm
Joined: 12 Feb 2006
Posts: 30
|
|
| Back to top |
|
|
Стас Агарков
Joined: 05 Feb 2007
Posts: 130
Location: Белгород
|
| (Separately) Posted: Sat May 03, 2008 13:25 Post subject: |
|
|
Странная прога. Можно сказать, не работает даже. Создал пустой файл из нулей 10 Мб, она думала секунд 10, в конце концов закончила, но в свойствах файла так и остался размер 10 Мб. Поставил в стандартных свойствах файла галочку «Сжимать» и через секунду файл сжался и размер на диске стал 4 Кб.
Да и в Таненбауме я читал, что NTFS сам сжимает по такому принципу. Если 16 блоков не смогли сжаться хотя бы в 15, то он разжимает обратно. |
|
| Back to top |
|
|
wOxxOm
Joined: 12 Feb 2006
Posts: 30
|
| (Separately) Posted: Sat May 03, 2008 13:30 Post subject: |
|
|
| понимаю, но все, что вы сказали, не имеет места быть здесь ^_^ |
|
| Back to top |
|
|
Стас Агарков
Joined: 05 Feb 2007
Posts: 130
Location: Белгород
|
| (Separately) Posted: Sat May 03, 2008 13:33 Post subject: |
|
|
Я вас не понял.
P.S. А GTA SA у вас так хорошо сжалась, потому что там вся музыка нулями забита... |
|
| Back to top |
|
|
Моторокер
Joined: 06 May 2005
Posts: 1517
Location: г. Пермь (читается Перьмь)
|
| (Separately) Posted: Sun May 04, 2008 13:26 Post subject: Re: "умный" компрессор NTFS файлов для total |
|
|
| wOxxOm wrote: | | вписать в прогу анализатор сжимаемости наподобие winrar'а не умею |
Подсчитать количество каждого символа и если количество примерно одинаковое, то не сожмётся. Чем больше разброс, тем больше сожмётся.
_________________
плагины для Total Commander, статьи Graphics Converter; NSCopy; SEO HTML; KillOK; Плагин на Delphi
ПармаСруб - строительство домов и бань в Перми |
|
| Back to top |
|
|
DrShark
Joined: 21 Oct 2006
Posts: 911
Location: Kyiv, Ukraine
|
| (Separately) Posted: Thu Jun 12, 2008 22:36 Post subject: |
|
|
Тулза фактически не сжимает файлы в Windows Vista, не смотря на отображаемый коеффициент. То ли админ прав не хватает, то ли в ОС что-то поменялось.
А при попытке сжатия прогой некоторых файлов на системном диске WinVista разразилась БлуСкрином при следующей загрузке.
После самовосстановления она показала такое сообщение:
| Quote: | [Window Title]
Microsoft Windows
[Main Instruction]
Windows восстановлена после непредвиденного завершения работы
[Content]
При следующем подключении к Интернету Windows может провести поиск способа устранения этой ошибки.
[V] Показать подробности проблемы [Отложить поиск решений] [Отмена]
Сигнатура проблемы:
Имя события проблемы: BlueScreen
Версия ОС: 6.0.6001.2.1.0.768.3
Код языка: 1058
Дополнительные сведения об этой проблеме:
BCCode: d1
BCP1: 00000014
BCP2: 00000002
BCP3: 00000000
BCP4: 8CD58066
OS Version: 6_0_6001
Service Pack: 1_0
Product: 768_1
Файлы, содержащие сведения об этой проблеме:
C:\Windows\Minidump\Mini061208-01.dmp
C:\Users\Vladislav\AppData\Local\Temp\WER-74147-0.sysdata.xml
C:\Users\Vladislav\AppData\Local\Temp\WERB099.tmp.version.txt
Прочтите заявление о конфиденциальности:
http://go.microsoft.com/fwlink/?linkid=50163&clcid=0x0419 |
|
|
| Back to top |
|
|
LonerD
Joined: 04 Jan 2011
Posts: 1172
Location: Макеевка
|
| (Separately) Posted: Mon Jun 11, 2012 20:45 Post subject: |
|
|
Утилитка не получила развитие?
Если остался - перевыложите бинарик.
Какие ещё аналоги есть? Можно без умного сжатия. Чтобы выделить несколько файлов/папок на панели, ткнуть кнопочку (хоткей) - и они сжались. |
|
| Back to top |
|
|
MVV
Joined: 15 Oct 2009
Posts: 4815
Location: Ростов-Дон
|
|
| Back to top |
|
|
LonerD
Joined: 04 Jan 2011
Posts: 1172
Location: Макеевка
|
| (Separately) Posted: Mon Jun 11, 2012 23:58 Post subject: |
|
|
MVV
Спасибо за наводку. Истина где-то рядом.
Подозревал, что есть в винде штатное средство, но в целом сжатием пока особой надобности пользоваться не было. |
|
| Back to top |
|
|
Mellomann
Joined: 07 Sep 2009
Posts: 709
|
| (Separately) Posted: Thu Jul 12, 2012 21:32 Post subject: |
|
|
Да тут, собственно, и изучать практичски нечего... | Code: | COMPACT [/C | /U] [/S[:папка]] [/A] [/I] [/F] [/Q] [имяФайла [...]]
/C Сжатие выбранных файлов. Папки маркируются так, чтобы добавляемые позже файлы также были сжаты.
/U Распаковка выбранных сжатых файлов. Папки маркируются так, чтобы добавляемые позже файлы не были сжаты.
/S Выполнение указанной операции над файлами в выбранной папке и всех ее подпапках. По умолчанию используется текущая папка.
/A Отображение файлов с атрибутами "скрытый" и "системный". По умолчанию эти файлы пропускаются.
/I Продолжение выполнения указанной операции даже после возникновения ошибок. По умолчанию выполнение программы COMPACT прерывается при возникновении ошибки.
/F Принудительное сжатие всех выбранных файлов, даже если некоторые из них уже сжаты. По умолчанию сжатые файлы пропускаются.
/Q Вывод лишь наиболее существенных сведений.
имяФайла Имя файла, имя папки или шаблон имен файлов.
При вызове без параметров программа COMPACT отображает состояние сжатия для текущей папки и всех содержащихся в ней файлов. Допускается ввод нескольких имен файлов или подстановочных знаков. Если указаны несколько параметров, они разделяются пробелами. |
Да и анализатора тоже не хватает...
Может кто написать утильку-анализатор, которая просто будет читать что есть и на основе существующего алгоритма NTFS жать это всё просто в памяти (не сохраняя на диск), а затем выдавая процент сжатия?
Вопрос о расходе памяти не стоит - пускай хоть всё в памяти держит, ибо пару гигчиков оперативки я могу на это выделить, а файлы >2Гб меня на сжатие сейчас интересуют мало...
з.ы
Опционально (если возможно) можно встроить и функцию самого сжатия файлов при достижении некоего приемлемого процента, но ТОЛЬКО посредством передачи списка имён файлов стандартной программе COMPACT с нужными параметрами (так проще и надёжнее). |
|
| Back to top |
|
|
DrShark
Joined: 21 Oct 2006
Posts: 911
Location: Kyiv, Ukraine
|
| (Separately) Posted: Tue Jul 17, 2012 23:26 Post subject: |
|
|
| LonerD wrote: | Утилитка не получила развитие?
Если остался - перевыложите бинарик. |
Версия от 27.06.2006 (на SkyDrive)
_________________
"the light is coming to give back everything the darkness stole"
—©@AG4 |
|
| Back to top |
|
|
|
|
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum
|
Powered by phpBB © 2001, 2005 phpBB Group
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
