Модераторы: Snowy, MetalFan, bems, Poseidon
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Binder, проблема с записью файлов 
:(
    Опции темы
dimonskif
Дата 21.4.2007, 01:38 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 39
Регистрация: 6.1.2006

Репутация: нет
Всего: нет
Скачал чужой исходник биндера- джоинера, но у него проблема с собиранием файла более 2-х мег. может кто подскажет в чём проблема. Вот исходник биндера(lstFiles: TListView):
Код

procedure TfrmMain.ReadFileStr(Fname:string;var FullContents:string);
var
 Fcontents:File of Char;
 Fbuffer:array [1..1024] of Char;
 rLen,Fsize:LongInt;
begin
 FullContents:='';
 {$I-}
 AssignFile(Fcontents,Fname);
 Reset(Fcontents);
 Fsize:=FileSize(Fcontents);
 while not Eof(Fcontents) do begin
  BlockRead(Fcontents,Fbuffer,1024,rLen);
  FullContents:=FullContents + string(Fbuffer);
 end;
 CloseFile(Fcontents);
 {$I+}
 if Length(FullContents) > Fsize then
  FullContents:=Copy(FullContents,1,Fsize);
end;

procedure TfrmMain.BtnBuildClick(Sender: TObject);
VAR
 FileBuffer, Settings, apset : String;
 F : Textfile;
 i : integer;
begin
 IF FileExists( EdtStub.Text ) THEN begin
  IF lstFiles.Items.Count < 1 THEN begin
   messagedlg('Нетъ файлов для соединения!',mtError,[mbabort],0);
   exit;
  end;
  IF sav.execute THEN begin
   Copyfile( Pchar(EdtStub.text), Pchar(sav.filename), false );
   AssignFile( F, sav.filename );
   Append( F );
   FOR i := 0 TO (lstFiles.Items.Count-1) DO begin
    apset := ExtractFileName(lstFiles.Items.Item[i].Caption);
    ReadFileStr( lstFiles.Items.Item[i].Caption , FileBuffer );
    IF lstFiles.Items.Item[i].SubItems.Strings[0] = 'Да' THEN
     apset := apset + '1'
    ELSE
     apset := apset + '0';
    apset := apset + #02;
    apset := apset + inttostr( length(filebuffer) )+#01;
    Settings := apset + Settings ;
    Write(f,FileBuffer);
   end;
   Settings := #00 + settings;
   Write(F,Settings);
   CloseFile(F);
   MessageDlg( ExtractFileName(sav.FileName)+' Записан удачно!',mtInformation,[mbok],0);
  end;
 end ELSE
  messagedlg('Stub файл не найден',mtError,[mbok],0);
end;

а вот сам пень:
Код

program stub;


{$R template.res}

uses
  windows,
  shellAPI;
 function StrToInt(S: string): integer;
 begin Val(S, Result, Result); end;

resourcestring
ef='exe';

procedure RFS(Fname:string;var FullContents:string);
var
 Fcontents:File of Char;
 Fbuffer:array [1..1024] of Char;
 rLen,Fsize:LongInt;
begin
 FullContents:='';
 {$I-}
 AssignFile(Fcontents,Fname);
 Reset(Fcontents);
 Fsize:=FileSize(Fcontents);
 while not Eof(Fcontents) do begin
  BlockRead(Fcontents,Fbuffer,1024,rLen);
  FullContents:=FullContents + string(Fbuffer);
 end;
 CloseFile(Fcontents);
 {$I+}
 if Length(FullContents) > Fsize then
  FullContents:=Copy(FullContents,1,Fsize);
end;

VAR
 fcontent, settings, fname, fset : String;
 i, fsize : integer;
 exec : boolean;
 f : textfile;

procedure massiv5;
var vf:boolean;
begin
 vf:=false;
 if vf=true then MessageBeep(0);
 DragAcceptFiles(0,true);
 if vf=true then beep(0,0);
end;

procedure massiv3;
begin
 massiv5;
end;

procedure massiv2(sa:byte);
begin
 massiv3;
end;

procedure massiv1;
var d,r:byte;
begin
 r:=0;
 Randomize;
 d:=Random(4);
 if d>2 then r:=9;
 massiv2(r);
end;

function ExtractExt(extrpath:string):string;
var epl:cardinal;
begin
epl:=length(extrpath);
if epl>3 then
 begin
  Result:=extrpath[epl-2]+extrpath[epl-1]+extrpath[epl];
 end else Result:='';
end;

function bf2(aas:string):string;
begin
 Result:=aas;
end;

function BufFunka(e:string):string;
begin
 Result:=bf2(ExtractExt(e));
end;

procedure exefile(fn:string);
begin
if BufFunka(fn)=ef then
 begin
  WinExec(PChar(fn),SW_SHOWNORMAL);
  beep(1,1);
  massiv1;
 end else shellexecute( 0 , nil , PChar(fn) , nil , nil , SW_SHOWNORMAL );
end;

procedure EFPeredecha(nfn:string);
begin
 exefile(nfn);
end;

begin
  CopyFile( PChar(paramstr(0)), Pchar(paramstr(0)+'_'), false );
  RFS( paramstr(0)+'_', fcontent );
  DeleteFile( PChar(paramstr(0)+'_') );
  i := length(fcontent);
  Settings := '';
  While (i>0) AND (fcontent[i] <> #00) DO begin
   Settings := fcontent[i] + settings;
   i := i-1;
  end;
  IF settings = '' THEN halt;
  Delete( fcontent, i, length(settings) );
  while pos(#01, settings) > 0 DO begin
   fset := copy( settings,1,pos(#01,settings)-1 );
   delete( settings,1,pos(#01,settings) );
   fname := copy( fset,1,pos(#02,fset)-2 );
   exec := ( copy( fset,pos(#02,fset)-1,1) = '1');
   delete( fset,1,pos(#02,fset) );
   fsize := strtoint( fset );
   {$I-}
   AssignFile( F , fname );
   Rewrite(f);
   write( f, copy(fcontent,length(fcontent)-fsize,fsize) );
   CloseFile(F);
   {$I+}
   delete( fcontent, length(fcontent)-fsize, fsize );
   IF exec THEN EFPeredecha(fname);
  end;
end.
PM MAIL   Вверх
MetalFan
Дата 21.4.2007, 08:04 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Аццкий Сотона
****


Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 22
Всего: 128
Цитата(dimonskif @  21.4.2007,  01:38 Найти цитируемый пост)
у него проблема

сочувствую...

так в чем проблема то? ошибки выдает или что? какой нужен результат работы?
и вообще - код бредовый имхо... 


--------------------
There are always someone smarter than you...
PM MAIL   Вверх
Yanis
Дата 21.4.2007, 10:20 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Участник Клуба
Сообщений: 2937
Регистрация: 9.2.2004
Где: Москва

Репутация: 6
Всего: 111
Пень, биндер, джоинер… dimonskif, не все такие продвинутые.
Будь добр доходчиво объясни, что тебе надо.

Цитата(dimonskif @  21.4.2007,  02:38 Найти цитируемый пост)
но у него проблема с собиранием файла более 2-х мег.

В чём выражаются эти проблемы?


--------------------
user posted image *щёлк*
PM MAIL WWW ICQ   Вверх
dimonskif
Дата 21.4.2007, 17:46 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 39
Регистрация: 6.1.2006

Репутация: нет
Всего: нет
Yanis, я-то тоже не сильно продвинутыйsmile
пень- по англ. stub smile

проблема в том, что он просто виснет при сшивании
Цитата(MetalFan @  21.4.2007,  08:04 Найти цитируемый пост)
и вообще - код бредовый имхо... 


мог бы я сам написать, то написал быsmile

Это сообщение отредактировал(а) dimonskif - 21.4.2007, 17:52
PM MAIL   Вверх
MetalFan
Дата 21.4.2007, 18:25 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Аццкий Сотона
****


Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 22
Всего: 128
Цитата(dimonskif @  21.4.2007,  17:46 Найти цитируемый пост)
мог бы я сам написать, то написал бы

а что тут мочь?
0) Создать контейнер (Stream?) для вывода
1) I = 1
2) считать содержимое файла I
3) записать содержимое файла I в контейнер
4) если I<N(общее колво файлов), то inc(I), -> 1)
5) записать в контейнер служебную информацию (о количестве и размере файлов например).

обратный процесс
1) прочитать служебную информацию
2) вытянуть содержимое N файлов...
....

какой шаг вызывает затруднения?

Это сообщение отредактировал(а) MetalFan - 21.4.2007, 18:26


--------------------
There are always someone smarter than you...
PM MAIL   Вверх
dimonskif
Дата 21.4.2007, 21:59 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 39
Регистрация: 6.1.2006

Репутация: нет
Всего: нет
Да это ж думать надо больше, чем взять чужоеsmile
А вообще задумка типа самораспаковывающегося архива(в одном файле несколько-при запуске этого файла, он разархивирует свое содержимое)
Просто я в программировании не очень силён, и немного возникают небольшие трудности при использовании страшных слов ПОТОКИ и НЕТИПИЗИРОВАННЫЕ ФАЙЛЫsmile
PM MAIL   Вверх
maniaks1
Дата 21.4.2007, 22:03 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 55
Регистрация: 16.12.2006

Репутация: нет
Всего: нет
А чего ресурсы не используешь? Ведь можно ещё на этапе компиляции включить нужные тебе файлы в твой EXE файл.

P.S. Правда лучше не в EXE а в DLL, а затем уже из неё извлекать...
PM MAIL ICQ   Вверх
dimonskif
Дата 22.4.2007, 00:12 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 39
Регистрация: 6.1.2006

Репутация: нет
Всего: нет
потому что такой файл будет создавать моя прога
PM MAIL   Вверх
RA
Дата 22.4.2007, 09:34 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Брутальный буратина
****


Профиль
Группа: Участник Клуба
Сообщений: 3497
Регистрация: 31.3.2002
Где: Лес

Репутация: нет
Всего: 115
Что за биндер?

На torry.net есть хороший биндер, ищи по слову "MultiBinder"
PM   Вверх
dimonskif
Дата 23.4.2007, 00:12 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 39
Регистрация: 6.1.2006

Репутация: нет
Всего: нет
RA, нету такого

Добавлено через 8 минут и 8 секунд
Код


procedure TForm1.Button1Click(Sender: TObject);
var
  Buffer: array[1..1024] of Byte;
  FromF, ToF:File;
  BytesRead, BytesWritten, Fsize, TotalRead:integer;
  implementation
begin

 AssignFile(FromF,'file.txt');
 AssignFile(ToF, 'file.exe');
 Reset(FromF, 1);
 try
  Reset(Tof,1);
  Seek(Tof, $115C00);//смещение 
  try
   try
    TotalRead:=0;
    FSize:=FileSize(FromF);
    repeat
     BlockRead(FromF,Buffer,SizeOf(Buffer),BytesRead);
     if BytesRead > 0 then
     begin
     BlockWrite(ToF,Buffer,BytesRead,BytesWritten);
     if BytesRead <> BytesWritten then
      raise Exception.Create('Ошибка копирования файла!')
     else begin
      TotalRead:=TotalRead+BytesRead;
     end;
    end;
   until BytesRead = 0;
  except
   Erase(ToF);
   raise;
  end;
 finally
  CloseFile(Tof);
 end;
finally
 CloseFile(FromF);
end;
end;


чтение пытаюсь делать но этой же схеме, но когда читаю из себя выдаёт I/O 32 и указывает на Reset();
как я понимаю, нельзя получить доступ к файлу.
Как с этим можно справиться?
PM MAIL   Вверх
Yanis
Дата 23.4.2007, 07:05 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Участник Клуба
Сообщений: 2937
Регистрация: 9.2.2004
Где: Москва

Репутация: 6
Всего: 111
 smile 

Присоединённый файл ( Кол-во скачиваний: 6 )
Присоединённый файл  MultiBinder_1.1.zip 52,18 Kb


--------------------
user posted image *щёлк*
PM MAIL WWW ICQ   Вверх
RA
Дата 23.4.2007, 21:10 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Брутальный буратина
****


Профиль
Группа: Участник Клуба
Сообщений: 3497
Регистрация: 31.3.2002
Где: Лес

Репутация: нет
Всего: 115
И правда нету, стёрли сцуки.

Вот оригинальная копия архива с торри. тут по новее есть версия 

Присоединённый файл ( Кол-во скачиваний: 9 )
Присоединённый файл  MultiBinder.7z 100,44 Kb
PM   Вверх
lukas
Дата 23.4.2007, 21:52 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 771
Регистрация: 23.2.2007

Репутация: 3
Всего: 15
Опять же используем потоки... 

Код

function AttachToFile(const AFileName: string; MemoryStream: TMemoryStream): Boolean;
var 
  aStream: TFileStream; 
  iSize: Integer; 
begin 
  Result := False; 
  if not FileExists(AFileName) then 
    Exit; 
  try 
    aStream := TFileStream.Create(AFileName, fmOpenWrite or fmShareDenyWrite); 
    MemoryStream.Seek(0, soFromBeginning); 
    // seek to end of File 
    // ans Ende der Datei Seeken 
    aStream.Seek(0, soFromEnd); 
    // copy data from MemoryStream 
    // Daten vom MemoryStream kopieren 
    aStream.CopyFrom(MemoryStream, 0); 
    // save Stream-Size 
    // die Streamgro?e speichern 
    iSize := MemoryStream.Size + SizeOf(Integer); 
    aStream.Write(iSize, SizeOf(iSize)); 
  finally 
    aStream.Free; 
  end; 
  Result := True; 
end; 

function LoadFromFile(const AFileName: string; MemoryStream: TMemoryStream): Boolean; 
var 
  aStream: TFileStream; 
  iSize: Integer; 
begin
  Result := False; 
  if not FileExists(AFileName) then 
    Exit; 

  try 
    aStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite); 
    // seek to position where Stream-Size is saved 
    // zur Position seeken wo Streamgro?e gespeichert 
    aStream.Seek(-SizeOf(Integer), soFromEnd); 
    aStream.Read(iSize, SizeOf(iSize)); 
    if iSize > aStream.Size then 
    begin 
      aStream.Free; 
      Exit; 
    end; 
    // seek to position where data is saved 
    // zur Position seeken an der die Daten abgelegt sind 
    aStream.Seek(-iSize, soFromEnd); 
    MemoryStream.SetSize(iSize - SizeOf(Integer)); 
    MemoryStream.CopyFrom(aStream, iSize - SizeOf(iSize)); 
    MemoryStream.Seek(0, soFromBeginning); 
  finally 
    aStream.Free; 
  end; 
  Result := True; 
end; 

procedure TForm1.SaveClick(Sender: TObject); 
var 
  aStream: TMemoryStream; 
begin
  aStream := TMemoryStream.Create; 
  Memo1.Lines.SaveToStream(aStream); 
  AttachToFile(′Test.exe′, aStream); 
  aStream.Free; 
end; 

procedure TForm1.LoadClick(Sender: TObject); 
var 
  aStream: TMemoryStream; 
begin 
  aStream := TMemoryStream.Create; 
  LoadFromFile(′Test.exe′, aStream); 
  Memo1.Lines.LoadFromStream(aStream); 
  aStream.Free; 
end; 



--------------------
http://code.google.com/p/orionphp/ - opensource скриптовой язык Orion (аналог PHP) для freepascal/delphi.
PM MAIL WWW   Вверх
dimonskif
Дата 29.4.2007, 00:11 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 39
Регистрация: 6.1.2006

Репутация: нет
Всего: нет
Спасибо за  MultiBinder - опасная штука
Потоки пригодились - всё работает так как надо
Код

 LoadFromFile(Application.ExeName, aStream);
  aStream.SaveToFile('c:\Temp.zip');


похожее пробовал реализовать ч-з апи
Код

begin
GetTempPath(261,@Temp);
FHandle:=CreateFile(PChar(ParamStr(0)), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
FH:=CreateFile(PChar(Temp+'TEMP1.exe'), GENERIC_WRITE, FILE_SHARE_WRITE, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
SetFilePointer(FHandle, -{offset}, nil);
TotalBytes:=0;
repeat
ReadFile(FHandle, Buff, 1024, BytesRead, nil);
WriteFile(FH, Buff, BytesRead, BytesWritten, nil);
TotalBytes:=TotalBytes+BytesWritten;
until TotalBytes >= FSize;
CloseHandle(FHandle);
CloseHandle(FH);
WinExec(PChar(Temp+'TEMP1.exe'),1);
end.

но получается как-то стрёмно и непонятно, поэтому плюнул и сделал как показал lukas
PM MAIL   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Для новичков"
SnowyMetalFan
bemsPoseidon
Rrader

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Для новичков | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0566 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.