Pascal Disket için dosya böLÜCÜ

Disket için dosya bölücü Disket sığasından büyük dosyaları 1.44 MB'lık parçalara böler.
Bir de bunları birleştirmek için Setup oluşturur.
Program Hakkında

Geçen yaz 1.0 ve 2.0 versiyonlarını yaptığım
bu programın son halini (2.1) veriyorum.
1.0 versiyonu dosyaları oluştururken o kadar
yavaştı ki programın kitlendiğini zannederdiniz


read, write yerine blockread, blockwrite kullanırsanız
dosya işlemleriniz çok hızlı olur.


İşte Kodlar

Eğer Türkçe harfleri bozuk
görüyorsanız düzeltme işlemini .exe yi oluşturduktan
sonra deneyin, belki dos ortamında düzelirler.



PROGRAM Dosya_Bolucu;


USES Crt, Dos;


CONST
DISKSIZE = 1457664 ; {byte}
DSKMOD = 15894 ;
MAX = 65535;


TYPE
Buf= array[1..MAX] of Char;


VAR
PBuf : ^Buf;
FileNum, CurrFile, x : Byte;
FileIn, FileOut : File;
Batch : Text;
NumRead, NumWrite, Attr : Word;
FragByte : Longint;
Ok : Boolean;
Path : PathStr;
Dir : DirStr;
Name : NameStr;
Ext : ExtStr;


Procedure Kapat;
Begin
Dispose(PBuf);
WriteLn;
WriteLn(' Programdan ‡�kmak i‡in bir tuŸa bas�n.');
repeat
until KeyPressed;
WriteLn;
WriteLn(' Bye...');
Halt;
End;


BEGIN {program}
New(PBuf);
ClrScr;
TextColor(15);

WriteLn;
WriteLn(' File Fragmanter (for floppy) 2.1 by Levent Esen. (Temmuz 2004)');
WriteLn;
WriteLn(' Bu program disket s�§as�ndan b�y�k olan bir dosyan�z� disket ile aktarmak'
+' i‡in par‡alay�p taŸ�man�z� sa§lar.');
WriteLn;
WriteLn(' Kullan�m: Dosyay� program simgesinin �zerine s�r�kleyip b�rak�n yada');
WriteLn(' komut sat�r�ndan parametre olarak dosyan�n tam adresini girin.');
WriteLn;

if ParamCount <> 1 then
begin
WriteLn(' HATA: Parametre eksik!');
Kapat;
end;

WriteLn(' Kaynak dosya: ', ParamStr(1)); WriteLn;
Assign(FileIn, ParamStr(1));
GetFAttr(FileIn, Attr);
SetFAttr(FileIn, 0);
{$I-}
Reset(FileIn, 1);
{$I+}
if IOResult <> 0 then
begin
WriteLn(' Belirtilen dosya a‡�lamad�. Olas� ihtimaller :');
WriteLn;
WriteLn(' * Dosya ad� yanl�Ÿ.');
WriteLn(' (MsDos"daki ismini kullan�n)');
WriteLn;
WriteLn(' * Ge‡erli bir dosya de§il.');
WriteLn;
WriteLn(' * Dosya Sistemi hatas�.');
WriteLn(' (ScanDisk yap�n)');
Kapat;
end;

FileNum := (filesize(FileIn) div DISKSIZE) + 1 ;
FragByte := filesize(FileIn) mod DISKSIZE ;

if (FileNum = 1) then
begin
WriteLn(' Dosya disket s�§as�ndan k�‡�k.');
WriteLn(' ˜Ÿleme gerek yok.');
Kapat;
end
else
if (FileNum >= 100) then
begin
WriteLn(' Kaynak s�§as� 100"den fazla dosyaya b”lmeyi gerektiriyor! ');
WriteLn(' ˜Ÿlem yap�lam�yor.');
Kapat;
end;

Ok:=false;

repeat
{$I-}
MkDir('C:\FRAGFILE');
{$I+}
if (IOResult<>0) then
begin
WriteLn(' "C:\FragFile" dizinini silip ENTER"a bas�n..');
ReadLn;
end
else
Ok:=true;
until Ok;

WriteLn(' T�m ayarlar yap�ld�.');
WriteLn(' Dosyalar� iŸlem sonunda "C:\FragFile" klas”r�nde bulabilirsiniz.');
WriteLn(' BirleŸtirmek i‡in ayn� klas”rde yer alacak "SETUP.BAT" program�n� kullan�n.');
WriteLn(' Haz�rsan�z bir tuŸa bas�n ve bekleyin.');

repeat
until KeyPressed;

ChDir('c:\FragFile');
WriteLn; WriteLn;
WriteLn(' B”lme ˜Ÿlemi BaŸlad�.');
WriteLn;
Path:=ParamStr(1);
FSplit(Path, Dir, Name, Ext);

{********************* B”lme Rutini **************}

Assign(Batch, 'SETUP.BAT');
ReWrite(Batch);
WriteLn(Batch, '@echo off');
WriteLn(Batch, 'echo.');
WriteLn(Batch, 'echo "', Name+Ext, '" dosyas�n� birleŸtirmek �zeresiniz.');
WriteLn(Batch, 'echo.');
WriteLn(Batch, 'echo BirleŸtirilicek ', FileNum, ' dosyan�n da bu dizinde oldu§undan emin de§ilseniz'
+' CTRL+C"ye, haz�rsan�z, ');
WriteLn(Batch, 'pause');
Write(Batch, 'copy /b ');

for CurrFile:=1 to (FileNum-1) do
begin
WriteLn(' ', CurrFile, '/', FileNum, ' "inci dosya..');
Assign(FileOut, 'Data' + Chr(48 + (CurrFile div 10)) + Chr(48 + (CurrFile mod 10)) + '.pak');
Write(Batch, 'Data' + Chr(48 + (CurrFile div 10)) + Chr(48 + (CurrFile mod 10)) + '.pak+');
ReWrite(FileOut, 1);
for x:=1 to 22 do
begin
BlockRead(FileIn, PBuf^, MAX, NumRead);
BlockWrite(FileOut, PBuf^, NumRead, NumWrite);
end;
BlockRead(FileIn, PBuf^, DSKMOD, NumRead);
BlockWrite(FileOut, PBuf^, NumRead, NumWrite);
Close(FileOut);
end;

Assign(FileOut, 'Data' + Chr(48 + (FileNum div 10)) + Chr(48 + (FileNum mod 10)) + '.pak');
Write(Batch, 'Data' + Chr(48 + (FileNum div 10)) + Chr(48 + (FileNum mod 10)) + '.pak ');
WriteLn(' ', FileNum, '/', FileNum, ' "inci dosya..');
WriteLn(Batch, Name + Ext);
WriteLn(Batch, 'echo.');
WriteLn(Batch, 'echo ˜Ÿlem sona erdi.');
ReWrite(FileOut, 1);

for x:=1 to FragByte div MAX do
begin
BlockRead(FileIn, PBuf^, MAX, NumRead);
BlockWrite(FileOut, PBuf^, NumRead, NumWrite);
end;

BlockRead(FileIn, PBuf^, (FragByte mod MAX), NumRead);
BlockWrite(FileOut, PBuf^, NumRead, NumWrite);
SetFAttr(FileIn, Attr);
Close(Batch);
Close(FileOut);
Close(FileIn);
WriteLn;
WriteLn(' ˜Ÿlem bitti!');
WriteLn;
WriteLn(' Bye...');
END.