Bedava forum kurmak | ©phpBB | Bedava yardımlaşma forumu | Suistimalı göstermek | Yetkinblog.com
ForumAlem

ForumAlem
 
AnasayfaAnasayfa  SSSSSS  AramaArama  Üye ListesiÜye Listesi  Kullanıcı GruplarıKullanıcı Grupları  Kayıt OlKayıt Ol  Giriş yapGiriş yap  

Paylaş | 
 

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

Önceki başlık Sonraki başlık Aşağa gitmek 
YazarMesaj
ToPrAk
Admin
Admin
avatar

Mesaj Sayısı : 457
Kayıt tarihi : 05/08/08
Yaş : 28
Nerden : KONYA

MesajKonu: Pascal Disket için dosya böLÜCÜ   Cuma Ağus. 08, 2008 6:01 pm

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.
Sayfa başına dön Aşağa gitmek
Kullanıcı profilini gör
 
Pascal Disket için dosya böLÜCÜ
Önceki başlık Sonraki başlık Sayfa başına dön 
1 sayfadaki 1 sayfası

Bu forumun müsaadesi var:Bu forumdaki mesajlara cevap veremezsiniz
ForumAlem :: Programlama Dilleri :: PascaL-
Buraya geçin: