root/trunk/LCLFileInString.pas

////////////////////////////////////////////////////////////
//            Класс для работы с файлом, как              //
//                с паскалевской строкой                  //
//                     LCL-вариант                        //
//                        v 1.5                           //
//                                                        //
//              Copyright (C) 2007 Sagrer                 //
//          Распространяется на условиях LGPL 2.1         //
//                  см. файл lgpl.txt                     //
//                                                        //
//                  sagrer@yandex.ru                      //
////////////////////////////////////////////////////////////

//К работе над данным файлом приложили руки, ноги.... короче аффтары:
// 1) Sagrer (sagrer@yandex.ru)

////////////////////////////////////////////////////////////////////////

unit LCLFileInString;

{$mode objfpc}{$H+}

interface

uses
  Windows, SysUtils, Forms, Dialogs, Classes;
  
const
  //Коды для OutputMessagesMode
  FIS_Output_none = 0;        //Не выводить мессаги.
  FIS_Output_GUI = 1;         //Выводить окошки в GUI.
  FIS_Output_Console = 2;     //Выводить о ошибках в консоль.

type
  TFileInString = Class (TObject)                //Класс для загрузки файла в строку и сохранения. + работа со строкой.
  public
    //Переменные
    OutputMessagesMode : Integer;                //Куда выводить мессаги о ошибках - в GUI / в консоль / в никуда.
    FileString : AnsiString;                     //Тут хранится собсно загруженная инфа.
    FirstLoaded : boolean;                       //Признак того что какая-либо информация когда-либо загружалась.
    //Конструкторы-деструкторы
    constructor Create; virtual;                            //Конcтруктор  %).
    Destructor Destroy; override;                           //Типа деструктор.
    //Методы
    Function Siz : Integer;                      //Получить размер загруженной инфы.
    Function Load(const FName : AnsiString) : boolean; virtual; //Загрузить из файла.
    Procedure Save(const FName : AnsiString);                   //Сохранить в файл.
    Procedure MakNewFile(); virtual;                              //"Создать новый файл" %).
    Procedure AddChar(const ch : char);                         //Добавить символ.
    Procedure AddByte(const bt : byte);                         //Добавить байт.
    Function ReadStr(const FirstByte, BytesRead : Integer) : AnsiString;    //Прочитать строку.
    Procedure LoadFromResource(const ResName, ResType : PChar);             //Загрузить инфу из ресурса.
  end;  

implementation

////////////////////////////////////////
//           TFileInString            //
////////////////////////////////////////

//------------------------------------//
//      Конструкторы-деструкторы      //
//------------------------------------//

Constructor TFileInString.Create;
//Конутруктор  %).
begin
  FirstLoaded := false;
  FileString := '';
  SetLength(FileString,0);
  OutputMessagesMode := FIS_Output_none;      //По умолчанию вывод в никуда.
end;

Destructor TFileInString.Destroy;
begin
  //Типа деструктор.
  SetLength(FileString,0);
  inherited;
end;

//------------------------------------//
//             Методы                 //
//------------------------------------//

Function TFileInString.Siz : Integer;
//Получить размер загруженной инфы.
begin
  Result := Length(FileString);
end;

Function TFileInString.Load(const FName : AnsiString) : boolean;
//Загрузить из файла.
var
  DataFile: THandle;
  FileSize: DWORD;
  Resultt : integer;
begin
  Result := false;
  FileString := '';
  Resultt := 0;
  //Процедура загрузки в строку.
  //Открываю файл и получаю его размер.
  //Кстати проверяю файл на его наличие :).
  If FileExists(FName) = true then begin
    DataFile := FileOpen(FName, fmOpenRead or fmShareDenyNone);
    if DataFile = 0 then
      if OutputMessagesMode = FIS_Output_GUI then begin
        Application.MessageBox(PChar('Error, loading'+FName),'Error',MB_OK or MB_ICONERROR);
      end
      else if OutputMessagesMode = FIS_Output_Console then begin
        Writeln('Error, loading'+FName);
      end;
    try
      FileSize := GetFileSize(DataFile, nil);
      SetLength(FileString, FileSize);
      ReadFile(THandle(DataFile),Pointer(FileString)^,FileSize,LongWord(Resultt),nil)
    finally
      CloseHandle(DataFile);
    end;
    FirstLoaded := true;
    Result := true;
  end
  else begin
    //Наорать на юзверя (или программера), что файла нету!
    if OutputMessagesMode = FIS_Output_GUI then begin
      ShowMessage('Ошибка! Типа не могу открыть файл '+FName+', т.к. открывать то нечего. Проверьте пути.');
    end
    else if OutputMessagesMode = FIS_Output_Console then begin
      Writeln('Error, cant load file'+FName+'because file is not exists! Check paths!');
    end;
  end;
end;

procedure TFileInString.Save(const FName : AnsiString);
//Сохранить в файл.
var
  DataFile: THandle;
  FileSize: DWORD;
  Resultt : integer;

