Pascal Disket için dosya bölücü

CorsaiR · 11 Ağu 2007

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 basn.');
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§asndan byk olan bir dosyanz disket ile aktarmak'
+' i‡in par‡alayp taŸmanz sa§lar.');
WriteLn;
WriteLn(' Kullanm: Dosyay program simgesinin zerine srkleyip brakn yada');
WriteLn(' komut satrndan parametre olarak dosyann 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 kullann)');
WriteLn;
WriteLn(' * Ge‡erli bir dosya de§il.');
WriteLn;
WriteLn(' * Dosya Sistemi hatas.');
WriteLn(' (ScanDisk yapn)');
Kapat;
end;

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

if (FileNum = 1) then
begin
WriteLn(' Dosya disket s§asndan 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 yaplamyor.');
Kapat;
end;

Ok:=false;

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

WriteLn(' Tm ayarlar yapld.');
WriteLn(' Dosyalar iŸlem sonunda "C:\FragFile" klas”rnde bulabilirsiniz.');
WriteLn(' BirleŸtirmek i‡in ayn klas”rde yer alacak "SETUP.BAT" programn kullann.');
WriteLn(' Hazrsanz bir tuŸa basn 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, '" dosyasn birleŸtirmek zeresiniz.');
WriteLn(Batch, 'echo.');
WriteLn(Batch, 'echo BirleŸtirilicek ', FileNum, ' dosyann da bu dizinde oldu§undan emin de§ilseniz'
+' CTRL+C"ye, hazrsanz, ');
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.

Coded By Levent Esen.

Pascal Disket için dosya bölücü

CorsaiR

Emektar

Sosyal medya sayfalarımız