wOxxOm
|
 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 и вставить туда код. |
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
