Экспертная система Delphi.int.ru

Сообщество программистов
Общение, помощь, обмен опытом
Логин:
Пароль:
Регистрация | Забыли пароль?

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

#   

Статистика за сегодня:  


Лучшие эксперты

Подробнее »

Вопрос # 63

Раздел: Delphi » Работа с файловой системой
/ вопрос открыт /

здраствуте
прочитал я статю - Копирование файлов - Выпуск #43 (08 марта 2006 г.) и вот сечас все мучаюсь как переделать код чтоб не скопировать файл - а чтоб соединить два файла.
за ранее благодарен

Приложение:
  1.  
  2. type
  3.  
  4.  
  5. procedure FastFileCopy(Const InfileName, OutFileName: String; CallBack: TCallBack);
  6.  
  7. type
  8. PBuffer = ^TBuffer;
  9. TBuffer = array [1..BufSize] of Byte;
  10. var
  11. Size : integer;
  12. Buffer : PBuffer;
  13. infile, outfile : File;
  14. SizeDone,SizeFile: Longint;
  15. begin
  16. if (InFileName <> OutFileName) then
  17. begin
  18. buffer := Nil;
  19. AssignFile(infile, InFileName);
  20. System.Reset(infile, 1);
  21. try
  22. SizeFile := FileSize(infile);
  23. AssignFile(outfile, OutFileName);
  24. System.Rewrite(outfile, 1);
  25. try
  26. SizeDone := 0; New(Buffer);
  27. repeat
  28. BlockRead(infile, Buffer^, BufSize, Size);
  29. Inc(SizeDone, Size);
  30. CallBack(SizeDone, SizeFile);
  31. BlockWrite(outfile,Buffer^, Size)
  32. until Size < BufSize;
  33. FileSetDate(TFileRec(outfile).Handle,
  34. FileGetDate(TFileRec(infile).Handle));
  35. finally
  36. if Buffer <> Nil then Dispose(Buffer);
  37. System.close(outfile)
  38. end;
  39. finally
  40. System.close(infile);
  41. end;
  42. end else
  43. Raise EInOutError.Create('File cannot be copied into itself');
  44. end;
  45.  
  46.  
  47. procedure FileCopy(Const SourceFileName, TargetFileName: String);
  48. var
  49. S,T : TFileStream;
  50. begin
  51. S := TFileStream.Create(sourcefilename, fmOpenRead );
  52. try
  53. T := TFileStream.Create(targetfilename, fmOpenWrite or fmCreate);
  54. try
  55. T.CopyFrom(S, S.Size ) ;
  56. FileSetDate(T.Handle, FileGetDate(S.Handle));
  57. finally
  58. T.Free;
  59. end;
  60. finally
  61. S.Free;
  62. end;
  63. end;
  64.  
  65.  
  66. uses LZExpand;
  67.  
  68. procedure CopyFile(FromFileName, ToFileName : string);
  69. var
  70. FromFile, ToFile: File;
  71. begin
  72. AssignFile(FromFile, FromFileName);
  73. AssignFile(ToFile, ToFileName);
  74. Reset(FromFile);
  75. try
  76. Rewrite(ToFile);
  77. try
  78. if LZCopy(TFileRec(FromFile).Handle, TFileRec(ToFile).Handle)<0 then
  79. raise Exception.Create('Error using LZCopy')
  80. finally
  81. CloseFile(ToFile);
  82. end;
  83. finally
  84. CloseFile(FromFile);
  85. end;
  86. end;
  87.  


Oleg Вопрос ожидает решения (принимаются ответы, доступен мини-форум)

Вопрос задал: Oleg (статус: Посетитель)
Вопрос отправлен: 26 июня 2006, 18:48
Состояние вопроса: открыт, ответов: 4.

Ответ #1. Отвечает эксперт: Помфюк Владимир Степанович

Здравствуйте, Oleg!
приблизительно так:

1. Копирование методом Pascal.
type
TCallBack=procedure (Position,Size:Longint); {Для индикации процесса копирования}