begin
  //Процедура сейва из строки..
  Resultt := 0;
  If Siz <> 0 then begin
    if FirstLoaded = true then begin
      //Если есть чего сохранять, то погнали.
      if (DirectoryExists(ExtractFilePath(FName)) = false) and (ExtractFilePath(FName) <> '') then begin
        //Если папки для файла нет, то попробовать создать ее...
        ForceDirectories(ExtractFilePath(FName));
      end;
      //Если старый файл есть - создать пустой на его месте.
      DataFile := CreateFile(PChar(FName),GENERIC_READ or GENERIC_WRITE,0,nil,CREATE_ALWAYS,FILE_ATTRIBUTE_NORMAL,0);
      //DataFile := FileOpen(FName, fmOpenWrite or fmShareDenyWrite);
      if DataFile = 0 then
        if OutputMessagesMode = FIS_Output_GUI then begin
          Application.MessageBox(PChar('Error, Saving'+FName),'Error',MB_OK or MB_ICONERROR);
        end
        else if OutputMessagesMode = FIS_Output_Console then begin
          Writeln('Error, Saving'+FName);
        end;
      try
        FileSize := siz;
        WriteFile(THandle(DataFile),Pointer(FileString)^,FileSize,LongWord(Resultt),nil)
      finally
        CloseHandle(DataFile);
      end;
      FirstLoaded := true;
    end
    else begin
      //Если сохранять нечего, то громко заругаться!
      if OutputMessagesMode = FIS_Output_GUI then begin
        ShowMessage('ЕПТЫТЬ!..., кароче в обьект класа еще ни разу ниче не грузилось! А сохранять то чего блин??? Типа ошибка, ниче не сохранилось :(');
      end
      else if OutputMessagesMode = FIS_Output_Console then begin
        Writeln('ERROR! Nothing loaded into TFileInString class''s object! Nothing to save!');
      end;
    end;
  end
  else begin
    //Если файл пустой (0 байтов)

    //try
      DataFile := CreateFile(PChar(FName),GENERIC_READ or GENERIC_WRITE,0,nil,CREATE_ALWAYS,FILE_ATTRIBUTE_NORMAL,0);
    //finally
      CloseHandle(DataFile);
    //end;
  end;
end;

Procedure TFileInString.MakNewFile();
//"Создать новый файл" %).
begin
  //ПроцеДурка для "создания" файла - чтоб новый делать можно было.
  FirstLoaded := true;
  SetLength(FileString,0);
  FileString := '';
end;

Procedure TFileInString.AddChar(const ch : char);
//Добавить символ.
begin
  //Процедура добавки байта в строку в виде чара.
  FileString := FileString+ch;
end;

Procedure TFileInString.AddByte(const bt : byte);
//Добавить байт.
begin
  //Процедура добавки байта в строку в виде байта...
  FileString := FileString+char(bt);
end;

Function TFileInString.ReadStr(const FirstByte, BytesRead : Integer) : AnsiString;
//Прочитать строку.
var
  TempInt, LastByte : Integer;
begin
  //Прочитать строку начиная с нужного байта.
  //и по конечный байт.
  TempInt := Length(FileString);
  LastByte := FirstByte+BytesRead;

  If LastByte <= TempInt+1 then begin
    //Только если LastByte не вылезло за пределы файла.
    //(точнее за пределы переменной - в ту часть памяти, куда лезть не положено)
    //ато винда покажет синий экранчик :).
    SetLength(Result,LastByte-FirstByte);
    Result := Copy(FileString,FirstByte,BytesRead);
    SetLength(Result,LastByte-FirstByte);
  end
  else begin
    result := '';
  end;  
end;

Procedure TFileInString.LoadFromResource(const ResName, ResType : PChar);
//Загрузить инфу из ресурса.
var
  R : HRSRC;
  G : HGlobal;
  P : PChar;
  Sz : DWORD;
  E : Integer;
  
begin
  //Функа для загрузки инфы в файл из ресурса, присобаченного к экзейнику.
  
  //Читаем % )). Сделано аналогично тому как сделано в KOL.
  R := FindResource( HInstance, ResName, ResType );
  if R <> 0 then
  begin
    Sz := SizeofResource( HInstance, R );
    G := LoadResource( HInstance, R );
    if G <> 0 then
    begin
      P := GlobalLock( G );
      if P = nil then
      begin
        E := GetLastError;
        if E = ERROR_INVALID_HANDLE then
           P := Pointer( G )
        else
           Exit;
      end;
      SetLength(FileString,Sz);
      CopyMemory(@FileString[1],P,Sz);
      if P <> Pointer( G ) then GlobalUnlock( G );
      //FreeResource( G );
      { from Win32.hlp: "You do not need to call the FreeResource
        function to free a resource loaded by using the LoadResource
        function." }
    end;
  end;
end;

end.