procedure FastFileCopy(Const InfileName1,InfileName2, OutFileName: String; CallBack: TCallBack);
Const BufSize = 3*4*4096; { 48Kbytes дает прекрасный результат }
type
PBuffer = ^TBuffer;
TBuffer = array [1..BufSize] of Byte;
var
Size : integer;
Buffer : PBuffer;
infile1, infile2, outfile : File;
SizeDone,SizeFile: Longint;
begin
if (InFileName1 <> OutFileName)and(InFileName2 <> OutFileName) then
begin
buffer := Nil;
AssignFile(infile1, InFileName1);
System.Reset(infile1, 1);
AssignFile(infile1, InFileName2);
System.Reset(infile1, 1);
try
AssignFile(outfile, OutFileName);
System.Rewrite(outfile, 1);
try
New(Buffer);
SizeFile := FileSize(infile1);
SizeDone := 0;
repeat
BlockRead(infile1, Buffer^, BufSize, Size);
Inc(SizeDone, Size);
CallBack(SizeDone, SizeFile);
BlockWrite(outfile,Buffer^, Size)
until Size < BufSize;
FileSetDate(TFileRec(outfile).Handle,
FileGetDate(TFileRec(infile1).Handle));

SizeFile := FileSize(infile2);
SizeDone := 0;
repeat
BlockRead(infile2, Buffer^, BufSize, Size);
Inc(SizeDone, Size);
CallBack(SizeDone, SizeFile);
BlockWrite(outfile,Buffer^, Size)
until Size < BufSize;
finally
if Buffer <> Nil then Dispose(Buffer);
System.close(outfile)
end;
finally
System.close(infile1);
System.close(infile2);
end;
end else
Raise EInOutError.Create('File cannot be copied into itself');
end;

Ответ отправил: Помфюк Владимир Степанович (статус: Абитуриент)
Время отправки: 26 июня 2006, 18:59
Оценка за ответ: 2

Комментарий к оценке: не работает :( пустой файл получается
да и хотелось чтоб Файл1 приплюсовалсья к Файлу2

Ответ #2. Отвечает эксперт: min@y™

Предлагаю использовать 2 экземпляра TFileStream. Могу, если надо, написать пример. Будет просто и изящно. Но сейчас времени нету, пиши в мыло или сюда на форум.

Ответ отправил: min@y™ (статус: Доктор наук)
Время отправки: 27 июня 2006, 08:17

Ответ #3. Отвечает эксперт: bruder

Здравствуйте, Oleg!
Сам пользуюсь этим: (один минус-получившийся файл использовать не удасться, его нужно будет сначало "распаковать".)

Приложение:
  1. unit Unit1;
  2.  
  3. interface
  4.  
  5. uses
  6. Windows, Forms, Classes, Controls, StdCtrls;
  7.  
  8. type
  9. TForm1 = class(TForm)
  10. Button1: TButton;
  11. procedure Button1Click(Sender: TObject);
  12. private
  13. { Private declarations }
  14. public
  15. { Public declarations }
  16. end;
  17.  
  18. var
  19. Form1: TForm1;
  20.  
  21. implementation
  22.  
  23. {$R *.dfm}
  24. Procedure AddToStream ( Source , Dest : TStream );
  25. var
  26. Size : Integer ;
  27. begin
  28. Source.position := 0 ;
  29. Size := Source.Size ;
  30. Dest.Write(Size,SizeOf(Integer));
  31. Dest.CopyFrom(Source,Source.size);
  32. end;
  33.  
  34. Procedure ThisISHowIPutFilesIn;
  35. var
  36. ABigFileStream, SomeSmallFiles : TMemoryStream ;
  37. begin
  38. ABigFileStream := TMemoryStream.Create ;
  39. try
  40. SomeSmallFiles := TMemoryStream.Create ;
  41. try
  42. SomeSmallFiles.LoadFromFile('1.exe');
  43. AddToStream(SomeSmallFiles,ABigFileStream);
  44. SomeSmallFiles.LoadFromFile('2.exe');
  45. AddToStream(SomeSmallFiles,ABigFileStream);
  46.  
  47. finally
  48. SomeSmallFiles.Free ;
  49. end;
  50. ABigFileStream.SaveToFile('OutFile')
  51. finally
  52. ABigFileStream.free ;
  53. end;
  54. end;
  55.  
  56. procedure TForm1.Button1Click(Sender: TObject);
  57. begin
  58. ThisISHowIPutFilesIn;
  59. end;
  60.  
  61. end.
  62.  
  63. Procedure GetFromStream ( Source , Dest : TStream ; Index : Integer );
  64. Var
  65. Size , I : Integer ;
  66. begin
  67. Source.Position := 0 ;
  68. For i := 0 to index-1 do
  69. begin
  70. Source.Read(Size,SizeOf(Integer));
  71. Source.Position := Source.Position + Size ;
  72. end;
  73. if Source.position = Source.Size then
  74. Raise EAccessViolation.Create('Index Out Of Bounds') ;
  75. Source.Read(Size,SizeOf(Integer));
  76. Dest.Position := 0 ;
  77. Dest.Size := 0 ;
  78. Dest.CopyFrom(Source,Size);
  79. end;
  80.  
  81. Procedure ThisISHowIGetStufOut;
  82. var
  83. ABigFileStream, SomeSmallFiles : TMemoryStream ;
  84. begin
  85. ABigFileStream := TMemoryStream.Create ;
  86. try
  87. ABigFileStream.LoadFromFile('OutFile');
  88. SomeSmallFiles := TMemoryStream.Create ;
  89. try
  90. GetFromStream(ABigFileStream,SomeSmallFiles,0);
  91. SomeSmallFiles.SaveToFile('1.exe');
  92. GetFromStream(ABigFileStream,SomeSmallFiles,1);
  93. SomeSmallFiles.SaveToFile('2.exe');
  94. finally
  95. SomeSmallFiles.Free ;
  96. end;
  97. finally
  98. ABigFileStream.free ;
  99. end;
  100. end;


Ответ отправил: bruder (статус: 4-ый класс)
Время отправки: 27 июня 2006, 09:57

Ответ #4. Отвечает эксперт: Косолапов Дмитрий Юрьевич

В первом способе вместо Rewrite(outfile, 1) Reset(outfile, 1). Наверное, надо будет еще и спозиционироваться на конце файла (Seek).

Во втором способе вместо T := TFileStream.Create(targetfilename, fmOpenWrite or fmCreate) попробуй T := TFileStream.Create(targetfilename, fmOpenReadWrite)

В третьем способе - аналогично первому

Ответ отправил: Косолапов Дмитрий Юрьевич (статус: 8-ой класс)
Время отправки: 27 июня 2006, 10:03
Оценка за ответ: 3


Мини-форум вопроса

Всего сообщений: 1; последнее сообщение — 27 июня 2006, 10:41; участников в обсуждении: 1.
min@y™

min@y™ (статус: Доктор наук), 27 июня 2006, 10:41 [#1]:

Вот, написал 100% рабочий пример (отладил):

// Слияние 2х файлов
procedure TForm1.CopyButtonClick(Sender: TObject);
var
FIn, FOut: TFileStream;
InSize1, InSize2, OutSize: Int64;
begin
if (not FileExists(LabeledEdit1.Text)) or (not FileExists(LabeledEdit2.Text))
then begin
Application.MessageBox(PChar('Один из входных файлов не найден.'),
PChar('Облом'),
MB_OK + MB_ICONERROR);
Exit;
end;

try
CopyButton.Enabled:= False;
FOut:= TFileStream.Create(LabeledEdit3.Text, fmCreate or fmShareExclusive);
try
FIn:= TFileStream.Create(LabeledEdit1.Text, fmOpenRead or fmShareExclusive);
try
FOut.CopyFrom(FIn, 0);
finally
InSize1:= FIn.Size;
FIn.Free;
end;

FIn:= TFileStream.Create(LabeledEdit2.Text, fmOpenRead or fmShareExclusive);
try
FOut.CopyFrom(FIn, 0);
finally
InSize2:= FIn.Size;
FIn.Free;
end;
finally
OutSize:= FOut.Size;
FOut.Free;
CopyButton.Enabled:= True;
end;

Application.MessageBox(PChar('Слияние файлов прошло удачно. '#13#10'Размер 1-го файла: '
+ IntToStr(InSize1)
+ ' байт'#13#10'Размер 2-го файла: '
+ IntToStr(InSize2)
+ ' байт'#13#10'Размер выходного файла: '
+ IntToStr(OutSize) + ' байт'#13#10),
PChar(''),
MB_OK + MB_ICONINFORMATION);
except
on E: Exception do
Application.MessageBox(PChar(E.Message),
PChar('Ошибка копирования'),
MB_OK + MB_ICONERROR);
end;
end;
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.
Версия движка: 2.6+ (26.01.2011)
© 2005-2025
Текущее время: 22 февраля 2025, 11:48
Выполнено за 0.02 сек.